/-
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 filter (hiding map)
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 μ] {E : set G}

/-- 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

/-- A shear mapping preserves the measure `μ.prod ν`.
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 /-" An additive shear mapping preserves the measure `μ.prod ν`. "-/]
lemma map_prod_mul_eq [is_mul_left_invariant ν] :
  map (λ z : G × G, (z.1, z.1 * z.2)) (μ.prod ν) = μ.prod ν :=
((measure_preserving.id μ).skew_product measurable_mul
  (filter.eventually_of_forall $ map_mul_left_eq_self ν)).map_eq

/-- 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 (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 μ ν

@[to_additive]
lemma quasi_measure_preserving_div [is_mul_right_invariant μ] :
  quasi_measure_preserving (λ (p : G × G), p.1 / p.2) (μ.prod μ) μ :=
begin
  refine quasi_measure_preserving.prod_of_left measurable_div _,
  simp_rw [div_eq_mul_inv],
  apply eventually_of_forall,
  refine λ y, ⟨measurable_mul_const y⁻¹, (map_mul_right_eq_self μ y⁻¹).absolutely_continuous⟩
end

variables [is_mul_left_invariant μ]

/-- 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 : 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 ν] :
  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 :
  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 map_inv_absolutely_continuous : map has_inv.inv μ ≪ μ :=
(quasi_measure_preserving_inv μ).absolutely_continuous

@[to_additive]
lemma measure_inv_null : μ 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 absolutely_continuous_map_inv : μ ≪ map has_inv.inv μ :=
begin
  refine absolutely_continuous.mk (λ s hs, _),
  simp_rw [map_apply measurable_inv hs, inv_preimage, measure_inv_null, imp_self]
end

