/-
Copyright (c) 2022 Rémi Bottinelli. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémi Bottinelli

! This file was ported from Lean 3 source module category_theory.groupoid.vertex_group
! leanprover-community/mathlib commit 47b51515e69f59bca5cf34ef456e6000fe205a69
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Groupoid
import Mathlib.CategoryTheory.PathCategory
import Mathlib.Algebra.Group.Defs
import Mathlib.Algebra.Hom.Group
import Mathlib.Algebra.Hom.Equiv.Basic
import Mathlib.Combinatorics.Quiver.Path

/-!
# Vertex group

This file defines the vertex group (*aka* isotropy group) of a groupoid at a vertex.

## Implementation notes

* The instance is defined "manually", instead of relying on `CategoryTheory.Aut.group` or
  using `CategoryTheory.inv`.
* The multiplication order therefore matches the categorical one: `x * y = x ≫ y`.
* The inverse is directly defined in terms of the groupoidal inverse: `x ⁻¹ = Groupoid.inv x`.

## Tags

isotropy, vertex group, groupoid
-/

namespace CategoryTheory

namespace Groupoid

universe u v

variable {C : Type u} [Groupoid C]

/-- The vertex group at `c`. -/
@[simps mul one inv]
instance vertexGroup (c : C) : Group (c ⟶ c) where
  mul := fun x y : c ⟶ c => x ≫ y
  mul_assoc := Category.assoc
  one := 𝟙 c
  one_mul := Category.id_comp
  mul_one := Category.comp_id
  inv := Groupoid.inv
  mul_left_inv := inv_comp
#align category_theory.groupoid.vertex_group CategoryTheory.Groupoid.vertexGroup

/-- The inverse in the group is equal to the inverse given by `CategoryTheory.inv`. -/
theorem vertexGroup.inv_eq_inv (c : C) (γ : c ⟶ c) : γ⁻¹ = CategoryTheory.inv γ :=
  Groupoid.inv_eq_inv γ
#align category_theory.groupoid.vertex_group.inv_eq_inv CategoryTheory.Groupoid.vertexGroup.inv_eq_inv

/-- An arrow in the groupoid defines, by conjugation, an isomorphism of groups between
its endpoints.
-/
@[simps]
def vertexGroupIsomOfMap {c d : C} (f : c ⟶ d) : (c ⟶ c) ≃* (d ⟶ d)
    where
  toFun γ := inv f ≫ γ ≫ f
  invFun δ := f ≫ δ ≫ inv f
  left_inv γ := by
    simp_rw [Category.assoc, comp_inv, Category.comp_id, ← Category.assoc, comp_inv,
      Category.id_comp]
  right_inv δ := by
    simp_rw [Category.assoc, inv_comp, ← Category.assoc, inv_comp, Category.id_comp,
      Category.comp_id]
  map_mul' γ₁ γ₂ := by
    simp only [vertexGroup_mul, inv_eq_inv, Category.assoc, IsIso.hom_inv_id_assoc]
#align category_theory.groupoid.vertex_group_isom_of_map CategoryTheory.Groupoid.vertexGroupIsomOfMap

/-- A path in the groupoid defines an isomorphism between its endpoints.
-/
def vertexGroupIsomOfPath {c d : C} (p : Quiver.Path c d) : (c ⟶ c) ≃* (d ⟶ d) :=
  vertexGroupIsomOfMap (composePath p)
#align category_theory.groupoid.vertex_group_isom_of_path CategoryTheory.Groupoid.vertexGroupIsomOfPath

/-- A functor defines a morphism of vertex group. -/
@[simps]
def CategoryTheory.Functor.mapVertexGroup {D : Type v} [Groupoid D] (φ : C ⥤ D) (c : C) :
    (c ⟶ c) →* (φ.obj c ⟶ φ.obj c) where
  toFun := φ.map
  map_one' := φ.map_id c
  map_mul' := φ.map_comp
#align category_theory.functor.map_vertex_group CategoryTheory.Groupoid.CategoryTheory.Functor.mapVertexGroup

end Groupoid

end CategoryTheory


/-
Copyright (c) 2019 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.associated
import algebra.regular.basic
import linear_algebra.matrix.mv_polynomial
import linear_algebra.matrix.polynomial
import ring_theory.polynomial.basic
import tactic.linarith
import tactic.ring_exp

/-!
# Cramer's rule and adjugate matrices

The adjugate matrix is the transpose of the cofactor matrix.
It is calculated with Cramer's rule, which we introduce first.
The vectors returned by Cramer's rule are given by the linear map `cramer`,
which sends a matrix `A` and vector `b` to the vector consisting of the
determinant of replacing the `i`th column of `A` with `b` at index `i`
(written as `(A.update_column i b).det`).
Using Cramer's rule, we can compute for each matrix `A` the matrix `adjugate A`.
The entries of the adjugate are the determinants of each minor of `A`.
Instead of defining a minor to be `A` with row `i` and column `j` deleted, we
replace the `i`th row of `A` with the `j`th basis vector; this has the same
determinant as the minor but more importantly equals Cramer's rule applied
to `A` and the `j`th basis vector, simplifying the subsequent proofs.
We prove the adjugate behaves like `det A • A⁻¹`.

## Main definitions

 * `matrix.cramer A b`: the vector output by Cramer's rule on `A` and `b`.
 * `matrix.adjugate A`: the adjugate (or classical adjoint) of the matrix `A`.

## References

  * https://en.wikipedia.org/wiki/Cramer's_rule#Finding_inverse_matrix

## Tags

cramer, cramer's rule, adjugate
-/

namespace matrix
universes u v
variables {n : Type u} [decidable_eq n] [fintype n] {α : Type v} [comm_ring α]
open_locale matrix big_operators polynomial
open equiv equiv.perm finset

section cramer
/-!
  ### `cramer` section

  Introduce the linear map `cramer` with values defined by `cramer_map`.
  After defining `cramer_map` and showing it is linear,
  we will restrict our proofs to using `cramer`.
-/
variables (A : matrix n n α) (b : n → α)

/--
  `cramer_map A b i` is the determinant of the matrix `A` with column `i` replaced with `b`,
  and thus `cramer_map A b` is the vector output by Cramer's rule on `A` and `b`.

  If `A ⬝ x = b` has a unique solution in `x`, `cramer_map A` sends the vector `b` to `A.det • x`.
  Otherwise, the outcome of `cramer_map` is well-defined but not necessarily useful.
-/
def cramer_map (i : n) : α := (A.update_column i b).det

lemma cramer_map_is_linear (i : n) : is_linear_map α (λ b, cramer_map A b i) :=
{ map_add := det_update_column_add _ _,
  map_smul := det_update_column_smul _ _ }

lemma cramer_is_linear : is_linear_map α (cramer_map A) :=
begin
  split; intros; ext i,
  { apply (cramer_map_is_linear A i).1 },
  { apply (cramer_map_is_linear A i).2 }
end

/--
  `cramer A b i` is the determinant of the matrix `A` with column `i` replaced with `b`,
  and thus `cramer A b` is the vector output by Cramer's rule on `A` and `b`.

  If `A ⬝ x = b` has a unique solution in `x`, `cramer A` sends the vector `b` to `A.det • x`.
  Otherwise, the outcome of `cramer` is well-defined but not necessarily useful.
 -/
def cramer (A : matrix n n α) : (n → α) →ₗ[α] (n → α) :=
is_linear_map.mk' (cramer_map A) (cramer_is_linear A)

lemma cramer_apply (i : n) : cramer A b i = (A.update_column i b).det := rfl

lemma cramer_transpose_apply (i : n) : cramer Aᵀ b i = (A.update_row i b).det :=
by rw [cramer_apply, update_column_transpose, det_transpose]

lemma cramer_transpose_row_self (i : n) :
  Aᵀ.cramer (A i) = pi.single i A.det :=
begin
  ext j,
  rw [cramer_apply, pi.single_apply],
  split_ifs with h,
  { -- i = j: this entry should be `A.det`
    subst h,
    simp only [update_column_transpose, det_transpose, update_row, function.update_eq_self] },
  { -- i ≠ j: this entry should be 0
    rw [update_column_transpose, det_transpose],
    apply det_zero_of_row_eq h,
    rw [update_row_self, update_row_ne (ne.symm h)] }
end

lemma cramer_row_self (i : n) (h : ∀ j, b j = A j i) :
  A.cramer b = pi.single i A.det :=
begin
  rw [← transpose_transpose A, det_transpose],
  convert cramer_transpose_row_self Aᵀ i,
  exact funext h
end

@[simp] lemma cramer_one : cramer (1 : matrix n n α) = 1 :=
begin
  ext i j,
  convert congr_fun (cramer_row_self (1 : matrix n n α) (pi.single i 1) i _) j,
  { simp },
  { intros j, rw [matrix.one_eq_pi_single, pi.single_comm] }
end

lemma cramer_smul (r : α) (A : matrix n n α) :
  cramer (r • A) = r ^ (fintype.card n - 1) • cramer A :=
linear_map.ext $ λ b, funext $ λ _, det_update_column_smul' _ _ _ _

@[simp] lemma cramer_subsingleton_apply [subsingleton n] (A : matrix n n α) (b : n → α) (i : n) :
  cramer A b i = b i :=
by rw [cramer_apply, det_eq_elem_of_subsingleton _ i, update_column_self]

