/-
Copyright (c) 2021 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning

! This file was ported from Lean 3 source module combinatorics.configuration
! leanprover-community/mathlib commit d2d8742b0c21426362a9dacebc6005db895ca963
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Order
import Mathbin.Combinatorics.Hall.Basic
import Mathbin.Data.Fintype.BigOperators
import Mathbin.SetTheory.Cardinal.Finite

/-!
# Configurations of Points and lines
This file introduces abstract configurations of points and lines, and proves some basic properties.

## Main definitions
* `configuration.nondegenerate`: Excludes certain degenerate configurations,
  and imposes uniqueness of intersection points.
* `configuration.has_points`: A nondegenerate configuration in which
  every pair of lines has an intersection point.
* `configuration.has_lines`:  A nondegenerate configuration in which
  every pair of points has a line through them.
* `configuration.line_count`: The number of lines through a given point.
* `configuration.point_count`: The number of lines through a given line.

## Main statements
* `configuration.has_lines.card_le`: `has_lines` implies `|P| ≤ |L|`.
* `configuration.has_points.card_le`: `has_points` implies `|L| ≤ |P|`.
* `configuration.has_lines.has_points`: `has_lines` and `|P| = |L|` implies `has_points`.
* `configuration.has_points.has_lines`: `has_points` and `|P| = |L|` implies `has_lines`.
Together, these four statements say that any two of the following properties imply the third:
(a) `has_lines`, (b) `has_points`, (c) `|P| = |L|`.

-/

open BigOperators

namespace Configuration

variable (P L : Type _) [Membership P L]

/-- A type synonym. -/
def Dual :=
  P
#align configuration.dual Configuration.Dual

instance [this : Inhabited P] : Inhabited (Dual P) :=
  this

instance [Finite P] : Finite (Dual P) :=
  ‹Finite P›

instance [this : Fintype P] : Fintype (Dual P) :=
  this

instance : Membership (Dual L) (Dual P) :=
  ⟨Function.swap (Membership.Mem : P → L → Prop)⟩

/-- A configuration is nondegenerate if:
  1) there does not exist a line that passes through all of the points,
  2) there does not exist a point that is on all of the lines,
  3) there is at most one line through any two points,
  4) any two lines have at most one intersection point.
  Conditions 3 and 4 are equivalent. -/
class Nondegenerate : Prop where
  exists_point : ∀ l : L, ∃ p, p ∉ l
  exists_line : ∀ p, ∃ l : L, p ∉ l
  eq_or_eq : ∀ {p₁ p₂ : P} {l₁ l₂ : L}, p₁ ∈ l₁ → p₂ ∈ l₁ → p₁ ∈ l₂ → p₂ ∈ l₂ → p₁ = p₂ ∨ l₁ = l₂
#align configuration.nondegenerate Configuration.Nondegenerate

/-- A nondegenerate configuration in which every pair of lines has an intersection point. -/
class HasPoints extends Nondegenerate P L where
  mkPoint : ∀ {l₁ l₂ : L} (h : l₁ ≠ l₂), P
  mkPoint_ax : ∀ {l₁ l₂ : L} (h : l₁ ≠ l₂), mk_point h ∈ l₁ ∧ mk_point h ∈ l₂
#align configuration.has_points Configuration.HasPoints

/-- A nondegenerate configuration in which every pair of points has a line through them. -/
class HasLines extends Nondegenerate P L where
  mkLine : ∀ {p₁ p₂ : P} (h : p₁ ≠ p₂), L
  mkLine_ax : ∀ {p₁ p₂ : P} (h : p₁ ≠ p₂), p₁ ∈ mk_line h ∧ p₂ ∈ mk_line h
#align configuration.has_lines Configuration.HasLines

open Nondegenerate

open HasPoints (mkPoint mkPoint_ax)

open HasLines (mkLine mkLine_ax)

instance [Nondegenerate P L] : Nondegenerate (Dual L) (Dual P)
    where
  exists_point := @exists_line P L _ _
  exists_line := @exists_point P L _ _
  eq_or_eq l₁ l₂ p₁ p₂ h₁ h₂ h₃ h₄ := (@eq_or_eq P L _ _ p₁ p₂ l₁ l₂ h₁ h₃ h₂ h₄).symm

instance [HasPoints P L] : HasLines (Dual L) (Dual P) :=
  { Dual.nondegenerate _ _ with
    mkLine := @mkPoint P L _ _
    mkLine_ax := fun _ _ => mkPoint_ax }

instance [HasLines P L] : HasPoints (Dual L) (Dual P) :=
  { Dual.nondegenerate _ _ with
    mkPoint := @mkLine P L _ _
    mkPoint_ax := fun _ _ => mkLine_ax }

theorem HasPoints.existsUnique_point [HasPoints P L] (l₁ l₂ : L) (hl : l₁ ≠ l₂) :
    ∃! p, p ∈ l₁ ∧ p ∈ l₂ :=
  ⟨mkPoint hl, mkPoint_ax hl, fun p hp =>
    (eq_or_eq hp.1 (mkPoint_ax hl).1 hp.2 (mkPoint_ax hl).2).resolve_right hl⟩
#align configuration.has_points.exists_unique_point Configuration.HasPoints.existsUnique_point

theorem HasLines.existsUnique_line [HasLines P L] (p₁ p₂ : P) (hp : p₁ ≠ p₂) :
    ∃! l : L, p₁ ∈ l ∧ p₂ ∈ l :=
  HasPoints.existsUnique_point (Dual L) (Dual P) p₁ p₂ hp
#align configuration.has_lines.exists_unique_line Configuration.HasLines.existsUnique_line

variable {P L}

/-- If a nondegenerate configuration has at least as many points as lines, then there exists
  an injective function `f` from lines to points, such that `f l` does not lie on `l`. -/
theorem Nondegenerate.exists_injective_of_card_le [Nondegenerate P L] [Fintype P] [Fintype L]
    (h : Fintype.card L ≤ Fintype.card P) : ∃ f : L → P, Function.Injective f ∧ ∀ l, f l ∉ l := by
  classical
    let t : L → Finset P := fun l => Set.toFinset { p | p ∉ l }
    suffices ∀ s : Finset L, s.card ≤ (s.bunionᵢ t).card
      by
      -- Hall's marriage theorem
      obtain ⟨f, hf1, hf2⟩ := (Finset.all_card_le_bunionᵢ_card_iff_exists_injective t).mp this
      exact ⟨f, hf1, fun l => set.mem_to_finset.mp (hf2 l)⟩
    intro s
    by_cases hs₀ : s.card = 0
    -- If `s = ∅`, then `s.card = 0 ≤ (s.bUnion t).card`
    · simp_rw [hs₀, zero_le]
    by_cases hs₁ : s.card = 1
    -- If `s = {l}`, then pick a point `p ∉ l`
    · obtain ⟨l, rfl⟩ := finset.card_eq_one.mp hs₁
      obtain ⟨p, hl⟩ := exists_point l
      rw [Finset.card_singleton, Finset.singleton_bunionᵢ, Nat.one_le_iff_ne_zero]
      exact Finset.card_ne_zero_of_mem (set.mem_to_finset.mpr hl)
    suffices s.bUnion tᶜ.card ≤ sᶜ.card
      by
      -- Rephrase in terms of complements (uses `h`)
      rw [Finset.card_compl, Finset.card_compl, tsub_le_iff_left] at this
      replace := h.trans this
      rwa [← add_tsub_assoc_of_le s.card_le_univ, le_tsub_iff_left (le_add_left s.card_le_univ),
        add_le_add_iff_right] at this
    have hs₂ : s.bUnion tᶜ.card ≤ 1 :=
      by
      -- At most one line through two points of `s`
      refine' finset.card_le_one_iff.mpr fun p₁ p₂ hp₁ hp₂ => _
      simp_rw [Finset.mem_compl, Finset.mem_bunionᵢ, exists_prop, not_exists, not_and,
        Set.mem_toFinset, Set.mem_setOf_eq, Classical.not_not] at hp₁ hp₂
      obtain ⟨l₁, l₂, hl₁, hl₂, hl₃⟩ :=
        finset.one_lt_card_iff.mp (nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hs₀, hs₁⟩)
      exact (eq_or_eq (hp₁ l₁ hl₁) (hp₂ l₁ hl₁) (hp₁ l₂ hl₂) (hp₂ l₂ hl₂)).resolve_right hl₃
    by_cases hs₃ : sᶜ.card = 0
    · rw [hs₃, le_zero_iff]
      rw [Finset.card_compl, tsub_eq_zero_iff_le, LE.le.le_iff_eq (Finset.card_le_univ _), eq_comm,
        Finset.card_eq_iff_eq_univ] at hs₃⊢
      rw [hs₃]
      rw [Finset.eq_univ_iff_forall] at hs₃⊢
      exact fun p =>
        Exists.elim (exists_line p)-- If `s = univ`, then show `s.bUnion t = univ`
        fun l hl => finset.mem_bUnion.mpr ⟨l, Finset.mem_univ l, set.mem_to_finset.mpr hl⟩
    · exact hs₂.trans (nat.one_le_iff_ne_zero.mpr hs₃)
#align configuration.nondegenerate.exists_injective_of_card_le Configuration.Nondegenerate.exists_injective_of_card_le

-- If `s < univ`, then consequence of `hs₂`
variable {P} (L)