@[to_additive]
lemma lintegral_lintegral_mul_inv [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.ae_measurable,
end

@[to_additive]
lemma measure_mul_right_null (y : G) :
  μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ E = 0 :=
calc μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ ((λ x, y⁻¹ * x) ⁻¹' E⁻¹)⁻¹ = 0 :
  by simp_rw [← inv_preimage, 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
  (h2E : μ E ≠ 0) (y : G) : μ ((λ x, x * y) ⁻¹' E) ≠ 0 :=
(not_iff_not_of_iff (measure_mul_right_null μ y)).mpr h2E

@[to_additive] lemma quasi_measure_preserving_mul_right (g : G) :
  quasi_measure_preserving (λ h : G, h * g) μ μ :=
begin
  refine ⟨measurable_mul_const g, absolutely_continuous.mk $ λ s hs, _⟩,
  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null], exact id,
end

@[to_additive]
lemma map_mul_right_absolutely_continuous (g : G) : map (* g) μ ≪ μ :=
(quasi_measure_preserving_mul_right μ g).absolutely_continuous

@[to_additive]
lemma absolutely_continuous_map_mul_right (g : G) : μ ≪ map (* g) μ :=
begin
  refine absolutely_continuous.mk (λ s hs, _),
  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null], exact id
end

@[to_additive] lemma quasi_measure_preserving_div_left (g : G) :
  quasi_measure_preserving (λ h : G, g / h) μ μ :=
begin
  refine ⟨measurable_const.div measurable_id, _⟩,
  simp_rw [div_eq_mul_inv],
  rw [← map_map (measurable_const_mul g) measurable_inv],
  refine ((map_inv_absolutely_continuous μ).map $ measurable_const_mul g).trans _,
  rw [map_mul_left_eq_self],
end

@[to_additive]
lemma map_div_left_absolutely_continuous (g : G) : map (λ h, g / h) μ ≪ μ :=
(quasi_measure_preserving_div_left μ g).absolutely_continuous

@[to_additive]
lemma absolutely_continuous_map_div_left (g : G) : μ ≪ map (λ h, g / h) μ :=
begin
  simp_rw [div_eq_mul_inv],
  rw [← map_map (measurable_const_mul g) measurable_inv],
  conv_lhs { rw [← map_mul_left_eq_self μ g] },
  exact (absolutely_continuous_map_inv μ).map (measurable_const_mul g)
end

/-- This is the computation performed in the proof of [Halmos, §60 Th. A]. -/
@[to_additive]
lemma measure_mul_lintegral_eq
  [is_mul_left_invariant ν] (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 /-" Any two nonzero left-invariant measures are absolutely continuous w.r.t. each
other. "-/]
lemma absolutely_continuous_of_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 ν]
  (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 ν]
  (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 ν]
  (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 ν] {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 /-" Left invariant Borel measures on an additive measurable group are unique
  (up to a scalar). "-/]
lemma measure_eq_div_smul [is_mul_left_invariant ν]
  (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


import basic
import group_theory.order_of_element

namespace myint

lemma add_pair_eq {a b : ℕ × ℕ} : ⟦a⟧ + ⟦b⟧ = add_pair a b := rfl

/-
`quotient.ind` gives the correspondence between elements of a quotient type and equivalence classes
of the underlying type. It states that to prove `β q` for every `q` in a quotient type, it suffices
to prove `β ⟦a⟧` for every `a` in the underlying type.
-/

protected lemma add_comm : ∀ n m : myint, n + m = m + n :=
by { apply quotient.ind₂, intros, simp [add_pair_eq, add_pair], congr' 1; apply nat.add_comm }

protected lemma zero_add : ∀ a : myint, 0 + a = a :=
begin
  apply quotient.ind, rintros ⟨a₁, a₂⟩, dsimp [myint.has_zero_myint, mk], rw add_pair_eq,
  dsimp [add_pair], congr'; apply nat.zero_add,
end

protected lemma add_zero : ∀ a : myint, a + 0 = a :=
by { intro, rw [myint.add_comm, myint.zero_add], }

protected lemma add_left_neg : ∀ a : myint, -a + a = 0 :=
begin
  apply quotient.ind, rintro ⟨a₁, a₂⟩,
  dsimp [myint.has_zero_myint, myint.has_neg_myint, neg, myint.neg_pair, mk], simp [add_pair_eq, add_pair],
  apply quot.sound, dsimp [setoid.r, myintrel], rw [add_zero, zero_add, add_comm],
end

protected lemma neg_pair' (a b : ℕ) : - [[a,b]] = [[b,a]] := by { apply quotient.sound, dsimp, refl, }

-- Proving `add_assoc` requires three applications of `quotient.ind`.
protected lemma add_assoc (n m k : myint) : n + m + k = n + (m + k) :=
quotient.ind (λ a₁, quotient.ind (λ a₂, quotient.ind
  (λ a₃, by { simp [add_pair_eq, add_pair, mk], congr' 3; simp [nat.add_assoc] } ) k) m) n

-- Here, `nsmul` is multiplication of a `myint` on the left by a `nat`.
protected def nsmul : ℕ → myint → myint
| 0 x            := 0
| (nat.succ n) x := x + (nsmul n x)

instance add_semigroup_myint : add_semigroup myint :=
{ add := add,
  add_assoc := myint.add_assoc }

instance add_monoid_myint : add_monoid myint :=
{ zero := myint.has_zero_myint.zero,
  zero_add := myint.zero_add,
  add_zero := myint.add_zero,
  nsmul := myint.nsmul,
  nsmul_zero' := λ _, rfl,
  nsmul_succ' := λ _ _, rfl,
  ..myint.add_semigroup_myint }

protected lemma nsmul_eq_nsmul {n : ℕ} {a : myint} : n • a = nsmul n a := rfl

lemma nsmul_myint_pair {n a b : ℕ} : n • ([[a, b]] : myint) = [[n • a, n • b]] :=
begin
  repeat {rw myint.nsmul_eq_nsmul },
  induction n with n ih,
  { simpa [add_monoid.nsmul_zero'], },
  { rw [add_monoid.nsmul_succ', ih], dsimp [mk],
    rw [add_pair_eq, add_pair, nat.succ_eq_add_one, mk],
    congr'; linarith,  }
end

instance add_comm_semigroup_myint : add_comm_semigroup myint :=
{ add_comm := myint.add_comm,
  ..myint.add_semigroup_myint }

instance sub_neg_monoid_myint : sub_neg_monoid myint :=
{  ..myint.add_monoid_myint, ..myint.has_neg_myint, ..myint.has_sub_myint }

instance add_group_myint : add_group myint :=
{ add_left_neg := myint.add_left_neg, ..myint.sub_neg_monoid_myint }

instance add_comm_monoid_myint : add_comm_monoid myint :=
{ ..myint.add_comm_semigroup_myint, ..myint.add_monoid_myint }

instance add_comm_group_myint : add_comm_group myint :=
{ ..myint.add_group_myint, ..myint.add_comm_monoid_myint }

-- Having proved that `myint` is a `add_comm_group`, we can use the simplifier to prove theorems
-- auomatically!
example (a b : myint) : a + b - a = b := by simp

-- Replacing `simp` above with `squeeze_simp` shows exactly which lemmas are needed. I used this
-- to get the following.
example (a b : myint) : a + b - a = b := by simp only [add_sub_cancel']

-- The `ac_refl` tactic proves results that need only associativity and commutativity.
example (a b c d : myint) : (a + b) + (c + d) = b + (c + a) + d := by ac_refl

-- The `•` symbol below is written `\smul` and represents the scalar multiplication `nsmul`.
example : 3 • (-7 : myint) = -21 := dec_trivial

lemma nonneg_or_neg : ∀ a : myint, ∃ n : ℕ, a = [[n, 0]] ∨ a = [[0, n.succ]] :=
begin
  apply quotient.ind,
  rintro ⟨a₁, a₂⟩,
  cases (le_or_lt a₂ a₁) with nonneg neg,
  { use a₁ - a₂, left, apply quot.sound,
    dsimp [setoid.r, myintrel], simp [nat.sub_add_cancel, nonneg], },
  { use (a₂ - a₁).pred, right, apply quot.sound,
    dsimp [setoid.r, myintrel], simp [nat.add_sub_of_le, neg],
    rw nat.succ_pred_eq_of_pos,
    { exact nat.add_sub_of_le (le_of_lt neg) },
    { exact nat.sub_pos_of_lt neg }, },
end

def prod_nat_to_int (n : ℕ × ℕ) : ℤ := n.1 - n.2

/-- A funtion from myint to int. -/
def myint_to_int (n : myint) : ℤ :=
begin
  apply quotient.lift_on n prod_nat_to_int, intros a b h,
  dsimp [has_equiv.equiv, setoid.r, myintrel] at h,
  dsimp [prod_nat_to_int], linarith,
end

lemma myint_to_int_of_pair (n m : ℕ) : myint_to_int [[n, m]] = n - m := rfl

example : myint_to_int [[6,13]] = -7 := rfl

/-- The function `myint_to_int` is additive. -/
protected lemma map_add_myint_to_int : ∀ n m : myint, myint_to_int (n + m) = myint_to_int n + myint_to_int m :=
begin
  apply quotient.ind₂,
  rintro ⟨a₁, a₂⟩ ⟨b₁, b₂⟩,
  rw [add_pair_eq, add_pair, ←mk, ←mk],
  repeat { rw myint_to_int_of_pair },
  push_cast, linarith,
end

/-- Wwe define `myint_to_int_hom`, an (additve group) homomorphism from `myint` to `int`. -/
def myint_to_int_add_monoid_hom : myint →+ ℤ :=
{ to_fun := myint_to_int,
  map_zero' := rfl,
  map_add' := myint.map_add_myint_to_int }

/-- The function `myint_to_int` has an inverse function. We first define a function `int_to_prod_nat` -/
def int_to_prod_nat : ℤ → ℕ × ℕ
| (int.of_nat n)          := (n, 0)
| (int.neg_succ_of_nat n) := (0, nat.succ n)

example : int_to_prod_nat (-5) = (0,5) := rfl

/-- `int_my_myint` is the composite of `quotient.mk` and `int_to_prod_nat`.-/
def int_to_myint (n : ℤ) :  myint := ⟦int_to_prod_nat n⟧

example : int_to_myint (-5) = [[0, 5]] := rfl

/-- We show that `myint_to_int` is an equivalence. Here, `myint ≃ int` is notation for `equiv myint int`. -/
def myint_to_int_equiv : myint ≃ int :=
{ to_fun := myint_to_int,
  inv_fun := int_to_myint,
  left_inv :=
  by { intro n, rcases (nonneg_or_neg n) with ⟨a, rfl | rfl⟩; { rw myint_to_int_of_pair, norm_cast, }, },
  right_inv := by {rintro ⟨_, _⟩; refl, }, }

/-
For free, we have an additive equivalence (i.e. a group isomomorphism) from `myint` to `int`.
Here, `myint ≃+ int` is notation for `add_equiv myint int`.
-/
def myint_to_int_add_equiv : myint ≃+ int :=
{ ..myint_to_int_equiv, ..myint_to_int_add_monoid_hom }

/-
Using this equivalence, we get (for free) that the equivalence respects orders of elements.
-/
example (a : myint) : add_order_of (myint_to_int a) = add_order_of a :=
let f := myint_to_int_add_equiv in add_order_of_injective (f.to_add_monoid_hom) (f.injective) a

end myint


import algebra.invertible
import tactic.linarith
import tactic.field_simp
import order.filter.at_top_bot

section fields
variables {F : Type*}

def cube_root_unity_a [field F] (root_three_i : F) : F :=
  (-1 + root_three_i)/2

def cube_root_unity_b [field F] (root_three_i : F) : F :=
  (-1 - root_three_i)/2

lemma multiply_out_cubed [field F] (x y : F) : (x + y) * (x + y) * (x + y) =
        (x * x * x) + (3 * x * x * y) + (3 * x * y * y) + (y * y * y) :=
begin
  ring,
end

/- If F isn't of characteristic 2, 2^3 ≠ 0 also.-/
lemma eight_ne_zero [field F] (two_ne_zero : (2 : F) ≠ (0 : F)) : (8 : F) ≠ (0 : F) :=
begin
  have cubed : (2 : F) * (2 : F) * (2 : F) = (8 : F),
    ring,
  rw <- cubed, clear cubed,
  exact mul_ne_zero (mul_ne_zero two_ne_zero two_ne_zero) two_ne_zero,
end

lemma twenty_seven_ne_zero [field F] (three_ne_zero : (3 : F) ≠ (0 : F)) :
  (27 : F) ≠ (0 : F) :=
begin
  have cubed : (3 : F) * (3 : F) * (3 : F) = (27 : F),
    ring,
  rw <- cubed, clear cubed,
  exact mul_ne_zero (mul_ne_zero three_ne_zero three_ne_zero) three_ne_zero,
end

@[simp] lemma cubrt_unity_a_correct [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    (cube_root_unity_a root_three_i) * (cube_root_unity_a root_three_i) * (cube_root_unity_a root_three_i)
     = 1 :=
begin
  unfold cube_root_unity_a,
  have simp_numerator : (-1 + root_three_i) * (-1 + root_three_i) * (-1 + root_three_i) = 8,
    rw multiply_out_cubed, rw rt3_i_correct,
    repeat {rw mul_neg_one}, repeat {rw neg_neg},
    rw mul_assoc (-3) root_three_i root_three_i, rw rt3_i_correct,
    ring,
  calc (-1 + root_three_i) / 2 * ((-1 + root_three_i) / 2) * ((-1 + root_three_i) / 2)
       = (-1 + root_three_i) * (-1 + root_three_i) / (2 * 2) * ((-1 + root_three_i) / 2)
          : by rw div_mul_div
   ... = ((-1 + root_three_i) * (-1 + root_three_i) * (-1 + root_three_i) / (2 * 2 * 2))
          : by rw div_mul_div
   ... = 8 / (2 * 2 * 2) : by rw simp_numerator
   ... = 8 / 8 : by ring_nf
   ... = 1 : by rw div_self (eight_ne_zero two_ne_zero),
end

@[simp] lemma cubrt_unity_b_correct [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    (cube_root_unity_b root_three_i) * (cube_root_unity_b root_three_i) * (cube_root_unity_b root_three_i)
     = 1 :=
begin
  have switch_roots : (cube_root_unity_b root_three_i) = (cube_root_unity_a (- root_three_i)),
    unfold cube_root_unity_b, unfold cube_root_unity_a, ring_nf,
  rw switch_roots, clear switch_roots,
  have neg_rt3_i_correct : (-root_three_i) * (-root_three_i) = (-3),
    rw neg_mul_neg, exact rt3_i_correct,
  exact cubrt_unity_a_correct (-root_three_i) neg_rt3_i_correct two_ne_zero,
end

@[simp] lemma cube_roots_unity_sum_zero [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    (cube_root_unity_a root_three_i) + (cube_root_unity_b root_three_i) = -1 :=
begin
  unfold cube_root_unity_a, unfold cube_root_unity_b,
  field_simp, ring,
end

@[simp] lemma cubrt_unity_a_ne_zero [field F] (root_three_i : F)
  (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
  (cube_root_unity_a root_three_i) ≠ 0 :=
begin
  have one_ne_zero : 1 ≠ (0 : F), simp,
  intros h, rw <- cubrt_unity_a_correct at one_ne_zero,
  rw h at one_ne_zero, simp at one_ne_zero, cc,
  repeat {assumption},
end

@[simp] lemma cubrt_unity_a_reciprocal [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    1/(cube_root_unity_a root_three_i) = (cube_root_unity_b root_three_i) :=
begin
  have root_ne_zero : (cube_root_unity_a root_three_i) ≠ 0,
    exact cubrt_unity_a_ne_zero root_three_i rt3_i_correct two_ne_zero,
  field_simp, unfold cube_root_unity_a, unfold cube_root_unity_b,
  field_simp, rw left_distrib, rw sub_eq_add_neg, repeat {rw right_distrib},
  rw neg_mul_comm root_three_i root_three_i,
  rw <- neg_mul_eq_mul_neg root_three_i root_three_i,
  rw rt3_i_correct, ring,
end

@[simp] lemma cubrt_unity_b_ne_zero [field F] (root_three_i : F)
  (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
  (cube_root_unity_b root_three_i) ≠ 0 :=
begin
  rw <- cubrt_unity_a_reciprocal root_three_i rt3_i_correct two_ne_zero, apply one_div_ne_zero,
  exact cubrt_unity_a_ne_zero root_three_i rt3_i_correct two_ne_zero,
end

@[simp] lemma cubrt_unity_b_reciprocal [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    1/(cube_root_unity_b root_three_i) = (cube_root_unity_a root_three_i) :=
begin
  have tmp : ∀(a b : F), 1 / a = 1 / b -> a = b,
    intros a b h, simp at h, exact h,
  apply tmp, rw one_div_one_div, symmetry,
  exact cubrt_unity_a_reciprocal root_three_i rt3_i_correct two_ne_zero,
end

@[simp] lemma cubrts_unity_mul_one [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    (cube_root_unity_a root_three_i) * (cube_root_unity_b root_three_i) = 1 :=
begin
  rw <- cubrt_unity_a_reciprocal root_three_i rt3_i_correct two_ne_zero,
  rw mul_div_cancel',
  exact cubrt_unity_a_ne_zero root_three_i rt3_i_correct two_ne_zero,
end

@[simp] lemma cubrt_unity_a_squ [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    (cube_root_unity_a root_three_i) * (cube_root_unity_a root_three_i) = (cube_root_unity_b root_three_i)
 :=
begin
  have h : (cube_root_unity_a root_three_i) *
              (cube_root_unity_a root_three_i) *
              (cube_root_unity_a root_three_i)
               / (cube_root_unity_a root_three_i) = 1 * (cube_root_unity_b root_three_i),
    rw cubrt_unity_a_correct root_three_i rt3_i_correct two_ne_zero,
    rw cubrt_unity_a_reciprocal root_three_i rt3_i_correct two_ne_zero,
    rw one_mul,
  rw mul_div_cancel at h, rw one_mul at h, exact h,
  exact cubrt_unity_a_ne_zero root_three_i rt3_i_correct two_ne_zero,
end

@[simp] lemma cubrt_unity_b_squ [field F] (root_three_i : F)
    (rt3_i_correct : root_three_i * root_three_i = (-3))
    (two_ne_zero : (2 : F) ≠ (0 : F)) :
    (cube_root_unity_b root_three_i) * (cube_root_unity_b root_three_i) = (cube_root_unity_a root_three_i)
 :=
begin
  have h : (cube_root_unity_a root_three_i) ≠ 0,
    exact cubrt_unity_a_ne_zero root_three_i rt3_i_correct two_ne_zero,
  rw [<- cubrt_unity_a_reciprocal] {occs := occurrences.pos [2]},
  field_simp, rw cubrt_unity_a_squ, repeat {assumption},
end

def depressed_cubic_solution_sqrt [field F] (c d : F) : F :=
  ((d * d) / (2 * 2)) + ((c * c * c)/27)

def depressed_cubic_solution_cube_root [field F] (d root  : F) : F :=
  -(d / 2) + root

def depressed_cubic_solution [field F] (c cubrt : F) : F :=
  cubrt + (-c / (3 * cubrt))

lemma add_three_thirds [field F] (x : F) (three_ne_zero : (3 : F) ≠ (0 : F)) :
  (x / 3) + (x / 3) + (x / 3) = x :=
begin
  repeat {rw div_add_div_same}, ring_nf, rw mul_comm, rw mul_div_cancel x three_ne_zero,
end

lemma rationalise_denominator [field F] (num den sqrt square : F) :
  (den - sqrt ≠ (0 : F)) ->
  (sqrt * sqrt = square) ->
  (num / (den + sqrt)) = (num * (den - sqrt)) / ((den * den) - square) :=
begin
  intros ne_zero h_sqrt, rw <- h_sqrt, clear h_sqrt,
  have two_squares : (den * den - sqrt * sqrt) = (den + sqrt) * (den - sqrt),
    ring,
  rw two_squares, clear two_squares,
  rw <- div_mul_div, rw div_self ne_zero, simp,
end

lemma tmp_nonzero [field F] (c d sqrt : F) (not_char_three : (3 : F) ≠ (0 : F)):
    (sqrt * sqrt = depressed_cubic_solution_sqrt c d) ->
    (c ≠ (0 : F)) ->
       (sqrt -(d / 2) ≠ (0 : F)) :=
begin
  intros h_sqrt c_ne_zero, intros h,
  rw sub_eq_zero at h, symmetry' at h,
  have h_squ : (-(d / 2)) * (-(d / 2)) = (sqrt * sqrt),
    rw h, clear h,
    rw neg_mul_neg,
  clear h,
  rw h_sqrt at h_squ, unfold depressed_cubic_solution_sqrt at h_squ,
  have tmp2 : -(d / 2) * -(d / 2) = (d * d) / (2 * 2),
    rw neg_mul_neg, rw div_mul_div,
  rw tmp2 at h_squ, clear tmp2, symmetry' at h_squ,
  have h_iszero : c * c * c / 27 = 0,
    rw add_right_eq_self at h_squ, exact h_squ,
  clear h_sqrt,
  have ne_zero : c * c * c ≠ (0 : F),
    exact mul_ne_zero (mul_ne_zero c_ne_zero c_ne_zero) c_ne_zero,
  exact div_ne_zero ne_zero (twenty_seven_ne_zero not_char_three) h_iszero,
end

/- The cubic formula involves dividing by multiples of three and of two,
     so we need additional arguments to assert that the relevant field
     is neither of characteristic 2 nor 3.-/
lemma depressed_cubic_solution_correct [field F] (c d x sqrt cubrt : F)
    (c_ne_zero : c ≠ (0 : F))
    (two_ne_zero : (2 : F) ≠ (0 : F)) (three_ne_zero : (3 : F) ≠ (0 : F)) :
  (sqrt * sqrt) = (depressed_cubic_solution_sqrt c d) ->
  (cubrt * cubrt * cubrt) = (depressed_cubic_solution_cube_root d sqrt) ->
  (x = (depressed_cubic_solution c cubrt) -> (x * x * x) + (c * x) + d = 0) :=
begin
  intros h_sqrt h_cubrt, unfold depressed_cubic_solution,
  have cubrt_ne_zero : cubrt ≠ (0 : F),
    intros h, unfold depressed_cubic_solution_cube_root at h_cubrt,
    symmetry' at h_cubrt, rw h at h_cubrt, rw mul_zero at h_cubrt,
    rw add_comm at h_cubrt, rw <- sub_eq_add_neg at h_cubrt,
    exact tmp_nonzero c d sqrt three_ne_zero h_sqrt c_ne_zero h_cubrt,
  intros h,
  rw h, clear h, repeat {rw right_distrib},
                 repeat {rw left_distrib}, repeat {rw right_distrib},
  rw h_cubrt,
  rw neg_div, repeat {rw <- neg_mul_eq_mul_neg}, repeat {rw <- neg_mul_eq_neg_mul},
  repeat {rw neg_neg}, repeat {rw div_mul_div},
  repeat {rw mul_assoc}, repeat {rw mul_comm (3 : F) (_ * _)},
  rw mul_comm (3 : F) cubrt, repeat {rw <- mul_assoc},
  rw h_cubrt, clear h_cubrt,

  /- We need to do some boring rearranging to eliminate the fractional powers
      of the cube root.-/
  rw div_mul_eq_mul_div_comm cubrt c (cubrt * 3),
  have cancel_cubrt : (c / (cubrt * 3)) * cubrt = c / 3,
    rw mul_comm _ cubrt, rw mul_div_comm,
    rw div_mul_right (3 : F) cubrt_ne_zero,
    rw <- div_eq_mul_one_div,
  rw mul_assoc _ cubrt (c / (cubrt * 3)),
  rw mul_assoc _ (c / (cubrt * 3)) cubrt,
  repeat {rw mul_comm cubrt (c / (cubrt * 3))},
  repeat {rw cancel_cubrt}, clear cancel_cubrt,
  rw div_mul_right (3 : F) cubrt_ne_zero,
  rw mul_div_comm c 1 3, rw one_mul,
  rw mul_comm (c / 3) cubrt,
  repeat {rw add_assoc}, rw add_comm (c / 3 * (c / (cubrt * 3))) _,
  rw <- add_assoc (-(cubrt * (c / 3))) (-(cubrt * (c / 3))) _,
  rw <- neg_add, rw add_assoc, rw <- add_assoc (-_) (-(cubrt * (c / 3))) _,
  rw <- neg_add,
  rw <- mul_div_assoc, rw add_three_thirds (cubrt * c) three_ne_zero,
  repeat {rw <- add_assoc _ (c * cubrt) _, rw add_comm _ (c * cubrt),
          rw add_assoc (c * cubrt) _ _},
  rw mul_comm cubrt c,
  rw add_assoc (c * cubrt) _ _, rw <- add_assoc (-(c * cubrt)) (c * cubrt),
  rw <- sub_eq_neg_add (c * cubrt) (c * cubrt), rw sub_self, rw zero_add,

  repeat {rw mul_assoc cubrt _ _}, rw mul_comm ((c * c)/_) cubrt,
  rw mul_div_comm cubrt (c * c), rw div_mul_right _ cubrt_ne_zero,
  rw add_comm (-(c * c * c / _)) _,
  rw add_comm _ (c / 3 * (c / (cubrt * 3))),

  have tmp_1 : (c * c * (1 / (cubrt * (3 * 3)))) = ((c * (c / (cubrt * 3))) / 3),
    field_simp, ring,
  rw tmp_1, clear tmp_1,
  have tmp_2 : (c / 3 * (c / (cubrt * 3))) = ((c * (c / (cubrt * 3))) / 3),
    field_simp, ring,
  rw tmp_2, clear tmp_2,
  repeat {rw add_assoc},
  rw <- add_assoc (c * (c / (cubrt * 3)) / 3) (c * (c / (cubrt * 3)) / 3) _,
  rw <- add_assoc (c * (c / (cubrt * 3)) / 3 + c * (c / (cubrt * 3)) / 3) (c * (c / (cubrt * 3)) / 3) _,
  rw add_three_thirds _ three_ne_zero,
  rw <- add_assoc (c * _) (-_) _, rw add_comm (c * _) (-_),
  rw <- sub_eq_neg_add, rw sub_self, rw zero_add,

  unfold depressed_cubic_solution_cube_root,
  have tmp : (c * c * c / ((-(d / 2) + sqrt) * 3 * 3 * 3)) =
             (c * c * c) / (-(d / 2) + sqrt) * 1 / (3 * 3 * 3),
    field_simp, ring_nf, rw <- mul_assoc, rw <- mul_assoc,
  rw tmp, clear tmp,
  have neg_sqrt : -sqrt * -sqrt = depressed_cubic_solution_sqrt c d,
    rw neg_mul_neg, exact h_sqrt,
  have nonzero : -(d / 2) - sqrt ≠ 0,
    rw sub_eq_add_neg, rw add_comm, rw <- sub_eq_add_neg,
    exact tmp_nonzero c d (-sqrt) three_ne_zero neg_sqrt c_ne_zero,
  rw rationalise_denominator (c * c * c) (-(d/2)) sqrt (depressed_cubic_solution_sqrt c d)
	    nonzero h_sqrt,
  unfold depressed_cubic_solution_sqrt,
  rw neg_mul_neg, rw div_mul_div, rw sub_add_eq_sub_sub,
  rw sub_self,
  field_simp, ring,
end

def depressed_cubic_x [field F] (a b x : F) : F :=
    x + (b / (3 * a))

def depressed_cubic_x_term [field F] (a b c : F) : F :=
    (3 * a * c - (b * b)) / (3 * a * a)

def depressed_cubic_constant [field F] (a b c d : F) : F :=
    (((2 * b * b * b) - (9 * a * b * c)) / (27 * a * a * a)) + (d / a)

lemma convert_cubic_to_depressed [field F] (a b c d x : F)
    (a_ne_zero : a ≠ 0) (three_ne_zero : (3 : F) ≠ (0 : F)) :
  (a * x * x * x) + (b * x * x) + (c * x) + d =
  a * (((depressed_cubic_x a b x) * (depressed_cubic_x a b x) * (depressed_cubic_x a b x))
  + (depressed_cubic_x_term a b c) * (depressed_cubic_x a b x)
  + (depressed_cubic_constant a b c d)) :=
begin
  unfold depressed_cubic_constant, unfold depressed_cubic_x_term,
  unfold depressed_cubic_x,
  have tmp : ∀ (a b : F), (a - b = 0) -> (a = b),
    intros a b h, have h1 : (a - b + b) = (0 + b), rw h, simp at h1, exact h1,
  apply tmp, field_simp, clear tmp,
  rw mul_div_assoc, rw div_mul_left a_ne_zero,
  have tmp : 3 * a * (3 * a) * (3 * a) = (27 * a * a) * a,
    ring,
  rw tmp, clear tmp, repeat {rw mul_assoc (27 * a * a)},
  have den_ne_zero : (27 * a * a) ≠ 0,
    repeat {apply mul_ne_zero}, exact twenty_seven_ne_zero three_ne_zero, repeat {assumption},
  field_simp, ring,
end

def cubic_formula [field F] (a b c cubrt : F) : F :=
  depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt - (b / (3 * a))

def cubic_formula_cubrt [field F] (a b c d sqrt : F) : F :=
  depressed_cubic_solution_cube_root (depressed_cubic_constant a b c d) sqrt

def cubic_formula_sqrt [field F] (a b c d : F) : F :=
  depressed_cubic_solution_sqrt (depressed_cubic_x_term a b c) (depressed_cubic_constant a b c d)

lemma cubic_solution [field F] (a b c d x sqrt cubrt : F)
  (a_ne_zero : a ≠ 0) (two_ne_zero : (2 : F) ≠ 0) (three_ne_zero : (3 : F) ≠ 0)
  (int_quantity_ne_zero : (depressed_cubic_x_term a b c ≠ 0)):

  (sqrt * sqrt = (cubic_formula_sqrt a b c d)) ->
  (cubrt * cubrt * cubrt = (cubic_formula_cubrt a b c d sqrt)) ->
  (x = (cubic_formula a b c cubrt)) ->
  (a * x * x * x) + (b * x * x) + (c * x) + d = 0 :=
begin
  intros h_sqrt h_cubrt h_x,
  unfold cubic_formula at h_x,
  rw convert_cubic_to_depressed a b c d x a_ne_zero three_ne_zero,
  have h : depressed_cubic_x a b x = depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt,
    unfold depressed_cubic_x, rw h_x, ring,
  rw h,
  have triv : depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt =
              depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt,
    refl,
  unfold cubic_formula_sqrt at h_sqrt,
  unfold cubic_formula_cubrt at h_cubrt,
  have eq_zero : (depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt * depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt * depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt + depressed_cubic_x_term a b c * depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt + depressed_cubic_constant a b c d)
                  = 0,
    exact depressed_cubic_solution_correct (depressed_cubic_x_term a b c) (depressed_cubic_constant a b c d) (depressed_cubic_solution (depressed_cubic_x_term a b c) cubrt) sqrt cubrt int_quantity_ne_zero two_ne_zero three_ne_zero h_sqrt h_cubrt triv,
  rw eq_zero, ring,
end

lemma multiply_out_cubic [field F] (x a b c : F) :
  (x + a) * (x + b) * (x + c) =
  x * x * x + (a + b + c) * x * x + (a * b + a * c + b * c) * x + (a * b * c) :=
begin
  ring,
end

lemma depressed_cubic_solution_unique [field F] (c d x sqrt cubrt rt3_i : F)
      (two_ne_zero : (2 : F) ≠ (0 : F)) (three_ne_zero : (3 : F) ≠ (0 : F))
      (c_ne_zero : c ≠ (0 : F)) :
  (sqrt * sqrt) = (depressed_cubic_solution_sqrt c d) ->
  (cubrt * cubrt * cubrt) = (depressed_cubic_solution_cube_root d sqrt) ->
  (rt3_i * rt3_i = (-3)) ->
  (x ≠ (depressed_cubic_solution c cubrt)) ->
   (x ≠ (depressed_cubic_solution c (cubrt * (cube_root_unity_a rt3_i)))) ->
   (x ≠ (depressed_cubic_solution c (cubrt * (cube_root_unity_b rt3_i)))) ->
  ((x * x * x) + (c * x) + d ≠ 0) :=
begin
  intros h_sqrt h_cubrt h_rt3i,
  have cubrt_ne_zero : cubrt ≠ 0,
    intros cubrt_zero, rw cubrt_zero at h_cubrt, rw mul_zero at h_cubrt,
    symmetry' at h_cubrt, unfold depressed_cubic_solution_cube_root at h_cubrt,
    rw add_comm at h_cubrt, rw <- sub_eq_add_neg at h_cubrt,
    exact tmp_nonzero c d sqrt three_ne_zero h_sqrt c_ne_zero h_cubrt,
  have h : (x - depressed_cubic_solution c cubrt) *
           (x - depressed_cubic_solution c (cubrt * cube_root_unity_a rt3_i)) *
           (x - depressed_cubic_solution c (cubrt * cube_root_unity_b rt3_i))
           =
           x * x * x + c * x + d,
    repeat {rw sub_eq_add_neg}, rw multiply_out_cubic,
    have x_squ : (-depressed_cubic_solution c cubrt + -depressed_cubic_solution c (cubrt * cube_root_unity_a rt3_i) + -depressed_cubic_solution c (cubrt * cube_root_unity_b rt3_i))
                  = 0,
      unfold depressed_cubic_solution, field_simp,
      repeat {rw <- mul_assoc}, rw div_mul_eq_div_mul_one_div _ _ (cube_root_unity_a _),
      rw cubrt_unity_a_reciprocal,
      rw div_mul_eq_div_mul_one_div _ _ (cube_root_unity_b _),
      rw cubrt_unity_b_reciprocal,
      field_simp,
      unfold cube_root_unity_a, unfold cube_root_unity_b, field_simp, ring,
      repeat {assumption},
    repeat {rw <- add_assoc}, repeat {rw mul_comm _ cubrt}, rw x_squ, clear x_squ,
    repeat {rw zero_mul}, rw add_zero,
    have x_term : (-depressed_cubic_solution c cubrt *
                        -depressed_cubic_solution c (cubrt * cube_root_unity_a rt3_i) +
                   -depressed_cubic_solution c cubrt *
                        -depressed_cubic_solution c (cubrt * cube_root_unity_b rt3_i) +
                    -depressed_cubic_solution c (cubrt * cube_root_unity_a rt3_i) *
                        -depressed_cubic_solution c (cubrt * cube_root_unity_b rt3_i))
                  = c,
      unfold depressed_cubic_solution, field_simp,
      repeat {rw <- mul_assoc}, rw div_mul_eq_div_mul_one_div _ _ (cube_root_unity_a _),
      rw cubrt_unity_a_reciprocal,
      rw div_mul_eq_div_mul_one_div _ _ (cube_root_unity_b _),
      rw cubrt_unity_b_reciprocal,
      field_simp,
      repeat {rw mul_comm _ (cube_root_unity_a _)}, repeat {rw mul_comm _ (cube_root_unity_b _)},
      simp only [left_distrib, right_distrib, <- neg_mul_eq_mul_neg, <- neg_mul_eq_neg_mul],
      rw mul_comm (cube_root_unity_b rt3_i) c, rw mul_assoc c (cube_root_unity_b _) _,
      rw <- mul_assoc (cube_root_unity_b _) (cube_root_unity_a _) _,
      rw mul_comm (cube_root_unity_b _) (cube_root_unity_a _), rw cubrts_unity_mul_one,
      rw mul_assoc (cube_root_unity_a rt3_i), rw mul_comm (cube_root_unity_a rt3_i),
      rw mul_assoc (cube_root_unity_b rt3_i), repeat {rw mul_assoc _ (cube_root_unity_a _)},
      rw <- mul_assoc (cube_root_unity_a _) (cube_root_unity_b _) _,
      rw cubrts_unity_mul_one,
      rw <- mul_assoc (cube_root_unity_a _) (cube_root_unity_a _) _,
      rw cubrt_unity_a_squ,
      repeat {rw mul_assoc _ (cube_root_unity_b _) _},
      rw <- mul_assoc (cube_root_unity_b _) (cube_root_unity_b _) _,
      rw cubrt_unity_b_squ,
      unfold cube_root_unity_a, unfold cube_root_unity_b, field_simp, ring,
      repeat {assumption},
    repeat {rw mul_comm _ cubrt}, rw x_term, clear x_term,
    have constant_term : (-depressed_cubic_solution c cubrt * -depressed_cubic_solution c (cubrt * cube_root_unity_a rt3_i) * -depressed_cubic_solution c (cubrt * cube_root_unity_b rt3_i))
                          = d,
      have four_ne_zero : (4 : F) ≠ 0,
        have tmp : (4 : F) = 2 * 2, ring, rw tmp,
        exact mul_ne_zero two_ne_zero two_ne_zero,
      have twenty_seven_ne_zero : (27 : F) ≠ 0,
        have tmp : (27 : F) = 3 * (3 * 3), ring, rw tmp,
        exact mul_ne_zero three_ne_zero (mul_ne_zero three_ne_zero three_ne_zero),
      unfold depressed_cubic_solution,
      repeat {rw div_mul_eq_div_mul_one_div},
      repeat {rw cubrt_unity_a_reciprocal}, repeat {rw cubrt_unity_b_reciprocal},
      field_simp,
      have unfold : (c + -(cubrt * (3 * cubrt))) * (c * cube_root_unity_b rt3_i + -(cubrt * cube_root_unity_a rt3_i * (3 * cubrt))) * (c * cube_root_unity_a rt3_i + -(cubrt * cube_root_unity_b rt3_i * (3 * cubrt)))
              =
              c ^ 3 * ((cube_root_unity_a rt3_i) * (cube_root_unity_b rt3_i)) -
              3 * (c * cubrt) ^ 2 * (((cube_root_unity_a rt3_i) * (cube_root_unity_b rt3_i)) + ((cube_root_unity_a rt3_i) * (cube_root_unity_a rt3_i)) + ((cube_root_unity_b rt3_i) * (cube_root_unity_b rt3_i))) +
              9 * c * cubrt ^ 4 * (((cube_root_unity_a rt3_i) * (cube_root_unity_b rt3_i)) + ((cube_root_unity_a rt3_i) * (cube_root_unity_a rt3_i)) + ((cube_root_unity_b rt3_i) * (cube_root_unity_b rt3_i))) -
              27 * (cubrt ^ 6) * ((cube_root_unity_a rt3_i) * (cube_root_unity_b rt3_i)),
        ring,
      rw unfold, clear unfold,
      rw cubrts_unity_mul_one, rw cubrt_unity_a_squ, rw cubrt_unity_b_squ,
      rw add_assoc _ (cube_root_unity_b rt3_i) (cube_root_unity_a rt3_i),
      rw add_comm (cube_root_unity_b rt3_i) (cube_root_unity_a rt3_i),
      rw cube_roots_unity_sum_zero, rw add_right_neg, repeat {rw mul_zero},
      rw mul_one, rw sub_zero, rw add_zero, rw mul_one,
      have tmp : (cubrt ^ 6) = (cubrt * cubrt * cubrt) * (cubrt * cubrt * cubrt),
        ring, rw tmp, clear tmp,
      have tmp : (3 * cubrt * (3 * cubrt) * (3 * cubrt)) = 27 * (cubrt * cubrt * cubrt),
        ring, rw tmp, clear tmp,
      rw h_cubrt, unfold depressed_cubic_solution_cube_root,
      have unfold : ((-(d / 2) + sqrt) * (-(d / 2) + sqrt)) =
                      d * d / 4 - d * sqrt + sqrt * sqrt,
        field_simp, ring,
      rw unfold, clear unfold, rw h_sqrt, unfold depressed_cubic_solution_sqrt,
      field_simp, ring,
      repeat {assumption},
    rw constant_term,
  intros h_s1 h_s2 h_s3, rw <- sub_ne_zero at h_s1, rw <- sub_ne_zero at h_s2, rw <- sub_ne_zero at h_s3,
  rw <- h, clear h,
  apply mul_ne_zero, apply mul_ne_zero, repeat {assumption},
end

lemma cubic_solution_unique [field F] (a b c d x sqrt cubrt rt3_i : F)
      (a_ne_zero : a ≠ (0 : F))
      (one_ne_zero : (1 : F) ≠ (0 : F)) (two_ne_zero : (2 : F) ≠ (0 : F)) (three_ne_zero : (3 : F) ≠ (0 : F))
      (int_quantity_ne_zero : (depressed_cubic_x_term a b c ≠ 0)) :
  (sqrt * sqrt = (cubic_formula_sqrt a b c d)) ->
  (cubrt * cubrt * cubrt = (cubic_formula_cubrt a b c d sqrt)) ->
  (rt3_i * rt3_i = (-3)) ->
  (x ≠ (cubic_formula a b c cubrt)) ->
   (x ≠ (cubic_formula a b c (cubrt * (cube_root_unity_a rt3_i)))) ->
   (x ≠ (cubic_formula a b c (cubrt * (cube_root_unity_b rt3_i)))) ->
  ((a * x * x * x) + (b * x * x) + (c * x) + d ≠ 0) :=
begin
  have twenty_seven_ne_zero : (27 : F) ≠ 0,
    have tmp : (27 : F) = 3 * (3 * 3), ring, rw tmp, clear tmp,
    exact mul_ne_zero three_ne_zero (mul_ne_zero three_ne_zero three_ne_zero),

  unfold cubic_formula, intros h_sqrt h_cubrt h_rt3i h_solution1 h_solution2 h_solution3,
  /- Divide through by the a (which we know isn't zero)... -/
  have tmp : (1 * x * x * x) + (b / a * x * x) + (c / a * x) + (d / a) ≠ 0 ->
             (a * x * x * x) + (b * x * x)     + (c * x)     + d       ≠ 0,
    intros h_tmp, field_simp at h_tmp, field_simp,
    have tmp_tmp : a * x * x * x = x * x * x * a, ring,
    rw tmp_tmp, exact h_tmp,
  apply tmp, clear tmp,
  rw convert_cubic_to_depressed, rw one_mul,

  have x_term_simplify : (depressed_cubic_x_term a b c) = (depressed_cubic_x_term 1 (b / a) (c / a)),
    unfold depressed_cubic_x_term, field_simp, ring,
  rw <- x_term_simplify, clear x_term_simplify,
  have minor : b / a / (3 * 1) = b / (3 * a), field_simp, left, rw mul_comm,
  apply depressed_cubic_solution_unique
        (depressed_cubic_x_term a b c)
        (depressed_cubic_constant 1 (b / a) (c / a) (d / a))
        (depressed_cubic_x 1 (b / a) x) sqrt cubrt rt3_i,
  repeat {assumption},

  rw h_sqrt, unfold cubic_formula_sqrt, unfold depressed_cubic_x_term,
             unfold depressed_cubic_constant, unfold depressed_cubic_solution_sqrt,
  field_simp, ring,

  rw h_cubrt, unfold cubic_formula_cubrt,
              unfold depressed_cubic_constant, unfold depressed_cubic_solution_cube_root,
  field_simp, ring,

  all_goals {unfold depressed_cubic_x, rw minor},
  all_goals {have tmp : ∀ (rt : F),
                	x ≠ depressed_cubic_solution (depressed_cubic_x_term a b c) rt - b / (3 * a) ->
                	x + b / (3 * a) ≠ depressed_cubic_solution (depressed_cubic_x_term a b c) rt,
    intros rt h1 h2, rw <- h2 at h1, simp at h1, cc},
  exact tmp _ h_solution1,
  exact tmp _ h_solution2,
  exact tmp _ h_solution3,
end

end fields


-- Declare our domain of discourse
variable (α : Type)

-- Declare some predicates
variable (P Q : α → Prop)

#check ∀ (x:α), P x

theorem test (x : α) : P x := sorry

-- ∀ (x:α), P x is fun (x: α) => P x
#check test

-- Introduction rule is just to a map a function
example : ∀ x, P x → P x := fun x => fun (h : P x) => h

-- Elimination rule is function application
example (h₁ : ∀ x, P x → Q x) (h₂ : ∀ x, P x) : ∀ x, Q x := fun (x:α) => h₁ x (h₂ x)

-- Once more slowly in tactic mode
example (h₁ : ∀ x, P x → Q x) (h₂ : ∀ x, P x) : ∀ x, Q x := by
  intro (x : α)
  have g₁ : P x := by exact h₂ x
  have g₂ : P x → Q x := by exact h₁ x
  exact g₂ g₁

--
#check ∃ (x:α), P x

#check exists (x:α), P x

-- ∃ introduction is a built-in structure
example (x:α) (h:P x) : ∃ y, P y := Exists.intro x h

#check @Exists α
#check @Exists.intro α

-- Guess
#check @Exists.elim α

example (h : ∃ y, ¬ P y) :  ¬ (∀ x, P x) := by
  intro (g : ∀ x, P x)
  apply Exists.elim h
  intro (a : α)
  intro (l : ¬ P a)
  exact l (g a)

-- Equality: reflexivity, symmetry, and transitivity
#check @Eq α
#check @Eq.refl
#check @Eq.symm
#check @Eq.trans

#check @rfl

-- Substituion for predicates
#check @Eq.subst

example (x y : α) (h : x = y) (g : P x) : P y := Eq.subst h g

-- Substitution for functions
example (β : Type) (x y : α) (h : x = y) (f : α → β) : f x = f y := congrArg f h

#check @congrArg

-- Can use the rewrite tactic - rw
example (β : Type) (x y : α) (h : x = y) (f : α → β) : f x = f y := by
  rw [h]

example (x: α) : x=x := by
  rfl

variable (A B : Prop)
theorem not_true : A → B := sorry
#check not_true

example : ∀ (x : α), P x → ∃ (y : α), P y := by
  intro (a : α)
  intro (h : P a)
  exact ⟨a, h⟩

variable (C : α → α → Prop)

example : (∃ (x:α), ∀ (y:α), C x y) → ∀ (v:α), ∃ (u:α), C u v := by
  intro h v
  apply Exists.elim h
  intro g f
  apply Exists.intro
  exact f v

variable (P : α → Prop)

example : (¬ ∃ y, P y) → ∀ x, ¬ P x := by
  intro h a n
  exact h ⟨a,n⟩

example (f : α → α) (x y : α) (h₁ : x = y) (h₂ : P (f x)) : P (f y) := by
  rw [h₁] at h₂
  assumption

variable (x y z : α)

example (h₁ : x = y) (h₂ : z = x) (f : α → α) : f y = f z := by
  rw [← h₁, h₂]
  -- calc
  --   f y = f y := by rfl
  --   _ = f x := by rw [←h₁]
  --   _ = f z := by rw
  --
example : (∀ x, P x → ¬ Q x) → ¬ ∃ y, P y ∧ Q y := by
  intro h n
  apply Exists.elim n
  intro a g
  exact h a g.left g.right


-- Igualdad_de_bloques_de_una_particion_cuando_tienen_elementos_comunes.lean
-- Igualdad de bloques de una partición cuando tienen elementos comunes
-- José A. Alonso Jiménez
-- Sevilla, 30 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Este ejercicio es el primero de una serie cuyo objetivo es demostrar
-- que el tipo de las particiones de un conjunto `X` es isomorfo al tipo
-- de las relaciones de equivalencia sobre `X`. El desarrollo de dicha
-- serie está basado en la [cuarta parte](https://bit.ly/3AQWY7o) de la
-- primera sesión del curso de Kevin Buzzard
-- "Formalising mathematics: workshop 1 — logic, sets, functions,
-- relations" (https://bit.ly/3kJo231).
--
-- Una [partición](https://bit.ly/3uplABS) de un conjunto A es un conjunto
-- de subconjuntos no vacíos de A tal que todo elemento de A está
-- exactamente en uno de dichos subconjuntos. Es decir, una famila de
-- conjuntos C es una partición de A si se verifican las siguientes
-- condiciones:
-- + Los conjuntos de C son no vacíos; es decir,
--      ∀ X ∈ C, X ≠ ∅.
-- + Los conjuntos de C recubren A; es decir,
--      ∀ a ∈ A, ∃ X ∈ C, a ∈ X
-- + Los conjuntos de C son disjuntos entre sí; es decir,
--      ∀ X Y ∈ C, X ∩ Y ≠ ∅ → X = Y
--
-- En Lean, se puede definir el tipo de las particiones sobre un tipo A
-- mediante una estructura con 4 campos:
-- +  Un conjunto de subconjuntos de A llamados los bloques de la partición.
-- + Una prueba de que los bloques son no vacíos.
-- + Una prueba de que cada término de tipo A está en uno de los bloques.
-- + Una prueba de que dos bloques con intersección no vacía son iguales.
-- Su definición es
--     @[ext] structure particion (A : Type) :=
--     (Bloques    : set (set A))
--     (Hno_vacios : ∀ X ∈ Bloques, (X : set A).nonempty)
--     (Hrecubren  : ∀ a, ∃ X ∈ Bloques, a ∈ X)
--     (Hdisjuntos : ∀ X Y ∈ Bloques, (X ∩ Y : set A).nonempty → X = Y)
--
-- Con la definición anterior,
-- + `P : particion A` expresa que `P` es una partición de `A`.
-- + `Bloques P` es el conjunto de los bloque de P.
-- + `Hno_vacios P` prueba que los bloques de `P` son no vacíos.
-- + `Hrecubren P` prueba que los bloque de `P` recubren a `A`.
-- + `Hdisjuntos p` prueba que los bloques de `P` son disjuntos entre sí
--
-- Demostrar que si dos bloques de una partición tienen un elemento en
-- común, entonces son iguales.
-- ---------------------------------------------------------------------

import tactic

@[ext] structure particion (A : Type) :=
(Bloques    : set (set A))
(Hno_vacios : ∀ X ∈ Bloques, (X : set A).nonempty)
(Hrecubren  : ∀ a, ∃ X ∈ Bloques, a ∈ X)
(Hdisjuntos : ∀ X Y ∈ Bloques, (X ∩ Y : set A).nonempty → X = Y)

namespace particion

variable  {A : Type}
variable  {P : particion A}
variables {X Y : set A}

-- 1ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
begin
  apply P.Hdisjuntos,
  { exact hX, },
  { exact hY, },
  { rw set.nonempty_def,
    use a,
    split,
    { exact haX, },
    { exact haY, }},
end

-- 2ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
begin
  apply P.Hdisjuntos,
  { exact hX, },
  { exact hY, },
  { use a,
    exact ⟨haX, haY⟩, },
end

-- 3ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
begin
  apply P.Hdisjuntos,
  { exact hX, },
  { exact hY, },
  { exact ⟨a, haX, haY⟩, },
end

-- 4ª demostración
lemma iguales_si_comun
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
Hdisjuntos P X hX Y hY ⟨a, haX, haY⟩

end particion


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/

import data.rat.order
import data.int.sqrt
/-!
# Square root on rational numbers

This file defines the square root function on rational numbers `rat.sqrt`
and proves several theorems about it.

-/
namespace rat

/-- Square root function on rational numbers, defined by taking the (integer) square root of the
numerator and the square root (on natural numbers) of the denominator. -/
@[pp_nodot] def sqrt (q : ℚ) : ℚ := rat.mk (int.sqrt q.num) (nat.sqrt q.denom)

/-* Let $q$ be rational, then the square root of $q * q$ is $|q|$. *-/
theorem sqrt_eq (q : ℚ) : rat.sqrt (q*q) = |q| :=
by rw [sqrt, mul_self_num, mul_self_denom, int.sqrt_eq, nat.sqrt_eq, abs_def]

/-* Let $x$ be rational, then there exists a rational number $q$ such that $q * q$ equals to $x$
if and only if the square of square root of $x$ equals to $x$. *-/
theorem exists_mul_self (x : ℚ) : (∃ q, q * q = x) ↔ rat.sqrt x * rat.sqrt x = x :=
⟨λ ⟨n, hn⟩, by rw [← hn, sqrt_eq, abs_mul_abs_self],
λ h, ⟨rat.sqrt x, h⟩⟩

/-* Let $q$ be rational, then the square root of $q$ is non negative. *-/
theorem sqrt_nonneg (q : ℚ) : 0 ≤ rat.sqrt q :=
nonneg_iff_zero_le.1 $ (mk_nonneg _ $ int.coe_nat_pos.2 $
nat.pos_of_ne_zero $ λ H, pos_iff_ne_zero.1 q.pos $ nat.sqrt_eq_zero.1 H).2
$ int.coe_nat_nonneg _

end rat


/-
  Definition of diagonally dominant matrices and tactic.
-/

import data.matrix.basic
import data.matrix.notation
import data.rat.basic
import data.finset.basic

import tactic.fin_cases
import tactic.linarith

open_locale big_operators

def diagdom {n : ℕ} (A : matrix (fin n) (fin n) ℚ) : Prop :=
∀ i, (∑ j, if i ≠ j then abs (A i j) else 0) ≤ abs (A i i)

namespace diagdom

open tactic
open interactive (parse)
open lean.parser (ident)

private meta def unfold_matrix : tactic unit :=
do
  `(diagdom %%M) ← target,
  dunfold_target [name.from_string M.to_string] {}

meta def prove_diagdom : tactic unit :=
`[unfold_matrix, intros i, fin_cases i; simp only [fin.sum_univ_succ]; dec_trivial]

def I2 : matrix (fin 2) (fin 2) ℚ :=
![![1, 0],
  ![0, 1]]

def I4 : matrix (fin 4) (fin 4) ℚ :=
![![1, 0, 0, 0],
  ![0, 1, 0, 0],
  ![0, 0, 1, 0],
  ![0, 0, 0, 1]]

def A : matrix (fin 3) (fin 3) ℚ :=
![![ 3, -2,  1],
  ![ 1, -3,  2],
  ![-1,  2,  4]]

def F : matrix (fin 9) (fin 9) ℚ :=
![![1, 0.04, 0.05, 0.04, 0.02, 0.01, 0.02, 0.05, 0.03],
  ![0.02, 1, 0.02, 0.02, 0.03, 0.02, 0.04, 0.04, 0.02],
  ![0.04, 0.02, 1, 0.05, 0.05, 0.04, 0.03, 0.05, 0.03],
  ![0.05, 0.04, 0.03, 1, 0.02, 0.05, 0.03, 0.02, 0.03],
  ![0.03, 0.03, 0.05, 0.03, 1, 0.02, 0.04, 0.01, 0.03],
  ![0.05, 0.04, 0.02, 0.01, 0.03, 1, 0.04, 0.05, 0.04],
  ![0.03, 0.04, 0.04, 0.02, 0.02, 0.03, 1, 0.01, 0.01],
  ![0.04, 0.03, 0.01, 0.02, 0.05, 0.02, 0.02, 1, 0.02],
  ![0.05, 0.01, 0.03, 0.04, 0.04, 0.05, 0.03, 0.03, 1]]

set_option profiler true

set_option timeout 10000000

example : diagdom I2 := by prove_diagdom

example : diagdom I4 := by prove_diagdom

example : diagdom A := by prove_diagdom

--example : diagdom F := by prove_diagdom

end diagdom


-- Ejercicios sobre aritmética real
-- ================================

-- ------------------------------------------------------
-- Ejercicio 1. Ejecutar las siguientes acciones:
-- 1. Importar la teoría de los números reales.
-- 2. Declarar a, b, c y d como variables sobre los
--    reales.
-- ------------------------------------------------------

import data.real.basic     -- 1
variables (a b c d : ℝ)    -- 2

-- -------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    (c * b) * a = b * (a * c)
-- -------------------------------------------------------

-- 1ª demostración
example : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm c b,
  rw mul_assoc,
  rw mul_comm c a,
end

-- 2ª demostración
example : (c * b) * a = b * (a * c) :=
begin
  calc (c * b) * a = (b * c) * a : by rw mul_comm c b
               ... = b * (c * a) : by rw mul_assoc
               ... = b * (a * c) : by rw mul_comm c a,
end

-- 3ª demostración
example : (c * b) * a = b * (a * c) :=
by linarith

-- 4ª demostración
example : (c * b) * a = b * (a * c) :=
by finish

-- 5ª demostración
example : (c * b) * a = b * (a * c) :=
by ring

-- -------------------------------------------------------
-- Ejercicio 3. Demostrar que si
--    c = b * a - d
--    d = a * b
-- entonces c = 0.
-- -------------------------------------------------------

-- 1ª demostración
example
  (h1 : c = b * a - d)
  (h2 : d = a * b)
  : c = 0 :=
begin
  rw h2 at h1,
  rw mul_comm b a at h1,
  rw sub_self (a * b) at h1,
  exact h1,
end

-- 2ª demostración
example
  (h1 : c = b * a - d)
  (h2 : d = a * b)
  : c = 0 :=
begin
  calc c = b * a - d     : by rw h1
     ... = b * a - a * b : by rw h2
     ... = a * b - a * b : by rw mul_comm a b
     ... = 0             : by rw sub_self (a*b),
end

-- 3ª demostración
example
  (h1 : c = b * a - d)
  (h2 : d = a * b)
  : c = 0 :=
begin
  calc c = b * a - d     : by rw h1
     ... = b * a - a * b : by rw h2
     ... = 0             : by ring,
end

-- -------------------------------------------------------
-- Ejercicio 4. Demostrar que
--    (a + b) + a = 2 * a + b
-- -------------------------------------------------------

-- 1ª demostración
example : (a + b) + a = 2 * a + b :=
begin
  calc (a + b) + a = a + (b + a) : by rw add_assoc
               ... = a + (a + b) : by rw add_comm b a
               ... = (a + a) + b : by rw ← add_assoc
               ... = 2 * a + b   : by rw two_mul,
end

-- 2ª demostración
-- ===============

example : (a + b) + a = 2 * a + b :=
by ring

-- -------------------------------------------------------
-- Ejercicio 5. Demostrar que
--    (a + b) * (a - b) = a^2 - b^2
-- -------------------------------------------------------

-- 1ª demostración
example : (a + b) * (a - b) = a^2 - b^2 :=
begin
  rw pow_two a,
  rw pow_two b,
  rw mul_sub (a + b) a b,
  rw add_mul a b a,
  rw add_mul a b b,
  rw mul_comm b a,
  rw ← sub_sub,
  rw ← add_sub,
  rw sub_self,
  rw add_zero,
end

-- 2ª demostración
example : (a + b) * (a - b) = a^2 - b^2 :=
begin
  calc (a + b) * (a - b)
           = (a + b) * a - (a + b) * b
                : by rw mul_sub (a + b) a b
       ... = a * a + b * a - (a + b) * b
                : by rw add_mul a b a
       ... = a * a + b * a - (a * b + b * b)
                : by rw add_mul a b b
       ... = a * a + a * b - (a * b + b * b)
                : by rw mul_comm b a
       ... = a * a + a * b - a * b - b * b
                : by rw sub_sub
       ... = a * a + (a * b - a * b) - b * b
                : by rw add_sub
       ... = a * a + 0 - b * b
                : by rw sub_self
       ... = a * a - b * b
                : by rw add_zero
       ... = a^2 - b * b
                : by rw pow_two a
       ... = a^2 - b^2
                : by rw pow_two b,
end

-- 3ª demostración
example : (a + b) * (a - b) = a^2 - b^2 :=
by ring


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import analysis.complex.basic
import ring_theory.polynomial.chebyshev
import data.complex.exponential

/-!
# Multiple angle formulas in terms of Chebyshev polynomials

* `polynomial.chebyshev.T_complex_cos`: the `n`-th Chebyshev polynomial evaluates on `complex.cos θ`
  to the value `complex.cos (n * θ)`.
-/

namespace polynomial.chebyshev

open polynomial complex

/-- The `n`-th Chebyshev polynomial of the first kind evaluates on `cos θ` to the
value `cos (n * θ)`. -/
lemma T_complex_cos (θ : ℂ) :
  ∀ n, (T ℂ n).eval (cos θ) = cos (n * θ)
| 0       := by simp only [T_zero, eval_one, nat.cast_zero, zero_mul, cos_zero]
| 1       := by simp only [eval_X, one_mul, T_one, nat.cast_one]
| (n + 2) :=
begin
  simp only [eval_X, eval_one, T_add_two, eval_sub, eval_bit0, nat.cast_succ, eval_mul],
  rw [T_complex_cos (n + 1), T_complex_cos n],
  have aux : sin θ * sin θ = 1 - cos θ * cos θ,
  { rw ← sin_sq_add_cos_sq θ, ring, },
  simp only [nat.cast_add, nat.cast_one, add_mul, cos_add, one_mul, sin_add, mul_assoc, aux],
  ring,
end

/-- `cos (n * θ)` is equal to the `n`-th Chebyshev polynomial of the first kind evaluated
on `cos θ`. -/
lemma cos_nat_mul (n : ℕ) (θ : ℂ) :
  cos (n * θ) = (T ℂ n).eval (cos θ) :=
(T_complex_cos θ n).symm

/-- The `n`-th Chebyshev polynomial of the second kind evaluates on `cos θ` to the
value `sin ((n+1) * θ) / sin θ`. -/
lemma U_complex_cos (θ : ℂ) (n : ℕ) :
  (U ℂ n).eval (cos θ) * sin θ = sin ((n+1) * θ) :=
begin
  induction n with d hd,
  { simp only [U_zero, nat.cast_zero, eval_one, mul_one, zero_add, one_mul] },
  { rw U_eq_X_mul_U_add_T,
    simp only [eval_add, eval_mul, eval_X, T_complex_cos, add_mul, mul_assoc, hd, one_mul],
    conv_rhs { rw [sin_add, mul_comm] },
    push_cast,
    simp only [add_mul, one_mul] }
end

/-- `sin ((n + 1) * θ)` is equal to `sin θ` multiplied with the `n`-th Chebyshev polynomial of the
second kind evaluated on `cos θ`. -/
lemma sin_nat_succ_mul (n : ℕ) (θ : ℂ) :
  sin ((n + 1) * θ) = (U ℂ n).eval (cos θ) * sin θ :=
(U_complex_cos θ n).symm

end polynomial.chebyshev


import .love05_inductive_predicates_demo

/-! # LoVe Homework 11: Logical Foundations of Mathematics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (7 points): Even Numbers as a Subtype

Usually, the most convenient way to represent even natural numbers is to use the
larger type `ℕ`, which also includes the odd natural numbers. If we want to
quantify only over even numbers `n`, we can add an assumption `even n` to our
lemma statement.

An alternative is to encode evenness in the type, using a subtype. We will
explore this approach.

1.1 (1 point). Define the type `evℕ` of even natural numbers, using the `even`
predicate introduced in the lecture 5 demo. -/

#print even

def evℕ : Type :=
sorry

/-! 1.2 (1 point). Prove the following lemma about the `even` predicate. You will
need it to answer question 1.3. -/

lemma even.add {m n : ℕ} (hm : even m) (hn : even n) :
  even (m + n) :=
sorry

/-! 1.3 (1 point). Define zero and addition of even numbers by filling in the
`sorry` placeholders. -/

def evℕ.zero : evℕ :=
sorry

def evℕ.add (m n : evℕ) : evℕ :=
sorry

/-! 1.4 (4 points). Prove that addition of even numbers is commutative and
associative, and has 0 as an identity element. -/

lemma evℕ.add_comm (m n : evℕ) :
  evℕ.add m n = evℕ.add n m :=
sorry

lemma evℕ.add_assoc (l m n : evℕ) :
  evℕ.add (evℕ.add l m) n = evℕ.add l (evℕ.add m n) :=
sorry

lemma evℕ.add_iden_left (n : evℕ) :
  evℕ.add evℕ.zero n = n :=
sorry

lemma evℕ.add_iden_right (n : evℕ) :
  evℕ.add n evℕ.zero = n :=
sorry

/-! ## Question 2 (2 points + 1 bonus point): Hilbert Choice

2.1 (1 bonus point). Prove the following lemma. -/

lemma exists_minimal_arg.aux (f : ℕ → ℕ) :
  ∀x m, f m = x → ∃n, ∀i, f n ≤ f i
| x m eq :=
  begin
    cases' classical.em (∃n, f n < x),
    sorry, sorry
  end

/-! Now this interesting lemma falls off: -/

lemma exists_minimal_arg (f : ℕ → ℕ) :
  ∃n : ℕ, ∀i : ℕ, f n ≤ f i :=
exists_minimal_arg.aux f _ 0 (by refl)

/-! 2.2 (1 point). Use what you learned in the lecture to define the following
function, which returns the (or an) index of the minimal element in `f`'s
image. -/

noncomputable def minimal_arg (f : ℕ → ℕ) : ℕ :=
sorry

/-! 2.3 (1 point). Prove the following characteristic lemma about your
definition. -/

lemma minimal_arg_spec (f : ℕ → ℕ) :
  ∀i : ℕ, f (minimal_arg f) ≤ f i :=
sorry

end LoVe


import algebra.big_operators algebra.group_power data.pnat M3P14.Arithmetic_functions.phi

-- positive naturals
-- todo: add all the properties of dirichlet conv

namespace nat

open list

/-- returns the finset of divisors of a positive natural -/
definition factors_new (d : ℕ+) : list ℕ :=
  filter (λ e, e ∣ d) (range (d+1))

#eval factors_new 6 -- [1, 2, 3, 6]

lemma mem_factors_iff_divides (d : ℕ+) (e : ℕ) : e ∈ factors_new d ↔ e ∣ d :=
 by simp [factors_new, -add_comm, nat.lt_succ_iff];
    exact and_iff_right_of_imp (le_of_dvd d.2)

lemma nodup_factors (d : ℕ+) : nodup (factors_new d) :=
nodup_filter _ (nodup_range (d+1) : nodup (range (d+1)))

/-- returns the sum of f(e) as e ranges over the divisors of d (positive nat) -/
definition divisor_sum
  {β : Type*} [add_comm_monoid β] (f : ℕ → β) (d : ℕ+) : β :=
finset.sum (⟨quotient.mk (factors_new d),nodup_factors d⟩) f

def perfect_num (n : ℕ+) : Prop :=  divisor_sum id n = 2*n

--theorem perfect_number_iff_mersenne (n p: ℕ+) (hp: prime p) : perfect_num n ↔ n = 2^(p-1)*((2^p)-1)

instance : decidable_pred perfect_num := λ _, by unfold perfect_num; apply_instance

theorem divisor_sum_phi (n : ℕ+) : divisor_sum (phi) n = n := sorry

#eval divisor_sum (id) (6) -- it's a perfect number!
#reduce (perfect_num 6 : bool)
#eval (perfect_num 5 : bool)

--dirichlet convolution
def conv (f g : ℕ → ℕ) := λ (n : pnat), divisor_sum (λ d, f d * g (n / d)) n

--#eval conv phi id

-- lemmas about conv

lemma conv_is_comm (f g : ℕ → ℕ) : conv f g = conv g f := sorry
--lemma conv_is_assoc (f g h : ℕ → ℕ) : conv (conv f g) h = conv f (conv g h) := sorry

--lemma conv_is_add_dist (f g h : ℕ → ℕ) : conv f (g + h) = conv f g + conv f h

--lemma conv_id_is_conv (f : ℕ → ℕ) : conv f id = f := sorry

--lemma conv_mul_is_mul (f g : ℕ → ℕ) : is_mult f

--lemma conv_has_inv (f : ℕ → ℕ) (hp : f 1 ≠ 0) : ∃ g : conv f g = id := sorry
end nat


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.polynomial.degree.definitions

/-!
# Trailing degree of univariate polynomials

## Main definitions

* `trailing_degree p`: the multiplicity of `X` in the polynomial `p`
* `nat_trailing_degree`: a variant of `trailing_degree` that takes values in the natural numbers
* `trailing_coeff`: the coefficient at index `nat_trailing_degree p`

Converts most results about `degree`, `nat_degree` and `leading_coeff` to results about the bottom
end of a polynomial
-/

noncomputable theory

open function polynomial finsupp finset
open_locale big_operators classical

namespace polynomial
universes u v
variables {R : Type u} {S : Type v} {a b : R} {n m : ℕ}

section semiring
variables [semiring R] {p q r : polynomial R}

/-- `trailing_degree p` is the multiplicity of `x` in the polynomial `p`, i.e. the smallest
`X`-exponent in `p`.
`trailing_degree p = some n` when `p ≠ 0` and `n` is the smallest power of `X` that appears
in `p`, otherwise
`trailing_degree 0 = ⊤`. -/
def trailing_degree (p : polynomial R) : with_top ℕ := p.support.inf some

lemma trailing_degree_lt_wf : well_founded
(λp q : polynomial R, trailing_degree p < trailing_degree q) :=
inv_image.wf trailing_degree (with_top.well_founded_lt nat.lt_wf)

/-- `nat_trailing_degree p` forces `trailing_degree p` to `ℕ`, by defining
`nat_trailing_degree ⊤ = 0`. -/
def nat_trailing_degree (p : polynomial R) : ℕ := (trailing_degree p).get_or_else 0

/-- `trailing_coeff p` gives the coefficient of the smallest power of `X` in `p`-/
def trailing_coeff (p : polynomial R) : R := coeff p (nat_trailing_degree p)

/-- a polynomial is `monic_at` if its trailing coefficient is 1 -/
def trailing_monic (p : polynomial R) := trailing_coeff p = (1 : R)

lemma trailing_monic.def : trailing_monic p ↔ trailing_coeff p = 1 := iff.rfl

instance trailing_monic.decidable [decidable_eq R] : decidable (trailing_monic p) :=
by unfold trailing_monic; apply_instance

@[simp] lemma trailing_monic.trailing_coeff {p : polynomial R} (hp : p.trailing_monic) :
  trailing_coeff p = 1 := hp

@[simp] lemma trailing_degree_zero : trailing_degree (0 : polynomial R) = ⊤ := rfl

@[simp] lemma trailing_coeff_zero : trailing_coeff (0 : polynomial R) = 0 := rfl

@[simp] lemma nat_trailing_degree_zero : nat_trailing_degree (0 : polynomial R) = 0 := rfl

lemma trailing_degree_eq_top : trailing_degree p = ⊤ ↔ p = 0 :=
⟨λ h, by rw [trailing_degree, ← min_eq_inf_with_top] at h;
  exact support_eq_empty.1 (min_eq_none.1 h),
λ h, by simp [h]⟩

lemma trailing_degree_eq_nat_trailing_degree (hp : p ≠ 0) :
  trailing_degree p = (nat_trailing_degree p : with_top ℕ) :=
let ⟨n, hn⟩ :=
  not_forall.1 (mt option.eq_none_iff_forall_not_mem.2 (mt trailing_degree_eq_top.1 hp)) in
have hn : trailing_degree p = some n := not_not.1 hn,
by rw [nat_trailing_degree, hn]; refl

lemma trailing_degree_eq_iff_nat_trailing_degree_eq {p : polynomial R} {n : ℕ} (hp : p ≠ 0) :
  p.trailing_degree = n ↔ p.nat_trailing_degree = n :=
by rw [trailing_degree_eq_nat_trailing_degree hp, with_top.coe_eq_coe]

lemma trailing_degree_eq_iff_nat_trailing_degree_eq_of_pos {p : polynomial R} {n : ℕ} (hn : 0 < n) :
  p.trailing_degree = n ↔ p.nat_trailing_degree = n :=
begin
  split,
  { intro H, rwa ← trailing_degree_eq_iff_nat_trailing_degree_eq, rintro rfl,
    rw trailing_degree_zero at H, exact option.no_confusion H },
  { intro H, rwa trailing_degree_eq_iff_nat_trailing_degree_eq, rintro rfl,
    rw nat_trailing_degree_zero at H, rw H at hn, exact lt_irrefl _ hn }
end

lemma nat_trailing_degree_eq_of_trailing_degree_eq_some {p : polynomial R} {n : ℕ}
  (h : trailing_degree p = n) : nat_trailing_degree p = n :=
have hp0 : p ≠ 0, from λ hp0, by rw hp0 at h; exact option.no_confusion h,
option.some_inj.1 $ show (nat_trailing_degree p : with_top ℕ) = n,
  by rwa [← trailing_degree_eq_nat_trailing_degree hp0]

@[simp] lemma nat_trailing_degree_le_trailing_degree :
  ↑(nat_trailing_degree p) ≤ trailing_degree p :=
begin
  by_cases hp : p = 0, { rw [hp, trailing_degree_zero], exact le_top },
  rw [trailing_degree_eq_nat_trailing_degree hp],
  exact le_refl _
end

lemma nat_trailing_degree_eq_of_trailing_degree_eq [semiring S] {q : polynomial S}
  (h : trailing_degree p = trailing_degree q) :
nat_trailing_degree p = nat_trailing_degree q :=
by unfold nat_trailing_degree; rw h

lemma le_trailing_degree_of_ne_zero (h : coeff p n ≠ 0) : trailing_degree p ≤ n :=
show @has_le.le (with_top ℕ) _ (p.support.inf some : with_top ℕ) (some n : with_top ℕ),
from finset.inf_le (mem_support_iff.2 h)

lemma nat_trailing_degree_le_of_ne_zero (h : coeff p n ≠ 0) : nat_trailing_degree p ≤ n :=
begin
  rw [← with_top.coe_le_coe, ← trailing_degree_eq_nat_trailing_degree],
  { exact le_trailing_degree_of_ne_zero h, },
  { assume h, subst h, exact h rfl }
end

lemma trailing_degree_le_trailing_degree (h : coeff q (nat_trailing_degree p) ≠ 0) :
  trailing_degree q ≤ trailing_degree p :=
begin
  by_cases hp : p = 0,
  { rw hp, exact le_top },
  { rw trailing_degree_eq_nat_trailing_degree hp, exact le_trailing_degree_of_ne_zero h }
end

lemma trailing_degree_ne_of_nat_trailing_degree_ne {n : ℕ} :
  p.nat_trailing_degree ≠ n → trailing_degree p ≠ n :=
mt $ λ h, by rw [nat_trailing_degree, h, option.get_or_else_coe]

theorem nat_trailing_degree_le_of_trailing_degree_le {n : ℕ} {hp : p ≠ 0}
  (H : (n : with_top ℕ) ≤ trailing_degree p) : n ≤ nat_trailing_degree p :=
begin
  rw trailing_degree_eq_nat_trailing_degree hp at H,
  exact with_top.coe_le_coe.mp H,
end

@[simp] lemma trailing_degree_monomial (ha : a ≠ 0) : trailing_degree (monomial n a) = n :=
by rw [trailing_degree, support_monomial _ _ ha, inf_singleton, with_top.some_eq_coe]

lemma nat_trailing_degree_monomial (ha : a ≠ 0) : nat_trailing_degree (monomial n a) = n :=
by rw [nat_trailing_degree, trailing_degree_monomial ha]; refl

lemma nat_trailing_degree_monomial_le : nat_trailing_degree (monomial n a) ≤ n :=
if ha : a = 0 then by simp [ha] else (nat_trailing_degree_monomial ha).le

lemma le_trailing_degree_monomial : ↑n ≤ trailing_degree (monomial n a) :=
if ha : a = 0 then by simp [ha] else (trailing_degree_monomial ha).ge

@[simp] lemma trailing_degree_C (ha : a ≠ 0) : trailing_degree (C a) = (0 : with_top ℕ) :=
trailing_degree_monomial ha

lemma le_trailing_degree_C : (0 : with_top ℕ) ≤ trailing_degree (C a) :=
le_trailing_degree_monomial

lemma trailing_degree_one_le : (0 : with_top ℕ) ≤ trailing_degree (1 : polynomial R) :=
by rw [← C_1]; exact le_trailing_degree_C

@[simp] lemma nat_trailing_degree_C (a : R) : nat_trailing_degree (C a) = 0 :=
nonpos_iff_eq_zero.1 nat_trailing_degree_monomial_le

@[simp] lemma nat_trailing_degree_one : nat_trailing_degree (1 : polynomial R) = 0 :=
nat_trailing_degree_C 1

@[simp] lemma nat_trailing_degree_nat_cast (n : ℕ) : nat_trailing_degree (n : polynomial R) = 0 :=
by simp only [←C_eq_nat_cast, nat_trailing_degree_C]

@[simp] lemma trailing_degree_C_mul_X_pow (n : ℕ) (ha : a ≠ 0) :
  trailing_degree (C a * X ^ n) = n :=
by rw [C_mul_X_pow_eq_monomial, trailing_degree_monomial ha]

lemma le_trailing_degree_C_mul_X_pow (n : ℕ) (a : R) :
  (n : with_top ℕ) ≤ trailing_degree (C a * X ^ n) :=
by { rw C_mul_X_pow_eq_monomial, exact le_trailing_degree_monomial }

lemma coeff_eq_zero_of_trailing_degree_lt (h : (n : with_top ℕ) < trailing_degree p) :
  coeff p n = 0 :=
not_not.1 (mt le_trailing_degree_of_ne_zero (not_le_of_gt h))

lemma coeff_eq_zero_of_lt_nat_trailing_degree {p : polynomial R} {n : ℕ}
  (h : n < p.nat_trailing_degree) :
  p.coeff n = 0 :=
begin
  apply coeff_eq_zero_of_trailing_degree_lt,
  by_cases hp : p = 0,
  { rw [hp, trailing_degree_zero], exact with_top.coe_lt_top n, },
  { rwa [trailing_degree_eq_nat_trailing_degree hp, with_top.coe_lt_coe] },
end

@[simp] lemma coeff_nat_trailing_degree_pred_eq_zero {p : polynomial R}
  {hp : (0 : with_top ℕ) < nat_trailing_degree p} : p.coeff (p.nat_trailing_degree - 1) = 0 :=
coeff_eq_zero_of_lt_nat_trailing_degree $ nat.sub_lt
  ((with_top.zero_lt_coe (nat_trailing_degree p)).mp hp) nat.one_pos

theorem le_trailing_degree_X_pow (n : ℕ) :
  (n : with_top ℕ) ≤ trailing_degree (X^n : polynomial R) :=
by simpa only [C_1, one_mul] using le_trailing_degree_C_mul_X_pow n (1:R)

theorem le_trailing_degree_X : (1 : with_top ℕ) ≤ trailing_degree (X : polynomial R) :=
le_trailing_degree_monomial

lemma nat_trailing_degree_X_le : (X : polynomial R).nat_trailing_degree ≤ 1 :=
nat_trailing_degree_monomial_le

@[simp] lemma trailing_coeff_eq_zero : trailing_coeff p = 0 ↔ p = 0 :=
⟨λ h, by_contradiction $ λ hp, mt mem_support_iff.1
  (not_not.2 h) (mem_of_min (trailing_degree_eq_nat_trailing_degree hp)),
λ h, h.symm ▸ leading_coeff_zero⟩

lemma trailing_coeff_nonzero_iff_nonzero : trailing_coeff p ≠ 0 ↔ p ≠ 0 :=
not_congr trailing_coeff_eq_zero

lemma nat_trailing_degree_mem_support_of_nonzero : p ≠ 0 → nat_trailing_degree p ∈ p.support :=
(mem_support_iff.mpr ∘ trailing_coeff_nonzero_iff_nonzero.mpr)

lemma nat_trailing_degree_le_of_mem_supp (a : ℕ) :
  a ∈ p.support → nat_trailing_degree p ≤ a:=
nat_trailing_degree_le_of_ne_zero ∘ mem_support_iff.mp

lemma nat_trailing_degree_eq_support_min' (h : p ≠ 0) :
  nat_trailing_degree p = p.support.min' (nonempty_support_iff.mpr h) :=
begin
  apply le_antisymm,
  { apply le_min',
    intros y hy,
    exact nat_trailing_degree_le_of_mem_supp y hy },
  { apply finset.min'_le,
    exact mem_support_iff.mpr (trailing_coeff_nonzero_iff_nonzero.mpr h), },
end

lemma nat_trailing_degree_le_nat_degree (p : polynomial R) :
  p.nat_trailing_degree ≤ p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, nat_degree_zero, nat_trailing_degree_zero] },
  { exact le_nat_degree_of_ne_zero (mt trailing_coeff_eq_zero.mp hp) },
end

lemma nat_trailing_degree_mul_X_pow {p : polynomial R} (hp : p ≠ 0) (n : ℕ) :
  (p * X ^ n).nat_trailing_degree = p.nat_trailing_degree + n :=
begin
  apply le_antisymm,
  { refine nat_trailing_degree_le_of_ne_zero (λ h, mt trailing_coeff_eq_zero.mp hp _),
    rwa [trailing_coeff, ←coeff_mul_X_pow] },
  { rw [nat_trailing_degree_eq_support_min' (λ h, hp (mul_X_pow_eq_zero h)), finset.le_min'_iff],
    intros y hy,
    have key : n ≤ y,
    { rw [mem_support_iff, coeff_mul_X_pow'] at hy,
      exact by_contra (λ h, hy (if_neg h)) },
    rw [mem_support_iff, coeff_mul_X_pow', if_pos key] at hy,
    exact (le_tsub_iff_right key).mp (nat_trailing_degree_le_of_ne_zero hy) },
end

end semiring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : polynomial R}

@[simp] lemma trailing_degree_one : trailing_degree (1 : polynomial R) = (0 : with_top ℕ) :=
trailing_degree_C one_ne_zero

@[simp] lemma trailing_degree_X : trailing_degree (X : polynomial R) = 1 :=
trailing_degree_monomial one_ne_zero

@[simp] lemma nat_trailing_degree_X : (X : polynomial R).nat_trailing_degree = 1 :=
nat_trailing_degree_monomial one_ne_zero

end nonzero_semiring

section ring
variables [ring R]

@[simp] lemma trailing_degree_neg (p : polynomial R) : trailing_degree (-p) = trailing_degree p :=
by unfold trailing_degree; rw support_neg

@[simp] lemma nat_trailing_degree_neg (p : polynomial R) :
  nat_trailing_degree (-p) = nat_trailing_degree p :=
by simp [nat_trailing_degree]

@[simp] lemma nat_trailing_degree_int_cast (n : ℤ) : nat_trailing_degree (n : polynomial R) = 0 :=
by simp only [←C_eq_int_cast, nat_trailing_degree_C]

end ring

section semiring
variables [semiring R]

/-- The second-lowest coefficient, or 0 for constants -/
def next_coeff_up (p : polynomial R) : R :=
if p.nat_trailing_degree = 0 then 0 else p.coeff (p.nat_trailing_degree + 1)

@[simp]
lemma next_coeff_up_C_eq_zero (c : R) :
  next_coeff_up (C c) = 0 := by { rw next_coeff_up, simp }

lemma next_coeff_up_of_pos_nat_trailing_degree (p : polynomial R) (hp : 0 < p.nat_trailing_degree) :
  next_coeff_up p = p.coeff (p.nat_trailing_degree + 1) :=
by { rw [next_coeff_up, if_neg], contrapose! hp, simpa }

end semiring

section semiring
variables [semiring R] {p q : polynomial R} {ι : Type*}

lemma coeff_nat_trailing_degree_eq_zero_of_trailing_degree_lt
  (h : trailing_degree p < trailing_degree q) :
  coeff q (nat_trailing_degree p) = 0 :=
coeff_eq_zero_of_trailing_degree_lt $ nat_trailing_degree_le_trailing_degree.trans_lt h

lemma ne_zero_of_trailing_degree_lt {n : with_top ℕ} (h : trailing_degree p < n) : p ≠ 0 :=
λ h₀, h.not_le (by simp [h₀])

end semiring
end polynomial


import data.set.basic
import data.nat.basic
import logic.basic

open set
open nat

universe u

-- Exercise 1
-- Exercise 2
-- Exercise 3
--   I know I shouldn't, but I'm skipping these because I want to learn how to
--   prove things I can't just show using a normal programming language.

-- Exercise 4
section
    lemma union_empty (α : Type u) (A : set α) :
        A ∪ ∅ = A :=
        begin
            rw union_def,
            ext a,
            rw mem_set_of_eq,
            rw mem_empty_eq,
            rw or_false,
        end

    lemma intersection_empty (α : Type u) (A : set α) :
        A ∩ ∅ = ∅ :=
        begin
            rw inter_def,
            ext a,
            rw mem_set_of_eq,
            repeat {rw mem_empty_eq},
            rw and_false,
        end
end

-- Exercise 5
section
    lemma union_comm (α : Type u) (A B : set α) :
        A ∪ B = B ∪ A :=
        begin
            repeat {rw union_def},
            ext,
            repeat {rw mem_set_of_eq},
            rw or_comm,
        end

    lemma intersection_comm (α : Type u) (A B : set α) :
        A ∩ B = B ∩ A :=
        begin
            repeat {rw inter_def},
            ext,
            repeat {rw mem_set_of_eq},
            rw and_comm,
        end
end

-- Exercise 6
section
    lemma union_distrib (α : Type u) (A B C : set α) :
        A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C) :=
        begin
            repeat {rw inter_def},
            repeat {rw union_def},

            ext a,

            repeat {rw mem_set_of_eq},
            rw or_and_distrib_left,
        end
end

-- Exercise 7
section
    lemma inter_distrib (α : Type u) (A B C : set α) :
        A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
        begin
            repeat {rw inter_def},
            repeat {rw union_def},

            ext a,

            repeat {rw mem_set_of_eq},
            rw and_or_distrib_left,
        end
end

-- Exercise 8
-- TODO: this is horrible
section
    lemma subset_inter (α : Type u) (A B : set α) :
        (A ⊆ B) ↔ (A ∩ B = A) :=
        begin
            split,

            {
                assume h,
                ext,
                rw inter_def,
                rw mem_set_of_eq,

                split,

                -- Proving x ∈ A ∧ x ∈ B → x ∈ A
                assume h',
                cases h' with hl hr,
                apply hl,

                -- Proving x ∈ A → x ∈ A ∧ x ∈ B
                assume hl,
                rw subset_def at h,
                have hr : x ∈ B, from (h x) hl,
                apply and.intro hl hr,
            },

            {
                assume h,
                rw <- h,
                assume x : α,
                rw [inter_def, mem_set_of_eq],
                assume h',
                cases h' with hl hr,
                apply hr,
            },
        end
end

-- Exercise 9
-- TODO: Syntax for complement?
-- section
--     lemma complement_inter (α : Type u) (A B : set α) :
--         (A ∩ B)
-- end

-- Exercise 10
section
    lemma union_minus_identity (α : Type u) (A B : set α) :
        (A ∪ B) = (A ∩ B) ∪ (A \ B) ∪ (B \ A) :=
        begin
            sorry,
        end
end

-- Exercise 11
-- section
--     lemma right_times_dist (α : Type u) (A B C : set α) :
--         (A ∪ B) × C = (A × C) ∪ (B × C) :=
--         begin
--             sorry,
--         end
-- end

-- Exercise 12
section
    lemma cap_minus_empty (α : Type u) (A B : set α) :
        (A ∩ B) \ B = ∅ :=
        begin
            ext,
            rw diff_eq,
            rw inter_assoc,
            rw inter_compl_self,
            rw inter_empty,
        end
end

-- Exercise 13
section
    lemma union_minus_identity' (α : Type u) (A B : set α) :
        (A ∪ B) \ B = A \ B :=
        begin
            ext,

            rw diff_eq,
            rw inter_comm,
            rw inter_distrib,
            rw [inter_comm (-B) A, inter_comm (-B) B],
            rw inter_compl_self,
            rw set.union_empty,
            rw <- diff_eq,
        end
end

-- Exercise 14

-- Exercise 15

-- Exercise 16

-- Exercise 17

-- Exercise 18

-- Exercise 19

-- Exercise 20

-- Exercise 21

-- Exercise 22

-- Exercise 23

-- Exercise 24

-- Exercise 25

-- Exercise 26

-- Exercise 27

-- Exercise 28

-- Exercise 29


import Scripts.set_theory
--===========================--
------ CONJUNTOS FINITOS ------
--===========================--

structure finite {α : Type u} {β : Type v} [Membership α β] (b : β) where
  list : List α
  all_in_list : ∀ {a}, a ∈ b → a ∈ list  -- a ∈ list es equivalente a List.Mem
                                        --a list (hay una instancia de Membership
                                        -- para listas con mem = List.Mem)

inductive is_finite {α : Type u} {β : Type v} [Membership α β] (b : β) : Prop where
  | intro : finite b → is_finite b

----------------------------------------
--- Propiedades de conjuntos finitos ---
----------------------------------------

-- El conjunto vacío es finito
theorem is_finite_empty {α : Type u} : is_finite (∅ : Set α) :=
  let list := []
  have all_in_list : ∀ {a}, a ∈ (∅ : Set α) → a ∈ list := fun h => h.elim
  is_finite.intro ⟨list, all_in_list⟩

-- Los conjuntos unitatios son finitos
theorem is_finite_singleton (a : α) : is_finite { a } :=
  let list := [a]
  have obv : a ∈ list := List.Mem.head  []
  have all_in_list : ∀ {b}, b ∈ ({ a } : Set α) → b ∈ list := fun h => h ▸ obv
  is_finite.intro ⟨list, all_in_list⟩

-- La unión de conjuntos finitos es finito
theorem is_finite_union {s t : Set α} : is_finite s → is_finite t → is_finite (s ∪ t) :=
  fun (is_finite.intro ⟨list_s, all_in_list_s⟩) (is_finite.intro ⟨list_t, all_in_list_t⟩) =>
    let list := list_s ++ list_t
    have all_in_list : ∀ {a}, a ∈ (s ∪ t) → a ∈ list := fun hunion =>
      hunion.elim (fun hsa => List.mem_append_of_mem_left list_t (all_in_list_s hsa))
                  (fun hta => List.mem_append_of_mem_right list_s (all_in_list_t hta))
    is_finite.intro ⟨list, all_in_list⟩

#check @List.mem_append_of_mem_right -- ∀ {α : Type u_1} {b : α} {bs : List α} (as : List α), b ∈ bs → b ∈ as ++ bs

--------------------------------------------------
--- Conjuntos finitos (definición alternativa) ---
--------------------------------------------------
inductive is_finite_alt : Set α → Prop where
  | empty : is_finite_alt ∅
  | singleton : ∀ a, is_finite_alt { a }
  | union : ∀ {s t}, is_finite_alt s → is_finite_alt t → is_finite_alt (s ∪ t)

-----------------------------------------------------------------
--- Propiedades de conjuntos finitos (definición alternativa) ---
-----------------------------------------------------------------

theorem is_finite_inter_with_finite  {s t : Set α} : is_finite_alt t → is_finite_alt (s ∩ t) :=
  fun hfinitet =>
    match hfinitet with
    | is_finite_alt.empty =>
      (eq_inter_empty s).symm ▸ is_finite_alt.empty
    | is_finite_alt.singleton a =>
      empty_or_singleton_eq_inter_singleton.elim
      (fun h_empty => h_empty ▸ is_finite_alt.empty)
      (fun h_single => h_single ▸ is_finite_alt.singleton a)
    | is_finite_alt.union ht1 ht2 =>
      eq_inter_union ▸ is_finite_alt.union (is_finite_inter_with_finite ht1) (is_finite_inter_with_finite ht2)

theorem subset_of_finite {s t : Set α} : s ⊆ t → is_finite_alt t → is_finite_alt s :=
  fun hsub hfinitet => eq_subset_inter_subset hsub ▸ is_finite_inter_with_finite hfinitet

-- EQUIVALENCIA DE AMBAS DEFINICIONES

-- La siguiete implicación es directa a partir de las propiedades probadas para 'is_finite'
theorem is_finite_of_is_finite_alt {s : Set α} : is_finite_alt s → is_finite s :=
  fun h =>
    match h with
    | is_finite_alt.empty => is_finite_empty
    | is_finite_alt.singleton _ => is_finite_singleton _
    | is_finite_alt.union ht1 ht2 => is_finite_union (is_finite_of_is_finite_alt ht1) (is_finite_of_is_finite_alt ht2)

-- La implicación contraria requiere de algunos lemas previos

theorem lemma1 {s : Set α} (h : ∀ {a}, a ∈ s → a ∈ []) : s = ∅ :=
  eq_empty_of_subset_empty (fun hsa => have contr := h hsa; by contradiction)

theorem lemma2 {a : α} {as : List α} :
  (fun b => b ∈ (a::as)) = { a } ∪ (fun b => b ∈ as) :=
    setext
      ⟨fun hbinlist =>
      match hbinlist with
      | List.Mem.head as =>
        Or.inl rfl
      | List.Mem.tail a h_b_in_as =>
        Or.inr h_b_in_as,
      fun hunionb =>
        hunionb.elim
        (fun hsingle =>
          hsingle ▸ List.Mem.head as)
        (fun hbintail =>
          List.Mem.tail a hbintail)⟩

theorem lemma3 : ∀ as : List α, is_finite_alt (fun a => a ∈ as)
  | [] =>
    have hempty : (fun a => a ∈ []) = (∅ : Set α) := lemma1 id
    hempty ▸ is_finite_alt.empty
  | a::as =>
    have div : (fun b => b ∈ (a::as)) = { a } ∪ (fun b => b ∈ as) := lemma2
    div ▸ is_finite_alt.union (is_finite_alt.singleton a) (lemma3 as)

theorem is_finite_alt_of_is_finite {s : Set α} : is_finite s → is_finite_alt s :=
  fun (is_finite.intro ⟨list, all_in_list⟩) =>
  -- 'list' es una lista con los elementos de 's'
  -- 'all_in_list' es la prueba de que todos los
  -- elementos de 's' están en 'list'
    let finiteSet : Set α := (fun b => b ∈ list)
    have hsub : s ⊆ finiteSet := all_in_list
    have hfin : is_finite_alt finiteSet := lemma3 list
    subset_of_finite hsub hfin

theorem is_finite_iff_is_finite_alt {s : Set α} : is_finite s ↔ is_finite_alt s :=
  ⟨is_finite_alt_of_is_finite,is_finite_of_is_finite_alt⟩