/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.perm.basic
import data.fintype.basic
import group_theory.subgroup.basic
/-!
# Lemmas about subgroups within the permutations (self-equivalences) of a type `α`

This file provides extra lemmas about some `subgroup`s that exist within `equiv.perm α`.
`group_theory.subgroup` depends on `group_theory.perm.basic`, so these need to be in a separate
file.

It also provides decidable instances on membership in these subgroups, since
`monoid_hom.decidable_mem_range` cannot be inferred without the help of a lambda.
The presence of these instances induces a `fintype` instance on the `quotient_group.quotient` of
these subgroups.
-/

namespace equiv
namespace perm

universes u

instance sum_congr_hom.decidable_mem_range {α β : Type*}
  [decidable_eq α] [decidable_eq β] [fintype α] [fintype β] :
  decidable_pred (∈ (sum_congr_hom α β).range) :=
λ x, infer_instance

@[simp]
lemma sum_congr_hom.card_range {α β : Type*}
  [fintype (sum_congr_hom α β).range] [fintype (perm α × perm β)] :
  fintype.card (sum_congr_hom α β).range = fintype.card (perm α × perm β) :=
fintype.card_eq.mpr ⟨(of_injective (sum_congr_hom α β) sum_congr_hom_injective).symm⟩

instance sigma_congr_right_hom.decidable_mem_range {α : Type*} {β : α → Type*}
  [decidable_eq α] [∀ a, decidable_eq (β a)] [fintype α] [∀ a, fintype (β a)] :
  decidable_pred (∈ (sigma_congr_right_hom β).range) :=
λ x, infer_instance

@[simp]
lemma sigma_congr_right_hom.card_range {α : Type*} {β : α → Type*}
  [fintype (sigma_congr_right_hom β).range] [fintype (Π a, perm (β a))] :
  fintype.card (sigma_congr_right_hom β).range = fintype.card (Π a, perm (β a)) :=
fintype.card_eq.mpr ⟨(of_injective (sigma_congr_right_hom β) sigma_congr_right_hom_injective).symm⟩