lemma cramer_zero [nontrivial n] : cramer (0 : matrix n n α) = 0 :=
begin
  ext i j,
  obtain ⟨j', hj'⟩ : ∃ j', j' ≠ j := exists_ne j,
  apply det_eq_zero_of_column_eq_zero j',
  intro j'',
  simp [update_column_ne hj'],
end

/-- Use linearity of `cramer` to take it out of a summation. -/
lemma sum_cramer {β} (s : finset β) (f : β → n → α) :
  ∑ x in s, cramer A (f x) = cramer A (∑ x in s, f x) :=
(linear_map.map_sum (cramer A)).symm

/-- Use linearity of `cramer` and vector evaluation to take `cramer A _ i` out of a summation. -/
lemma sum_cramer_apply {β} (s : finset β) (f : n → β → α) (i : n) :
∑ x in s, cramer A (λ j, f j x) i = cramer A (λ (j : n), ∑ x in s, f j x) i :=
calc ∑ x in s, cramer A (λ j, f j x) i
    = (∑ x in s, cramer A (λ j, f j x)) i : (finset.sum_apply i s _).symm
... = cramer A (λ (j : n), ∑ x in s, f j x) i :
  by { rw [sum_cramer, cramer_apply], congr' with j, apply finset.sum_apply }

end cramer

section adjugate
/-!
### `adjugate` section

Define the `adjugate` matrix and a few equations.
These will hold for any matrix over a commutative ring.
-/

/-- The adjugate matrix is the transpose of the cofactor matrix.

  Typically, the cofactor matrix is defined by taking the determinant of minors,
  i.e. the matrix with a row and column removed.
  However, the proof of `mul_adjugate` becomes a lot easier if we define the
  minor as replacing a column with a basis vector, since it allows us to use
  facts about the `cramer` map.
-/
def adjugate (A : matrix n n α) : matrix n n α := λ i, cramer Aᵀ (pi.single i 1)

lemma adjugate_def (A : matrix n n α) :
  adjugate A = λ i, cramer Aᵀ (pi.single i 1) := rfl

lemma adjugate_apply (A : matrix n n α) (i j : n) :
  adjugate A i j = (A.update_row j (pi.single i 1)).det :=
by { rw adjugate_def, simp only, rw [cramer_apply, update_column_transpose, det_transpose], }

lemma adjugate_transpose (A : matrix n n α) : (adjugate A)ᵀ = adjugate (Aᵀ) :=
begin
  ext i j,
  rw [transpose_apply, adjugate_apply, adjugate_apply, update_row_transpose, det_transpose],
  rw [det_apply', det_apply'],
  apply finset.sum_congr rfl,
  intros σ _,
  congr' 1,

  by_cases i = σ j,
  { -- Everything except `(i , j)` (= `(σ j , j)`) is given by A, and the rest is a single `1`.
    congr; ext j',
    subst h,
    have : σ j' = σ j ↔ j' = j := σ.injective.eq_iff,
    rw [update_row_apply, update_column_apply],
    simp_rw this,
    rw [←dite_eq_ite, ←dite_eq_ite],
    congr' 1 with rfl,
    rw [pi.single_eq_same, pi.single_eq_same], },
  { -- Otherwise, we need to show that there is a `0` somewhere in the product.
    have : (∏ j' : n, update_column A j (pi.single i 1) (σ j') j') = 0,
    { apply prod_eq_zero (mem_univ j),
      rw [update_column_self, pi.single_eq_of_ne' h], },
    rw this,
    apply prod_eq_zero (mem_univ (σ⁻¹ i)),
    erw [apply_symm_apply σ i, update_row_self],
    apply pi.single_eq_of_ne,
    intro h',
    exact h ((symm_apply_eq σ).mp h') }
end

/-- Since the map `b ↦ cramer A b` is linear in `b`, it must be multiplication by some matrix. This
matrix is `A.adjugate`. -/
lemma cramer_eq_adjugate_mul_vec (A : matrix n n α) (b : n → α) :
  cramer A b = A.adjugate.mul_vec b :=
begin
  nth_rewrite 1 ← A.transpose_transpose,
  rw [← adjugate_transpose, adjugate_def],
  have : b = ∑ i, (b i) • (pi.single i 1),
  { refine (pi_eq_sum_univ b).trans _, congr' with j, simp [pi.single_apply, eq_comm], congr, },
  nth_rewrite 0 this, ext k,
  simp [mul_vec, dot_product, mul_comm],
end

lemma mul_adjugate_apply (A : matrix n n α) (i j k) :
  A i k * adjugate A k j = cramer Aᵀ (pi.single k (A i k)) j :=
begin
  erw [←smul_eq_mul, ←pi.smul_apply, ←linear_map.map_smul, ←pi.single_smul', smul_eq_mul, mul_one],
end

lemma mul_adjugate (A : matrix n n α) : A ⬝ adjugate A = A.det • 1 :=
begin
  ext i j,
  rw [mul_apply, pi.smul_apply, pi.smul_apply, one_apply, smul_eq_mul, mul_boole],
  simp [mul_adjugate_apply, sum_cramer_apply, cramer_transpose_row_self, pi.single_apply, eq_comm]
end

lemma adjugate_mul (A : matrix n n α) : adjugate A ⬝ A = A.det • 1 :=
calc adjugate A ⬝ A = (Aᵀ ⬝ (adjugate Aᵀ))ᵀ :
  by rw [←adjugate_transpose, ←transpose_mul, transpose_transpose]
... = A.det • 1 : by rw [mul_adjugate (Aᵀ), det_transpose, transpose_smul, transpose_one]

lemma adjugate_smul (r : α) (A : matrix n n α) :
  adjugate (r • A) = r ^ (fintype.card n - 1) • adjugate A :=
begin
  rw [adjugate, adjugate, transpose_smul, cramer_smul],
  refl,
end

/-- A stronger form of **Cramer's rule** that allows us to solve some instances of `A ⬝ x = b` even
if the determinant is not a unit. A sufficient (but still not necessary) condition is that `A.det`
divides `b`. -/
@[simp] lemma mul_vec_cramer (A : matrix n n α) (b : n → α) :
  A.mul_vec (cramer A b) = A.det • b :=
by rw [cramer_eq_adjugate_mul_vec, mul_vec_mul_vec, mul_adjugate, smul_mul_vec_assoc, one_mul_vec]

lemma adjugate_subsingleton [subsingleton n] (A : matrix n n α) : adjugate A = 1 :=
begin
  ext i j,
  simp [subsingleton.elim i j, adjugate_apply, det_eq_elem_of_subsingleton _ i]
end

lemma adjugate_eq_one_of_card_eq_one {A : matrix n n α} (h : fintype.card n = 1) : adjugate A = 1 :=
begin
  haveI : subsingleton n := fintype.card_le_one_iff_subsingleton.mp h.le,
  exact adjugate_subsingleton _
end

@[simp] lemma adjugate_zero [nontrivial n] : adjugate (0 : matrix n n α) = 0 :=
begin
  ext i j,
  obtain ⟨j', hj'⟩ : ∃ j', j' ≠ j := exists_ne j,
  apply det_eq_zero_of_column_eq_zero j',
  intro j'',
  simp [update_column_ne hj'],
end

@[simp] lemma adjugate_one : adjugate (1 : matrix n n α) = 1 :=
by { ext, simp [adjugate_def, matrix.one_apply, pi.single_apply, eq_comm] }

lemma _root_.ring_hom.map_adjugate {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S)
  (M : matrix n n R) : f.map_matrix M.adjugate = matrix.adjugate (f.map_matrix M) :=
begin
  ext i k,
  have : pi.single i (1 : S) = f ∘ pi.single i 1,
  { rw ←f.map_one,
    exact pi.single_op (λ i, f) (λ i, f.map_zero) i (1 : R) },
  rw [adjugate_apply, ring_hom.map_matrix_apply, map_apply, ring_hom.map_matrix_apply,
      this, ←map_update_row, ←ring_hom.map_matrix_apply, ←ring_hom.map_det, ←adjugate_apply]
end

lemma _root_.alg_hom.map_adjugate {R A B : Type*} [comm_semiring R] [comm_ring A] [comm_ring B]
  [algebra R A] [algebra R B] (f : A →ₐ[R] B)
  (M : matrix n n A) : f.map_matrix M.adjugate = matrix.adjugate (f.map_matrix M) :=
f.to_ring_hom.map_adjugate _

lemma det_adjugate (A : matrix n n α) : (adjugate A).det = A.det ^ (fintype.card n - 1) :=
begin
  -- get rid of the `- 1`
  cases (fintype.card n).eq_zero_or_pos with h_card h_card,
  { haveI : is_empty n := fintype.card_eq_zero_iff.mp h_card,
    rw [h_card, nat.zero_sub, pow_zero, adjugate_subsingleton, det_one] },
  replace h_card := tsub_add_cancel_of_le h_card.nat_succ_le,

  -- express `A` as an evaluation of a polynomial in n^2 variables, and solve in the polynomial ring
  -- where `A'.det` is non-zero.
  let A' := mv_polynomial_X n n ℤ,
  suffices : A'.adjugate.det = A'.det ^ (fintype.card n - 1),
  { rw [←mv_polynomial_X_map_matrix_aeval ℤ A, ←alg_hom.map_adjugate, ←alg_hom.map_det,
      ←alg_hom.map_det, ←alg_hom.map_pow, this] },

  apply mul_left_cancel₀ (show A'.det ≠ 0, from det_mv_polynomial_X_ne_zero n ℤ),
  calc  A'.det * A'.adjugate.det
      = (A' ⬝ adjugate A').det                 : (det_mul _ _).symm
  ... = A'.det ^ fintype.card n                : by rw [mul_adjugate, det_smul, det_one, mul_one]
  ... = A'.det * A'.det ^ (fintype.card n - 1) : by rw [←pow_succ, h_card],
end

@[simp] lemma adjugate_fin_zero (A : matrix (fin 0) (fin 0) α) : adjugate A = 0 :=
@subsingleton.elim _ matrix.subsingleton_of_empty_left _ _

@[simp] lemma adjugate_fin_one (A : matrix (fin 1) (fin 1) α) : adjugate A = 1 :=
adjugate_subsingleton A

lemma adjugate_fin_two (A : matrix (fin 2) (fin 2) α) :
  adjugate A = ![![A 1 1, -A 0 1], ![-A 1 0, A 0 0]] :=
begin
  ext i j,
  rw [adjugate_apply, det_fin_two],
  fin_cases i with [0, 1]; fin_cases j with [0, 1];
  simp only [nat.one_ne_zero, one_mul, fin.one_eq_zero_iff, pi.single_eq_same, zero_mul,
    fin.zero_eq_one_iff, sub_zero, pi.single_eq_of_ne, ne.def, not_false_iff, update_row_self,
    update_row_ne, cons_val_zero, mul_zero, mul_one, zero_sub, cons_val_one, head_cons],
end

@[simp] lemma adjugate_fin_two' (a b c d : α) :
  adjugate ![![a, b], ![c, d]] = ![![d, -b], ![-c, a]] :=
adjugate_fin_two _

lemma adjugate_conj_transpose [star_ring α] (A : matrix n n α) : A.adjugateᴴ = adjugate (Aᴴ) :=
begin
  dsimp only [conj_transpose],
  have : Aᵀ.adjugate.map star = adjugate (Aᵀ.map star) := ((star_ring_end α).map_adjugate Aᵀ),
  rw [A.adjugate_transpose, this],
end

lemma is_regular_of_is_left_regular_det {A : matrix n n α} (hA : is_left_regular A.det) :
  is_regular A :=
begin
  split,
  { intros B C h,
    refine hA.matrix _,
    rw [←matrix.one_mul B, ←matrix.one_mul C, ←matrix.smul_mul, ←matrix.smul_mul, ←adjugate_mul,
        matrix.mul_assoc, matrix.mul_assoc, ←mul_eq_mul A, h, mul_eq_mul] },
  { intros B C h,
    simp only [mul_eq_mul] at h,
    refine hA.matrix _,
    rw [←matrix.mul_one B, ←matrix.mul_one C, ←matrix.mul_smul, ←matrix.mul_smul, ←mul_adjugate,
        ←matrix.mul_assoc, ←matrix.mul_assoc, h] }
end

lemma adjugate_mul_distrib_aux (A B : matrix n n α)
  (hA : is_left_regular A.det)
  (hB : is_left_regular B.det) :
  adjugate (A ⬝ B) = adjugate B ⬝ adjugate A :=
begin
  have hAB : is_left_regular (A ⬝ B).det,
  { rw [det_mul],
    exact hA.mul hB },
  refine (is_regular_of_is_left_regular_det hAB).left _,
  rw [mul_eq_mul, mul_adjugate, mul_eq_mul, matrix.mul_assoc, ←matrix.mul_assoc B, mul_adjugate,
      smul_mul, matrix.one_mul, mul_smul, mul_adjugate, smul_smul, mul_comm, ←det_mul]
end

/--
Proof follows from "The trace Cayley-Hamilton theorem" by Darij Grinberg, Section 5.3
-/
lemma adjugate_mul_distrib (A B : matrix n n α) : adjugate (A ⬝ B) = adjugate B ⬝ adjugate A :=
begin
  let g : matrix n n α → matrix n n α[X] :=
    λ M, M.map polynomial.C + (polynomial.X : α[X]) • 1,
  let f' : matrix n n α[X] →+* matrix n n α := (polynomial.eval_ring_hom 0).map_matrix,
  have f'_inv : ∀ M, f' (g M) = M,
  { intro,
    ext,
    simp [f', g], },
  have f'_adj : ∀ (M : matrix n n α), f' (adjugate (g M)) = adjugate M,
  { intro,
    rw [ring_hom.map_adjugate, f'_inv] },
  have f'_g_mul : ∀ (M N : matrix n n α), f' (g M ⬝ g N) = M ⬝ N,
  { intros,
    rw [←mul_eq_mul, ring_hom.map_mul, f'_inv, f'_inv, mul_eq_mul] },
  have hu : ∀ (M : matrix n n α), is_regular (g M).det,
  { intros M,
    refine polynomial.monic.is_regular _,
    simp only [g, polynomial.monic.def, ←polynomial.leading_coeff_det_X_one_add_C M, add_comm] },
  rw [←f'_adj, ←f'_adj, ←f'_adj, ←mul_eq_mul (f' (adjugate (g B))), ←f'.map_mul, mul_eq_mul,
      ←adjugate_mul_distrib_aux _ _ (hu A).left (hu B).left, ring_hom.map_adjugate,
      ring_hom.map_adjugate, f'_inv, f'_g_mul]
end

@[simp] lemma adjugate_pow (A : matrix n n α) (k : ℕ) :
  adjugate (A ^ k) = (adjugate A) ^ k :=
begin
  induction k with k IH,
  { simp },
  { rw [pow_succ', mul_eq_mul, adjugate_mul_distrib, IH, ←mul_eq_mul, pow_succ] }
end

lemma det_smul_adjugate_adjugate (A : matrix n n α) :
  det A • adjugate (adjugate A) = det A ^ (fintype.card n - 1) • A :=
begin
  have : A ⬝ (A.adjugate ⬝ A.adjugate.adjugate) = A ⬝ (A.det ^ (fintype.card n - 1) • 1),
  { rw [←adjugate_mul_distrib, adjugate_mul, adjugate_smul, adjugate_one], },
  rwa [←matrix.mul_assoc, mul_adjugate, matrix.mul_smul, matrix.mul_one, matrix.smul_mul,
    matrix.one_mul] at this,
end

/-- Note that this is not true for `fintype.card n = 1` since `1 - 2 = 0` and not `-1`. -/

  -- express `A` as an evaluation of a polynomial in n^2 variables, and solve in the polynomial ring
  -- where `A'.det` is non-zero.
  let A' := mv_polynomial_X n n ℤ,
  suffices : adjugate (adjugate A') = det A' ^ (fintype.card n - 2) • A',
  { rw [←mv_polynomial_X_map_matrix_aeval ℤ A, ←alg_hom.map_adjugate, ←alg_hom.map_adjugate, this,
      ←alg_hom.map_det, ← alg_hom.map_pow, alg_hom.map_matrix_apply, alg_hom.map_matrix_apply,
      matrix.map_smul' _ _ _ (_root_.map_mul _)] },
  have h_card' : fintype.card n - 2 + 1 = fintype.card n - 1,
  { simp [h_card] },

  have is_reg : is_smul_regular (mv_polynomial (n × n) ℤ) (det A') :=
    λ x y, mul_left_cancel₀ (det_mv_polynomial_X_ne_zero n ℤ),
  apply is_reg.matrix,
  rw [smul_smul, ←pow_succ, h_card', det_smul_adjugate_adjugate],
end

/-- A weaker version of `matrix.adjugate_adjugate` that uses `nontrivial`. -/
lemma adjugate_adjugate' (A : matrix n n α) [nontrivial n] :
  adjugate (adjugate A) = det A ^ (fintype.card n - 2) • A :=
adjugate_adjugate _ $ fintype.one_lt_card.ne'

end adjugate

end matrix


/-
Copyright (c) 2021 Alex Kontorovich and Heather Macbeth and Marc Masdeu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich, Heather Macbeth, Marc Masdeu
-/

import analysis.complex.upper_half_plane.basic
import analysis.normed_space.finite_dimension
import linear_algebra.general_linear_group
import linear_algebra.matrix.general_linear_group

/-!
# The action of the modular group SL(2, ℤ) on the upper half-plane

We define the action of `SL(2,ℤ)` on `ℍ` (via restriction of the `SL(2,ℝ)` action in
`analysis.complex.upper_half_plane`). We then define the standard fundamental domain
(`modular_group.fd`, `𝒟`) for this action and show
(`modular_group.exists_smul_mem_fd`) that any point in `ℍ` can be
moved inside `𝒟`.

## Main definitions

The standard (closed) fundamental domain of the action of `SL(2,ℤ)` on `ℍ`, denoted `𝒟`:
`fd := {z | 1 ≤ (z : ℂ).norm_sq ∧ |z.re| ≤ (1 : ℝ) / 2}`

The standard open fundamental domain of the action of `SL(2,ℤ)` on `ℍ`, denoted `𝒟ᵒ`:
`fdo := {z | 1 < (z : ℂ).norm_sq ∧ |z.re| < (1 : ℝ) / 2}`

These notations are localized in the `modular` locale and can be enabled via `open_locale modular`.

## Main results

Any `z : ℍ` can be moved to `𝒟` by an element of `SL(2,ℤ)`:
`exists_smul_mem_fd (z : ℍ) : ∃ g : SL(2,ℤ), g • z ∈ 𝒟`

If both `z` and `γ • z` are in the open domain `𝒟ᵒ` then `z = γ • z`:
`eq_smul_self_of_mem_fdo_mem_fdo {z : ℍ} {g : SL(2,ℤ)} (hz : z ∈ 𝒟ᵒ) (hg : g • z ∈ 𝒟ᵒ) : z = g • z`

# Discussion

Standard proofs make use of the identity

`g • z = a / c - 1 / (c (cz + d))`

for `g = [[a, b], [c, d]]` in `SL(2)`, but this requires separate handling of whether `c = 0`.
Instead, our proof makes use of the following perhaps novel identity (see
`modular_group.smul_eq_lc_row0_add`):

`g • z = (a c + b d) / (c^2 + d^2) + (d z - c) / ((c^2 + d^2) (c z + d))`

where there is no issue of division by zero.

Another feature is that we delay until the very end the consideration of special matrices
`T=[[1,1],[0,1]]` (see `modular_group.T`) and `S=[[0,-1],[1,0]]` (see `modular_group.S`), by
instead using abstract theory on the properness of certain maps (phrased in terms of the filters
`filter.cocompact`, `filter.cofinite`, etc) to deduce existence theorems, first to prove the
existence of `g` maximizing `(g•z).im` (see `modular_group.exists_max_im`), and then among
those, to minimize `|(g•z).re|` (see `modular_group.exists_row_one_eq_and_min_re`).
-/

/- Disable these instances as they are not the simp-normal form, and having them disabled ensures
we state lemmas in this file without spurious `coe_fn` terms. -/
local attribute [-instance] matrix.special_linear_group.has_coe_to_fun
local attribute [-instance] matrix.general_linear_group.has_coe_to_fun

open complex (hiding abs_two)
open matrix (hiding mul_smul) matrix.special_linear_group upper_half_plane
noncomputable theory

local notation `SL(` n `, ` R `)`:= special_linear_group (fin n) R
local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) ℤ) _

open_locale upper_half_plane complex_conjugate

local attribute [instance] fintype.card_fin_even

namespace modular_group

variables {g : SL(2, ℤ)} (z : ℍ)

section bottom_row

/-- The two numbers `c`, `d` in the "bottom_row" of `g=[[*,*],[c,d]]` in `SL(2, ℤ)` are coprime. -/
lemma bottom_row_coprime {R : Type*} [comm_ring R] (g : SL(2, R)) :
  is_coprime ((↑g : matrix (fin 2) (fin 2) R) 1 0) ((↑g : matrix (fin 2) (fin 2) R) 1 1) :=
begin
  use [- (↑g : matrix (fin 2) (fin 2) R) 0 1, (↑g : matrix (fin 2) (fin 2) R) 0 0],
  rw [add_comm, neg_mul, ←sub_eq_add_neg, ←det_fin_two],
  exact g.det_coe,
end

/-- Every pair `![c, d]` of coprime integers is the "bottom_row" of some element `g=[[*,*],[c,d]]`
of `SL(2,ℤ)`. -/
lemma bottom_row_surj {R : Type*} [comm_ring R] :
  set.surj_on (λ g : SL(2, R), @coe _ (matrix (fin 2) (fin 2) R) _ g 1) set.univ
    {cd | is_coprime (cd 0) (cd 1)} :=
begin
  rintros cd ⟨b₀, a, gcd_eqn⟩,
  let A := of ![![a, -b₀], cd],
  have det_A_1 : det A = 1,
  { convert gcd_eqn,
    simp [A, det_fin_two, (by ring : a * (cd 1) + b₀ * (cd 0) = b₀ * (cd 0) + a * (cd 1))] },
  refine ⟨⟨A, det_A_1⟩, set.mem_univ _, _⟩,
  ext; simp [A]
end

end bottom_row

section tendsto_lemmas

open filter continuous_linear_map
local attribute [simp] coe_smul

/-- The function `(c,d) → |cz+d|^2` is proper, that is, preimages of bounded-above sets are finite.
-/
lemma tendsto_norm_sq_coprime_pair :
  filter.tendsto (λ p : fin 2 → ℤ, ((p 0 : ℂ) * z + p 1).norm_sq)
  cofinite at_top :=
begin
  -- using this instance rather than the automatic `function.module` makes unification issues in
  -- `linear_equiv.closed_embedding_of_injective` less bad later in the proof.
  letI : module ℝ (fin 2 → ℝ) := normed_space.to_module,
  let π₀ : (fin 2 → ℝ) →ₗ[ℝ] ℝ := linear_map.proj 0,
  let π₁ : (fin 2 → ℝ) →ₗ[ℝ] ℝ := linear_map.proj 1,
  let f : (fin 2 → ℝ) →ₗ[ℝ] ℂ := π₀.smul_right (z:ℂ) + π₁.smul_right 1,
  have f_def : ⇑f = λ (p : fin 2 → ℝ), (p 0 : ℂ) * ↑z + p 1,
  { ext1,
    dsimp only [linear_map.coe_proj, real_smul,
      linear_map.coe_smul_right, linear_map.add_apply],
    rw mul_one, },
  have : (λ (p : fin 2 → ℤ), norm_sq ((p 0 : ℂ) * ↑z + ↑(p 1)))
    = norm_sq ∘ f ∘ (λ p : fin 2 → ℤ, (coe : ℤ → ℝ) ∘ p),
  { ext1,
    rw f_def,
    dsimp only [function.comp],
    rw [of_real_int_cast, of_real_int_cast], },
  rw this,
  have hf : f.ker = ⊥,
  { let g : ℂ →ₗ[ℝ] (fin 2 → ℝ) :=
      linear_map.pi ![im_lm, im_lm.comp ((z:ℂ) • ((conj_ae : ℂ →ₐ[ℝ] ℂ) : ℂ →ₗ[ℝ] ℂ))],
    suffices : ((z:ℂ).im⁻¹ • g).comp f = linear_map.id,
    { exact linear_map.ker_eq_bot_of_inverse this },
    apply linear_map.ext,
    intros c,
    have hz : (z:ℂ).im ≠ 0 := z.2.ne',
    rw [linear_map.comp_apply, linear_map.smul_apply, linear_map.id_apply],
    ext i,
    dsimp only [g, pi.smul_apply, linear_map.pi_apply, smul_eq_mul],
    fin_cases i,
    { show ((z : ℂ).im)⁻¹ * (f c).im = c 0,
      rw [f_def, add_im, of_real_mul_im, of_real_im, add_zero, mul_left_comm,
        inv_mul_cancel hz, mul_one], },
    { show ((z : ℂ).im)⁻¹ * ((z : ℂ) * conj (f c)).im = c 1,
      rw [f_def, ring_hom.map_add, ring_hom.map_mul, mul_add, mul_left_comm, mul_conj,
        conj_of_real, conj_of_real, ← of_real_mul, add_im, of_real_im, zero_add,
        inv_mul_eq_iff_eq_mul₀ hz],
      simp only [of_real_im, of_real_re, mul_im, zero_add, mul_zero] } },
  have hf' : closed_embedding f,
  { -- for some reason we get a timeout if we try and apply this lemma in a more sensible way
    have := @linear_equiv.closed_embedding_of_injective ℝ _ (fin 2 → ℝ) _ (id _) ℂ _ _ _ _,
    rotate 2,
    exact f,
    exact this hf },
  have h₂ : tendsto (λ p : fin 2 → ℤ, (coe : ℤ → ℝ) ∘ p) cofinite (cocompact _),
  { convert tendsto.pi_map_Coprod (λ i, int.tendsto_coe_cofinite),
    { rw Coprod_cofinite },
    { rw Coprod_cocompact } },
  exact tendsto_norm_sq_cocompact_at_top.comp (hf'.tendsto_cocompact.comp h₂),
end

/-- Given `coprime_pair` `p=(c,d)`, the matrix `[[a,b],[*,*]]` is sent to `a*c+b*d`.
  This is the linear map version of this operation.
-/
def lc_row0 (p : fin 2 → ℤ) : (matrix (fin 2) (fin 2) ℝ) →ₗ[ℝ] ℝ :=
((p 0:ℝ) • linear_map.proj 0 + (p 1:ℝ) • linear_map.proj 1 : (fin 2 → ℝ) →ₗ[ℝ] ℝ).comp
  (linear_map.proj 0)

@[simp] lemma lc_row0_apply (p : fin 2 → ℤ) (g : matrix (fin 2) (fin 2) ℝ) :
  lc_row0 p g = p 0 * g 0 0 + p 1 * g 0 1 :=
rfl

/-- Linear map sending the matrix [a, b; c, d] to the matrix [ac₀ + bd₀, - ad₀ + bc₀; c, d], for
some fixed `(c₀, d₀)`. -/
@[simps] def lc_row0_extend {cd : fin 2 → ℤ} (hcd : is_coprime (cd 0) (cd 1)) :
  (matrix (fin 2) (fin 2) ℝ) ≃ₗ[ℝ] matrix (fin 2) (fin 2) ℝ :=
linear_equiv.Pi_congr_right
![begin
    refine linear_map.general_linear_group.general_linear_equiv ℝ (fin 2 → ℝ)
      (general_linear_group.to_linear (plane_conformal_matrix (cd 0 : ℝ) (-(cd 1 : ℝ)) _)),
    norm_cast,
    rw neg_sq,
    exact hcd.sq_add_sq_ne_zero
  end,
  linear_equiv.refl ℝ (fin 2 → ℝ)]

/-- The map `lc_row0` is proper, that is, preimages of cocompact sets are finite in
`[[* , *], [c, d]]`.-/
theorem tendsto_lc_row0 {cd : fin 2 → ℤ} (hcd : is_coprime (cd 0) (cd 1)) :
  tendsto (λ g : {g : SL(2, ℤ) // ↑ₘg 1 = cd}, lc_row0 cd ↑(↑g : SL(2, ℝ)))
    cofinite (cocompact ℝ) :=
begin
  let mB : ℝ → (matrix (fin 2) (fin 2) ℝ) := λ t, of ![![t, (-(1:ℤ):ℝ)], coe ∘ cd],
  have hmB : continuous mB,
  { refine continuous_matrix _,
    simp only [fin.forall_fin_two, mB, continuous_const, continuous_id', of_apply,
      cons_val_zero, cons_val_one, and_self ] },
  refine filter.tendsto.of_tendsto_comp _ (comap_cocompact_le hmB),
  let f₁ : SL(2, ℤ) → matrix (fin 2) (fin 2) ℝ :=
    λ g, matrix.map (↑g : matrix _ _ ℤ) (coe : ℤ → ℝ),
  have cocompact_ℝ_to_cofinite_ℤ_matrix :
    tendsto (λ m : matrix (fin 2) (fin 2) ℤ, matrix.map m (coe : ℤ → ℝ)) cofinite (cocompact _),
  { simpa only [Coprod_cofinite, Coprod_cocompact]
      using tendsto.pi_map_Coprod (λ i : fin 2, tendsto.pi_map_Coprod
        (λ j : fin 2, int.tendsto_coe_cofinite)) },
  have hf₁ : tendsto f₁ cofinite (cocompact _) :=
    cocompact_ℝ_to_cofinite_ℤ_matrix.comp subtype.coe_injective.tendsto_cofinite,
  have hf₂ : closed_embedding (lc_row0_extend hcd) :=
    (lc_row0_extend hcd).to_continuous_linear_equiv.to_homeomorph.closed_embedding,
  convert hf₂.tendsto_cocompact.comp (hf₁.comp subtype.coe_injective.tendsto_cofinite) using 1,
  ext ⟨g, rfl⟩ i j : 3,
  fin_cases i; [fin_cases j, skip],
  -- the following are proved by `simp`, but it is replaced by `simp only` to avoid timeouts.
  { simp only [mB, mul_vec, dot_product, fin.sum_univ_two, _root_.coe_coe, coe_matrix_coe,
      int.coe_cast_ring_hom, lc_row0_apply, function.comp_app, cons_val_zero, lc_row0_extend_apply,
      linear_map.general_linear_group.coe_fn_general_linear_equiv,
      general_linear_group.to_linear_apply, coe_plane_conformal_matrix, neg_neg, mul_vec_lin_apply,
      cons_val_one, head_cons, of_apply] },
  { convert congr_arg (λ n : ℤ, (-n:ℝ)) g.det_coe.symm using 1,
    simp only [f₁, mul_vec, dot_product, fin.sum_univ_two, matrix.det_fin_two, function.comp_app,
      subtype.coe_mk, lc_row0_extend_apply, cons_val_zero,
      linear_map.general_linear_group.coe_fn_general_linear_equiv,
      general_linear_group.to_linear_apply, coe_plane_conformal_matrix, mul_vec_lin_apply,
      cons_val_one, head_cons, map_apply, neg_mul, int.cast_sub, int.cast_mul, neg_sub, of_apply],
    ring },
  { refl }
end

/-- This replaces `(g•z).re = a/c + *` in the standard theory with the following novel identity:
  `g • z = (a c + b d) / (c^2 + d^2) + (d z - c) / ((c^2 + d^2) (c z + d))`
  which does not need to be decomposed depending on whether `c = 0`. -/
lemma smul_eq_lc_row0_add {p : fin 2 → ℤ} (hp : is_coprime (p 0) (p 1)) (hg : ↑ₘg 1 = p) :
  ↑(g • z) = ((lc_row0 p ↑(g : SL(2, ℝ))) : ℂ) / (p 0 ^ 2 + p 1 ^ 2)
    + ((p 1 : ℂ) * z - p 0) / ((p 0 ^ 2 + p 1 ^ 2) * (p 0 * z + p 1)) :=
begin
  have nonZ1 : (p 0 : ℂ) ^ 2 + (p 1) ^ 2 ≠ 0 := by exact_mod_cast hp.sq_add_sq_ne_zero,
  have : (coe : ℤ → ℝ) ∘ p ≠ 0 := λ h, hp.ne_zero (by ext i; simpa using congr_fun h i),
  have nonZ2 : (p 0 : ℂ) * z + p 1 ≠ 0 := by simpa using linear_ne_zero _ z this,
  field_simp [nonZ1, nonZ2, denom_ne_zero, -upper_half_plane.denom, -denom_apply],
  rw (by simp : (p 1 : ℂ) * z - p 0 = ((p 1) * z - p 0) * ↑(det (↑g : matrix (fin 2) (fin 2) ℤ))),
  rw [←hg, det_fin_two],
  simp only [int.coe_cast_ring_hom, coe_matrix_coe, int.cast_mul, of_real_int_cast, map_apply,
  denom, int.cast_sub, _root_.coe_coe,coe_GL_pos_coe_GL_coe_matrix],
  ring,
end

lemma tendsto_abs_re_smul {p : fin 2 → ℤ} (hp : is_coprime (p 0) (p 1)) :
  tendsto (λ g : {g : SL(2, ℤ) // ↑ₘg 1 = p}, |((g : SL(2, ℤ)) • z).re|)
    cofinite at_top :=
begin
  suffices : tendsto (λ g : (λ g : SL(2, ℤ), ↑ₘg 1) ⁻¹' {p}, (((g : SL(2, ℤ)) • z).re))
    cofinite (cocompact ℝ),
  { exact tendsto_norm_cocompact_at_top.comp this },
  have : ((p 0 : ℝ) ^ 2 + p 1 ^ 2)⁻¹ ≠ 0,
  { apply inv_ne_zero,
    exact_mod_cast hp.sq_add_sq_ne_zero },
  let f := homeomorph.mul_right₀ _ this,
  let ff := homeomorph.add_right (((p 1:ℂ)* z - p 0) / ((p 0 ^ 2 + p 1 ^ 2) * (p 0 * z + p 1))).re,
  convert ((f.trans ff).closed_embedding.tendsto_cocompact).comp (tendsto_lc_row0 hp),
  ext g,
  change ((g : SL(2, ℤ)) • z).re = (lc_row0 p ↑(↑g : SL(2, ℝ))) / (p 0 ^ 2 + p 1 ^ 2)
  + (((p 1:ℂ )* z - p 0) / ((p 0 ^ 2 + p 1 ^ 2) * (p 0 * z + p 1))).re,
  exact_mod_cast (congr_arg complex.re (smul_eq_lc_row0_add z hp g.2))
end

end tendsto_lemmas

section fundamental_domain

local attribute [simp] coe_smul re_smul

/-- For `z : ℍ`, there is a `g : SL(2,ℤ)` maximizing `(g•z).im` -/
lemma exists_max_im :
  ∃ g : SL(2, ℤ), ∀ g' : SL(2, ℤ), (g' • z).im ≤ (g • z).im :=
begin
  classical,
  let s : set (fin 2 → ℤ) := {cd | is_coprime (cd 0) (cd 1)},
  have hs : s.nonempty := ⟨![1, 1], is_coprime_one_left⟩,
  obtain ⟨p, hp_coprime, hp⟩ :=
    filter.tendsto.exists_within_forall_le hs (tendsto_norm_sq_coprime_pair z),
  obtain ⟨g, -, hg⟩ := bottom_row_surj hp_coprime,
  refine ⟨g, λ g', _⟩,
  rw [special_linear_group.im_smul_eq_div_norm_sq, special_linear_group.im_smul_eq_div_norm_sq,
    div_le_div_left],
  { simpa [← hg] using hp (↑ₘg' 1) (bottom_row_coprime g') },
  { exact z.im_pos },
  { exact norm_sq_denom_pos g' z },
  { exact norm_sq_denom_pos g z },
end

/-- Given `z : ℍ` and a bottom row `(c,d)`, among the `g : SL(2,ℤ)` with this bottom row, minimize
  `|(g•z).re|`.  -/
lemma exists_row_one_eq_and_min_re {cd : fin 2 → ℤ} (hcd : is_coprime (cd 0) (cd 1)) :
  ∃ g : SL(2,ℤ), ↑ₘg 1 = cd ∧ (∀ g' : SL(2,ℤ), ↑ₘg 1 = ↑ₘg' 1 →
  |(g • z).re| ≤ |(g' • z).re|) :=
begin
  haveI : nonempty {g : SL(2, ℤ) // ↑ₘg 1 = cd} :=
    let ⟨x, hx⟩ := bottom_row_surj hcd in ⟨⟨x, hx.2⟩⟩,
  obtain ⟨g, hg⟩ := filter.tendsto.exists_forall_le (tendsto_abs_re_smul z hcd),
  refine ⟨g, g.2, _⟩,
  { intros g1 hg1,
    have : g1 ∈ ((λ g : SL(2, ℤ), ↑ₘg 1) ⁻¹' {cd}),
    { rw [set.mem_preimage, set.mem_singleton_iff],
      exact eq.trans hg1.symm (set.mem_singleton_iff.mp (set.mem_preimage.mp g.2)) },
    exact hg ⟨g1, this⟩ },
end

lemma coe_T_zpow_smul_eq {n : ℤ} : (↑((T^n) • z) : ℂ) = z + n :=
by simp [coe_T_zpow]

lemma re_T_zpow_smul (n : ℤ) : ((T^n) • z).re = z.re + n :=
by rw [←coe_re, coe_T_zpow_smul_eq, add_re, int_cast_re, coe_re]

lemma im_T_zpow_smul (n : ℤ) : ((T^n) • z).im = z.im :=
by rw [←coe_im, coe_T_zpow_smul_eq, add_im, int_cast_im, add_zero, coe_im]

lemma re_T_smul : (T • z).re = z.re + 1 := by simpa using re_T_zpow_smul z 1
lemma im_T_smul : (T • z).im = z.im := by simpa using im_T_zpow_smul z 1
lemma re_T_inv_smul : (T⁻¹ • z).re = z.re - 1 := by simpa using re_T_zpow_smul z (-1)
lemma im_T_inv_smul : (T⁻¹ • z).im = z.im := by simpa using im_T_zpow_smul z (-1)

variables {z}

-- If instead we had `g` and `T` of type `PSL(2, ℤ)`, then we could simply state `g = T^n`.
lemma exists_eq_T_zpow_of_c_eq_zero (hc : ↑ₘg 1 0 = 0) :
  ∃ (n : ℤ), ∀ (z : ℍ), g • z = T^n • z :=
begin
  have had := g.det_coe,
  replace had : ↑ₘg 0 0 * ↑ₘg 1 1 = 1, { rw [det_fin_two, hc] at had, linarith, },
  rcases int.eq_one_or_neg_one_of_mul_eq_one' had with ⟨ha, hd⟩ | ⟨ha, hd⟩,
  { use ↑ₘg 0 1,
    suffices : g = T^(↑ₘg 0 1), { intros z, conv_lhs { rw this, }, },
    ext i j, fin_cases i; fin_cases j;
    simp [ha, hc, hd, coe_T_zpow], },
  { use -↑ₘg 0 1,
    suffices : g = -T^(-↑ₘg 0 1), { intros z, conv_lhs { rw [this, SL_neg_smul], }, },
    ext i j, fin_cases i; fin_cases j;
    simp [ha, hc, hd, coe_T_zpow], },
end

/- If `c = 1`, then `g` factorises into a product terms involving only `T` and `S`. -/
lemma g_eq_of_c_eq_one (hc : ↑ₘg 1 0 = 1) :
  g = T^(↑ₘg 0 0) * S * T^(↑ₘg 1 1) :=
begin
  have hg := g.det_coe.symm,
  replace hg : ↑ₘg 0 1 = ↑ₘg 0 0 * ↑ₘg 1 1 - 1, { rw [det_fin_two, hc] at hg, linarith, },
  refine subtype.ext _,
  conv_lhs { rw matrix.eta_fin_two ↑ₘg },
  rw [hc, hg],
  simp only [coe_mul, coe_T_zpow, coe_S, mul_fin_two],
  congrm !![_, _; _, _]; ring
end

/-- If `1 < |z|`, then `|S • z| < 1`. -/
lemma norm_sq_S_smul_lt_one (h: 1 < norm_sq z) : norm_sq ↑(S • z) < 1 :=
by simpa [coe_S] using (inv_lt_inv z.norm_sq_pos zero_lt_one).mpr h

/-- If `|z| < 1`, then applying `S` strictly decreases `im`. -/
lemma im_lt_im_S_smul (h: norm_sq z < 1) : z.im < (S • z).im :=
begin
  have : z.im < z.im / norm_sq (z:ℂ),
  { have imz : 0 < z.im := im_pos z,
    apply (lt_div_iff z.norm_sq_pos).mpr,
    nlinarith },
  convert this,
  simp only [special_linear_group.im_smul_eq_div_norm_sq],
  field_simp [norm_sq_denom_ne_zero, norm_sq_ne_zero, S]
end

/-- The standard (closed) fundamental domain of the action of `SL(2,ℤ)` on `ℍ`. -/
def fd : set ℍ :=
{z | 1 ≤ (z : ℂ).norm_sq ∧ |z.re| ≤ (1 : ℝ) / 2}

/-- The standard open fundamental domain of the action of `SL(2,ℤ)` on `ℍ`. -/
def fdo : set ℍ :=
{z | 1 < (z : ℂ).norm_sq ∧ |z.re| < (1 : ℝ) / 2}

localized "notation (name := modular_group.fd) `𝒟` := modular_group.fd" in modular

localized "notation (name := modular_group.fdo) `𝒟ᵒ` := modular_group.fdo" in modular

lemma abs_two_mul_re_lt_one_of_mem_fdo (h : z ∈ 𝒟ᵒ) : |2 * z.re| < 1 :=
begin
  rw [abs_mul, abs_two, ← lt_div_iff' (zero_lt_two' ℝ)],
  exact h.2,
end

lemma three_lt_four_mul_im_sq_of_mem_fdo (h : z ∈ 𝒟ᵒ) : 3 < 4 * z.im^2 :=
begin
  have : 1 < z.re * z.re + z.im * z.im := by simpa [complex.norm_sq_apply] using h.1,
  have := h.2,
  cases abs_cases z.re;
  nlinarith,
end

/-- If `z ∈ 𝒟ᵒ`, and `n : ℤ`, then `|z + n| > 1`. -/
lemma one_lt_norm_sq_T_zpow_smul (hz : z ∈ 𝒟ᵒ) (n : ℤ) : 1 < norm_sq (((T^n) • z) : ℍ) :=
begin
  have hz₁ : 1 < z.re * z.re + z.im * z.im := hz.1,
  have hzn := int.nneg_mul_add_sq_of_abs_le_one n (abs_two_mul_re_lt_one_of_mem_fdo hz).le,
  have : 1 < (z.re + ↑n) * (z.re + ↑n) + z.im * z.im, { linarith, },
  simpa [coe_T_zpow, norm_sq],
end

lemma eq_zero_of_mem_fdo_of_T_zpow_mem_fdo {n : ℤ} (hz : z ∈ 𝒟ᵒ) (hg : (T^n) • z ∈ 𝒟ᵒ) : n = 0 :=
begin
  suffices : |(n : ℝ)| < 1,
  { rwa [← int.cast_abs, ← int.cast_one, int.cast_lt, int.abs_lt_one_iff] at this, },
  have h₁ := hz.2,
  have h₂ := hg.2,
  rw [re_T_zpow_smul] at h₂,
  calc |(n : ℝ)| ≤ |z.re| + |z.re + (n : ℝ)| : abs_add' (n : ℝ) z.re
             ... < 1/2 + 1/2 : add_lt_add h₁ h₂
             ... = 1 : add_halves 1,
end

/-- Any `z : ℍ` can be moved to `𝒟` by an element of `SL(2,ℤ)`  -/
lemma exists_smul_mem_fd (z : ℍ) : ∃ g : SL(2,ℤ), g • z ∈ 𝒟 :=
begin
  -- obtain a g₀ which maximizes im (g • z),
  obtain ⟨g₀, hg₀⟩ := exists_max_im z,
  -- then among those, minimize re
  obtain ⟨g, hg, hg'⟩ := exists_row_one_eq_and_min_re z (bottom_row_coprime g₀),
  refine ⟨g, _⟩,
  -- `g` has same max im property as `g₀`
  have hg₀' : ∀ (g' : SL(2,ℤ)), (g' • z).im ≤ (g • z).im,
  { have hg'' : (g • z).im = (g₀ • z).im,
    { rw [special_linear_group.im_smul_eq_div_norm_sq, special_linear_group.im_smul_eq_div_norm_sq,
      denom_apply, denom_apply, hg]},
    simpa only [hg''] using hg₀ },
  split,
  { -- Claim: `1 ≤ ⇑norm_sq ↑(g • z)`. If not, then `S•g•z` has larger imaginary part
    contrapose! hg₀',
    refine ⟨S * g, _⟩,
    rw mul_smul,
    exact im_lt_im_S_smul hg₀' },
  { show |(g • z).re| ≤ 1 / 2, -- if not, then either `T` or `T'` decrease |Re|.
    rw abs_le,
    split,
    { contrapose! hg',
      refine ⟨T * g, (T_mul_apply_one _).symm, _⟩,
      rw [mul_smul, re_T_smul],
      cases abs_cases ((g • z).re + 1); cases abs_cases (g • z).re; linarith },
    { contrapose! hg',
      refine ⟨T⁻¹ * g, (T_inv_mul_apply_one _).symm, _⟩,
      rw [mul_smul, re_T_inv_smul],
      cases abs_cases ((g • z).re - 1); cases abs_cases (g • z).re; linarith } }
end

section unique_representative

variables {z}

/-- An auxiliary result en route to `modular_group.c_eq_zero`. -/
lemma abs_c_le_one (hz : z ∈ 𝒟ᵒ) (hg : g • z ∈ 𝒟ᵒ) : |↑ₘg 1 0| ≤ 1 :=
begin
  let c' : ℤ := ↑ₘg 1 0,
  let c : ℝ := (c' : ℝ),
  suffices : 3 * c^2 < 4,
  { rw [← int.cast_pow, ← int.cast_three, ← int.cast_four, ← int.cast_mul, int.cast_lt] at this,
    replace this : c' ^ 2 ≤ 1 ^ 2, { linarith, },
    rwa [sq_le_sq, abs_one] at this },
  suffices : c ≠ 0 → 9 * c^4 < 16,
  { rcases eq_or_ne c 0 with hc | hc,
    { rw hc, norm_num, },
    { refine (abs_lt_of_sq_lt_sq' _ (by norm_num)).2,
      specialize this hc,
      linarith, }, },
  intros hc,
  replace hc : 0 < c^4, { rw pow_bit0_pos_iff; trivial, },
  have h₁ := mul_lt_mul_of_pos_right (mul_lt_mul'' (three_lt_four_mul_im_sq_of_mem_fdo hg)
      (three_lt_four_mul_im_sq_of_mem_fdo hz) (by linarith) (by linarith)) hc,
  have h₂ : (c * z.im) ^ 4 / norm_sq (denom ↑g z) ^ 2 ≤ 1 :=
    div_le_one_of_le (pow_four_le_pow_two_of_pow_two_le
      (upper_half_plane.c_mul_im_sq_le_norm_sq_denom z g)) (sq_nonneg _),
  let nsq := norm_sq (denom g z),
  calc 9 * c^4 < c^4 * z.im^2 * (g • z).im^2 * 16 : by linarith
           ... = c^4 * z.im^4 / nsq^2 * 16 : by { rw [special_linear_group.im_smul_eq_div_norm_sq,
            div_pow], ring, }
           ... ≤ 16 : by { rw ← mul_pow, linarith, },
end

/-- An auxiliary result en route to `modular_group.eq_smul_self_of_mem_fdo_mem_fdo`. -/
lemma c_eq_zero (hz : z ∈ 𝒟ᵒ) (hg : g • z ∈ 𝒟ᵒ) : ↑ₘg 1 0 = 0 :=
begin
  have hp : ∀ {g' : SL(2, ℤ)} (hg' : g' • z ∈ 𝒟ᵒ), ↑ₘg' 1 0 ≠ 1,
  { intros,
    by_contra hc,
    let a := ↑ₘg' 0 0,
    let d := ↑ₘg' 1 1,
    have had : T^(-a) * g' = S * T^d, { rw g_eq_of_c_eq_one hc, group, },
    let w := T^(-a) • (g' • z),
    have h₁ : w = S • (T^d • z), { simp only [w, ← mul_smul, had], },
    replace h₁ : norm_sq w < 1 := h₁.symm ▸ norm_sq_S_smul_lt_one (one_lt_norm_sq_T_zpow_smul hz d),
    have h₂ : 1 < norm_sq w := one_lt_norm_sq_T_zpow_smul hg' (-a),
    linarith, },
  have hn : ↑ₘg 1 0 ≠ -1,
  { intros hc,
    replace hc : ↑ₘ(-g) 1 0 = 1, { simp [← neg_eq_iff_eq_neg.mpr hc], },
    replace hg : (-g) • z ∈ 𝒟ᵒ := (SL_neg_smul g z).symm ▸ hg,
    exact hp hg hc, },
  specialize hp hg,
  rcases (int.abs_le_one_iff.mp $ abs_c_le_one hz hg);
  tauto,
end

/-- Second Main Fundamental Domain Lemma: if both `z` and `g • z` are in the open domain `𝒟ᵒ`,
where `z : ℍ` and `g : SL(2,ℤ)`, then `z = g • z`. -/
lemma eq_smul_self_of_mem_fdo_mem_fdo (hz : z ∈ 𝒟ᵒ) (hg : g • z ∈ 𝒟ᵒ) : z = g • z :=
begin
  obtain ⟨n, hn⟩ := exists_eq_T_zpow_of_c_eq_zero (c_eq_zero hz hg),
  rw hn at hg ⊢,
  simp [eq_zero_of_mem_fdo_of_T_zpow_mem_fdo hz hg, one_smul],
end

end unique_representative

end fundamental_domain

end modular_group


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Yury Kudryashov
-/
import data.set.lattice

/-!
# Extra lemmas about intervals

This file contains lemmas about intervals that cannot be included into `data.set.intervals.basic`
because this would create an `import` cycle. Namely, lemmas in this file can use definitions
from `data.set.lattice`, including `disjoint`.
-/

universes u v w

variables {ι : Sort u} {α : Type v} {β : Type w}

open set order_dual (to_dual)

namespace set

section preorder
variables [preorder α] {a b c : α}

@[simp] lemma Iic_disjoint_Ioi (h : a ≤ b) : disjoint (Iic a) (Ioi b) :=
λ x ⟨ha, hb⟩, not_le_of_lt (h.trans_lt hb) ha

@[simp] lemma Iic_disjoint_Ioc (h : a ≤ b) : disjoint (Iic a) (Ioc b c) :=
(Iic_disjoint_Ioi h).mono le_rfl (λ _, and.left)

@[simp] lemma Ioc_disjoint_Ioc_same {a b c : α} : disjoint (Ioc a b) (Ioc b c) :=
(Iic_disjoint_Ioc (le_refl b)).mono (λ _, and.right) le_rfl

@[simp] lemma Ico_disjoint_Ico_same {a b c : α} : disjoint (Ico a b) (Ico b c) :=
λ x hx, not_le_of_lt hx.1.2 hx.2.1

@[simp] lemma Ici_disjoint_Iic : disjoint (Ici a) (Iic b) ↔ ¬(a ≤ b) :=
by rw [set.disjoint_iff_inter_eq_empty, Ici_inter_Iic, Icc_eq_empty_iff]

@[simp] lemma Iic_disjoint_Ici : disjoint (Iic a) (Ici b) ↔ ¬(b ≤ a) :=
disjoint.comm.trans Ici_disjoint_Iic

@[simp] lemma Union_Iic : (⋃ a : α, Iic a) = univ := Union_eq_univ_iff.2 $ λ x, ⟨x, right_mem_Iic⟩
@[simp] lemma Union_Ici : (⋃ a : α, Ici a) = univ := Union_eq_univ_iff.2 $ λ x, ⟨x, left_mem_Ici⟩

@[simp] lemma Union_Icc_right (a : α) : (⋃ b, Icc a b) = Ici a :=
by simp only [← Ici_inter_Iic, ← inter_Union, Union_Iic, inter_univ]

@[simp] lemma Union_Ioc_right (a : α) : (⋃ b, Ioc a b) = Ioi a :=
by simp only [← Ioi_inter_Iic, ← inter_Union, Union_Iic, inter_univ]

@[simp] lemma Union_Icc_left (b : α) : (⋃ a, Icc a b) = Iic b :=
by simp only [← Ici_inter_Iic, ← Union_inter, Union_Ici, univ_inter]

@[simp] lemma Union_Ico_left (b : α) : (⋃ a, Ico a b) = Iio b :=
by simp only [← Ici_inter_Iio, ← Union_inter, Union_Ici, univ_inter]

@[simp] lemma Union_Iio [no_max_order α] : (⋃ a : α, Iio a) = univ :=
Union_eq_univ_iff.2 exists_gt

@[simp] lemma Union_Ioi [no_min_order α] : (⋃ a : α, Ioi a) = univ :=
Union_eq_univ_iff.2 exists_lt

@[simp] lemma Union_Ico_right [no_max_order α] (a : α) : (⋃ b, Ico a b) = Ici a :=
by simp only [← Ici_inter_Iio, ← inter_Union, Union_Iio, inter_univ]

@[simp] lemma Union_Ioo_right [no_max_order α] (a : α) : (⋃ b, Ioo a b) = Ioi a :=
by simp only [← Ioi_inter_Iio, ← inter_Union, Union_Iio, inter_univ]

@[simp] lemma Union_Ioc_left [no_min_order α] (b : α) : (⋃ a, Ioc a b) = Iic b :=
by simp only [← Ioi_inter_Iic, ← Union_inter, Union_Ioi, univ_inter]

@[simp] lemma Union_Ioo_left [no_min_order α] (b : α) : (⋃ a, Ioo a b) = Iio b :=
by simp only [← Ioi_inter_Iio, ← Union_inter, Union_Ioi, univ_inter]

end preorder

section linear_order
variables [linear_order α] {a₁ a₂ b₁ b₂ : α}

@[simp] lemma Ico_disjoint_Ico : disjoint (Ico a₁ a₂) (Ico b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
by simp_rw [set.disjoint_iff_inter_eq_empty, Ico_inter_Ico, Ico_eq_empty_iff,
  inf_eq_min, sup_eq_max, not_lt]

@[simp] lemma Ioc_disjoint_Ioc : disjoint (Ioc a₁ a₂) (Ioc b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
have h : _ ↔ min (to_dual a₁) (to_dual b₁) ≤ max (to_dual a₂) (to_dual b₂) := Ico_disjoint_Ico,
by simpa only [dual_Ico] using h

/-- If two half-open intervals are disjoint and the endpoint of one lies in the other,
  then it must be equal to the endpoint of the other. -/
lemma eq_of_Ico_disjoint {x₁ x₂ y₁ y₂ : α}
  (h : disjoint (Ico x₁ x₂) (Ico y₁ y₂)) (hx : x₁ < x₂) (h2 : x₂ ∈ Ico y₁ y₂) :
  y₁ = x₂ :=
begin
  rw [Ico_disjoint_Ico, min_eq_left (le_of_lt h2.2), le_max_iff] at h,
  apply le_antisymm h2.1,
  exact h.elim (λ h, absurd hx (not_lt_of_le h)) id
end

@[simp] lemma Union_Ico_eq_Iio_self_iff {f : ι → α} {a : α} :
  (⋃ i, Ico (f i) a) = Iio a ↔ ∀ x < a, ∃ i, f i ≤ x :=
by simp [← Ici_inter_Iio, ← Union_inter, subset_def]

@[simp] lemma Union_Ioc_eq_Ioi_self_iff {f : ι → α} {a : α} :
  (⋃ i, Ioc a (f i)) = Ioi a ↔ ∀ x, a < x → ∃ i, x ≤ f i :=
by simp [← Ioi_inter_Iic, ← inter_Union, subset_def]

@[simp] lemma bUnion_Ico_eq_Iio_self_iff {p : ι → Prop} {f : Π i, p i → α} {a : α} :
  (⋃ i (hi : p i), Ico (f i hi) a) = Iio a ↔ ∀ x < a, ∃ i hi, f i hi ≤ x :=
by simp [← Ici_inter_Iio, ← Union_inter, subset_def]

@[simp]

end linear_order

end set

section Union_Ixx

variables [linear_order α] {s : set α} {a : α} {f : ι → α}

lemma is_glb.bUnion_Ioi_eq (h : is_glb s a) : (⋃ x ∈ s, Ioi x) = Ioi a :=
begin
  refine (Union₂_subset $ λ x hx, _).antisymm (λ x hx, _),
  { exact Ioi_subset_Ioi (h.1 hx) },
  { rcases h.exists_between hx with ⟨y, hys, hay, hyx⟩,
    exact mem_bUnion hys hyx }
end

lemma is_glb.Union_Ioi_eq (h : is_glb (range f) a) :
  (⋃ x, Ioi (f x)) = Ioi a :=
bUnion_range.symm.trans h.bUnion_Ioi_eq

lemma is_lub.bUnion_Iio_eq (h : is_lub s a) :
  (⋃ x ∈ s, Iio x) = Iio a :=
h.dual.bUnion_Ioi_eq

lemma is_lub.Union_Iio_eq (h : is_lub (range f) a) :
  (⋃ x, Iio (f x)) = Iio a :=
h.dual.Union_Ioi_eq

end Union_Ixx


/-
Copyright (c) 2018 Johan Commelin All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Chris Hughes, Kevin Buzzard
-/
import algebra.group.hom
/-!
# Lift monoid homomorphisms to group homomorphisms of their units subgroups.
-/

universes u v w

namespace units
variables {M : Type u} {N : Type v} {P : Type w} [monoid M] [monoid N] [monoid P]

/-- The group homomorphism on units induced by a `monoid_hom`. -/
@[to_additive "The `add_group` homomorphism on `add_unit`s induced by an `add_monoid_hom`."]
def map (f : M →* N) : units M →* units N :=
monoid_hom.mk'
  (λ u, ⟨f u.val, f u.inv,
                  by rw [← f.map_mul, u.val_inv, f.map_one],
                  by rw [← f.map_mul, u.inv_val, f.map_one]⟩)
  (λ x y, ext (f.map_mul x y))

@[simp, to_additive] lemma coe_map (f : M →* N) (x : units M) : ↑(map f x) = f x := rfl

@[simp, to_additive] lemma coe_map_inv (f : M →* N) (u : units M) :
  ↑(map f u)⁻¹ = f ↑u⁻¹ :=
rfl

@[simp, to_additive]
lemma map_comp (f : M →* N) (g : N →* P) : map (g.comp f) = (map g).comp (map f) := rfl

variables (M)
@[simp, to_additive] lemma map_id : map (monoid_hom.id M) = monoid_hom.id (units M) :=
by ext; refl

/-- Coercion `units M → M` as a monoid homomorphism. -/
@[to_additive "Coercion `add_units M → M` as an add_monoid homomorphism."]
def coe_hom : units M →* M := ⟨coe, coe_one, coe_mul⟩

variable {M}

@[simp, to_additive] lemma coe_hom_apply (x : units M) : coe_hom M x = ↑x := rfl

/-- If a map `g : M → units N` agrees with a homomorphism `f : M →* N`, then
this map is a monoid homomorphism too. -/
@[to_additive "If a map `g : M → add_units N` agrees with a homomorphism `f : M →+ N`, then this map
is an add_monoid homomorphism too."]
def lift_right (f : M →* N) (g : M → units N) (h : ∀ x, ↑(g x) = f x) :
  M →* units N :=
{ to_fun := g,
  map_one' := units.ext $ (h 1).symm ▸ f.map_one,
  map_mul' := λ x y, units.ext $ by simp only [h, coe_mul, f.map_mul] }

@[simp, to_additive] lemma coe_lift_right {f : M →* N} {g : M → units N}
  (h : ∀ x, ↑(g x) = f x) (x) : (lift_right f g h x : N) = f x := h x

@[simp, to_additive] lemma mul_lift_right_inv {f : M →* N} {g : M → units N}
  (h : ∀ x, ↑(g x) = f x) (x) : f x * ↑(lift_right f g h x)⁻¹ = 1 :=
by rw [units.mul_inv_eq_iff_eq_mul, one_mul, coe_lift_right]

@[simp, to_additive] lemma lift_right_inv_mul {f : M →* N} {g : M → units N}
  (h : ∀ x, ↑(g x) = f x) (x) : ↑(lift_right f g h x)⁻¹ * f x = 1 :=
by rw [units.inv_mul_eq_iff_eq_mul, mul_one, coe_lift_right]

end units

namespace monoid_hom

/-- If `f` is a homomorphism from a group `G` to a monoid `M`,
then its image lies in the units of `M`,
and `f.to_hom_units` is the corresponding monoid homomorphism from `G` to `units M`. -/
@[to_additive "If `f` is a homomorphism from an additive group `G` to an additive monoid `M`,
then its image lies in the `add_units` of `M`,
and `f.to_hom_units` is the corresponding homomorphism from `G` to `add_units M`."]
def to_hom_units {G M : Type*} [group G] [monoid M] (f : G →* M) : G →* units M :=
{ to_fun := λ g,
    ⟨f g, f (g⁻¹),
      by rw [← f.map_mul, mul_inv_self, f.map_one],
      by rw [← f.map_mul, inv_mul_self, f.map_one]⟩,
  map_one' := units.ext (f.map_one),
  map_mul' := λ _ _, units.ext (f.map_mul _ _) }

@[simp] lemma coe_to_hom_units {G M : Type*} [group G] [monoid M] (f : G →* M) (g : G):
  (f.to_hom_units g : M) = f g := rfl

end monoid_hom

section is_unit
variables {M : Type*} {N : Type*}

@[to_additive] lemma is_unit.map [monoid M] [monoid N]
  (f : M →* N) {x : M} (h : is_unit x) : is_unit (f x) :=
by rcases h with ⟨y, rfl⟩; exact (units.map f y).is_unit

/-- If a homomorphism `f : M →* N` sends each element to an `is_unit`, then it can be lifted
to `f : M →* units N`. See also `units.lift_right` for a computable version. -/
@[to_additive "If a homomorphism `f : M →+ N` sends each element to an `is_add_unit`, then it can be
lifted to `f : M →+ add_units N`. See also `add_units.lift_right` for a computable version."]
noncomputable def is_unit.lift_right [monoid M] [monoid N] (f : M →* N)
  (hf : ∀ x, is_unit (f x)) : M →* units N :=
units.lift_right f (λ x, classical.some (hf x)) $ λ x, classical.some_spec (hf x)

@[to_additive] lemma is_unit.coe_lift_right [monoid M] [monoid N] (f : M →* N)
  (hf : ∀ x, is_unit (f x)) (x) :
  (is_unit.lift_right f hf x : N) = f x :=
units.coe_lift_right _ x

@[simp, to_additive] lemma is_unit.mul_lift_right_inv [monoid M] [monoid N] (f : M →* N)
  (h : ∀ x, is_unit (f x)) (x) : f x * ↑(is_unit.lift_right f h x)⁻¹ = 1 :=
units.mul_lift_right_inv (λ y, classical.some_spec $ h y) x

@[simp, to_additive] lemma is_unit.lift_right_inv_mul [monoid M] [monoid N] (f : M →* N)
  (h : ∀ x, is_unit (f x)) (x) : ↑(is_unit.lift_right f h x)⁻¹ * f x = 1 :=
units.lift_right_inv_mul (λ y, classical.some_spec $ h y) x

end is_unit


-- Diferencia_de_diferencia_de_conjuntos_2.lean
-- 2ª diferencia de diferencia de conjuntos.
-- José A. Alonso Jiménez
-- Sevilla, 21 de mayo de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    s \ (t ∪ u) ⊆ (s \ t) \ u
-- ----------------------------------------------------------------------

import data.set.basic
open set

variable {α : Type}
variables s t u : set α

-- 1ª demostración
-- ===============

example : s \ (t ∪ u) ⊆ (s \ t) \ u :=
begin
  intros x hx,
  split,
  { split,
    { exact hx.1, },
    { intro xt,
      apply hx.2,
      left,
      exact xt, }},
  { intro xu,
    apply hx.2,
    right,
    exact xu, },
end

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

example : s \ (t ∪ u) ⊆ (s \ t) \ u :=
begin
  rintros x ⟨xs, xntu⟩,
  split,
  { split,
    { exact xs, },
    { intro xt,
      exact xntu (or.inl xt), }},
  { intro xu,
    exact xntu (or.inr xu), },
end

-- 3ª demostración
-- ===============

example : s \ (t ∪ u) ⊆ (s \ t) \ u :=
begin
  rintros x ⟨xs, xntu⟩,
  use xs,
  { intro xt,
    exact xntu (or.inl xt) },
  { intro xu,
    exact xntu (or.inr xu) },
end

-- 4ª demostración
-- ===============

example : s \ (t ∪ u) ⊆ (s \ t) \ u :=
begin
  rintros x ⟨xs, xntu⟩;
  finish,
end

-- 5ª demostración
-- ===============

example : s \ (t ∪ u) ⊆ (s \ t) \ u :=
by intro ; finish

-- 6ª demostración
-- ===============

example : s \ (t ∪ u) ⊆ (s \ t) \ u :=
by rw diff_diff


/-
# Proposition world.

## Level 9: a big maze.

Lean's "congruence closure" tactic `cc` is good at mazes. You might want to try it now.
Perhaps I should have mentioned it earlier.
-/

/- Lemma : no-side-bar
There is a way through the following maze.
-/
example (A B C D E F G H I J K L : Prop)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=
begin
  cc,

end

/-
Now move onto advanced proposition world, where you will see
how to prove goals such as `P ∧ Q` ($P$ and $Q$), `P ∨ Q` ($P$ or $Q$),
`P ↔ Q` ($P\iff Q$).
You will need to learn five more tactics: `split`, `cases`,
`left`, `right`, and `exfalso`,
but they are all straightforward, and furthermore they are
essentially the last tactics you
need to learn in order to complete all the levels of the Natural Number Game,
including all the 17 levels of Inequality World.
-/

/- Tactic : cc

## Summary:

`cc` will solve certain "logic" goals.

## Details

`cc` is a "congruence closure tactic". In practice this means that it is
good at solving certain logic goals. It's worth trying if you think
that the goal could be solved using truth tables.
-/


import ..lectures.love05_inductive_predicates_demo
import ..lectures.love13_rational_and_real_numbers_demo

/-! # LoVe Exercise 13: Rational and Real Numbers -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Rationals
1.1. Prove the following lemma.
Hint: The lemma `fraction.mk.inj_eq` might be useful. -/

#check fraction.mk.inj_eq

lemma fraction.ext (a b : fraction) (hnum : fraction.num a = fraction.num b)
    (hdenom : fraction.denom a = fraction.denom b) :
  a = b := sorry

/-! 1.2. Extending the `fraction.has_mul` instance from the lecture, declare
`fraction` as an instance of `semigroup`.
Hint: Use the lemma `fraction.ext` above, and possibly `fraction.mul_num`, and
`fraction.mul_denom`. -/

#check fraction.ext
#check fraction.mul_num
#check fraction.mul_denom

@[instance] def fraction.semigroup : semigroup fraction :=
{ mul_assoc := sorry
  ..fraction.has_mul }

/-! 1.3. Extending the `rat.has_mul` instance from the lecture, declare `rat` as
an instance of `semigroup`. -/

@[instance] def rat.semigroup : semigroup rat :=
{ mul_assoc :=
 sorry
  ..rat.has_mul }

end LoVe


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import topology.instances.ennreal
import algebra.squarefree

/-!
# Divergence of the Prime Reciprocal Series

This file proves Theorem 81 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).
The theorem states that the sum of the reciprocals of all prime numbers diverges.
The formalization follows Erdős's proof by upper and lower estimates.

## Proof outline

1. Assume that the sum of the reciprocals of the primes converges.
2. Then there exists a `k : ℕ` such that, for any `x : ℕ`, the sum of the reciprocals of the primes
   between `k` and `x + 1` is less than 1/2 (`sum_lt_half_of_not_tendsto`).
3. For any `x : ℕ`, we can partition `range x` into two subsets (`range_sdiff_eq_bUnion`):
    * `M x k`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller
      than or equal to `k`;
    * `U x k`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`.
4. Then `|U x k|` is bounded by the sum over the primes `p > k` of the number of multiples of `p`
   in `(k, x]`, which is at most `x / p`. It follows that `|U x k|` is at most `x` times the sum of
  the reciprocals of the primes between `k` and `x + 1`, which is less than 1/2 as noted in (2), so
  `|U x k| < x / 2` (`card_le_mul_sum`).
5. By factoring `e + 1 = (m + 1)² * (r + 1)`, `r + 1` squarefree and `m + 1 ≤ √x`, and noting that
   squarefree numbers correspond to subsets of `[1, k]`, we find that `|M x k| ≤ 2 ^ k * √x`
   (`card_le_two_pow_mul_sqrt`).
6. Finally, setting `x := (2 ^ (k + 1))²` (`√x = 2 ^ (k + 1)`), we find that
   `|M x k| ≤ 2 ^ k * 2 ^ (k + 1) = x / 2`. Combined with the strict bound for `|U k x|` from (4),
   `x = |M x k| + |U x k| < x / 2 + x / 2 = x`.

## References

https://en.wikipedia.org/wiki/Divergence_of_the_sum_of_the_reciprocals_of_the_primes
-/

open_locale big_operators
open_locale classical
open filter finset

/--
The primes in `(k, x]`.
-/
noncomputable def P (x k : ℕ) := {p ∈ range (x + 1) | k < p ∧ nat.prime p}

/--
The union over those primes `p ∈ (k, x]` of the sets of `e < x` for which `e + 1` is a multiple
of `p`, i.e., those `e < x` for which there is a prime `p ∈ (k, x]` that divides `e + 1`.
-/
noncomputable def U (x k : ℕ) := finset.bUnion (P x k) (λ p, {e ∈ range x | p ∣ e + 1})

/--
Those `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to `k`.
-/
noncomputable def M (x k : ℕ) := {e ∈ range x | ∀ p : ℕ, (nat.prime p ∧ p ∣ e + 1) → p ≤ k}

/--
If the sum of the reciprocals of the primes converges, there exists a `k : ℕ` such that the sum of
the reciprocals of the primes greater than `k` is less than 1/2.

More precisely, for any `x : ℕ`, the sum of the reciprocals of the primes between `k` and `x + 1`
is less than 1/2.
-/
lemma sum_lt_half_of_not_tendsto
  (h : ¬ tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top) :
  ∃ k, ∀ x, ∑ p in P x k, 1 / (p : ℝ) < 1 / 2 :=
begin
  have h0 : (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ)))
          = λ n, ∑ p in range n, ite (nat.prime p) (1 / (p : ℝ)) 0,
  { simp only [sum_filter, filter_congr_decidable, sep_def] },

  have hf : ∀ n : ℕ, 0 ≤ ite (nat.prime n) (1 / (n : ℝ)) 0,
  { intro n, split_ifs,
    { simp only [one_div, inv_nonneg, nat.cast_nonneg] },
    { exact le_rfl } },

  rw [h0, ← summable_iff_not_tendsto_nat_at_top_of_nonneg hf, summable_iff_vanishing] at h,
  obtain ⟨s, h⟩ := h (set.Ioo (-1) (1/2)) (is_open_Ioo.mem_nhds (by norm_num)),
  obtain ⟨k, hk⟩ := exists_nat_subset_range s,
  use k,
  intro x,

  rw [P, sep_def, filter_congr_decidable, ←filter_filter, sum_filter],
  refine (h _ _).2,
  rw disjoint_iff_ne,
  simp_intros a ha b hb only [mem_filter],
  exact ((mem_range.mp (hk hb)).trans ha.2).ne',
end

/--
Removing from {0, ..., x - 1} those elements `e` for which `e + 1` is a product of powers of primes
smaller than or equal to `k` leaves those `e` for which there is a prime `p > k` that divides
`e + 1`, or the union over those primes `p > k` of the sets of `e`s for which `e + 1` is a multiple
of `p`.
-/
lemma range_sdiff_eq_bUnion {x k : ℕ} : range x \ M x k = U x k :=
begin
  ext e,
  simp only [mem_bUnion, not_and, mem_sdiff, sep_def, mem_filter, mem_range, U, M, P],
  push_neg,
  split,
  { rintros ⟨hex, hexh⟩,
    obtain ⟨p, ⟨hpp, hpe1⟩, hpk⟩ := hexh hex,
    refine ⟨p, _, ⟨hex, hpe1⟩⟩,
    exact ⟨(nat.le_of_dvd e.succ_pos hpe1).trans_lt (nat.succ_lt_succ hex), hpk, hpp⟩ },
  { rintros ⟨p, hpfilter, ⟨hex, hpe1⟩⟩,
    rw imp_iff_right hex,
    exact ⟨hex, ⟨p, ⟨hpfilter.2.2, hpe1⟩, hpfilter.2.1⟩⟩ },
end

/--
The number of `e < x` for which `e + 1` has a prime factor `p > k` is bounded by `x` times the sum
of reciprocals of primes in `(k, x]`.
-/
lemma card_le_mul_sum {x k : ℕ} : (card (U x k) : ℝ) ≤ x * ∑ p in P x k, 1 / p :=
begin
  let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p},
  let N := λ p, {e ∈ range x | p ∣ e + 1},
  have h : card (finset.bUnion P N) ≤ ∑ p in P, card (N p) := card_bUnion_le,

  calc  (card (finset.bUnion P N) : ℝ)
      ≤ ∑ p in P, card (N p)  : by assumption_mod_cast
  ... ≤ ∑ p in P, x * (1 / p) : sum_le_sum (λ p hp, _)
  ... = x * ∑ p in P, 1 / p   : mul_sum.symm,
  simp only [mul_one_div, N, sep_def, filter_congr_decidable, card_multiples, nat.cast_div_le],
end

/--
The number of `e < x` for which `e + 1` is a squarefree product of primes smaller than or equal to
`k` is bounded by `2 ^ k`, the number of subsets of `[1, k]`.
-/
lemma card_le_two_pow {x k : ℕ} : card {e ∈ M x k | squarefree (e + 1)} ≤ 2 ^ k :=
begin
  let M₁ := {e ∈ M x k | squarefree (e + 1)},
  let f := λ s, finset.prod s (λ a, a) - 1,
  let K := powerset (image nat.succ (range k)),

  -- Take `e` in `M x k`. If `e + 1` is squarefree, then it is the product of a subset of `[1, k]`.
  -- It follows that `e` is one less than such a product.
  have h : M₁ ⊆ image f K,
  { intros m hm,
    simp only [M₁, M, sep_def, mem_filter, mem_range, mem_powerset, mem_image, exists_prop] at hm ⊢,
    obtain ⟨⟨-, hmp⟩, hms⟩ := hm,
    use (m + 1).factors,
    { rwa [multiset.coe_nodup, ← nat.squarefree_iff_nodup_factors m.succ_ne_zero] },
    refine ⟨λ p, _, _⟩,
    { suffices : p ∈ (m + 1).factors → ∃ a : ℕ, a < k ∧ a.succ = p, { simpa },
      simp_intros hp only [nat.mem_factors m.succ_ne_zero],
      exact ⟨p.pred, (nat.pred_lt (nat.prime.ne_zero hp.1)).trans_le ((hmp p) hp),
            nat.succ_pred_eq_of_pos (nat.prime.pos hp.1)⟩ },
    { simp_rw f, simp [nat.prod_factors m.succ_ne_zero, m.succ_sub_one] } },

  -- The number of elements of `M x k` with `e + 1` squarefree is bounded by the number of subsets
  -- of `[1, k]`.
  calc card M₁ ≤ card (image f K)                    : card_le_of_subset h
  ...          ≤ card K                              : card_image_le
  ...          ≤ 2 ^ card (image nat.succ (range k)) : by simp only [K, card_powerset]
  ...          ≤ 2 ^ card (range k)                  : pow_le_pow one_le_two card_image_le
  ...          = 2 ^ k                               : by rw card_range k,
end

/--
The number of `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to
`k` is bounded by `2 ^ k * nat.sqrt x`.
-/
lemma card_le_two_pow_mul_sqrt {x k : ℕ} : card (M x k) ≤ 2 ^ k * nat.sqrt x :=
begin
  let M₁ := {e ∈ M x k | squarefree (e + 1)},
  let M₂ := M (nat.sqrt x) k,
  let K := finset.product M₁ M₂,
  let f : ℕ × ℕ → ℕ := λ mn, (mn.2 + 1) ^ 2 * (mn.1 + 1) - 1,

  -- Every element of `M x k` is one less than the product `(m + 1)² * (r + 1)` with `r + 1`
  -- squarefree and `m + 1 ≤ √x`, and both `m + 1` and `r + 1` still only have prime powers
  -- smaller than or equal to `k`.
  have h1 : M x k ⊆ image f K,
  { intros m hm,
    simp only [M, M₁, M₂, mem_image, exists_prop, prod.exists, mem_product, sep_def, mem_filter,
               mem_range] at hm ⊢,
    have hm' := m.zero_lt_succ,
    obtain ⟨a, b, hab₁, hab₂⟩ := nat.sq_mul_squarefree_of_pos' hm',
    obtain ⟨ham, hbm⟩ := ⟨dvd.intro_left _ hab₁, dvd.intro _ hab₁⟩,
    refine ⟨a, b, ⟨⟨⟨_, λ p hp, _⟩, hab₂⟩, ⟨_, λ p hp, _⟩⟩, by simp_rw [f, hab₁, m.succ_sub_one]⟩,
    { exact (nat.succ_le_succ_iff.mp (nat.le_of_dvd hm' ham)).trans_lt hm.1 },
    { exact hm.2 p ⟨hp.1, hp.2.trans ham⟩ },
    { calc b < b + 1        : lt_add_one b
      ...    ≤ (m + 1).sqrt : by simpa only [nat.le_sqrt, pow_two] using nat.le_of_dvd hm' hbm
      ...    ≤ x.sqrt       : nat.sqrt_le_sqrt (nat.succ_le_iff.mpr hm.1) },
    { exact hm.2 p ⟨hp.1, hp.2.trans (nat.dvd_of_pow_dvd one_le_two hbm)⟩ } },

  have h2 : card M₂ ≤ nat.sqrt x,
  { rw ← card_range (nat.sqrt x), apply card_le_of_subset, simp [M₂, M] },

  calc card (M x k) ≤ card (image f K)   : card_le_of_subset h1
  ...               ≤ card K             : card_image_le
  ...               = card M₁ * card M₂  : card_product M₁ M₂
  ...               ≤ 2 ^ k * x.sqrt     : mul_le_mul' card_le_two_pow h2,
end

theorem real.tendsto_sum_one_div_prime_at_top :
  tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top :=
begin
  -- Assume that the sum of the reciprocals of the primes converges.
  by_contradiction h,

  -- Then there is a natural number `k` such that for all `x`, the sum of the reciprocals of primes
  -- between `k` and `x` is less than 1/2.
  obtain ⟨k, h1⟩ := sum_lt_half_of_not_tendsto h,

  -- Choose `x` sufficiently large for the argument below to work, and use a perfect square so we
  -- can easily take the square root.
  let x := 2 ^ (k + 1) * 2 ^ (k + 1),

  -- We will partition `range x` into two subsets:
  -- * `M`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller
  --   than or equal to `k`;
  set M := M x k with hM,

  -- * `U`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`.
  let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p},
  set U := U x k with hU,

  -- This is indeed a partition, so `|U| + |M| = |range x| = x`.
  have h2 : x = card U + card M,
  { rw [← card_range x, hU, hM, ← range_sdiff_eq_bUnion],
    exact (card_sdiff_add_card_eq_card (finset.filter_subset _ _)).symm },

  -- But for the `x` we have chosen above, both `|U|` and `|M|` are less than or equal to `x / 2`,
  -- and for U, the inequality is strict.
  have h3 :=
    calc (card U : ℝ) ≤ x * ∑ p in P, 1 / p : card_le_mul_sum
    ...               < x * (1 / 2)         : mul_lt_mul_of_pos_left (h1 x) (by norm_num)
    ...               = x / 2               : mul_one_div x 2,

  have h4 :=
    calc (card M : ℝ) ≤ 2 ^ k * x.sqrt      : by exact_mod_cast card_le_two_pow_mul_sqrt
    ...               = 2 ^ k * ↑(2 ^ (k + 1)) : by rw nat.sqrt_eq
    ...               = x / 2               : by field_simp [x, mul_right_comm, ← pow_succ'],

  refine lt_irrefl (x : ℝ) _,
  calc (x : ℝ) = (card U : ℝ) + (card M : ℝ) : by assumption_mod_cast
  ...          < x / 2 + x / 2               : add_lt_add_of_lt_of_le h3 h4
  ...          = x                           : add_halves ↑x,
end


-- Regla de introducción del cuantificador existencial
-- ===================================================

-- Ej. 1. Demostrar
--    ∀x P(x) ⊢ ∃x P(x)

import tactic

variable U : Type
variable c : U
variable P : U -> Prop

-- 1ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
have h2 : P c, from h1 c,
show ∃x, P x,  from exists.intro c h2

-- 2ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
show ∃x, P x,  from exists.intro c (h1 c)

-- 3ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
exists.intro c (h1 c)

-- 4ª demostración
example
  (h1 : ∀x, P x)
  : ∃x, P x :=
⟨c, h1 c⟩

-- 5ª demostración
example
  (a : U)
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  use a,
  apply h1,
end

-- 6ª demostración
example
  (a : U)
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  constructor,
  apply h1 a,
end

-- 7ª demostración
example
  [inhabited U]
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  constructor,
  apply h1 (default U),
end

-- 8ª demostración
example
  (h : nonempty U)
  (h1 : ∀x, P x)
  : ∃x, P x :=
begin
  use (classical.choice h),
  apply h1,
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro

-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.sqrt
import Mathlib.data.nat.gcd
import Mathlib.algebra.group_power.default
import Mathlib.tactic.wlog
import Mathlib.tactic.norm_num
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Prime numbers

This file deals with prime numbers: natural numbers `p ≥ 2` whose only divisors are `p` and `1`.

## Important declarations

All the following declarations exist in the namespace `nat`.

- `prime`: the predicate that expresses that a natural number `p` is prime
- `primes`: the subtype of natural numbers that are prime
- `min_fac n`: the minimal prime factor of a natural number `n ≠ 1`
- `exists_infinite_primes`: Euclid's theorem that there exist infinitely many prime numbers
- `factors n`: the prime factorization of `n`
- `factors_unique`: uniqueness of the prime factorisation

-/

namespace nat

/-- `prime p` means that `p` is a prime number, that is, a natural number
  at least 2 whose only divisors are `p` and `1`. -/
def prime (p : ℕ) := bit0 1 ≤ p ∧ ∀ (m : ℕ), m ∣ p → m = 1 ∨ m = p

theorem prime.two_le {p : ℕ} : prime p → bit0 1 ≤ p := and.left

theorem prime.one_lt {p : ℕ} : prime p → 1 < p := prime.two_le

protected instance prime.one_lt' (p : ℕ) [hp : fact (prime p)] : fact (1 < p) := prime.one_lt hp

theorem prime.ne_one {p : ℕ} (hp : prime p) : p ≠ 1 := ne.symm (ne_of_lt (prime.one_lt hp))

theorem prime_def_lt {p : ℕ} : prime p ↔ bit0 1 ≤ p ∧ ∀ (m : ℕ), m < p → m ∣ p → m = 1 := sorry

theorem prime_def_lt' {p : ℕ} : prime p ↔ bit0 1 ≤ p ∧ ∀ (m : ℕ), bit0 1 ≤ m → m < p → ¬m ∣ p :=
  sorry

theorem prime_def_le_sqrt {p : ℕ} :
    prime p ↔ bit0 1 ≤ p ∧ ∀ (m : ℕ), bit0 1 ≤ m → m ≤ sqrt p → ¬m ∣ p :=
  sorry

/--
  This instance is slower than the instance `decidable_prime` defined below,
  but has the advantage that it works in the kernel.

  If you need to prove that a particular number is prime, in any case
  you should not use `dec_trivial`, but rather `by norm_num`, which is
  much faster.
  -/
def decidable_prime_1 (p : ℕ) : Decidable (prime p) :=
  decidable_of_iff' (bit0 1 ≤ p ∧ ∀ (m : ℕ), bit0 1 ≤ m → m < p → ¬m ∣ p) prime_def_lt'

theorem prime.ne_zero {n : ℕ} (h : prime n) : n ≠ 0 :=
  id fun (ᾰ : n = 0) => Eq._oldrec (fun (h : prime 0) => of_as_true trivial h) (Eq.symm ᾰ) h

theorem prime.pos {p : ℕ} (pp : prime p) : 0 < p := lt_of_succ_lt (prime.one_lt pp)

theorem not_prime_zero : ¬prime 0 := of_as_true trivial

theorem not_prime_one : ¬prime 1 := of_as_true trivial

theorem prime_two : prime (bit0 1) := of_as_true trivial

theorem prime_three : prime (bit1 1) := of_as_true trivial

theorem prime.pred_pos {p : ℕ} (pp : prime p) : 0 < Nat.pred p :=
  iff.mpr lt_pred_iff (prime.one_lt pp)

theorem succ_pred_prime {p : ℕ} (pp : prime p) : Nat.succ (Nat.pred p) = p :=
  succ_pred_eq_of_pos (prime.pos pp)

theorem dvd_prime {p : ℕ} {m : ℕ} (pp : prime p) : m ∣ p ↔ m = 1 ∨ m = p := sorry

theorem dvd_prime_two_le {p : ℕ} {m : ℕ} (pp : prime p) (H : bit0 1 ≤ m) : m ∣ p ↔ m = p :=
  iff.trans (dvd_prime pp) (or_iff_right_of_imp (not.elim (ne_of_gt H)))

theorem prime_dvd_prime_iff_eq {p : ℕ} {q : ℕ} (pp : prime p) (qp : prime q) : p ∣ q ↔ p = q :=
  dvd_prime_two_le qp (prime.two_le pp)

theorem prime.not_dvd_one {p : ℕ} (pp : prime p) : ¬p ∣ 1 :=
  fun (ᾰ : p ∣ 1) => idRhs False (not_le_of_gt (prime.one_lt pp) (le_of_dvd (of_as_true trivial) ᾰ))

theorem not_prime_mul {a : ℕ} {b : ℕ} (a1 : 1 < a) (b1 : 1 < b) : ¬prime (a * b) := sorry

theorem not_prime_mul' {a : ℕ} {b : ℕ} {n : ℕ} (h : a * b = n) (h₁ : 1 < a) (h₂ : 1 < b) :
    ¬prime n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (¬prime n)) (Eq.symm h))) (not_prime_mul h₁ h₂)

def min_fac_aux (n : ℕ) : ℕ → ℕ := sorry

def min_fac : ℕ → ℕ := sorry

@[simp] theorem min_fac_zero : min_fac 0 = bit0 1 := rfl

@[simp] theorem min_fac_one : min_fac 1 = 1 := rfl

theorem min_fac_eq (n : ℕ) : min_fac n = ite (bit0 1 ∣ n) (bit0 1) (min_fac_aux n (bit1 1)) := sorry

theorem min_fac_aux_has_prop {n : ℕ} (n2 : bit0 1 ≤ n) (nd2 : ¬bit0 1 ∣ n) (k : ℕ) (i : ℕ) :
    k = bit0 1 * i + bit1 1 →
        (∀ (m : ℕ), bit0 1 ≤ m → m ∣ n → k ≤ m) → min_fac_prop n (min_fac_aux n k) :=
  sorry

theorem min_fac_has_prop {n : ℕ} (n1 : n ≠ 1) : min_fac_prop n (min_fac n) := sorry

theorem min_fac_dvd (n : ℕ) : min_fac n ∣ n :=
  dite (n = 1) (fun (n1 : n = 1) => Eq.symm n1 ▸ of_as_true trivial)
    fun (n1 : ¬n = 1) => and.left (and.right (min_fac_has_prop n1))

theorem min_fac_prime {n : ℕ} (n1 : n ≠ 1) : prime (min_fac n) := sorry

theorem min_fac_le_of_dvd {n : ℕ} {m : ℕ} : bit0 1 ≤ m → m ∣ n → min_fac n ≤ m :=
  dite (n = 1)
    (fun (n1 : n = 1) (m : ℕ) (m2 : bit0 1 ≤ m) (d : m ∣ n) =>
      Eq.symm n1 ▸ le_trans (of_as_true trivial) m2)
    fun (n1 : ¬n = 1) => and.right (and.right (min_fac_has_prop n1))

theorem min_fac_pos (n : ℕ) : 0 < min_fac n :=
  dite (n = 1) (fun (n1 : n = 1) => Eq.symm n1 ▸ of_as_true trivial)
    fun (n1 : ¬n = 1) => prime.pos (min_fac_prime n1)

theorem min_fac_le {n : ℕ} (H : 0 < n) : min_fac n ≤ n := le_of_dvd H (min_fac_dvd n)

theorem prime_def_min_fac {p : ℕ} : prime p ↔ bit0 1 ≤ p ∧ min_fac p = p := sorry

protected instance decidable_prime (p : ℕ) : Decidable (prime p) :=
  decidable_of_iff' (bit0 1 ≤ p ∧ min_fac p = p) prime_def_min_fac

theorem not_prime_iff_min_fac_lt {n : ℕ} (n2 : bit0 1 ≤ n) : ¬prime n ↔ min_fac n < n :=
  iff.trans (not_congr (iff.trans prime_def_min_fac (and_iff_right n2)))
    (iff.symm (iff.trans lt_iff_le_and_ne (and_iff_right (min_fac_le (le_of_succ_le n2)))))

theorem min_fac_le_div {n : ℕ} (pos : 0 < n) (np : ¬prime n) : min_fac n ≤ n / min_fac n := sorry

theorem min_fac_sq_le_self {n : ℕ} (w : 0 < n) (h : ¬prime n) : min_fac n ^ bit0 1 ≤ n := sorry

@[simp] theorem min_fac_eq_one_iff {n : ℕ} : min_fac n = 1 ↔ n = 1 := sorry

@[simp] theorem min_fac_eq_two_iff (n : ℕ) : min_fac n = bit0 1 ↔ bit0 1 ∣ n := sorry

theorem exists_dvd_of_not_prime {n : ℕ} (n2 : bit0 1 ≤ n) (np : ¬prime n) :
    ∃ (m : ℕ), m ∣ n ∧ m ≠ 1 ∧ m ≠ n :=
  sorry

theorem exists_dvd_of_not_prime2 {n : ℕ} (n2 : bit0 1 ≤ n) (np : ¬prime n) :
    ∃ (m : ℕ), m ∣ n ∧ bit0 1 ≤ m ∧ m < n :=
  Exists.intro (min_fac n)
    { left := min_fac_dvd n,
      right :=
        { left := prime.two_le (min_fac_prime (ne_of_gt n2)),
          right := iff.mp (not_prime_iff_min_fac_lt n2) np } }

theorem exists_prime_and_dvd {n : ℕ} (n2 : bit0 1 ≤ n) : ∃ (p : ℕ), prime p ∧ p ∣ n :=
  Exists.intro (min_fac n) { left := min_fac_prime (ne_of_gt n2), right := min_fac_dvd n }

/-- Euclid's theorem. There exist infinitely many prime numbers.
Here given in the form: for every `n`, there exists a prime number `p ≥ n`. -/
theorem exists_infinite_primes (n : ℕ) : ∃ (p : ℕ), n ≤ p ∧ prime p := sorry

theorem prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = bit0 1 ∨ p % bit0 1 = 1 := sorry

theorem coprime_of_dvd {m : ℕ} {n : ℕ} (H : ∀ (k : ℕ), prime k → k ∣ m → ¬k ∣ n) : coprime m n :=
  sorry

theorem coprime_of_dvd' {m : ℕ} {n : ℕ} (H : ∀ (k : ℕ), prime k → k ∣ m → k ∣ n → k ∣ 1) :
    coprime m n :=
  coprime_of_dvd
    fun (k : ℕ) (kp : prime k) (km : k ∣ m) (kn : k ∣ n) =>
      not_le_of_gt (prime.one_lt kp) (le_of_dvd zero_lt_one (H k kp km kn))

theorem factors_lemma {k : ℕ} : (k + bit0 1) / min_fac (k + bit0 1) < k + bit0 1 :=
  div_lt_self (of_as_true trivial) (prime.one_lt (min_fac_prime (of_as_true trivial)))

/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
def factors : ℕ → List ℕ := sorry

theorem mem_factors {n : ℕ} {p : ℕ} : p ∈ factors n → prime p := sorry

theorem prod_factors {n : ℕ} : 0 < n → list.prod (factors n) = n := sorry

theorem factors_prime {p : ℕ} (hp : prime p) : factors p = [p] := sorry

/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/
theorem factors_add_two (n : ℕ) :
    factors (n + bit0 1) = min_fac (n + bit0 1) :: factors ((n + bit0 1) / min_fac (n + bit0 1)) :=
  rfl

theorem prime.coprime_iff_not_dvd {p : ℕ} {n : ℕ} (pp : prime p) : coprime p n ↔ ¬p ∣ n := sorry

theorem prime.dvd_iff_not_coprime {p : ℕ} {n : ℕ} (pp : prime p) : p ∣ n ↔ ¬coprime p n :=
  iff.mpr iff_not_comm (prime.coprime_iff_not_dvd pp)

theorem prime.not_coprime_iff_dvd {m : ℕ} {n : ℕ} :
    ¬coprime m n ↔ ∃ (p : ℕ), prime p ∧ p ∣ m ∧ p ∣ n :=
  sorry

theorem prime.dvd_mul {p : ℕ} {m : ℕ} {n : ℕ} (pp : prime p) : p ∣ m * n ↔ p ∣ m ∨ p ∣ n := sorry

theorem prime.not_dvd_mul {p : ℕ} {m : ℕ} {n : ℕ} (pp : prime p) (Hm : ¬p ∣ m) (Hn : ¬p ∣ n) :
    ¬p ∣ m * n :=
  sorry

theorem prime.dvd_of_dvd_pow {p : ℕ} {m : ℕ} {n : ℕ} (pp : prime p) (h : p ∣ m ^ n) : p ∣ m :=
  Nat.rec (fun (h : p ∣ m ^ 0) => not.elim (prime.not_dvd_one pp) h)
    (fun (n : ℕ) (IH : p ∣ m ^ n → p ∣ m) (h : p ∣ m ^ Nat.succ n) =>
      or.elim (iff.mp (prime.dvd_mul pp) h) id IH)
    n h

theorem prime.pow_not_prime {x : ℕ} {n : ℕ} (hn : bit0 1 ≤ n) : ¬prime (x ^ n) := sorry

theorem prime.mul_eq_prime_pow_two_iff {x : ℕ} {y : ℕ} {p : ℕ} (hp : prime p) (hx : x ≠ 1)
    (hy : y ≠ 1) : x * y = p ^ bit0 1 ↔ x = p ∧ y = p :=
  sorry

theorem prime.dvd_factorial {n : ℕ} {p : ℕ} (hp : prime p) : p ∣ factorial n ↔ p ≤ n := sorry

theorem prime.coprime_pow_of_not_dvd {p : ℕ} {m : ℕ} {a : ℕ} (pp : prime p) (h : ¬p ∣ a) :
    coprime a (p ^ m) :=
  coprime.pow_right m (coprime.symm (iff.mpr (prime.coprime_iff_not_dvd pp) h))

theorem coprime_primes {p : ℕ} {q : ℕ} (pp : prime p) (pq : prime q) : coprime p q ↔ p ≠ q :=
  iff.trans (prime.coprime_iff_not_dvd pp) (not_congr (dvd_prime_two_le pq (prime.two_le pp)))

theorem coprime_pow_primes {p : ℕ} {q : ℕ} (n : ℕ) (m : ℕ) (pp : prime p) (pq : prime q)
    (h : p ≠ q) : coprime (p ^ n) (q ^ m) :=
  coprime.pow n m (iff.mpr (coprime_primes pp pq) h)

theorem coprime_or_dvd_of_prime {p : ℕ} (pp : prime p) (i : ℕ) : coprime p i ∨ p ∣ i :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coprime p i ∨ p ∣ i)) (propext (prime.dvd_iff_not_coprime pp))))
    (em (coprime p i))

theorem dvd_prime_pow {p : ℕ} (pp : prime p) {m : ℕ} {i : ℕ} :
    i ∣ p ^ m ↔ ∃ (k : ℕ), ∃ (H : k ≤ m), i = p ^ k :=
  sorry

/--
If `p` is prime,
and `a` doesn't divide `p^k`, but `a` does divide `p^(k+1)`
then `a = p^(k+1)`.
-/
theorem eq_prime_pow_of_dvd_least_prime_pow {a : ℕ} {p : ℕ} {k : ℕ} (pp : prime p) (h₁ : ¬a ∣ p ^ k)
    (h₂ : a ∣ p ^ (k + 1)) : a = p ^ (k + 1) :=
  sorry

theorem mem_list_primes_of_dvd_prod {p : ℕ} (hp : prime p) {l : List ℕ} :
    (∀ (p : ℕ), p ∈ l → prime p) → p ∣ list.prod l → p ∈ l :=
  sorry

theorem mem_factors_iff_dvd {n : ℕ} {p : ℕ} (hn : 0 < n) (hp : prime p) : p ∈ factors n ↔ p ∣ n :=
  { mp := fun (h : p ∈ factors n) => prod_factors hn ▸ list.dvd_prod h,
    mpr :=
      fun (h : p ∣ n) =>
        mem_list_primes_of_dvd_prod hp mem_factors (Eq.symm (prod_factors hn) ▸ h) }

theorem perm_of_prod_eq_prod {l₁ : List ℕ} {l₂ : List ℕ} :
    list.prod l₁ = list.prod l₂ →
        (∀ (p : ℕ), p ∈ l₁ → prime p) → (∀ (p : ℕ), p ∈ l₂ → prime p) → l₁ ~ l₂ :=
  sorry

theorem factors_unique {n : ℕ} {l : List ℕ} (h₁ : list.prod l = n)
    (h₂ : ∀ (p : ℕ), p ∈ l → prime p) : l ~ factors n :=
  sorry

theorem succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : prime p) {m : ℕ} {n : ℕ} {k : ℕ}
    {l : ℕ} (hpm : p ^ k ∣ m) (hpn : p ^ l ∣ n) (hpmn : p ^ (k + l + 1) ∣ m * n) :
    p ^ (k + 1) ∣ m ∨ p ^ (l + 1) ∣ n :=
  sorry

/-- The type of prime numbers -/
def primes := Subtype fun (p : ℕ) => prime p

namespace primes

protected instance has_repr : has_repr primes :=
  has_repr.mk fun (p : primes) => repr (subtype.val p)

protected instance inhabited : Inhabited primes :=
  { default := { val := bit0 1, property := prime_two } }

protected instance coe_nat : has_coe primes ℕ := has_coe.mk subtype.val

theorem coe_nat_inj (p : primes) (q : primes) : ↑p = ↑q → p = q := fun (h : ↑p = ↑q) => subtype.eq h

end primes

protected instance monoid.prime_pow {α : Type u_1} [monoid α] : has_pow α primes :=
  has_pow.mk fun (x : α) (p : primes) => x ^ subtype.val p

end nat

/-! ### Primality prover -/

namespace tactic

namespace norm_num

theorem is_prime_helper (n : ℕ) (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n :=
  iff.mpr nat.prime_def_min_fac { left := h₁, right := h₂ }

theorem min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = bit0 1 := sorry

/-- A predicate representing partial progress in a proof of `min_fac`. -/
def min_fac_helper (n : ℕ) (k : ℕ) := 0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n)

theorem min_fac_helper.n_pos {n : ℕ} {k : ℕ} (h : min_fac_helper n k) : 0 < n := sorry

theorem min_fac_ne_bit0 {n : ℕ} {k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k := sorry

theorem min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 := sorry

theorem min_fac_helper_1 {n : ℕ} {k : ℕ} {k' : ℕ} (e : k + 1 = k')
    (np : nat.min_fac (bit1 n) ≠ bit1 k) (h : min_fac_helper n k) : min_fac_helper n k' :=
  sorry

theorem min_fac_helper_2 (n : ℕ) (k : ℕ) (k' : ℕ) (e : k + 1 = k') (np : ¬nat.prime (bit1 k))
    (h : min_fac_helper n k) : min_fac_helper n k' :=
  sorry

theorem min_fac_helper_3 (n : ℕ) (k : ℕ) (k' : ℕ) (c : ℕ) (e : k + 1 = k')
    (nc : bit1 n % bit1 k = c) (c0 : 0 < c) (h : min_fac_helper n k) : min_fac_helper n k' :=
  sorry

theorem min_fac_helper_4 (n : ℕ) (k : ℕ) (hd : bit1 n % bit1 k = 0) (h : min_fac_helper n k) :
    nat.min_fac (bit1 n) = bit1 k :=
  sorry

theorem min_fac_helper_5 (n : ℕ) (k : ℕ) (k' : ℕ) (e : bit1 k * bit1 k = k') (hd : bit1 n < k')
    (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker

! This file was ported from Lean 3 source module data.polynomial.integral_normalization
! leanprover-community/mathlib commit 6f401acf4faec3ab9ab13a42789c4f68064a61cd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.AlgebraMap
import Mathlib.Data.Polynomial.Degree.Lemmas
import Mathlib.Data.Polynomial.Monic

/-!
# Theory of monic polynomials

We define `integralNormalization`, which relate arbitrary polynomials to monic ones.
-/

open BigOperators Polynomial

namespace Polynomial

universe u v y

variable {R : Type u} {S : Type v} {a b : R} {m n : ℕ} {ι : Type y}

section IntegralNormalization

section Semiring

variable [Semiring R]

/-- If `f : R[X]` is a nonzero polynomial with root `z`, `integralNormalization f` is
a monic polynomial with root `leadingCoeff f * z`.

Moreover, `integralNormalization 0 = 0`.
-/
noncomputable def integralNormalization (f : R[X]) : R[X] :=
  ∑ i in f.support,
    monomial i (if f.degree = i then 1 else coeff f i * f.leadingCoeff ^ (f.natDegree - 1 - i))
#align polynomial.integral_normalization Polynomial.integralNormalization

@[simp]
theorem integralNormalization_zero : integralNormalization (0 : R[X]) = 0 := by
  simp [integralNormalization]
#align polynomial.integral_normalization_zero Polynomial.integralNormalization_zero

theorem integralNormalization_coeff {f : R[X]} {i : ℕ} :
    (integralNormalization f).coeff i =
      if f.degree = i then 1 else coeff f i * f.leadingCoeff ^ (f.natDegree - 1 - i) := by
  have : f.coeff i = 0 → f.degree ≠ i := fun hc hd => coeff_ne_zero_of_eq_degree hd hc
  simp (config := { contextual := true }) [integralNormalization, coeff_monomial, this,
    mem_support_iff]
#align polynomial.integral_normalization_coeff Polynomial.integralNormalization_coeff

theorem integralNormalization_support {f : R[X]} : (integralNormalization f).support ⊆ f.support :=
  by
  intro
  simp (config := { contextual := true }) [integralNormalization, coeff_monomial, mem_support_iff]
#align polynomial.integral_normalization_support Polynomial.integralNormalization_support

theorem integralNormalization_coeff_degree {f : R[X]} {i : ℕ} (hi : f.degree = i) :
    (integralNormalization f).coeff i = 1 := by rw [integralNormalization_coeff, if_pos hi]
#align polynomial.integral_normalization_coeff_degree Polynomial.integralNormalization_coeff_degree

theorem integralNormalization_coeff_natDegree {f : R[X]} (hf : f ≠ 0) :
    (integralNormalization f).coeff (natDegree f) = 1 :=
  integralNormalization_coeff_degree (degree_eq_natDegree hf)
#align polynomial.integral_normalization_coeff_nat_degree Polynomial.integralNormalization_coeff_natDegree

theorem integralNormalization_coeff_ne_degree {f : R[X]} {i : ℕ} (hi : f.degree ≠ i) :
    coeff (integralNormalization f) i = coeff f i * f.leadingCoeff ^ (f.natDegree - 1 - i) := by
  rw [integralNormalization_coeff, if_neg hi]
#align polynomial.integral_normalization_coeff_ne_degree Polynomial.integralNormalization_coeff_ne_degree

theorem integralNormalization_coeff_ne_natDegree {f : R[X]} {i : ℕ} (hi : i ≠ natDegree f) :
    coeff (integralNormalization f) i = coeff f i * f.leadingCoeff ^ (f.natDegree - 1 - i) :=
  integralNormalization_coeff_ne_degree (degree_ne_of_natDegree_ne hi.symm)
#align polynomial.integral_normalization_coeff_ne_nat_degree Polynomial.integralNormalization_coeff_ne_natDegree

theorem monic_integralNormalization {f : R[X]} (hf : f ≠ 0) : Monic (integralNormalization f) :=
  monic_of_degree_le f.natDegree
    (Finset.sup_le fun i h =>
      WithBot.coe_le_coe.2 <| le_natDegree_of_mem_supp i <| integralNormalization_support h)
    (integralNormalization_coeff_natDegree hf)
#align polynomial.monic_integral_normalization Polynomial.monic_integralNormalization

end Semiring

section IsDomain

variable [Ring R] [IsDomain R]

@[simp]
theorem support_integralNormalization {f : R[X]} : (integralNormalization f).support = f.support :=
  by
  by_cases hf : f = 0; · simp [hf]
  ext i
  refine' ⟨fun h => integralNormalization_support h, _⟩
  simp only [integralNormalization_coeff, mem_support_iff]
  intro hfi
  split_ifs with hi <;> simp [hfi, hi, pow_ne_zero _ (leadingCoeff_ne_zero.mpr hf)]
#align polynomial.support_integral_normalization Polynomial.support_integralNormalization

end IsDomain

section IsDomain

variable [CommRing R] [IsDomain R]

variable [CommSemiring S]

theorem integralNormalization_eval₂_eq_zero {p : R[X]} (f : R →+* S) {z : S} (hz : eval₂ f z p = 0)
    (inj : ∀ x : R, f x = 0 → x = 0) :
    eval₂ f (z * f p.leadingCoeff) (integralNormalization p) = 0 :=
  calc
    eval₂ f (z * f p.leadingCoeff) (integralNormalization p) =
        p.support.attach.sum fun i =>
          f (coeff (integralNormalization p) i.1 * p.leadingCoeff ^ i.1) * z ^ i.1 := by
      rw [eval₂_eq_sum, sum_def, support_integralNormalization]
      simp only [mul_comm z, mul_pow, mul_assoc, RingHom.map_pow, RingHom.map_mul]
      exact Finset.sum_attach.symm
    _ =
        p.support.attach.sum fun i =>
          f (coeff p i.1 * p.leadingCoeff ^ (natDegree p - 1)) * z ^ i.1 := by
      by_cases hp : p = 0; · simp [hp]
      have one_le_deg : 1 ≤ natDegree p :=
        Nat.succ_le_of_lt (natDegree_pos_of_eval₂_root hp f hz inj)
      congr with i
      congr 2
      by_cases hi : i.1 = natDegree p
      · rw [hi, integralNormalization_coeff_degree, one_mul, leadingCoeff, ← pow_succ,
          tsub_add_cancel_of_le one_le_deg]
        exact degree_eq_natDegree hp
      · have : i.1 ≤ p.natDegree - 1 :=
          Nat.le_pred_of_lt (lt_of_le_of_ne (le_natDegree_of_ne_zero (mem_support_iff.mp i.2)) hi)
        rw [integralNormalization_coeff_ne_natDegree hi, mul_assoc, ← pow_add,
          tsub_add_cancel_of_le this]
    _ = f p.leadingCoeff ^ (natDegree p - 1) * eval₂ f z p := by
      simp_rw [eval₂_eq_sum, sum_def, fun i => mul_comm (coeff p i), RingHom.map_mul,
               RingHom.map_pow, mul_assoc, ← Finset.mul_sum]
      congr 1
      exact @Finset.sum_attach _ _ p.support _ fun i => f (p.coeff i) * z ^ i
    _ = 0 := by rw [hz, mul_zero]
#align polynomial.integral_normalization_eval₂_eq_zero Polynomial.integralNormalization_eval₂_eq_zero

theorem integralNormalization_aeval_eq_zero [Algebra R S] {f : R[X]} {z : S} (hz : aeval z f = 0)
    (inj : ∀ x : R, algebraMap R S x = 0 → x = 0) :
    aeval (z * algebraMap R S f.leadingCoeff) (integralNormalization f) = 0 :=
  integralNormalization_eval₂_eq_zero (algebraMap R S) hz inj
#align polynomial.integral_normalization_aeval_eq_zero Polynomial.integralNormalization_aeval_eq_zero

end IsDomain

end IntegralNormalization

end Polynomial


section Chap4_1
variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  ⟨λ hpq => ⟨λ w => (hpq w).left, λ w => (hpq w).right⟩,
   λ hphq => λ w => ⟨hphq.left w, hphq.right w⟩⟩

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := λ hpq => λ hp => λ w => (hpq w) (hp w)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  fun h => Or.elim h
    (λ hpx => λ w => Or.inl (hpx w))
    (λ hqx => λ w => Or.inr (hqx w))
end Chap4_1

section Chap4_2
variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : α -> ((∃ _ : α, r) ↔ r) :=
  λ w => Iff.intro
    (λ ⟨_, hr⟩ => hr)
    (λ hr => ⟨w, hr⟩)

open Classical
example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
  Iff.intro
    (λ hpxor => byCases
      (λ h' : ∀ x, p x => Or.inl h')
      (λ h' : ¬ ∀ x, p x =>
        have ⟨w, hnpw⟩ : ∃ x, ¬ p x := byContradiction
          λ hnpx =>
            have : ∀ x, p x := λ w => byContradiction λ hnpw => hnpx ⟨w, hnpw⟩
            h' this
        have hr : r := byContradiction λ hnr =>
          have : p w := False.elim ((hpxor w).elim hnpw hnr)
          hnpw this
        Or.inr hr))
    (λ hpxor => λ w =>
      hpxor.elim
        (λ hpx => Or.inl (hpx w))
        (λ hr => Or.inr hr))

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
  Iff.intro
    (λ hxrpx => λ hr => λ w => hxrpx w hr)
    (λ hrxpx => λ w => λ hr => hrxpx hr w)
end Chap4_2

section Chap4_3
variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

-- Who would shave the barber?
-- Why ↔ instead of ∧?
example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False :=
  have : ¬ ((shaves barber barber) ↔ ¬ shaves barber barber) :=
    λ h =>
      have hn : ¬ shaves barber barber := λ h' => h.mp h' h'
      have hnn : ¬ ¬ shaves barber barber := λ h' => h' (h.mpr h')
      hnn hn
  this (h barber)
end Chap4_3

section Chap4_4
def even (n : Nat) : Prop := ∃ x : Nat, 2 * x = n
def prime (n : Nat) : Prop := ¬ ∃ x y : Nat, 1 < x ∧ x < n ∧ 1 < y ∧ y < n ∧ x * y = n
def infinitely_many_primes : Prop := ∀ k : Nat, ∃ p : Nat, prime p ∧ p > k
def Fermat_prime (n : Nat) : Prop := ∃ k : Nat, 2^(2^k) + 1 = n
def infinitely_many_Fermat_primes : Prop := ∀ k : Nat, ∃ p, Fermat_prime p ∧ p > k
def goldbach_conjecture : Prop := ∀ x : Nat, x > 2 ∧ even x -> (∃ p q, prime p ∧ prime q ∧ x = p + q)
def Goldbach's_weak_conjecture : Prop := ∀ x : Nat, x > 5 ∧ ¬ even x -> (∃ p q r, prime p ∧ prime q ∧ prime r ∧ x = p + q + r)
def Fermat's_last_theorem : Prop := ∀ n : Nat, n > 2 -> ¬ (∃ a b c, a > 0 ∧ b > 0 ∧ c > 0 ∧ a^n + b^n = c^n)

end Chap4_4

section Chap4_5
open Classical
variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : (∃ _ : α, r) → r :=
  λ h => h.elim (λ _ hr => hr)

example (a : α) : r → (∃ _ : α, r) :=
  λ h1 => ⟨a, h1⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  ⟨λ ⟨w, pw, hr⟩ => ⟨⟨w, pw⟩, hr⟩,
   λ ⟨⟨w, pw⟩, hr⟩ => ⟨w, pw, hr⟩⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  ⟨λ ⟨w, hpqx⟩ => hpqx.elim (λ hpx => Or.inl ⟨w, hpx⟩) (λ hqx => Or.inr ⟨w, hqx⟩),
   λ hpq => hpq.elim (λ ⟨w, hpw⟩ => ⟨w, Or.inl hpw⟩) (λ ⟨w, hqw⟩ => ⟨w, Or.inr hqw⟩)⟩

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  ⟨λ h => λ ⟨w, hnpx⟩ => hnpx (h w),
   λ h => λ w => byContradiction λ hnpw => h ⟨w, hnpw⟩⟩

example : (∃ x, p x ) ↔ ¬ (∀ x, ¬ p x) :=
  ⟨λ ⟨w, hpw⟩ => λ hnp => (hnp w) hpw,
   λ h => byContradiction λ (h1 : ¬ ∃ x, p x) =>
     have (h2 : ∀ x, ¬ p x) :=
       λ w =>
       λ h3 : p w => h1 ⟨w, h3⟩
     h h2⟩

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  ⟨λ h => byContradiction λ h1 =>
       have h2 : (∀ x, ¬ p x) :=
         λ w => λ (h3 : p w) => h ⟨w, h3⟩
       h1 h2,
   λ h => λ ⟨w, h1⟩ => (h w) h1⟩

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  ⟨λ h => byContradiction λ h1 =>
     have h2 : ∀ x, p x := λ w => byContradiction λ hnpw => h1 ⟨w, hnpw⟩
     h h2,
   λ ⟨w, hnpw⟩ => λ h1 => hnpw (h1 w)⟩

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  ⟨λ h => λ ⟨w, hpw⟩ => (h w) hpw,
   λ h => λ w => λ hpw => h ⟨w, hpw⟩⟩

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  ⟨λ ⟨w, hpwr⟩ => λ hpx => hpwr (hpx w),
   λ h => byCases
     (λ h': ∀ x, p x => ⟨a, λ _ => h h'⟩)
     (λ h': ¬ ∀ x, p x =>
       have ⟨w, hnpw⟩ : ∃ x, ¬ p x := byContradiction λ hnnpx =>
         have nh' : ∀ x, p x := λ w => byContradiction λ hnpw => hnnpx ⟨w, hnpw⟩
         h' nh'
       ⟨w, λ hpw => absurd hpw hnpw⟩)⟩

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
  ⟨λ ⟨w, hrpw⟩ => λ hr => ⟨w, hrpw hr⟩,
   λ hrpx => byCases
     (λ h' : ∃ x, p x =>
       have ⟨w, pw⟩ := h'
       ⟨w, λ _ => pw⟩)
     (λ h' : ¬ ∃ x, p x => byCases
       (λ hr : r  => absurd (hrpx hr) h')
       (λ hnr : ¬r  => ⟨a, λ hr => absurd hr hnr⟩))⟩

end Chap4_5


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.polynomial.chebyshev.defs
import Mathlib.analysis.special_functions.trigonometric
import Mathlib.ring_theory.localization
import Mathlib.data.zmod.basic
import Mathlib.algebra.invertible
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Chebyshev polynomials

The Chebyshev polynomials are two families of polynomials indexed by `ℕ`,
with integral coefficients.
In this file, we only consider Chebyshev polynomials of the first kind.

## Main declarations

* `polynomial.chebyshev₁_mul`, the `(m * n)`-th Chebyshev polynomial is the composition
  of the `m`-th and `n`-th Chebyshev polynomials.
* `polynomial.lambdashev_mul`, the `(m * n)`-th lambdashev polynomial is the composition
  of the `m`-th and `n`-th lambdashev polynomials.
* `polynomial.lambdashev_char_p`, for a prime number `p`, the `p`-th lambdashev polynomial
  is congruent to `X ^ p` modulo `p`.

## Implementation details

Since Chebyshev polynomials have interesting behaviour over the complex numbers and modulo `p`,
we define them to have coefficients in an arbitrary commutative ring, even though
technically `ℤ` would suffice.
The benefit of allowing arbitrary coefficient rings, is that the statements afterwards are clean,
and do not have `map (int.cast_ring_hom R)` interfering all the time.

-/

namespace polynomial

/-- The `(m * n)`-th Chebyshev polynomial is the composition of the `m`-th and `n`-th -/
theorem chebyshev₁_mul (R : Type u_1) [comm_ring R] (m : ℕ) (n : ℕ) : chebyshev₁ R (m * n) = comp (chebyshev₁ R m) (chebyshev₁ R n) := sorry

/-!

### A Lambda structure on `polynomial ℤ`

Mathlib doesn't currently know what a Lambda ring is.
But once it does, we can endow `polynomial ℤ` with a Lambda structure
in terms of the `lambdashev` polynomials defined below.
There is exactly one other Lambda structure on `polynomial ℤ` in terms of binomial polynomials.

-/

theorem lambdashev_eval_add_inv {R : Type u_1} [comm_ring R] (x : R) (y : R) (h : x * y = 1) (n : ℕ) : eval (x + y) (lambdashev R n) = x ^ n + y ^ n := sorry

theorem lambdashev_eq_chebyshev₁ (R : Type u_1) [comm_ring R] [invertible (bit0 1)] (n : ℕ) : lambdashev R n = bit0 1 * comp (chebyshev₁ R n) (coe_fn C ⅟ * X) := sorry

theorem chebyshev₁_eq_lambdashev (R : Type u_1) [comm_ring R] [invertible (bit0 1)] (n : ℕ) : chebyshev₁ R n = coe_fn C ⅟ * comp (lambdashev R n) (bit0 1 * X) := sorry

/-- the `(m * n)`-th lambdashev polynomial is the composition of the `m`-th and `n`-th -/
theorem lambdashev_mul (R : Type u_1) [comm_ring R] (m : ℕ) (n : ℕ) : lambdashev R (m * n) = comp (lambdashev R m) (lambdashev R n) := sorry

theorem lambdashev_comp_comm (R : Type u_1) [comm_ring R] (m : ℕ) (n : ℕ) : comp (lambdashev R m) (lambdashev R n) = comp (lambdashev R n) (lambdashev R m) := sorry

theorem lambdashev_zmod_p (p : ℕ) [fact (nat.prime p)] : lambdashev (zmod p) p = X ^ p := sorry

theorem lambdashev_char_p (R : Type u_1) [comm_ring R] (p : ℕ) [fact (nat.prime p)] [char_p R p] : lambdashev R p = X ^ p := sorry