/-- Number of points on a given line. -/
noncomputable def lineCount (p : P) : ℕ :=
  Nat.card { l : L // p ∈ l }
#align configuration.line_count Configuration.lineCount

variable (P) {L}

/-- Number of lines through a given point. -/
noncomputable def pointCount (l : L) : ℕ :=
  Nat.card { p : P // p ∈ l }
#align configuration.point_count Configuration.pointCount

variable (P L)

theorem sum_lineCount_eq_sum_pointCount [Fintype P] [Fintype L] :
    (∑ p : P, lineCount L p) = ∑ l : L, pointCount P l := by
  classical
    simp only [line_count, point_count, Nat.card_eq_fintype_card, ← Fintype.card_sigma]
    apply Fintype.card_congr
    calc
      (Σp, { l : L // p ∈ l }) ≃ { x : P × L // x.1 ∈ x.2 } :=
        (Equiv.subtypeProdEquivSigmaSubtype (· ∈ ·)).symm
      _ ≃ { x : L × P // x.2 ∈ x.1 } := ((Equiv.prodComm P L).subtypeEquiv fun x => Iff.rfl)
      _ ≃ Σl, { p // p ∈ l } := Equiv.subtypeProdEquivSigmaSubtype fun (l : L) (p : P) => p ∈ l

#align configuration.sum_line_count_eq_sum_point_count Configuration.sum_lineCount_eq_sum_pointCount

variable {P L}

theorem HasLines.pointCount_le_lineCount [HasLines P L] {p : P} {l : L} (h : p ∉ l)
    [Finite { l : L // p ∈ l }] : pointCount P l ≤ lineCount L p :=
  by
  by_cases hf : Infinite { p : P // p ∈ l }
  · exact (le_of_eq Nat.card_eq_zero_of_infinite).trans (zero_le (line_count L p))
  haveI := fintypeOfNotInfinite hf
  cases nonempty_fintype { l : L // p ∈ l }
  rw [line_count, point_count, Nat.card_eq_fintype_card, Nat.card_eq_fintype_card]
  have : ∀ p' : { p // p ∈ l }, p ≠ p' := fun p' hp' => h ((congr_arg (· ∈ l) hp').mpr p'.2)
  exact
    Fintype.card_le_of_injective (fun p' => ⟨mk_line (this p'), (mk_line_ax (this p')).1⟩)
      fun p₁ p₂ hp =>
      Subtype.ext
        ((eq_or_eq p₁.2 p₂.2 (mk_line_ax (this p₁)).2
              ((congr_arg _ (subtype.ext_iff.mp hp)).mpr (mk_line_ax (this p₂)).2)).resolve_right
          fun h' => (congr_arg _ h').mp h (mk_line_ax (this p₁)).1)
#align configuration.has_lines.point_count_le_line_count Configuration.HasLines.pointCount_le_lineCount

theorem HasPoints.lineCount_le_pointCount [HasPoints P L] {p : P} {l : L} (h : p ∉ l)
    [hf : Finite { p : P // p ∈ l }] : lineCount L p ≤ pointCount P l :=
  @HasLines.pointCount_le_lineCount (Dual L) (Dual P) _ _ l p h hf
#align configuration.has_points.line_count_le_point_count Configuration.HasPoints.lineCount_le_pointCount

variable (P L)

/-- If a nondegenerate configuration has a unique line through any two points, then `|P| ≤ |L|`. -/
theorem HasLines.card_le [HasLines P L] [Fintype P] [Fintype L] : Fintype.card P ≤ Fintype.card L :=
  by
  classical
    by_contra hc₂
    obtain ⟨f, hf₁, hf₂⟩ := nondegenerate.exists_injective_of_card_le (le_of_not_le hc₂)
    have :=
      calc
        (∑ p, line_count L p) = ∑ l, point_count P l := sum_line_count_eq_sum_point_count P L
        _ ≤ ∑ l, line_count L (f l) :=
          (Finset.sum_le_sum fun l hl => has_lines.point_count_le_line_count (hf₂ l))
        _ = ∑ p in finset.univ.image f, line_count L p :=
          (Finset.sum_bij (fun l hl => f l) (fun l hl => Finset.mem_image_of_mem f hl)
            (fun l hl => rfl) (fun l₁ l₂ hl₁ hl₂ hl₃ => hf₁ hl₃) fun p => by
            simp_rw [Finset.mem_image, eq_comm, imp_self])
        _ < ∑ p, line_count L p := _

    · exact lt_irrefl _ this
    · obtain ⟨p, hp⟩ := not_forall.mp (mt (Fintype.card_le_of_surjective f) hc₂)
      refine'
        Finset.sum_lt_sum_of_subset (finset.univ.image f).subset_univ (Finset.mem_univ p) _ _
          fun p hp₁ hp₂ => zero_le (line_count L p)
      · simpa only [Finset.mem_image, exists_prop, Finset.mem_univ, true_and_iff]
      · rw [line_count, Nat.card_eq_fintype_card, Fintype.card_pos_iff]
        obtain ⟨l, hl⟩ := @exists_line P L _ _ p
        exact
          let this := not_exists.mp hp l
          ⟨⟨mk_line this, (mk_line_ax this).2⟩⟩
#align configuration.has_lines.card_le Configuration.HasLines.card_le

/-- If a nondegenerate configuration has a unique point on any two lines, then `|L| ≤ |P|`. -/
theorem HasPoints.card_le [HasPoints P L] [Fintype P] [Fintype L] :
    Fintype.card L ≤ Fintype.card P :=
  @HasLines.card_le (Dual L) (Dual P) _ _ _ _
#align configuration.has_points.card_le Configuration.HasPoints.card_le

variable {P L}

theorem HasLines.exists_bijective_of_card_eq [HasLines P L] [Fintype P] [Fintype L]
    (h : Fintype.card P = Fintype.card L) :
    ∃ f : L → P, Function.Bijective f ∧ ∀ l, pointCount P l = lineCount L (f l) := by
  classical
    obtain ⟨f, hf1, hf2⟩ := nondegenerate.exists_injective_of_card_le (ge_of_eq h)
    have hf3 := (Fintype.bijective_iff_injective_and_card f).mpr ⟨hf1, h.symm⟩
    refine'
      ⟨f, hf3, fun l =>
        (Finset.sum_eq_sum_iff_of_le fun l hl => has_lines.point_count_le_line_count (hf2 l)).mp
          ((sum_line_count_eq_sum_point_count P L).symm.trans
            (Finset.sum_bij (fun l hl => f l) (fun l hl => Finset.mem_univ (f l))
                (fun l hl => refl (line_count L (f l))) (fun l₁ l₂ hl₁ hl₂ hl => hf1 hl) fun p hp =>
                _).symm)
          l (Finset.mem_univ l)⟩
    obtain ⟨l, rfl⟩ := hf3.2 p
    exact ⟨l, Finset.mem_univ l, rfl⟩
#align configuration.has_lines.exists_bijective_of_card_eq Configuration.HasLines.exists_bijective_of_card_eq

theorem HasLines.lineCount_eq_pointCount [HasLines P L] [Fintype P] [Fintype L]
    (hPL : Fintype.card P = Fintype.card L) {p : P} {l : L} (hpl : p ∉ l) :
    lineCount L p = pointCount P l := by
  classical
    obtain ⟨f, hf1, hf2⟩ := has_lines.exists_bijective_of_card_eq hPL
    let s : Finset (P × L) := Set.toFinset { i | i.1 ∈ i.2 }
    have step1 : (∑ i : P × L, line_count L i.1) = ∑ i : P × L, point_count P i.2 :=
      by
      rw [← Finset.univ_product_univ, Finset.sum_product_right, Finset.sum_product]
      simp_rw [Finset.sum_const, Finset.card_univ, hPL, sum_line_count_eq_sum_point_count]
    have step2 : (∑ i in s, line_count L i.1) = ∑ i in s, point_count P i.2 :=
      by
      rw [s.sum_finset_product Finset.univ fun p => Set.toFinset { l | p ∈ l }]
      rw [s.sum_finset_product_right Finset.univ fun l => Set.toFinset { p | p ∈ l }]
      refine'
        (Finset.sum_bij (fun l hl => f l) (fun l hl => Finset.mem_univ (f l)) (fun l hl => _)
            (fun _ _ _ _ h => hf1.1 h) fun p hp => _).symm
      · simp_rw [Finset.sum_const, Set.toFinset_card, ← Nat.card_eq_fintype_card]
        change point_count P l • point_count P l = line_count L (f l) • line_count L (f l)
        rw [hf2]
      · obtain ⟨l, hl⟩ := hf1.2 p
        exact ⟨l, Finset.mem_univ l, hl.symm⟩
      all_goals simp_rw [Finset.mem_univ, true_and_iff, Set.mem_toFinset]; exact fun p => Iff.rfl
    have step3 : (∑ i in sᶜ, line_count L i.1) = ∑ i in sᶜ, point_count P i.2 := by
      rwa [← s.sum_add_sum_compl, ← s.sum_add_sum_compl, step2, add_left_cancel_iff] at step1
    rw [← Set.toFinset_compl] at step3
    exact
      ((Finset.sum_eq_sum_iff_of_le fun i hi =>
              has_lines.point_count_le_line_count (set.mem_to_finset.mp hi)).mp
          step3.symm (p, l) (set.mem_to_finset.mpr hpl)).symm
#align configuration.has_lines.line_count_eq_point_count Configuration.HasLines.lineCount_eq_pointCount

theorem HasPoints.lineCount_eq_pointCount [HasPoints P L] [Fintype P] [Fintype L]
    (hPL : Fintype.card P = Fintype.card L) {p : P} {l : L} (hpl : p ∉ l) :
    lineCount L p = pointCount P l :=
  (@HasLines.lineCount_eq_pointCount (Dual L) (Dual P) _ _ _ _ hPL.symm l p hpl).symm
#align configuration.has_points.line_count_eq_point_count Configuration.HasPoints.lineCount_eq_pointCount

/-- If a nondegenerate configuration has a unique line through any two points, and if `|P| = |L|`,
  then there is a unique point on any two lines. -/
noncomputable def HasLines.hasPoints [HasLines P L] [Fintype P] [Fintype L]
    (h : Fintype.card P = Fintype.card L) : HasPoints P L :=
  let this : ∀ l₁ l₂ : L, l₁ ≠ l₂ → ∃ p : P, p ∈ l₁ ∧ p ∈ l₂ := fun l₁ l₂ hl => by
    classical
      obtain ⟨f, hf1, hf2⟩ := has_lines.exists_bijective_of_card_eq h
      haveI : Nontrivial L := ⟨⟨l₁, l₂, hl⟩⟩
      haveI := fintype.one_lt_card_iff_nontrivial.mp ((congr_arg _ h).mpr Fintype.one_lt_card)
      have h₁ : ∀ p : P, 0 < line_count L p := fun p =>
        Exists.elim (exists_ne p) fun q hq =>
          (congr_arg _ Nat.card_eq_fintype_card).mpr
            (fintype.card_pos_iff.mpr ⟨⟨mk_line hq, (mk_line_ax hq).2⟩⟩)
      have h₂ : ∀ l : L, 0 < point_count P l := fun l => (congr_arg _ (hf2 l)).mpr (h₁ (f l))
      obtain ⟨p, hl₁⟩ := fintype.card_pos_iff.mp ((congr_arg _ Nat.card_eq_fintype_card).mp (h₂ l₁))
      by_cases hl₂ : p ∈ l₂
      exact ⟨p, hl₁, hl₂⟩
      have key' : Fintype.card { q : P // q ∈ l₂ } = Fintype.card { l : L // p ∈ l } :=
        ((has_lines.line_count_eq_point_count h hl₂).trans Nat.card_eq_fintype_card).symm.trans
          Nat.card_eq_fintype_card
      have : ∀ q : { q // q ∈ l₂ }, p ≠ q := fun q hq => hl₂ ((congr_arg (· ∈ l₂) hq).mpr q.2)
      let f : { q : P // q ∈ l₂ } → { l : L // p ∈ l } := fun q =>
        ⟨mk_line (this q), (mk_line_ax (this q)).1⟩
      have hf : Function.Injective f := fun q₁ q₂ hq =>
        Subtype.ext
          ((eq_or_eq q₁.2 q₂.2 (mk_line_ax (this q₁)).2
                ((congr_arg _ (subtype.ext_iff.mp hq)).mpr (mk_line_ax (this q₂)).2)).resolve_right
            fun h => (congr_arg _ h).mp hl₂ (mk_line_ax (this q₁)).1)
      have key' := ((Fintype.bijective_iff_injective_and_card f).mpr ⟨hf, key'⟩).2
      obtain ⟨q, hq⟩ := key' ⟨l₁, hl₁⟩
      exact ⟨q, (congr_arg _ (subtype.ext_iff.mp hq)).mp (mk_line_ax (this q)).2, q.2⟩
  { ‹HasLines P L› with
    mkPoint := fun l₁ l₂ hl => Classical.choose (this l₁ l₂ hl)
    mkPoint_ax := fun l₁ l₂ hl => Classical.choose_spec (this l₁ l₂ hl) }
#align configuration.has_lines.has_points Configuration.HasLines.hasPoints

/-- If a nondegenerate configuration has a unique point on any two lines, and if `|P| = |L|`,
  then there is a unique line through any two points. -/
noncomputable def HasPoints.hasLines [HasPoints P L] [Fintype P] [Fintype L]
    (h : Fintype.card P = Fintype.card L) : HasLines P L :=
  let this := @HasLines.hasPoints (Dual L) (Dual P) _ _ _ _ h.symm
  { ‹HasPoints P L› with
    mkLine := fun _ _ => this.mkPoint
    mkLine_ax := fun _ _ => this.mkPoint_ax }
#align configuration.has_points.has_lines Configuration.HasPoints.hasLines

variable (P L)

/-- A projective plane is a nondegenerate configuration in which every pair of lines has
  an intersection point, every pair of points has a line through them,
  and which has three points in general position. -/
class ProjectivePlane extends HasPoints P L, HasLines P L where
  exists_config :
    ∃ (p₁ p₂ p₃ : P)(l₁ l₂ l₃ : L),
      p₁ ∉ l₂ ∧ p₁ ∉ l₃ ∧ p₂ ∉ l₁ ∧ p₂ ∈ l₂ ∧ p₂ ∈ l₃ ∧ p₃ ∉ l₁ ∧ p₃ ∈ l₂ ∧ p₃ ∉ l₃
#align configuration.projective_plane Configuration.ProjectivePlane

namespace ProjectivePlane

variable [ProjectivePlane P L]

instance : ProjectivePlane (Dual L) (Dual P) :=
  { Dual.hasPoints _ _, Dual.hasLines _ _ with
    exists_config :=
      let ⟨p₁, p₂, p₃, l₁, l₂, l₃, h₁₂, h₁₃, h₂₁, h₂₂, h₂₃, h₃₁, h₃₂, h₃₃⟩ := @exists_config P L _ _
      ⟨l₁, l₂, l₃, p₁, p₂, p₃, h₂₁, h₃₁, h₁₂, h₂₂, h₃₂, h₁₃, h₂₃, h₃₃⟩ }

/-- The order of a projective plane is one less than the number of lines through an arbitrary point.
Equivalently, it is one less than the number of points on an arbitrary line. -/
noncomputable def order : ℕ :=
  lineCount L (Classical.choose (@exists_config P L _ _)) - 1
#align configuration.projective_plane.order Configuration.ProjectivePlane.order

theorem card_points_eq_card_lines [Fintype P] [Fintype L] : Fintype.card P = Fintype.card L :=
  le_antisymm (HasLines.card_le P L) (HasPoints.card_le P L)
#align configuration.projective_plane.card_points_eq_card_lines Configuration.ProjectivePlane.card_points_eq_card_lines

variable {P} (L)

theorem lineCount_eq_lineCount [Finite P] [Finite L] (p q : P) : lineCount L p = lineCount L q :=
  by
  cases nonempty_fintype P
  cases nonempty_fintype L
  obtain ⟨p₁, p₂, p₃, l₁, l₂, l₃, h₁₂, h₁₃, h₂₁, h₂₂, h₂₃, h₃₁, h₃₂, h₃₃⟩ := exists_config
  have h := card_points_eq_card_lines P L
  let n := line_count L p₂
  have hp₂ : line_count L p₂ = n := rfl
  have hl₁ : point_count P l₁ = n := (has_lines.line_count_eq_point_count h h₂₁).symm.trans hp₂
  have hp₃ : line_count L p₃ = n := (has_lines.line_count_eq_point_count h h₃₁).trans hl₁
  have hl₃ : point_count P l₃ = n := (has_lines.line_count_eq_point_count h h₃₃).symm.trans hp₃
  have hp₁ : line_count L p₁ = n := (has_lines.line_count_eq_point_count h h₁₃).trans hl₃
  have hl₂ : point_count P l₂ = n := (has_lines.line_count_eq_point_count h h₁₂).symm.trans hp₁
  suffices ∀ p : P, line_count L p = n by exact (this p).trans (this q).symm
  refine' fun p =>
    or_not.elim (fun h₂ => _) fun h₂ => (has_lines.line_count_eq_point_count h h₂).trans hl₂
  refine' or_not.elim (fun h₃ => _) fun h₃ => (has_lines.line_count_eq_point_count h h₃).trans hl₃
  rwa [(eq_or_eq h₂ h₂₂ h₃ h₂₃).resolve_right fun h =>
      h₃₃ ((congr_arg (Membership.Mem p₃) h).mp h₃₂)]
#align configuration.projective_plane.line_count_eq_line_count Configuration.ProjectivePlane.lineCount_eq_lineCount

variable (P) {L}

theorem pointCount_eq_pointCount [Finite P] [Finite L] (l m : L) :
    pointCount P l = pointCount P m :=
  lineCount_eq_lineCount (Dual P) l m
#align configuration.projective_plane.point_count_eq_point_count Configuration.ProjectivePlane.pointCount_eq_pointCount

variable {P L}

theorem lineCount_eq_pointCount [Finite P] [Finite L] (p : P) (l : L) :
    lineCount L p = pointCount P l :=
  Exists.elim (exists_point l) fun q hq =>
    (lineCount_eq_lineCount L p q).trans <|
      by
      cases nonempty_fintype P
      cases nonempty_fintype L
      exact has_lines.line_count_eq_point_count (card_points_eq_card_lines P L) hq
#align configuration.projective_plane.line_count_eq_point_count Configuration.ProjectivePlane.lineCount_eq_pointCount

variable (P L)

theorem Dual.order [Finite P] [Finite L] : order (Dual L) (Dual P) = order P L :=
  congr_arg (fun n => n - 1) (lineCount_eq_pointCount _ _)
#align configuration.projective_plane.dual.order Configuration.ProjectivePlane.Dual.order

variable {P} (L)

theorem lineCount_eq [Finite P] [Finite L] (p : P) : lineCount L p = order P L + 1 := by
  classical
    obtain ⟨q, -, -, l, -, -, -, -, h, -⟩ := Classical.choose_spec (@exists_config P L _ _)
    cases nonempty_fintype { l : L // q ∈ l }
    rw [order, line_count_eq_line_count L p q, line_count_eq_line_count L (Classical.choose _) q,
      line_count, Nat.card_eq_fintype_card, Nat.sub_add_cancel]
    exact fintype.card_pos_iff.mpr ⟨⟨l, h⟩⟩
#align configuration.projective_plane.line_count_eq Configuration.ProjectivePlane.lineCount_eq

variable (P) {L}

theorem pointCount_eq [Finite P] [Finite L] (l : L) : pointCount P l = order P L + 1 :=
  (lineCount_eq (Dual P) l).trans (congr_arg (fun n => n + 1) (Dual.order P L))
#align configuration.projective_plane.point_count_eq Configuration.ProjectivePlane.pointCount_eq

variable (P L)

theorem one_lt_order [Finite P] [Finite L] : 1 < order P L :=
  by
  obtain ⟨p₁, p₂, p₃, l₁, l₂, l₃, -, -, h₂₁, h₂₂, h₂₃, h₃₁, h₃₂, h₃₃⟩ := @exists_config P L _ _
  classical
    cases nonempty_fintype { p : P // p ∈ l₂ }
    rw [← add_lt_add_iff_right, ← point_count_eq _ l₂, point_count, Nat.card_eq_fintype_card]
    simp_rw [Fintype.two_lt_card_iff, Ne, Subtype.ext_iff]
    have h := mk_point_ax fun h => h₂₁ ((congr_arg _ h).mpr h₂₂)
    exact
      ⟨⟨mk_point _, h.2⟩, ⟨p₂, h₂₂⟩, ⟨p₃, h₃₂⟩, ne_of_mem_of_not_mem h.1 h₂₁,
        ne_of_mem_of_not_mem h.1 h₃₁, ne_of_mem_of_not_mem h₂₃ h₃₃⟩
#align configuration.projective_plane.one_lt_order Configuration.ProjectivePlane.one_lt_order

variable {P} (L)

theorem two_lt_lineCount [Finite P] [Finite L] (p : P) : 2 < lineCount L p := by
  simpa only [line_count_eq L p, Nat.succ_lt_succ_iff] using one_lt_order P L
#align configuration.projective_plane.two_lt_line_count Configuration.ProjectivePlane.two_lt_lineCount

variable (P) {L}

theorem two_lt_pointCount [Finite P] [Finite L] (l : L) : 2 < pointCount P l := by
  simpa only [point_count_eq P l, Nat.succ_lt_succ_iff] using one_lt_order P L
#align configuration.projective_plane.two_lt_point_count Configuration.ProjectivePlane.two_lt_pointCount

variable (P) (L)

theorem card_points [Fintype P] [Finite L] : Fintype.card P = order P L ^ 2 + order P L + 1 :=
  by
  cases nonempty_fintype L
  obtain ⟨p, -⟩ := @exists_config P L _ _
  let ϕ : { q // q ≠ p } ≃ Σl : { l : L // p ∈ l }, { q // q ∈ l.1 ∧ q ≠ p } :=
    { toFun := fun q => ⟨⟨mk_line q.2, (mk_line_ax q.2).2⟩, q, (mk_line_ax q.2).1, q.2⟩
      invFun := fun lq => ⟨lq.2, lq.2.2.2⟩
      left_inv := fun q => Subtype.ext rfl
      right_inv := fun lq =>
        Sigma.subtype_ext
          (Subtype.ext
            ((eq_or_eq (mk_line_ax lq.2.2.2).1 (mk_line_ax lq.2.2.2).2 lq.2.2.1 lq.1.2).resolve_left
              lq.2.2.2))
          rfl }
  classical
    have h1 : Fintype.card { q // q ≠ p } + 1 = Fintype.card P :=
      by
      apply (eq_tsub_iff_add_eq_of_le (Nat.succ_le_of_lt (fintype.card_pos_iff.mpr ⟨p⟩))).mp
      convert(Fintype.card_subtype_compl _).trans (congr_arg _ (Fintype.card_subtype_eq p))
    have h2 : ∀ l : { l : L // p ∈ l }, Fintype.card { q // q ∈ l.1 ∧ q ≠ p } = order P L :=
      by
      intro l
      rw [← Fintype.card_congr (Equiv.subtypeSubtypeEquivSubtypeInter (· ∈ l.val) (· ≠ p)),
        Fintype.card_subtype_compl fun x : Subtype (· ∈ l.val) => x.val = p, ←
        Nat.card_eq_fintype_card]
      refine' tsub_eq_of_eq_add ((point_count_eq P l.1).trans _)
      rw [← Fintype.card_subtype_eq (⟨p, l.2⟩ : { q : P // q ∈ l.1 })]
      simp_rw [Subtype.ext_iff_val]
    simp_rw [← h1, Fintype.card_congr ϕ, Fintype.card_sigma, h2, Finset.sum_const, Finset.card_univ]
    rw [← Nat.card_eq_fintype_card, ← line_count, line_count_eq, smul_eq_mul, Nat.succ_mul, sq]
#align configuration.projective_plane.card_points Configuration.ProjectivePlane.card_points

theorem card_lines [Finite P] [Fintype L] : Fintype.card L = order P L ^ 2 + order P L + 1 :=
  (card_points (Dual L) (Dual P)).trans (congr_arg (fun n => n ^ 2 + n + 1) (Dual.order P L))
#align configuration.projective_plane.card_lines Configuration.ProjectivePlane.card_lines

end ProjectivePlane

end Configuration


/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark
-/

import data.polynomial.expand
import linear_algebra.matrix.charpoly.basic

/-!
# Characteristic polynomials

We give methods for computing coefficients of the characteristic polynomial.

## Main definitions

- `matrix.charpoly_degree_eq_dim` proves that the degree of the characteristic polynomial
  over a nonzero ring is the dimension of the matrix
- `matrix.det_eq_sign_charpoly_coeff` proves that the determinant is the constant term of the
  characteristic polynomial, up to sign.
- `matrix.trace_eq_neg_charpoly_coeff` proves that the trace is the negative of the (d-1)th
  coefficient of the characteristic polynomial, where d is the dimension of the matrix.
  For a nonzero ring, this is the second-highest coefficient.

-/

noncomputable theory

universes u v w z

open polynomial matrix
open_locale big_operators polynomial

variables {R : Type u} [comm_ring R]
variables {n G : Type v} [decidable_eq n] [fintype n]
variables {α β : Type v} [decidable_eq α]

open finset

variable {M : matrix n n R}

lemma charmatrix_apply_nat_degree [nontrivial R] (i j : n) :
  (charmatrix M i j).nat_degree = ite (i = j) 1 0 :=
by { by_cases i = j; simp [h, ← degree_eq_iff_nat_degree_eq_of_pos (nat.succ_pos 0)], }

lemma charmatrix_apply_nat_degree_le (i j : n) :
  (charmatrix M i j).nat_degree ≤ ite (i = j) 1 0 :=
by split_ifs; simp [h, nat_degree_X_sub_C_le]

namespace matrix

variable (M)
lemma charpoly_sub_diagonal_degree_lt :
(M.charpoly - ∏ (i : n), (X - C (M i i))).degree < ↑(fintype.card n - 1) :=
begin
  rw [charpoly, det_apply', ← insert_erase (mem_univ (equiv.refl n)),
    sum_insert (not_mem_erase (equiv.refl n) univ), add_comm],
  simp only [charmatrix_apply_eq, one_mul, equiv.perm.sign_refl, id.def, int.cast_one,
    units.coe_one, add_sub_cancel, equiv.coe_refl],
  rw ← mem_degree_lt, apply submodule.sum_mem (degree_lt R (fintype.card n - 1)),
  intros c hc, rw [← C_eq_int_cast, C_mul'],
  apply submodule.smul_mem (degree_lt R (fintype.card n - 1)) ↑↑(equiv.perm.sign c),
  rw mem_degree_lt, apply lt_of_le_of_lt degree_le_nat_degree _, rw with_bot.coe_lt_coe,
  apply lt_of_le_of_lt _ (equiv.perm.fixed_point_card_lt_of_ne_one (ne_of_mem_erase hc)),
  apply le_trans (polynomial.nat_degree_prod_le univ (λ i : n, (charmatrix M (c i) i))) _,
  rw card_eq_sum_ones, rw sum_filter, apply sum_le_sum,
  intros, apply charmatrix_apply_nat_degree_le,
end

lemma charpoly_coeff_eq_prod_coeff_of_le {k : ℕ} (h : fintype.card n - 1 ≤ k) :
  M.charpoly.coeff k = (∏ i : n, (X - C (M i i))).coeff k :=
begin
  apply eq_of_sub_eq_zero, rw ← coeff_sub, apply polynomial.coeff_eq_zero_of_degree_lt,
  apply lt_of_lt_of_le (charpoly_sub_diagonal_degree_lt M) _, rw with_bot.coe_le_coe, apply h,
end

lemma det_of_card_zero (h : fintype.card n = 0) (M : matrix n n R) : M.det = 1 :=
by { rw fintype.card_eq_zero_iff at h, suffices : M = 1, { simp [this] }, ext i, exact h.elim i }

theorem charpoly_degree_eq_dim [nontrivial R] (M : matrix n n R) :
M.charpoly.degree = fintype.card n :=
begin
  by_cases fintype.card n = 0,
  { rw h, unfold charpoly, rw det_of_card_zero, {simp}, {assumption} },
  rw ← sub_add_cancel M.charpoly (∏ (i : n), (X - C (M i i))),
  have h1 : (∏ (i : n), (X - C (M i i))).degree = fintype.card n,
  { rw degree_eq_iff_nat_degree_eq_of_pos, swap, apply nat.pos_of_ne_zero h,
    rw nat_degree_prod', simp_rw nat_degree_X_sub_C, unfold fintype.card, simp,
    simp_rw (monic_X_sub_C _).leading_coeff, simp, },
  rw degree_add_eq_right_of_degree_lt, exact h1, rw h1,
  apply lt_trans (charpoly_sub_diagonal_degree_lt M), rw with_bot.coe_lt_coe,
  rw ← nat.pred_eq_sub_one, apply nat.pred_lt, apply h,
end

theorem charpoly_nat_degree_eq_dim [nontrivial R] (M : matrix n n R) :
  M.charpoly.nat_degree = fintype.card n :=
nat_degree_eq_of_degree_eq_some (charpoly_degree_eq_dim M)

lemma charpoly_monic (M : matrix n n R) : M.charpoly.monic :=
begin
  nontriviality,
  by_cases fintype.card n = 0, {rw [charpoly, det_of_card_zero h], apply monic_one},
  have mon : (∏ (i : n), (X - C (M i i))).monic,
  { apply monic_prod_of_monic univ (λ i : n, (X - C (M i i))), simp [monic_X_sub_C], },
  rw ← sub_add_cancel (∏ (i : n), (X - C (M i i))) M.charpoly at mon,
  rw monic at *, rw leading_coeff_add_of_degree_lt at mon, rw ← mon,
  rw charpoly_degree_eq_dim, rw ← neg_sub, rw degree_neg,
  apply lt_trans (charpoly_sub_diagonal_degree_lt M), rw with_bot.coe_lt_coe,
  rw ← nat.pred_eq_sub_one, apply nat.pred_lt, apply h,
end

theorem trace_eq_neg_charpoly_coeff [nonempty n] (M : matrix n n R) :
  trace M = -M.charpoly.coeff (fintype.card n - 1) :=
begin
  rw charpoly_coeff_eq_prod_coeff_of_le, swap, refl,
  rw [fintype.card, prod_X_sub_C_coeff_card_pred univ (λ i : n, M i i) fintype.card_pos, neg_neg,
    trace],
  refl
end

-- I feel like this should use polynomial.alg_hom_eval₂_algebra_map
lemma mat_poly_equiv_eval (M : matrix n n R[X]) (r : R) (i j : n) :
  (mat_poly_equiv M).eval ((scalar n) r) i j = (M i j).eval r :=
begin
  unfold polynomial.eval, unfold eval₂,
  transitivity polynomial.sum (mat_poly_equiv M) (λ (e : ℕ) (a : matrix n n R),
    (a * (scalar n) r ^ e) i j),
  { unfold polynomial.sum, rw sum_apply, dsimp, refl },
  { simp_rw [←ring_hom.map_pow, ←(scalar.commute _ _).eq],
    simp only [coe_scalar, matrix.one_mul, ring_hom.id_apply,
      pi.smul_apply, smul_eq_mul, mul_eq_mul, algebra.smul_mul_assoc],
    have h : ∀ x : ℕ, (λ (e : ℕ) (a : R), r ^ e * a) x 0 = 0 := by simp,
    simp only [polynomial.sum, mat_poly_equiv_coeff_apply, mul_comm],
    apply (finset.sum_subset (support_subset_support_mat_poly_equiv _ _ _) _).symm,
    assume n hn h'n,
    rw not_mem_support_iff at h'n,
    simp only [h'n, zero_mul] }
end

lemma eval_det (M : matrix n n R[X]) (r : R) :
  polynomial.eval r M.det = (polynomial.eval (scalar n r) (mat_poly_equiv M)).det :=
begin
  rw [polynomial.eval, ← coe_eval₂_ring_hom, ring_hom.map_det],
  apply congr_arg det, ext, symmetry, convert mat_poly_equiv_eval _ _ _ _,
end

theorem det_eq_sign_charpoly_coeff (M : matrix n n R) :
  M.det = (-1)^(fintype.card n) * M.charpoly.coeff 0:=
begin
  rw [coeff_zero_eq_eval_zero, charpoly, eval_det, mat_poly_equiv_charmatrix, ← det_smul],
  simp
end

end matrix

variables {p : ℕ} [fact p.prime]

lemma mat_poly_equiv_eq_X_pow_sub_C {K : Type*} (k : ℕ) [field K] (M : matrix n n K) :
  mat_poly_equiv
      ((expand K (k) : K[X] →+* K[X]).map_matrix (charmatrix (M ^ k))) =
    X ^ k - C (M ^ k) :=
begin
  ext m,
  rw [coeff_sub, coeff_C, mat_poly_equiv_coeff_apply, ring_hom.map_matrix_apply, matrix.map_apply,
    alg_hom.coe_to_ring_hom, dmatrix.sub_apply, coeff_X_pow],
  by_cases hij : i = j,
  { rw [hij, charmatrix_apply_eq, alg_hom.map_sub, expand_C, expand_X, coeff_sub, coeff_X_pow,
     coeff_C],
    split_ifs with mp m0;
    simp only [matrix.one_apply_eq, dmatrix.zero_apply] },
  { rw [charmatrix_apply_ne _ _ _ hij, alg_hom.map_neg, expand_C, coeff_neg, coeff_C],
    split_ifs with m0 mp;
    simp only [hij, zero_sub, dmatrix.zero_apply, sub_zero, neg_zero, matrix.one_apply_ne, ne.def,
      not_false_iff] }
end

namespace matrix

/-- Any matrix polynomial `p` is equivalent under evaluation to `p %ₘ M.charpoly`; that is, `p`
is equivalent to a polynomial with degree less than the dimension of the matrix. -/
lemma aeval_eq_aeval_mod_charpoly (M : matrix n n R) (p : R[X]) :
  aeval M p = aeval M (p %ₘ M.charpoly) :=
(aeval_mod_by_monic_eq_self_of_root M.charpoly_monic M.aeval_self_charpoly).symm

/-- Any matrix power can be computed as the sum of matrix powers less than `fintype.card n`.

TODO: add the statement for negative powers phrased with `zpow`. -/
lemma pow_eq_aeval_mod_charpoly (M : matrix n n R) (k : ℕ) : M^k = aeval M (X^k %ₘ M.charpoly) :=
by rw [←aeval_eq_aeval_mod_charpoly, map_pow, aeval_X]

end matrix

section ideal

lemma coeff_charpoly_mem_ideal_pow {I : ideal R} (h : ∀ i j, M i j ∈ I) (k : ℕ) :
  M.charpoly.coeff k ∈ I ^ (fintype.card n - k) :=
begin
  delta charpoly,
  rw [matrix.det_apply, finset_sum_coeff],
  apply sum_mem,
  rintro c -,
  rw [coeff_smul, submodule.smul_mem_iff'],
  have : ∑ (x : n), 1 = fintype.card n := by rw [finset.sum_const, card_univ, smul_eq_mul, mul_one],
  rw ← this,
  apply coeff_prod_mem_ideal_pow_tsub,
  rintro i - (_|k),
  { rw [tsub_zero, pow_one, charmatrix_apply, coeff_sub, coeff_X_mul_zero, coeff_C_zero, zero_sub,
      neg_mem_iff],
    exact h (c i) i },
  { rw [nat.succ_eq_one_add, tsub_self_add, pow_zero, ideal.one_eq_top],
    exact submodule.mem_top }
end

end ideal


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

import number_theory.cyclotomic.primitive_roots
import field_theory.polynomial_galois_group

/-!
# Galois group of cyclotomic extensions

In this file, we show the relationship between the Galois group of `K(ζₙ)` and `(zmod n)ˣ`;
it is always a subgroup, and if the `n`th cyclotomic polynomial is irreducible, they are isomorphic.

## Main results

* `is_primitive_root.aut_to_pow_injective`: `is_primitive_root.aut_to_pow` is injective
  in the case that it's considered over a cyclotomic field extension, where `n` does not divide
  the characteristic of K.
* `is_cyclotomic_extension.aut_equiv_pow`: If, additionally, the `n`th cyclotomic polynomial is
  irreducible in K, then `aut_to_pow` is a `mul_equiv` (for example, in ℚ and certain 𝔽ₚ).
* `gal_X_pow_equiv_units_zmod`, `gal_cyclotomic_equiv_units_zmod`: Repackage `aut_equiv_pow` in
  terms of `polynomial.gal`.
* `is_cyclotomic_extension.aut.comm_group`: Cyclotomic extensions are abelian.

## References

* https://kconrad.math.uconn.edu/blurbs/galoistheory/cyclotomic.pdf

## TODO

* We currently can get away with the fact that the power of a primitive root is a primitive root,
  but the correct long-term solution for computing other explicit Galois groups is creating
  `power_basis.map_conjugate`; but figuring out the exact correct assumptions + proof for this is
  mathematically nontrivial. (Current thoughts: the correct condition is that the annihilating
  ideal of both elements is equal. This may not hold in an ID, and definitely holds in an ICD.)

-/

local attribute [instance] pnat.fact_pos

variables {n : ℕ+} (K : Type*) [field K] {L : Type*} [field L] {μ : L} (hμ : is_primitive_root μ n)
          [algebra K L] [is_cyclotomic_extension {n} K L]

open polynomial ne_zero is_cyclotomic_extension

open_locale cyclotomic

namespace is_primitive_root

/-- `is_primitive_root.aut_to_pow` is injective in the case that it's considered over a cyclotomic
field extension, where `n` does not divide the characteristic of K. -/
lemma aut_to_pow_injective : function.injective $ hμ.aut_to_pow K :=
begin
  intros f g hfg,
  apply_fun units.val at hfg,
  simp only [is_primitive_root.coe_aut_to_pow_apply, units.val_eq_coe] at hfg,
  generalize_proofs hf' hg' at hfg,
  have hf := hf'.some_spec,
  have hg := hg'.some_spec,
  generalize_proofs hζ at hf hg,
  suffices : f hμ.to_roots_of_unity = g hμ.to_roots_of_unity,
  { apply alg_equiv.coe_alg_hom_injective,
    apply (hμ.power_basis K).alg_hom_ext,
    exact this },
  rw zmod.eq_iff_modeq_nat at hfg,
  refine (hf.trans _).trans hg.symm,
  rw [←roots_of_unity.coe_pow _ hf'.some, ←roots_of_unity.coe_pow _ hg'.some],
  congr' 1,
  rw [pow_eq_pow_iff_modeq],
  convert hfg,
  rw [hμ.eq_order_of],
  rw [←hμ.coe_to_roots_of_unity_coe] {occs := occurrences.pos [2]},
  rw [order_of_units, order_of_subgroup]
end

end is_primitive_root

namespace is_cyclotomic_extension

/-- Cyclotomic extensions are abelian. -/
noncomputable def aut.comm_group [ne_zero ((n : ℕ) : K)] : comm_group (L ≃ₐ[K] L) :=
let _ := of_no_zero_smul_divisors K L n in by exactI
((zeta_primitive_root n K L).aut_to_pow_injective K).comm_group _
  (map_one _) (map_mul _) (map_inv _) (map_div _) (map_pow _) (map_zpow _)

variables (h : irreducible (cyclotomic n K)) {K} (L)

include h

/-- The `mul_equiv` that takes an automorphism `f` to the element `k : (zmod n)ˣ` such that
  `f μ = μ ^ k`. A stronger version of `is_primitive_root.aut_to_pow`. -/
@[simps] noncomputable def aut_equiv_pow [ne_zero ((n : ℕ) : K)] : (L ≃ₐ[K] L) ≃* (zmod n)ˣ :=
let hn := of_no_zero_smul_divisors K L n in
by exactI
let hζ := zeta_primitive_root n K L,
    hμ := λ t, hζ.pow_of_coprime _ (zmod.val_coe_unit_coprime t) in
{ inv_fun := λ t, (hζ.power_basis K).equiv_of_minpoly ((hμ t).power_basis K)
  begin
    simp only [is_primitive_root.power_basis_gen],
    have hr := is_primitive_root.minpoly_eq_cyclotomic_of_irreducible
               ((zeta_primitive_root n K L).pow_of_coprime _ (zmod.val_coe_unit_coprime t)) h,
    exact ((zeta_primitive_root n K L).minpoly_eq_cyclotomic_of_irreducible h).symm.trans hr
  end,
  left_inv := λ f, begin
    simp only [monoid_hom.to_fun_eq_coe],
    apply alg_equiv.coe_alg_hom_injective,
    apply (hζ.power_basis K).alg_hom_ext,
    simp only [alg_equiv.coe_alg_hom, alg_equiv.map_pow],
    rw power_basis.equiv_of_minpoly_gen,
    simp only [is_primitive_root.power_basis_gen, is_primitive_root.aut_to_pow_spec],
  end,
  right_inv := λ x, begin
    simp only [monoid_hom.to_fun_eq_coe],
    generalize_proofs _ _ _ h,
    have key := hζ.aut_to_pow_spec K ((hζ.power_basis K).equiv_of_minpoly
                                      ((hμ x).power_basis K) h),
    have := (hζ.power_basis K).equiv_of_minpoly_gen ((hμ x).power_basis K) h,
    rw hζ.power_basis_gen K at this,
    rw [this, is_primitive_root.power_basis_gen] at key,
    rw ← hζ.coe_to_roots_of_unity_coe at key {occs := occurrences.pos [1, 5]},
    simp only [←coe_coe, ←roots_of_unity.coe_pow] at key,
    replace key := roots_of_unity.coe_injective key,
    rw [pow_eq_pow_iff_modeq, ←order_of_subgroup, ←order_of_units, hζ.coe_to_roots_of_unity_coe,
        ←(zeta_primitive_root n K L).eq_order_of, ←zmod.eq_iff_modeq_nat] at key,
    simp only [zmod.nat_cast_val, zmod.cast_id', id.def] at key,
    exact units.ext key
  end,
  .. (zeta_primitive_root n K L).aut_to_pow K }

include hμ

variables {L}

/-- Maps `μ` to the `alg_equiv` that sends `is_cyclotomic_extension.zeta` to `μ`. -/
noncomputable def from_zeta_aut [ne_zero ((n : ℕ) : K)] : L ≃ₐ[K] L :=
have _ := of_no_zero_smul_divisors K L n, by exactI
let hζ := (zeta_primitive_root n K L).eq_pow_of_pow_eq_one hμ.pow_eq_one n.pos in
(aut_equiv_pow L h).symm $ zmod.unit_of_coprime hζ.some $
((zeta_primitive_root n K L).pow_iff_coprime n.pos hζ.some).mp $ hζ.some_spec.some_spec.symm ▸ hμ

lemma from_zeta_aut_spec [ne_zero ((n : ℕ) : K)] : from_zeta_aut hμ h (zeta n K L) = μ :=
begin
  simp_rw [from_zeta_aut, aut_equiv_pow_symm_apply],
  generalize_proofs _ hζ h _ hμ _,
  rw [←hζ.power_basis_gen K] {occs := occurrences.pos [4]},
  rw [power_basis.equiv_of_minpoly_gen, hμ.power_basis_gen K],
  convert h.some_spec.some_spec,
  exact zmod.val_cast_of_lt h.some_spec.some
end

end is_cyclotomic_extension

section gal

variables (h : irreducible (cyclotomic n K)) {K}

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`. Asserts that the
Galois group of `cyclotomic n K` is equivalent to `(zmod n)ˣ` if `n` does not divide the
characteristic of `K`, and `cyclotomic n K` is irreducible in the base field. -/
noncomputable def gal_cyclotomic_equiv_units_zmod [ne_zero ((n : ℕ) : K)] :
  (cyclotomic n K).gal ≃* (zmod n)ˣ :=
(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
(is_cyclotomic_extension.aut_equiv_pow L h)

/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`. Asserts that the
Galois group of `X ^ n - 1` is equivalent to `(zmod n)ˣ` if `n` does not divide the characteristic
of `K`, and `cyclotomic n K` is irreducible in the base field. -/
noncomputable def gal_X_pow_equiv_units_zmod [ne_zero ((n : ℕ) : K)] :
  (X ^ (n : ℕ) - 1).gal ≃* (zmod n)ˣ :=
(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
(is_cyclotomic_extension.aut_equiv_pow L h)

end gal


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Damiano Testa, Jens Wagemaker
-/
import algebra.monoid_algebra.division
import data.nat.interval
import data.polynomial.degree.definitions
import data.polynomial.induction

/-!
# Induction on polynomials

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

This file contains lemmas dealing with different flavours of induction on polynomials.
-/

noncomputable theory
open_locale classical big_operators polynomial

open finset

namespace polynomial
universes u v w z
variables {R : Type u} {S : Type v} {T : Type w} {A : Type z} {a b : R} {n : ℕ}

section semiring
variables [semiring R] {p q : R[X]}

/-- `div_X p` returns a polynomial `q` such that `q * X + C (p.coeff 0) = p`.
  It can be used in a semiring where the usual division algorithm is not possible -/
def div_X (p : R[X]) : R[X] :=
⟨add_monoid_algebra.div_of p.to_finsupp 1⟩

@[simp] lemma coeff_div_X : (div_X p).coeff n = p.coeff (n+1) :=
by { rw [add_comm], cases p, refl }

lemma div_X_mul_X_add (p : R[X]) : div_X p * X + C (p.coeff 0) = p :=
ext $ by rintro ⟨_|_⟩; simp [coeff_C, nat.succ_ne_zero, coeff_mul_X]

@[simp] lemma div_X_C (a : R) : div_X (C a) = 0 :=
ext $ λ n, by simp [coeff_div_X, coeff_C, finsupp.single_eq_of_ne _]

lemma div_X_eq_zero_iff : div_X p = 0 ↔ p = C (p.coeff 0) :=
⟨λ h, by simpa [eq_comm, h] using div_X_mul_X_add p,
  λ h, by rw [h, div_X_C]⟩

lemma div_X_add : div_X (p + q) = div_X p + div_X q :=
ext $ by simp

lemma degree_div_X_lt (hp0 : p ≠ 0) : (div_X p).degree < p.degree :=
by haveI := nontrivial.of_polynomial_ne hp0;
calc (div_X p).degree < (div_X p * X + C (p.coeff 0)).degree :
  if h : degree p ≤ 0
  then begin
      have h' : C (p.coeff 0) ≠ 0, by rwa [← eq_C_of_degree_le_zero h],
      rw [eq_C_of_degree_le_zero h, div_X_C, degree_zero, zero_mul, zero_add],
      exact lt_of_le_of_ne bot_le (ne.symm (mt degree_eq_bot.1 $
        by simp [h'])),
    end
  else
    have hXp0 : div_X p ≠ 0,
      by simpa [div_X_eq_zero_iff, -not_le, degree_le_zero_iff] using h,
    have leading_coeff (div_X p) * leading_coeff X ≠ 0, by simpa,
    have degree (C (p.coeff 0)) < degree (div_X p * X),
      from calc degree (C (p.coeff 0)) ≤ 0 : degree_C_le
         ... < 1 : dec_trivial
         ... = degree (X : R[X]) : degree_X.symm
         ... ≤ degree (div_X p * X) :
          by rw [← zero_add (degree X), degree_mul' this];
            exact add_le_add
              (by rw [zero_le_degree_iff, ne.def, div_X_eq_zero_iff];
                exact λ h0, h (h0.symm ▸ degree_C_le))
              le_rfl,
    by rw [degree_add_eq_left_of_degree_lt this];
      exact degree_lt_degree_mul_X hXp0
... = p.degree : congr_arg _ (div_X_mul_X_add _)

/-- An induction principle for polynomials, valued in Sort* instead of Prop. -/
@[elab_as_eliminator] noncomputable def rec_on_horner
  {M : R[X] → Sort*} : Π (p : R[X]),
  M 0 →
  (Π p a, coeff p 0 = 0 → a ≠ 0 → M p → M (p + C a)) →
  (Π p, p ≠ 0 → M p → M (p * X)) →
  M p
| p := λ M0 MC MX,
if hp : p = 0 then eq.rec_on hp.symm M0
else
have wf : degree (div_X p) < degree p,
  from degree_div_X_lt hp,
by rw [← div_X_mul_X_add p] at *;
  exact
  if hcp0 : coeff p 0 = 0
  then by rw [hcp0, C_0, add_zero];
    exact MX _ (λ h : div_X p = 0, by simpa [h, hcp0] using hp)
      (rec_on_horner _ M0 MC MX)
  else MC _ _ (coeff_mul_X_zero _) hcp0 (if hpX0 : div_X p = 0
    then show M (div_X p * X), by rw [hpX0, zero_mul]; exact M0
    else MX (div_X p) hpX0 (rec_on_horner _ M0 MC MX))
using_well_founded {dec_tac := tactic.assumption}

/--  A property holds for all polynomials of positive `degree` with coefficients in a semiring `R`
if it holds for
* `a * X`, with `a ∈ R`,
* `p * X`, with `p ∈ R[X]`,
* `p + a`, with `a ∈ R`, `p ∈ R[X]`,
with appropriate restrictions on each term.

See `nat_degree_ne_zero_induction_on` for a similar statement involving no explicit multiplication.
 -/
@[elab_as_eliminator] lemma degree_pos_induction_on
  {P : R[X] → Prop} (p : R[X]) (h0 : 0 < degree p)
  (hC : ∀ {a}, a ≠ 0 → P (C a * X))
  (hX : ∀ {p}, 0 < degree p → P p → P (p * X))
  (hadd : ∀ {p} {a}, 0 < degree p → P p → P (p + C a)) : P p :=
rec_on_horner p
  (λ h, by rw degree_zero at h; exact absurd h dec_trivial)
  (λ p a _ _ ih h0,
    have 0 < degree p,
      from lt_of_not_ge (λ h, (not_lt_of_ge degree_C_le) $
        by rwa [eq_C_of_degree_le_zero h, ← C_add] at h0),
    hadd this (ih this))
  (λ p _ ih h0',
    if h0 : 0 < degree p
    then hX h0 (ih h0)
    else by rw [eq_C_of_degree_le_zero (le_of_not_gt h0)] at *;
      exact hC (λ h : coeff p 0 = 0,
        by simpa [h, nat.not_lt_zero] using h0'))
  h0

/--  A property holds for all polynomials of non-zero `nat_degree` with coefficients in a
semiring `R` if it holds for
* `p + a`, with `a ∈ R`, `p ∈ R[X]`,
* `p + q`, with `p, q ∈ R[X]`,
* monomials with nonzero coefficient and non-zero exponent,
with appropriate restrictions on each term.
Note that multiplication is "hidden" in the assumption on monomials, so there is no explicit
multiplication in the statement.
See `degree_pos_induction_on` for a similar statement involving more explicit multiplications.
 -/
@[elab_as_eliminator] lemma nat_degree_ne_zero_induction_on {M : R[X] → Prop}
  {f : R[X]} (f0 : f.nat_degree ≠ 0) (h_C_add : ∀ {a p}, M p → M (C a + p))
  (h_add : ∀ {p q}, M p → M q → M (p + q))
  (h_monomial : ∀ {n : ℕ} {a : R}, a ≠ 0 → n ≠ 0 → M (monomial n a)) :
  M f :=
suffices f.nat_degree = 0 ∨ M f, from or.dcases_on this (λ h, (f0 h).elim) id,
begin
  apply f.induction_on,
  { exact λ a, or.inl (nat_degree_C _) },
  { rintros p q (hp | hp) (hq | hq),
    { refine or.inl _,
      rw [eq_C_of_nat_degree_eq_zero hp, eq_C_of_nat_degree_eq_zero hq, ← C_add, nat_degree_C] },
    { refine or.inr _,
      rw [eq_C_of_nat_degree_eq_zero hp],
      exact h_C_add hq },
    { refine or.inr _,
      rw [eq_C_of_nat_degree_eq_zero hq, add_comm],
      exact h_C_add hp },
    { exact or.inr (h_add hp hq) } },
  { intros n a hi,
    by_cases a0 : a = 0,
    { exact or.inl (by rw [a0, C_0, zero_mul, nat_degree_zero]) },
    { refine or.inr _,
      rw C_mul_X_pow_eq_monomial,
      exact h_monomial a0 n.succ_ne_zero } }
end

end semiring

end polynomial


import tutorial_world.level08_use --hide
open IncidencePlane --hide
/- Tactic : have

## Summary
`have h : P,` will create a new goal of creating a term of type `P`, and will add `h : P` to the hypotheses for the goal you were working on.

## Details
If you want to name a term of some type (because you want it in your local context for some reason), and if you have the formula for the term, you can use have to give the term a name.

## Example (have q := ... or have q : Q := ...)
If the local context contains

```
f : P → Q
p : P
```
then the tactic `have q := f(p),` will add `q` to our local context, leaving it like this:

```
f : P → Q
p : P
q : Q
```

If you think about it, you don't ever really need `q`, because whenever you think you need it you coudl just use `f(p)` instead. But it's good that we can introduce convenient notation like this.

## Example (have q : Q,)
A variant of this tactic can be used where you just declare the type of the term you want to have, finish the tactic statement with a comma and no :=, and then Lean just adds it as a new goal. The number of goals goes up by one if you use `have` like this.

For example if the local context is

```
P Q R : Prop/Type,
f : P → Q,
g : Q → R,
p : P
⊢ R
```
then after `have q : Q,`, there will be the new goal

```
f : P → Q,
g : Q → R,
p : P,
⊢ Q
```
and your original goal will have `q : Q` added to the list of hypotheses.
-/

/-
# Tutorial World

## Level 9: the `have` tactic (boss level).

Congratulations! You are half of the way to finish this world! In this level, we introduce the new tactic `have`. It is used to add a new hypothesis
to the context (which, of course, you will have to prove!). This is sometimes useful to structure our proofs. In this particular level, it is convenient
to prove first that `r = line_through B C`, and then that `s = line_through B C`. This strategy will allow us to finish the prove very easily!

To use the tactic `have`, we should follow the following structure: `have h : A = B,`. This line will add the hypothesis `h : A = B` to the local
context and break the proof into two goals. First, Lean will ask us to prove `⊢ A = B` without the hypothesis `h : A = B`. Then, it will ask us to
prove the goal that existed before with the support of the new hypothesis `h : A = B` that we have added to the local context.

**Pro tip:** Because you're getting better at this, proofs are going to be more challenging as time goes by. Whenever you see that you have to prove two
or more goals to finsih one level, you may want to use **curly braces**; that is to say, the **{** - **}** symbols. Inside each of them, you just have to
prove one goal. Then, whenever you want to prove the following one, just open curly braces again. **Don't forget to close them with a comma at the end!**

For example, the first line of this proof will be `have hr : r = line_through B C,` (you can change `hr` into whatever name you are comfortable with to
make reference to the hypothesis `r = line_through B C`). Now, because two goals have appeared, you can type the following structure:

{

(delete this parenthesis and hit the space bar twice)sorry,

},

{

(delete this parenthesis and hit the space bar twice)sorry,

},

In this way, by deleting the `sorry`'s, you will be able to prove the goals separately. Now, let's try solve this level together so that you can
easily understand how the syntax of Lean works!

First, we are going to prove the first goal, which is `⊢ r = line_through B C,`. To begin with, let's look at the "theorem statements" we have.
Can you note that `incidence` finishes with the same structure as our goal? Then, we have to check if we have the previous implications of `incidence`
in our local context. On the face of it, `h : B ≠ C` and `h1 : B ∈ r ∧ C ∈ r` are what we are looking for. However, `h1` should be divided into `B ∈ r`
and `C ∈ r`, right? [**Rule of thumb:** whenever a hypothesis looks like `h1 : P ∧ Q`, we can refer to `P` and `Q` as `h1.1` and `h1.2`, respectively.]
Then, notice how `exact incidence h h1.1 h1.2,` closes the first goal!

Before jumping onto the second goal, we may want to rewrite something first. Can you see that we can `rw hr,` (where `hr : r = line_through B C`) to change
the goal `⊢ r = s` into `⊢ line_through B C = s`. Now, you will be wondering if `exact incidence h h2.1 h2.2,` finishes the proof, but it does not. Do you
know why? Because the theorem statement called `incidence` works with the goal `⊢ s = line_through B C`, but not with `⊢ line_through B C = s`. Because of
this reason, we should create another hypothesis by using the `have` tactic. That is to say, type `have hs : s = line_through B C,` right before the curly braces.

Now, two final goals are waiting to be proved! I'm sure that you are able to complete the level by your own! Make an effort to apply the knowledge that
we have acquired so far! In case you get stuck, click right below for a hint.

-/

/- Hint : Click here for a hint, in case you get stuck.
Do you see that `exact incidence h h2.1 h2.2,` closes the above goal? It is similar to the case that we have proved earlier.
Now, try to finish the proof by rewriting one of the hypotheses. Still bewildered? Click on "View source" (located on the
top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma : no-side-bar
If two lines share two distinct points, then they are the same line.
-/
lemma equal_lines_example (B C : Ω) (h : B ≠ C) (r s : Line Ω)
(h1 :  B ∈ r ∧ C ∈ r)
(h2 : B ∈ s ∧ C ∈ s)
: r = s :=
begin
  have hr : r = line_through B C,
  {
    exact incidence h h1.1 h1.2,
  },
  rw hr,
  have hs : s = line_through B C,
  {
    exact incidence h h2.1 h2.2,
  },
  rw hs,
end


import tactic
/-

# Quotients

The quotient of a type by an equivalence relation.

## Overview

A binary relation on a type `X` is just a function `r : X → X → Prop`,
that is, a true-false statement attached to each pair of elements of `X`.

If `r` is also reflexive, symmetric and transitive, we say it is an
equivalence relation. We will use the standard notation `x ≈ y`
for `r x y` below.

Given a type `X` and an equivalence relation `≈` on it, the type `clX` of
equivalence classes for `≈` comes equipped with a canonical function
`X → clX` (sending an element to its equivalence class), and it also satisfies
a universal property, namely that to give a map from `clX` to a type `T`
is to give a map `X → T` which is constant on equivalence classes.

Note however that other types other than the type of equivalence classes
may also satisfy this universal property. For example if we start with
a type `X` and a surjection `p : X → Y` and then define an equivalence
relation on `X` by `x₁ ≈ x₂ ↔ p x₁ = p x₂` then `Y` satisfies the same
universal property. In general it is a fact in mathematics that things
which define universal properties are unique up to unique isomorphism,
and things like the type of equivalence classes are just a *model* for
this general concept of quotient.

Lean does not use the equivalence class model when doing quotients.
Here's how it does it. The type `setoid X` is defined to be the type
of equivalence relations on `X`. If `s : setoid X` is an equivalence relation
then Lean defines `quotient s` to be a new type which satisfies the
universal property of quotients. Let us spell out what this means.
Firstly, it means that there is a map `p : X → quotient s`, and
secondly it means that to give a map `f : quotient s → T` is to
give `f ∘ p : X → T`, a map which is constant on equivalence classes.

In this file we will learn the various useful functions which Lean has
for dealing with quotients -- that is, the key definitions and theorems
which mathematicians use, sometimes subconsciously, when dealing with
quotients. We will learn them by explicitly working through an
example, namely the case where `X = ℕ²` and `(a,b) ≈ (c,d) ↔ a + d = c + b`.
In this case, the quotient is a model for the integers.

## More on universal properties.

Recall that if `X` and `T` are types, then `X → T` denotes the *type*
of functions from `X` to `T`. A mathematician might call this
type `Hom(X,T)`. A term `f : X → T` of this type is just a function
from `X` to `T`.

Let us now spell out the universal property more carefully.
Given a type `X` and an equivalence relation `≈` on `X`, we say
that a function `f : X → T` is *constant on equivalence classes*,
(or `≈`-equivariant for short), if `∀ x y : X, x ≈ y → f x = f y`.

We say that a pair `(Q, p)` consisting of a type `Q` and a
function `p : X → Q` are a *quotient* of `X` by `≈`
if `p` is constant on equivalence classes, and furthermore `p`
is *initial* with repect to this property. What does this mean?
Let me spell this out.

Let `(Q, p)` be a quotient of `X` by `≈`. Note first that if `T` is any
type and `g : Q → T` is any function, then `f := g ∘ p : X → T` is
constant on equivalence classes (because `p` is). Being *initial* is the claim
that this construction, starting with a function `g : Q → T` and
giving us a function `f : X → T` which is `≈`-equivariant,
is a *bijection* between `Q → T` and the subset of `X → T`
consisting of `≈`-equivariant functions. In diagrams, if `f` is
constant on equivalence classes, then there's a unique `g` which
fills in the diagram.

          f
    X ---------> T
    |          /\
    |        /
    | p    / ∃!g
    |    /
    |  /
    \/
    Q

One can easily check that the type of equivalence classes for `≈` satisfies
this universal property, with `p` being the map sending a term of type `X`
to its equivalence class. One can think of the type of equivalence classes
as a "model" for the quotient, in the same way that you might have seen
a model for the tensor product `V ⊗ W` of two vector spaces given
as a quotient of the vector space generated by pairs `(v,w)` by the subspace
generated by an appropriate collection of relations, or a model for
the localisation `R[1/S]` of a commutative ring at a multiplicative
subset given by `R × S` modulo a certain equivalence relation. Models
are useful. A model of an `n`-dimensional real vector space is obtained
by choosing a basis; then it can be identified with `ℝⁿ` enabling explicit
computations to be done.

But there are many other models for quotients. For example let's
say `X` and `Q` are any types, and `f : X → Q` is any surjection at all.
Define `≈` on `X` by `x ≈ y ↔ f x = f y`. It is easy to check that `Q` is a
quotient of `X` by `≈` simply because `Q` naturally bijects with the
equivalence classes of `≈`.

Lean does not use equivalence classes in its definition of the quotient
of `X` by `≈`. It chooses a different model. It is an opaque model, meaning
that you cannot actually see what the terms are.
But Lean and mathlib give you a very solid API for the quotient.
In particular, the quotient satisfies the universal property, so one
can prove that it bijects with the type of equivalence classes on `X`.
However, after a while one moves away from the "equivalence class"
way of thinking, and starts thinking more abstractly about quotients,
and so ultimately one does not really need this bijection at all.

You might wonder why Lean does not use the type of equivalence classes.
The reason is not a mathematical one -- it is simply to do with an
implementation issue which I will mention later.

Here is a guided tour of the API for Lean's quotients, worked out for
a specific example -- the integers, as a quotient of ℕ² by the
equivalence relation `(a,b) ≈ (c,d) ↔ a + d = c + b.`

-/

-- N2 is much easier to type than `ℕ × ℕ`
abbreviation N2 := ℕ × ℕ

namespace N2 -- all the functions below will be N2.something

-- Hmm, I guess I should run you through the API for products `×`.

/-

### products

The product of two types `X` and `Y` is `prod X Y`, with notation `X × Y`.
Hover over `×` to find out how to type it.

-/
section product

-- to make a term of a product, use round brackets.
def foo : N2 := (3,4)

-- To extract the first term of a product, use `.1` or `.fst`

example : foo.1 = 3 :=
begin
  -- true by definition.
  refl
end

example : foo.fst = 3 :=
begin
  refl
end

-- similarly use `.2` or `.snd` to get the second term

example : foo.snd = 4 := rfl -- term mode reflexivity of equality

-- The extensionality tactic works for products: a product is determined
-- by the two parts used to make it.
example (X Y : Type) (s t : X × Y) (h1 : s.fst = t.fst) (h2 : s.snd = t.snd) :
  s = t :=
begin
  ext,
  { exact h1 },
  { exact h2 }
end

-- you can uses `cases x` on a product if you want to take it apart into
-- its two pieces
example (A B : Type) (x : A × B) : x = (x.1, x.2) :=
begin
  -- note that this is not yet `refl` -- you have to take `x` apart.
  cases x with a b,
  -- ⊢ (a, b) = ((a, b).fst, (a, b).snd)
  dsimp only, -- to tidy up: this replaces `(a, b).fst` with `a`.
  -- ⊢ (a, b) = (a, b)
  refl,
end

end product

/-

## Worked example: ℤ as a quotient of ℕ²

There's a surjection `ℕ × ℕ → ℤ` sending `(a,b)` to `a - b` (where here
`a` and `b` are regarded as integers). One checks easily that `(a,b)`
and `(c,d)` are sent to the same integer if and only if `a + d = b + c`.
Conversely one could just define an equivalence relation on ℕ × ℕ
by `ab ≈ cd ↔ ab.1 + cd.2 = cd.1 + ab.2` and then redefine ℤ -- or more
precisely define a second ℤ -- to be the quotient
by this equivalence relation. Let's set up this equivalence relation
and call the quotient `Z`. Recall we're using `N2` to mean `ℕ × ℕ`.

-/

def r (ab cd : N2) : Prop :=
ab.1 + cd.2 = cd.1 + ab.2

-- This is a definition so let's make a little API for it.
-- It's nice to be able to `rw` to get rid of explicit occurrences of `r`.
-- So let's make two lemmas suitable for rewriting.

lemma r_def (ab cd : N2) : r ab cd ↔ ab.1 + cd.2 = cd.1 + ab.2 :=
begin
  refl
end

-- This one is more useful if you've already done `cases` on the pairs.
lemma r_def' (a b c d : ℕ) : r (a,b) (c,d) ↔ a + d = c + b :=
begin
  refl
end

def r_refl : reflexive r :=
begin
  -- you can start with `unfold reflexive` if you want to see what
  -- you're supposed to be proving here.
  sorry,
end

-- hint: `linarith` is good at linear arithmetic.
def r_symm : symmetric r :=
begin
  sorry
end

def r_trans : transitive r :=
begin
  sorry
end

-- now let's give N2 a setoid structure coming from `r`.
-- In other words, we tell the type class inference system
-- about `r`. Let's call it `setoid` and remember
-- we're in the `N2` namespace, so its full name
-- is N2.setoid
instance setoid : setoid N2 := ⟨r, r_refl, r_symm, r_trans⟩

-- Now we can use `≈` notation

example (x y : N2) : x ≈ y ↔ r x y :=
begin
  -- true by definition
  refl
end

-- `r x y` and `x ≈ y` are definitionally equal but not syntactically equal,
-- rather annoyingly, so we need two more lemmas enabling us to rewrite.
-- Let's teach them to `simp`, because they're the ones we'll be using
-- in practice.

@[simp] lemma equiv_def (ab cd : N2) : ab ≈ cd ↔ ab.1 + cd.2 = cd.1 + ab.2 :=
begin
  refl
end

@[simp] lemma equiv_def' (a b c d : ℕ) : (a,b) ≈ (c,d) ↔ a + d = c + b :=
iff.rfl -- term mode variant

end N2

open N2

-- Now we can take the quotient!
def Z := quotient N2.setoid

namespace Z

-- And now we can finally start.

-- The map from N2 to Z is called `quotient.mk`
-- Recall `foo` is `(3,4)`

def bar : Z := quotient.mk foo -- bar is the image of `foo` in the quotient.
-- so it's morally -1.

-- Notation for `quotient.mk x` is `⟦x⟧`
example : bar = ⟦foo⟧ :=
begin
  refl
end

/-

## Z

We have a new type `Z` now, and a way of going from `N2`
to `Z` (`quotient.mk`, with notation `⟦ ⟧`).

Here then are some things we can think about:

(1) How to prove the universal property for `Z`?
(2) How to put a ring structure on `Z`?
(3) How to define a map from `Z` to Lean's `ℤ`, which
is not defined as a quotient but also satisfies the
universal property?

We will do (1) and (2) in this file. Let's start with (1).
The claim is that to give
a map `Z → T` is to give a map `N2 → T`
which is constant on equivalence classes. The
construction: given a map `Z → T`, just
compose with `quotient.mk : N2 → Z`.
What do we need to prove here?

First we need to prove that `quotient.mk` is `≈`-equivariant.
In other words, we need to prove `x ≈ y → ⟦x⟧ = ⟦y⟧`.

-/

example (x y : N2) : x ≈ y → ⟦x⟧ = ⟦y⟧ :=
quotient.sound

-- Of course we know the other implication is also true.
-- This is called `quotient.exact`.

example (x y : N2) : ⟦x⟧ = ⟦y⟧ → x ≈ y :=
quotient.exact

-- The iff statement (useful for rewrites) is called `quotient.eq` :

example (x y : N2) : ⟦x⟧ = ⟦y⟧ ↔ x ≈ y :=
quotient.eq

-- So now we can define the map from `Z → T` to the subtype of `N2 → T`
-- consisting of `≈`-equivariant functions.

variable {T : Type}

/- Given a map `g : Z → T`, make a function `f : N2 → T` which is
   constant on equivalence classes. -/
def universal1 (g : Z → T) :
  {f : N2 → T // ∀ x y : N2, x ≈ y → f x = f y} :=
⟨λ n2, g ⟦n2⟧, begin
  sorry
end⟩

-- To go the other way, we use a new function called `quotient.lift`.
-- Note that this is a weird name for the construction, at least if your
-- mental picture has the quotient underneath the type with the relation.
-- But we're stuck with it.

/- Given a map `f : N2 → T` plus the assumption that it is constant on
   equivalence classes, "lift" this map to a map `Z → T`. -/
def universal2 (f : N2 → T) (hf : ∀ x y : N2, x ≈ y → f x = f y) :
  Z → T :=
quotient.lift f hf

-- So now the big question is: how do we prove that these two constructions
-- are inverse to each other? In other words, what is the API for
-- the definition `quotient.lift`?
-- Let's start by showing that going from `N2 → T` to `Z → T` (via `quotient.lift`)
-- and then back to `N2 → T` (via composing with `quotient.mk`) is the
-- identity function. Recall `⟦⟧` is the notation for `quotient.mk`.
-- Another way of writing the example below : universal2 ∘ universal1 = id.

example (f : N2 → T) (hf : ∀ x y : N2, x ≈ y → f x = f y) :
  f = λ n2, quotient.lift f hf ⟦n2⟧ :=
begin
  -- true by definition!
  refl
end

-- This is the reason quotients are defined as a black box; if we had
-- defined them to be equivalence classes this would be true, but
-- not by definition. To a mathematician this is not really a big deal,
-- but it is what it is.

-- To go the other way, proving universal1 ∘ universal2 = id, the key thing
-- to know is a function
-- called `quotient.induction_on`:

example (g : Z → T) : g = quotient.lift (λ n2, g ⟦n2⟧) (universal1 g).2 :=
begin
  -- two functions are equal if they agree on all inputs
  ext z,
  -- now use `quotient.induction_on` (this is the key move)
  apply quotient.induction_on z,
  -- and now we're in the situation of the above example again
  intro ab,
  -- so it's true by definition.
  refl,
end

-- We have hence proved that `universal1` and `universal2` are inverse
-- bijections, at least in this `N2 → Z` case. In `Part_C` we will do
-- this in general, but there is a ton of material this week so
-- don't worry if you don't get to it.

/-

## Giving Z a commutative ring structure

Let's now show how to give this quotient object `Z` a commutative ring
structure, which it somehow wants to inherit from structures on `ℕ`. Recall
that a ring is a choice of `0`, `1`, and functions `+`, `-` and `*`
satisfying some axioms. After a while this all becomes straightforward
and boring, so I will go through the proof that it's an abelian group
under addition carefully and then the multiplication part is just more
of the same -- feel free to skip it.

### zero and one

We start by giving `Z` a zero and a one.

-/

def zero : Z := ⟦(0, 0)⟧

def one : Z := ⟦(1, 0)⟧

-- We don't have the numeral notation yet though:

-- #check (0 : Z) -- error about failing to find an instance of `has_zero Z`

-- Let's use numeral notation `0` and `1` for `zero` and `one`.

instance : has_zero Z := ⟨zero⟩
instance : has_one Z := ⟨one⟩

-- let's start to train the simplifier
@[simp] lemma zero_def : (0 : Z) = ⟦(0, 0)⟧ := rfl -- works
@[simp] lemma one_def : (1 : Z) = ⟦(1, 0)⟧ := rfl

/-

### negation

Let's do negation next, by which I mean the function sending `z` to `-z`,
because this is a function which only takes one input (addition takes two).

Here is how a mathematician might describe defining negation on the
equivalence classes of `ℕ × ℕ`. They might say this:

1) choose an element `z` of the quotient `Z`.
2) lift it randomly to a pair `(a, b)` of natural numbers.
3) Define `-z` to be `⟦(b,a)⟧`
4) Now let us check that this definition did not depend on the random lift in (2):
   [and then they prove a lemma saying the construction is well-defined, i.e.
    that if `(a, b) ≈ (c,d)` then `⟦(b, a)⟧ = ⟦(d, c)⟧` ]

This is the way mathematicians are taught. We will use *the same
construction* in Lean but we will phrase it differently.

1') Define an auxiliary map `N2 → Z` by sending `(a,b)` to `⟦(b,a)⟧`
2') I claim that this function is constant on equivalence classes
    [and then we prove a lemma saying `(a, b) ≈ (c, d) → ⟦(b, a)⟧ = ⟦(d, c)⟧`
3') Now use `quotient.lift` to descend this to a map from `Z` to `Z`.

So as you can see, the mathematics is the same, but the emphasis is slightly
different.
-/

-- Here's the auxiliary map.
def neg_aux (ab : N2) : Z := ⟦(ab.2, ab.1)⟧

-- useful for rewriting. Let's teach it to `simp`.
@[simp] lemma neg_aux_def (ab : N2) : neg_aux ab = ⟦(ab.2, ab.1)⟧ := rfl
  -- true by def

-- In the process of making this definition we need to prove a theorem
-- saying neg_aux is constant on equivalence classes.
def neg : Z → Z := quotient.lift neg_aux
begin
  -- ⊢ ∀ (a b : N2), a ≈ b → neg_aux a = neg_aux b
  sorry,
end

-- `-z` notation
instance : has_neg Z := ⟨neg⟩

-- Let's teach the definition of `neg` to the simplifier.
@[simp] lemma neg_def (a b : ℕ) : (-⟦(a, b)⟧ : Z) = ⟦(b, a)⟧ := rfl
/-

## Addition

If we use `quotient.lift` for defining addition, we'd have to use it twice.
We define `⟦(a, b)⟧ + ⟦(c, d)⟧ = ⟦(a + c, b + d)⟧` and would then have
to check it was independent of the choice of lift `(a, b)` in one lemma,
and then in a second proof check it was independent of the choice of `(c, d)`.
The variant `quotient.lift₂` enables us to prove both results in one go.
It says that if `f : A → B → C` is a function which and `A` and `B`
have equivalence relations on them, and `f` is constant on equivalence
classes in both the `A` and the `B` variable, then `f` descends ("lifts")
to a function `A/~ → B/~ → C`.
-/

-- auxiliary definition of addition (note `(a-b)+(c-d)=(a+c)-(b+d)` )
def add_aux (ab cd : N2) : Z := ⟦(ab.1 + cd.1, ab.2 + cd.2)⟧

-- useful for rewriting
@[simp] lemma add_aux_def (ab cd : N2) :
  add_aux ab cd = ⟦(ab.1 + cd.1, ab.2 + cd.2)⟧ :=
rfl -- true by def

def add : Z → Z → Z := quotient.lift₂ add_aux
begin
  sorry,
end

-- notation for addition
instance : has_add Z := ⟨add⟩

-- train the simplifier, because we have some axioms to prove about `+`
@[simp] lemma add_def (a b c d : ℕ) :
  (⟦(a, b)⟧ + ⟦(c, d)⟧ : Z) = ⟦(a+c, b+d)⟧ :=
rfl

-- may as well get subtraction working
def sub (x y : Z) : Z := x + -y

instance : has_sub Z := ⟨sub⟩

/-

## Z is a commutative group under addition

-/

def add_comm_group : add_comm_group Z :=
{ zero := 0,
  add := (+),
  neg := has_neg.neg,
  sub := has_sub.sub,
  -- The key is always `quotient.induction_on`
  -- I'll do the first one for you.
  zero_add := begin
    intro x,
    apply quotient.induction_on x, clear x,
    rintro ⟨a, b⟩,
    simp,
  end,
  add_zero := begin
    sorry
  end,
  -- Here there are three variables so it's `quotient.induction_on₃`
  -- Remember the `ring` tactic will prove identities in `ℕ`.
  add_assoc := begin
    sorry
  end,
  add_left_neg := begin
    sorry
  end,
  add_comm := begin
    sorry
  end,
}

/-

## More of the same : Z is a commutative ring.

I would recommend skipping this and going onto Part B.
There are no more ideas here, this is just to prove that it can be done.

A mild variant: let's do multiplication in a slightly different way.
Instead of using `quotient.lift₂` (which descends a map `N2 → N2 → Z` to a
map `Z → Z → Z`) we'll use `quotient.map₂`, which descends a
map `N2 → N2 → N2` to a map `Z → Z → Z`.

-/

-- auxiliary definition of multiplication: `(a-b)*(c-d) = (a*c+b*d)-(a*d+b*c)`
def mul_aux (ab cd : N2) : N2 :=
  (ab.1 * cd.1 + ab.2 * cd.2, ab.1 * cd.2 + ab.2 * cd.1)

@[simp] lemma mul_aux_def (a b c d : ℕ) :
  mul_aux (a,b) (c,d) = (a*c+b*d,a*d+b*c) := rfl

-- The key result you have to prove here involves multiplication so is
-- unfortunately non-linear. However `nlinarith` is OK at non-linear arithmetic...
def mul : Z → Z → Z := quotient.map₂ mul_aux
begin
  sorry
end

-- notation for multiplication
instance : has_mul Z := ⟨mul⟩

@[simp] lemma mul_def (a b c d : ℕ) :
  (⟦(a, b)⟧ * ⟦(c, d)⟧ : Z) = ⟦(a*c+b*d, a*d+b*c)⟧ := rfl

-- now let's prove that Z is a commutative ring!

def comm_ring : comm_ring Z :=
{ one := 1,
  add := (+),
  mul := (*),
  mul_assoc := begin
    intros x y z,
    apply quotient.induction_on₃ x y z, clear x y z,
    rintros ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩,
    simp,
    ring,
  end,
  -- etc etc
  one_mul := begin
    sorry
  end,
  mul_one := begin
    sorry
  end,
  left_distrib := begin
    sorry
  end,
  right_distrib := begin
    sorry
  end,
  mul_comm := begin
    sorry
  end,
  ..add_comm_group
}

end Z


import data.real.basic

variables a b c d : ℝ

#check add_assoc
#check add_mul
#check mul_add

-- BEGIN

/- a tactic proof using rw -/
example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
begin
  rw [add_mul, mul_add, mul_add],
  rw ← add_assoc,
end

/- a calc proof-/
example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
calc
  (a + b) * (c + d)
      = a * c + a * d + (b * c + b * d) :
      by rw [add_mul, mul_add, mul_add]
  ... = a * c + a * d + b * c + b * d :
      by rw ← add_assoc
-- END


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/

import algebra.group_power.basic
import logic.function.iterate
import group_theory.perm.basic

/-!
# Iterates of monoid and ring homomorphisms

Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean
can't apply lemmas like `monoid_hom.map_one` to `f^[n] 1`. Though it is possible to define
a monoid structure on the endomorphisms, quite often we do not want to convert from
`M →* M` to `monoid.End M` and from `f^[n]` to `f^n` just to apply a simple lemma.

So, we restate standard `*_hom.map_*` lemmas under names `*_hom.iterate_map_*`.

We also prove formulas for iterates of add/mul left/right.

## Tags

homomorphism, iterate
-/

open function

variables {M : Type*} {N : Type*} {G : Type*} {H : Type*}

/-- An auxiliary lemma that can be used to prove `⇑(f ^ n) = (⇑f^[n])`. -/
lemma hom_coe_pow {F : Type*} [monoid F] (c : F → M → M) (h1 : c 1 = id)
  (hmul : ∀ f g, c (f * g) = c f ∘ c g) (f : F) : ∀ n, c (f ^ n) = (c f^[n])
| 0 := by { rw [pow_zero, h1], refl }
| (n + 1) := by rw [pow_succ, iterate_succ', hmul, hom_coe_pow]

namespace monoid_hom

section

variables [mul_one_class M] [mul_one_class N]

@[simp, to_additive]
theorem iterate_map_one (f : M →* M) (n : ℕ) : f^[n] 1 = 1 :=
iterate_fixed f.map_one n

@[simp, to_additive]
theorem iterate_map_mul (f : M →* M) (n : ℕ) (x y) :
  f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
semiconj₂.iterate f.map_mul n x y

end

variables [monoid M] [monoid N] [group G] [group H]

@[simp, to_additive]
theorem iterate_map_inv (f : G →* G) (n : ℕ) (x) :
  f^[n] (x⁻¹) = (f^[n] x)⁻¹ :=
commute.iterate_left f.map_inv n x

@[simp, to_additive]
theorem iterate_map_div (f : G →* G) (n : ℕ) (x y) :
  f^[n] (x / y) = (f^[n] x) / (f^[n] y) :=
semiconj₂.iterate f.map_div n x y

theorem iterate_map_pow (f : M →* M) (n : ℕ) (a) (m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_pow x m) n a

theorem iterate_map_zpow (f : G →* G) (n : ℕ) (a) (m : ℤ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_zpow x m) n a

lemma coe_pow {M} [comm_monoid M] (f : monoid.End M) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

end monoid_hom

lemma monoid.End.coe_pow {M} [monoid M] (f : monoid.End M) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

-- we define these manually so that we can pick a better argument order
namespace add_monoid_hom
variables [add_monoid M] [add_group G]

theorem iterate_map_smul (f : M →+ M) (n m : ℕ) (x : M) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_pow n x m

attribute [to_additive iterate_map_smul, to_additive_reorder 5] monoid_hom.iterate_map_pow

theorem iterate_map_zsmul (f : G →+ G) (n : ℕ) (m : ℤ) (x : G) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_zpow n x m

attribute [to_additive, to_additive_reorder 5] monoid_hom.iterate_map_zpow

end add_monoid_hom

lemma add_monoid.End.coe_pow {A} [add_monoid A] (f : add_monoid.End A) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

namespace ring_hom

section semiring

variables {R : Type*} [semiring R] (f : R →+* R) (n : ℕ) (x y : R)

lemma coe_pow (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) f n

theorem iterate_map_one : f^[n] 1 = 1 := f.to_monoid_hom.iterate_map_one n

theorem iterate_map_zero : f^[n] 0 = 0 := f.to_add_monoid_hom.iterate_map_zero n

theorem iterate_map_add : f^[n] (x + y) = (f^[n] x) + (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_add n x y

theorem iterate_map_mul : f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
f.to_monoid_hom.iterate_map_mul n x y

theorem iterate_map_pow (a) (n m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
f.to_monoid_hom.iterate_map_pow n a m

theorem iterate_map_smul (n m : ℕ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_smul n m x

end semiring

variables {R : Type*} [ring R] (f : R →+* R) (n : ℕ) (x y : R)

theorem iterate_map_sub : f^[n] (x - y) = (f^[n] x) - (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_sub n x y

theorem iterate_map_neg : f^[n] (-x) = -(f^[n] x) :=
f.to_add_monoid_hom.iterate_map_neg n x

theorem iterate_map_zsmul (n : ℕ) (m : ℤ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_zsmul n m x

end ring_hom

lemma equiv.perm.coe_pow {α : Type*} (f : equiv.perm α) (n : ℕ) : ⇑(f ^ n) = (f^[n]) :=
hom_coe_pow _ rfl (λ _ _, rfl) _ _

--what should be the namespace for this section?
section monoid

variables [monoid G] (a : G) (n : ℕ)

@[simp, to_additive] lemma mul_left_iterate : ((*) a)^[n] = (*) (a^n) :=
nat.rec_on n (funext $ λ x, by simp) $ λ n ihn,
funext $ λ x, by simp [iterate_succ, ihn, pow_succ', mul_assoc]

@[simp, to_additive] lemma mul_right_iterate : (* a)^[n] = (* a ^ n) :=
begin
  induction n with d hd,
  { simpa },
  { simp [← pow_succ, hd] }
end

@[to_additive]
lemma mul_right_iterate_apply_one : (* a)^[n] 1 = a ^ n :=
by simp [mul_right_iterate]

end monoid

section semigroup

variables [semigroup G] {a b c : G}

@[to_additive]
lemma semiconj_by.function_semiconj_mul_left (h : semiconj_by a b c) :
  function.semiconj ((*)a) ((*)b) ((*)c) :=
λ j, by rw [← mul_assoc, h.eq, mul_assoc]

@[to_additive]
lemma commute.function_commute_mul_left (h : commute a b) :
  function.commute ((*)a) ((*)b) :=
semiconj_by.function_semiconj_mul_left h

@[to_additive]
lemma semiconj_by.function_semiconj_mul_right_swap (h : semiconj_by a b c) :
  function.semiconj (*a) (*c) (*b) :=
λ j, by simp_rw [mul_assoc, ← h.eq]

@[to_additive]
lemma commute.function_commute_mul_right (h : commute a b) :
  function.commute (*a) (*b) :=
semiconj_by.function_semiconj_mul_right_swap h

end semigroup


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import data.zmod.quotient
import group_theory.noncomm_pi_coprod
import group_theory.order_of_element
import algebra.gcd_monoid.finset
import data.nat.factorization.basic
import tactic.by_contra

/-!
# Exponent of a group

This file defines the exponent of a group, or more generally a monoid. For a group `G` it is defined
to be the minimal `n≥1` such that `g ^ n = 1` for all `g ∈ G`. For a finite group `G`,
it is equal to the lowest common multiple of the order of all elements of the group `G`.

## Main definitions

* `monoid.exponent_exists` is a predicate on a monoid `G` saying that there is some positive `n`
  such that `g ^ n = 1` for all `g ∈ G`.
* `monoid.exponent` defines the exponent of a monoid `G` as the minimal positive `n` such that
  `g ^ n = 1` for all `g ∈ G`, by convention it is `0` if no such `n` exists.
* `add_monoid.exponent_exists` the additive version of `monoid.exponent_exists`.
* `add_monoid.exponent` the additive version of `monoid.exponent`.

## Main results

* `monoid.lcm_order_eq_exponent`: For a finite left cancel monoid `G`, the exponent is equal to the
  `finset.lcm` of the order of its elements.
* `monoid.exponent_eq_supr_order_of(')`: For a commutative cancel monoid, the exponent is
  equal to `⨆ g : G, order_of g` (or zero if it has any order-zero elements).

## TODO
* Refactor the characteristic of a ring to be the exponent of its underlying additive group.
-/

universe u

variable {G : Type u}

open_locale classical

namespace monoid

section monoid

variables (G) [monoid G]

/--A predicate on a monoid saying that there is a positive integer `n` such that `g ^ n = 1`
  for all `g`.-/
@[to_additive "A predicate on an additive monoid saying that there is a positive integer `n` such
  that `n • g = 0` for all `g`."]
def exponent_exists  := ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1

/--The exponent of a group is the smallest positive integer `n` such that `g ^ n = 1` for all
  `g ∈ G` if it exists, otherwise it is zero by convention.-/
@[to_additive "The exponent of an additive group is the smallest positive integer `n` such that
  `n • g = 0` for all `g ∈ G` if it exists, otherwise it is zero by convention."]
noncomputable def exponent :=
if h : exponent_exists G then nat.find h else 0

variable {G}

@[to_additive]
lemma exponent_exists_iff_ne_zero : exponent_exists G ↔ exponent G ≠ 0 :=
begin
  rw [exponent],
  split_ifs,
  { simp [h, @not_lt_zero' ℕ] }, --if this isn't done this way, `to_additive` freaks
  { tauto },
end

@[to_additive]
lemma exponent_eq_zero_iff : exponent G = 0 ↔ ¬ exponent_exists G :=
by simp only [exponent_exists_iff_ne_zero, not_not]

@[to_additive]
lemma exponent_eq_zero_of_order_zero {g : G} (hg : order_of g = 0) : exponent G = 0 :=
exponent_eq_zero_iff.mpr $ λ ⟨n, hn, hgn⟩, order_of_eq_zero_iff'.mp hg n hn $ hgn g

@[to_additive exponent_nsmul_eq_zero]
lemma pow_exponent_eq_one (g : G) : g ^ exponent G = 1 :=
begin
  by_cases exponent_exists G,
  { simp_rw [exponent, dif_pos h],
    exact (nat.find_spec h).2 g },
  { simp_rw [exponent, dif_neg h, pow_zero] }
end

@[to_additive]
lemma pow_eq_mod_exponent {n : ℕ} (g : G): g ^ n = g ^ (n % exponent G) :=
calc g ^ n = g ^ (n % exponent G + exponent G * (n / exponent G)) : by rw [nat.mod_add_div]
  ... = g ^ (n % exponent G) : by simp [pow_add, pow_mul, pow_exponent_eq_one]

@[to_additive]
lemma exponent_pos_of_exists (n : ℕ) (hpos : 0 < n) (hG : ∀ g : G, g ^ n = 1) :
  0 < exponent G :=
begin
  have h : ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1 := ⟨n, hpos, hG⟩,
  rw [exponent, dif_pos],
  exact (nat.find_spec h).1,
end

@[to_additive]

@[to_additive]
lemma exponent_min (m : ℕ) (hpos : 0 < m) (hm : m < exponent G) : ∃ g : G, g ^ m ≠ 1 :=
begin
  by_contra' h,
  have hcon : exponent G ≤ m := exponent_min' m hpos h,
  linarith,
end

@[simp, to_additive]
lemma exp_eq_one_of_subsingleton [subsingleton G] : exponent G = 1 :=
begin
  apply le_antisymm,
  { apply exponent_min' _ nat.one_pos,
    simp },
  { apply nat.succ_le_of_lt,
    apply exponent_pos_of_exists 1 (nat.one_pos),
    simp },
end

@[to_additive add_order_dvd_exponent]
lemma order_dvd_exponent (g : G) : (order_of g) ∣ exponent G :=
order_of_dvd_of_pow_eq_one $ pow_exponent_eq_one g

variable (G)

@[to_additive]
lemma exponent_dvd_of_forall_pow_eq_one (G) [monoid G] (n : ℕ) (hG : ∀ g : G, g ^ n = 1) :
  exponent G ∣ n :=
begin
  rcases n.eq_zero_or_pos with rfl | hpos,
  { exact dvd_zero _ },
  apply nat.dvd_of_mod_eq_zero,
  by_contradiction h,
  have h₁ := nat.pos_of_ne_zero h,
  have h₂ : n % exponent G < exponent G := nat.mod_lt _ (exponent_pos_of_exists n hpos hG),
  have h₃ : exponent G ≤ n % exponent G,
  { apply exponent_min' _ h₁,
    simp_rw ←pow_eq_mod_exponent,
    exact hG },
  linarith,
end

@[to_additive lcm_add_order_of_dvd_exponent]
lemma lcm_order_of_dvd_exponent [fintype G] : (finset.univ : finset G).lcm order_of ∣ exponent G :=
begin
  apply finset.lcm_dvd,
  intros g hg,
  exact order_dvd_exponent g
end

@[to_additive exists_order_of_eq_pow_padic_val_nat_add_exponent]
lemma _root_.nat.prime.exists_order_of_eq_pow_factorization_exponent {p : ℕ} (hp : p.prime) :
  ∃ g : G, order_of g = p ^ (exponent G).factorization p :=
begin
  haveI := fact.mk hp,
  rcases eq_or_ne ((exponent G).factorization p) 0 with h | h,
  { refine ⟨1, by rw [h, pow_zero, order_of_one]⟩ },
  have he : 0 < exponent G := ne.bot_lt (λ ht,
    by {rw ht at h, apply h, rw [bot_eq_zero, nat.factorization_zero, finsupp.zero_apply] }),
  rw ← finsupp.mem_support_iff at h,
  obtain ⟨g, hg⟩ : ∃ (g : G), g ^ (exponent G / p) ≠ 1,
  { suffices key : ¬ exponent G ∣ exponent G / p,
    { simpa using mt (exponent_dvd_of_forall_pow_eq_one G (exponent G / p)) key },
    exact λ hd, hp.one_lt.not_le ((mul_le_iff_le_one_left he).mp $
                nat.le_of_dvd he $ nat.mul_dvd_of_dvd_div (nat.dvd_of_mem_factorization h) hd) },
  obtain ⟨k, hk : exponent G = p ^ _ * k⟩ := nat.ord_proj_dvd _ _,
  obtain ⟨t, ht⟩ := nat.exists_eq_succ_of_ne_zero (finsupp.mem_support_iff.mp h),
  refine ⟨g ^ k, _⟩,
  rw ht,
  apply order_of_eq_prime_pow,
  { rwa [hk, mul_comm, ht, pow_succ', ←mul_assoc, nat.mul_div_cancel _ hp.pos, pow_mul] at hg },
  { rw [←nat.succ_eq_add_one, ←ht, ←pow_mul, mul_comm, ←hk],
    exact pow_exponent_eq_one g },
end

variable {G}

@[to_additive] lemma exponent_ne_zero_iff_range_order_of_finite (h : ∀ g : G, 0 < order_of g) :
  exponent G ≠ 0 ↔ (set.range (order_of : G → ℕ)).finite :=
begin
  refine ⟨λ he, _, λ he, _⟩,
  { by_contra h,
    obtain ⟨m, ⟨t, rfl⟩, het⟩ := set.infinite.exists_nat_lt h (exponent G),
    exact pow_ne_one_of_lt_order_of' he het (pow_exponent_eq_one t) },
  { lift (set.range order_of) to finset ℕ using he with t ht,
    have htpos : 0 < t.prod id,
    { refine finset.prod_pos (λ a ha, _),
      rw [←finset.mem_coe, ht] at ha,
      obtain ⟨k, rfl⟩ := ha,
      exact h k },
    suffices : exponent G ∣ t.prod id,
    { intro h,
      rw [h, zero_dvd_iff] at this,
      exact htpos.ne' this },
    refine exponent_dvd_of_forall_pow_eq_one _ _ (λ g, _),
    rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd, pow_zero g],
    apply finset.dvd_prod_of_mem,
    rw [←finset.mem_coe, ht],
    exact set.mem_range_self g },
end

@[to_additive] lemma exponent_eq_zero_iff_range_order_of_infinite (h : ∀ g : G, 0 < order_of g) :
  exponent G = 0 ↔ (set.range (order_of : G → ℕ)).infinite :=
have _ := exponent_ne_zero_iff_range_order_of_finite h,
by rwa [ne.def, not_iff_comm, iff.comm] at this

@[to_additive lcm_add_order_eq_exponent]
lemma lcm_order_eq_exponent [fintype G] : (finset.univ : finset G).lcm order_of = exponent G :=
begin
  apply nat.dvd_antisymm (lcm_order_of_dvd_exponent G),
  refine exponent_dvd_of_forall_pow_eq_one G _ (λ g, _),
  obtain ⟨m, hm⟩ : order_of g ∣ finset.univ.lcm order_of := finset.dvd_lcm (finset.mem_univ g),
  rw [hm, pow_mul, pow_order_of_eq_one, one_pow]
end

end monoid

section left_cancel_monoid

variable [left_cancel_monoid G]

@[to_additive]
lemma exponent_ne_zero_of_finite [finite G] : exponent G ≠ 0 :=
by { casesI nonempty_fintype G,
  simpa [←lcm_order_eq_exponent, finset.lcm_eq_zero_iff] using λ x, (order_of_pos x).ne' }

end left_cancel_monoid

section comm_monoid

variable [comm_monoid G]

@[to_additive] lemma exponent_eq_supr_order_of (h : ∀ g : G, 0 < order_of g) :
  exponent G = ⨆ g : G, order_of g :=
begin
  rw supr,
  rcases eq_or_ne (exponent G) 0 with he | he,
  { rw [he, set.infinite.nat.Sup_eq_zero $ (exponent_eq_zero_iff_range_order_of_infinite h).1 he] },
  have hne : (set.range (order_of : G → ℕ)).nonempty := ⟨1, 1, order_of_one⟩,
  have hfin : (set.range (order_of : G → ℕ)).finite,
  { rwa [← exponent_ne_zero_iff_range_order_of_finite h] },
  obtain ⟨t, ht⟩ := hne.cSup_mem hfin,
  apply nat.dvd_antisymm _,
  { rw ←ht,
    apply order_dvd_exponent },
  refine nat.dvd_of_factors_subperm he _,
  rw list.subperm_ext_iff,
  by_contra' h,
  obtain ⟨p, hp, hpe⟩ := h,
  replace hp := nat.prime_of_mem_factors hp,
  simp only [nat.factors_count_eq] at hpe,
  set k := (order_of t).factorization p with hk,
  obtain ⟨g, hg⟩ := hp.exists_order_of_eq_pow_factorization_exponent G,
  suffices : order_of t < order_of (t ^ (p ^ k) * g),
  { rw ht at this,
    exact this.not_le (le_cSup hfin.bdd_above $ set.mem_range_self _) },
  have hpk  : p ^ k ∣ order_of t := nat.ord_proj_dvd _ _,
  have hpk' : order_of (t ^ p ^ k) = order_of t / p ^ k,
  { rw [order_of_pow' t (pow_ne_zero k hp.ne_zero), nat.gcd_eq_right hpk] },
  obtain ⟨a, ha⟩ := nat.exists_eq_add_of_lt hpe,
  have hcoprime : (order_of (t ^ p ^ k)).coprime (order_of g),
  { rw [hg, nat.coprime_pow_right_iff (pos_of_gt hpe), nat.coprime_comm],
    apply or.resolve_right (nat.coprime_or_dvd_of_prime hp _),
    nth_rewrite 0 ←pow_one p,
    convert nat.pow_succ_factorization_not_dvd (h $ t ^ p ^ k).ne' hp,
    rw [hpk', nat.factorization_div hpk],
    simp [hp] },
  rw [(commute.all _ g).order_of_mul_eq_mul_order_of_of_coprime hcoprime, hpk', hg, ha, ←ht, ←hk,
      pow_add, pow_add, pow_one, ←mul_assoc, ←mul_assoc, nat.div_mul_cancel, mul_assoc,
      lt_mul_iff_one_lt_right $ h t, ←pow_succ'],
  exact one_lt_pow hp.one_lt a.succ_ne_zero,
  exact hpk
end

@[to_additive] lemma exponent_eq_supr_order_of' :
  exponent G = if ∃ g : G, order_of g = 0 then 0 else ⨆ g : G, order_of g :=
begin
  split_ifs,
  { obtain ⟨g, hg⟩ := h,
    exact exponent_eq_zero_of_order_zero hg },
  { have := not_exists.mp h,
    exact exponent_eq_supr_order_of (λ g, ne.bot_lt $ this g) }
end

end comm_monoid

section cancel_comm_monoid

variables [cancel_comm_monoid G]

@[to_additive] lemma exponent_eq_max'_order_of [fintype G] :
  exponent G = ((@finset.univ G _).image order_of).max' ⟨1, by simp⟩ :=
begin
  rw [←finset.nonempty.cSup_eq_max', finset.coe_image, finset.coe_univ, set.image_univ, ← supr],
  exact exponent_eq_supr_order_of order_of_pos
end

end cancel_comm_monoid

end monoid

section comm_group

open subgroup
open_locale big_operators

variables (G) [comm_group G] [group.fg G]

@[to_additive] lemma card_dvd_exponent_pow_rank : nat.card G ∣ monoid.exponent G ^ group.rank G :=
begin
  obtain ⟨S, hS1, hS2⟩ := group.rank_spec G,
  rw [←hS1, ←fintype.card_coe, ←finset.card_univ, ←finset.prod_const],
  let f : (Π g : S, zpowers (g : G)) →* G := noncomm_pi_coprod (λ s t h x y hx hy, mul_comm x y),
  have hf : function.surjective f,
  { rw [←monoid_hom.range_top_iff_surjective, eq_top_iff, ←hS2, closure_le],
    exact λ g hg, ⟨pi.mul_single ⟨g, hg⟩ ⟨g, mem_zpowers g⟩, noncomm_pi_coprod_mul_single _ _⟩ },
  replace hf := nat_card_dvd_of_surjective f hf,
  rw nat.card_pi at hf,
  refine hf.trans (finset.prod_dvd_prod_of_dvd _ _ (λ g hg, _)),
  rw ← order_eq_card_zpowers',
  exact monoid.order_dvd_exponent (g : G),
end

@[to_additive] lemma card_dvd_exponent_pow_rank' {n : ℕ} (hG : ∀ g : G, g ^ n = 1) :
  nat.card G ∣ n ^ group.rank G :=
(card_dvd_exponent_pow_rank G).trans
    (pow_dvd_pow_of_dvd (monoid.exponent_dvd_of_forall_pow_eq_one G n hG) (group.rank G))

end comm_group


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar el límite del producto de dos sucesiones
-- convergentes es el producto de sus límites.
-- ----------------------------------------------------------------------

import .Definicion_de_convergencia
import .Convergencia_de_la_funcion_constante
import .Convergencia_de_la_suma
import .Convergencia_del_producto_por_una_constante
import .Acotacion_de_convergentes
import .Producto_por_sucesion_convergente_a_cero
import tactic

variables {s t : ℕ → ℝ} {a b : ℝ}

theorem converges_to_mul
  (cs : converges_to s a)
  (ct : converges_to t b)
  : converges_to (λ n, s n * t n) (a * b) :=
begin
  have h₁ : converges_to (λ n, s n * (t n - b)) 0,
  { apply aux cs,
    convert converges_to_add ct (converges_to_const (-b)),
    ring, },
  convert (converges_to_add h₁ (@converges_to_mul_const s a b cs)),
  { ext,
    ring },
  { ring },
end

-- Prueba
-- ======

/-
s t : ℕ → ℝ,
a b : ℝ,
cs : converges_to s a,
ct : converges_to t b
⊢ converges_to (λ (n : ℕ), s n * t n) (a * b)
  >> have h₁ : converges_to (λ n, s n * (t n - b)) 0,
| ⊢ converges_to (λ (n : ℕ), s n * (t n - b)) 0
|   >> { apply aux cs,
| ⊢ converges_to (λ (n : ℕ), t n - b) 0
|   >>   convert converges_to_add ct (converges_to_const (-b)),
| ⊢ 0 = b + -b
|   >>   ring },
h₁ : converges_to (λ (n : ℕ), s n * (t n - b)) 0
⊢ converges_to (λ (n : ℕ), s n * t n) (a * b)
  >> convert (converges_to_add h₁ (@converges_to_mul_const s a b cs)),
| ⊢ (λ (n : ℕ), s n * t n) = λ (n : ℕ), s n * (t n - b) + b * s n
|   >> { ext,
| x : ℕ
| ⊢ s x * t x = s x * (t x - b) + b * s x
|   >>   ring },
⊢ a * b = 0 + b * a
  >> { ring },
no goals
-/