instance subtype_congr_hom.decidable_mem_range {α : Type*} (p : α → Prop) [decidable_pred p]
  [fintype (perm {a // p a} × perm {a // ¬ p a})] [decidable_eq (perm α)] :
  decidable_pred (∈ (subtype_congr_hom p).range) :=
λ x, infer_instance

@[simp]
lemma subtype_congr_hom.card_range {α : Type*} (p : α → Prop) [decidable_pred p]
  [fintype (subtype_congr_hom p).range] [fintype (perm {a // p a} × perm {a // ¬ p a})] :
  fintype.card (subtype_congr_hom p).range = fintype.card (perm {a // p a} × perm {a // ¬ p a}) :=
fintype.card_eq.mpr ⟨(of_injective (subtype_congr_hom p) (subtype_congr_hom_injective p)).symm⟩

/-- **Cayley's theorem**: Every group G is isomorphic to a subgroup of the symmetric group acting on
`G`. Note that we generalize this to an arbitrary "faithful" group action by `G`. Setting `H = G`
recovers the usual statement of Cayley's theorem via `right_cancel_monoid.to_has_faithful_scalar` -/
noncomputable def subgroup_of_mul_action (G H : Type*) [group G] [mul_action G H]
  [has_faithful_scalar G H] : G ≃* (mul_action.to_perm_hom G H).range :=
mul_equiv.of_left_inverse' _ (classical.some_spec mul_action.to_perm_injective.has_left_inverse)

end perm
end equiv


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

Definitions and properties of gcd, lcm, and coprime.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.nat.lemmas
import Mathlib.Lean3Lib.init.meta.well_founded_tactics

namespace Mathlib

namespace nat

/- gcd -/

def gcd : ℕ → ℕ → ℕ := sorry

@[simp] theorem gcd_zero_left (x : ℕ) : gcd 0 x = x := sorry

@[simp] theorem gcd_succ (x : ℕ) (y : ℕ) : gcd (Nat.succ x) y = gcd (y % Nat.succ x) (Nat.succ x) :=
  sorry

@[simp] theorem gcd_one_left (n : ℕ) : gcd 1 n = 1 := sorry

theorem gcd_def (x : ℕ) (y : ℕ) : gcd x y = ite (x = 0) y (gcd (y % x) x) := sorry

@[simp] theorem gcd_self (n : ℕ) : gcd n n = n := sorry

@[simp] theorem gcd_zero_right (n : ℕ) : gcd n 0 = n := sorry

theorem gcd_rec (m : ℕ) (n : ℕ) : gcd m n = gcd (n % m) m := sorry

theorem gcd.induction {P : ℕ → ℕ → Prop} (m : ℕ) (n : ℕ) (H0 : ∀ (n : ℕ), P 0 n)
    (H1 : ∀ (m n : ℕ), 0 < m → P (n % m) m → P m n) : P m n :=
  sorry

def lcm (m : ℕ) (n : ℕ) : ℕ := m * n / gcd m n

def coprime (m : ℕ) (n : ℕ) := gcd m n = 1

end Mathlib


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.metric_space.emetric_paracompact
import analysis.convex.partition_of_unity

/-!
# Lemmas about (e)metric spaces that need partition of unity

The main lemma in this file (see `metric.exists_continuous_real_forall_closed_ball_subset`) says the
following. Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets,
let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
positive continuous function `δ : C(X, → ℝ)` such that for any `i` and `x ∈ K i`, we have
`metric.closed_ball x (δ x) ⊆ U i`. We also formulate versions of this lemma for extended metric
spaces and for different codomains (`ℝ`, `ℝ≥0`, and `ℝ≥0∞`).

We also prove a few auxiliary lemmas to be used later in a proof of the smooth version of this
lemma.

## Tags

metric space, partition of unity, locally finite
-/

open_locale topology ennreal big_operators nnreal filter
open set function filter topological_space

variables {ι X : Type*}

namespace emetric

variables [emetric_space X] {K : ι → set X} {U : ι → set X}

/-- Let `K : ι → set X` be a locally finitie family of closed sets in an emetric space. Let
`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then for any point
`x : X`, for sufficiently small `r : ℝ≥0∞` and for `y` sufficiently close to `x`, for all `i`, if
`y ∈ K i`, then `emetric.closed_ball y r ⊆ U i`. -/

lemma exists_forall_closed_ball_subset_aux₁ (hK : ∀ i, is_closed (K i))
  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) (x : X) :
  ∃ r : ℝ, ∀ᶠ y in 𝓝 x, r ∈ Ioi (0 : ℝ) ∩
    ennreal.of_real ⁻¹' ⋂ i (hi : y ∈ K i), {r | closed_ball y r ⊆ U i} :=
begin
  have := (ennreal.continuous_of_real.tendsto' 0 0 ennreal.of_real_zero).eventually
    (eventually_nhds_zero_forall_closed_ball_subset hK hU hKU hfin x).curry,
  rcases this.exists_gt with ⟨r, hr0, hr⟩,
  refine ⟨r, hr.mono (λ y hy, ⟨hr0, _⟩)⟩,
  rwa [mem_preimage, mem_Inter₂]
end

lemma exists_forall_closed_ball_subset_aux₂ (y : X) :
  convex ℝ (Ioi (0 : ℝ) ∩ ennreal.of_real ⁻¹' ⋂ i (hi : y ∈ K i), {r | closed_ball y r ⊆ U i}) :=
(convex_Ioi _).inter $ ord_connected.convex $ ord_connected.preimage_ennreal_of_real $
  ord_connected_Inter $ λ i, ord_connected_Inter $
    λ hi, ord_connected_set_of_closed_ball_subset y (U i)

/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
exists a positive continuous function `δ : C(X, ℝ)` such that for any `i` and `x ∈ K i`,
we have `emetric.closed_ball x (ennreal.of_real (δ x)) ⊆ U i`. -/
lemma exists_continuous_real_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
  ∃ δ : C(X, ℝ), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (ennreal.of_real $ δ x) ⊆ U i :=
by simpa only [mem_inter_iff, forall_and_distrib, mem_preimage, mem_Inter, @forall_swap ι X]
  using exists_continuous_forall_mem_convex_of_local_const exists_forall_closed_ball_subset_aux₂
    (exists_forall_closed_ball_subset_aux₁ hK hU hKU hfin)

/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
exists a positive continuous function `δ : C(X, ℝ≥0)` such that for any `i` and `x ∈ K i`,
we have `emetric.closed_ball x (δ x) ⊆ U i`. -/
lemma exists_continuous_nnreal_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
  ∃ δ : C(X, ℝ≥0), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
begin
  rcases exists_continuous_real_forall_closed_ball_subset hK hU hKU hfin with ⟨δ, hδ₀, hδ⟩,
  lift δ to C(X, ℝ≥0) using λ x, (hδ₀ x).le,
  refine ⟨δ, hδ₀, λ i x hi, _⟩,
  simpa only [← ennreal.of_real_coe_nnreal] using hδ i x hi
end

/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
exists a positive continuous function `δ : C(X, ℝ≥0∞)` such that for any `i` and `x ∈ K i`,
we have `emetric.closed_ball x (δ x) ⊆ U i`. -/
lemma exists_continuous_ennreal_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
  ∃ δ : C(X, ℝ≥0∞), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
let ⟨δ, hδ₀, hδ⟩ := exists_continuous_nnreal_forall_closed_ball_subset hK hU hKU hfin
in ⟨continuous_map.comp ⟨coe, ennreal.continuous_coe⟩ δ, λ x, ennreal.coe_pos.2 (hδ₀ x), hδ⟩

end emetric

namespace metric

variables [metric_space X] {K : ι → set X} {U : ι → set X}

/-- Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets, let
`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
positive continuous function `δ : C(X, ℝ≥0)` such that for any `i` and `x ∈ K i`, we have
`metric.closed_ball x (δ x) ⊆ U i`. -/
lemma exists_continuous_nnreal_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
  ∃ δ : C(X, ℝ≥0), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
begin
  rcases emetric.exists_continuous_nnreal_forall_closed_ball_subset hK hU hKU hfin
    with ⟨δ, hδ0, hδ⟩,
  refine ⟨δ, hδ0, λ i x hx, _⟩,
  rw [← emetric_closed_ball_nnreal],
  exact hδ i x hx
end

/-- Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets, let
`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
positive continuous function `δ : C(X, ℝ)` such that for any `i` and `x ∈ K i`, we have
`metric.closed_ball x (δ x) ⊆ U i`. -/
lemma exists_continuous_real_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
  ∃ δ : C(X, ℝ), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
let ⟨δ, hδ₀, hδ⟩ := exists_continuous_nnreal_forall_closed_ball_subset hK hU hKU hfin
in ⟨continuous_map.comp ⟨coe, nnreal.continuous_coe⟩ δ, hδ₀, hδ⟩

end metric


import ring_theory.principal_ideal_domain linear_algebra.basic
open unique_factorization_domain

variables (R : Type*) (M : Type*) [add_comm_group M]
open_locale classical
section
variables [integral_domain R] [add_comm_group M] [module R M] (a : M)

/-- Given `a` in an R-module M, the ideal of `R` consisting of `r : R` such that
`r • a = 0`. -/
@[reducible] def ord : ideal R :=
⟨{r : R | r • a = 0}, zero_smul R a,
 λ x y (hx : _ = _) (hy : _ = _), show _ = _, by
   rw [add_smul x y a, hx, hy, zero_add],
 λ c x (h : _ = _), show _ = _, by
   rw [smul_eq_mul, ←smul_smul c x, h, smul_zero c]⟩

variables {R M}
lemma mem_ord (b : R) : b ∈ ord R M a ↔ b • a = 0 := iff.rfl

variables (R M)
/-- Torsion submodule: elements `m` of M such that there exists a non-zero `r : R` such that
`m • r = 0`. -/
def tors : submodule R M :=
⟨{a₁ : M | ∃ r : R, r ≠ 0 ∧ r ∈ ord R M a₁},
 ⟨1, ⟨ne.symm $ zero_ne_one, smul_zero 1⟩⟩,
 λ x y ⟨r, ⟨hr0, (hr : _ = _)⟩⟩ ⟨s, ⟨hs0, (hs : _ = _)⟩⟩,
  ⟨r * s, show _ ∧ (_ = _), from
   ⟨mul_ne_zero hr0 hs0, by rw [smul_add (r*s) x y, ←smul_smul r s y,
     hs, mul_comm, ←smul_smul s r]; norm_num [hr]⟩⟩,
  λ c x ⟨r, ⟨hr0, (hr : _ = _)⟩⟩,
    ⟨r, show _ ∧ (_ = _), from ⟨hr0, by rw [smul_smul r c, mul_comm,
      ←smul_smul c r, hr, smul_zero]⟩⟩⟩

end
variables [integral_domain R] [is_principal_ideal_ring R]
  [decidable_eq (associates R)] [add_comm_group M]
          [module R M] (a : M)

noncomputable instance ufd : unique_factorization_domain R :=
principal_ideal_ring.to_unique_factorization_domain

variables {R M}
--is private in mathlib
/-- Given nonzero `x : R`, if `⟦a⟧` is an element of `R` modulo association and `a` is a
factor of `x`, then `⟦a⟧` is irreducible. -/
theorem forall_map_mk_factors_irreducible (x : R) (hx : x ≠ 0) :
  ∀(a : associates R), a ∈ multiset.map associates.mk (factors x) → irreducible a :=
begin
  assume a ha,
  rcases multiset.mem_map.1 ha with ⟨c, hc, rfl⟩,
  exact (associates.irreducible_mk_iff c).2 (irreducible_factors hx _ hc)
end

/-- Given prime `p : R` and `⟦a⟧`, if `⟦a⟧` is in an i-tuple of `⟦p⟧`'s, `⟦a⟧` is irred. -/
lemma mem_repeat_prime_irred {p : R} (i : ℕ) (hp : prime p) (a : associates R)
(h : a ∈ multiset.repeat (associates.mk p) i) : irreducible a :=
by rw multiset.eq_of_mem_repeat h;
   exact (associates.irreducible_mk_iff p).2 (irreducible_iff_prime.2 hp)

/-- Given prime `p : R`, the tuple of irreducible factors of `p^i` (with multiplicity) modulo
assocition is an i-tuple of `⟦p⟧`'s. -/
lemma factors_prime_pow {p : R} (i : ℕ) (hp : prime p) :
  (factors (p^i)).map associates.mk =
  multiset.repeat (associates.mk p) i :=
associates.unique'
(forall_map_mk_factors_irreducible (p ^ i) $ pow_ne_zero i hp.1) (mem_repeat_prime_irred i hp) $
by rw [associates.prod_mk, associates.mk_eq_mk_iff_associated.2 $ factors_prod $
       pow_ne_zero i hp.1, multiset.prod_repeat, associates.mk_pow]

/-- Given prime `p : R` and the equivalence relation 'association', if `⟦r⟧` divides `⟦p ^ i⟧`, `r ≠ 0`. -/
lemma ne_zero_of_le_prime_pow {r p : R} {i : ℕ} (hp : prime p)
  (hr : associates.mk r ≤ associates.mk (p^i)) : r ≠ 0 :=
by intro h; rw h at hr; exact absurd (zero_dvd_iff.1 $
  associates.dvd_of_mk_le_mk hr) (pow_ne_zero i hp.1)

/-- Given prime `p : R` and the equivalence relation 'association', if `⟦r⟧` divides `⟦p ^ i⟧` then
there exists `j ≤ i` such that `⟦r⟧ = ⟦p ^ j⟧`. -/
lemma eq_prime_pow_of_dvd_prime_pow (r p : R) (i : ℕ) (hp : prime p)
(hr : associates.mk r ≤ associates.mk (p^i)) : ∃ j : ℕ, j ≤ i ∧ associates.mk r = associates.mk (p^j) :=
begin
  have : (factors r).map associates.mk ≤ multiset.repeat (associates.mk p) i,
  by rwa [←factors_prime_pow i hp, ←associates.prod_le_prod_iff_le
          (forall_map_mk_factors_irreducible r $ ne_zero_of_le_prime_pow hp hr) $
          forall_map_mk_factors_irreducible (p^i) $ pow_ne_zero i hp.1, associates.prod_mk,
          associates.prod_mk, associates.mk_eq_mk_iff_associated.2 $
          factors_prod $ ne_zero_of_le_prime_pow hp hr,
          associates.mk_eq_mk_iff_associated.2 $ factors_prod $ pow_ne_zero i hp.1],
  let j := multiset.card (multiset.map associates.mk $ factors r),
  exact ⟨j, ⟨by rw ←multiset.card_repeat (associates.mk p) i; exact multiset.card_le_of_le this,
    by { have H1 : multiset.map associates.mk (factors r) = multiset.repeat (associates.mk p) j,
      by rw multiset.eq_repeat'; intros; rw multiset.eq_of_mem_repeat (multiset.mem_of_le this H),
        rw [←associates.mk_eq_mk_iff_associated.2 $ factors_prod $ ne_zero_of_le_prime_pow hp hr,
            ←associates.prod_mk, H1, multiset.prod_repeat, associates.mk_pow]}⟩⟩
end

/-- if `a b : R` are equal up to association, they generate the same ideal. -/
lemma eq_span_of_eq_mk {α : Type*} [comm_ring α] {a b : α} (H: associates.mk a = associates.mk b) :
ideal.span ({a} : set α) = ideal.span ({b}) :=
begin
  apply ideal.ext, intro, split,
  intro h, cases associates.mk_eq_mk_iff_associated.1 H.symm with u hu,
  swap, intro h, cases associates.mk_eq_mk_iff_associated.1 H with u hu,
  all_goals {  cases exists_eq_mul_right_of_dvd (ideal.mem_span_singleton.1 h) with w hw,
               apply ideal.mem_span_singleton.2,
               use (↑u*w), rw [←mul_assoc, hu, hw]},
end

/-- Given `a : M` and prime `p : R` such that `p ^ i = 0`, there exists `j ≤ i` such that the ideal
generated by `p ^ j` equals the ideal of elements `r : R` such that `r • a = 0`. -/
lemma prime_pow_le (a : M) (p : R) (i : ℕ) (hp : prime p) (Ha : p^i•a = 0) :
  ∃ j : ℕ, j ≤ i ∧ ord R M a = ideal.span ({p^j}: set R) :=
begin
  rw ←submodule.is_principal.span_singleton_generator (ord R M a),
  let r := submodule.is_principal.generator (ord R M a),
  have : associates.mk r ≤ associates.mk (p^i), from
    associates.mk_le_mk_of_dvd ((submodule.is_principal.mem_iff_generator_dvd $ ord R M a).mp Ha),
  cases (eq_prime_pow_of_dvd_prime_pow r p i hp this) with j hj,
  exact ⟨j, hj.1, eq_span_of_eq_mk hj.2⟩,
end

lemma ord_ideal_zero_eq_top : ord R M 0 = ⊤ :=
eq_top_iff.2 $ λ x h, smul_zero x

/-- Given `x, y` in a torsion R-module `M`, and `n m : ℕ, p : R` such that
the ideal generated by `p ^ n` is the set of `r : R` such that `r • x = 0` and
the ideal generated by `p ^ m` is the set of `r : R` such that `r • y = 0`, we have
`p ^ max{n, m} • x + p ^ max{n, m} • y = 0`. -/
lemma pow_aux {x y : tors R M} {n m : ℕ} {p : R}
  (hn : ord R (tors R M) x = ideal.span ({p ^ n} : set R))
  (hm : ord R (tors R M) y = ideal.span ({p ^ m} : set R)) :
   p ^ max n m • x + p ^ max n m • y = 0 :=
begin
  conv in (p ^ max n m • x)
    {  rw [←nat.sub_add_cancel (le_max_left n m), pow_add p (max n m - n) n, mul_smul]},
  conv in (p ^ max n m • y)
    {  rw [←nat.sub_add_cancel (le_max_right n m), pow_add p (max n m - m) m, mul_smul]},
  suffices h : p ^ n ∈ ord R (tors R M) x ∧ p ^ m ∈ ord R (tors R M) y, by
    change _ = _ ∧ _ = _ at h; norm_num [h],
  rw [hn, hm],
  exact ⟨ideal.mem_span_singleton'.2 ⟨1, one_mul _⟩, ideal.mem_span_singleton'.2 ⟨1, one_mul _⟩⟩,
end

/-- Given `a : M` and prime `p : R`, if the ideal generated by `p ^ i` equals the set `r : R`
such that `r • a = 0`, then `p ^ i • a = 0`. -/
lemma eq_zero_of_ord_pow {a : M} {p : R} (i : ℕ) (hp : prime p)
(H : ord R M a = ideal.span ({p^i}: set R)) : p^i•a = 0 :=
show p ^ i ∈ ord R M a, by rw H; exact ideal.mem_span_singleton'.2 ⟨1, one_mul _⟩

/-- Given `a : M` and prime `p : R`, if `p ^ i • ≠ 0` and `p ^ (i + 1) • a = 0`, then the ideal
generated by `p ^ (i + 1)` equals the set of `r : R` such that `r • a = 0`. -/
lemma ord_eq_of_pow {a : M} {p : R} {i : ℕ} (hp : prime p)
  (hn0 : p ^ i • a ≠ 0) (h0 : p ^ (i + 1) • a = 0) :
  ord R M a = ideal.span ({p^(i + 1)}: set R) :=
begin
  cases prime_pow_le _ _ _ hp h0 with j hj,
  have : i + 1 ≤ j, by
    {rw ←not_lt,
    intro hnot,
    have := nat.lt_succ_iff.1 hnot,
    cases nat.le.dest this with k hk,
    rw ←hk at hn0,
    rw pow_add at hn0,
    rw mul_comm at hn0,
    rw mul_smul at hn0,
    have hj0 := eq_zero_of_ord_pow j hp hj.2,
    rw hj0 at hn0,
    rw smul_zero at hn0, exact hn0 rfl,
    },
  rw nat.le_antisymm this hj.1, exact hj.2,
end

variables (M)
/-- Given a prime `p : R`, we define a submodule of a torsion R-module comprising
`a` such that there exists `n : ℕ` for which the ideal generated by `p ^ n` equals
the set of `r : R` such that `r • a = 0`. -/
def prime_pow_ord (p : {p // prime p}) : submodule R (tors R M) :=
⟨  {a : tors R M | ∃ n : ℕ, ord R (tors R M) a = ideal.span ({p.1 ^ n} : set R)},
   ⟨0, by erw [pow_zero _, ideal.span_singleton_one, ord_ideal_zero_eq_top]⟩,
   λ x y ⟨n, (hn : _ = _)⟩ ⟨m, (hm : _ = _)⟩, by
   { cases prime_pow_le (x + y) p.1 (max n m) p.2
      (show _, by {rw smul_add (p.1 ^ (max n m)) x y, exact pow_aux hn hm}),
     exact ⟨w, h.2⟩},
    λ c x ⟨n, (hn : _ = _)⟩, by
    {  cases prime_pow_le (c•x) p.1 n p.2
       (show _, by { rw [←mul_smul, mul_comm, mul_smul],
         suffices : p.1 ^ n • x = 0, by {rw this, rw smul_zero},
          show p.1 ^ n ∈ ord R (tors R M) x, rw hn,
            exact ideal.mem_span_singleton'.2 ⟨1, one_mul _⟩}),
       exact ⟨w, h.2⟩}⟩

variables {M}

lemma exists_rep (A : submodule R M) (x : submodule.quotient A) :
∃ a : M, submodule.quotient.mk a = x := @quotient.exists_rep M (submodule.quotient_rel A) x

/-- The quotient of a module by its torsion submodule is torsion free. -/
variables (R M)
lemma tors_free_of_quotient :
  tors R (submodule.quotient $ tors R M) = ⊥ :=
by apply submodule.ext;
exact
(λ x, iff.intro
(λ h, by {rw [submodule.mem_bot], rcases h with ⟨r, ⟨hr0, hr⟩⟩,
 cases (exists_rep (tors R M) x) with a ha,
 have h : r • a ∈ tors R M, by {apply (submodule.quotient.mk_eq_zero (tors R M)).1,
                            rw [submodule.quotient.mk_smul, ha], exact hr},
        rcases h with ⟨s, ⟨hs0, hs⟩⟩,
        rw [ha.symm],
        apply (submodule.quotient.mk_eq_zero (tors R M)).2,
        exact ⟨s*r, ⟨mul_ne_zero hs0 hr0,
                        by {rw mem_ord at hs ⊢, simp [←smul_smul, hs]}⟩⟩})
(λ h, by {rw [submodule.mem_bot] at h, rw h,
          exact ⟨1, ⟨ne.symm $ zero_ne_one,
                     by {rw ord_ideal_zero_eq_top, trivial} ⟩⟩}))

/-- If `p : R` is prime, it's not nilpotent. -/
lemma ne_zero_of_prime_pow {p : R} (n : ℕ) (hp : prime p) :
  p ^ n ≠ 0 :=
begin
  induction n with n hn,
  simp,
  intro hnot,
  rw pow_succ at hnot,
  cases mul_eq_zero.1 hnot with hl hr,
  refine @not_prime_zero R _ _,
  rw ←hl, exact hp,
  exact hn hr,
end


universe u

theorem instForAll {A : Type u} {f : A → Prop} {a : A} :
  (forall a' : A, f a') → f a := by
  intro h
  exact h a

theorem instEqual₁ {A : Type u} {P : A → Prop} {t : A} :
  (forall x : A, x = t → P x) → P t := by
  intro h
  exact h t rfl

theorem instEqual₂ {A : Type u} {P : A → Prop} {t : A} :
  P t → (forall x : A, x = t → P x) := by
  intros h x r
  rewrite [r]
  exact h

theorem instEqual {A : Type u} {P : A → Prop} {t : A} :
  (forall x : A, x = t → P x) ↔ P t := ⟨instEqual₁, instEqual₂⟩


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_102 :
  (2^8) % 5 = 1 :=
begin
  norm_num,
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Floris van Doorn, Mario Carneiro, Martin Dvorak

! This file was ported from Lean 3 source module data.list.join
! leanprover-community/mathlib commit 18a5306c091183ac90884daa9373fa3b178e8607
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.BigOperators.Basic

/-!
# Join of a list of lists

This file proves basic properties of `List.join`, which concatenates a list of lists. It is defined
in `Init.Data.List.Basic`.
-/

variable {α β : Type _}

namespace List

attribute [simp] join

-- Porting note: simp can prove this
-- @[simp]
theorem join_singleton (l : List α) : [l].join = l := by rw [join, join, append_nil]
#align list.join_singleton List.join_singleton

@[simp]
theorem join_eq_nil : ∀ {L : List (List α)}, join L = [] ↔ ∀ l ∈ L, l = []
  | [] => iff_of_true rfl (forall_mem_nil _)
  | l :: L => by simp only [join, append_eq_nil, join_eq_nil, forall_mem_cons]
#align list.join_eq_nil List.join_eq_nil

@[simp]
theorem join_append (L₁ L₂ : List (List α)) : join (L₁ ++ L₂) = join L₁ ++ join L₂ := by
  induction L₁
  · rfl
  · simp [*]
#align list.join_append List.join_append

theorem join_concat (L : List (List α)) (l : List α) : join (L.concat l) = join L ++ l := by simp
#align list.join_concat List.join_concat

-- Porting note: `ff/tt` should be translated to `false/true`.
-- Porting note: `List.filter` now takes a `Bool` not a `Prop`.
--     Should the correct spelling now be `== false` instead?
@[simp]
theorem join_filter_isEmpty_eq_false [DecidablePred fun l : List α => l.isEmpty = false] :
    ∀ {L : List (List α)}, join (L.filter fun l => l.isEmpty = false) = L.join
  | [] => rfl
  | [] :: L => by
      simp [join_filter_isEmpty_eq_false (L := L), isEmpty_iff_eq_nil]
  | (a :: l) :: L => by
      have cons_not_empty : isEmpty (a :: l) = false := rfl
      simp [join_filter_isEmpty_eq_false (L := L), cons_not_empty]
#align list.join_filter_empty_eq_ff List.join_filter_isEmpty_eq_false

@[simp]
theorem join_filter_ne_nil [DecidablePred fun l : List α => l ≠ []] {L : List (List α)} :
    join (L.filter fun l => l ≠ []) = L.join := by
  simp [join_filter_isEmpty_eq_false, ← isEmpty_iff_eq_nil]
#align list.join_filter_ne_nil List.join_filter_ne_nil

theorem join_join (l : List (List (List α))) : l.join.join = (l.map join).join := by
  induction l <;> simp [*]
#align list.join_join List.join_join

@[simp]
theorem length_join (L : List (List α)) : length (join L) = sum (map length L) := by
  induction L <;> [rfl, simp only [*, join, map, sum_cons, length_append]]
#align list.length_join List.length_join

@[simp]
theorem length_bind (l : List α) (f : α → List β) :
    length (List.bind l f) = sum (map (length ∘ f) l) := by rw [List.bind, length_join, map_map]
#align list.length_bind List.length_bind

@[simp]
theorem bind_eq_nil {l : List α} {f : α → List β} : List.bind l f = [] ↔ ∀ x ∈ l, f x = [] :=
  join_eq_nil.trans <| by
    simp only [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
#align list.bind_eq_nil List.bind_eq_nil

/-- In a join, taking the first elements up to an index which is the sum of the lengths of the
first `i` sublists, is the same as taking the join of the first `i` sublists. -/
theorem take_sum_join (L : List (List α)) (i : ℕ) :
    L.join.take ((L.map length).take i).sum = (L.take i).join := by
  induction L generalizing i
  · simp
  · cases i <;> simp [take_append, *]
#align list.take_sum_join List.take_sum_join

/-- In a join, dropping all the elements up to an index which is the sum of the lengths of the
first `i` sublists, is the same as taking the join after dropping the first `i` sublists. -/
theorem drop_sum_join (L : List (List α)) (i : ℕ) :
    L.join.drop ((L.map length).take i).sum = (L.drop i).join := by
  induction L generalizing i
  · simp
  · cases i <;> simp [drop_append, *]
#align list.drop_sum_join List.drop_sum_join

/-- Taking only the first `i+1` elements in a list, and then dropping the first `i` ones, one is
left with a list of length `1` made of the `i`-th element of the original list. -/
theorem drop_take_succ_eq_cons_get (L : List α) (i : Fin L.length) :
    (L.take (i + 1)).drop i = [get L i] := by
  induction' L with head tail ih
  · exact (Nat.not_succ_le_zero i i.isLt).elim
  rcases i with ⟨_ | i, hi⟩
  · simp
  · simpa using ih ⟨i, Nat.lt_of_succ_lt_succ hi⟩

set_option linter.deprecated false in
/-- Taking only the first `i+1` elements in a list, and then dropping the first `i` ones, one is
left with a list of length `1` made of the `i`-th element of the original list. -/
@[deprecated drop_take_succ_eq_cons_get]
theorem drop_take_succ_eq_cons_nthLe (L : List α) {i : ℕ} (hi : i < L.length) :
    (L.take (i + 1)).drop i = [nthLe L i hi] := by
  induction' L with head tail generalizing i
  · simp only [length] at hi
    exact (Nat.not_succ_le_zero i hi).elim
  cases' i with i hi
  · simp
    rfl
  have : i < tail.length := by
    simp at hi
    exact Nat.lt_of_succ_lt_succ hi
  simp [*]
  rfl
#align list.drop_take_succ_eq_cons_nth_le List.drop_take_succ_eq_cons_nthLe

/-- In a join of sublists, taking the slice between the indices `A` and `B - 1` gives back the
original sublist of index `i` if `A` is the sum of the lenghts of sublists of index `< i`, and
`B` is the sum of the lengths of sublists of index `≤ i`. -/
theorem drop_take_succ_join_eq_get (L : List (List α)) (i : Fin L.length) :
    (L.join.take ((L.map length).take (i + 1)).sum).drop ((L.map length).take i).sum =
      get L i := by
  have : (L.map length).take i = ((L.take (i + 1)).map length).take i := by
    simp [map_take, take_take]
  simp [take_sum_join, this, drop_sum_join, drop_take_succ_eq_cons_get]

set_option linter.deprecated false in
/-- In a join of sublists, taking the slice between the indices `A` and `B - 1` gives back the
original sublist of index `i` if `A` is the sum of the lenghts of sublists of index `< i`, and
`B` is the sum of the lengths of sublists of index `≤ i`. -/
@[deprecated drop_take_succ_join_eq_get]
theorem drop_take_succ_join_eq_nthLe (L : List (List α)) {i : ℕ} (hi : i < L.length) :
    (L.join.take ((L.map length).take (i + 1)).sum).drop ((L.map length).take i).sum =
      nthLe L i hi := by
  have : (L.map length).take i = ((L.take (i + 1)).map length).take i := by
    simp [map_take, take_take]
  simp [take_sum_join, this, drop_sum_join, drop_take_succ_eq_cons_nthLe _ hi]
#align list.drop_take_succ_join_eq_nth_le List.drop_take_succ_join_eq_nthLe

set_option linter.deprecated false in
/-- Auxiliary lemma to control elements in a join. -/
@[deprecated]
theorem sum_take_map_length_lt1 (L : List (List α)) {i j : ℕ} (hi : i < L.length)
    (hj : j < (nthLe L i hi).length) :
    ((L.map length).take i).sum + j < ((L.map length).take (i + 1)).sum := by
  simp [hi, sum_take_succ, hj]
#align list.sum_take_map_length_lt1 List.sum_take_map_length_lt1

set_option linter.deprecated false in
/-- Auxiliary lemma to control elements in a join. -/
@[deprecated]
theorem sum_take_map_length_lt2 (L : List (List α)) {i j : ℕ} (hi : i < L.length)
    (hj : j < (nthLe L i hi).length) : ((L.map length).take i).sum + j < L.join.length := by
  convert lt_of_lt_of_le (sum_take_map_length_lt1 L hi hj) (monotone_sum_take _ hi)
  have : L.length = (L.map length).length := by simp
  simp [this, -length_map]
#align list.sum_take_map_length_lt2 List.sum_take_map_length_lt2

set_option linter.deprecated false in
/-- The `n`-th element in a join of sublists is the `j`-th element of the `i`th sublist,
where `n` can be obtained in terms of `i` and `j` by adding the lengths of all the sublists
of index `< i`, and adding `j`. -/
@[deprecated]
theorem nthLe_join (L : List (List α)) {i j : ℕ} (hi : i < L.length)
    (hj : j < (nthLe L i hi).length) :
    nthLe L.join (((L.map length).take i).sum + j) (sum_take_map_length_lt2 L hi hj) =
      nthLe (nthLe L i hi) j hj := by
  have := nthLe_take L.join (sum_take_map_length_lt2 L hi hj) (sum_take_map_length_lt1 L hi hj)
  rw [this, nthLe_drop, nthLe_of_eq (drop_take_succ_join_eq_nthLe L hi)]
#align list.nth_le_join List.nthLe_join

/-- Two lists of sublists are equal iff their joins coincide, as well as the lengths of the
sublists. -/
theorem eq_iff_join_eq (L L' : List (List α)) :
    L = L' ↔ L.join = L'.join ∧ map length L = map length L' := by
  refine' ⟨fun H => by simp [H], _⟩
  rintro ⟨join_eq, length_eq⟩
  apply ext_get
  · have : length (map length L) = length (map length L') := by rw [length_eq]
    simpa using this
  · intro n h₁ h₂
    rw [← drop_take_succ_join_eq_get, ← drop_take_succ_join_eq_get, join_eq, length_eq]
#align list.eq_iff_join_eq List.eq_iff_join_eq

theorem join_drop_length_sub_one {L : List (List α)} (h : L ≠ []) :
    (L.drop (L.length - 1)).join = L.getLast h := by
  induction L using List.reverseRecOn
  · cases h rfl
  · simp
#align list.join_drop_length_sub_one List.join_drop_length_sub_one

/-- We can rebracket `x ++ (l₁ ++ x) ++ (l₂ ++ x) ++ ... ++ (lₙ ++ x)` to
`(x ++ l₁) ++ (x ++ l₂) ++ ... ++ (x ++ lₙ) ++ x` where `L = [l₁, l₂, ..., lₙ]`. -/
theorem append_join_map_append (L : List (List α)) (x : List α) :
    x ++ (List.map (fun l => l ++ x) L).join = (List.map (fun l => x ++ l) L).join ++ x := by
  induction' L with _ _ ih
  · rw [map_nil, join, append_nil, map_nil, join, nil_append]
  · rw [map_cons, join, map_cons, join, append_assoc, ih, append_assoc, append_assoc]
#align list.append_join_map_append List.append_join_map_append

/-- Reversing a join is the same as reversing the order of parts and reversing all parts. -/
theorem reverse_join (L : List (List α)) :
    L.join.reverse = (List.map List.reverse L).reverse.join := by
  induction' L with _ _ ih
  · rfl
  · rw [join, reverse_append, ih, map_cons, reverse_cons', join_concat]
#align list.reverse_join List.reverse_join

/-- Joining a reverse is the same as reversing all parts and reversing the joined result. -/
theorem join_reverse (L : List (List α)) :
    L.reverse.join = (List.map List.reverse L).join.reverse := by
  simpa [reverse_reverse, map_reverse] using congr_arg List.reverse (reverse_join L.reverse)
#align list.join_reverse List.join_reverse

end List


/-
Copyright (c) 2020 Thomas Browning and Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning and Patrick Lutz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.adjoin
import Mathlib.field_theory.separable
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Primitive Element Theorem

In this file we prove the primitive element theorem.

## Main results

- `exists_primitive_element`: a finite separable extension `E / F` has a primitive element, i.e.
  there is an `α : E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.

## Implementation notes

In declaration names, `primitive_element` abbreviates `adjoin_simple_eq_top`:
it stands for the statement `F⟮α⟯ = (⊤ : subalgebra F E)`. We did not add an extra
declaration `is_primitive_element F α := F⟮α⟯ = (⊤ : subalgebra F E)` because this
requires more unfolding without much obvious benefit.

## Tags

primitive element, separable field extension, separable extension, intermediate field, adjoin, exists_adjoin_simple_eq_top

-/

namespace field

/-! ### Primitive element theorem for finite fields -/

/-- Primitive element theorem assuming E is finite. -/
theorem exists_primitive_element_of_fintype_top (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [fintype E] : ∃ (α : E), intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α) = ⊤ := sorry

/-- Primitive element theorem for finite dimensional extension of a finite field. -/
theorem exists_primitive_element_of_fintype_bot (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [fintype F] [finite_dimensional F E] : ∃ (α : E), intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α) = ⊤ :=
  exists_primitive_element_of_fintype_top F E

/-! ### Primitive element theorem for infinite fields -/

theorem primitive_element_inf_aux_exists_c {F : Type u_1} [field F] [infinite F] {E : Type u_2} [field E] (ϕ : F →+* E) (α : E) (β : E) (f : polynomial F) (g : polynomial F) : ∃ (c : F),
  ∀ (α' : E),
    α' ∈ polynomial.roots (polynomial.map ϕ f) →
      ∀ (β' : E), β' ∈ polynomial.roots (polynomial.map ϕ g) → -(α' - α) / (β' - β) ≠ coe_fn ϕ c := sorry

-- This is the heart of the proof of the primitive element theorem. It shows that if `F` is

-- infinite and `α` and `β` are separable over `F` then `F⟮α, β⟯` is generated by a single element.

theorem primitive_element_inf_aux {F : Type u_1} [field F] [infinite F] {E : Type u_2} [field E] (α : E) (β : E) [algebra F E] (F_sep : is_separable F E) : ∃ (γ : E),
  intermediate_field.adjoin F (intermediate_field.insert.insert (intermediate_field.insert.insert ∅ β) α) =
    intermediate_field.adjoin F (intermediate_field.insert.insert ∅ γ) := sorry

/-- Primitive element theorem: a finite separable field extension `E` of `F` has a
  primitive element, i.e. there is an `α ∈ E` such that `F⟮α⟯ = (⊤ : subalgebra F E)`.-/
theorem exists_primitive_element {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] [finite_dimensional F E] (F_sep : is_separable F E) : ∃ (α : E), intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α) = ⊤ := sorry


/-
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.invertible
import linear_algebra.affine_space.affine_equiv

/-!
# Midpoint of a segment

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

## Main definitions

* `midpoint R x y`: midpoint of the segment `[x, y]`. We define it for `x` and `y`
  in a module over a ring `R` with invertible `2`.
* `add_monoid_hom.of_map_midpoint`: construct an `add_monoid_hom` given a map `f` such that
  `f` sends zero to zero and midpoints to midpoints.

## Main theorems

* `midpoint_eq_iff`: `z` is the midpoint of `[x, y]` if and only if `x + y = z + z`,
* `midpoint_unique`: `midpoint R x y` does not depend on `R`;
* `midpoint x y` is linear both in `x` and `y`;
* `point_reflection_midpoint_left`, `point_reflection_midpoint_right`:
  `equiv.point_reflection (midpoint R x y)` swaps `x` and `y`.

We do not mark most lemmas as `@[simp]` because it is hard to tell which side is simpler.

## Tags

midpoint, add_monoid_hom
-/

open affine_map affine_equiv

section

variables (R : Type*) {V V' P P' : Type*} [ring R] [invertible (2:R)]
  [add_comm_group V] [module R V] [add_torsor V P]
  [add_comm_group V'] [module R V'] [add_torsor V' P']

include V

/-- `midpoint x y` is the midpoint of the segment `[x, y]`. -/
def midpoint (x y : P) : P := line_map x y (⅟2:R)

variables {R} {x y z : P}
include V'

@[simp] lemma affine_map.map_midpoint (f : P →ᵃ[R] P') (a b : P) :
  f (midpoint R a b) = midpoint R (f a) (f b) :=
f.apply_line_map a b _

@[simp] lemma affine_equiv.map_midpoint (f : P ≃ᵃ[R] P') (a b : P) :
  f (midpoint R a b) = midpoint R (f a) (f b) :=
f.apply_line_map a b _

omit V'

@[simp] lemma affine_equiv.point_reflection_midpoint_left (x y : P) :
  point_reflection R (midpoint R x y) x = y :=
by rw [midpoint, point_reflection_apply, line_map_apply, vadd_vsub,
  vadd_vadd, ← add_smul, ← two_mul, mul_inv_of_self, one_smul, vsub_vadd]

lemma midpoint_comm (x y : P) : midpoint R x y = midpoint R y x :=
by rw [midpoint, ← line_map_apply_one_sub, one_sub_inv_of_two, midpoint]

@[simp] lemma affine_equiv.point_reflection_midpoint_right (x y : P) :
  point_reflection R (midpoint R x y) y = x :=
by rw [midpoint_comm, affine_equiv.point_reflection_midpoint_left]

lemma midpoint_vsub_midpoint (p₁ p₂ p₃ p₄ : P) :
  midpoint R p₁ p₂ -ᵥ midpoint R p₃ p₄ = midpoint R (p₁ -ᵥ p₃) (p₂ -ᵥ p₄) :=
line_map_vsub_line_map _ _ _ _ _

lemma midpoint_vadd_midpoint (v v' : V) (p p' : P) :
  midpoint R v v' +ᵥ midpoint R p p' = midpoint R (v +ᵥ p) (v' +ᵥ p') :=
line_map_vadd_line_map _ _ _ _ _

lemma midpoint_eq_iff {x y z : P} : midpoint R x y = z ↔ point_reflection R z x = y :=
eq_comm.trans ((injective_point_reflection_left_of_module R x).eq_iff'
  (affine_equiv.point_reflection_midpoint_left x y)).symm

@[simp] lemma midpoint_vsub_left (p₁ p₂ : P) : midpoint R p₁ p₂ -ᵥ p₁ = (⅟2:R) • (p₂ -ᵥ p₁) :=
line_map_vsub_left _ _ _

@[simp] lemma midpoint_vsub_right (p₁ p₂ : P) : midpoint R p₁ p₂ -ᵥ p₂ = (⅟2:R) • (p₁ -ᵥ p₂) :=
by rw [midpoint_comm, midpoint_vsub_left]

@[simp] lemma left_vsub_midpoint (p₁ p₂ : P) : p₁ -ᵥ midpoint R p₁ p₂ = (⅟2:R) • (p₁ -ᵥ p₂) :=
left_vsub_line_map _ _ _

@[simp] lemma right_vsub_midpoint (p₁ p₂ : P) : p₂ -ᵥ midpoint R p₁ p₂ = (⅟2:R) • (p₂ -ᵥ p₁) :=
by rw [midpoint_comm, left_vsub_midpoint]

lemma midpoint_vsub (p₁ p₂ p : P) :
  midpoint R p₁ p₂ -ᵥ p = (⅟2:R) • (p₁ -ᵥ p) + (⅟2:R) • (p₂ -ᵥ p) :=
by rw [←vsub_sub_vsub_cancel_right p₁ p p₂, smul_sub, sub_eq_add_neg, ←smul_neg,
       neg_vsub_eq_vsub_rev, add_assoc, inv_of_two_smul_add_inv_of_two_smul, ←vadd_vsub_assoc,
       midpoint_comm, midpoint, line_map_apply]

lemma vsub_midpoint (p₁ p₂ p : P) :
  p -ᵥ midpoint R p₁ p₂ = (⅟2:R) • (p -ᵥ p₁) + (⅟2:R) • (p -ᵥ p₂) :=
by rw [←neg_vsub_eq_vsub_rev, midpoint_vsub, neg_add, ←smul_neg, ←smul_neg,
       neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev]

@[simp] lemma midpoint_sub_left (v₁ v₂ : V) : midpoint R v₁ v₂ - v₁ = (⅟2:R) • (v₂ - v₁) :=
midpoint_vsub_left v₁ v₂

@[simp] lemma midpoint_sub_right (v₁ v₂ : V) : midpoint R v₁ v₂ - v₂ = (⅟2:R) • (v₁ - v₂) :=
midpoint_vsub_right v₁ v₂

@[simp] lemma left_sub_midpoint (v₁ v₂ : V) : v₁ - midpoint R v₁ v₂ = (⅟2:R) • (v₁ - v₂) :=
left_vsub_midpoint v₁ v₂

@[simp] lemma right_sub_midpoint (v₁ v₂ : V) : v₂ - midpoint R v₁ v₂ = (⅟2:R) • (v₂ - v₁) :=
right_vsub_midpoint v₁ v₂

variable (R)

@[simp] lemma midpoint_eq_left_iff {x y : P} : midpoint R x y = x ↔ x = y :=
by rw [midpoint_eq_iff, point_reflection_self]

@[simp] lemma left_eq_midpoint_iff {x y : P} : x = midpoint R x y ↔ x = y :=
by rw [eq_comm, midpoint_eq_left_iff]

@[simp] lemma midpoint_eq_right_iff {x y : P} : midpoint R x y = y ↔ x = y :=
by rw [midpoint_comm, midpoint_eq_left_iff, eq_comm]

@[simp] lemma right_eq_midpoint_iff {x y : P} : y = midpoint R x y ↔ x = y :=
by rw [eq_comm, midpoint_eq_right_iff]

lemma midpoint_eq_midpoint_iff_vsub_eq_vsub {x x' y y' : P} :
  midpoint R x y = midpoint R x' y' ↔ x -ᵥ x' = y' -ᵥ y :=
by rw [← @vsub_eq_zero_iff_eq V, midpoint_vsub_midpoint, midpoint_eq_iff, point_reflection_apply,
  vsub_eq_sub, zero_sub, vadd_eq_add, add_zero, neg_eq_iff_eq_neg, neg_vsub_eq_vsub_rev]

lemma midpoint_eq_iff' {x y z : P} : midpoint R x y = z ↔ equiv.point_reflection z x = y :=
midpoint_eq_iff

/-- `midpoint` does not depend on the ring `R`. -/
lemma midpoint_unique (R' : Type*) [ring R'] [invertible (2:R')] [module R' V] (x y : P) :
  midpoint R x y = midpoint R' x y :=
(midpoint_eq_iff' R).2 $ (midpoint_eq_iff' R').1 rfl

@[simp] lemma midpoint_self (x : P) : midpoint R x x = x :=
line_map_same_apply _ _

@[simp] lemma midpoint_add_self (x y : V) : midpoint R x y + midpoint R x y = x + y :=
calc midpoint R x y +ᵥ midpoint R x y = midpoint R x y +ᵥ midpoint R y x : by rw midpoint_comm
... = x + y : by rw [midpoint_vadd_midpoint, vadd_eq_add, vadd_eq_add, add_comm, midpoint_self]

lemma midpoint_zero_add (x y : V) : midpoint R 0 (x + y) = midpoint R x y :=
(midpoint_eq_midpoint_iff_vsub_eq_vsub R).2 $ by simp [sub_add_eq_sub_sub_swap]

lemma midpoint_eq_smul_add (x y : V) : midpoint R x y = (⅟2 : R) • (x + y) :=
by rw [midpoint_eq_iff, point_reflection_apply, vsub_eq_sub, vadd_eq_add, sub_add_eq_add_sub,
  ← two_smul R, smul_smul, mul_inv_of_self, one_smul, add_sub_cancel']

@[simp] lemma midpoint_self_neg (x : V) :
  midpoint R x (-x) = 0 :=
by rw [midpoint_eq_smul_add, add_neg_self, smul_zero]

@[simp] lemma midpoint_neg_self (x : V) :
  midpoint R (-x) x = 0 :=
by simpa using midpoint_self_neg R (-x)

@[simp] lemma midpoint_sub_add (x y : V) :
  midpoint R (x - y) (x + y) = x :=
by rw [sub_eq_add_neg, ← vadd_eq_add, ← vadd_eq_add, ← midpoint_vadd_midpoint]; simp

@[simp] lemma midpoint_add_sub (x y : V) :
  midpoint R (x + y) (x - y) = x :=
by rw midpoint_comm; simp

end

namespace add_monoid_hom

variables (R R' : Type*) {E F : Type*}
  [ring R] [invertible (2:R)] [add_comm_group E] [module R E]
  [ring R'] [invertible (2:R')] [add_comm_group F] [module R' F]

/-- A map `f : E → F` sending zero to zero and midpoints to midpoints is an `add_monoid_hom`. -/
def of_map_midpoint (f : E → F) (h0 : f 0 = 0)
  (hm : ∀ x y, f (midpoint R x y) = midpoint R' (f x) (f y)) :
  E →+ F :=
{ to_fun := f,
  map_zero' := h0,
  map_add' := λ x y,
    calc f (x + y) = f 0 + f (x + y) : by rw [h0, zero_add]
    ... = midpoint R' (f 0) (f (x + y)) + midpoint R' (f 0) (f (x + y)) :
      (midpoint_add_self _ _ _).symm
    ... = f (midpoint R x y) + f (midpoint R x y) : by rw [← hm, midpoint_zero_add]
    ... = f x + f y : by rw [hm, midpoint_add_self] }

@[simp] lemma coe_of_map_midpoint (f : E → F) (h0 : f 0 = 0)
  (hm : ∀ x y, f (midpoint R x y) = midpoint R' (f x) (f y)) :
  ⇑(of_map_midpoint R R' f h0 hm) = f := rfl

end add_monoid_hom


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

! This file was ported from Lean 3 source module algebra.continued_fractions.convergents_equiv
! leanprover-community/mathlib commit a7e36e48519ab281320c4d192da6a7b348ce40ad
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.ContinuedFractions.ContinuantsRecurrence
import Mathbin.Algebra.ContinuedFractions.TerminatedStable
import Mathbin.Tactic.FieldSimp
import Mathbin.Tactic.Ring

/-!
# Equivalence of Recursive and Direct Computations of `gcf` Convergents

## Summary

We show the equivalence of two computations of convergents (recurrence relation (`convergents`) vs.
direct evaluation (`convergents'`)) for `gcf`s on linear ordered fields. We follow the proof from
[hardy2008introduction], Chapter 10. Here's a sketch:

Let `c` be a continued fraction `[h; (a₀, b₀), (a₁, b₁), (a₂, b₂),...]`, visually:
$$
  c = h + \dfrac{a_0}
                {b_0 + \dfrac{a_1}
                             {b_1 + \dfrac{a_2}
                                          {b_2 + \dfrac{a_3}
                                                       {b_3 + \dots}}}}
$$
One can compute the convergents of `c` in two ways:
1. Directly evaluating the fraction described by `c` up to a given `n` (`convergents'`)
2. Using the recurrence (`convergents`):
  - `A₋₁ = 1,  A₀ = h,  Aₙ = bₙ₋₁ * Aₙ₋₁ + aₙ₋₁ * Aₙ₋₂`, and
  - `B₋₁ = 0,  B₀ = 1,  Bₙ = bₙ₋₁ * Bₙ₋₁ + aₙ₋₁ * Bₙ₋₂`.

To show the equivalence of the computations in the main theorem of this file
`convergents_eq_convergents'`, we proceed by induction. The case `n = 0` is trivial.

For `n + 1`, we first "squash" the `n + 1`th position of `c` into the `n`th position to obtain
another continued fraction
  `c' := [h; (a₀, b₀),..., (aₙ-₁, bₙ-₁), (aₙ, bₙ + aₙ₊₁ / bₙ₊₁), (aₙ₊₁, bₙ₊₁),...]`.
This squashing process is formalised in section `squash`. Note that directly evaluating `c` up to
position `n + 1` is equal to evaluating `c'` up to `n`. This is shown in lemma
`succ_nth_convergent'_eq_squash_gcf_nth_convergent'`.

By the inductive hypothesis, the two computations for the `n`th convergent of `c` coincide.
So all that is left to show is that the recurrence relation for `c` at `n + 1` and and `c'` at
`n` coincide. This can be shown by another induction.
The corresponding lemma in this file is `succ_nth_convergent_eq_squash_gcf_nth_convergent`.

## Main Theorems

- `generalized_continued_fraction.convergents_eq_convergents'` shows the equivalence under a strict
positivity restriction on the sequence.
- `continued_fractions.convergents_eq_convergents'` shows the equivalence for (regular) continued
fractions.

## References

- https://en.wikipedia.org/wiki/Generalized_continued_fraction
- [*Hardy, GH and Wright, EM and Heath-Brown, Roger and Silverman, Joseph*][hardy2008introduction]

## Tags

fractions, recurrence, equivalence
-/

variable {K : Type _} {n : ℕ}

namespace GeneralizedContinuedFraction

/- ./././Mathport/Syntax/Translate/Command.lean:224:11: unsupported: unusual advanced open style -/
variable {g : GeneralizedContinuedFraction K} {s : Seq <| Pair K}

section Squash

/-!
We will show the equivalence of the computations by induction. To make the induction work, we need
to be able to *squash* the nth and (n + 1)th value of a sequence. This squashing itself and the
lemmas about it are not very interesting. As a reader, you hence might want to skip this section.
-/

section WithDivisionRing

variable [DivisionRing K]

/-- Given a sequence of gcf.pairs `s = [(a₀, bₒ), (a₁, b₁), ...]`, `squash_seq s n`
combines `⟨aₙ, bₙ⟩` and `⟨aₙ₊₁, bₙ₊₁⟩` at position `n` to `⟨aₙ, bₙ + aₙ₊₁ / bₙ₊₁⟩`. For example,
`squash_seq s 0 = [(a₀, bₒ + a₁ / b₁), (a₁, b₁),...]`.
If `s.terminated_at (n + 1)`, then `squash_seq s n = s`.
-/
def squashSeq (s : Seq <| Pair K) (n : ℕ) : Seq (Pair K) :=
  match Prod.mk (s.get? n) (s.get? (n + 1)) with
  | ⟨some gp_n, some gp_succ_n⟩ =>
    Seq.nats.zipWith
      (-- return the squashed value at position `n`; otherwise, do nothing.
      fun n' gp => if n' = n then ⟨gp_n.a, gp_n.b + gp_succ_n.a / gp_succ_n.b⟩ else gp)
      s
  | _ => s
#align generalized_continued_fraction.squash_seq GeneralizedContinuedFraction.squashSeq

/-! We now prove some simple lemmas about the squashed sequence -/

/-- If the sequence already terminated at position `n + 1`, nothing gets squashed. -/
theorem squashSeq_eq_self_of_terminated (terminated_at_succ_n : s.TerminatedAt (n + 1)) :
    squashSeq s n = s :=
  by
  change s.nth (n + 1) = none at terminated_at_succ_n
  cases s_nth_eq : s.nth n <;> simp only [*, squash_seq]
#align generalized_continued_fraction.squash_seq_eq_self_of_terminated GeneralizedContinuedFraction.squashSeq_eq_self_of_terminated

/-- If the sequence has not terminated before position `n + 1`, the value at `n + 1` gets
squashed into position `n`. -/
theorem squashSeq_nth_of_not_terminated {gp_n gp_succ_n : Pair K} (s_nth_eq : s.get? n = some gp_n)
    (s_succ_nth_eq : s.get? (n + 1) = some gp_succ_n) :
    (squashSeq s n).get? n = some ⟨gp_n.a, gp_n.b + gp_succ_n.a / gp_succ_n.b⟩ := by
  simp [*, squash_seq]
#align generalized_continued_fraction.squash_seq_nth_of_not_terminated GeneralizedContinuedFraction.squashSeq_nth_of_not_terminated

/-- The values before the squashed position stay the same. -/
theorem squashSeq_nth_of_lt {m : ℕ} (m_lt_n : m < n) : (squashSeq s n).get? m = s.get? m :=
  by
  cases s_succ_nth_eq : s.nth (n + 1)
  case none => rw [squash_seq_eq_self_of_terminated s_succ_nth_eq]
  case some =>
    obtain ⟨gp_n, s_nth_eq⟩ : ∃ gp_n, s.nth n = some gp_n; exact s.ge_stable n.le_succ s_succ_nth_eq
    obtain ⟨gp_m, s_mth_eq⟩ : ∃ gp_m, s.nth m = some gp_m;
    exact s.ge_stable (le_of_lt m_lt_n) s_nth_eq
    simp [*, squash_seq, m_lt_n.ne]
#align generalized_continued_fraction.squash_seq_nth_of_lt GeneralizedContinuedFraction.squashSeq_nth_of_lt

/-- Squashing at position `n + 1` and taking the tail is the same as squashing the tail of the
sequence at position `n`. -/
theorem squashSeq_succ_n_tail_eq_squashSeq_tail_n :
    (squashSeq s (n + 1)).tail = squashSeq s.tail n :=
  by
  cases' s_succ_succ_nth_eq : s.nth (n + 2) with gp_succ_succ_n
  case
    none =>
    have : squash_seq s (n + 1) = s := squash_seq_eq_self_of_terminated s_succ_succ_nth_eq
    cases s_succ_nth_eq : s.nth (n + 1) <;>
      simp only [squash_seq, seq.nth_tail, s_succ_nth_eq, s_succ_succ_nth_eq]
  case
    some =>
    obtain ⟨gp_succ_n, s_succ_nth_eq⟩ : ∃ gp_succ_n, s.nth (n + 1) = some gp_succ_n;
    exact s.ge_stable (n + 1).le_succ s_succ_succ_nth_eq
    -- apply extensionality with `m` and continue by cases `m = n`.
    ext1 m
    cases' Decidable.em (m = n) with m_eq_n m_ne_n
    · have : s.tail.nth n = some gp_succ_n := (s.nth_tail n).trans s_succ_nth_eq
      simp [*, squash_seq]
    · have : s.tail.nth m = s.nth (m + 1) := s.nth_tail m
      cases s_succ_mth_eq : s.nth (m + 1)
      all_goals have s_tail_mth_eq := this.trans s_succ_mth_eq
      · simp only [*, squash_seq, seq.nth_tail, seq.nth_zip_with, Option.map₂_none_right]
      · simp [*, squash_seq]
#align generalized_continued_fraction.squash_seq_succ_n_tail_eq_squash_seq_tail_n GeneralizedContinuedFraction.squashSeq_succ_n_tail_eq_squashSeq_tail_n

/-- The auxiliary function `convergents'_aux` returns the same value for a sequence and the
corresponding squashed sequence at the squashed position. -/
theorem succ_succ_nth_convergent'_aux_eq_succ_nth_convergent'_aux_squashSeq :
    convergents'Aux s (n + 2) = convergents'Aux (squashSeq s n) (n + 1) :=
  by
  cases' s_succ_nth_eq : s.nth <| n + 1 with gp_succ_n
  case none =>
    rw [squash_seq_eq_self_of_terminated s_succ_nth_eq,
      convergents'_aux_stable_step_of_terminated s_succ_nth_eq]
  case some =>
    induction' n with m IH generalizing s gp_succ_n
    case zero =>
      obtain ⟨gp_head, s_head_eq⟩ : ∃ gp_head, s.head = some gp_head
      exact s.ge_stable zero_le_one s_succ_nth_eq
      have : (squash_seq s 0).headI = some ⟨gp_head.a, gp_head.b + gp_succ_n.a / gp_succ_n.b⟩ :=
        squash_seq_nth_of_not_terminated s_head_eq s_succ_nth_eq
      simp [*, convergents'_aux, seq.head, seq.nth_tail]
    case succ =>
      obtain ⟨gp_head, s_head_eq⟩ : ∃ gp_head, s.head = some gp_head
      exact s.ge_stable (m + 2).zero_le s_succ_nth_eq
      suffices
        gp_head.a / (gp_head.b + convergents'_aux s.tail (m + 2)) =
          convergents'_aux (squash_seq s (m + 1)) (m + 2)
        by simpa only [convergents'_aux, s_head_eq]
      have : convergents'_aux s.tail (m + 2) = convergents'_aux (squash_seq s.tail m) (m + 1) :=
        by
        refine' IH gp_succ_n _
        simpa [seq.nth_tail] using s_succ_nth_eq
      have : (squash_seq s (m + 1)).headI = some gp_head :=
        (squash_seq_nth_of_lt m.succ_pos).trans s_head_eq
      simp only [*, convergents'_aux, squash_seq_succ_n_tail_eq_squash_seq_tail_n]
#align generalized_continued_fraction.succ_succ_nth_convergent'_aux_eq_succ_nth_convergent'_aux_squash_seq GeneralizedContinuedFraction.succ_succ_nth_convergent'_aux_eq_succ_nth_convergent'_aux_squashSeq

/-! Let us now lift the squashing operation to gcfs. -/

/-- Given a gcf `g = [h; (a₀, bₒ), (a₁, b₁), ...]`, we have
- `squash_nth.gcf g 0 = [h + a₀ / b₀); (a₀, bₒ), ...]`,
- `squash_nth.gcf g (n + 1) = ⟨g.h, squash_seq g.s n⟩`
-/
def squashGcf (g : GeneralizedContinuedFraction K) : ℕ → GeneralizedContinuedFraction K
  | 0 =>
    match g.s.get? 0 with
    | none => g
    | some gp => ⟨g.h + gp.a / gp.b, g.s⟩
  | n + 1 => ⟨g.h, squashSeq g.s n⟩
#align generalized_continued_fraction.squash_gcf GeneralizedContinuedFraction.squashGcf

/-! Again, we derive some simple lemmas that are not really of interest. This time for the
squashed gcf. -/

/-- If the gcf already terminated at position `n`, nothing gets squashed. -/
theorem squashGcf_eq_self_of_terminated (terminated_at_n : TerminatedAt g n) : squashGcf g n = g :=
  by
  cases n
  case zero =>
    change g.s.nth 0 = none at terminated_at_n
    simp only [convergents', squash_gcf, convergents'_aux, terminated_at_n]
  case succ => cases g; simp [squash_seq_eq_self_of_terminated terminated_at_n, squash_gcf]
#align generalized_continued_fraction.squash_gcf_eq_self_of_terminated GeneralizedContinuedFraction.squashGcf_eq_self_of_terminated

/-- The values before the squashed position stay the same. -/
theorem squashGcf_nth_of_lt {m : ℕ} (m_lt_n : m < n) :
    (squashGcf g (n + 1)).s.get? m = g.s.get? m := by
  simp only [squash_gcf, squash_seq_nth_of_lt m_lt_n]
#align generalized_continued_fraction.squash_gcf_nth_of_lt GeneralizedContinuedFraction.squashGcf_nth_of_lt

/-- `convergents'` returns the same value for a gcf and the corresponding squashed gcf at the
squashed position. -/
theorem succ_nth_convergent'_eq_squashGcf_nth_convergent' :
    g.convergents' (n + 1) = (squashGcf g n).convergents' n :=
  by
  cases n
  case zero =>
    cases g_s_head_eq : g.s.nth 0 <;>
      simp [g_s_head_eq, squash_gcf, convergents', convergents'_aux, seq.head]
  case succ =>
    simp only [succ_succ_nth_convergent'_aux_eq_succ_nth_convergent'_aux_squash_seq, convergents',
      squash_gcf]
#align generalized_continued_fraction.succ_nth_convergent'_eq_squash_gcf_nth_convergent' GeneralizedContinuedFraction.succ_nth_convergent'_eq_squashGcf_nth_convergent'

/-- The auxiliary continuants before the squashed position stay the same. -/
theorem continuantsAux_eq_continuantsAux_squashGcf_of_le {m : ℕ} :
    m ≤ n → continuantsAux g m = (squashGcf g n).continuantsAux m :=
  Nat.strong_induction_on m
    (by
      clear m
      intro m IH m_le_n
      cases' m with m'
      · rfl
      · cases' n with n'
        · exact (m'.not_succ_le_zero m_le_n).elim
        -- 1 ≰ 0
        · cases' m' with m''
          · rfl
          · -- get some inequalities to instantiate the IH for m'' and m'' + 1
            have m'_lt_n : m'' + 1 < n' + 1 := m_le_n
            have succ_m''th_conts_aux_eq := IH (m'' + 1) (lt_add_one (m'' + 1)) m'_lt_n.le
            have : m'' < m'' + 2 := lt_add_of_pos_right m'' zero_lt_two
            have m''th_conts_aux_eq := IH m'' this (le_trans this.le m_le_n)
            have : (squash_gcf g (n' + 1)).s.get? m'' = g.s.nth m'' :=
              squash_gcf_nth_of_lt (nat.succ_lt_succ_iff.mp m'_lt_n)
            simp [continuants_aux, succ_m''th_conts_aux_eq, m''th_conts_aux_eq, this])
#align generalized_continued_fraction.continuants_aux_eq_continuants_aux_squash_gcf_of_le GeneralizedContinuedFraction.continuantsAux_eq_continuantsAux_squashGcf_of_le

end WithDivisionRing

/-- The convergents coincide in the expected way at the squashed position if the partial denominator
at the squashed position is not zero. -/
theorem succ_nth_convergent_eq_squashGcf_nth_convergent [Field K]
    (nth_part_denom_ne_zero : ∀ {b : K}, g.partialDenominators.get? n = some b → b ≠ 0) :
    g.convergents (n + 1) = (squashGcf g n).convergents n :=
  by
  cases' Decidable.em (g.terminated_at n) with terminated_at_n not_terminated_at_n
  · have : squash_gcf g n = g := squash_gcf_eq_self_of_terminated terminated_at_n
    simp only [this, convergents_stable_of_terminated n.le_succ terminated_at_n]
  · obtain ⟨⟨a, b⟩, s_nth_eq⟩ : ∃ gp_n, g.s.nth n = some gp_n
    exact option.ne_none_iff_exists'.mp not_terminated_at_n
    have b_ne_zero : b ≠ 0 := nth_part_denom_ne_zero (part_denom_eq_s_b s_nth_eq)
    cases' n with n'
    case
      zero =>
      suffices (b * g.h + a) / b = g.h + a / b by
        simpa [squash_gcf, s_nth_eq, convergent_eq_conts_a_div_conts_b,
          continuants_recurrence_aux s_nth_eq zeroth_continuant_aux_eq_one_zero
            first_continuant_aux_eq_h_one]
      calc
        (b * g.h + a) / b = b * g.h / b + a / b := by ring
        -- requires `field`, not `division_ring`
            _ =
            g.h + a / b :=
          by rw [mul_div_cancel_left _ b_ne_zero]

    case
      succ =>
      obtain ⟨⟨pa, pb⟩, s_n'th_eq⟩ : ∃ gp_n', g.s.nth n' = some gp_n' :=
        g.s.ge_stable n'.le_succ s_nth_eq
      -- Notations
      let g' := squash_gcf g (n' + 1)
      set pred_conts := g.continuants_aux (n' + 1) with succ_n'th_conts_aux_eq
      set ppred_conts := g.continuants_aux n' with n'th_conts_aux_eq
      let pA := pred_conts.a
      let pB := pred_conts.b
      let ppA := ppred_conts.a
      let ppB := ppred_conts.b
      set pred_conts' := g'.continuants_aux (n' + 1) with succ_n'th_conts_aux_eq'
      set ppred_conts' := g'.continuants_aux n' with n'th_conts_aux_eq'
      let pA' := pred_conts'.a
      let pB' := pred_conts'.b
      let ppA' := ppred_conts'.a
      let ppB' := ppred_conts'.b
      -- first compute the convergent of the squashed gcf
      have :
        g'.convergents (n' + 1) =
          ((pb + a / b) * pA' + pa * ppA') / ((pb + a / b) * pB' + pa * ppB') :=
        by
        have : g'.s.nth n' = some ⟨pa, pb + a / b⟩ :=
          squash_seq_nth_of_not_terminated s_n'th_eq s_nth_eq
        rw [convergent_eq_conts_a_div_conts_b,
          continuants_recurrence_aux this n'th_conts_aux_eq'.symm succ_n'th_conts_aux_eq'.symm]
      rw [this]
      -- then compute the convergent of the original gcf by recursively unfolding the continuants
      -- computation twice
      have :
        g.convergents (n' + 2) =
          (b * (pb * pA + pa * ppA) + a * pA) / (b * (pb * pB + pa * ppB) + a * pB) :=
        by
        -- use the recurrence once
        have : g.continuants_aux (n' + 2) = ⟨pb * pA + pa * ppA, pb * pB + pa * ppB⟩ :=
          continuants_aux_recurrence s_n'th_eq n'th_conts_aux_eq.symm succ_n'th_conts_aux_eq.symm
        -- and a second time
        rw [convergent_eq_conts_a_div_conts_b,
          continuants_recurrence_aux s_nth_eq succ_n'th_conts_aux_eq.symm this]
      rw [this]
      suffices
        ((pb + a / b) * pA + pa * ppA) / ((pb + a / b) * pB + pa * ppB) =
          (b * (pb * pA + pa * ppA) + a * pA) / (b * (pb * pB + pa * ppB) + a * pB)
        by
        obtain ⟨eq1, eq2, eq3, eq4⟩ : pA' = pA ∧ pB' = pB ∧ ppA' = ppA ∧ ppB' = ppB := by
          simp [*, (continuants_aux_eq_continuants_aux_squash_gcf_of_le <| le_refl <| n' + 1).symm,
            (continuants_aux_eq_continuants_aux_squash_gcf_of_le n'.le_succ).symm]
        symm
        simpa only [eq1, eq2, eq3, eq4, mul_div_cancel _ b_ne_zero]
      field_simp
      congr 1 <;> ring
#align generalized_continued_fraction.succ_nth_convergent_eq_squash_gcf_nth_convergent GeneralizedContinuedFraction.succ_nth_convergent_eq_squashGcf_nth_convergent

end Squash

/-- Shows that the recurrence relation (`convergents`) and direct evaluation (`convergents'`) of the
gcf coincide at position `n` if the sequence of fractions contains strictly positive values only.
Requiring positivity of all values is just one possible condition to obtain this result.
For example, the dual - sequences with strictly negative values only - would also work.

In practice, one most commonly deals with (regular) continued fractions, which satisfy the
positivity criterion required here. The analogous result for them
(see `continued_fractions.convergents_eq_convergents`) hence follows directly from this theorem.
-/
theorem convergents_eq_convergents' [LinearOrderedField K]
    (s_pos : ∀ {gp : Pair K} {m : ℕ}, m < n → g.s.get? m = some gp → 0 < gp.a ∧ 0 < gp.b) :
    g.convergents n = g.convergents' n :=
  by
  induction' n with n IH generalizing g
  case zero => simp
  case succ =>
    let g' := squash_gcf g n
    -- first replace the rhs with the squashed computation
    suffices g.convergents (n + 1) = g'.convergents' n by
      rwa [succ_nth_convergent'_eq_squash_gcf_nth_convergent']
    cases' Decidable.em (terminated_at g n) with terminated_at_n not_terminated_at_n
    · have g'_eq_g : g' = g := squash_gcf_eq_self_of_terminated terminated_at_n
      rw [convergents_stable_of_terminated n.le_succ terminated_at_n, g'_eq_g, IH _]
      intro _ _ m_lt_n s_mth_eq
      exact s_pos (Nat.lt.step m_lt_n) s_mth_eq
    · suffices g.convergents (n + 1) = g'.convergents n
        by
        -- invoke the IH for the squashed gcf
        rwa [← IH]
        intro gp' m m_lt_n s_mth_eq'
        -- case distinction on m + 1 = n or m + 1 < n
        cases' m_lt_n with n succ_m_lt_n
        · -- the difficult case at the squashed position: we first obtain the values from
          -- the sequence
          obtain ⟨gp_succ_m, s_succ_mth_eq⟩ : ∃ gp_succ_m, g.s.nth (m + 1) = some gp_succ_m
          exact option.ne_none_iff_exists'.mp not_terminated_at_n
          obtain ⟨gp_m, mth_s_eq⟩ : ∃ gp_m, g.s.nth m = some gp_m
          exact g.s.ge_stable m.le_succ s_succ_mth_eq
          -- we then plug them into the recurrence
          suffices 0 < gp_m.a ∧ 0 < gp_m.b + gp_succ_m.a / gp_succ_m.b
            by
            have ot : g'.s.nth m = some ⟨gp_m.a, gp_m.b + gp_succ_m.a / gp_succ_m.b⟩ :=
              squash_seq_nth_of_not_terminated mth_s_eq s_succ_mth_eq
            have : gp' = ⟨gp_m.a, gp_m.b + gp_succ_m.a / gp_succ_m.b⟩ := by cc
            rwa [this]
          refine' ⟨(s_pos (Nat.lt.step m_lt_n) mth_s_eq).left, _⟩
          refine' add_pos (s_pos (Nat.lt.step m_lt_n) mth_s_eq).right _
          have : 0 < gp_succ_m.a ∧ 0 < gp_succ_m.b := s_pos (lt_add_one <| m + 1) s_succ_mth_eq
          exact div_pos this.left this.right
        · -- the easy case: before the squashed position, nothing changes
          refine' s_pos (Nat.lt.step <| Nat.lt.step succ_m_lt_n) _
          exact Eq.trans (squash_gcf_nth_of_lt succ_m_lt_n).symm s_mth_eq'
      -- now the result follows from the fact that the convergents coincide at the squashed position
      -- as established in `succ_nth_convergent_eq_squash_gcf_nth_convergent`.
      have : ∀ ⦃b⦄, g.partial_denominators.nth n = some b → b ≠ 0 :=
        by
        intro b nth_part_denom_eq
        obtain ⟨gp, s_nth_eq, ⟨refl⟩⟩ : ∃ gp, g.s.nth n = some gp ∧ gp.b = b
        exact exists_s_b_of_part_denom nth_part_denom_eq
        exact (ne_of_lt (s_pos (lt_add_one n) s_nth_eq).right).symm
      exact succ_nth_convergent_eq_squash_gcf_nth_convergent this
#align generalized_continued_fraction.convergents_eq_convergents' GeneralizedContinuedFraction.convergents_eq_convergents'

end GeneralizedContinuedFraction

open GeneralizedContinuedFraction

namespace ContinuedFraction

/-- Shows that the recurrence relation (`convergents`) and direct evaluation (`convergents'`) of a
(regular) continued fraction coincide. -/
theorem convergents_eq_convergents' [LinearOrderedField K] {c : ContinuedFraction K} :
    (↑c : GeneralizedContinuedFraction K).convergents =
      (↑c : GeneralizedContinuedFraction K).convergents' :=
  by
  ext n
  apply convergents_eq_convergents'
  intro gp m m_lt_n s_nth_eq
  exact
    ⟨zero_lt_one.trans_le
        ((c : SimpleContinuedFraction K).property m gp.a (part_num_eq_s_a s_nth_eq)).symm.le,
      c.property m gp.b <| part_denom_eq_s_b s_nth_eq⟩
#align continued_fraction.convergents_eq_convergents' ContinuedFraction.convergents_eq_convergents'

end ContinuedFraction


import linear_algebra.multivariate_polynomial
import linear_algebra.tensor_product
import data.polynomial ring_theory.subring

universes u v w u₁ v₁

open lattice

theorem mv_polynomial.C_mul' (R : Type u) [comm_ring R] [decidable_eq R]
  (ι : Type v) [decidable_eq ι] (c : R) (p : mv_polynomial ι R) :
  mv_polynomial.C c * p = c • p :=
begin
  apply finsupp.induction p,
  { exact (mul_zero $ mv_polynomial.C c).trans (@smul_zero R (mv_polynomial ι R) _ _ _ c).symm },
  intros a b f haf hb0 ih,
  rw [mul_add, ih, @smul_add R (mv_polynomial ι R) _ _ _ c], congr' 1,
  rw [finsupp.mul_def, finsupp.smul_single, mv_polynomial.C, mv_polynomial.monomial],
  rw [finsupp.sum_single_index, finsupp.sum_single_index, zero_add, smul_eq_mul],
  { rw [mul_zero, finsupp.single_zero] },
  { rw finsupp.sum_single_index,
    all_goals { rw [zero_mul, finsupp.single_zero] } }
end

structure algebra.core (R : Type u) (A : Type v) [comm_ring R] [comm_ring A] :=
(to_fun : R → A) [hom : is_ring_hom to_fun]

structure algebra (R : Type u) (A : Type v) [comm_ring R] [comm_ring A] extends module R A :=
(to_fun : R → A) [hom : is_ring_hom to_fun]
(smul_def' : ∀ r x, r • x = to_fun r * x)

attribute [instance] algebra.hom

namespace algebra

variables (R : Type u) (S : Type v) (A : Type w)
variables [comm_ring R] [comm_ring S] [comm_ring A]

instance : has_coe_to_fun (algebra R A) :=
⟨_, to_fun⟩

variables {R S A} (i : algebra R A)

@[simp] lemma map_add (r s : R) : i (r + s) = i r + i s :=
is_ring_hom.map_add _

@[simp] lemma map_zero : i (0 : R) = 0 :=
is_ring_hom.map_zero _

@[simp] lemma map_neg (r : R) : i (-r) = -i r :=
is_ring_hom.map_neg _

@[simp] lemma map_sub (r s : R) : i (r - s) = i r - i s :=
is_ring_hom.map_sub _

@[simp] lemma map_mul (r s : R) : i (r * s) = i r * i s :=
is_ring_hom.map_mul _

@[simp] lemma map_one : i (1 : R) = 1 :=
is_ring_hom.map_one _

def of_core (i : algebra.core R A) : algebra R A :=
{ smul := λ c x, i.to_fun c * x,
  smul_zero := λ x, mul_zero (i.to_fun x),
  smul_add := λ r x y, mul_add (i.to_fun r) x y,
  add_smul := λ r s x, show i.to_fun (r + s) * x = _, by rw [i.hom.3, add_mul],
  mul_smul := λ r s x, show i.to_fun (r * s) * x = _, by rw [i.hom.2, mul_assoc],
  one_smul := λ x, show i.to_fun 1 * x = _, by rw [i.hom.1, one_mul],
  zero_smul := λ x, show i.to_fun 0 * x = _, by rw [@@is_ring_hom.map_zero _ _ i.to_fun i.hom, zero_mul],
  smul_def' := λ c x, rfl,
  .. i }

def mod (i : algebra R A) : Type w := A

namespace mod
instance : comm_ring (mod i) := _inst_3
instance : monoid (mod i) := infer_instance
instance : add_comm_group (mod i) := infer_instance
instance : module R (mod i) := i.to_module
instance : has_scalar R (mod i) := infer_instance

instance {F : Type u} {K : Type v}
  [discrete_field F] [comm_ring K] (i : algebra F K) :
  vector_space F (mod i) :=
{ .. algebra.mod.module i }
end mod

theorem smul_def (r : R) (x : mod i) : r • x = i r * x :=
smul_def' i r x

@[simp] protected lemma mul_smul (s : R) (x y : mod i) :
  x * (has_scalar.smul.{u w} s y) = has_scalar.smul.{u w} s (x * y) :=
by rw [smul_def, smul_def, mul_left_comm _ _ _]

@[simp] lemma smul_mul (r : R) (x y : mod i) :
  (r • x) * y = has_scalar.smul.{u w} r (x * y) :=
by rw [smul_def, smul_def, mul_assoc _ _ _]

def polynomial (R : Type u) [comm_ring R] [decidable_eq R] : algebra R (polynomial R) :=
{ to_fun := polynomial.C,
  smul_def' := λ c p, (polynomial.C_mul' c p).symm,
  .. polynomial.module }

def mv_polynomial (R : Type u) [comm_ring R] [decidable_eq R]
  (ι : Type v) [decidable_eq ι] : algebra R (mv_polynomial ι R) :=
{ to_fun := mv_polynomial.C,
  smul_def' := λ c p, (mv_polynomial.C_mul' R ι c p).symm,
  .. mv_polynomial.module }

def of_subring (S : set R) [is_subring S] : algebra S R :=
of_core { to_fun := subtype.val,
  hom := ⟨rfl, λ _ _, rfl, λ _ _, rfl⟩ }

def lmul : i.mod →ₗ i.mod →ₗ i.mod :=
linear_map.mk₂ (*)
  (λ x y z, add_mul x y z)
  (λ c x y, by rw [smul_def, smul_def, mul_assoc _ x y])
  (λ x y z, mul_add x y z)
  (λ c x y, by rw [smul_def, smul_def, mul_left_comm x _ y])

set_option class.instance_max_depth 37
def lmul_left (r : i.mod) : i.mod →ₗ i.mod :=
i.lmul r

def lmul_right (r : i.mod) : i.mod →ₗ i.mod :=
i.lmul.flip r

@[simp] lemma lmul_apply (p q : i.mod) : i.lmul p q = p * q := rfl
@[simp] lemma lmul_left_apply (p q : i.mod) : i.lmul_left p q = p * q := rfl
@[simp] lemma lmul_right_apply (p q : i.mod) : i.lmul_right p q = q * p := rfl

set_option class.instance_max_depth 32

@[simp] lemma map_zero' : (i (0 : R) : i.mod) = 0 := i.map_zero
@[simp] lemma map_one' : (i (1 : R) : i.mod) = 1 := i.map_one

end algebra

structure alg_hom {R : Type u} {A : Type v} {B : Type w}
  [comm_ring R] [comm_ring A] [comm_ring B]
  (iA : algebra R A) (iB : algebra R B) :=
(to_fun : A → B) [hom : is_ring_hom to_fun]
(commutes' : ∀ r : R, to_fun (iA r) = iB r)

infixr ` →ₐ `:25 := alg_hom

namespace alg_hom

variables {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁}
variables [comm_ring R] [comm_ring A] [comm_ring B] [comm_ring C] [comm_ring D]
variables (iA : algebra R A) (iB : algebra R B) (iC : algebra R C) (iD : algebra R D)
include R

instance : has_coe_to_fun (iA →ₐ iB) := ⟨λ _, A → B, to_fun⟩

variables {iA iB iC iD} (φ : iA →ₐ iB)

instance : is_ring_hom ⇑φ := hom φ

@[extensionality]
theorem ext {φ₁ φ₂ : iA →ₐ iB} (H : ∀ x, φ₁ x = φ₂ x) : φ₁ = φ₂ :=
by cases φ₁; cases φ₂; congr' 1; ext; apply H

theorem commutes (r) : φ (iA r) = iB r := φ.commutes' r

@[simp] lemma map_add (r s : A) : φ (r + s) = φ r + φ s :=
is_ring_hom.map_add _

@[simp] lemma map_zero : φ (0 : A) = 0 :=
is_ring_hom.map_zero _

@[simp] lemma map_neg (r : A) : φ (-r) = -φ r :=
is_ring_hom.map_neg _

@[simp] lemma map_sub (r s : A) : φ (r - s) = φ r - φ s :=
is_ring_hom.map_sub _

@[simp] lemma map_mul (r s : A) : φ (r * s) = φ r * φ s :=
is_ring_hom.map_mul _

@[simp] lemma map_one : φ (1 : A) = 1 :=
is_ring_hom.map_one _

@[simp] lemma map_add' (r s : iA.mod) : φ (r + s) = φ r + φ s :=
is_ring_hom.map_add _

@[simp] lemma map_zero' : φ (0 : iA.mod) = 0 :=
is_ring_hom.map_zero _

@[simp] lemma map_neg' (r : iA.mod) : φ (-r) = -φ r :=
is_ring_hom.map_neg _

@[simp] lemma map_sub' (r s : iA.mod) : φ (r - s) = φ r - φ s :=
is_ring_hom.map_sub _

@[simp] lemma map_mul' (r s : iA.mod) : φ (r * s) = φ r * φ s :=
is_ring_hom.map_mul _

@[simp] lemma map_one' : φ (1 : iA.mod) = 1 :=
is_ring_hom.map_one _

def to_linear_map : iA.mod →ₗ iB.mod :=
{ to_fun := φ,
  add := φ.map_add,
  smul := λ c x, by rw [algebra.smul_def, φ.map_mul, φ.commutes c, algebra.smul_def] }

@[simp] lemma to_linear_map_apply (p : A) : φ.to_linear_map p = φ p := rfl

theorem to_linear_map_inj {φ₁ φ₂ : iA →ₐ iB} (H : φ₁.to_linear_map = φ₂.to_linear_map) : φ₁ = φ₂ :=
ext $ λ x, show φ₁.to_linear_map x = φ₂.to_linear_map x, by rw H

variable (iA)
protected def id : iA →ₐ iA :=
{ to_fun := id, commutes' := λ _, rfl }
variable {iA}

@[simp] lemma id_apply (p : A) : alg_hom.id iA p = p := rfl

def comp (φ₁ : iB →ₐ iC) (φ₂ : iA →ₐ iB) : iA →ₐ iC :=
{ to_fun := φ₁ ∘ φ₂,
  commutes' := λ r, by rw [function.comp_apply, φ₂.commutes, φ₁.commutes] }

@[simp] lemma comp_apply (φ₁ : iB →ₐ iC) (φ₂ : iA →ₐ iB) (p : A) :
  φ₁.comp φ₂ p = φ₁ (φ₂ p) := rfl

theorem comp_id : φ.comp (alg_hom.id iA) = φ :=
ext $ λ x, rfl

theorem id_comp : (alg_hom.id iB).comp φ = φ :=
ext $ λ x, rfl

theorem comp_assoc (φ₁ : iC →ₐ iD) (φ₂ : iB →ₐ iC) (φ₃ : iA →ₐ iB) :
  (φ₁.comp φ₂).comp φ₃ = φ₁.comp (φ₂.comp φ₃) :=
ext $ λ x, rfl

end alg_hom

namespace algebra

variables {R : Type u} {S : Type v} {A : Type w}
variables [comm_ring R] [comm_ring S] [comm_ring A]
variables (iRS : algebra R S) (iSA : algebra S A)

def comap : algebra R A :=
of_core { to_fun := iSA ∘ iRS }

def to_comap : iRS →ₐ (iRS.comap iSA) :=
{ to_fun := iSA,
  commutes' := λ r, rfl }

theorem to_comap_apply (x) : iRS.to_comap iSA x = iSA x := rfl

end algebra

namespace polynomial

variables (R : Type u) {A : Type v}
variables [comm_ring R] [comm_ring A] (i : algebra R A)
variables [decidable_eq R] (x : A)

def aeval : (algebra.polynomial R) →ₐ i :=
{ to_fun := eval₂ i x,
  hom := ⟨eval₂_one _ x, λ _ _, eval₂_mul _ x, λ _ _, eval₂_add _ x⟩,
  commutes' := λ r, eval₂_C _ _ }

theorem aeval_def (p : polynomial R) : aeval R i x p = eval₂ i x p :=
rfl

instance aeval.is_ring_hom : is_ring_hom (aeval R i x) :=
alg_hom.hom _

theorem eval_unique (φ : algebra.polynomial R →ₐ i) (p) :
  φ p = eval₂ i (φ X) p :=
begin
  apply polynomial.induction_on p,
  { intro r, rw eval₂_C, exact φ.commutes r },
  { intros f g ih1 ih2,
    rw [is_ring_hom.map_add φ, ih1, ih2, eval₂_add] },
  { intros n r ih,
    rw [pow_succ', ← mul_assoc, is_ring_hom.map_mul φ, eval₂_mul, eval₂_X, ih] }
end

end polynomial

namespace mv_polynomial

variables (R : Type u) (A : Type v)
variables [comm_ring R] [comm_ring A] (i : algebra R A)
variables [decidable_eq R] [decidable_eq A] (σ : set A)

def aeval : (algebra.mv_polynomial R σ) →ₐ i :=
{ to_fun := eval₂ i subtype.val,
  hom := ⟨eval₂_one _ _, λ _ _, eval₂_mul _ _, λ _ _, eval₂_add _ _⟩,
  commutes' := λ r, eval₂_C _ _ _ }

theorem aeval_def (p : mv_polynomial σ R) : aeval R A i σ p = eval₂ i subtype.val p :=
rfl

instance aeval.is_ring_hom : is_ring_hom (aeval R A i σ) :=
alg_hom.hom _

variables (ι : Type w) [decidable_eq ι]

theorem eval_unique (φ : algebra.mv_polynomial R ι →ₐ i) (p) :
  φ p = eval₂ i (φ ∘ X) p :=
begin
  apply mv_polynomial.induction_on p,
  { intro r, rw eval₂_C, exact φ.commutes r },
  { intros f g ih1 ih2,
    rw [is_ring_hom.map_add φ, ih1, ih2, eval₂_add] },
  { intros p j ih,
    rw [is_ring_hom.map_mul φ, eval₂_mul, eval₂_X, ih] }
end

end mv_polynomial

section

variables (R : Type*) [comm_ring R]

def ring.to_ℤ_algebra : algebra ℤ R := algebra.of_core
{ to_fun := coe,
  hom := by constructor; intros; simp }

def is_ring_hom.to_ℤ_alg_hom
  (R : Type u) [comm_ring R] (iR : algebra ℤ R)
  (S : Type v) [comm_ring S] (iS : algebra ℤ S)
  (f : R → S) [is_ring_hom f] : iR →ₐ iS :=
{ to_fun := f, hom := by apply_instance,
  commutes' := λ i, int.induction_on i (by rw [iR.map_zero, iS.map_zero, is_ring_hom.map_zero f])
      (λ i ih, by rw [iR.map_add, iS.map_add, iR.map_one, iS.map_one];
        rw [is_ring_hom.map_add f, is_ring_hom.map_one f, ih])
      (λ i ih, by rw [iR.map_sub, iS.map_sub, iR.map_one, iS.map_one];
        rw [is_ring_hom.map_sub f, is_ring_hom.map_one f, ih]) }

instance : ring (polynomial ℤ) :=
comm_ring.to_ring _

instance int.cast_hom : is_ring_hom (coe : ℤ → R) :=
⟨int.cast_one, int.cast_mul, int.cast_add⟩

end

structure subalgebra {R : Type u} {A : Type v}
  [comm_ring R] [comm_ring A] (i : algebra R A) : Type v :=
(carrier : set A) [subring : is_subring carrier]
(range_le : set.range i ≤ carrier)

attribute [instance] subalgebra.subring

namespace subalgebra

variables {R : Type u} {A : Type v}
variables [comm_ring R] [comm_ring A] (i : algebra R A)

instance : has_coe (subalgebra i) (set A) :=
⟨λ S, S.carrier⟩

instance : has_mem A (subalgebra i) :=
⟨λ x S, x ∈ S.carrier⟩

variables {i}

theorem mem_coe {x : A} {s : subalgebra i} : x ∈ (s : set A) ↔ x ∈ s :=
iff.rfl

@[extensionality] theorem ext {S T : subalgebra i}
  (h : ∀ x : A, x ∈ S ↔ x ∈ T) : S = T :=
by cases S; cases T; congr; ext x; exact h x

variables (S : subalgebra i)

instance : is_subring (S : set A) := S.subring

instance : comm_ring S := @@subtype.comm_ring _ S.is_subring

protected def algebra : algebra R S :=
{ smul := λ (c:R) x, ⟨@has_scalar.smul R A i.to_module.to_has_scalar c x.1,
    by rw i.smul_def; exact @@is_submonoid.mul_mem _ S.2.2 (S.3 ⟨c, rfl⟩) x.2⟩,
  smul_add := λ c x y, subtype.eq $ by apply i.1.1.2,
  add_smul := λ c x y, subtype.eq $ by apply i.1.1.3,
  mul_smul := λ c x y, subtype.eq $ by apply i.1.1.4,
  one_smul := λ x, subtype.eq $ by apply i.1.1.5,
  zero_smul := λ x, subtype.eq $ by apply i.1.1.6,
  smul_zero := λ x, subtype.eq $ by apply i.1.1.7,
  to_fun := λ r, ⟨i r, S.range_le ⟨r, rfl⟩⟩,
  hom := ⟨subtype.eq i.map_one, λ x y, subtype.eq $ i.map_mul x y,
    λ x y, subtype.eq $ i.map_add x y⟩,
  smul_def' := λ c x, subtype.eq $ by apply i.4 }

def val : S.algebra →ₐ i :=
{ to_fun := subtype.val,
  hom := ⟨rfl, λ _ _, rfl, λ _ _, rfl⟩,
  commutes' := λ r, rfl }

def to_submodule : submodule R i.mod :=
{ carrier := S.carrier,
  zero := (0:S).2,
  add := λ x y hx hy, (⟨x, hx⟩ + ⟨y, hy⟩ : S).2,
  smul := λ c x hx, (i.smul_def c x).symm ▸ (⟨i c, S.range_le ⟨c, rfl⟩⟩ * ⟨x, hx⟩:S).2 }

instance to_submodule.is_subring : is_subring (S.to_submodule : set i.mod) := S.2

instance : partial_order (subalgebra i) :=
{ le := λ S T, S.carrier ≤ T.carrier,
  le_refl := λ _, le_refl _,
  le_trans := λ _ _ _, le_trans,
  le_antisymm := λ S T hst hts, ext $ λ x, ⟨@hst x, @hts x⟩ }

def comap {R : Type u} {S : Type v} {A : Type w}
  [comm_ring R] [comm_ring S] [comm_ring A]
  (iRS : algebra R S) {iSA : algebra S A}
  (iSB : subalgebra iSA) : subalgebra (iRS.comap iSA) :=
{ carrier := iSB,
  range_le := λ a ⟨r, hr⟩, hr ▸ iSB.range_le ⟨_, rfl⟩ }

def under {R : Type u} {A : Type v} [comm_ring R] [comm_ring A]
  {i : algebra R A} (S : subalgebra i)
  (T : subalgebra (algebra.of_subring (S : set A))) : subalgebra i :=
{ carrier := T,
  range_le := λ a ⟨r, hr⟩, hr ▸ T.range_le ⟨⟨i r, S.range_le ⟨r, rfl⟩⟩, rfl⟩ }

end subalgebra

namespace alg_hom

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_ring R] [comm_ring A] [comm_ring B]
variables {iA : algebra R A} {iB : algebra R B}
variables (φ : iA →ₐ iB)

protected def range : subalgebra iB :=
{ carrier := set.range φ,
  subring :=
  { one_mem := ⟨1, φ.map_one⟩,
    mul_mem := λ y₁ y₂ ⟨x₁, hx₁⟩ ⟨x₂, hx₂⟩, ⟨x₁ * x₂, hx₁ ▸ hx₂ ▸ φ.map_mul x₁ x₂⟩ },
  range_le := λ y ⟨r, hr⟩, ⟨iA r, hr ▸ φ.commutes r⟩ }

end alg_hom

namespace algebra

variables {R : Type u} {A : Type v}
variables [comm_ring R] [comm_ring A] (i : algebra R A)

variables (R)
protected def id : algebra R R := algebra.of_core
{ to_fun := id }
variables {R}

def of_id : algebra.id R →ₐ i :=
{ to_fun := i, commutes' := λ _, rfl }

theorem of_id_apply (r) : i.of_id r = i r := rfl

def adjoin (s : set A) : subalgebra i :=
{ carrier := ring.closure (set.range i ∪ s),
  range_le := le_trans (set.subset_union_left _ _) ring.subset_closure }

protected def gc : galois_connection i.adjoin coe :=
λ s S, ⟨λ H, le_trans (le_trans (set.subset_union_right _ _) ring.subset_closure) H,
λ H, ring.closure_subset $ set.union_subset S.range_le H⟩

protected def gi : galois_insertion i.adjoin coe :=
{ choice := λ s hs, i.adjoin s,
  gc := i.gc,
  le_l_u := λ S, (i.gc S (i.adjoin S)).1 (le_refl _),
  choice_eq := λ _ _, rfl }

instance : complete_lattice (subalgebra i) :=
galois_insertion.lift_complete_lattice i.gi

theorem mem_bot {x : A} : x ∈ (⊥ : subalgebra i) ↔ x ∈ set.range i :=
suffices (⊥ : subalgebra i) = i.of_id.range, by rw this; refl,
le_antisymm bot_le $ subalgebra.range_le _

theorem mem_top {x : A} : x ∈ (⊤ : subalgebra i) :=
ring.mem_closure $ or.inr trivial

def to_top : i →ₐ (⊤ : subalgebra i).algebra :=
{ to_fun := λ x, ⟨x, i.mem_top⟩,
  hom := ⟨rfl, λ _ _, rfl, λ _ _, rfl⟩,
  commutes' := λ _, rfl }

end algebra


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

! This file was ported from Lean 3 source module group_theory.group_action.embedding
! leanprover-community/mathlib commit a437a2499163d85d670479f69f625f461cc5fef9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.GroupAction.Group
import Mathlib.GroupTheory.GroupAction.Pi

/-!
# Group actions on embeddings

This file provides a `MulAction G (α ↪ β)` instance that agrees with the `MulAction G (α → β)`
instances defined by `Pi.mulAction`.

Note that unlike the `Pi` instance, this requires `G` to be a group.
-/

universe u v w

variable {G G' α β : Type _}

namespace Function.Embedding

@[to_additive]
instance smul [Group G] [MulAction G β] : SMul G (α ↪ β) :=
  ⟨fun g f => f.trans (MulAction.toPerm g).toEmbedding⟩

@[to_additive]
theorem smul_def [Group G] [MulAction G β] (g : G) (f : α ↪ β) :
    g • f = f.trans (MulAction.toPerm g).toEmbedding :=
  rfl
#align function.embedding.smul_def Function.Embedding.smul_def
#align function.embedding.vadd_def Function.Embedding.vadd_def

@[to_additive (attr := simp)]
theorem smul_apply [Group G] [MulAction G β] (g : G) (f : α ↪ β) (a : α) : (g • f) a = g • f a :=
  rfl
#align function.embedding.smul_apply Function.Embedding.smul_apply
#align function.embedding.vadd_apply Function.Embedding.vadd_apply

@[to_additive]
theorem coe_smul [Group G] [MulAction G β] (g : G) (f : α ↪ β) : ⇑(g • f) = g • ⇑f :=
  rfl
#align function.embedding.coe_smul Function.Embedding.coe_smul
#align function.embedding.coe_vadd Function.Embedding.coe_vadd

instance [Group G] [Group G'] [SMul G G'] [MulAction G β] [MulAction G' β]
    [IsScalarTower G G' β] : IsScalarTower G G' (α ↪ β) :=
  ⟨fun x y z => Function.Embedding.ext fun i => smul_assoc x y (z i)⟩

@[to_additive]
instance [Group G] [Group G'] [MulAction G β] [MulAction G' β] [SMulCommClass G G' β] :
    SMulCommClass G G' (α ↪ β) :=
  ⟨fun x y z => Function.Embedding.ext fun i => smul_comm x y (z i)⟩

instance [Group G] [MulAction G β] [MulAction Gᵐᵒᵖ β] [IsCentralScalar G β] :
    IsCentralScalar G (α ↪ β) :=
  ⟨fun _ _ => Function.Embedding.ext fun _ => op_smul_eq_smul _ _⟩

@[to_additive]
instance [Group G] [MulAction G β] : MulAction G (α ↪ β) :=
  FunLike.coe_injective.mulAction _ coe_smul

end Function.Embedding


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.function.conjugate
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Iterations of a function

In this file we prove simple properties of `nat.iterate f n` a.k.a. `f^[n]`:

* `iterate_zero`, `iterate_succ`, `iterate_succ'`, `iterate_add`, `iterate_mul`:
  formulas for `f^[0]`, `f^[n+1]` (two versions), `f^[n+m]`, and `f^[n*m]`;

* `iterate_id` : `id^[n]=id`;

* `injective.iterate`, `surjective.iterate`, `bijective.iterate` :
  iterates of an injective/surjective/bijective function belong to the same class;

* `left_inverse.iterate`, `right_inverse.iterate`, `commute.iterate_left`, `comute.iterate_right`,
  `commute.iterate_iterate`:
  some properties of pairs of functions survive under iterations

* `iterate_fixed`, `semiconj.iterate_*`, `semiconj₂.iterate`:
  if `f` fixes a point (resp., semiconjugates unary/binary operarations), then so does `f^[n]`.

-/

namespace function

@[simp] theorem iterate_zero {α : Type u} (f : α → α) : nat.iterate f 0 = id := rfl

theorem iterate_zero_apply {α : Type u} (f : α → α) (x : α) : nat.iterate f 0 x = x := rfl

@[simp] theorem iterate_succ {α : Type u} (f : α → α) (n : ℕ) :
    nat.iterate f (Nat.succ n) = nat.iterate f n ∘ f :=
  rfl

theorem iterate_succ_apply {α : Type u} (f : α → α) (n : ℕ) (x : α) :
    nat.iterate f (Nat.succ n) x = nat.iterate f n (f x) :=
  rfl

@[simp] theorem iterate_id {α : Type u} (n : ℕ) : nat.iterate id n = id := sorry

theorem iterate_add {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) :
    nat.iterate f (m + n) = nat.iterate f m ∘ nat.iterate f n :=
  sorry

theorem iterate_add_apply {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) (x : α) :
    nat.iterate f (m + n) x = nat.iterate f m (nat.iterate f n x) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (nat.iterate f (m + n) x = nat.iterate f m (nat.iterate f n x)))
        (iterate_add f m n)))
    (Eq.refl (comp (nat.iterate f m) (nat.iterate f n) x))

@[simp] theorem iterate_one {α : Type u} (f : α → α) : nat.iterate f 1 = f :=
  funext fun (a : α) => rfl

theorem iterate_mul {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) :
    nat.iterate f (m * n) = nat.iterate (nat.iterate f m) n :=
  sorry

theorem iterate_fixed {α : Type u} {f : α → α} {x : α} (h : f x = x) (n : ℕ) :
    nat.iterate f n x = x :=
  sorry

theorem injective.iterate {α : Type u} {f : α → α} (Hinj : injective f) (n : ℕ) :
    injective (nat.iterate f n) :=
  nat.rec_on n injective_id
    fun (n : ℕ) (ihn : injective (nat.iterate f n)) => injective.comp ihn Hinj

theorem surjective.iterate {α : Type u} {f : α → α} (Hsurj : surjective f) (n : ℕ) :
    surjective (nat.iterate f n) :=
  nat.rec_on n surjective_id
    fun (n : ℕ) (ihn : surjective (nat.iterate f n)) => surjective.comp ihn Hsurj

theorem bijective.iterate {α : Type u} {f : α → α} (Hbij : bijective f) (n : ℕ) :
    bijective (nat.iterate f n) :=
  { left := injective.iterate (and.left Hbij) n, right := surjective.iterate (and.right Hbij) n }

namespace semiconj

theorem iterate_right {α : Type u} {β : Type v} {f : α → β} {ga : α → α} {gb : β → β}
    (h : semiconj f ga gb) (n : ℕ) : semiconj f (nat.iterate ga n) (nat.iterate gb n) :=
  nat.rec_on n id_right
    fun (n : ℕ) (ihn : semiconj f (nat.iterate ga n) (nat.iterate gb n)) => comp_right ihn h

theorem iterate_left {α : Type u} {f : α → α} {g : ℕ → α → α}
    (H : ∀ (n : ℕ), semiconj f (g n) (g (n + 1))) (n : ℕ) (k : ℕ) :
    semiconj (nat.iterate f n) (g k) (g (n + k)) :=
  sorry

end semiconj

namespace commute

theorem iterate_right {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) :
    commute f (nat.iterate g n) :=
  semiconj.iterate_right h n

theorem iterate_left {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) :
    commute (nat.iterate f n) g :=
  symm (iterate_right (symm h) n)

theorem iterate_iterate {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (m : ℕ) (n : ℕ) :
    commute (nat.iterate f m) (nat.iterate g n) :=
  iterate_right (iterate_left h m) n

theorem iterate_eq_of_map_eq {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) {x : α}
    (hx : f x = g x) : nat.iterate f n x = nat.iterate g n x :=
  sorry

theorem comp_iterate {α : Type u} {f : α → α} {g : α → α} (h : commute f g) (n : ℕ) :
    nat.iterate (f ∘ g) n = nat.iterate f n ∘ nat.iterate g n :=
  sorry

theorem iterate_self {α : Type u} (f : α → α) (n : ℕ) : commute (nat.iterate f n) f :=
  iterate_left (refl f) n

theorem self_iterate {α : Type u} (f : α → α) (n : ℕ) : commute f (nat.iterate f n) :=
  iterate_right (refl f) n

theorem iterate_iterate_self {α : Type u} (f : α → α) (m : ℕ) (n : ℕ) :
    commute (nat.iterate f m) (nat.iterate f n) :=
  iterate_iterate (refl f) m n

end commute

theorem semiconj₂.iterate {α : Type u} {f : α → α} {op : α → α → α} (hf : semiconj₂ f op op)
    (n : ℕ) : semiconj₂ (nat.iterate f n) op op :=
  nat.rec_on n (semiconj₂.id_left op)
    fun (n : ℕ) (ihn : semiconj₂ (nat.iterate f n) op op) => semiconj₂.comp ihn hf

theorem iterate_succ' {α : Type u} (f : α → α) (n : ℕ) :
    nat.iterate f (Nat.succ n) = f ∘ nat.iterate f n :=
  sorry

theorem iterate_succ_apply' {α : Type u} (f : α → α) (n : ℕ) (x : α) :
    nat.iterate f (Nat.succ n) x = f (nat.iterate f n x) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (nat.iterate f (Nat.succ n) x = f (nat.iterate f n x)))
        (iterate_succ' f n)))
    (Eq.refl (comp f (nat.iterate f n) x))

theorem iterate_pred_comp_of_pos {α : Type u} (f : α → α) {n : ℕ} (hn : 0 < n) :
    nat.iterate f (Nat.pred n) ∘ f = nat.iterate f n :=
  sorry

theorem comp_iterate_pred_of_pos {α : Type u} (f : α → α) {n : ℕ} (hn : 0 < n) :
    f ∘ nat.iterate f (Nat.pred n) = nat.iterate f n :=
  sorry

theorem left_inverse.iterate {α : Type u} {f : α → α} {g : α → α} (hg : left_inverse g f) (n : ℕ) :
    left_inverse (nat.iterate g n) (nat.iterate f n) :=
  sorry

theorem right_inverse.iterate {α : Type u} {f : α → α} {g : α → α} (hg : right_inverse g f)
    (n : ℕ) : right_inverse (nat.iterate g n) (nat.iterate f n) :=
  left_inverse.iterate hg n

end Mathlib