/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.constructions.prod
import measure_theory.group.measure

/-!
# Measure theory in the product of groups
In this file we show properties about measure theory in products of measurable groups
and properties of iterated integrals in measurable groups.

These lemmas show the uniqueness of left invariant measures on measurable groups, up to
scaling. In this file we follow the proof and refer to the book *Measure Theory* by Paul Halmos.

The idea of the proof is to use the translation invariance of measures to prove `μ(F) = c * μ(E)`
for two sets `E` and `F`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
the characteristic functions of `E` and `F`.
Assume that `μ` and `ν` are left-invariant measures. Then the map `(x, y) ↦ (y * x, x⁻¹)`
preserves the measure `μ.prod ν`, which means that
```
  ∫ x, ∫ y, h x y ∂ν ∂μ = ∫ x, ∫ y, h (y * x) x⁻¹ ∂ν ∂μ
```
If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E)`, we can rewrite the RHS to
`μ(F)`, and the LHS to `c * μ(E)`, where `c = c(ν)` does not depend on `μ`.
Applying this to `μ` and to `ν` gives `μ (F) / μ (E) = ν (F) / ν (E)`, which is the uniqueness up to
scalar multiplication.

The proof in [Halmos] seems to contain an omission in §60 Th. A, see
`measure_theory.measure_lintegral_div_measure`.

-/

noncomputable theory
open set (hiding prod_eq) function measure_theory
open_locale classical ennreal pointwise measure_theory

variables (G : Type*) [measurable_space G]
variables [group G] [has_measurable_mul₂ G]
variables (μ ν : measure G) [sigma_finite ν] [sigma_finite μ]

/-- The map `(x, y) ↦ (x, xy)` as a `measurable_equiv`. This is a shear mapping. -/
@[to_additive "The map `(x, y) ↦ (x, x + y)` as a `measurable_equiv`.
This is a shear mapping."]
protected def measurable_equiv.shear_mul_right [has_measurable_inv G] : G × G ≃ᵐ G × G :=
{ measurable_to_fun  := measurable_fst.prod_mk measurable_mul,
  measurable_inv_fun := measurable_fst.prod_mk $ measurable_fst.inv.mul measurable_snd,
  .. equiv.prod_shear (equiv.refl _) equiv.mul_left }

variables {G}

namespace measure_theory

open measure

/-- This condition is part of the definition of a measurable group in [Halmos, §59].
  There, the map in this lemma is called `S`. -/
@[to_additive map_prod_sum_eq]
lemma map_prod_mul_eq [is_mul_left_invariant ν] :
  map (λ z : G × G, (z.1, z.1 * z.2)) (μ.prod ν) = μ.prod ν :=
begin
  refine (prod_eq _).symm, intros s t hs ht,
  simp_rw [map_apply (measurable_fst.prod_mk (measurable_fst.mul measurable_snd)) (hs.prod ht),
    prod_apply ((measurable_fst.prod_mk (measurable_fst.mul measurable_snd)) (hs.prod ht)),
    preimage_preimage],
  conv_lhs { congr, skip, funext, rw [mk_preimage_prod_right_fn_eq_if ((*) x), measure_if] },
  simp_rw [measure_preimage_mul, lintegral_indicator _ hs, set_lintegral_const, mul_comm]
end

/-- The function we are mapping along is `SR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
@[to_additive map_prod_add_eq_swap]
lemma map_prod_mul_eq_swap [is_mul_left_invariant μ] :
  map (λ z : G × G, (z.2, z.2 * z.1)) (μ.prod ν) = ν.prod μ :=
begin
  rw [← prod_swap],
  simp_rw [map_map (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)) measurable_swap],
  exact map_prod_mul_eq ν μ
end

@[to_additive]
lemma measurable_measure_mul_right {E : set G} (hE : measurable_set E) :
  measurable (λ x, μ ((λ y, y * x) ⁻¹' E)) :=
begin
  suffices : measurable (λ y,
    μ ((λ x, (x, y)) ⁻¹' ((λ z : G × G, ((1 : G), z.1 * z.2)) ⁻¹' ((univ : set G) ×ˢ E)))),
  { convert this, ext1 x, congr' 1 with y : 1, simp },
  apply measurable_measure_prod_mk_right,
  exact measurable_const.prod_mk (measurable_fst.mul measurable_snd) (measurable_set.univ.prod hE)
end

variables [has_measurable_inv G]

/-- The function we are mapping along is `S⁻¹` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq`. -/
@[to_additive map_prod_neg_add_eq]
lemma map_prod_inv_mul_eq [is_mul_left_invariant ν] :
  map (λ z : G × G, (z.1, z.1⁻¹ * z.2)) (μ.prod ν) = μ.prod ν :=
(measurable_equiv.shear_mul_right G).map_apply_eq_iff_map_symm_apply_eq.mp $ map_prod_mul_eq μ ν

/-- The function we are mapping along is `S⁻¹R` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
@[to_additive map_prod_neg_add_eq_swap]
lemma map_prod_inv_mul_eq_swap [is_mul_left_invariant μ] :
  map (λ z : G × G, (z.2, z.2⁻¹ * z.1)) (μ.prod ν) = ν.prod μ :=
begin
  rw [← prod_swap],
  simp_rw
    [map_map (measurable_snd.prod_mk $ measurable_snd.inv.mul measurable_fst) measurable_swap],
  exact map_prod_inv_mul_eq ν μ
end

/-- The function we are mapping along is `S⁻¹RSR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
@[to_additive map_prod_add_neg_eq]
lemma map_prod_mul_inv_eq [is_mul_left_invariant μ] [is_mul_left_invariant ν] :
  map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod ν) = μ.prod ν :=
begin
  suffices : map ((λ z : G × G, (z.2, z.2⁻¹ * z.1)) ∘ (λ z : G × G, (z.2, z.2 * z.1))) (μ.prod ν) =
    μ.prod ν,
  { convert this, ext1 ⟨x, y⟩, simp },
  simp_rw [← map_map (measurable_snd.prod_mk (measurable_snd.inv.mul measurable_fst))
    (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)), map_prod_mul_eq_swap μ ν,
    map_prod_inv_mul_eq_swap ν μ]
end

@[to_additive] lemma quasi_measure_preserving_inv [is_mul_left_invariant μ] :
  quasi_measure_preserving (has_inv.inv : G → G) μ μ :=
begin
  refine ⟨measurable_inv, absolutely_continuous.mk $ λ s hsm hμs, _⟩,
  rw [map_apply measurable_inv hsm, inv_preimage],
  have hf : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
    (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
  suffices : map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod μ) (s⁻¹ ×ˢ s⁻¹) = 0,
  { simpa only [map_prod_mul_inv_eq μ μ, prod_prod, mul_eq_zero, or_self] using this },
  have hsm' : measurable_set (s⁻¹ ×ˢ s⁻¹) := hsm.inv.prod hsm.inv,
  simp_rw [map_apply hf hsm', prod_apply_symm (hf hsm'), preimage_preimage, mk_preimage_prod,
    inv_preimage, inv_inv, measure_mono_null (inter_subset_right _ _) hμs, lintegral_zero]
end

@[to_additive]
lemma measure_inv_null [is_mul_left_invariant μ] {E : set G} :
  μ ((λ x, x⁻¹) ⁻¹' E) = 0 ↔ μ E = 0 :=
begin
  refine ⟨λ hE, _, (quasi_measure_preserving_inv μ).preimage_null⟩,
  convert (quasi_measure_preserving_inv μ).preimage_null hE,
  exact (inv_inv _).symm
end

@[to_additive]
lemma lintegral_lintegral_mul_inv [is_mul_left_invariant μ] [is_mul_left_invariant ν]
  (f : G → G → ℝ≥0∞) (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f (y * x) x⁻¹ ∂ν ∂μ = ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ :=
begin
  have h : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
  (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
  have h2f : ae_measurable (uncurry $ λ x y, f (y * x) x⁻¹) (μ.prod ν),
  { apply hf.comp_measurable' h (map_prod_mul_inv_eq μ ν).absolutely_continuous },
  simp_rw [lintegral_lintegral h2f, lintegral_lintegral hf],
  conv_rhs { rw [← map_prod_mul_inv_eq μ ν] },
  symmetry,
  exact lintegral_map' (hf.mono' (map_prod_mul_inv_eq μ ν).absolutely_continuous) h,
end

@[to_additive]
lemma measure_mul_right_null [is_mul_left_invariant μ] {E : set G} (y : G) :
  μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ E = 0 :=
calc μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ (has_inv.inv ⁻¹' ((λ x, y⁻¹ * x) ⁻¹' (has_inv.inv ⁻¹' E))) = 0 :
  by simp only [preimage_preimage, mul_inv_rev, inv_inv]
... ↔ μ E = 0 : by simp only [measure_inv_null μ, measure_preimage_mul]

@[to_additive]
lemma measure_mul_right_ne_zero [is_mul_left_invariant μ] {E : set G}
  (h2E : μ E ≠ 0) (y : G) : μ ((λ x, x * y) ⁻¹' E) ≠ 0 :=
(not_iff_not_of_iff (measure_mul_right_null μ y)).mpr h2E

/-- This is the computation performed in the proof of [Halmos, §60 Th. A]. -/
@[to_additive]
lemma measure_mul_lintegral_eq [is_mul_left_invariant μ]
  [is_mul_left_invariant ν] {E : set G} (Em : measurable_set E) (f : G → ℝ≥0∞) (hf : measurable f) :
  μ E * ∫⁻ y, f y ∂ν = ∫⁻ x, ν ((λ z, z * x) ⁻¹' E) * f (x⁻¹) ∂μ :=
begin
  rw [← set_lintegral_one, ← lintegral_indicator _ Em,
    ← lintegral_lintegral_mul (measurable_const.indicator Em).ae_measurable hf.ae_measurable,
    ← lintegral_lintegral_mul_inv μ ν],
  swap, { exact (((measurable_const.indicator Em).comp measurable_fst).mul
      (hf.comp measurable_snd)).ae_measurable },
  have mE : ∀ x : G, measurable (λ y, ((λ z, z * x) ⁻¹' E).indicator (λ z, (1 : ℝ≥0∞)) y) :=
  λ x, measurable_const.indicator (measurable_mul_const _ Em),
  have : ∀ x y, E.indicator (λ (z : G), (1 : ℝ≥0∞)) (y * x) =
    ((λ z, z * x) ⁻¹' E).indicator (λ (b : G), 1) y,
  { intros x y, symmetry, convert indicator_comp_right (λ y, y * x), ext1 z, refl },
  simp_rw [this, lintegral_mul_const _ (mE _), lintegral_indicator _ (measurable_mul_const _ Em),
    set_lintegral_one],
end

/-- Any two nonzero left-invariant measures are absolutely continuous w.r.t. each other. -/
@[to_additive]
lemma absolutely_continuous_of_is_mul_left_invariant
  [is_mul_left_invariant μ] [is_mul_left_invariant ν] (hν : ν ≠ 0) : μ ≪ ν :=
begin
  refine absolutely_continuous.mk (λ E Em hνE, _),
  have h1 := measure_mul_lintegral_eq μ ν Em 1 measurable_one,
  simp_rw [pi.one_apply, lintegral_one, mul_one, (measure_mul_right_null ν _).mpr hνE,
    lintegral_zero, mul_eq_zero, measure_univ_eq_zero.not.mpr hν, or_false] at h1,
  exact h1
end

@[to_additive]
lemma ae_measure_preimage_mul_right_lt_top [is_mul_left_invariant μ] [is_mul_left_invariant ν]
  {E : set G} (Em : measurable_set E) (hμE : μ E ≠ ∞) :
  ∀ᵐ x ∂μ, ν ((λ y, y * x) ⁻¹' E) < ∞ :=
begin
  refine ae_of_forall_measure_lt_top_ae_restrict' ν.inv _ _,
  intros A hA h2A h3A,
  simp only [ν.inv_apply] at h3A,
  apply ae_lt_top (measurable_measure_mul_right ν Em),
  have h1 := measure_mul_lintegral_eq μ ν Em (A⁻¹.indicator 1) (measurable_one.indicator hA.inv),
  rw [lintegral_indicator _ hA.inv] at h1,
  simp_rw [pi.one_apply, set_lintegral_one, ← image_inv, indicator_image inv_injective, image_inv,
    ← indicator_mul_right _ (λ x, ν ((λ y, y * x) ⁻¹' E)), function.comp, pi.one_apply,
    mul_one] at h1,
  rw [← lintegral_indicator _ hA, ← h1],
  exact ennreal.mul_ne_top hμE h3A.ne,
end

@[to_additive]
lemma ae_measure_preimage_mul_right_lt_top_of_ne_zero [is_mul_left_invariant μ]
  [is_mul_left_invariant ν] {E : set G} (Em : measurable_set E) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞) :
  ∀ᵐ x ∂μ, ν ((λ y, y * x) ⁻¹' E) < ∞ :=
begin
  refine (ae_measure_preimage_mul_right_lt_top ν ν Em h3E).filter_mono _,
  refine (absolutely_continuous_of_is_mul_left_invariant μ ν _).ae_le,
  refine mt _ h2E,
  intro hν,
  rw [hν, measure.coe_zero, pi.zero_apply]
end

/-- A technical lemma relating two different measures. This is basically [Halmos, §60 Th. A].
  Note that if `f` is the characteristic function of a measurable set `F` this states that
  `μ F = c * μ E` for a constant `c` that does not depend on `μ`.

  Note: There is a gap in the last step of the proof in [Halmos].
  In the last line, the equality `g(x⁻¹)ν(Ex⁻¹) = f(x)` holds if we can prove that
  `0 < ν(Ex⁻¹) < ∞`. The first inequality follows from §59, Th. D, but the second inequality is
  not justified. We prove this inequality for almost all `x` in
  `measure_theory.ae_measure_preimage_mul_right_lt_top_of_ne_zero`. -/
@[to_additive]
lemma measure_lintegral_div_measure [is_mul_left_invariant μ]
  [is_mul_left_invariant ν] {E : set G} (Em : measurable_set E) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞)
  (f : G → ℝ≥0∞) (hf : measurable f) :
  μ E * ∫⁻ y, f y⁻¹ / ν ((λ x, x * y⁻¹) ⁻¹' E) ∂ν = ∫⁻ x, f x ∂μ :=
begin
  set g := λ y, f y⁻¹ / ν ((λ x, x * y⁻¹) ⁻¹' E),
  have hg : measurable g := (hf.comp measurable_inv).div
    ((measurable_measure_mul_right ν Em).comp measurable_inv),
  simp_rw [measure_mul_lintegral_eq μ ν Em g hg, g, inv_inv],
  refine lintegral_congr_ae _,
  refine (ae_measure_preimage_mul_right_lt_top_of_ne_zero μ ν Em h2E h3E).mono (λ x hx , _),
  simp_rw [ennreal.mul_div_cancel' (measure_mul_right_ne_zero ν h2E _) hx.ne]
end

@[to_additive]
lemma measure_mul_measure_eq [is_mul_left_invariant μ]
  [is_mul_left_invariant ν] {E F : set G}
  (hE : measurable_set E) (hF : measurable_set F) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞) :
    μ E * ν F = ν E * μ F :=
begin
  have h1 := measure_lintegral_div_measure ν ν hE h2E h3E (F.indicator (λ x, 1))
    (measurable_const.indicator hF),
  have h2 := measure_lintegral_div_measure μ ν hE h2E h3E (F.indicator (λ x, 1))
    (measurable_const.indicator hF),
  rw [lintegral_indicator _ hF, set_lintegral_one] at h1 h2,
  rw [← h1, mul_left_comm, h2],
end

/-- Left invariant Borel measures on a measurable group are unique (up to a scalar). -/
@[to_additive]
lemma measure_eq_div_smul [is_mul_left_invariant μ]
  [is_mul_left_invariant ν] {E : set G}
  (hE : measurable_set E) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞) : μ = (μ E / ν E) • ν :=
begin
  ext1 F hF,
  rw [smul_apply, smul_eq_mul, mul_comm, ← mul_div_assoc, mul_comm,
    measure_mul_measure_eq μ ν hE hF h2E h3E, mul_div_assoc, ennreal.mul_div_cancel' h2E h3E]
end

end measure_theory


/-
Copyright (c) 2020 Benjamin Davidson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Benjamin Davidson
-/
import analysis.special_functions.trigonometric.arctan_deriv

/-! ### Leibniz's Series for Pi -/

namespace real

open filter set
open_locale classical big_operators topology real
local notation (name := abs) `|`x`|` := abs x

/-- This theorem establishes **Leibniz's series for `π`**: The alternating sum of the reciprocals
  of the odd numbers is `π/4`. Note that this is a conditionally rather than absolutely convergent
  series. The main tool that this proof uses is the Mean Value Theorem (specifically avoiding the
  Fundamental Theorem of Calculus).

  Intuitively, the theorem holds because Leibniz's series is the Taylor series of `arctan x`
  centered about `0` and evaluated at the value `x = 1`. Therefore, much of this proof consists of
  reasoning about a function
    `f := arctan x - ∑ i in finset.range k, (-(1:ℝ))^i * x^(2*i+1) / (2*i+1)`,
  the difference between `arctan` and the `k`-th partial sum of its Taylor series. Some ingenuity is
  required due to the fact that the Taylor series is not absolutely convergent at `x = 1`.

  This proof requires a bound on `f 1`, the key idea being that `f 1` can be split as the sum of
  `f 1 - f u` and `f u`, where `u` is a sequence of values in [0,1], carefully chosen such that
  each of these two terms can be controlled (in different ways).

  We begin the proof by (1) introducing that sequence `u` and then proving that another sequence
  constructed from `u` tends to `0` at `+∞`. After (2) converting the limit in our goal to an
  inequality, we (3) introduce the auxiliary function `f` defined above. Next, we (4) compute the
  derivative of `f`, denoted by `f'`, first generally and then on each of two subintervals of [0,1].
  We then (5) prove a bound for `f'`, again both generally as well as on each of the two
  subintervals. Finally, we (6) apply the Mean Value Theorem twice, obtaining bounds on `f 1 - f u`
  and `f u - f 0` from the bounds on `f'` (note that `f 0 = 0`). -/
theorem tendsto_sum_pi_div_four :
  tendsto (λ k, ∑ i in finset.range k, ((-(1:ℝ))^i / (2*i+1))) at_top (𝓝 (π/4)) :=
begin
  rw [tendsto_iff_norm_tendsto_zero, ← tendsto_zero_iff_norm_tendsto_zero],
  -- (1) We introduce a useful sequence `u` of values in [0,1], then prove that another sequence
  --     constructed from `u` tends to `0` at `+∞`
  let u := λ k : ℕ, (k:nnreal) ^ (-1 / (2 * (k:ℝ) + 1)),
  have H : tendsto (λ k : ℕ, (1:ℝ) - (u k) + (u k) ^ (2 * (k:ℝ) + 1)) at_top (𝓝 0),
  { convert (((tendsto_rpow_div_mul_add (-1) 2 1 two_ne_zero.symm).neg.const_add 1).add
      tendsto_inv_at_top_zero).comp tendsto_coe_nat_at_top_at_top,
    { ext k,
      simp only [nnreal.coe_nat_cast, function.comp_app, nnreal.coe_rpow],
      rw [← rpow_mul (nat.cast_nonneg k) ((-1)/(2*(k:ℝ)+1)) (2*(k:ℝ)+1),
         @div_mul_cancel _ _ (2*(k:ℝ)+1) _
            (by { norm_cast, simp only [nat.succ_ne_zero, not_false_iff] }), rpow_neg_one k,
          sub_eq_add_neg] },
    { simp only [add_zero, add_right_neg] } },
  -- (2) We convert the limit in our goal to an inequality
  refine squeeze_zero_norm _ H,
  intro k,
  -- Since `k` is now fixed, we henceforth denote `u k` as `U`
  let U := u k,
  -- (3) We introduce an auxiliary function `f`
  let b := λ (i:ℕ) x, (-(1:ℝ))^i * x^(2*i+1) / (2*i+1),
  let f := λ x, arctan x - (∑ i in finset.range k, b i x),
  suffices f_bound : |f 1 - f 0| ≤ (1:ℝ) - U + U ^ (2 * (k:ℝ) + 1),
  { rw ← norm_neg,
    convert f_bound,
    simp only [f], simp [b] },
  -- We show that `U` is indeed in [0,1]
  have hU1 : (U:ℝ) ≤ 1,
  { by_cases hk : k = 0,
    { simp [u, U, hk] },
    { exact rpow_le_one_of_one_le_of_nonpos (by { norm_cast, exact nat.succ_le_iff.mpr
        (nat.pos_of_ne_zero hk) }) (le_of_lt (@div_neg_of_neg_of_pos _ _ (-(1:ℝ)) (2*k+1)
          (neg_neg_iff_pos.mpr zero_lt_one) (by { norm_cast, exact nat.succ_pos' }))) } },
  have hU2 := nnreal.coe_nonneg U,
  -- (4) We compute the derivative of `f`, denoted by `f'`
  let f' := λ x : ℝ, (-x^2) ^ k / (1 + x^2),
  have has_deriv_at_f : ∀ x, has_deriv_at f (f' x) x,
  { intro x,
    have has_deriv_at_b : ∀ i ∈ finset.range k, (has_deriv_at (b i) ((-x^2)^i) x),
    { intros i hi,
      convert has_deriv_at.const_mul ((-1:ℝ)^i / (2*i+1)) (@has_deriv_at.pow _ _ _ _ _ (2*i+1)
        (has_deriv_at_id x)),
      { ext y,
        simp only [b, id.def],
        ring },
      { simp only [nat.add_succ_sub_one, add_zero, mul_one, id.def, nat.cast_bit0, nat.cast_add,
                  nat.cast_one, nat.cast_mul],
        rw [← mul_assoc, @div_mul_cancel _ _ (2*(i:ℝ)+1) _ (by { norm_cast, linarith }),
            pow_mul x 2 i, ← mul_pow (-1) (x^2) i],
        ring_nf } },
    convert (has_deriv_at_arctan x).sub (has_deriv_at.sum has_deriv_at_b),
    have g_sum :=
      @geom_sum_eq _ _ (-x^2) ((neg_nonpos.mpr (sq_nonneg x)).trans_lt zero_lt_one).ne k,
    simp only [f'] at g_sum ⊢,
    rw [g_sum, ← neg_add' (x^2) 1, add_comm (x^2) 1, sub_eq_add_neg, neg_div', neg_div_neg_eq],
    ring },
  have hderiv1 : ∀ x ∈ Icc (U:ℝ) 1, has_deriv_within_at f (f' x) (Icc (U:ℝ) 1) x :=
    λ x hx, (has_deriv_at_f x).has_deriv_within_at,
  have hderiv2 : ∀ x ∈ Icc 0 (U:ℝ), has_deriv_within_at f (f' x) (Icc 0 (U:ℝ)) x :=
    λ x hx, (has_deriv_at_f x).has_deriv_within_at,
  -- (5) We prove a general bound for `f'` and then more precise bounds on each of two subintervals
  have f'_bound : ∀ x ∈ Icc (-1:ℝ) 1, |f' x| ≤ |x|^(2*k),
  { intros x hx,
    rw [abs_div, is_absolute_value.abv_pow abs (-x^2) k, abs_neg, is_absolute_value.abv_pow abs x 2,
        ← pow_mul],
    refine div_le_of_nonneg_of_le_mul (abs_nonneg _) (pow_nonneg (abs_nonneg _) _) _,
    refine le_mul_of_one_le_right (pow_nonneg (abs_nonneg _) _) _,
    rw abs_of_nonneg ((add_nonneg zero_le_one (sq_nonneg x)) : (0 : ℝ) ≤ _),
    exact (le_add_of_nonneg_right (sq_nonneg x) : (1 : ℝ) ≤ _) },
  have hbound1 : ∀ x ∈ Ico (U:ℝ) 1, |f' x| ≤ 1,
  { rintros x ⟨hx_left, hx_right⟩,
    have hincr := pow_le_pow_of_le_left (le_trans hU2 hx_left) (le_of_lt hx_right) (2*k),
    rw [one_pow (2*k), ← abs_of_nonneg (le_trans hU2 hx_left)] at hincr,
    rw ← abs_of_nonneg (le_trans hU2 hx_left) at hx_right,
    linarith [f'_bound x (mem_Icc.mpr (abs_le.mp (le_of_lt hx_right)))] },
  have hbound2 : ∀ x ∈ Ico 0 (U:ℝ), |f' x| ≤ U ^ (2*k),
  { rintros x ⟨hx_left, hx_right⟩,
    have hincr := pow_le_pow_of_le_left hx_left (le_of_lt hx_right) (2*k),
    rw ← abs_of_nonneg hx_left at hincr hx_right,
    rw ← abs_of_nonneg hU2 at hU1 hx_right,
    linarith [f'_bound x (mem_Icc.mpr (abs_le.mp (le_trans (le_of_lt hx_right) hU1)))] },
  -- (6) We twice apply the Mean Value Theorem to obtain bounds on `f` from the bounds on `f'`
  have mvt1 :=
    norm_image_sub_le_of_norm_deriv_le_segment' hderiv1 hbound1 _ (right_mem_Icc.mpr hU1),
  have mvt2 :=
    norm_image_sub_le_of_norm_deriv_le_segment' hderiv2 hbound2 _ (right_mem_Icc.mpr hU2),
  -- The following algebra is enough to complete the proof
  calc |f 1 - f 0| = |(f 1 - f U) + (f U - f 0)| : by ring_nf
               ... ≤ 1 * (1-U) + U^(2*k) * (U - 0) : le_trans (abs_add (f 1 - f U) (f U - f 0))
                                                      (add_le_add mvt1 mvt2)
               ... = 1 - U + U^(2*k) * U : by ring
               ... = 1 - (u k) + (u k)^(2*(k:ℝ)+1) : by { rw [← pow_succ' (U:ℝ) (2*k)], norm_cast },
end

end real


/- Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Orlando Cau
-/
import linear_algebra.basic linear_algebra.finite_dimensional
import algebra.module
/-!
  We fix a notation composition of linear_map.
-/
notation f ` ⊚ `:80 g:80 :=  linear_map.comp f g

universe variables u v w

open linear_map

/-- A representation of a group `G` on an `R`-module `M` is a group homomorphism from `G` to
  `GL(M)`.
  -/

def group_representation (G R M : Type*) [group G] [ring R] [add_comm_group M] [module R M] :
  Type* :=       G →* M →ₗ[R] M

variables {G : Type u} [group G]
          {R : Type v} [ring R]
          {M : Type w}[add_comm_group M] [module R M]

instance  : has_coe_to_fun (group_representation G R M) := ⟨_, λ ρ , ρ.to_fun⟩

variables (ρ : group_representation G R M)

@[simp]lemma map_comp (s t : G) : ρ (s * t) = ρ s ⊚ ρ t :=  ρ.map_mul _ _

def gr.to_equiv' (g : G) :  M ≃ₗ[R] M := { to_fun := ρ g,
  add := (ρ g).map_add ,
  smul := (ρ g).map_smul,
  inv_fun := (ρ g⁻¹ ),
  left_inv := begin intro, change (ρ g⁻¹ ⊚ ρ g) x = _, erw ←  map_comp, rw inv_mul_self, erw ρ.map_one, exact rfl end,
  right_inv :=  begin intro, change (ρ g ⊚ ρ g⁻¹ ) x = _, erw ←  map_comp, rw mul_inv_self, erw ρ.map_one, exact rfl end, }

lemma gr.to_equiv : G →* M ≃ₗ[R] M := { to_fun := gr.to_equiv' ρ  ,
  map_one' := begin
      unfold gr.to_equiv', congr,erw ρ.map_one, exact rfl, rw one_inv, rw ρ.map_one,  exact rfl,
   end,
  map_mul' := begin
    intros, unfold gr.to_equiv', congr, rw map_comp, exact rfl,
    rw mul_inv_rev, rw map_comp, exact rfl,
   end }

@[simp] lemma rho_symm_apply (x : M)(g : G) : ρ g ((gr.to_equiv ρ g).inv_fun x) = x := begin
  dunfold gr.to_equiv, change (ρ g ⊚ ρ g⁻¹) x = x, rw ← map_comp, rw mul_inv_self, rw ρ.map_one, exact rfl,
end

@[simp] lemma symm_eq_inv (ρ : group_representation G R M) (g : G) : ρ g⁻¹ = (gr.to_equiv ρ g).symm :=
begin
  ext, conv_lhs{
    erw ← rho_symm_apply ρ x g,
  },
  change (ρ g⁻¹ * ρ g) _ = _,
  erw ← ρ.map_mul, rw inv_mul_self, rw ρ.map_one, exact rfl,
end


import ..prooflab
import lectures.lec4_equality_of_functions

/-! # Homework 3
Homework must be done individually.
Replace the placeholders (e.g., `:= sorry`) with your solutions using only the tactics we have learned so far. -/

namespace PROOFS

/-
We know that we can add any two natural numbers and get a natural number. In fact, as we have already seen we have the following function which takes __any__ two natural numbers `m` and `n` as input and returns `m + n`.
-/

#check nat.add

/-
Sometimes this fact is phrased as "natural numbers are closed under addition". But natural numbers are not closed under subtraction; we know that 4 subtracted from 3 is not a natural number. However, Lean has a notion of truncated subtraction which defined `m - n` to be `0` if `m < n` and if `n ≤ m`, it returns the usual nonnegative subtraction `m - n`.
-/

#eval 4 - 3
#eval 3 - 4

def add_one (n : ℕ) :=
n + 1

def sub_one (n : ℕ) :=
n - 1

/-! ## Question 1 (20 points):
Prove the following equality of functions.
-/

example :
  sub_one ∘ add_one = id :=
begin
  sorry,
end

/-! ## Question 2 (20 points):
Fill in
-/

example (f : bool → bool) (h : f ∘ f = f) :
   f ∘ f ∘ f = f :=
begin
  sorry,
end

/-
### Question 3 (30 points):
1. Compose functions `square` and `add_one` to define two functions `square_succ` and `succ_square` where the first function maps `n : ℕ` to `(n + 1) * (n + 1)` and the second function maps `n : ℕ` to `n * n + 1`.

2. Prove that the function `square_succ` is the same as `shift_plus1 square` where `shift_plus1` is defined in below.
-/

#check square
#check add_one

def square_succ := sorry
#eval square_succ 20

def succ_square := sorry
#eval succ_square 20

def shift_plus1 := λ f : ℕ → ℕ, λ n, f(n + 1)
def shift_minus1 := λ f : ℕ → ℕ, λ n, f(n - 1)

example :
  shift_plus1 square = square_succ :=
begin
  sorry,
end

/- ### Question 4 (30 points):
A functions `f` is a __left inverse__ to a function `g` if `f ∘ g = id`.
-/
@[simp] def left_inv {A B : Type} (f : A → B) (g : B → A)  := f ∘ g = id

#check left_inv

/-
A functions `g` is a __right inverse__ to a function `f` if `f ∘ g = id`.
-/

@[simp] def right_inv {A B : Type} (g : B → A) (f : A → B) := f ∘ g = id

/- Complete the proof of the lemma
`inv_of_left_inv_and_right_inv` in below which says that if a function has both a left inverse and a right inverse, then they are equal.
-/

lemma inv_of_left_inv_and_right_inv {A B : Type} (f : A → B) (g : B → A) (k : A → B) (h₁ : left_inv f g) (h₂ : right_inv k g ) :
k = f :=
-- the statement above says that if `f` is a left inverse of `g` and `k` is a right inverse of `g` then `k = f`.
begin
   funext,
   calc
   k x = (id ∘ k) x : sorry
   ... = ((f ∘ g) ∘ k) x : sorry
   ... = f ((g ∘ k) x) : sorry
   ... = f (id x) : sorry
   ... = f x : by sorry,
end

end PROOFS


/-
Copyright (c) 2021 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.W.basic
import set_theory.cardinal.ordinal

/-!
# Cardinality of W-types

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file proves some theorems about the cardinality of W-types. The main result is
`cardinal_mk_le_max_aleph_0_of_fintype` which says that if for any `a : α`,
`β a` is finite, then the cardinality of `W_type β` is at most the maximum of the
cardinality of `α` and `ℵ₀`.
This can be used to prove theorems about the cardinality of algebraic constructions such as
polynomials. There is a surjection from a `W_type` to `mv_polynomial` for example, and
this surjection can be used to put an upper bound on the cardinality of `mv_polynomial`.

## Tags

W, W type, cardinal, first order
-/
universe u

variables {α : Type u} {β : α → Type u}

noncomputable theory

namespace W_type

open_locale cardinal

open cardinal

lemma cardinal_mk_eq_sum : #(W_type β) = sum (λ a : α, #(W_type β) ^ #(β a)) :=
begin
  simp only [cardinal.power_def, ← cardinal.mk_sigma],
  exact mk_congr (equiv_sigma β)
end

/-- `#(W_type β)` is the least cardinal `κ` such that `sum (λ a : α, κ ^ #(β a)) ≤ κ` -/
lemma cardinal_mk_le_of_le {κ : cardinal.{u}} (hκ : sum (λ a : α, κ ^ #(β a)) ≤ κ) :
  #(W_type β) ≤ κ :=
begin
  induction κ using cardinal.induction_on with γ,
  simp only [cardinal.power_def, ← cardinal.mk_sigma, cardinal.le_def] at hκ,
  cases hκ,
  exact cardinal.mk_le_of_injective (elim_injective _ hκ.1 hκ.2)
end

/-- If, for any `a : α`, `β a` is finite, then the cardinality of `W_type β`
  is at most the maximum of the cardinality of `α` and `ℵ₀`  -/
lemma cardinal_mk_le_max_aleph_0_of_finite [∀ a, finite (β a)] : #(W_type β) ≤ max (#α) ℵ₀ :=
(is_empty_or_nonempty α).elim
  (begin
    introI h,
    rw [cardinal.mk_eq_zero (W_type β)],
    exact zero_le _
  end) $
λ hn, let m := max (#α) ℵ₀ in cardinal_mk_le_of_le $
calc cardinal.sum (λ a, m ^ #(β a))
    ≤ #α * ⨆ a, m ^ #(β a) : cardinal.sum_le_supr _
... ≤ m * ⨆ a, m ^ #(β a) : mul_le_mul' (le_max_left _ _) le_rfl
... = m : mul_eq_left.{u} (le_max_right _ _)
  (csupr_le' $ λ i, pow_le (le_max_right _ _) (lt_aleph_0_of_finite _)) $
  pos_iff_ne_zero.1 $ order.succ_le_iff.1
    begin
      rw succ_zero,
      obtain ⟨a⟩ : nonempty α, from hn,
      refine le_trans _ (le_csupr (bdd_above_range.{u u} _) a),
      rw ←power_zero,
      exact power_le_power_left (pos_iff_ne_zero.1
        (aleph_0_pos.trans_le (le_max_right _ _))) (zero_le _)
    end

end W_type


import data.nat.prime algebra.big_operators M3P14.Arithmetic_functions.sum_over_divisors

open nat

-- mobius function

-- taken from M3P14 sheet 1
def square_free_int (n : ℕ) := ∀ p : ℕ, prime p ∧ (p ∣ n → ¬ (p^2 ∣ n))

-- number of prime divisors of n, not counting multiplicities
def primes_div_nodup (n : ℕ) := n.factors.erase_dup.length
local notation `ω` := primes_div_nodup
--#eval ω 30

--number of prime divisors of n, counting multiplicities
def primes_div_dup (n : ℕ) := n.factors.length
local notation `Ω` := primes_div_dup
--#eval Ω 300

local attribute [instance] classical.prop_decidable

noncomputable def mobius (n : ℕ) : int :=
if square_free_int n ∧ (2 ∣ ω n) then 1 else
if square_free_int n ∧ ¬(2 ∣ ω n) then -1
else 0

local notation `μ`  := mobius

theorem mob_mul (m n : ℕ) : μ (m*n) = (μ m ) * (μ n) := sorry

lemma non_coprime (m n : ℕ) : (gcd m n) > 1 → μ (m * n) = 0 := sorry

--theorem mob_sum (n d : ℕ) (hp : n ≠ 1) (hq: d ∣ n) : divisor_sum mobius n = 0 := sorry

--def mertens_func (n k : ℕ) := sum k μ n

--theorem mobius_inv (m n : ℕ) (f : ℕ → ℕ) (g : ℕ → ℕ) : (g n = sum f d) → (f n = sum (μ d) * g (n / d) ) := sorry


/-
Copyright (c) 2023 Huub Vromen. All rights reserved.
Author: Huub Vromen
-/

import data.set.basic
/-- A set-theoretic semantics for Aristotle's assertoric syllogisms is used by
    many authors. See, for instance, Smith, 1989.
    Terms are interpreted as non-empty subsets of some set of individuals. -/

variable {α : Type}
variable {x : α}
variables {A B C : set α}
-- *** how can I stipulate that these sets have to be nonempty?

/-- semantics of the `a` relation -/
def universal_affirmative (A: set α) (B: set α) : Prop :=
  A ∩ B = B
infixr ` a ` : 80 := universal_affirmative

/-- semantics of the `e` relation -/
def universal_negative (A: set α) (B: set α) : Prop :=
  A ∩ B = ∅
infixr ` e ` : 80 := universal_negative

/-- semantics of the `i` relation -/
def particular_affirmative (A: set α) (B: set α) : Prop :=
  (A ∩ B).nonempty
infixr ` i ` : 80 := particular_affirmative

/-- semantics of the `o` relation -/
def particular_negative (A: set α) (B: set α) : Prop :=
  A ∩ B ≠ B
infixr ` o ` : 80 := particular_negative

/-- semantics of contradictory: contradictory is defined as negation -/
def c (p : Prop) : Prop := ¬ p

/-- first, we prove a helpful lemma -/
lemma inter_empty (h1 : A e B) : x ∈ B → x ∉ A :=
begin
rw universal_negative at h1,
intro h2,
by_contra h3,
have h4 : x ∈ A ∩ B, from set.mem_inter h3 h2,
have h5 : (A ∩ B).nonempty, from exists.intro x h4,
have h6 : A ∩ B ≠ ∅, from set.nonempty.ne_empty h5,
show false, from h6 h1
end

/--  Now, we prove the soundness of the axiom system DR -/

lemma Barbara₁ : A a B → B a C → A a C :=
begin
intros h1 h2,
rw universal_affirmative at *,
calc A ∩ C
    = A ∩ (B ∩ C) : by rw h2
... = (A ∩ B) ∩ C : by tidy
... = B ∩ C : by rw h1
... = C : by rw h2
end

lemma Celarent₁ : A e B → B a C → A e C :=
begin
  intros h1 h2,
  rw universal_negative at *,
  rw universal_affirmative at h2,
  calc A ∩ C
      = A ∩ (B ∩ C): by rw h2
  ... = (A ∩ B) ∩ C: by tidy
  ... = ∅ ∩ C : by rw h1
  ... = ∅ : by simp,
end

lemma e_conv : A e B → B e A :=
begin
intro h1,
rw universal_negative at *,
cc,
end

lemma a_conv : (A a B ∧ B.nonempty) → B i A :=
  begin
  intro h1,
  cases h1.2 with p hp,
  rw particular_affirmative,
  rw universal_affirmative at h1,
  cc,
  end

lemma contr {p r : Prop} : (c r → c p) → p → r :=
begin
intros h1,
contrapose!,
assumption
end

/-- we can also prove the contradictories axioms -/

lemma contr_a : c (A a B) = A o B := by simp [c, particular_negative, universal_affirmative]

lemma contr_e : c (A e B) = A i B :=
begin
simp [c, particular_affirmative, universal_negative],
exact set.ne_empty_iff_nonempty
end

lemma contr_i : c (A i B) = A e B :=
begin
simp [c, particular_affirmative, universal_negative],
exact set.not_nonempty_iff_eq_empty
end

lemma contr_o : c (A o B) = A a B := by simp [c, particular_negative, universal_affirmative]

/-- it is, of course, also possible to prove the redundant axioms  -/

lemma Darii₁ : A a B → B i C → A i C :=
begin
intros h1 h2,
--simp [universal_affirmation, particular_affirmation] at *,
--by_contra h3,
cases h2 with p hp,
cases hp,
rw universal_affirmative at h1,
have h4 : p ∈ A ∩ B, by cc,
exact exists.intro p (and.intro h4.left hp_right),
end

lemma Ferio₁ : A e B → B i C → A o C :=
begin
  intros h1 h2,
  cases h2 with p h,
  rw particular_negative,
  cases h with hb hc,
  have h3 : p ∉ A, by exact inter_empty h1 hb,
  simp,
  by_contra h4,
  rw ← h4 at hc,
  show false, from h3 hc.1
end

lemma i_conv : A i B → B i A :=
begin
intros h1,
cases h1 with p h2,
cases h2 with q r,
exact exists.intro p (and.intro r q)
end

#lint


-- Example for seminar announcement

import data.zmod.basic -- import relevant part of the library

-- First state and prove the two lemmas that we will need.

/- The first lemma says that `7` is not a sum of three squares in `ℤ/8ℤ`.
This is a finite problem; `dec_trivial` can prove such statements. -/
lemma three_squares_mod_8 : ∀ a b c : zmod 8, a^2 + b^2 + c^2 ≠ 7 := dec_trivial

-- The second lemma says that when `x^2 + y^2 + z^2` is divisible by `4`
-- (where `x`, `y`, `z` are in `ℕ`), then `x`, `y` and `z` are even.
lemma three_squares_even : ∀ x y z : ℕ, 4 ∣ x^2 + y^2 + z^2 → 2 ∣ x ∧ 2 ∣ y ∧ 2 ∣ z :=
begin
  -- we first formulate the corresponding statement in `ℤ/4ℤ`
  have h₂ : ∀ a b c : zmod 4,
            a^2 + b^2 + c^2 = 0 → (a = 0 ∨ a = 2) ∧ (b = 0 ∨ b = 2) ∧ (c = 0 ∨ c = 2)
  := dec_trivial, -- again a finite problem
  -- now we need a statement that allows us to translate from `ℤ/4ℤ` to `ℕ`
  have h₄ : ∀ x : ℕ, (x : zmod 4) = 0 ∨ (x : zmod 4) = 2 → 2 ∣ x :=
  begin
    rintros x (hx₁ | hx₂), -- two goals with different assumptions on `x`
    { -- here we assume that `x ≡ 0 mod 4`
      have hx₁' := (zmod.nat_coe_zmod_eq_zero_iff_dvd x 4).mp hx₁,
      rw (show 4 = 2*2, from by norm_num) at hx₁',
      exact dvd_of_mul_left_dvd hx₁', },
    { -- here we assume that `x ≡ 2 mod 4`
      have hx₂' : x % 4 = 2 % 4 := (zmod.nat_coe_eq_nat_coe_iff' _ _ _).mp hx₂,
      apply_fun (λ z, z % 2) at hx₂', -- reduce mod `2`
      rw [nat.mod_mod_of_dvd _ (by norm_num : 2 ∣ 4)] at hx₂',
      norm_num at hx₂', -- replace `2 % 4 % 2` by `0`
      exact nat.dvd_of_mod_eq_zero hx₂', },
  end,
  -- now use `h₂` and `h₄` to prove the claim
  intros x y z h,
  have h' := (zmod.nat_coe_zmod_eq_zero_iff_dvd _ _).mpr h, -- write as equality in `ℤ/4ℤ`
  push_cast at h',
  cases h₂ x y z h' with hx hyz,
  cases hyz with hy hz,
  split,
  { apply h₄ x, exact hx, },
  split,
  { apply h₄ y, exact hy, },
  apply h₄ z, exact hz,
  -- rcases h₂ x y z h' with ⟨hx, hy, hz⟩,
  -- exact ⟨h₄ x hx, h₄ y hy, h₄ z hz⟩,
end

-- Now we state the theorem:
-- A natural number of the form `4^k * (8*m + 7)` is not a sum of three squares
theorem three_squares (k m : ℕ) : ¬ ∃ x y z : ℕ, x^2 + y^2 + z^2 = 4^k*(8*m + 7) :=
begin
  push_neg, -- change to `∀ x y z, x^2 + y^2 + z^2 ≠ 4^k*(8*m+7)`
  intros x y z hxyz, -- now we have to show a contradiction
  -- we do induction on `k`, but with the statement `∀ x y z, ...`
  induction k with k ih generalizing x y z,
  { -- the base case: `k = 0`
    apply_fun (coe : ℕ → zmod 8) at hxyz, -- reduce mod `8`
    norm_num at hxyz, -- simplify and apply `three_squares_mod_8`
    exact three_squares_mod_8 x y z hxyz, },
  { -- the inductive step; `ih` is the induction hypothesis
    rw [pow_succ _ k, mul_assoc] at hxyz, -- replace `4^(k+1)*...` by `4*(4^k*...)`
    have h : 4 ∣ x^2 + y^2 + z^2 :=
    begin
      change ∃ a : ℕ, x^2 + y^2 + z^2 = 4*a,
      use 4 ^ k * (8 * m + 7),
      exact hxyz,
    end,
    -- ⟨4^k*(8*m+7), hxyz⟩,
    -- it follows that `x`, `y` and `z` are divisible by `2`
    -- we need to spell this out, so that we can replace `x` by `2*x₁` etc.
    rcases three_squares_even x y z h with ⟨⟨x₁, hx₁⟩, ⟨y₁, hy₁⟩, ⟨z₁, hz₁⟩⟩,
    rw [hx₁, hy₁, hz₁,
        -- the following does the calculation that allows us to cancel `4*...`
        (by ring : (2*x₁)^2 + (2*y₁)^2 + (2*z₁)^2 = 4*(x₁^2 + y₁^2 + z₁^2))] at hxyz,
    exact ih x₁ y₁ z₁ (mul_left_cancel₀ (by norm_num : 4 ≠ 0) hxyz), },
end

open nat

/-- Helper lemma for gcds -/
lemma gcd_mul_coprime {a b : ℕ} (c : ℕ) (h₁ : gcd a b = 1) : (gcd a c) * (gcd b c) = gcd (a*b) c :=
begin
  -- this is `nat.coprime.gcd_mul` up to the symmetry of `gcd`
  rw [gcd_comm a, gcd_comm b, gcd_comm (a*b), coprime.gcd_mul _ h₁],
end

/- Descent Lemma -/
lemma descent {a b c : ℕ} (h₁ : gcd a b = 1) (h₂ : a*b = c^2) : ∃ u v, a = u^2 ∧ b = v^2 ∧ c = u*v :=
begin
  cases eq_or_ne c 0 with hc hc,
  -- first deal with the case `c = 0`
  { simp [hc] at *,
    cases h₂ with h₀ h₀,
    all_goals { simp [h₀] at *, simp [h₁] },
    { use [0, 1], simp, },
    { use [1, 0], simp, } },
  -- now `c ≠ 0`; this implies that `a*b ≠ 0`
  have h₀ : a*b ≠ 0,
  { intro h, rw h at h₂, exact hc (pow_eq_zero h₂.symm), },
  -- we can take `u = gcd a c` and `v = gcd b c`
  use [gcd a c, gcd b c],
  -- prove the last statement
  have h₃ : (gcd a c) * (gcd b c) = c,
  { rw [gcd_mul_coprime c h₁, h₂, pow_two, gcd_mul_left_left], },
  -- this implies `u^2 * v^2 = a*b`
  have h₄ : (gcd a c)^2 * (gcd b c)^2 = a*b,
  { rw h₂, conv_rhs {rw [← h₃]}, ring, },
  -- since `a` and `b` are coprime, `a` is coprime to `v^2`
  have ha : coprime a ((gcd b c)^2),
  { rw [coprime_pow_right_iff (by norm_num : 0 < 2), nat.gcd_comm],
    exact coprime.gcd_right c h₁, },
  -- similarly, `b` is coprime to `u^2`
  have hb : coprime b ((gcd a c)^2),
  { rw [coprime_pow_right_iff (by norm_num : 0 < 2), nat.gcd_comm],
    have h₁' : gcd b a = 1, { rw nat.gcd_comm, exact h₁, },
    exact coprime.gcd_right c h₁', },
  -- we deduce that `a` divides `u^2` and `b` divides `v^2`
  have ha' : a ∣ (gcd a c)^2,
  { refine coprime.dvd_of_dvd_mul_left ha _,
    rw [mul_comm, h₄],
    exact dvd_mul_right a b, },
  have hb' : b ∣ (gcd b c)^2,
  { refine coprime.dvd_of_dvd_mul_left hb _,
    rw [h₄],
    exact dvd_mul_left b a, },
  -- write `u^2 = a * r` and `v^2 = b * s`
  cases ha' with r hr,
  cases hb' with s hs,
  -- then `(a*b) * (r*s) = a*b`, which implies `r*s = 1`
  rw [hr, hs, mul_comm b, mul_assoc, ← mul_assoc r, mul_comm _ b, ← mul_assoc] at h₄,
  nth_rewrite 1 ← mul_one (a * b) at h₄,
  have hrs := mul_left_cancel₀ h₀ h₄,
  -- and therefore `r = s = 1`
  rw [eq_one_of_mul_eq_one_right hrs, mul_one] at hr,
  rw [eq_one_of_mul_eq_one_left hrs, mul_one] at hs,
  exact ⟨hr.symm, hs.symm, h₃.symm⟩,
end


/-
This file contains the definition of a Boolean (disjunctive) clause.
This particular implementation has clauses as lists.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon Univeristy
-/

import cnf.literal
import cnf.assignment
import basic

import data.list.basic

universe u

-- Represents the parametric type of the variable stored in the literal
variables {V : Type*}

/- Disjunctive clauses are lists of literals, joined by logical ORs. -/
def clause (V : Type*) := list (literal V)

-- Note that the above definition allows for duplication of literals, whereas
-- a set definition would not. Lists also allow for computable functions,
-- while Lean sets are noncomputable by default

namespace clause

open function
open literal
open list

/-! # Properties -/

-- Many of these properties follow directly from lists

instance [inhabited V] : inhabited (clause V) := ⟨[arbitrary (literal V)]⟩

instance has_decidable_eq [decidable_eq V] : decidable_eq (clause V)
| []        []        := is_true rfl
| (a :: as) []        := is_false (λ h, list.no_confusion h)
| []        (b :: bs) := is_false (λ h, list.no_confusion h)
| (a :: as) (b :: bs) :=
  match (literal.decidable_eq V) a b with
  | is_true hab  :=
    match has_decidable_eq as bs with
    | is_true h := is_true (eq.subst hab (eq.subst h rfl))
    | is_false hf := is_false (λ h, list.no_confusion h (λ _ ha, absurd ha hf))
    end
  | is_false hf := is_false (λ h, list.no_confusion h (λ hab _, absurd hab hf))
  end

instance : has_mem (literal V) (clause V) := ⟨list.mem⟩
instance : has_emptyc (clause V) := ⟨list.nil⟩ -- Refactor empty into [] below?
instance [decidable_eq V] : has_union (clause V) := ⟨list.union⟩
instance [decidable_eq V] : has_inter (clause V) := ⟨list.inter⟩
instance : has_singleton (literal V) (clause V) := ⟨λ l, [l]⟩
instance [decidable_eq V] : has_insert (literal V) (clause V) := ⟨list.insert⟩
instance : has_append (clause V) := ⟨list.append⟩
instance : has_subset (clause V) := ⟨list.subset⟩
instance [has_repr V] : has_repr (clause V) := ⟨list.repr⟩

instance [decidable_eq V] (l : literal V) (c : clause V) : decidable (l ∈ c) :=
by apply_instance

/-! # eval -/
section eval

variables (τ : assignment V) (l : literal V) (c c₁ c₂ : clause V)

protected def eval : bool := c.foldr (λ l b, b || (l.eval τ)) ff

@[simp] theorem eval_nil : clause.eval τ [] = ff := rfl

@[simp] theorem eval_singleton : clause.eval τ [l] = l.eval τ :=
by simp only [clause.eval, foldr, ff_bor]

@[simp] theorem eval_cons : clause.eval τ (l :: c) = (l.eval τ) || (c.eval τ) :=
by simp only [clause.eval, foldr, bool.bor_comm]

theorem eval_append : clause.eval τ (c₁ ++ c₂) = c₁.eval τ || c₂.eval τ :=
begin
  unfold clause.eval,
  rw foldr_append,
  cases foldr (λ l b, b || literal.eval τ l) ff c₂,
  { rw bor_ff },
  { rw [bor_tt, foldr_bor_tt] }
end

theorem eval_tt_iff_exists_literal_eval_tt {τ : assignment V} {c : clause V} :
  c.eval τ = tt ↔ ∃ l, l ∈ c ∧ literal.eval τ l = tt :=
begin
  induction c with l ls ih,
  { simp only [eval_nil, not_mem_nil, false_and, exists_false] },
  { simp only [eval_cons, bor_eq_true_eq_eq_tt_or_eq_tt, mem_cons_iff],
    split,
    { rintros (h | h),
      { use [l, or.inl rfl, h] },
      { rcases ih.mp h with ⟨l₂, hl, he⟩,
        use [l₂, mem_cons_of_mem l hl, he] } },
    { rintros ⟨l₂, (rfl | hl), he⟩,
      { exact or.inl he },
      { exact or.inr (ih.mpr ⟨l₂, hl, he⟩) } } }
end

theorem eval_ff_iff_forall_literal_eval_ff {τ : assignment V} {c : clause V} :
  clause.eval τ c = ff ↔ ∀ l, l ∈ c → literal.eval τ l = ff :=
begin
  induction c with l ls ih,
  { simp only [eval_nil, eq_self_iff_true, not_mem_nil, is_empty.forall_iff, implies_true_iff] },
  { simp only [ih, eval_cons, bor_eq_false_eq_eq_ff_and_eq_ff, mem_cons_iff, forall_eq_or_imp] }
end

theorem eval_tautology {c : clause V} {l : literal V} :
  l ∈ c → l.flip ∈ c → ∀ (τ : assignment V), clause.eval τ c = tt :=
begin
  intros hl hlf τ,
  apply eval_tt_iff_exists_literal_eval_tt.mpr,
  cases h : (literal.eval τ l),
  { exact ⟨l.flip, hlf, eval_flip_of_eval h⟩ },
  { exact ⟨l, hl, h⟩ }
end

theorem eval_tt_of_subset_eval_tt {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ ⊆ c₂ → clause.eval τ c₁ = tt → clause.eval τ c₂ = tt :=
begin
  intros h₁ h₂,
  apply eval_tt_iff_exists_literal_eval_tt.mpr,
  rcases eval_tt_iff_exists_literal_eval_tt.mp h₂ with ⟨l, hl, he⟩,
  exact ⟨l, h₁ hl, he⟩
end

theorem eval_ff_of_superset_eval_ff {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ ⊆ c₂ → clause.eval τ c₂ = ff → clause.eval τ c₁ = ff :=
begin
  intros h₁ h₂,
  apply eval_ff_iff_forall_literal_eval_ff.mpr,
  intros l hl,
  exact (eval_ff_iff_forall_literal_eval_ff.mp h₂) l (h₁ hl)
end

theorem eval_tt_of_sublist_eval_tt {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ <+ c₂ → clause.eval τ c₁ = tt → clause.eval τ c₂ = tt :=
assume h₁, eval_tt_of_subset_eval_tt (sublist.subset h₁)

theorem eval_ff_of_superlist_eval_ff {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ <+ c₂ → clause.eval τ c₂ = ff → clause.eval τ c₁ = ff :=
assume h₁, eval_ff_of_superset_eval_ff (sublist.subset h₁)

theorem eval_tt_cons_of_eval_tt {τ : assignment V} {c : clause V} (l : literal V) :
  clause.eval τ c = tt → clause.eval τ (l :: c) = tt :=
assume h, eval_tt_of_sublist_eval_tt (sublist_cons l c) h

theorem eval_ff_of_eval_ff_cons {τ : assignment V} {c : clause V} {l : literal V} :
  clause.eval τ (l :: c) = ff → clause.eval τ c = ff :=
assume h, eval_ff_of_superlist_eval_ff (sublist_cons l c) h

end eval

/-! ### Counting -/
section counting

variables (τ : assignment V) (l : literal V) (c c₁ c₂ : clause V)

protected def count_tt : nat := c.countp (literal.is_true τ)
protected def count_ff : nat := c.countp (literal.is_false τ)

def count_pos (c : clause V) : nat := c.countp literal.is_pos
def count_neg (c : clause V) : nat := c.countp literal.is_neg

@[simp] lemma count_tt_nil : clause.count_tt τ [] = 0 := rfl
@[simp] lemma count_ff_nil : clause.count_ff τ [] = 0 := rfl
@[simp] lemma count_pos_nil : count_pos ([] : clause V) = 0 := rfl
@[simp] lemma count_neg_nil : count_neg ([] : clause V) = 0 := rfl

@[simp] theorem count_tt_singleton : clause.count_tt τ [l] = cond (l.eval τ) 1 0 :=
by cases h : (l.eval τ); simp [h, clause.count_tt, literal.is_true]

@[simp] theorem count_ff_singleton : clause.count_ff τ [l] = cond (l.eval τ) 0 1 :=
by cases h : (l.eval τ); simp [h, clause.count_ff, literal.is_false]

@[simp] theorem count_pos_singleton : count_pos [l] = cond l.is_pos 1 0 :=
by cases l; simp [count_pos, literal.is_pos]

@[simp] theorem count_neg_singleton : count_neg [l] = cond l.is_neg 1 0 :=
by cases l; simp [count_neg, literal.is_neg]

@[simp] theorem count_tt_cons : clause.count_tt τ (l :: c) = cond (l.eval τ) (1 + c.count_tt τ) (c.count_tt τ) :=
by cases h : (l.eval τ); simp [h, literal.is_true, clause.count_tt, add_comm]

@[simp] theorem count_ff_cons : clause.count_ff τ (l :: c) = cond (l.eval τ) (c.count_ff τ) (1 + c.count_ff τ) :=
by cases h : (l.eval τ); simp [h, literal.is_false, clause.count_ff, add_comm]

@[simp] theorem count_pos_cons : count_pos (l :: c) = cond l.is_pos (1 + c.count_pos) c.count_pos :=
by cases l; simp [count_pos, literal.is_pos, add_comm]

@[simp] theorem count_neg_cons : count_neg (l :: c) = cond l.is_neg (1 + c.count_neg) c.count_neg :=
by cases l; simp [count_neg, literal.is_neg, add_comm]

theorem count_tt_append : clause.count_tt τ (c₁ ++ c₂) = clause.count_tt τ c₁ + clause.count_tt τ c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [count_tt_nil, zero_add, nil_append] },
  { cases h : (literal.eval τ l); simp [h, ih, add_assoc] }
end

theorem count_ff_append : clause.count_ff τ (c₁ ++ c₂) = clause.count_ff τ c₁ + clause.count_ff τ c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [count_ff_nil, zero_add, nil_append] },
  { cases h : (literal.eval τ l); { simp [h, ih, add_assoc] } }
end

theorem count_pos_append : clause.count_pos (c₁ ++ c₂) = clause.count_pos c₁ + clause.count_pos c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [nil_append, count_pos_nil, zero_add] },
  { cases l; simp [ih, literal.is_pos, add_assoc] }
end

theorem count_neg_append : clause.count_neg (c₁ ++ c₂) = clause.count_neg c₁ + clause.count_neg c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [nil_append, count_neg_nil, zero_add] },
  { cases l; { simp [ih, literal.is_neg, add_assoc] } }
end

theorem count_tt_le_length : c.count_tt τ ≤ c.length :=
by simp only [clause.count_tt, countp_eq_length_filter, length_filter]

theorem count_ff_le_length : c.count_ff τ ≤ c.length :=
by simp only [clause.count_ff, countp_eq_length_filter, length_filter]

theorem count_pos_le_length : c.count_pos ≤ c.length :=
by simp only [count_pos, countp_eq_length_filter, length_filter]

theorem count_neg_le_length : c.count_neg ≤ c.length :=
by simp only [count_neg, countp_eq_length_filter, length_filter]

theorem count_tt_plus_count_ff_eq_length (τ : assignment V) (c : clause V) :
  c.count_tt τ + c.count_ff τ = c.length :=
begin
  induction c with l ls ih,
  { simp },
  { cases h : (l.eval τ);
    simp [count_tt_cons, count_ff_cons, h, ← ih],
    { rw [add_assoc, add_comm (clause.count_ff τ ls) 1] },
    { rw [add_comm (clause.count_tt τ ls + clause.count_ff τ ls) 1, ← add_assoc] } }
end

theorem count_tt_eq_length_sub_count_ff : c.count_tt τ = c.length - c.count_ff τ :=
eq_tsub_of_add_eq (count_tt_plus_count_ff_eq_length τ c)

theorem count_ff_eq_length_sub_count_tt : c.count_ff τ = c.length - c.count_tt τ :=
eq_tsub_of_add_eq (add_comm (c.count_tt τ) (c.count_ff τ) ▸ count_tt_plus_count_ff_eq_length τ c)

theorem count_pos_plus_count_neg_eq_length : c.count_pos + c.count_neg = c.length :=
begin
  induction c with l ls ih,
  { simp },
  { cases l;
    simp [count_pos_cons, count_neg_cons, literal.is_pos, literal.is_neg, ← ih],
    { rw [add_comm (count_pos ls + count_neg ls) 1, ← add_assoc] },
    { rw [add_assoc, add_comm 1] } }
end

theorem count_pos_eq_length_sub_count_neg : c.count_pos = c.length - c.count_neg :=
eq_tsub_of_add_eq (count_pos_plus_count_neg_eq_length c)

theorem count_neg_eq_length_sub_count_pos : c.count_neg = c.length - c.count_pos :=
eq_tsub_of_add_eq (add_comm (c.count_pos) (c.count_neg) ▸ count_pos_plus_count_neg_eq_length c)

theorem count_tt_eq_zero_iff_eval_ff {τ : assignment V} {c : clause V} :
  c.count_tt τ = 0 ↔ c.eval τ = ff :=
begin
  rw [clause.count_tt, countp_eq_zero, eval_ff_iff_forall_literal_eval_ff],
  split,
  { intros hc l hl,
    have := hc l hl,
    rw [literal.is_true, eq_ff_eq_not_eq_tt] at this,
    exact this },
  { intros hl a ha, simp [literal.is_true, hl a ha] }
end

theorem count_tt_gt_zero_iff_eval_tt {τ : assignment V} {c : clause V} :
  c.count_tt τ > 0 ↔ c.eval τ = tt :=
begin
  rw [clause.count_tt, eval_tt_iff_exists_literal_eval_tt],
  split,
  { intro hp,
    rcases (countp_pos _).mp hp with ⟨l, hl, he⟩,
    exact ⟨l, hl, he⟩ },
  { rintro ⟨l, hl, he⟩,
    exact (countp_pos _).mpr ⟨l, hl, he⟩ }
end

end counting

/-! # falsify and truthify -/
section falsify

variables (τ : assignment V) (v : V) (l : list V) {c c₁ c₂ : clause V}

-- For any assignment and variables, there is a clause that evaluates to false
-- Simply map each variable in the list to the literal which evaluates to false
def falsify : clause V := l.map (λ v, cond (τ v) (Neg v) (Pos v))
def truthify : clause V := l.map (λ v, cond (τ v) (Pos v) (Neg v))

@[simp] lemma falsify_nil : falsify τ [] = [] := rfl
@[simp] lemma truthify_nil : truthify τ [] = [] := rfl

@[simp] lemma falsify_singleton : falsify τ [v] = cond (τ v) [Neg v] [Pos v] :=
by cases h : τ v; simp [h, falsify]

@[simp] lemma truthify_singleton : truthify τ [v] = cond (τ v) [Pos v] [Neg v] :=
by cases h : τ v; simp [h, truthify]

@[simp] theorem falsify_cons : falsify τ (v :: l) = cond (τ v) (Neg v :: falsify τ l) (Pos v :: falsify τ l) :=
by cases h : τ v; simp [falsify, map_cons, h]

@[simp] theorem truthify_cons : truthify τ (v :: l) = cond (τ v) (Pos v :: truthify τ l) (Neg v :: truthify τ l) :=
by cases h : τ v; simp [truthify, map_cons, h]

theorem falsify_eval_ff : clause.eval τ (falsify τ l) = ff :=
begin
  induction l with v vs ih,
  { rw [falsify_nil, eval_nil] },
  { cases h : (τ v); simp [h, eval_cons, literal.eval, ih] }
end

theorem truthify_eval_tt {l : list V} (hl : l ≠ []) : clause.eval τ (truthify τ l) = tt :=
begin
  induction l with v vs ih,
  { contradiction },
  { cases h : (τ v); simp [h, literal.eval, eval_cons] }
end

theorem flip_truthify_eq_falsify : map literal.flip (truthify τ l) = falsify τ l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : (τ v); simp [h, literal.eval, ih, literal.flip] }
end

theorem falsify_map_var_eq : map var (falsify τ l) = l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : (τ v);
    { simp only [falsify_cons, map_cons, h, var, true_and, eq_self_iff_true, cond],
      exact ih } }
end

theorem truthify_map_var_eq : map var (truthify τ l) = l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : (τ v);
    { simp only [truthify_cons, map_cons, h, var, true_and, eq_self_iff_true, cond],
      exact ih } }
end

theorem count_tt_falsify : clause.count_tt τ (falsify τ l) = 0 :=
count_tt_eq_zero_iff_eval_ff.mpr (falsify_eval_ff τ l)

lemma count_tt_truthify : clause.count_tt τ (truthify τ l) = length l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : τ v; simp [literal.eval, h, ih, add_comm] }
end

theorem count_tt_sublist : c₁ <+ c₂ → c₁.count_tt τ ≤ c₂.count_tt τ :=
assume h, by simp [clause.count_tt, sublist.countp_le (literal.is_true τ) h]

theorem count_ff_sublist : c₁ <+ c₂ → c₁.count_ff τ ≤ c₂.count_ff τ :=
assume h, by simp [clause.count_ff, sublist.countp_le (literal.is_false τ) h]

theorem count_pos_sublist : c₁ <+ c₂ → c₁.count_pos ≤ c₂.count_pos :=
assume h, by simp [count_pos, sublist.countp_le literal.is_pos h]

theorem count_neg_sublist : c₁ <+ c₂ → c₁.count_neg ≤ c₂.count_neg :=
assume h, by simp [count_neg, sublist.countp_le literal.is_neg h]

theorem pos_count_tt_iff_exists_tt {τ} : c.count_tt τ > 0 ↔ ∃ l, l ∈ c ∧ literal.is_true τ l :=
by simp [clause.count_tt, countp_pos]

theorem pos_count_ff_iff_exists_ff {τ} : c.count_ff τ > 0 ↔ ∃ l, l ∈ c ∧ literal.is_false τ l :=
by simp [clause.count_ff, countp_pos]

theorem pos_count_pos_iff_exists_pos : c.count_pos > 0 ↔ ∃ l, l ∈ c ∧ literal.is_pos l :=
by simp [count_pos, countp_pos]

theorem pos_count_neg_iff_exists_neg : c.count_neg > 0 ↔ ∃ l, l ∈ c ∧ literal.is_neg l :=
by simp [count_neg, countp_pos]

theorem count_tt_perm : c₁ ~ c₂ → ∀ (τ : assignment V), c₁.count_tt τ = c₂.count_tt τ :=
begin
  intros hp τ,
  induction hp with x l₂ l₂' p IH  x y l₂  l₂ m₂ r₂ p₁ p₂ IH₁ IH₂,
  { refl },
  { simp [count_tt_cons, IH] },
  { simp [count_tt_cons], cases literal.eval τ x; cases literal.eval τ y; simp },
  { exact eq.trans IH₁ IH₂ }
end

end falsify

/-! # Flip counting -/
section flips

variables [decidable_eq V]

-- If two clauses have the same length, literals can be compared at each
-- position. If they are literal.flip's of each other, increment a counter
def count_flips : clause V → clause V → nat
| []         _        := 0
| _         []        := 0
| (l :: ls) (m :: ms) := ite (l.flip = m)
                         (1 + count_flips ls ms) (count_flips ls ms)

@[simp] lemma count_flips_nil (c : clause V) : count_flips [] c = 0 :=
by cases c; refl

@[simp] theorem count_flips_cons (c₁ c₂ : clause V) (l₁ l₂ : literal V) :
  count_flips (l₁ :: c₁) (l₂ :: c₂) = ite (l₁.flip = l₂)
    (1 + count_flips c₁ c₂) (count_flips c₁ c₂) :=
by by_cases l₁.flip = l₂; simp only [count_flips]

@[simp] theorem count_flips_self (c : clause V) : count_flips c c = 0 :=
begin
  induction c with l ls ih,
  { refl },
  { simp [count_flips, flip_ne, ih] }
end

theorem count_flips_comm (c₁ c₂ : clause V) : count_flips c₁ c₂ = count_flips c₂ c₁ :=
begin
  induction c₁ with l ls ih generalizing c₂,
  { cases c₂; simp [count_flips] },
  { cases c₂,
    { refl },
    { simp [count_flips, ih c₂_tl],
      by_cases h : (l.flip = c₂_hd),
      { simp [h, flip_eq_iff_eq_flip.mp h, flip_flip] },
      { simp [h, ne.symm (flip_ne_iff_ne_flip.mp h), flip_flip] } } }
end

theorem count_flips_pos_of_map_var_eq_of_neq {c₁ c₂ : clause V} :
  map var c₁ = map var c₂ → c₁ ≠ c₂ → count_flips c₁ c₂ > 0 :=
begin
  intros h hne,
  induction c₁ with l ls ih generalizing c₂,
  { exact absurd (eq_nil_of_map_eq_nil h.symm).symm hne },
  { rcases exists_map_cons_of_map_cons h.symm with ⟨x, xs, rfl, hxl, hxs⟩,
    unfold count_flips,
    rcases var_eq_iff_eq_or_flip_eq.mp hxl with rfl | rfl,
    { simp [ih (tail_eq_of_cons_eq h) (ne_tail_of_eq_head_of_ne hne rfl)] },
    { simp [flip_flip, nat.zero_lt_one_add] } }
end

theorem count_flips_falsify_eq_count_tt (τ : assignment V) (c : clause V) :
  count_flips c (falsify τ (map var c)) = clause.count_tt τ c :=
begin
  induction c with l ls ih,
  { simp },
  { cases l; { cases h : (τ l); { simp [var, h, literal.eval, literal.flip, ih] } } }
end

/-! ## Parity reasoning for evaluation -/

theorem eval_tt_of_map_var_eq_of_tt_ne_neg {τ : assignment V} {l : list V} {c : clause V} :
  map var c = l → clause.count_tt τ (map Pos l) ≠ count_neg c → c.eval τ = tt :=
begin
  induction l with v vs ih generalizing c,
  { rw map_eq_nil, rintro rfl, contradiction },
  { intros hc hne,
    rcases exists_cons_of_map_cons hc with ⟨l, ls, rfl, rfl, hls⟩,
    cases l,
    { cases h : τ l,
      { simp [literal.eval, var, literal.is_neg, h] at hne,
        exact eval_tt_cons_of_eval_tt _ (ih hls hne) },
      { simp [literal.eval, h] } },
    { cases h : τ l,
      { simp [literal.eval, h] },
      { simp [literal.eval, var, literal.is_neg, h] at hne,
        exact eval_tt_cons_of_eval_tt _ (ih hls hne) } } }
end

-- Corollary of the above wrt parity reasoning
theorem eval_tt_of_map_var_eq_of_ne_parity {τ : assignment V} {l : list V} {c : clause V} :
  map var c = l → (clause.count_tt τ (map Pos l)).bodd ≠ (count_neg c).bodd → c.eval τ = tt :=
λ hc hcount, eval_tt_of_map_var_eq_of_tt_ne_neg hc (ne_of_apply_ne nat.bodd hcount)

-- Parity reasoning based on flips rather than negs
theorem eval_tt_of_ne_flips {τ : assignment V} {c₁ c₂ : clause V} :
  map var c₁ = map var c₂ → c₁.count_tt τ ≠ count_flips c₁ c₂ → c₂.eval τ = tt :=
begin
  induction c₁ with l ls ih generalizing c₂,
  { simp },
  { intros hc₂ hne,
    rcases exists_map_cons_of_map_cons hc₂.symm with ⟨m, ms, rfl, hm, hms⟩,
    cases m,
    { cases h : (τ m),
      { cases l;
        { unfold var at hm,
          simp [literal.eval, literal.flip, ← hm, h] at hne,
          exact eval_tt_cons_of_eval_tt _ (ih hms.symm hne) } },
      { simp only [eval_cons, literal.eval, hm, h, tt_bor] } },
    { cases h : (τ m),
      { simp only [eval_cons, literal.eval, hm, h, bnot, tt_bor] },
      { cases l;
        { unfold var at hm,
          simp [literal.eval, literal.flip, ← hm, h] at hne,
          exact eval_tt_cons_of_eval_tt _ (ih hms.symm hne) } } } }
end

end flips

/-! # vars -/
section vars

variables [decidable_eq V]

protected def vars : clause V → finset V
| []        := ∅
| (l :: ls) := {l.var} ∪ (vars ls)
--| (l :: ls) := insert l.var (vars ls) -- Use insert instead?

@[simp] theorem vars_nil : clause.vars ([] : clause V) = ∅ := rfl

@[simp] theorem vars_singleton (l : literal V) : clause.vars [l] = {l.var} := rfl

theorem mem_vars_cons_self (l : literal V) (c : clause V) : l.var ∈ clause.vars (l :: c) :=
finset.mem_union_left _ (finset.mem_singleton_self l.var)

theorem mem_vars_cons_of_mem_vars {c : clause V} (l : literal V) {v : V} :
  v ∈ c.vars → v ∈ clause.vars (l :: c) :=
assume h, finset.mem_union.mpr (or.inr h)

theorem vars_append (c₁ c₂ : clause V) : (c₁ ++ c₂).vars = c₁.vars ∪ c₂.vars :=
begin
  induction c₁ with l ls ih,
  { simp only [finset.empty_union, vars_nil, nil_append] },
  { simp only [cons_append, clause.vars, ih, finset.union_assoc], }
end

theorem vars_perm {c₁ c₂ : clause V} : c₁ ~ c₂ → c₁.vars = c₂.vars :=
begin
  intro hp,
  induction hp with _ _ _ _ IH  x y _  _ _ _ _ _ IH₁ IH₂,
  { refl },
  { unfold clause.vars, rw IH },
  { unfold clause.vars,
    rw [← finset.union_assoc, ← finset.union_assoc, finset.union_comm {x.var} {y.var}] },
  { exact eq.trans IH₁ IH₂ }
end

theorem mem_vars_of_mem {c : clause V} {l : literal V} : l ∈ c → l.var ∈ c.vars :=
begin
  induction c with d ds ih,
  { simp },
  { intro hl,
    rcases eq_or_ne_mem_of_mem hl with rfl | hm,
    { exact finset.mem_union.mpr (or.inl (finset.mem_singleton_self l.var)) },
    { exact finset.mem_union.mpr (or.inr (ih hm.2)) } }
end

theorem exists_mem_clause_of_mem_vars {c : clause V} {v : V} :
  v ∈ c.vars → ∃ (l : literal V), l ∈ c ∧ l.var = v :=
begin
  induction c with l ls ih,
  { simp },
  { intro hmem,
    by_cases h : (l.var = v),
    { use [l, mem_cons_self l ls, h] },
    { rcases finset.mem_union.mp hmem with h₁| h₂,
      { exact absurd (finset.mem_singleton.mp h₁).symm h },
      { rcases ih h₂ with ⟨m, hm, hv⟩, use [m, mem_cons_of_mem l hm, hv] } } }
end

theorem vars_subset_of_vars_cons (l : literal V) (c : clause V) : c.vars ⊆ clause.vars (l :: c) :=
finset.subset_union_right _ _

theorem vars_subset_of_subset {c₁ c₂ : clause V} : c₁ ⊆ c₂ → c₁.vars ⊆ c₂.vars :=
begin
  intros h v hv,
  rcases exists_mem_clause_of_mem_vars hv with ⟨l, hl, rfl⟩,
  exact mem_vars_of_mem (h hl)
end

section mem_vars_lemmas

variables {v : V} {c : clause V}

-- (map var c) and vars c are equivalent from a set perspective
theorem mem_vars_iff_mem_map_vars : v ∈ c.vars ↔ v ∈ map var c :=
begin
  split,
  { intro h,
    exact mem_map.mpr (exists_mem_clause_of_mem_vars h) },
  { intro h,
    rcases mem_map.mp h with ⟨l, hmem, hv⟩,
    exact hv ▸ mem_vars_of_mem hmem }
end

theorem not_mem_vars_iff_not_mem_map_vars : v ∉ map var c ↔ v ∉ c.vars :=
by simp [mem_vars_iff_mem_map_vars]

theorem mem_vars_iff_pos_or_neg_mem_clause : v ∈ c.vars ↔ (Pos v) ∈ c ∨ (Neg v) ∈ c :=
begin
  split,
  { intro h,
    rcases exists_mem_clause_of_mem_vars h with ⟨l, hmem, hv⟩,
    cases l; { rw ← hv, simp [var, hmem] } },
  { rintros (h | h); { exact mem_vars_of_mem h } }
end

theorem vars_append_subset_left (c₁ c₂ : clause V) : c₁.vars ⊆ (c₁ ++ c₂).vars :=
by { rw vars_append, exact finset.subset_union_left _ _ }

theorem vars_append_subset_right (c₁ c₂ : clause V) : c₂.vars ⊆ (c₁ ++ c₂).vars :=
by { rw vars_append, exact finset.subset_union_right _ _ }

theorem mem_vars_append_left {c₁ : clause V} (c₂) : v ∈ c₁.vars → v ∈ (c₁ ++ c₂).vars :=
assume h, vars_append_subset_left c₁ c₂ h

theorem mem_vars_append_right (c₁) {c₂ : clause V} : v ∈ c₂.vars → v ∈ (c₁ ++ c₂).vars :=
assume h, vars_append_subset_right c₁ c₂ h

theorem mem_left_or_right_of_mem_vars_append {c₁ c₂ : clause V} :
  v ∈ (c₁ ++ c₂).vars → (v ∈ c₁.vars) ∨ (v ∈ c₂.vars) :=
by { rw vars_append, exact finset.mem_union.mp }

theorem not_mem_vars_append_left {c₁ c₂ : clause V} : v ∉ (c₁ ++ c₂).vars → v ∉ c₁.vars :=
assume h, mt (mem_vars_append_left c₂) h

theorem not_mem_vars_append_right {c₁ c₂ : clause V} : v ∉ (c₁ ++ c₂).vars → v ∉ c₂.vars :=
assume h, mt (mem_vars_append_right c₁) h

theorem not_mem_vars_append_of_not_mem_of_not_mem {c₁ c₂ : clause V} :
  v ∉ c₁.vars → v ∉ c₂.vars → v ∉ (c₁ ++ c₂).vars :=
begin
  intros h₁ h₂ hcon,
  rcases mem_left_or_right_of_mem_vars_append hcon; { contradiction }
end

end mem_vars_lemmas

open assignment

variables {τ₁ τ₂ : assignment V} {c : clause V}

theorem eval_eq_of_eqod : (eqod τ₁ τ₂ c.vars) → c.eval τ₁ = c.eval τ₂ :=
begin
  intro h,
  cases hev : (c.eval τ₂),
  { rw eval_ff_iff_forall_literal_eval_ff at hev,
    apply eval_ff_iff_forall_literal_eval_ff.mpr,
    intros l hl,
    exact hev l hl ▸ eval_eq_of_eqod_of_var_mem h (mem_vars_of_mem hl) },
  { rcases eval_tt_iff_exists_literal_eval_tt.mp hev with ⟨l, hl, htt⟩,
    apply eval_tt_iff_exists_literal_eval_tt.mpr,
    use [l, hl],
    exact htt ▸ eval_eq_of_eqod_of_var_mem h (mem_vars_of_mem hl) }
end

theorem count_tt_eq_of_eqod : (eqod τ₁ τ₂ c.vars) → c.count_tt τ₁ = c.count_tt τ₂ :=
begin
  induction c with l ls ih,
  { simp only [count_tt_nil, eqod_nil, vars_nil, forall_true_left] },
  { intro h,
    rw clause.vars at h,
    cases l;
    { rw literal.var at h,
      simp [literal.eval, eqod_union_left h l (finset.mem_singleton_self l), ih (eqod_union_right h)] } }
end

theorem count_tt_ite (c : clause V) : c.count_tt (assignment.ite c.vars τ₁ τ₂) = c.count_tt τ₁ :=
count_tt_eq_of_eqod (ite_eqod c.vars τ₁ τ₂)

end vars

end clause


/-
Copyright (c) 2020 Ruben Van de Velde. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

! This file was ported from Lean 3 source module main
-/
import Mathlib.Data.Int.Parity
import Mathlib.RingTheory.Int.Basic

--set_option synthInstance.etaExperiment true

section

variable {R : Type _} [CommRing R] {x y z : R}

theorem coprime_add_self_pow {n : ℕ} (hn : 0 < n) (hsoln : x ^ n + y ^ n = z ^ n)
    (hxx : IsCoprime x y) : IsCoprime x z := by
  have := IsCoprime.mul_add_left_right (hxx.pow (n := n) (m := n)) 1
  rwa [mul_one, hsoln, IsCoprime.pow_iff hn hn] at this
#align coprime_add_self_pow coprime_add_self_pow

end

-- Edwards p49 introduction
theorem Int.factor_div (a x : ℤ) (hodd : Odd x) :
    ∃ m c : ℤ, c + m * x = a ∧ 2 * c.natAbs < x.natAbs :=
  by
  have h0' : x ≠ 0 := by
    rintro rfl
    simp only [even_zero, not_true, Int.odd_iff_not_even] at hodd
  set c := a % x with hc
  by_cases H : 2 * c.natAbs < x.natAbs
  · exact ⟨a / x, c, Int.emod_add_ediv' a x, H⟩
  · push_neg  at H
    refine' ⟨(a + abs x) / x, c - abs x, _, _⟩
    · have := self_dvd_abs x
      rw [Int.add_ediv_of_dvd_right this, add_mul, Int.ediv_mul_cancel this, sub_add_add_cancel, hc,
        Int.emod_add_ediv']
    · rw [← Int.ofNat_lt]
      replace H := Int.ofNat_le_ofNat_of_le H
      have ofNat_two : ((2 : Nat) : Int) = 2 := rfl
      rw [Int.ofNat_mul, ofNat_two] at H⊢
      have hcnonneg := Int.emod_nonneg a h0'
      have := Int.emod_lt a h0'
      rw [Int.natAbs_of_nonneg hcnonneg] at H
      rw [← Int.natAbs_neg, neg_sub, Int.natAbs_of_nonneg (sub_nonneg_of_le this.le), mul_sub,
        sub_lt_iff_lt_add, two_mul, Int.abs_eq_natAbs, add_lt_add_iff_left]
      apply lt_of_le_of_ne H
      contrapose! hodd with heqtwomul
      rw [← Int.even_iff_not_odd, ← Int.natAbs_even, ← Int.even_coe_nat, even_iff_two_dvd]
      exact ⟨_, heqtwomul⟩
#align int.factor_div Int.factor_div

theorem two_not_cube (r : ℕ) : r ^ 3 ≠ 2 := by
  have : 1 ≤ 3 := by norm_num
  apply Monotone.ne_of_lt_of_lt_nat (Nat.pow_left_strictMono this).monotone 1 <;> norm_num
#align two_not_cube two_not_cube

nonrec theorem Int.two_not_cube (r : ℤ) : r ^ 3 ≠ 2 := by
  intro H
  apply two_not_cube r.natAbs
  rw [← Int.natAbs_pow, H]
  norm_num
#align int.two_not_cube Int.two_not_cube

-- todo square neg_square and neg_pow_bit0
section

variable {R : Type _} [CommRing R] [IsDomain R] [IsPrincipalIdealRing R] [GCDMonoid R]

theorem Irreducible.coprime_of_not_dvd_of_dvd {p k m : R} (hp : Irreducible p) (hdvd1 : ¬p ∣ m)
    (hdvd2 : k ∣ m) : IsCoprime p k :=
  (Irreducible.coprime_iff_not_dvd hp).mpr fun hdvd1' => hdvd1 (hdvd1'.trans hdvd2)
#align irreducible.coprime_of_not_dvd_of_dvd Irreducible.coprime_of_not_dvd_of_dvd

theorem Irreducible.dvd_of_dvd_mul_left {p k m n : R} (hdvd1 : ¬p ∣ m) (hdvd2 : k ∣ m)
    (hp : Irreducible p) (h : k ∣ p * n) : k ∣ n :=
  (hp.coprime_of_not_dvd_of_dvd hdvd1 hdvd2).symm.dvd_of_dvd_mul_left h
#align irreducible.dvd_of_dvd_mul_left Irreducible.dvd_of_dvd_mul_left

end

theorem Int.dvd_mul_cancel_prime' {p k m n : ℤ} (hdvd1 : ¬p ∣ m) (hdvd2 : k ∣ m) (hp : Prime p)
    (h : k ∣ p * n) : k ∣ n :=
  Irreducible.dvd_of_dvd_mul_left hdvd1 hdvd2 hp.irreducible h
#align int.dvd_mul_cancel_prime' Int.dvd_mul_cancel_prime'


import algebra.ring.boolean_ring

theorem decide_diophantine2_1 (a b n x y : ℕ): a*x+b*y =n → 0 < a → x < n/a + 1 :=
  λ h, λ ha: 0 < a,
  have hh: x*a ≤ n, from
    calc _ = a*x + 0    : by ring
       ... ≤ a*x + (b*y) : add_le_add_left (nat.zero_le  _) (a*x)
       ... = _           : h,
  calc _ ≤ n/a           : (nat.le_div_iff_mul_le ha).mpr hh
     ... < _             : lt_add_one (n/a)

theorem decide_diophantine2_2 (a b n x y : ℕ):
  a*x+b*y =n → 0 < a → 0 < b → x < n/a + 1 ∧ y < n/b + 1 :=
  λ g1, λ ha hb,
  have g2:b*y+a*x =n, from calc _ = a*x+b*y : by ring
                              ... = _       : g1,
  have h1: x < n/a + 1, from decide_diophantine2_1 a b n x y g1 ha,
  have h2: y < n/b + 1, from decide_diophantine2_1 b a n y x g2 hb,
  and.intro h1 h2

instance example_1_59 :
  decidable (∀ x y : ℕ, 2*x+3*y=7 ∧ (x>0→ y>0) ↔ x=2∧  y=1) :=
  decidable_of_iff
  (∀ x : fin (7/2+1), ∀ y: fin(7/3+1), 2*x.1+3*y.1=7 ∧ (x.1>0→ y.1>0) ↔ x.1=2∧  y.1=1)
  (
    iff.intro (
      λ h x y, iff.intro (
        λ h1,
        have H: 2 * x + 3 * y = 7 ∧ (x > 0 → y > 0) ↔ x = 2 ∧ y = 1, from
          h ⟨ x,
            (decide_diophantine2_2 2 3 7 x y h1.1 (two_pos) three_pos).1
          ⟩ ⟨y,
            (decide_diophantine2_2 2 3 7 x y h1.1 (two_pos) three_pos).2
          ⟩,
        H.mp h1
      )
      (
        λ hxy, and.intro (
          calc 2 * x + 3 * y = 2 * x + 3 * 1: by rw hxy.2
                         ... = 2 * 2 + 3 * 1: by rw hxy.1
                         ... = 7: dec_trivial
        ) (
          λ hx, calc y = 1: hxy.2
                   ... > 0: one_pos
        )
      )
    ) (
      λ h, λ x y, h x.val y.val
    )
  )

example : (∀ x y : ℕ, 2*x+3*y=7 ∧ (x>0→ y>0) ↔ x=2∧  y=1) := dec_trivial


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.nat.parity
import order.filter.at_top_bot

/-!
# Numbers are frequently modeq to fixed numbers

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

In this file we prove that `m ≡ d [MOD n]` frequently as `m → ∞`.
-/

open filter

namespace nat

/-- Infinitely many natural numbers are equal to `d` mod `n`. -/

lemma frequently_mod_eq {d n : ℕ} (h : d < n) : ∃ᶠ m in at_top, m % n = d :=
by simpa only [nat.modeq, mod_eq_of_lt h] using frequently_modeq h.ne_bot d

lemma frequently_even : ∃ᶠ m : ℕ in at_top, even m :=
by simpa only [even_iff] using frequently_mod_eq zero_lt_two

lemma frequently_odd : ∃ᶠ m : ℕ in at_top, odd m :=
by simpa only [odd_iff] using frequently_mod_eq one_lt_two

end nat


/-
Copyright (c) 2022 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import analysis.special_functions.log.base
import measure_theory.measure.measure_space_def

/-!
# Doubling measures

A doubling measure `μ` on a metric space is a measure for which there exists a constant `C` such
that for all sufficiently small radii `ε`, and for any centre, the measure of a ball of radius
`2 * ε` is bounded by `C` times the measure of the concentric ball of radius `ε`.

This file records basic files on doubling measures.

## Main definitions

  * `is_doubling_measure`: the definition of a doubling measure (as a typeclass).
  * `is_doubling_measure.doubling_constant`: a function yielding the doubling constant `C` appearing
  in the definition of a doubling measure.
-/

noncomputable theory

open set filter metric measure_theory topological_space
open_locale ennreal nnreal topology

/-- A measure `μ` is said to be a doubling measure if there exists a constant `C` such that for
all sufficiently small radii `ε`, and for any centre, the measure of a ball of radius `2 * ε` is
bounded by `C` times the measure of the concentric ball of radius `ε`.

Note: it is important that this definition makes a demand only for sufficiently small `ε`. For
example we want hyperbolic space to carry the instance `is_doubling_measure volume` but volumes grow
exponentially in hyperbolic space. To be really explicit, consider the hyperbolic plane of
curvature -1, the area of a disc of radius `ε` is `A(ε) = 2π(cosh(ε) - 1)` so `A(2ε)/A(ε) ~ exp(ε)`.
-/
class is_doubling_measure {α : Type*} [metric_space α] [measurable_space α] (μ : measure α) :=
(exists_measure_closed_ball_le_mul [] :
  ∃ (C : ℝ≥0), ∀ᶠ ε in 𝓝[>] 0, ∀ x, μ (closed_ball x (2 * ε)) ≤ C * μ (closed_ball x ε))

namespace is_doubling_measure

variables {α : Type*} [metric_space α] [measurable_space α] (μ : measure α) [is_doubling_measure μ]

/-- A doubling constant for a doubling measure.

See also `is_doubling_measure.scaling_constant_of`. -/
def doubling_constant : ℝ≥0 := classical.some $ exists_measure_closed_ball_le_mul μ

lemma exists_measure_closed_ball_le_mul' :
  ∀ᶠ ε in 𝓝[>] 0, ∀ x, μ (closed_ball x (2 * ε)) ≤ doubling_constant μ * μ (closed_ball x ε) :=
classical.some_spec $ exists_measure_closed_ball_le_mul μ

lemma exists_eventually_forall_measure_closed_ball_le_mul (K : ℝ) :
  ∃ (C : ℝ≥0), ∀ᶠ ε in 𝓝[>] 0, ∀ x t (ht : t ≤ K),
    μ (closed_ball x (t * ε)) ≤ C * μ (closed_ball x ε) :=
begin
  let C := doubling_constant μ,
  have hμ : ∀ (n : ℕ), ∀ᶠ ε in 𝓝[>] 0, ∀ x,
    μ (closed_ball x (2^n * ε)) ≤ ↑(C^n) * μ (closed_ball x ε),
  { intros n,
    induction n with n ih, { simp, },
    replace ih := eventually_nhds_within_pos_mul_left (two_pos : 0 < (2 : ℝ)) ih,
    refine (ih.and (exists_measure_closed_ball_le_mul' μ)).mono (λ ε hε x, _),
    calc μ (closed_ball x (2^(n + 1) * ε))
          = μ (closed_ball x (2^n * (2 * ε))) : by rw [pow_succ', mul_assoc]
      ... ≤ ↑(C^n) * μ (closed_ball x (2 * ε)) : hε.1 x
      ... ≤ ↑(C^n) * (C * μ (closed_ball x ε)) : ennreal.mul_left_mono (hε.2 x)
      ... = ↑(C^(n + 1)) * μ (closed_ball x ε) : by rw [← mul_assoc, pow_succ', ennreal.coe_mul], },
  rcases lt_or_le K 1 with hK | hK,
  { refine ⟨1, _⟩,
    simp only [ennreal.coe_one, one_mul],
    exact eventually_mem_nhds_within.mono (λ ε hε x t ht,
      measure_mono $ closed_ball_subset_closed_ball (by nlinarith [mem_Ioi.mp hε])), },
  { refine ⟨C^⌈real.logb 2 K⌉₊, ((hμ ⌈real.logb 2 K⌉₊).and eventually_mem_nhds_within).mono
      (λ ε hε x t ht, le_trans (measure_mono $ closed_ball_subset_closed_ball _) (hε.1 x))⟩,
    refine mul_le_mul_of_nonneg_right (ht.trans _) (mem_Ioi.mp hε.2).le,
    conv_lhs { rw ← real.rpow_logb two_pos (by norm_num) (by linarith : 0 < K), },
    rw ← real.rpow_nat_cast,
    exact real.rpow_le_rpow_of_exponent_le one_le_two (nat.le_ceil (real.logb 2 K)), },
end

/-- A variant of `is_doubling_measure.doubling_constant` which allows for scaling the radius by
values other than `2`. -/
def scaling_constant_of (K : ℝ) : ℝ≥0 :=
max (classical.some $ exists_eventually_forall_measure_closed_ball_le_mul μ K) 1

@[simp] lemma one_le_scaling_constant_of (K : ℝ) : 1 ≤ scaling_constant_of μ K :=
le_max_of_le_right $ le_refl 1

lemma eventually_measure_mul_le_scaling_constant_of_mul (K : ℝ) :
  ∃ (R : ℝ), 0 < R ∧ ∀ x t r (ht : t ∈ Ioc 0 K) (hr : r ≤ R),
    μ (closed_ball x (t * r)) ≤ scaling_constant_of μ K * μ (closed_ball x r) :=
begin
  have h := classical.some_spec (exists_eventually_forall_measure_closed_ball_le_mul μ K),
  rcases mem_nhds_within_Ioi_iff_exists_Ioc_subset.1 h with ⟨R, Rpos, hR⟩,
  refine ⟨R, Rpos, λ x t r ht hr, _⟩,
  rcases lt_trichotomy r 0 with rneg|rfl|rpos,
  { have : t * r < 0, from mul_neg_of_pos_of_neg ht.1 rneg,
    simp only [closed_ball_eq_empty.2 this, measure_empty, zero_le'] },
  { simp only [mul_zero, closed_ball_zero],
    refine le_mul_of_one_le_of_le _ le_rfl,
    apply ennreal.one_le_coe_iff.2 (le_max_right _ _) },
  { apply (hR ⟨rpos, hr⟩ x t ht.2).trans _,
    exact mul_le_mul_right' (ennreal.coe_le_coe.2 (le_max_left _ _)) _ }
end

lemma eventually_measure_le_scaling_constant_mul (K : ℝ) :
  ∀ᶠ r in 𝓝[>] 0, ∀ x,
    μ (closed_ball x (K * r)) ≤ scaling_constant_of μ K * μ (closed_ball x r) :=
begin
  filter_upwards [classical.some_spec (exists_eventually_forall_measure_closed_ball_le_mul μ K)]
    with r hr x,
  exact (hr x K le_rfl).trans (mul_le_mul_right' (ennreal.coe_le_coe.2 (le_max_left _ _)) _)
end

lemma eventually_measure_le_scaling_constant_mul' (K : ℝ) (hK : 0 < K) :
  ∀ᶠ r in 𝓝[>] 0, ∀ x,
    μ (closed_ball x r) ≤ scaling_constant_of μ K⁻¹ * μ (closed_ball x (K * r)) :=
begin
  convert eventually_nhds_within_pos_mul_left hK (eventually_measure_le_scaling_constant_mul μ K⁻¹),
  ext,
  simp [inv_mul_cancel_left₀ hK.ne'],
end

/-- A scale below which the doubling measure `μ` satisfies good rescaling properties when one
multiplies the radius of balls by at most `K`, as stated
in `measure_mul_le_scaling_constant_of_mul`. -/
def scaling_scale_of (K : ℝ) : ℝ :=
(eventually_measure_mul_le_scaling_constant_of_mul μ K).some

lemma scaling_scale_of_pos (K : ℝ) : 0 < scaling_scale_of μ K :=
(eventually_measure_mul_le_scaling_constant_of_mul μ K).some_spec.1

lemma measure_mul_le_scaling_constant_of_mul {K : ℝ} {x : α} {t r : ℝ}
  (ht : t ∈ Ioc 0 K) (hr : r ≤ scaling_scale_of μ K) :
  μ (closed_ball x (t * r)) ≤ scaling_constant_of μ K * μ (closed_ball x r) :=
(eventually_measure_mul_le_scaling_constant_of_mul μ K).some_spec.2 x t r ht hr

end is_doubling_measure


/-
Copyright (c) 2021 Ivan Sadofschi Costa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ivan Sadofschi Costa
-/
import data.fin.tuple
import data.finsupp.basic

/-!
# `cons` and `tail` for maps `fin n →₀ M`

We interpret maps `fin n →₀ M` as `n`-tuples of elements of `M`,
We define the following operations:
* `finsupp.tail` : the tail of a map `fin (n + 1) →₀ M`, i.e., its last `n` entries;
* `finsupp.cons` : adding an element at the beginning of an `n`-tuple, to get an `n + 1`-tuple;

In this context, we prove some usual properties of `tail` and `cons`, analogous to those of
`data.fin.tuple.basic`.
-/

noncomputable theory

namespace finsupp

variables {n : ℕ} (i : fin n) {M : Type*} [has_zero M] (y : M)
  (t : fin (n + 1) →₀ M) (s : fin n →₀ M)

/-- `tail` for maps `fin (n + 1) →₀ M`. See `fin.tail` for more details. -/
def tail (s : fin (n + 1) →₀ M) : fin n →₀ M :=
finsupp.equiv_fun_on_fintype.inv_fun (fin.tail s.to_fun)

/-- `cons` for maps `fin n →₀ M`. See `fin.cons` for more details. -/
def cons (y : M) (s : fin n →₀ M) : fin (n + 1) →₀ M :=
finsupp.equiv_fun_on_fintype.inv_fun (fin.cons y s.to_fun)

lemma tail_apply : tail t i = t i.succ :=
begin
  simp only [tail, equiv_fun_on_fintype_symm_apply_to_fun, equiv.inv_fun_as_coe],
  refl,
end

@[simp] lemma cons_zero : cons y s 0 = y :=
by simp [cons, finsupp.equiv_fun_on_fintype]

@[simp] lemma cons_succ : cons y s i.succ = s i :=
begin
  simp only [finsupp.cons, fin.cons, finsupp.equiv_fun_on_fintype, fin.cases_succ, finsupp.coe_mk],
  refl,
end

@[simp] lemma tail_cons : tail (cons y s) = s :=
begin
  simp only [finsupp.cons, fin.cons, finsupp.tail, fin.tail],
  ext,
  simp only [equiv_fun_on_fintype_symm_apply_to_fun, equiv.inv_fun_as_coe,
    finsupp.coe_mk, fin.cases_succ, equiv_fun_on_fintype],
  refl,
end

@[simp] lemma cons_tail : cons (t 0) (tail t) = t :=
begin
  ext,
  by_cases c_a : a = 0,
  { rw [c_a, cons_zero] },
  { rw [←fin.succ_pred a c_a, cons_succ, ←tail_apply] },
end

@[simp] lemma cons_zero_zero : cons 0 (0 : fin n →₀ M) = 0 :=
begin
  ext,
  by_cases c : a = 0,
  { simp [c] },
  { rw [←fin.succ_pred a c, cons_succ],
    simp },
end

variables {s} {y}

lemma cons_ne_zero_of_left (h : y ≠ 0) : cons y s ≠ 0 :=
begin
  contrapose! h with c,
  rw [←cons_zero y s, c, finsupp.coe_zero, pi.zero_apply],
end

lemma cons_ne_zero_of_right (h : s ≠ 0) : cons y s ≠ 0 :=
begin
  contrapose! h with c,
  ext,
  simp [ ← cons_succ a y s, c],
end

lemma cons_ne_zero_iff : cons y s ≠ 0 ↔ y ≠ 0 ∨ s ≠ 0 :=
begin
  refine ⟨λ h, _, λ h, h.cases_on cons_ne_zero_of_left cons_ne_zero_of_right⟩,
  refine imp_iff_not_or.1 (λ h' c, h _),
  rw [h', c, finsupp.cons_zero_zero],
end

end finsupp


/-
In Lean and related proof assistants, such
as Coq, you can obtain proofs not only by
applying inference rules, such as eq.refl,
directly, but also by using programs, called
tactics, that automate some of the details
of finding and applying inference rules or
sequences of such rules.

As an example, we look at the "rfl" tactic,
which slightly simplifies the application of
the eq.refl inference rule. Let's first look
at a few uses of rfl.
-/

theorem t1 : 2 = 1 + 1 := rfl
theorem t2 : tt = tt := rfl

/-
The rfl tactics appear to be producing
proofs of the given propositions, and that
is indeed the case. If we #check t1 we'll
see that this is so. t1 is a proof of 0=0
and in fact is exactly eq.refl 0.
-/

#check t1
#reduce t1

/-
What rfl is doing is grabbing the left side
of an equality proposition, such as 2 or tt
in the examples here, and returning eq.refl
applied to that value.
-/

/-
EXERCISE: Use rfl to produce a proof, h, of
the proposition, "Hello" = "He" ++ "llo".

EXERCISE: Use rfl to prove p: 3*3+4*4=5*5.
-/

theorem h : "Hello" = "He" ++ "llo" := rfl

/- * A brief aside about terminology *-/

/-
Note: The word "theorem" in mathematics is generally
used to mean an "important" proposition that has been
proved. The word lemma is used to mean a less
important proposition that has been proved, often as
part of a larger proof of a more important theorem.
Mathematicians also use the word corollary to refer
to a proposition the proof of which follows from the
proof of a more important theorem. You can read all
about the various words used to refer to things that
have been proved, or that are intended to be proved,
here: https://academia.stackexchange.com/questions/113819/is-it-acceptable-for-a-referee-to-suggest-changing-theorem-into-proposition.
For our purposes, we'll typically just use theorem.
-/

/-
As you have now seen, Lean's notion of equality
does not mean exact equality of expressions. It
means instead the equality the values to which
they "reduce" when you "evaluate" them. We can
prove 2 = 1 + 1 using rfl (or eq.refl of course)
because the "literal expression", 2, reduces to
the value 2; the function application expression,
1 + 1 (wherein the plus function is applied to
the two arguments, 1 and 1) also reduces to 2;
those two values are the same; and so eq.refl 2
generates a proof that type-checks.
-/

/-
EXERCISE: Prove as a theorem, tthof (a silly and
uninformative name to be sure), that 2 + 3 = 1 + 4.

EXERCISE: Prove as a theorem, hpleqhl, that "Hello "
++ "Lean! is equal to "Hello Lean!" (these values
are of type string in Lean and the ++ operator here
refers to the string concatenation function in Lean.)
-/


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.dual
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Contractions

Given modules $M, N$ over a commutative ring $R$, this file defines the natural linear maps:
$M^* \otimes M \to R$, $M \otimes M^* \to R$, and $M^* \otimes N → Hom(M, N)$, as well as proving
some basic properties of these maps.

## Tags

contraction, dual module, tensor product
-/

/-- The natural left-handed pairing between a module and its dual. -/
def contract_left (R : Type u) (M : Type v) [comm_ring R] [add_comm_group M] [module R M] : linear_map R (tensor_product R (module.dual R M) M) R :=
  linear_map.to_fun (tensor_product.uncurry R (module.dual R M) M R) linear_map.id

/-- The natural right-handed pairing between a module and its dual. -/
def contract_right (R : Type u) (M : Type v) [comm_ring R] [add_comm_group M] [module R M] : linear_map R (tensor_product R M (module.dual R M)) R :=
  linear_map.to_fun (tensor_product.uncurry R M (module.dual R M) R) (linear_map.flip linear_map.id)

/-- The natural map associating a linear map to the tensor product of two modules. -/
def dual_tensor_hom (R : Type u) (M : Type v) (N : Type v) [comm_ring R] [add_comm_group M] [add_comm_group N] [module R M] [module R N] : linear_map R (tensor_product R (module.dual R M) N) (linear_map R M N) :=
  let M' : Type (max v u) := module.dual R M;
  coe_fn (tensor_product.uncurry R M' N (linear_map R M N)) linear_map.smul_rightₗ

@[simp] theorem contract_left_apply {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M] (f : module.dual R M) (m : M) : coe_fn (contract_left R M) (tensor_product.tmul R f m) = coe_fn f m :=
  tensor_product.uncurry_apply linear_map.id f m

@[simp] theorem contract_right_apply {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M] (f : module.dual R M) (m : M) : coe_fn (contract_right R M) (tensor_product.tmul R m f) = coe_fn f m :=
  tensor_product.uncurry_apply (linear_map.flip linear_map.id) m f

@[simp] theorem dual_tensor_hom_apply {R : Type u} {M : Type v} {N : Type v} [comm_ring R] [add_comm_group M] [add_comm_group N] [module R M] [module R N] (f : module.dual R M) (m : M) (n : N) : coe_fn (coe_fn (dual_tensor_hom R M N) (tensor_product.tmul R f n)) m = coe_fn f m • n := sorry


/-
The goal of this file is to prove the following.  If S ⊆ ℂ^n is a subspace and L : S → V is
an isometry, then there exists an isometry M : ℂ^n → ℂ^n such that M(s) = L(s) for every s ∈ S.

-- Checked over by:
-- Hans
-/

import analysis.inner_product_space.pi_L2
open_locale complex_conjugate

variable {n : ℕ}

local notation `ℂ^` n := euclidean_space ℂ (fin n)

variables (S : submodule ℂ (ℂ^n)) (L : S →ₗᵢ[ℂ] ℂ^n)

local notation `dim ` S := finite_dimensional.finrank ℂ S

local notation `range ` L := L.to_linear_map.range

local notation `proj ` S := orthogonal_projection S

/-
dim L(S) = dim S
-/
lemma dim_range_eq_dim : (dim (range L)) = (dim S) :=
begin
  have equiv_of_image := linear_equiv.of_injective (L.to_linear_map) L.injective,
  have : (dim S) = (dim (range L)) :=
  begin
    apply finite_dimensional.nonempty_linear_equiv_iff_finrank_eq.1,
    use equiv_of_image,
    exact finite_dimensional.finite_dimensional_submodule S,
    exact finite_dimensional.finite_dimensional_submodule (L.to_linear_map).range,
  end,
  rw this,
end

/-
(dim Sᗮ) = (dim ℂ^n) - (dim S)
-/
lemma finrank_orthogonal_eq_finrank_sub (S : submodule ℂ (ℂ^n)) :
  (dim Sᗮ) = (dim ℂ^n) - (dim S) :=
begin
  have : (dim S) + (dim Sᗮ) = (dim ℂ^n) := S.finrank_add_finrank_orthogonal,
  symmetry,
  rw nat.sub_eq_iff_eq_add,
  rw add_comm,
  symmetry,
  exact this,
  apply submodule.finrank_le,
end

/-
dim L(S)ᗮ = dim Sᗮ
-/
lemma dim_orthogonal_range_eq_dim_orthogonal : (dim (range L)ᗮ) = (dim Sᗮ) :=
begin
  exact calc (dim (range L)ᗮ) = (dim ℂ^n) - (dim (range L)) : finrank_orthogonal_eq_finrank_sub (range L)
  ...                         = (dim ℂ^n) - (dim S)         : by rw dim_range_eq_dim
  ...                         = (dim Sᗮ)                     : by rw ← finrank_orthogonal_eq_finrank_sub S,
end

/-
We have an isometry L' between Sᗮ and L(S)ᗮ by mapping through Euclidean space.
-/
lemma complementary_isometry : ∃ (L' : (Sᗮ →ₗᵢ[ℂ] (range L)ᗮ)), true :=
begin
  have : (dim Sᗮ) = (dim Sᗮ) := by simp only [eq_self_iff_true],
  let L1 := (linear_isometry_equiv.of_inner_product_space this).to_linear_isometry,
  let L2 := (linear_isometry_equiv.of_inner_product_space (dim_orthogonal_range_eq_dim_orthogonal S L)).symm.to_linear_isometry,
  use (L2.comp L1),
end

noncomputable def L' := (range L)ᗮ.subtypeₗᵢ.comp (complementary_isometry S L).some

/-
We build a linear map on ℂ^n by projecting and applying our isometries.
-/

local notation `extend ` L :=
  L.to_linear_map.comp (proj S).to_linear_map + (L' S L).to_linear_map.comp (proj Sᗮ).to_linear_map

/-
The Pythagorean theorem, applied to members of S and Sᗮ.
-/
lemma norm_add_sq_orthogonal (x y : ℂ^n) (hx : x ∈ S) (hy : y ∈ Sᗮ) : ∥ x + y ∥^2 = ∥ x ∥^2 + ∥ y ∥^2 :=
begin
  iterate {rw sq},
  apply norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero x y (submodule.inner_right_of_mem_orthogonal hx hy),
end

/-
The extension (extend L) is an isometry.
-/
lemma extend_isometry : ∀ (x : ℂ^n), ∥ (extend L) x ∥^2 = ∥ x ∥^2 :=
begin
  intro x,
  have x_decomp : x = ↑((proj S) x) + ↑((proj Sᗮ) x) := eq_sum_orthogonal_projection_self_orthogonal_complement S x,
  conv
  begin
    to_rhs,
    rw x_decomp,
  end,
  have h_xS : ↑((proj S) x) ∈ S := set_like.coe_mem ((proj S) x),
  have h_xSperp : ↑((proj Sᗮ) x) ∈ Sᗮ := set_like.coe_mem ((proj Sᗮ) x),
  rw norm_add_sq_orthogonal S ((proj S) x) ((proj Sᗮ) x) h_xS h_xSperp,

  have Mx_decomp : (extend L) x = L ((proj S) x) + (L' S L)((proj Sᗮ) x) :=
  begin
    simp only [linear_isometry.coe_to_linear_map, continuous_linear_map.to_linear_map_eq_coe,
      add_left_inj, eq_self_iff_true, function.comp_app, linear_map.coe_comp, linear_isometry.map_eq_iff,
      continuous_linear_map.coe_coe, linear_map.add_apply],
  end,
  rw Mx_decomp,
  have h_Lx : L ((proj S) x) ∈ (range L) := L.to_linear_map.mem_range_self ((proj S) x),
  have h_L'x : (L' S L)((proj Sᗮ) x) ∈ (range L)ᗮ :=
  begin
    rw L',
    simp only [ submodule.subtype_apply, linear_isometry.coe_comp,
      function.comp_app, submodule.coe_mem, submodule.coe_subtypeₗᵢ ],
  end,
  rw norm_add_sq_orthogonal (range L) (L ((proj S) x)) ((L' S L) ((proj Sᗮ) x)) h_Lx h_L'x,
  simp only [linear_isometry.norm_map, submodule.coe_norm],
end

/-
The extension (extend L) agrees with L on S.
-/

lemma extend_on_submodule : ∀ (s : S), (extend L) s = L s :=
begin
  intro s,
  simp only [add_right_eq_self,
    linear_isometry.coe_to_linear_map,
    continuous_linear_map.to_linear_map_eq_coe,
    function.comp_app,
    orthogonal_projection_mem_subspace_eq_self,
    linear_map.coe_comp,
    continuous_linear_map.coe_coe,
    linear_map.add_apply],
  rw orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero,
  simp only [eq_self_iff_true, linear_isometry.map_zero],
  simp only [submodule.orthogonal_orthogonal, submodule.coe_mem],
end

/-
There exists an isometry that extends L, namely (extend L).
-/
theorem isometry_extend : ∃ (M : (ℂ^n) →ₗᵢ[ℂ] (ℂ^n)), (∀ (s : S), M s = L s) :=
begin
  let M := (extend L),
  use M,
  have : ∀ (x : ℂ^n), ∥ M x ∥^2 = ∥ x ∥^2 := extend_isometry S L,
  intro x,
  specialize this x,
  rw sq_eq_sq at this,
  exact this,
  exact norm_nonneg _,
  exact norm_nonneg _,
  exact extend_on_submodule S L,
end


meta def few_shot_prompt : string := "Natural language version: \"If $z_1, \\dots, z_n$ are complex, then $|z_1 + z_2 + \\dots + z_n|\\leq |z_1| + |z_2| + \\dots + |z_n|$.\" Translate the natural language version to a Lean mathlib version:
theorem abs_sum_leq_sum_abs (n : ℕ) (f : ℕ → ℂ) :
  abs (∑ i in finset.range n, f i) ≤ ∑ i in finset.range n, abs (f i) :=

Natural language version: \"If x and y are in $\\mathbb{R}^n$, then $|x+y|^2 + |x-y|^2 = 2|x|^2 + 2|y|^2$.\" Translate the natural language version to a Lean mathlib version:
theorem sum_add_square_sub_square_eq_sum_square (n : ℕ) (x y : euclidean_space ℝ (fin n)) :
  ∥x + y∥^2 + ∥x - y∥^2 = 2*∥x∥^2 + 2*∥y∥^2 :=

Natural language version: \"If $x$ is an element of infinite order in $G$, prove that the elements $x^n$, $n\\in\\mathbb{Z}$ are all distinct.\" Translate the natural language version to a Lean mathlib version:
theorem distinct_powers_of_infinite_order_element (G : Type*) [group G] (x : G)
  (hx : x ≠ 1) (hx_inf : ∀ n : ℕ, x ^ n ≠ 1) :
  ∀ m n : ℤ, m ≠ n → x ^ m ≠ x ^ n :=

Natural language version: \"Let $X$ be a topological space; let $A$ be a subset of $X$. Suppose that for each $x\\in A$ there is an open set $U$ containing $x$ such that $U\\subset A$. Show that $A$ is open in $X$.\" Translate the natural language version to a Lean mathlib version:
theorem subset_of_open_subset_is_open (X : Type*) [topological_space X]
  (A : set X) (hA : ∀ x ∈ A, ∃ U : set X, is_open U ∧ x ∈ U ∧ U ⊆ A):
  is_open A :="

meta def prompt_of_nl_statement (nl few_shot_prompt : string):=
few_shot_prompt ++ "\n\nNatural language version: \"" ++ nl ++ "\" Translate the natural language version to a Lean mathlib version:\ntheorem"

meta def example_nl := "Let $a,b\\in G$, Show that $ab$ and $ba$ have the same order."

meta def example_prompt := prompt_of_nl_statement example_nl few_shot_prompt