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

/-!
# Reverse of a univariate polynomial

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

The main definition is `reverse`.  Applying `reverse` to a polynomial `f : R[X]` produces
the polynomial with a reversed list of coefficients, equivalent to `X^f.nat_degree * f(1/X)`.

The main result is that `reverse (f * g) = reverse f * reverse g`, provided the leading
coefficients of `f` and `g` do not multiply to zero.
-/

namespace polynomial

open polynomial finsupp finset
open_locale classical polynomial

section semiring

variables {R : Type*} [semiring R] {f : R[X]}

/-- If `i ≤ N`, then `rev_at_fun N i` returns `N - i`, otherwise it returns `i`.
This is the map used by the embedding `rev_at`.
-/
def rev_at_fun (N i : ℕ) : ℕ := ite (i ≤ N) (N-i) i

lemma rev_at_fun_invol {N i : ℕ} : rev_at_fun N (rev_at_fun N i) = i :=
begin
  unfold rev_at_fun,
  split_ifs with h j,
  { exact tsub_tsub_cancel_of_le h, },
  { exfalso,
    apply j,
    exact nat.sub_le N i, },
  { refl, },
end

lemma rev_at_fun_inj {N : ℕ} : function.injective (rev_at_fun N) :=
begin
  intros a b hab,
  rw [← @rev_at_fun_invol N a, hab, rev_at_fun_invol],
end

/-- If `i ≤ N`, then `rev_at N i` returns `N - i`, otherwise it returns `i`.
Essentially, this embedding is only used for `i ≤ N`.
The advantage of `rev_at N i` over `N - i` is that `rev_at` is an involution.
-/
def rev_at (N : ℕ) : function.embedding ℕ ℕ :=
{ to_fun := λ i , (ite (i ≤ N) (N-i) i),
  inj' := rev_at_fun_inj }

/-- We prefer to use the bundled `rev_at` over unbundled `rev_at_fun`. -/
@[simp] lemma rev_at_fun_eq (N i : ℕ) : rev_at_fun N i = rev_at N i := rfl

@[simp] lemma rev_at_invol {N i : ℕ} : (rev_at N) (rev_at N i) = i :=
rev_at_fun_invol

@[simp] lemma rev_at_le {N i : ℕ} (H : i ≤ N) : rev_at N i = N - i :=
if_pos H

lemma rev_at_add {N O n o : ℕ} (hn : n ≤ N) (ho : o ≤ O) :
  rev_at (N + O) (n + o) = rev_at N n + rev_at O o :=
begin
  rcases nat.le.dest hn with ⟨n', rfl⟩,
  rcases nat.le.dest ho with ⟨o', rfl⟩,
  repeat { rw rev_at_le (le_add_right rfl.le) },
  rw [add_assoc, add_left_comm n' o, ← add_assoc, rev_at_le (le_add_right rfl.le)],
  repeat {rw add_tsub_cancel_left},
end

@[simp] lemma rev_at_zero (N : ℕ) : rev_at N 0 = N :=
by simp [rev_at]

/-- `reflect N f` is the polynomial such that `(reflect N f).coeff i = f.coeff (rev_at N i)`.
In other words, the terms with exponent `[0, ..., N]` now have exponent `[N, ..., 0]`.

In practice, `reflect` is only used when `N` is at least as large as the degree of `f`.

Eventually, it will be used with `N` exactly equal to the degree of `f`.  -/
noncomputable def reflect (N : ℕ) : R[X] → R[X]
| ⟨f⟩ := ⟨finsupp.emb_domain (rev_at N) f⟩

lemma reflect_support (N : ℕ) (f : R[X]) :
  (reflect N f).support = finset.image (rev_at N) f.support :=
begin
  rcases f,
  ext1,
  simp only [reflect, support_of_finsupp, support_emb_domain, finset.mem_map, finset.mem_image],
end

@[simp] lemma coeff_reflect (N : ℕ) (f : R[X]) (i : ℕ) :
  coeff (reflect N f) i = f.coeff (rev_at N i) :=
begin
  rcases f,
  simp only [reflect, coeff],
  calc finsupp.emb_domain (rev_at N) f i
      = finsupp.emb_domain (rev_at N) f (rev_at N (rev_at N i)) : by rw rev_at_invol
  ... = f (rev_at N i) : finsupp.emb_domain_apply _ _ _
end

@[simp] lemma reflect_zero {N : ℕ} : reflect N (0 : R[X]) = 0 := rfl

@[simp] lemma reflect_eq_zero_iff {N : ℕ} {f : R[X]} :
  reflect N (f : R[X]) = 0 ↔ f = 0 :=
by { rcases f, simp [reflect] }

@[simp] lemma reflect_add (f g : R[X]) (N : ℕ) :
  reflect N (f + g) = reflect N f + reflect N g :=
by { ext, simp only [coeff_add, coeff_reflect], }

@[simp] lemma reflect_C_mul (f : R[X]) (r : R) (N : ℕ) :
  reflect N (C r * f) = C r * (reflect N f) :=
by { ext, simp only [coeff_reflect, coeff_C_mul], }

@[simp] lemma reflect_C_mul_X_pow (N n : ℕ) {c : R} :
  reflect N (C c * X ^ n) = C c * X ^ (rev_at N n) :=
begin
  ext,
  rw [reflect_C_mul, coeff_C_mul, coeff_C_mul, coeff_X_pow, coeff_reflect],
  split_ifs with h j,
  { rw [h, rev_at_invol, coeff_X_pow_self], },
  { rw [not_mem_support_iff.mp],
    intro a,
    rw [← one_mul (X ^ n), ← C_1] at a,
    apply h,
    rw [← (mem_support_C_mul_X_pow a), rev_at_invol], },
end

@[simp] lemma reflect_C (r : R) (N : ℕ) : reflect N (C r) = C r * X ^ N :=
by conv_lhs { rw [← mul_one (C r), ← pow_zero X, reflect_C_mul_X_pow, rev_at_zero] }

@[simp] lemma reflect_monomial (N n : ℕ) : reflect N ((X : R[X]) ^ n) = X ^ (rev_at N n) :=
by rw [← one_mul (X ^ n), ← one_mul (X ^ (rev_at N n)), ← C_1, reflect_C_mul_X_pow]

lemma reflect_mul_induction (cf cg : ℕ) :
  ∀ N O : ℕ, ∀ f g : R[X],
  f.support.card ≤ cf.succ → g.support.card ≤ cg.succ → f.nat_degree ≤ N → g.nat_degree ≤ O →
  (reflect (N + O) (f * g)) = (reflect N f) * (reflect O g) :=
begin
  induction cf with cf hcf,
  --first induction (left): base case
  { induction cg with cg hcg,
    -- second induction (right): base case
    { intros N O f g Cf Cg Nf Og,
      rw [← C_mul_X_pow_eq_self Cf, ← C_mul_X_pow_eq_self Cg],
      simp_rw [mul_assoc, X_pow_mul, mul_assoc, ← pow_add (X : R[X]), reflect_C_mul,
        reflect_monomial, add_comm, rev_at_add Nf Og, mul_assoc, X_pow_mul, mul_assoc,
        ← pow_add (X : R[X]), add_comm], },
    -- second induction (right): induction step
    { intros N O f g Cf Cg Nf Og,
      by_cases g0 : g = 0,
      { rw [g0, reflect_zero, mul_zero, mul_zero, reflect_zero], },

      rw [← erase_lead_add_C_mul_X_pow g, mul_add, reflect_add, reflect_add, mul_add, hcg, hcg];
        try { assumption },
      { exact le_add_left card_support_C_mul_X_pow_le_one },
      { exact (le_trans (nat_degree_C_mul_X_pow_le g.leading_coeff g.nat_degree) Og) },
      { exact nat.lt_succ_iff.mp (gt_of_ge_of_gt Cg (erase_lead_support_card_lt g0)) },
      { exact le_trans erase_lead_nat_degree_le_aux Og } } },
  --first induction (left): induction step
  { intros N O f g Cf Cg Nf Og,
    by_cases f0 : f = 0,
    { rw [f0, reflect_zero, zero_mul, zero_mul, reflect_zero], },

    rw [← erase_lead_add_C_mul_X_pow f, add_mul, reflect_add, reflect_add, add_mul, hcf, hcf];
       try { assumption },
    { exact le_add_left card_support_C_mul_X_pow_le_one },
    { exact (le_trans (nat_degree_C_mul_X_pow_le f.leading_coeff f.nat_degree) Nf) },
    { exact nat.lt_succ_iff.mp (gt_of_ge_of_gt Cf (erase_lead_support_card_lt f0)) },
    { exact (le_trans erase_lead_nat_degree_le_aux Nf) } }
end

@[simp] theorem reflect_mul
  (f g : R[X]) {F G : ℕ} (Ff : f.nat_degree ≤ F) (Gg : g.nat_degree ≤ G) :
  reflect (F + G) (f * g) = reflect F f * reflect G g :=
reflect_mul_induction _ _ F G f g f.support.card.le_succ g.support.card.le_succ Ff Gg

section eval₂

variables {S : Type*} [comm_semiring S]

lemma eval₂_reflect_mul_pow (i : R →+* S) (x : S) [invertible x] (N : ℕ) (f : R[X])
  (hf : f.nat_degree ≤ N) : eval₂ i (⅟x) (reflect N f) * x ^ N = eval₂ i x f :=
begin
  refine induction_with_nat_degree_le (λ f, eval₂ i (⅟x) (reflect N f) * x ^ N = eval₂ i x f)
    _ _ _ _ f hf,
  { simp },
  { intros n r hr0 hnN,
    simp only [rev_at_le hnN, reflect_C_mul_X_pow, eval₂_X_pow, eval₂_C, eval₂_mul],
    conv in (x ^ N) { rw [← nat.sub_add_cancel hnN] },
    rw [pow_add, ← mul_assoc, mul_assoc (i r), ← mul_pow, inv_of_mul_self, one_pow, mul_one] },
  { intros,
    simp [*, add_mul] }
end

lemma eval₂_reflect_eq_zero_iff (i : R →+* S) (x : S) [invertible x] (N : ℕ) (f : R[X])
  (hf : f.nat_degree ≤ N) : eval₂ i (⅟x) (reflect N f) = 0 ↔ eval₂ i x f = 0 :=
begin
  conv_rhs { rw [← eval₂_reflect_mul_pow i x N f hf] },
  split,
  { intro h, rw [h, zero_mul] },
  { intro h, rw [← mul_one (eval₂ i (⅟x) _), ← one_pow N, ← mul_inv_of_self x,
      mul_pow, ← mul_assoc, h, zero_mul] }
end

end eval₂

/-- The reverse of a polynomial f is the polynomial obtained by "reading f backwards".
Even though this is not the actual definition, reverse f = f (1/X) * X ^ f.nat_degree. -/
noncomputable def reverse (f : R[X]) : R[X] := reflect f.nat_degree f

lemma coeff_reverse (f : R[X]) (n : ℕ) :
  f.reverse.coeff n = f.coeff (rev_at f.nat_degree n) :=
by rw [reverse, coeff_reflect]

@[simp] lemma coeff_zero_reverse (f : R[X]) : coeff (reverse f) 0 = leading_coeff f :=
by rw [coeff_reverse, rev_at_le (zero_le f.nat_degree), tsub_zero, leading_coeff]

@[simp] lemma reverse_zero : reverse (0 : R[X]) = 0 := rfl

@[simp] lemma reverse_eq_zero : f.reverse = 0 ↔ f = 0 :=
by simp [reverse]

lemma reverse_nat_degree_le (f : R[X]) : f.reverse.nat_degree ≤ f.nat_degree :=
begin
  rw [nat_degree_le_iff_degree_le, degree_le_iff_coeff_zero],
  intros n hn,
  rw with_bot.coe_lt_coe at hn,
  rw [coeff_reverse, rev_at, function.embedding.coe_fn_mk,
      if_neg (not_le_of_gt hn), coeff_eq_zero_of_nat_degree_lt hn],
end

lemma nat_degree_eq_reverse_nat_degree_add_nat_trailing_degree (f : R[X]) :
  f.nat_degree = f.reverse.nat_degree + f.nat_trailing_degree :=
begin
  by_cases hf : f = 0,
  { rw [hf, reverse_zero, nat_degree_zero, nat_trailing_degree_zero] },
  apply le_antisymm,
  { refine tsub_le_iff_right.mp _,
    apply le_nat_degree_of_ne_zero,
    rw [reverse, coeff_reflect, ←rev_at_le f.nat_trailing_degree_le_nat_degree, rev_at_invol],
    exact trailing_coeff_nonzero_iff_nonzero.mpr hf },
  { rw ← le_tsub_iff_left f.reverse_nat_degree_le,
    apply nat_trailing_degree_le_of_ne_zero,
    have key := mt leading_coeff_eq_zero.mp (mt reverse_eq_zero.mp hf),
    rwa [leading_coeff, coeff_reverse, rev_at_le f.reverse_nat_degree_le] at key },
end

lemma reverse_nat_degree (f : R[X]) :
  f.reverse.nat_degree = f.nat_degree - f.nat_trailing_degree :=
by rw [f.nat_degree_eq_reverse_nat_degree_add_nat_trailing_degree, add_tsub_cancel_right]

lemma reverse_leading_coeff (f : R[X]) : f.reverse.leading_coeff = f.trailing_coeff :=
by rw [leading_coeff, reverse_nat_degree, ←rev_at_le f.nat_trailing_degree_le_nat_degree,
  coeff_reverse, rev_at_invol, trailing_coeff]

lemma reverse_nat_trailing_degree  (f : R[X]) : f.reverse.nat_trailing_degree = 0 :=
begin
  by_cases hf : f = 0,
  { rw [hf, reverse_zero, nat_trailing_degree_zero] },
  { rw ← le_zero_iff,
    apply nat_trailing_degree_le_of_ne_zero,
    rw [coeff_zero_reverse],
    exact mt leading_coeff_eq_zero.mp hf },
end

theorem reverse_mul {f g : R[X]} (fg : f.leading_coeff * g.leading_coeff ≠ 0) :
 reverse (f * g) = reverse f * reverse g :=
begin
  unfold reverse,
  rw [nat_degree_mul' fg, reflect_mul  f g rfl.le rfl.le],
end

@[simp] lemma reverse_mul_of_domain {R : Type*} [ring R] [no_zero_divisors R] (f g : R[X]) :
  reverse (f * g) = reverse f * reverse g :=
begin
  by_cases f0 : f=0,
  { simp only [f0, zero_mul, reverse_zero], },
  by_cases g0 : g=0,
  { rw [g0, mul_zero, reverse_zero, mul_zero], },
  simp [reverse_mul, *],
end

lemma trailing_coeff_mul {R : Type*} [ring R] [no_zero_divisors R] (p q : R[X]) :
  (p * q).trailing_coeff = p.trailing_coeff * q.trailing_coeff :=
by rw [←reverse_leading_coeff, reverse_mul_of_domain, leading_coeff_mul,
  reverse_leading_coeff, reverse_leading_coeff]

@[simp] lemma coeff_one_reverse (f : R[X]) : coeff (reverse f) 1 = next_coeff f :=
begin
  rw [coeff_reverse, next_coeff],
  split_ifs with hf,
  { have : coeff f 1 = 0 := coeff_eq_zero_of_nat_degree_lt (by simp only [hf, zero_lt_one]),
    simp [*, rev_at] },
  { rw rev_at_le,
    exact nat.succ_le_iff.2 (pos_iff_ne_zero.2 hf) }
end

section eval₂
variables {S : Type*} [comm_semiring S]

lemma eval₂_reverse_mul_pow (i : R →+* S) (x : S) [invertible x] (f : R[X]) :
  eval₂ i (⅟x) (reverse f) * x ^ f.nat_degree = eval₂ i x f :=
eval₂_reflect_mul_pow i _ _ f le_rfl

@[simp] lemma eval₂_reverse_eq_zero_iff (i : R →+* S) (x : S) [invertible x] (f : R[X]) :
  eval₂ i (⅟x) (reverse f) = 0 ↔ eval₂ i x f = 0 :=
eval₂_reflect_eq_zero_iff i x _ _ le_rfl

end eval₂

end semiring

section ring

variables {R : Type*} [ring R]

@[simp] lemma reflect_neg (f : R[X]) (N : ℕ) :
  reflect N (- f) = - reflect N f :=
by rw [neg_eq_neg_one_mul, ←C_1, ←C_neg, reflect_C_mul, C_neg, C_1, ←neg_eq_neg_one_mul]

@[simp] lemma reflect_sub (f g : R[X]) (N : ℕ) :
  reflect N (f - g) = reflect N f - reflect N g :=
by rw [sub_eq_add_neg, sub_eq_add_neg, reflect_add, reflect_neg]

@[simp] lemma reverse_neg (f : R[X]) :
  reverse (- f) = - reverse f :=
by rw [reverse, reverse, reflect_neg, nat_degree_neg]

end ring

end polynomial


import data.polynomial.basic
import data.polynomial.eval
import data.real.basic

/-- definition of a negligible function -/
def negligible (f : ℕ → ℝ) : Prop :=
  ∀ p : polynomial ℕ, ∃ N : ℕ, ∀ n : ℕ, N < n →
    (f n : ℝ) ≤ (1 : ℝ) / p.eval n

lemma negligible_add {f g : ℕ → ℝ} (hf : negligible f) (hg : negligible g) : negligible (f + g) :=
begin
  unfold negligible at *,
  intro p,
  replace hf := hf (2 * p),
  replace hg := hg (2 * p),
  rcases hf with ⟨Nf, hpf⟩,
  rcases hg with ⟨Ng, hpg⟩,
  use (max Nf Ng),
  intro n,
  replace hpf := hpf n,
  replace hpg := hpg n,
  intro hNfg,
  have hNf : Nf < n, -- library_search, -- fails
    apply lt_of_le_of_lt _ hNfg,
    exact le_max_left Nf Ng,
  have hNg : Ng < n, -- library_search, -- fails
    apply lt_of_le_of_lt _ hNfg,
    exact le_max_right Nf Ng,
  replace hpf := hpf hNf,
  replace hpg := hpg hNg,
  simp only [pi.add_apply, polynomial.eval_mul, nat.cast_mul],
  have hpfg := (add_le_add hpf hpg),
  apply trans hpfg,
  simp,
  simp_rw mul_inv₀,
  rw ←one_div,
  linarith,
end

lemma negligible_of_le_negligible {f g : ℕ → ℝ} (hfg : f ≤ g) (hg : negligible g) : negligible f :=
begin
  unfold negligible at *,
  intro p,
  replace hg := hg (p),
  rcases hg with ⟨Ng, hpg⟩,
  use Ng,
  intro n,
  replace hpg := hpg n,
  intro hNg,
  replace hpg := hpg hNg,
  exact le_trans (hfg n) hpg,
end


import algebra.big_operators.basic
import data.real.basic

/-
Canadian Mathematical Olympiad 1998, Problem 3

Let n be a natural number such that n ≥ 2. Show that

  (1/(n + 1))(1 + 1/3 + ... + 1/(2n -1)) > (1/n)(1/2 + 1/4 + ... + 1/2n).
-/

open_locale big_operators

-- n' + 1 = n

theorem canada1998_q3 (n' : ℕ) (hn : 1 ≤ n') :
  ((1:ℝ)/(n'+2)) * ∑ (i:ℕ) in finset.range n', (1/(2 * n' + 1)) >
  ((1:ℝ)/(n'+1)) * ∑ (i:ℕ) in finset.range n', (1/(2 * n' + 2)) :=
begin
  cases n',
  { sorry, },
  clear hn,
  sorry
end


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.algebra.subalgebra
import topology.algebra.module

/-!
# Topological (sub)algebras

A topological algebra over a topological semiring `R` is a topological ring with a compatible
continuous scalar multiplication by elements of `R`. We reuse typeclass `has_continuous_smul` for
topological algebras.

## Results

This is just a minimal stub for now!

The topological closure of a subalgebra is still a subalgebra,
which as an algebra is a topological algebra.
-/

open classical set topological_space algebra
open_locale classical

universes u v w

section topological_algebra
variables (R : Type*) [topological_space R] [comm_semiring R]
variables (A : Type u) [topological_space A]
variables [semiring A]

lemma continuous_algebra_map_iff_smul [algebra R A] [topological_semiring A] :
  continuous (algebra_map R A) ↔ continuous (λ p : R × A, p.1 • p.2) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { simp only [algebra.smul_def], exact (h.comp continuous_fst).mul continuous_snd },
  { rw algebra_map_eq_smul_one', exact h.comp (continuous_id.prod_mk continuous_const) }
end

@[continuity]
lemma continuous_algebra_map [algebra R A] [topological_semiring A] [has_continuous_smul R A] :
  continuous (algebra_map R A) :=
(continuous_algebra_map_iff_smul R A).2 continuous_smul

lemma has_continuous_smul_of_algebra_map [algebra R A] [topological_semiring A]
  (h : continuous (algebra_map R A)) :
  has_continuous_smul R A :=
⟨(continuous_algebra_map_iff_smul R A).1 h⟩

end topological_algebra

section topological_algebra
variables {R : Type*} [comm_semiring R]
variables {A : Type u} [topological_space A]
variables [semiring A]
variables [algebra R A] [topological_semiring A]

/-- The closure of a subalgebra in a topological algebra as a subalgebra. -/
def subalgebra.topological_closure (s : subalgebra R A) : subalgebra R A :=
{ carrier := closure (s : set A),
  algebra_map_mem' := λ r, s.to_subsemiring.subring_topological_closure (s.algebra_map_mem r),
  .. s.to_subsemiring.topological_closure }

@[simp] lemma subalgebra.topological_closure_coe (s : subalgebra R A) :
  (s.topological_closure : set A) = closure (s : set A) :=
rfl

instance subalgebra.topological_closure_topological_semiring (s : subalgebra R A) :
  topological_semiring (s.topological_closure) :=
s.to_subsemiring.topological_closure_topological_semiring

instance subalgebra.topological_closure_topological_algebra
  [topological_space R] [has_continuous_smul R A] (s : subalgebra R A) :
  has_continuous_smul R (s.topological_closure) :=
s.to_submodule.topological_closure_has_continuous_smul

lemma subalgebra.subalgebra_topological_closure (s : subalgebra R A) :
  s ≤ s.topological_closure :=
subset_closure

lemma subalgebra.is_closed_topological_closure (s : subalgebra R A) :
  is_closed (s.topological_closure : set A) :=
by convert is_closed_closure

lemma subalgebra.topological_closure_minimal
  (s : subalgebra R A) {t : subalgebra R A} (h : s ≤ t) (ht : is_closed (t : set A)) :
  s.topological_closure ≤ t :=
closure_minimal h ht

/--
This is really a statement about topological algebra isomorphisms,
but we don't have those, so we use the clunky approach of talking about
an algebra homomorphism, and a separate homeomorphism,
along with a witness that as functions they are the same.
-/
lemma subalgebra.topological_closure_comap'_homeomorph
  (s : subalgebra R A)
  {B : Type*} [topological_space B] [ring B] [topological_ring B] [algebra R B]
  (f : B →ₐ[R] A) (f' : B ≃ₜ A) (w : (f : B → A) = f') :
  s.topological_closure.comap' f = (s.comap' f).topological_closure :=
begin
  apply set_like.ext',
  simp only [subalgebra.topological_closure_coe],
  simp only [subalgebra.coe_comap, subsemiring.coe_comap, alg_hom.coe_to_ring_hom],
  rw [w],
  exact f'.preimage_closure _,
end

end topological_algebra


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

/-!
# Complemented subspaces of normed vector spaces

A submodule `p` of a topological module `E` over `R` is called *complemented* if there exists
a continuous linear projection `f : E →ₗ[R] p`, `∀ x : p, f x = x`. We prove that for
a closed subspace of a normed space this condition is equivalent to existence of a closed
subspace `q` such that `p ⊓ q = ⊥`, `p ⊔ q = ⊤`. We also prove that a subspace of finite codimension
is always a complemented subspace.

## Tags

complemented subspace, normed vector space
-/

variables {𝕜 E F G : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E]
  [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F] [normed_add_comm_group G]
  [normed_space 𝕜 G]

noncomputable theory

open linear_map (ker range)

namespace continuous_linear_map

section

variables [complete_space 𝕜]

lemma ker_closed_complemented_of_finite_dimensional_range (f : E →L[𝕜] F)
  [finite_dimensional 𝕜 (range f)] :
  (ker f).closed_complemented :=
begin
  set f' : E →L[𝕜] (range f) := f.cod_restrict _ (f : E →ₗ[𝕜] F).mem_range_self,
  rcases f'.exists_right_inverse_of_surjective (f : E →ₗ[𝕜] F).range_range_restrict with ⟨g, hg⟩,
  simpa only [ker_cod_restrict] using f'.closed_complemented_ker_of_right_inverse g (ext_iff.1 hg)
end

end

variables [complete_space E] [complete_space (F × G)]

/-- If `f : E →L[R] F` and `g : E →L[R] G` are two surjective linear maps and
their kernels are complement of each other, then `x ↦ (f x, g x)` defines
a linear equivalence `E ≃L[R] F × G`. -/
def equiv_prod_of_surjective_of_is_compl (f : E →L[𝕜] F) (g : E →L[𝕜] G) (hf : range f = ⊤)
  (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) :
  E ≃L[𝕜] F × G :=
((f : E →ₗ[𝕜] F).equiv_prod_of_surjective_of_is_compl ↑g hf hg
  hfg).to_continuous_linear_equiv_of_continuous (f.continuous.prod_mk g.continuous)

@[simp] lemma coe_equiv_prod_of_surjective_of_is_compl {f : E →L[𝕜] F} {g : E →L[𝕜] G}
  (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) :
  (equiv_prod_of_surjective_of_is_compl f g hf hg hfg : E →ₗ[𝕜] F × G) = f.prod g :=
rfl

@[simp] lemma equiv_prod_of_surjective_of_is_compl_to_linear_equiv {f : E →L[𝕜] F} {g : E →L[𝕜] G}
  (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) :
  (equiv_prod_of_surjective_of_is_compl f g hf hg hfg).to_linear_equiv =
    linear_map.equiv_prod_of_surjective_of_is_compl f g hf hg hfg :=
rfl

@[simp] lemma equiv_prod_of_surjective_of_is_compl_apply {f : E →L[𝕜] F} {g : E →L[𝕜] G}
  (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) (x : E) :
  equiv_prod_of_surjective_of_is_compl f g hf hg hfg x = (f x, g x) :=
rfl

end continuous_linear_map

namespace subspace

variables [complete_space E] (p q : subspace 𝕜 E)

/-- If `q` is a closed complement of a closed subspace `p`, then `p × q` is continuously
isomorphic to `E`. -/
def prod_equiv_of_closed_compl (h : is_compl p q) (hp : is_closed (p : set E))
  (hq : is_closed (q : set E)) : (p × q) ≃L[𝕜] E :=
begin
  haveI := hp.complete_space_coe, haveI := hq.complete_space_coe,
  refine (p.prod_equiv_of_is_compl q h).to_continuous_linear_equiv_of_continuous _,
  exact (p.subtypeL.coprod q.subtypeL).continuous
end

/-- Projection to a closed submodule along a closed complement. -/
def linear_proj_of_closed_compl (h : is_compl p q) (hp : is_closed (p : set E))
  (hq : is_closed (q : set E)) :
  E →L[𝕜] p :=
(continuous_linear_map.fst 𝕜 p q) ∘L ↑(prod_equiv_of_closed_compl p q h hp hq).symm

variables {p q}

@[simp] lemma coe_prod_equiv_of_closed_compl (h : is_compl p q) (hp : is_closed (p : set E))
  (hq : is_closed (q : set E)) :
  ⇑(p.prod_equiv_of_closed_compl q h hp hq) = p.prod_equiv_of_is_compl q h := rfl

@[simp]

@[simp] lemma coe_continuous_linear_proj_of_closed_compl (h : is_compl p q)
  (hp : is_closed (p : set E)) (hq : is_closed (q : set E)) :
  (p.linear_proj_of_closed_compl q h hp hq : E →ₗ[𝕜] p) = p.linear_proj_of_is_compl q h := rfl

@[simp] lemma coe_continuous_linear_proj_of_closed_compl' (h : is_compl p q)
  (hp : is_closed (p : set E)) (hq : is_closed (q : set E)) :
  ⇑(p.linear_proj_of_closed_compl q h hp hq) = p.linear_proj_of_is_compl q h := rfl

lemma closed_complemented_of_closed_compl (h : is_compl p q) (hp : is_closed (p : set E))
  (hq : is_closed (q : set E)) : p.closed_complemented :=
⟨p.linear_proj_of_closed_compl q h hp hq, submodule.linear_proj_of_is_compl_apply_left h⟩

lemma closed_complemented_iff_has_closed_compl : p.closed_complemented ↔
  is_closed (p : set E) ∧ ∃ (q : subspace 𝕜 E) (hq : is_closed (q : set E)), is_compl p q :=
⟨λ h, ⟨h.is_closed, h.has_closed_complement⟩,
  λ ⟨hp, ⟨q, hq, hpq⟩⟩, closed_complemented_of_closed_compl hpq hp hq⟩

lemma closed_complemented_of_quotient_finite_dimensional [complete_space 𝕜]
  [finite_dimensional 𝕜 (E ⧸ p)] (hp : is_closed (p : set E)) :
  p.closed_complemented :=
begin
  obtain ⟨q, hq⟩ : ∃ q, is_compl p q := p.exists_is_compl,
  haveI : finite_dimensional 𝕜 q := (p.quotient_equiv_of_is_compl q hq).finite_dimensional,
  exact closed_complemented_of_closed_compl hq hp q.closed_of_finite_dimensional
end

end subspace


/-
Copyright (c) 2022 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.W.cardinal
import ring_theory.algebraic_independent
import field_theory.is_alg_closed.basic
import field_theory.intermediate_field
import data.polynomial.cardinal
import data.mv_polynomial.cardinal
import data.zmod.algebra
/-!
# Classification of Algebraically closed fields

This file contains results related to classifying algebraically closed fields.

## Main statements

* `is_alg_closed.equiv_of_transcendence_basis` Two fields with the same characteristic and the same
  cardinality of transcendence basis are isomorphic.
* `is_alg_closed.ring_equiv_of_cardinal_eq_of_char_eq` Two uncountable algebraically closed fields
  are isomorphic if they have the same characteristic and the same cardinality.
-/
universe u

open_locale cardinal
open cardinal

section algebraic_closure

namespace algebra.is_algebraic

variables (R L : Type u) [comm_ring R] [comm_ring L] [is_domain L] [algebra R L]
variables [no_zero_smul_divisors R L] (halg : algebra.is_algebraic R L)

lemma cardinal_mk_le_sigma_polynomial :
  #L ≤ #(Σ p : polynomial R, { x : L // x ∈ (p.map (algebra_map R L)).roots }) :=
@mk_le_of_injective L (Σ p : polynomial R, { x : L | x ∈ (p.map (algebra_map R L)).roots })
  (λ x : L, let p := classical.indefinite_description _ (halg x) in
    ⟨p.1, x,
      begin
      dsimp,
      have h : p.1.map (algebra_map R L) ≠ 0,
      { rw [ne.def, ← polynomial.degree_eq_bot, polynomial.degree_map_eq_of_injective
          (no_zero_smul_divisors.algebra_map_injective R L), polynomial.degree_eq_bot],
        exact p.2.1 },
      erw [polynomial.mem_roots h, polynomial.is_root, polynomial.eval_map,
        ← polynomial.aeval_def, p.2.2],
      end⟩) (λ x y, begin
    intro h,
    simp only at h,
    refine (subtype.heq_iff_coe_eq _).1 h.2,
    simp only [h.1, iff_self, forall_true_iff]
  end)

/--The cardinality of an algebraic extension is at most the maximum of the cardinality
of the base ring or `ω` -/
lemma cardinal_mk_le_max : #L ≤ max (#R) ω :=
calc #L ≤ #(Σ p : polynomial R, { x : L // x ∈ (p.map (algebra_map R L)).roots }) :
  cardinal_mk_le_sigma_polynomial R L halg
... = cardinal.sum (λ p : polynomial R, #{ x : L | x ∈ (p.map (algebra_map R L)).roots }) :
  by rw ← mk_sigma; refl
... ≤ cardinal.sum.{u u} (λ p : polynomial R, ω) : sum_le_sum _ _
  (λ p, le_of_lt begin
    rw [lt_omega_iff_finite],
    classical,
    simp only [← @multiset.mem_to_finset _ _ _ (p.map (algebra_map R L)).roots],
    exact set.finite_mem_finset _,
  end)
... = #(polynomial R) * ω : sum_const' _ _
... ≤ max (max (#(polynomial R)) ω) ω : mul_le_max _ _
... ≤ max (max (max (#R) ω) ω) ω :
  max_le_max (max_le_max polynomial.cardinal_mk_le_max le_rfl) le_rfl
... = max (#R) ω : by simp only [max_assoc, max_comm omega.{u}, max_left_comm omega.{u}, max_self]

end algebra.is_algebraic

end algebraic_closure

namespace is_alg_closed

section classification

noncomputable theory

variables {R L K : Type*} [comm_ring R]
variables [field K] [algebra R K]
variables [field L] [algebra R L]
variables {ι : Type*} (v : ι → K)
variables {κ : Type*} (w : κ → L)

variables (hv : algebraic_independent R v)

lemma is_alg_closure_of_transcendence_basis [is_alg_closed K] (hv : is_transcendence_basis R v) :
  is_alg_closure (algebra.adjoin R (set.range v)) K :=
by letI := ring_hom.domain_nontrivial (algebra_map R K); exact
{ alg_closed := by apply_instance,
  algebraic := hv.is_algebraic }

variables (hw : algebraic_independent R w)

/-- setting `R` to be `zmod (ring_char R)` this result shows that if two algebraically
closed fields have equipotent transcendence bases and the same characteristic then they are
isomorphic. -/
def equiv_of_transcendence_basis [is_alg_closed K] [is_alg_closed L] (e : ι ≃ κ)
  (hv : is_transcendence_basis R v) (hw : is_transcendence_basis R w) : K ≃+* L :=
begin
  letI := is_alg_closure_of_transcendence_basis v hv;
  letI := is_alg_closure_of_transcendence_basis w hw;
  have e : algebra.adjoin R (set.range v) ≃+* algebra.adjoin R (set.range w),
  { refine hv.1.aeval_equiv.symm.to_ring_equiv.trans _,
    refine (alg_equiv.of_alg_hom
      (mv_polynomial.rename e)
      (mv_polynomial.rename e.symm)
      _ _).to_ring_equiv.trans _,
    { ext, simp },
    { ext, simp },
    exact hw.1.aeval_equiv.to_ring_equiv },
  exact is_alg_closure.equiv_of_equiv K L e
end

end classification

section cardinal

variables {R L K : Type u} [comm_ring R]
variables [field K] [algebra R K] [is_alg_closed K]
variables {ι : Type u} (v : ι → K)
variable (hv : is_transcendence_basis R v)

lemma cardinal_le_max_transcendence_basis (hv : is_transcendence_basis R v) :
  #K ≤ max (max (#R) (#ι)) ω :=
calc #K ≤ max (#(algebra.adjoin R (set.range v))) ω :
  by letI := is_alg_closure_of_transcendence_basis v hv;
   exact algebra.is_algebraic.cardinal_mk_le_max _ _ is_alg_closure.algebraic
... = max (#(mv_polynomial ι R)) ω : by rw [cardinal.eq.2 ⟨(hv.1.aeval_equiv).to_equiv⟩]
... ≤ max (max (max (#R) (#ι)) ω) ω : max_le_max mv_polynomial.cardinal_mk_le_max le_rfl
... = _ : by simp [max_assoc]

/-- If `K` is an uncountable algebraically closed field, then its
cardinality is the same as that of a transcendence basis. -/
lemma cardinal_eq_cardinal_transcendence_basis_of_omega_lt [nontrivial R]
  (hv : is_transcendence_basis R v) (hR : #R ≤ ω) (hK : ω < #K) : #K = #ι :=
have ω ≤ #ι,
  from le_of_not_lt (λ h,
    not_le_of_gt hK $ calc
      #K ≤ max (max (#R) (#ι)) ω : cardinal_le_max_transcendence_basis v hv
     ... ≤ _ : max_le (max_le hR (le_of_lt h)) le_rfl),
le_antisymm
  (calc #K ≤ max (max (#R) (#ι)) ω : cardinal_le_max_transcendence_basis v hv
       ... = #ι : begin
         rw [max_eq_left, max_eq_right],
         { exact le_trans hR this },
         { exact le_max_of_le_right this }
       end)
  (mk_le_of_injective (show function.injective v, from hv.1.injective))

end cardinal

variables {K L : Type} [field K] [field L] [is_alg_closed K] [is_alg_closed L]

/-- Two uncountable algebraically closed fields of characteristic zero are isomorphic
if they have the same cardinality. -/
@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_zero [char_zero K] [char_zero L]
  (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  cases exists_is_transcendence_basis ℤ
    (show function.injective (algebra_map ℤ K),
      from int.cast_injective) with s hs,
  cases exists_is_transcendence_basis ℤ
    (show function.injective (algebra_map ℤ L),
      from int.cast_injective) with t ht,
  have : #s = #t,
  { rw [← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ hs (le_of_eq mk_int) hK,
        ← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ ht (le_of_eq mk_int), hKL],
    rwa ← hKL },
  cases cardinal.eq.1 this with e,
  exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
end

private lemma ring_equiv_of_cardinal_eq_of_char_p (p : ℕ) [fact p.prime]
  [char_p K p] [char_p L p] (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  cases exists_is_transcendence_basis (zmod p)
    (show function.injective (algebra_map (zmod p) K),
      from ring_hom.injective _) with s hs,
  cases exists_is_transcendence_basis (zmod p)
    (show function.injective (algebra_map (zmod p) L),
      from ring_hom.injective _) with t ht,
  have : #s = #t,
  { rw [← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ hs
      (le_of_lt $ lt_omega_iff_fintype.2 ⟨infer_instance⟩) hK,
        ← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ ht
      (le_of_lt $ lt_omega_iff_fintype.2 ⟨infer_instance⟩), hKL],
    rwa ← hKL },
  cases cardinal.eq.1 this with e,
  exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
end

/-- Two uncountable algebraically closed fields are isomorphic
if they have the same cardinality and the same characteristic. -/
@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_eq (p : ℕ) [char_p K p] [char_p L p]
  (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
begin
  apply classical.choice,
  rcases char_p.char_is_prime_or_zero K p with hp | hp,
  { haveI : fact p.prime := ⟨hp⟩,
    exact ⟨ring_equiv_of_cardinal_eq_of_char_p p hK hKL⟩ },
  { rw [hp] at *,
    resetI,
    letI : char_zero K := char_p.char_p_to_char_zero K,
    letI : char_zero L := char_p.char_p_to_char_zero L,
    exact ⟨ring_equiv_of_cardinal_eq_of_char_zero hK hKL⟩ }
end

end is_alg_closed


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.inner_product_space.orientation
import measure_theory.measure.haar_lebesgue

/-!
# Volume forms and measures on inner product spaces

A volume form induces a Lebesgue measure on general finite-dimensional real vector spaces. In this
file, we discuss the specific situation of inner product spaces, where an orientation gives
rise to a canonical volume form. We show that the measure coming from this volume form gives
measure `1` to the parallelepiped spanned by any orthonormal basis, and that it coincides with
the canonical `volume` from the `measure_space` instance.
-/

open finite_dimensional measure_theory measure_theory.measure set

variables {ι F : Type*}
variables [fintype ι] [normed_add_comm_group F] [inner_product_space ℝ F] [finite_dimensional ℝ F]
  [measurable_space F] [borel_space F]

section

variables {m n : ℕ} [_i : fact (finrank ℝ F = n)]
include _i

/-- The volume form coming from an orientation in an inner product space gives measure `1` to the
parallelepiped associated to any orthonormal basis. This is a rephrasing of
`abs_volume_form_apply_of_orthonormal` in terms of measures. -/
lemma orientation.measure_orthonormal_basis
  (o : orientation ℝ F (fin n)) (b : orthonormal_basis ι ℝ F) :
  o.volume_form.measure (parallelepiped b) = 1 :=
begin
  have e : ι ≃ fin n,
  { refine fintype.equiv_fin_of_card_eq _,
    rw [← _i.out, finrank_eq_card_basis b.to_basis] },
  have A : ⇑b = (b.reindex e) ∘ e,
  { ext x,
    simp only [orthonormal_basis.coe_reindex, function.comp_app, equiv.symm_apply_apply] },
  rw [A, parallelepiped_comp_equiv, alternating_map.measure_parallelepiped,
    o.abs_volume_form_apply_of_orthonormal, ennreal.of_real_one],
end

/-- In an oriented inner product space, the measure coming from the canonical volume form
associated to an orientation coincides with the volume. -/
lemma orientation.measure_eq_volume (o : orientation ℝ F (fin n)) :
  o.volume_form.measure = volume :=
begin
  have A : o.volume_form.measure ((std_orthonormal_basis ℝ F).to_basis.parallelepiped) = 1,
    from orientation.measure_orthonormal_basis o (std_orthonormal_basis ℝ F),
  rw [add_haar_measure_unique o.volume_form.measure
    ((std_orthonormal_basis ℝ F).to_basis.parallelepiped), A, one_smul],
  simp only [volume, basis.add_haar],
end

end

/-- The volume measure in a finite-dimensional inner product space gives measure `1` to the
parallelepiped spanned by any orthonormal basis. -/
lemma orthonormal_basis.volume_parallelepiped (b : orthonormal_basis ι ℝ F) :
  volume (parallelepiped b) = 1 :=
begin
  haveI : fact (finrank ℝ F = finrank ℝ F) := ⟨rfl⟩,
  let o := (std_orthonormal_basis ℝ F).to_basis.orientation,
  rw ← o.measure_eq_volume,
  exact o.measure_orthonormal_basis b,
end


import topology.algebra.module.locally_convex

open filter
open_locale pointwise topological_space

def has_homothetic_basis {ι E : Sort*} [topological_space E] [has_scalar ℝ E] (l : filter E)
  (p : ι → Prop) (s : ι → set E) : Prop :=
has_basis l (λ iε : ι × ℝ, p iε.1 ∧ 0 < iε.2) (λ iε, iε.2 • s iε.1)

lemma ball_eq_smul_ball {E : Sort*} [semi_normed_group E] [normed_space ℝ E] {ε : ℝ} (hε : 0 < ε) :
  metric.ball (0 : E) ε = ε • metric.ball (0 : E) 1 :=
begin
  ext x,
  split;
  intros hx,
  { refine ⟨ε⁻¹ • x, _, _⟩,
    { rw mem_ball_zero_iff at *,
      rw norm_smul_of_nonneg (inv_nonneg.mpr hε.le),
      rwa [← mul_lt_mul_left (inv_pos.mpr hε), inv_mul_cancel hε.ne.symm] at hx },
    { rw [smul_smul, mul_inv_cancel hε.ne.symm, one_smul] } },
  { rcases hx with ⟨y, hy, rfl⟩,
    rw mem_ball_zero_iff at *,
    rw [norm_smul_of_nonneg hε.le],
    rwa [← mul_lt_mul_left hε, mul_one] at hy }
end

lemma normed_space.has_homothetic_basis_zero {ι E : Sort*} [semi_normed_group E]
  [normed_space ℝ E] :
  has_homothetic_basis (𝓝 0 : filter E) (λ (i : unit), true) (λ _, metric.ball (0 : E) 1) :=
metric.nhds_basis_ball.to_has_basis
  (λ ε hε, ⟨⟨(), ε⟩, ⟨true.intro, hε⟩, by simp [ball_eq_smul_ball hε]⟩)
  (λ iε hiε, ⟨iε.2, hiε.2, by simp [ball_eq_smul_ball hiε.2]⟩)


/-
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, Simon Hudon, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.defs
import Mathlib.logic.function.basic
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/--
Composing two associative operations of `f : α → α → α` on the left
is equal to an associative operation on the left.
-/
theorem comp_assoc_left {α : Type u} (f : α → α → α) [is_associative α f] (x : α) (y : α) :
    f x ∘ f y = f (f x y) :=
  sorry

/--
Composing two associative operations of `f : α → α → α` on the right
is equal to an associative operation on the right.
-/
theorem comp_assoc_right {α : Type u} (f : α → α → α) [is_associative α f] (x : α) (y : α) :
    ((fun (z : α) => f z x) ∘ fun (z : α) => f z y) = fun (z : α) => f z (f y x) :=
  sorry

/--
Composing two multiplications on the left by `y` then `x`
is equal to a multiplication on the left by `x * y`.
-/
@[simp] theorem comp_mul_left {α : Type u_1} [semigroup α] (x : α) (y : α) :
    Mul.mul x ∘ Mul.mul y = Mul.mul (x * y) :=
  comp_assoc_left Mul.mul x y

/--
Composing two multiplications on the right by `y` and `x`
is equal to a multiplication on the right by `y * x`.
-/
@[simp] theorem comp_add_right {α : Type u_1} [add_semigroup α] (x : α) (y : α) :
    ((fun (_x : α) => _x + x) ∘ fun (_x : α) => _x + y) = fun (_x : α) => _x + (y + x) :=
  comp_assoc_right Add.add x y

theorem ite_add_zero {M : Type u} [add_monoid M] {P : Prop} [Decidable P] {a : M} {b : M} :
    ite P (a + b) 0 = ite P a 0 + ite P b 0 :=
  sorry

theorem eq_one_iff_eq_one_of_mul_eq_one {M : Type u} [monoid M] {a : M} {b : M} (h : a * b = 1) :
    a = 1 ↔ b = 1 :=
  sorry

theorem add_left_comm {G : Type u} [add_comm_semigroup G] (a : G) (b : G) (c : G) :
    a + (b + c) = b + (a + c) :=
  left_comm Add.add add_comm add_assoc

theorem mul_right_comm {G : Type u} [comm_semigroup G] (a : G) (b : G) (c : G) :
    a * b * c = a * c * b :=
  right_comm Mul.mul mul_comm mul_assoc

theorem add_add_add_comm {G : Type u} [add_comm_semigroup G] (a : G) (b : G) (c : G) (d : G) :
    a + b + (c + d) = a + c + (b + d) :=
  sorry

@[simp] theorem bit0_zero {M : Type u} [add_monoid M] : bit0 0 = 0 := add_zero 0

@[simp] theorem bit1_zero {M : Type u} [add_monoid M] [HasOne M] : bit1 0 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (bit1 0 = 1)) (bit1.equations._eqn_1 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (bit0 0 + 1 = 1)) bit0_zero))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + 1 = 1)) (zero_add 1))) (Eq.refl 1)))

theorem neg_unique {M : Type u} [add_comm_monoid M] {x : M} {y : M} {z : M} (hy : x + y = 0)
    (hz : x + z = 0) : y = z :=
  left_neg_eq_right_neg (trans (add_comm y x) hy) hz

@[simp] theorem mul_eq_left_iff {M : Type u} [left_cancel_monoid M] {a : M} {b : M} :
    a * b = a ↔ b = 1 :=
  iff.trans
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b = a ↔ a * b = a * 1)) (mul_one a)))
      (iff.refl (a * b = a)))
    mul_left_cancel_iff

@[simp] theorem left_eq_add_iff {M : Type u} [add_left_cancel_monoid M] {a : M} {b : M} :
    a = a + b ↔ b = 0 :=
  iff.trans eq_comm add_eq_left_iff

@[simp] theorem mul_eq_right_iff {M : Type u} [right_cancel_monoid M] {a : M} {b : M} :
    a * b = b ↔ a = 1 :=
  iff.trans
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b = b ↔ a * b = 1 * b)) (one_mul b)))
      (iff.refl (a * b = b)))
    mul_right_cancel_iff

@[simp] theorem right_eq_mul_iff {M : Type u} [right_cancel_monoid M] {a : M} {b : M} :
    b = a * b ↔ a = 1 :=
  iff.trans eq_comm mul_eq_right_iff

theorem neg_eq_zero_sub {G : Type u} [sub_neg_monoid G] (x : G) : -x = 0 - x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-x = 0 - x)) (sub_eq_add_neg 0 x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-x = 0 + -x)) (zero_add (-x)))) (Eq.refl (-x)))

theorem mul_one_div {G : Type u} [div_inv_monoid G] (x : G) (y : G) : x * (1 / y) = x / y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x * (1 / y) = x / y)) (div_eq_mul_inv 1 y)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x * (1 * (y⁻¹)) = x / y)) (one_mul (y⁻¹))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (x * (y⁻¹) = x / y)) (div_eq_mul_inv x y)))
        (Eq.refl (x * (y⁻¹)))))

theorem mul_div_assoc {G : Type u} [div_inv_monoid G] {a : G} {b : G} {c : G} :
    a * b / c = a * (b / c) :=
  sorry

theorem mul_div_assoc' {G : Type u} [div_inv_monoid G] (a : G) (b : G) (c : G) :
    a * (b / c) = a * b / c :=
  Eq.symm mul_div_assoc

@[simp] theorem one_div {G : Type u} [div_inv_monoid G] (a : G) : 1 / a = (a⁻¹) :=
  Eq.symm (inv_eq_one_div a)

@[simp] theorem neg_add_cancel_right {G : Type u} [add_group G] (a : G) (b : G) : a + -b + b = a :=
  sorry

@[simp] theorem neg_zero {G : Type u} [add_group G] : -0 = 0 := neg_eq_of_add_eq_zero (zero_add 0)

theorem left_inverse_inv (G : Type u_1) [group G] :
    function.left_inverse (fun (a : G) => a⁻¹) fun (a : G) => a⁻¹ :=
  inv_inv

@[simp] theorem inv_involutive {G : Type u} [group G] : function.involutive has_inv.inv := inv_inv

theorem neg_injective {G : Type u} [add_group G] : function.injective Neg.neg :=
  function.involutive.injective neg_involutive

@[simp] theorem neg_inj {G : Type u} [add_group G] {a : G} {b : G} : -a = -b ↔ a = b :=
  function.injective.eq_iff neg_injective

@[simp] theorem add_neg_cancel_left {G : Type u} [add_group G] (a : G) (b : G) : a + (-a + b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + (-a + b) = b)) (Eq.symm (add_assoc a (-a) b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -a + b = b)) (add_right_neg a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + b = b)) (zero_add b))) (Eq.refl b)))

theorem add_left_surjective {G : Type u} [add_group G] (a : G) : function.surjective (Add.add a) :=
  fun (x : G) => Exists.intro (-a + x) (add_neg_cancel_left a x)

theorem add_right_surjective {G : Type u} [add_group G] (a : G) :
    function.surjective fun (x : G) => x + a :=
  fun (x : G) => Exists.intro (x + -a) (neg_add_cancel_right x a)

@[simp] theorem mul_inv_rev {G : Type u} [group G] (a : G) (b : G) : a * b⁻¹ = b⁻¹ * (a⁻¹) := sorry

theorem eq_neg_of_eq_neg {G : Type u} [add_group G] {a : G} {b : G} (h : a = -b) : b = -a := sorry

theorem eq_neg_of_add_eq_zero {G : Type u} [add_group G] {a : G} {b : G} (h : a + b = 0) : a = -b :=
  sorry

theorem eq_add_neg_of_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a + c = b) :
    a = b + -c :=
  sorry

theorem eq_neg_add_of_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : b + a = c) :
    a = -b + c :=
  sorry

theorem neg_add_eq_of_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : b = a + c) :
    -a + b = c :=
  sorry

theorem mul_inv_eq_of_eq_mul {G : Type u} [group G] {a : G} {b : G} {c : G} (h : a = c * b) :
    a * (b⁻¹) = c :=
  sorry

theorem eq_add_of_add_neg_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a + -c = b) :
    a = b + c :=
  sorry

theorem eq_mul_of_inv_mul_eq {G : Type u} [group G] {a : G} {b : G} {c : G} (h : b⁻¹ * a = c) :
    a = b * c :=
  sorry

theorem mul_eq_of_eq_inv_mul {G : Type u} [group G] {a : G} {b : G} {c : G} (h : b = a⁻¹ * c) :
    a * b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b = c)) h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a⁻¹ * c) = c)) (mul_inv_cancel_left a c))) (Eq.refl c))

theorem mul_eq_of_eq_mul_inv {G : Type u} [group G] {a : G} {b : G} {c : G} (h : a = c * (b⁻¹)) :
    a * b = c :=
  sorry

theorem add_self_iff_eq_zero {G : Type u} [add_group G] {a : G} : a + a = a ↔ a = 0 :=
  eq.mp (Eq._oldrec (Eq.refl (a + a = a + 0 ↔ a = 0)) (add_zero a)) (add_right_inj a)

@[simp] theorem neg_eq_zero {G : Type u} [add_group G] {a : G} : -a = 0 ↔ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a = 0 ↔ a = 0)) (Eq.symm (propext neg_inj))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a = 0 ↔ -a = -0)) neg_zero)) (iff.refl (-a = 0)))

@[simp] theorem zero_eq_neg {G : Type u} [add_group G] {a : G} : 0 = -a ↔ a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 = -a ↔ a = 0)) (propext eq_comm)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a = 0 ↔ a = 0)) (propext neg_eq_zero))) (iff.refl (a = 0)))

theorem neg_ne_zero {G : Type u} [add_group G] {a : G} : -a ≠ 0 ↔ a ≠ 0 := not_congr neg_eq_zero

theorem eq_neg_iff_eq_neg {G : Type u} [add_group G] {a : G} {b : G} : a = -b ↔ b = -a :=
  { mp := eq_neg_of_eq_neg, mpr := eq_neg_of_eq_neg }

theorem neg_eq_iff_neg_eq {G : Type u} [add_group G] {a : G} {b : G} : -a = b ↔ -b = a :=
  iff.trans eq_comm (iff.trans eq_neg_iff_eq_neg eq_comm)

theorem mul_eq_one_iff_eq_inv {G : Type u} [group G] {a : G} {b : G} : a * b = 1 ↔ a = (b⁻¹) :=
  sorry

theorem mul_eq_one_iff_inv_eq {G : Type u} [group G] {a : G} {b : G} : a * b = 1 ↔ a⁻¹ = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b = 1 ↔ a⁻¹ = b)) (propext mul_eq_one_iff_eq_inv)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = (b⁻¹) ↔ a⁻¹ = b)) (propext eq_inv_iff_eq_inv)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b = (a⁻¹) ↔ a⁻¹ = b)) (propext eq_comm)))
        (iff.refl (a⁻¹ = b))))

theorem eq_neg_iff_add_eq_zero {G : Type u} [add_group G] {a : G} {b : G} : a = -b ↔ a + b = 0 :=
  iff.symm add_eq_zero_iff_eq_neg

theorem neg_eq_iff_add_eq_zero {G : Type u} [add_group G] {a : G} {b : G} : -a = b ↔ a + b = 0 :=
  iff.symm add_eq_zero_iff_neg_eq

theorem eq_mul_inv_iff_mul_eq {G : Type u} [group G] {a : G} {b : G} {c : G} :
    a = b * (c⁻¹) ↔ a * c = b :=
  sorry

theorem eq_inv_mul_iff_mul_eq {G : Type u} [group G] {a : G} {b : G} {c : G} :
    a = b⁻¹ * c ↔ b * a = c :=
  sorry

theorem inv_mul_eq_iff_eq_mul {G : Type u} [group G] {a : G} {b : G} {c : G} :
    a⁻¹ * b = c ↔ b = a * c :=
  sorry

theorem add_neg_eq_iff_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} :
    a + -b = c ↔ a = c + b :=
  sorry

theorem mul_inv_eq_one {G : Type u} [group G] {a : G} {b : G} : a * (b⁻¹) = 1 ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * (b⁻¹) = 1 ↔ a = b)) (propext mul_eq_one_iff_eq_inv)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = (b⁻¹⁻¹) ↔ a = b)) (inv_inv b))) (iff.refl (a = b)))

theorem inv_mul_eq_one {G : Type u} [group G] {a : G} {b : G} : a⁻¹ * b = 1 ↔ a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * b = 1 ↔ a = b)) (propext mul_eq_one_iff_eq_inv)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ = (b⁻¹) ↔ a = b)) (propext inv_inj))) (iff.refl (a = b)))

@[simp] theorem mul_left_eq_self {G : Type u} [group G] {a : G} {b : G} : a * b = b ↔ a = 1 := sorry

@[simp] theorem add_right_eq_self {G : Type u} [add_group G] {a : G} {b : G} : a + b = a ↔ b = 0 :=
  sorry

theorem sub_left_injective {G : Type u} [add_group G] {b : G} :
    function.injective fun (a : G) => a - b :=
  sorry

theorem div_right_injective {G : Type u} [group G] {b : G} :
    function.injective fun (a : G) => b / a :=
  sorry

@[simp] theorem sub_self {G : Type u} [add_group G] (a : G) : a - a = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - a = 0)) (sub_eq_add_neg a a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -a = 0)) (add_right_neg a))) (Eq.refl 0))

@[simp] theorem sub_add_cancel {G : Type u} [add_group G] (a : G) (b : G) : a - b + b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + b = a)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b + b = a)) (neg_add_cancel_right a b))) (Eq.refl a))

@[simp] theorem add_sub_cancel {G : Type u} [add_group G] (a : G) (b : G) : a + b - b = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b - b = a)) (sub_eq_add_neg (a + b) b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b + -b = a)) (add_neg_cancel_right a b))) (Eq.refl a))

theorem add_sub_assoc {G : Type u} [add_group G] (a : G) (b : G) (c : G) :
    a + b - c = a + (b - c) :=
  sorry

theorem eq_of_sub_eq_zero {G : Type u} [add_group G] {a : G} {b : G} (h : a - b = 0) : a = b :=
  sorry

theorem sub_eq_zero_of_eq {G : Type u} [add_group G] {a : G} {b : G} (h : a = b) : a - b = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = 0)) h))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b - b = 0)) (sub_self b))) (Eq.refl 0))

theorem sub_eq_zero_iff_eq {G : Type u} [add_group G] {a : G} {b : G} : a - b = 0 ↔ a = b :=
  { mp := eq_of_sub_eq_zero, mpr := sub_eq_zero_of_eq }

@[simp] theorem sub_zero {G : Type u} [add_group G] (a : G) : a - 0 = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - 0 = a)) (sub_eq_add_neg a 0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -0 = a)) neg_zero))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a + 0 = a)) (add_zero a))) (Eq.refl a)))

theorem sub_ne_zero_of_ne {G : Type u} [add_group G] {a : G} {b : G} (h : a ≠ b) : a - b ≠ 0 :=
  id fun (hab : a - b = 0) => h (eq_of_sub_eq_zero hab)

@[simp] theorem sub_neg_eq_add {G : Type u} [add_group G] (a : G) (b : G) : a - -b = a + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - -b = a + b)) (sub_eq_add_neg a (-b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + --b = a + b)) (neg_neg b))) (Eq.refl (a + b)))

@[simp] theorem neg_sub {G : Type u} [add_group G] (a : G) (b : G) : -(a - b) = b - a := sorry

theorem add_sub {G : Type u} [add_group G] (a : G) (b : G) (c : G) : a + (b - c) = a + b - c :=
  sorry

theorem sub_add_eq_sub_sub_swap {G : Type u} [add_group G] (a : G) (b : G) (c : G) :
    a - (b + c) = a - c - b :=
  sorry

@[simp] theorem add_sub_add_right_eq_sub {G : Type u} [add_group G] (a : G) (b : G) (c : G) :
    a + c - (b + c) = a - b :=
  sorry

theorem eq_sub_of_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a + c = b) :
    a = b - c :=
  sorry

theorem sub_eq_of_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a = c + b) :
    a - b = c :=
  sorry

theorem eq_add_of_sub_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a - c = b) :
    a = b + c :=
  sorry

theorem add_eq_of_eq_sub {G : Type u} [add_group G] {a : G} {b : G} {c : G} (h : a = c - b) :
    a + b = c :=
  sorry

@[simp] theorem sub_right_inj {G : Type u} [add_group G] {a : G} {b : G} {c : G} :
    a - b = a - c ↔ b = c :=
  function.injective.eq_iff sub_right_injective

@[simp] theorem sub_left_inj {G : Type u} [add_group G] {a : G} {b : G} {c : G} :
    b - a = c - a ↔ b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (b - a = c - a ↔ b = c)) (sub_eq_add_neg b a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + -a = c - a ↔ b = c)) (sub_eq_add_neg c a)))
      (add_left_inj (-a)))

theorem sub_add_sub_cancel {G : Type u} [add_group G] (a : G) (b : G) (c : G) :
    a - b + (b - c) = a - c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + (b - c) = a - c)) (Eq.symm (add_sub_assoc (a - b) b c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - b + b - c = a - c)) (sub_add_cancel a b)))
      (Eq.refl (a - c)))

theorem sub_sub_sub_cancel_right {G : Type u} [add_group G] (a : G) (b : G) (c : G) :
    a - c - (b - c) = a - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - c - (b - c) = a - b)) (Eq.symm (neg_sub c b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - c - -(c - b) = a - b)) (sub_neg_eq_add (a - c) (c - b))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a - c + (c - b) = a - b)) (sub_add_sub_cancel a c b)))
        (Eq.refl (a - b))))

theorem sub_sub_assoc_swap {G : Type u} [add_group G] {a : G} {b : G} {c : G} :
    a - (b - c) = a + c - b :=
  sorry

theorem sub_eq_zero {G : Type u} [add_group G] {a : G} {b : G} : a - b = 0 ↔ a = b := sorry

theorem sub_ne_zero {G : Type u} [add_group G] {a : G} {b : G} : a - b ≠ 0 ↔ a ≠ b :=
  not_congr sub_eq_zero

theorem eq_sub_iff_add_eq {G : Type u} [add_group G] {a : G} {b : G} {c : G} :
    a = b - c ↔ a + c = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b - c ↔ a + c = b)) (sub_eq_add_neg b c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = b + -c ↔ a + c = b)) (propext eq_add_neg_iff_add_eq)))
      (iff.refl (a + c = b)))

theorem sub_eq_iff_eq_add {G : Type u} [add_group G] {a : G} {b : G} {c : G} :
    a - b = c ↔ a = c + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = c ↔ a = c + b)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b = c ↔ a = c + b)) (propext add_neg_eq_iff_eq_add)))
      (iff.refl (a = c + b)))

theorem eq_iff_eq_of_sub_eq_sub {G : Type u} [add_group G] {a : G} {b : G} {c : G} {d : G}
    (H : a - b = c - d) : a = b ↔ c = d :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b ↔ c = d)) (Eq.symm (propext sub_eq_zero))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a - b = 0 ↔ c = d)) H))
      (eq.mpr (id (Eq._oldrec (Eq.refl (c - d = 0 ↔ c = d)) (propext sub_eq_zero)))
        (iff.refl (c = d))))

theorem left_inverse_sub_add_left {G : Type u} [add_group G] (c : G) :
    function.left_inverse (fun (x : G) => x - c) fun (x : G) => x + c :=
  fun (x : G) => add_sub_cancel x c

theorem left_inverse_add_left_sub {G : Type u} [add_group G] (c : G) :
    function.left_inverse (fun (x : G) => x + c) fun (x : G) => x - c :=
  fun (x : G) => sub_add_cancel x c

theorem left_inverse_add_right_neg_add {G : Type u} [add_group G] (c : G) :
    function.left_inverse (fun (x : G) => c + x) fun (x : G) => -c + x :=
  fun (x : G) => add_neg_cancel_left c x

theorem left_inverse_neg_add_add_right {G : Type u} [add_group G] (c : G) :
    function.left_inverse (fun (x : G) => -c + x) fun (x : G) => c + x :=
  fun (x : G) => neg_add_cancel_left c x

theorem neg_add {G : Type u} [add_comm_group G] (a : G) (b : G) : -(a + b) = -a + -b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-(a + b) = -a + -b)) (neg_add_rev a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-b + -a = -a + -b)) (add_comm (-b) (-a))))
      (Eq.refl (-a + -b)))

theorem sub_add_eq_sub_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a - (b + c) = a - b - c :=
  sorry

theorem neg_add_eq_sub {G : Type u} [add_comm_group G] (a : G) (b : G) : -a + b = b - a := sorry

theorem sub_add_eq_add_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a - b + c = a + c - b :=
  sorry

theorem sub_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b - c = a - (b + c) :=
  sorry

theorem sub_add {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) : a - b + c = a - (b - c) :=
  sorry

@[simp] theorem add_sub_add_left_eq_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    c + a - (c + b) = a - b :=
  sorry

theorem eq_sub_of_add_eq' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : c + a = b) :
    a = b - c :=
  sorry

theorem sub_eq_of_eq_add' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : a = b + c) :
    a - b = c :=
  sorry

theorem eq_add_of_sub_eq' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : a - b = c) :
    a = b + c :=
  sorry

theorem add_eq_of_eq_sub' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} (h : b = c - a) :
    a + b = c :=
  sorry

theorem sub_sub_self {G : Type u} [add_comm_group G] (a : G) (b : G) : a - (a - b) = b := sorry

theorem add_sub_comm {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) (d : G) :
    a + b - (c + d) = a - c + (b - d) :=
  sorry

theorem sub_eq_sub_add_sub {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a - b = c - b + (a - c) :=
  sorry

theorem neg_neg_sub_neg {G : Type u} [add_comm_group G] (a : G) (b : G) : -(-a - -b) = a - b :=
  sorry

@[simp] theorem sub_sub_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) : a - (a - b) = b :=
  sub_sub_self a b

theorem sub_eq_neg_add {G : Type u} [add_comm_group G] (a : G) (b : G) : a - b = -b + a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = -b + a)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b = -b + a)) (add_comm a (-b)))) (Eq.refl (-b + a)))

theorem neg_add' {G : Type u} [add_comm_group G] (a : G) (b : G) : -(a + b) = -a - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-(a + b) = -a - b)) (sub_eq_add_neg (-a) b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-(a + b) = -a + -b)) (neg_add a b))) (Eq.refl (-a + -b)))

@[simp] theorem neg_sub_neg {G : Type u} [add_comm_group G] (a : G) (b : G) : -a - -b = b - a :=
  sorry

theorem eq_sub_iff_add_eq' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} :
    a = b - c ↔ c + a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a = b - c ↔ c + a = b)) (propext eq_sub_iff_add_eq)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + c = b ↔ c + a = b)) (add_comm a c)))
      (iff.refl (c + a = b)))

theorem sub_eq_iff_eq_add' {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} :
    a - b = c ↔ a = b + c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = c ↔ a = b + c)) (propext sub_eq_iff_eq_add)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a = c + b ↔ a = b + c)) (add_comm c b)))
      (iff.refl (a = b + c)))

@[simp] theorem add_sub_cancel' {G : Type u} [add_comm_group G] (a : G) (b : G) : a + b - a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b - a = b)) (sub_eq_neg_add (a + b) a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a + (a + b) = b)) (neg_add_cancel_left a b))) (Eq.refl b))

@[simp] theorem add_sub_cancel'_right {G : Type u} [add_comm_group G] (a : G) (b : G) :
    a + (b - a) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + (b - a) = b)) (Eq.symm (add_sub_assoc a b a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b - a = b)) (add_sub_cancel' a b))) (Eq.refl b))

-- This lemma is in the `simp` set under the name `add_neg_cancel_comm_assoc`,

-- defined  in `algebra/group/commute`

theorem add_add_neg_cancel'_right {G : Type u} [add_comm_group G] (a : G) (b : G) :
    a + (b + -a) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + (b + -a) = b)) (Eq.symm (sub_eq_add_neg b a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + (b - a) = b)) (add_sub_cancel'_right a b))) (Eq.refl b))

theorem sub_right_comm {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a - b - c = a - c - b :=
  sorry

@[simp] theorem add_add_sub_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a + c + (b - c) = a + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + c + (b - c) = a + b)) (add_assoc a c (b - c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + (c + (b - c)) = a + b)) (add_sub_cancel'_right c b)))
      (Eq.refl (a + b)))

@[simp] theorem sub_add_add_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a - c + (b + c) = a + b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - c + (b + c) = a + b)) (add_left_comm (a - c) b c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + (a - c + c) = a + b)) (sub_add_cancel a c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b + a = a + b)) (add_comm b a))) (Eq.refl (a + b))))

@[simp] theorem sub_add_sub_cancel' {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a - b + (c - a) = c - b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b + (c - a) = c - b)) (add_comm (a - b) (c - a))))
    (sub_add_sub_cancel c a b)

@[simp] theorem add_sub_sub_cancel {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    a + b - (a - c) = b + c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + b - (a - c) = b + c)) (Eq.symm (sub_add (a + b) a c))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + b - a + c = b + c)) (add_sub_cancel' a b)))
      (Eq.refl (b + c)))

@[simp] theorem sub_sub_sub_cancel_left {G : Type u} [add_comm_group G] (a : G) (b : G) (c : G) :
    c - a - (c - b) = b - a :=
  sorry

theorem sub_eq_sub_iff_add_eq_add {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} {d : G} :
    a - b = c - d ↔ a + d = c + b :=
  sorry

theorem sub_eq_sub_iff_sub_eq_sub {G : Type u} [add_comm_group G] {a : G} {b : G} {c : G} {d : G} :
    a - b = c - d ↔ a - c = b - d :=
  sorry

end Mathlib


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

! This file was ported from Lean 3 source module representation_theory.character
! leanprover-community/mathlib commit 55b3f8206b8596db8bb1804d8a92814a0b6670c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RepresentationTheory.FdRep
import Mathbin.LinearAlgebra.Trace
import Mathbin.RepresentationTheory.Invariants

/-!
# Characters of representations

This file introduces characters of representation and proves basic lemmas about how characters
behave under various operations on representations.

# TODO
* Once we have the monoidal closed structure on `fdRep k G` and a better API for the rigid
structure, `char_dual` and `char_lin_hom` should probably be stated in terms of `Vᘁ` and `ihom V W`.
-/

noncomputable section

universe u

open CategoryTheory LinearMap CategoryTheory.MonoidalCategory Representation FiniteDimensional

open BigOperators

variable {k : Type u} [Field k]

namespace FdRep

section Monoid

variable {G : Type u} [Monoid G]

/-- The character of a representation `V : fdRep k G` is the function associating to `g : G` the
trace of the linear map `V.ρ g`.-/
def character (V : FdRep k G) (g : G) :=
  LinearMap.trace k V (V.ρ g)
#align fdRep.character FdRep.character

theorem char_mul_comm (V : FdRep k G) (g : G) (h : G) : V.character (h * g) = V.character (g * h) :=
  by simp only [trace_mul_comm, character, map_mul]
#align fdRep.char_mul_comm FdRep.char_mul_comm

@[simp]
theorem char_one (V : FdRep k G) : V.character 1 = FiniteDimensional.finrank k V := by
  simp only [character, map_one, trace_one]
#align fdRep.char_one FdRep.char_one

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The character is multiplicative under the tensor product. -/
@[simp]
theorem char_tensor (V W : FdRep k G) : (V ⊗ W).character = V.character * W.character :=
  by
  ext g
  convert trace_tensor_product' (V.ρ g) (W.ρ g)
#align fdRep.char_tensor FdRep.char_tensor

/-- The character of isomorphic representations is the same. -/
theorem char_iso {V W : FdRep k G} (i : V ≅ W) : V.character = W.character :=
  by
  ext g
  simp only [character, FdRep.Iso.conj_ρ i]
  exact (trace_conj' (V.ρ g) _).symm
#align fdRep.char_iso FdRep.char_iso

end Monoid

section Group

variable {G : Type u} [Group G]

/-- The character of a representation is constant on conjugacy classes. -/
@[simp]
theorem char_conj (V : FdRep k G) (g : G) (h : G) : V.character (h * g * h⁻¹) = V.character g := by
  rw [char_mul_comm, inv_mul_cancel_left]
#align fdRep.char_conj FdRep.char_conj

@[simp]
theorem char_dual (V : FdRep k G) (g : G) : (of (dual V.ρ)).character g = V.character g⁻¹ :=
  trace_transpose' (V.ρ g⁻¹)
#align fdRep.char_dual FdRep.char_dual

@[simp]
theorem char_linHom (V W : FdRep k G) (g : G) :
    (of (linHom V.ρ W.ρ)).character g = V.character g⁻¹ * W.character g := by
  rw [← char_iso (dual_tensor_iso_lin_hom _ _), char_tensor, Pi.mul_apply, char_dual]
#align fdRep.char_lin_hom FdRep.char_linHom

variable [Fintype G] [Invertible (Fintype.card G : k)]

theorem average_char_eq_finrank_invariants (V : FdRep k G) :
    (⅟ (Fintype.card G : k) • ∑ g : G, V.character g) = finrank k (invariants V.ρ) :=
  by
  rw [← (is_proj_average_map V.ρ).trace]
  simp [character, GroupAlgebra.average, _root_.map_sum]
#align fdRep.average_char_eq_finrank_invariants FdRep.average_char_eq_finrank_invariants

end Group

section Orthogonality

variable {G : GroupCat.{u}} [IsAlgClosed k]

open Classical

variable [Fintype G] [Invertible (Fintype.card G : k)]

/-- Orthogonality of characters for irreducible representations of finite group over an
algebraically closed field whose characteristic doesn't divide the order of the group. -/
theorem char_orthonormal (V W : FdRep k G) [Simple V] [Simple W] :
    (⅟ (Fintype.card G : k) • ∑ g : G, V.character g * W.character g⁻¹) =
      if Nonempty (V ≅ W) then ↑1 else ↑0 :=
  by
  -- First, we can rewrite the summand `V.character g * W.character g⁻¹` as the character
  -- of the representation `V ⊗ W* ≅ Hom(W, V)` applied to `g`.
  conv in
    V.character _ *
      W.character _ =>
    rw [mul_comm, ← char_dual, ← Pi.mul_apply, ← char_tensor]
    rw [char_iso (FdRep.dualTensorIsoLinHom W.ρ V)]
  -- The average over the group of the character of a representation equals the dimension of the
  -- space of invariants.
  rw [average_char_eq_finrank_invariants]
  rw [show (of (lin_hom W.ρ V.ρ)).ρ = lin_hom W.ρ V.ρ from FdRep.of_ρ (lin_hom W.ρ V.ρ)]
  -- The space of invariants of `Hom(W, V)` is the subspace of `G`-equivariant linear maps,
  -- `Hom_G(W, V)`.
  rw [(lin_hom.invariants_equiv_fdRep_hom W V).finrank_eq]
  -- By Schur's Lemma, the dimension of `Hom_G(W, V)` is `1` is `V ≅ W` and `0` otherwise.
  rw_mod_cast [finrank_hom_simple_simple W V, iso.nonempty_iso_symm]
#align fdRep.char_orthonormal FdRep.char_orthonormal

end Orthogonality

end FdRep


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

import algebra.gcd_monoid.multiset
import combinatorics.partition
import group_theory.perm.cycle.basic
import ring_theory.int.basic
import tactic.linarith

/-!
# Cycle Types

In this file we define the cycle type of a permutation.

## Main definitions

- `σ.cycle_type` where `σ` is a permutation of a `fintype`
- `σ.partition` where `σ` is a permutation of a `fintype`

## Main results

- `sum_cycle_type` : The sum of `σ.cycle_type` equals `σ.support.card`
- `lcm_cycle_type` : The lcm of `σ.cycle_type` equals `order_of σ`
- `is_conj_iff_cycle_type_eq` : Two permutations are conjugate if and only if they have the same
  cycle type.
- `exists_prime_order_of_dvd_card`: For every prime `p` dividing the order of a finite group `G`
  there exists an element of order `p` in `G`. This is known as Cauchy's theorem.
-/

namespace equiv.perm
open equiv list multiset

variables {α : Type*} [fintype α]

section cycle_type

variables [decidable_eq α]

/-- The cycle type of a permutation -/
def cycle_type (σ : perm α) : multiset ℕ :=
σ.cycle_factors_finset.1.map (finset.card ∘ support)

lemma cycle_type_def (σ : perm α) :
  σ.cycle_type = σ.cycle_factors_finset.1.map (finset.card ∘ support) := rfl

lemma cycle_type_eq' {σ : perm α} (s : finset (perm α))
  (h1 : ∀ f : perm α, f ∈ s → f.is_cycle) (h2 : ∀ (a ∈ s) (b ∈ s), a ≠ b → disjoint a b)
  (h0 : s.noncomm_prod id
    (λ a ha b hb, (em (a = b)).by_cases (λ h, h ▸ commute.refl a)
      (set.pairwise.mono' (λ _ _, disjoint.commute) h2 ha hb)) = σ) :
  σ.cycle_type = s.1.map (finset.card ∘ support) :=
begin
  rw cycle_type_def,
  congr,
  rw cycle_factors_finset_eq_finset,
  exact ⟨h1, h2, h0⟩
end

lemma cycle_type_eq {σ : perm α} (l : list (perm α)) (h0 : l.prod = σ)
  (h1 : ∀ σ : perm α, σ ∈ l → σ.is_cycle) (h2 : l.pairwise disjoint) :
  σ.cycle_type = l.map (finset.card ∘ support) :=
begin
  have hl : l.nodup := nodup_of_pairwise_disjoint_cycles h1 h2,
  rw cycle_type_eq' l.to_finset,
  { simp [list.dedup_eq_self.mpr hl] },
  { simpa using h1 },
  { simpa [hl] using h0 },
  { simpa [list.dedup_eq_self.mpr hl] using h2.forall disjoint.symmetric }
end

lemma cycle_type_one : (1 : perm α).cycle_type = 0 :=
cycle_type_eq [] rfl (λ _, false.elim) pairwise.nil

lemma cycle_type_eq_zero {σ : perm α} : σ.cycle_type = 0 ↔ σ = 1 :=
by simp [cycle_type_def, cycle_factors_finset_eq_empty_iff]

lemma card_cycle_type_eq_zero {σ : perm α} : σ.cycle_type.card = 0 ↔ σ = 1 :=
by rw [card_eq_zero, cycle_type_eq_zero]

lemma two_le_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : 2 ≤ n :=
begin
  simp only [cycle_type_def, ←finset.mem_def, function.comp_app, multiset.mem_map,
    mem_cycle_factors_finset_iff] at h,
  obtain ⟨_, ⟨hc, -⟩, rfl⟩ := h,
  exact hc.two_le_card_support
end

lemma one_lt_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : 1 < n :=
two_le_of_mem_cycle_type h

lemma is_cycle.cycle_type {σ : perm α} (hσ : is_cycle σ) : σ.cycle_type = [σ.support.card] :=
cycle_type_eq [σ] (mul_one σ) (λ τ hτ, (congr_arg is_cycle (list.mem_singleton.mp hτ)).mpr hσ)
  (pairwise_singleton disjoint σ)

lemma card_cycle_type_eq_one {σ : perm α} : σ.cycle_type.card = 1 ↔ σ.is_cycle :=
begin
  rw card_eq_one,
  simp_rw [cycle_type_def, multiset.map_eq_singleton, ←finset.singleton_val,
           finset.val_inj, cycle_factors_finset_eq_singleton_iff],
  split,
  { rintro ⟨_, _, ⟨h, -⟩, -⟩,
    exact h },
  { intro h,
    use [σ.support.card, σ],
    simp [h] }
end

lemma disjoint.cycle_type {σ τ : perm α} (h : disjoint σ τ) :
  (σ * τ).cycle_type = σ.cycle_type + τ.cycle_type :=
begin
  rw [cycle_type_def, cycle_type_def, cycle_type_def, h.cycle_factors_finset_mul_eq_union,
      ←multiset.map_add, finset.union_val, multiset.add_eq_union_iff_disjoint.mpr _],
  rw [←finset.disjoint_val],
  exact h.disjoint_cycle_factors_finset
end

lemma cycle_type_inv (σ : perm α) : σ⁻¹.cycle_type = σ.cycle_type :=
cycle_induction_on (λ τ : perm α, τ⁻¹.cycle_type = τ.cycle_type) σ rfl
  (λ σ hσ, by rw [hσ.cycle_type, hσ.inv.cycle_type, support_inv])
  (λ σ τ hστ hc hσ hτ, by rw [mul_inv_rev, hστ.cycle_type, ←hσ, ←hτ, add_comm,
    disjoint.cycle_type (λ x, or.imp (λ h : τ x = x, inv_eq_iff_eq.mpr h.symm)
    (λ h : σ x = x, inv_eq_iff_eq.mpr h.symm) (hστ x).symm)])

lemma cycle_type_conj {σ τ : perm α} : (τ * σ * τ⁻¹).cycle_type = σ.cycle_type :=
begin
  revert τ,
  apply cycle_induction_on _ σ,
  { intro,
    simp },
  { intros σ hσ τ,
    rw [hσ.cycle_type, hσ.is_cycle_conj.cycle_type, card_support_conj] },
  { intros σ τ hd hc hσ hτ π,
    rw [← conj_mul, hd.cycle_type, disjoint.cycle_type, hσ, hτ],
    intro a,
    apply (hd (π⁻¹ a)).imp _ _;
    { intro h, rw [perm.mul_apply, perm.mul_apply, h, apply_inv_self] } }
end

lemma sum_cycle_type (σ : perm α) : σ.cycle_type.sum = σ.support.card :=
cycle_induction_on (λ τ : perm α, τ.cycle_type.sum = τ.support.card) σ
  (by rw [cycle_type_one, sum_zero, support_one, finset.card_empty])
  (λ σ hσ, by rw [hσ.cycle_type, coe_sum, list.sum_singleton])
  (λ σ τ hστ hc hσ hτ, by rw [hστ.cycle_type, sum_add, hσ, hτ, hστ.card_support_mul])

lemma sign_of_cycle_type' (σ : perm α) :
  sign σ = (σ.cycle_type.map (λ n, -(-1 : ℤˣ) ^ n)).prod :=
cycle_induction_on (λ τ : perm α, sign τ = (τ.cycle_type.map (λ n, -(-1 : ℤˣ) ^ n)).prod) σ
  (by rw [sign_one, cycle_type_one, multiset.map_zero, prod_zero])
  (λ σ hσ, by rw [hσ.sign, hσ.cycle_type, coe_map, coe_prod,
    list.map_singleton, list.prod_singleton])
  (λ σ τ hστ hc hσ hτ, by rw [sign_mul, hσ, hτ, hστ.cycle_type, multiset.map_add, prod_add])

lemma sign_of_cycle_type (f : perm α) :
  sign f = (-1 : ℤˣ)^(f.cycle_type.sum + f.cycle_type.card) :=
cycle_induction_on
  (λ f : perm α, sign f = (-1 : ℤˣ)^(f.cycle_type.sum + f.cycle_type.card))
  f
  ( -- base_one
    by rw [equiv.perm.cycle_type_one, sign_one, multiset.sum_zero, multiset.card_zero, pow_zero] )
  ( -- base_cycles
    λ f hf,
      by rw [equiv.perm.is_cycle.cycle_type hf, hf.sign,
      coe_sum, list.sum_cons, sum_nil, add_zero, coe_card, length_singleton,
      pow_add, pow_one, mul_comm, neg_mul, one_mul] )
  ( -- induction_disjoint
    λ f g hfg hf Pf Pg,
    by rw [equiv.perm.disjoint.cycle_type hfg,
      multiset.sum_add, multiset.card_add,← add_assoc,
      add_comm f.cycle_type.sum g.cycle_type.sum,
      add_assoc g.cycle_type.sum _ _,
      add_comm g.cycle_type.sum _,
      add_assoc, pow_add,
      ← Pf, ← Pg,
      equiv.perm.sign_mul])

lemma lcm_cycle_type (σ : perm α) : σ.cycle_type.lcm = order_of σ :=
cycle_induction_on (λ τ : perm α, τ.cycle_type.lcm = order_of τ) σ
  (by rw [cycle_type_one, lcm_zero, order_of_one])
  (λ σ hσ, by rw [hσ.cycle_type, ←singleton_coe, ←singleton_eq_cons, lcm_singleton,
    order_of_is_cycle hσ, normalize_eq])
  (λ σ τ hστ hc hσ hτ, by rw [hστ.cycle_type, lcm_add, lcm_eq_nat_lcm, hστ.order_of, hσ, hτ])

lemma dvd_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : n ∣ order_of σ :=
begin
  rw ← lcm_cycle_type,
  exact dvd_lcm h,
end

lemma order_of_cycle_of_dvd_order_of (f : perm α) (x : α) :
  order_of (cycle_of f x) ∣ order_of f :=
begin
  by_cases hx : f x = x,
  { rw ←cycle_of_eq_one_iff at hx,
    simp [hx] },
  { refine dvd_of_mem_cycle_type _,
    rw [cycle_type, multiset.mem_map],
    refine ⟨f.cycle_of x, _, _⟩,
    { rwa [←finset.mem_def, cycle_of_mem_cycle_factors_finset_iff, mem_support] },
    { simp [order_of_is_cycle (is_cycle_cycle_of _ hx)] } }
end

lemma two_dvd_card_support {σ : perm α} (hσ : σ ^ 2 = 1) : 2 ∣ σ.support.card :=
(congr_arg (has_dvd.dvd 2) σ.sum_cycle_type).mp
  (multiset.dvd_sum (λ n hn, by rw le_antisymm (nat.le_of_dvd zero_lt_two $
  (dvd_of_mem_cycle_type hn).trans $ order_of_dvd_of_pow_eq_one hσ) (two_le_of_mem_cycle_type hn)))

lemma cycle_type_prime_order {σ : perm α} (hσ : (order_of σ).prime) :
  ∃ n : ℕ, σ.cycle_type = repeat (order_of σ) (n + 1) :=
begin
  rw eq_repeat_of_mem (λ n hn, or_iff_not_imp_left.mp
    (hσ.eq_one_or_self_of_dvd n (dvd_of_mem_cycle_type hn)) (one_lt_of_mem_cycle_type hn).ne'),
  use σ.cycle_type.card - 1,
  rw tsub_add_cancel_of_le,
  rw [nat.succ_le_iff, pos_iff_ne_zero, ne, card_cycle_type_eq_zero],
  intro H,
  rw [H, order_of_one] at hσ,
  exact hσ.ne_one rfl,
end

lemma is_cycle_of_prime_order {σ : perm α} (h1 : (order_of σ).prime)
  (h2 : σ.support.card < 2 * (order_of σ)) : σ.is_cycle :=
begin
  obtain ⟨n, hn⟩ := cycle_type_prime_order h1,
  rw [←σ.sum_cycle_type, hn, multiset.sum_repeat, nsmul_eq_mul, nat.cast_id, mul_lt_mul_right
      (order_of_pos σ), nat.succ_lt_succ_iff, nat.lt_succ_iff, nat.le_zero_iff] at h2,
  rw [←card_cycle_type_eq_one, hn, card_repeat, h2],
end

lemma cycle_type_le_of_mem_cycle_factors_finset {f g : perm α}
  (hf : f ∈ g.cycle_factors_finset) :
  f.cycle_type ≤ g.cycle_type :=
begin
  rw mem_cycle_factors_finset_iff at hf,
  rw [cycle_type_def, cycle_type_def, hf.left.cycle_factors_finset_eq_singleton],
  refine map_le_map _,
  simpa [←finset.mem_def, mem_cycle_factors_finset_iff] using hf
end

lemma cycle_type_mul_mem_cycle_factors_finset_eq_sub {f g : perm α}
  (hf : f ∈ g.cycle_factors_finset) :
  (g * f⁻¹).cycle_type = g.cycle_type - f.cycle_type :=
begin
  suffices : (g * f⁻¹).cycle_type + f.cycle_type = g.cycle_type - f.cycle_type + f.cycle_type,
  { rw tsub_add_cancel_of_le (cycle_type_le_of_mem_cycle_factors_finset hf) at this,
    simp [←this] },
  simp [←(disjoint_mul_inv_of_mem_cycle_factors_finset hf).cycle_type,
    tsub_add_cancel_of_le (cycle_type_le_of_mem_cycle_factors_finset hf)]
end

theorem is_conj_of_cycle_type_eq {σ τ : perm α} (h : cycle_type σ = cycle_type τ) : is_conj σ τ :=
begin
  revert τ,
  apply cycle_induction_on _ σ,
  { intros τ h,
    rw [cycle_type_one, eq_comm, cycle_type_eq_zero] at h,
    rw h },
  { intros σ hσ τ hστ,
    have hτ := card_cycle_type_eq_one.2 hσ,
    rw [hστ, card_cycle_type_eq_one] at hτ,
    apply hσ.is_conj hτ,
    rw [hσ.cycle_type, hτ.cycle_type, coe_eq_coe, singleton_perm] at hστ,
    simp only [and_true, eq_self_iff_true] at hστ,
    exact hστ },
  { intros σ τ hστ hσ h1 h2 π hπ,
    rw [hστ.cycle_type] at hπ,
    { have h : σ.support.card ∈ map (finset.card ∘ perm.support) π.cycle_factors_finset.val,
      { simp [←cycle_type_def, ←hπ, hσ.cycle_type] },
      obtain ⟨σ', hσ'l, hσ'⟩ := multiset.mem_map.mp h,
      have key : is_conj (σ' * (π * σ'⁻¹)) π,
      { rw is_conj_iff,
        use σ'⁻¹,
        simp [mul_assoc] },
      refine is_conj.trans _ key,
      have hs : σ.cycle_type = σ'.cycle_type,
      { rw [←finset.mem_def, mem_cycle_factors_finset_iff] at hσ'l,
        rw [hσ.cycle_type, ←hσ', hσ'l.left.cycle_type] },
      refine hστ.is_conj_mul (h1 hs) (h2 _) _,
      { rw [cycle_type_mul_mem_cycle_factors_finset_eq_sub, ←hπ, add_comm, hs,
            add_tsub_cancel_right],
        rwa finset.mem_def },
      { exact (disjoint_mul_inv_of_mem_cycle_factors_finset hσ'l).symm } } }
end

theorem is_conj_iff_cycle_type_eq {σ τ : perm α} :
  is_conj σ τ ↔ σ.cycle_type = τ.cycle_type :=
⟨λ h, begin
  obtain ⟨π, rfl⟩ := is_conj_iff.1 h,
  rw cycle_type_conj,
end, is_conj_of_cycle_type_eq⟩

@[simp] lemma cycle_type_extend_domain {β : Type*} [fintype β] [decidable_eq β]
  {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p) {g : perm α} :
  cycle_type (g.extend_domain f) = cycle_type g :=
begin
  apply cycle_induction_on _ g,
  { rw [extend_domain_one, cycle_type_one, cycle_type_one] },
  { intros σ hσ,
    rw [(hσ.extend_domain f).cycle_type, hσ.cycle_type, card_support_extend_domain] },
  { intros σ τ hd hc hσ hτ,
    rw [hd.cycle_type, ← extend_domain_mul, (hd.extend_domain f).cycle_type, hσ, hτ] }
end

lemma mem_cycle_type_iff {n : ℕ} {σ : perm α} :
  n ∈ cycle_type σ ↔ ∃ c τ : perm α, σ = c * τ ∧ disjoint c τ ∧ is_cycle c ∧ c.support.card = n :=
begin
  split,
  { intro h,
    obtain ⟨l, rfl, hlc, hld⟩ := trunc_cycle_factors σ,
    rw cycle_type_eq _ rfl hlc hld at h,
    obtain ⟨c, cl, rfl⟩ := list.exists_of_mem_map h,
    rw (list.perm_cons_erase cl).pairwise_iff (λ _ _ hd, _) at hld,
    swap, { exact hd.symm },
    refine ⟨c, (l.erase c).prod, _, _, hlc _ cl, rfl⟩,
    { rw [← list.prod_cons,
        (list.perm_cons_erase cl).symm.prod_eq' (hld.imp (λ _ _, disjoint.commute))] },
    { exact disjoint_prod_right _ (λ g, list.rel_of_pairwise_cons hld) } },
  { rintros ⟨c, t, rfl, hd, hc, rfl⟩,
    simp [hd.cycle_type, hc.cycle_type] }
end

lemma le_card_support_of_mem_cycle_type {n : ℕ} {σ : perm α} (h : n ∈ cycle_type σ) :
  n ≤ σ.support.card :=
(le_sum_of_mem h).trans (le_of_eq σ.sum_cycle_type)

lemma cycle_type_of_card_le_mem_cycle_type_add_two {n : ℕ} {g : perm α}
  (hn2 : fintype.card α < n + 2) (hng : n ∈ g.cycle_type) :
  g.cycle_type = {n} :=
begin
  obtain ⟨c, g', rfl, hd, hc, rfl⟩ := mem_cycle_type_iff.1 hng,
  by_cases g'1 : g' = 1,
  { rw [hd.cycle_type, hc.cycle_type, multiset.singleton_eq_cons, multiset.singleton_coe,
      g'1, cycle_type_one, add_zero] },
  contrapose! hn2,
  apply le_trans _ (c * g').support.card_le_univ,
  rw [hd.card_support_mul],
  exact add_le_add_left (two_le_card_support_of_ne_one g'1) _,
end

end cycle_type

lemma card_compl_support_modeq [decidable_eq α] {p n : ℕ} [hp : fact p.prime] {σ : perm α}
  (hσ : σ ^ p ^ n = 1) : σ.supportᶜ.card ≡ fintype.card α [MOD p] :=
begin
  rw [nat.modeq_iff_dvd' σ.supportᶜ.card_le_univ, ←finset.card_compl, compl_compl],
  refine (congr_arg _ σ.sum_cycle_type).mp (multiset.dvd_sum (λ k hk, _)),
  obtain ⟨m, -, hm⟩ := (nat.dvd_prime_pow hp.out).mp (order_of_dvd_of_pow_eq_one hσ),
  obtain ⟨l, -, rfl⟩ := (nat.dvd_prime_pow hp.out).mp
    ((congr_arg _ hm).mp (dvd_of_mem_cycle_type hk)),
  exact dvd_pow_self _ (λ h, (one_lt_of_mem_cycle_type hk).ne $ by rw [h, pow_zero]),
end

lemma exists_fixed_point_of_prime {p n : ℕ} [hp : fact p.prime] (hα : ¬ p ∣ fintype.card α)
  {σ : perm α} (hσ : σ ^ p ^ n = 1) : ∃ a : α, σ a = a :=
begin
  classical,
  contrapose! hα,
  simp_rw ← mem_support at hα,
  exact nat.modeq_zero_iff_dvd.mp ((congr_arg _ (finset.card_eq_zero.mpr (compl_eq_bot.mpr
    (finset.eq_univ_iff_forall.mpr hα)))).mp (card_compl_support_modeq hσ).symm),
end

lemma exists_fixed_point_of_prime' {p n : ℕ} [hp : fact p.prime] (hα : p ∣ fintype.card α)
  {σ : perm α} (hσ : σ ^ p ^ n = 1) {a : α} (ha : σ a = a) : ∃ b : α, σ b = b ∧ b ≠ a :=
begin
  classical,
  have h : ∀ b : α, b ∈ σ.supportᶜ ↔ σ b = b :=
  λ b, by rw [finset.mem_compl, mem_support, not_not],
  obtain ⟨b, hb1, hb2⟩ := finset.exists_ne_of_one_lt_card (lt_of_lt_of_le hp.out.one_lt
    (nat.le_of_dvd (finset.card_pos.mpr ⟨a, (h a).mpr ha⟩) (nat.modeq_zero_iff_dvd.mp
    ((card_compl_support_modeq hσ).trans (nat.modeq_zero_iff_dvd.mpr hα))))) a,
  exact ⟨b, (h b).mp hb1, hb2⟩,
end

lemma is_cycle_of_prime_order' {σ : perm α} (h1 : (order_of σ).prime)
  (h2 : fintype.card α < 2 * (order_of σ)) : σ.is_cycle :=
begin
  classical,
  exact is_cycle_of_prime_order h1 (lt_of_le_of_lt σ.support.card_le_univ h2),
end

section cauchy

variables (G : Type*) [group G] (n : ℕ)

/-- The type of vectors with terms from `G`, length `n`, and product equal to `1:G`. -/
def vectors_prod_eq_one : set (vector G n) :=
{v | v.to_list.prod = 1}

namespace vectors_prod_eq_one

lemma mem_iff {n : ℕ} (v : vector G n) :
v ∈ vectors_prod_eq_one G n ↔ v.to_list.prod = 1 := iff.rfl

lemma zero_eq : vectors_prod_eq_one G 0 = {vector.nil} :=
set.eq_singleton_iff_unique_mem.mpr ⟨eq.refl (1 : G), λ v hv, v.eq_nil⟩

lemma one_eq : vectors_prod_eq_one G 1 = {vector.nil.cons 1} :=
begin
  simp_rw [set.eq_singleton_iff_unique_mem, mem_iff,
    vector.to_list_singleton, list.prod_singleton, vector.head_cons],
  exact ⟨rfl, λ v hv, v.cons_head_tail.symm.trans (congr_arg2 vector.cons hv v.tail.eq_nil)⟩,
end

instance zero_unique : unique (vectors_prod_eq_one G 0) :=
by { rw zero_eq, exact set.unique_singleton vector.nil }

instance one_unique : unique (vectors_prod_eq_one G 1) :=
by { rw one_eq, exact set.unique_singleton (vector.nil.cons 1) }

/-- Given a vector `v` of length `n`, make a vector of length `n + 1` whose product is `1`,
by appending the inverse of the product of `v`. -/
@[simps] def vector_equiv : vector G n ≃ vectors_prod_eq_one G (n + 1) :=
{ to_fun := λ v, ⟨v.to_list.prod⁻¹ ::ᵥ v,
    by rw [mem_iff, vector.to_list_cons, list.prod_cons, inv_mul_self]⟩,
  inv_fun := λ v, v.1.tail,
  left_inv := λ v, v.tail_cons v.to_list.prod⁻¹,
  right_inv := λ v, subtype.ext ((congr_arg2 vector.cons (eq_inv_of_mul_eq_one_left (by
  { rw [←list.prod_cons, ←vector.to_list_cons, v.1.cons_head_tail],
    exact v.2 })).symm rfl).trans v.1.cons_head_tail) }

/-- Given a vector `v` of length `n` whose product is 1, make a vector of length `n - 1`,
by deleting the last entry of `v`. -/
def equiv_vector : vectors_prod_eq_one G n ≃ vector G (n - 1) :=
((vector_equiv G (n - 1)).trans (if hn : n = 0 then (show vectors_prod_eq_one G (n - 1 + 1) ≃
  vectors_prod_eq_one G n, by { rw hn, apply equiv_of_unique })
  else by rw tsub_add_cancel_of_le (nat.pos_of_ne_zero hn).nat_succ_le)).symm

instance [fintype G] : fintype (vectors_prod_eq_one G n) :=
fintype.of_equiv (vector G (n - 1)) (equiv_vector G n).symm

lemma card [fintype G] :
  fintype.card (vectors_prod_eq_one G n) = fintype.card G ^ (n - 1) :=
(fintype.card_congr (equiv_vector G n)).trans (card_vector (n - 1))

variables {G n} {g : G} (v : vectors_prod_eq_one G n) (j k : ℕ)

/-- Rotate a vector whose product is 1. -/
def rotate : vectors_prod_eq_one G n :=
⟨⟨_, (v.1.1.length_rotate k).trans v.1.2⟩, list.prod_rotate_eq_one_of_prod_eq_one v.2 k⟩

lemma rotate_zero : rotate v 0 = v :=
subtype.ext (subtype.ext v.1.1.rotate_zero)

lemma rotate_rotate : rotate (rotate v j) k = rotate v (j + k) :=
subtype.ext (subtype.ext (v.1.1.rotate_rotate j k))

lemma rotate_length : rotate v n = v :=
subtype.ext (subtype.ext ((congr_arg _ v.1.2.symm).trans v.1.1.rotate_length))

end vectors_prod_eq_one

/-- For every prime `p` dividing the order of a finite group `G` there exists an element of order
`p` in `G`. This is known as Cauchy's theorem. -/
lemma _root_.exists_prime_order_of_dvd_card {G : Type*} [group G] [fintype G] (p : ℕ)
  [hp : fact p.prime] (hdvd : p ∣ fintype.card G) : ∃ x : G, order_of x = p :=
begin
  have hp' : p - 1 ≠ 0 := mt tsub_eq_zero_iff_le.mp (not_le_of_lt hp.out.one_lt),
  have Scard := calc p ∣ fintype.card G ^ (p - 1) : hdvd.trans (dvd_pow (dvd_refl _) hp')
  ... = fintype.card (vectors_prod_eq_one G p) : (vectors_prod_eq_one.card G p).symm,
  let f : ℕ → vectors_prod_eq_one G p → vectors_prod_eq_one G p :=
  λ k v, vectors_prod_eq_one.rotate v k,
  have hf1 : ∀ v, f 0 v = v := vectors_prod_eq_one.rotate_zero,
  have hf2 : ∀ j k v, f k (f j v) = f (j + k) v :=
  λ j k v, vectors_prod_eq_one.rotate_rotate v j k,
  have hf3 : ∀ v, f p v = v := vectors_prod_eq_one.rotate_length,
  let σ := equiv.mk (f 1) (f (p - 1))
    (λ s, by rw [hf2, add_tsub_cancel_of_le hp.out.one_lt.le, hf3])
    (λ s, by rw [hf2, tsub_add_cancel_of_le hp.out.one_lt.le, hf3]),
  have hσ : ∀ k v, (σ ^ k) v = f k v :=
  λ k v, nat.rec (hf1 v).symm (λ k hk, eq.trans (by exact congr_arg σ hk) (hf2 k 1 v)) k,
  replace hσ : σ ^ (p ^ 1) = 1 := perm.ext (λ v, by rw [pow_one, hσ, hf3, one_apply]),
  let v₀ : vectors_prod_eq_one G p := ⟨vector.repeat 1 p, (list.prod_repeat 1 p).trans (one_pow p)⟩,
  have hv₀ : σ v₀ = v₀ := subtype.ext (subtype.ext (list.rotate_repeat (1 : G) p 1)),
  obtain ⟨v, hv1, hv2⟩ := exists_fixed_point_of_prime' Scard hσ hv₀,
  refine exists_imp_exists (λ g hg, order_of_eq_prime _ (λ hg', hv2 _))
    (list.rotate_one_eq_self_iff_eq_repeat.mp (subtype.ext_iff.mp (subtype.ext_iff.mp hv1))),
  { rw [←list.prod_repeat, ←v.1.2, ←hg, (show v.val.val.prod = 1, from v.2)] },
  { rw [subtype.ext_iff_val, subtype.ext_iff_val, hg, hg', v.1.2],
    refl },
end

/-- For every prime `p` dividing the order of a finite additive group `G` there exists an element of
order `p` in `G`. This is the additive version of Cauchy's theorem. -/
lemma _root_.exists_prime_add_order_of_dvd_card {G : Type*} [add_group G] [fintype G] (p : ℕ)
  [hp : fact p.prime] (hdvd : p ∣ fintype.card G) : ∃ x : G, add_order_of x = p :=
@exists_prime_order_of_dvd_card (multiplicative G) _ _ _ _ hdvd

attribute [to_additive exists_prime_add_order_of_dvd_card] exists_prime_order_of_dvd_card

end cauchy

lemma subgroup_eq_top_of_swap_mem [decidable_eq α] {H : subgroup (perm α)}
  [d : decidable_pred (∈ H)] {τ : perm α} (h0 : (fintype.card α).prime)
  (h1 : fintype.card α ∣ fintype.card H) (h2 : τ ∈ H) (h3 : is_swap τ) :
  H = ⊤ :=
begin
  haveI : fact (fintype.card α).prime := ⟨h0⟩,
  obtain ⟨σ, hσ⟩ := exists_prime_order_of_dvd_card (fintype.card α) h1,
  have hσ1 : order_of (σ : perm α) = fintype.card α := (order_of_subgroup σ).trans hσ,
  have hσ2 : is_cycle ↑σ := is_cycle_of_prime_order'' h0 hσ1,
  have hσ3 : (σ : perm α).support = ⊤ :=
    finset.eq_univ_of_card (σ : perm α).support ((order_of_is_cycle hσ2).symm.trans hσ1),
  have hσ4 : subgroup.closure {↑σ, τ} = ⊤ := closure_prime_cycle_swap h0 hσ2 hσ3 h3,
  rw [eq_top_iff, ←hσ4, subgroup.closure_le, set.insert_subset, set.singleton_subset_iff],
  exact ⟨subtype.mem σ, h2⟩,
end

section partition

variables [decidable_eq α]

/-- The partition corresponding to a permutation -/
def partition (σ : perm α) : (fintype.card α).partition :=
{ parts := σ.cycle_type + repeat 1 (fintype.card α - σ.support.card),
  parts_pos := λ n hn,
  begin
    cases mem_add.mp hn with hn hn,
    { exact zero_lt_one.trans (one_lt_of_mem_cycle_type hn) },
    { exact lt_of_lt_of_le zero_lt_one (ge_of_eq (multiset.eq_of_mem_repeat hn)) },
  end,
  parts_sum := by rw [sum_add, sum_cycle_type, multiset.sum_repeat, nsmul_eq_mul,
    nat.cast_id, mul_one, add_tsub_cancel_of_le σ.support.card_le_univ] }

lemma parts_partition {σ : perm α} :
  σ.partition.parts = σ.cycle_type + repeat 1 (fintype.card α - σ.support.card) := rfl

lemma filter_parts_partition_eq_cycle_type {σ : perm α} :
  (partition σ).parts.filter (λ n, 2 ≤ n) = σ.cycle_type :=
begin
  rw [parts_partition, filter_add, multiset.filter_eq_self.2 (λ _, two_le_of_mem_cycle_type),
    multiset.filter_eq_nil.2 (λ a h, _), add_zero],
  rw multiset.eq_of_mem_repeat h,
  dec_trivial
end

lemma partition_eq_of_is_conj {σ τ : perm α} :
  is_conj σ τ ↔ σ.partition = τ.partition :=
begin
  rw [is_conj_iff_cycle_type_eq],
  refine ⟨λ h, _, λ h, _⟩,
  { rw [nat.partition.ext_iff, parts_partition, parts_partition,
      ← sum_cycle_type, ← sum_cycle_type, h] },
  { rw [← filter_parts_partition_eq_cycle_type, ← filter_parts_partition_eq_cycle_type, h] }
end

end partition

/-!
### 3-cycles
-/

/-- A three-cycle is a cycle of length 3. -/
def is_three_cycle [decidable_eq α] (σ : perm α) : Prop := σ.cycle_type = {3}

namespace is_three_cycle

variables [decidable_eq α] {σ : perm α}

lemma cycle_type (h : is_three_cycle σ) : σ.cycle_type = {3} := h

lemma card_support (h : is_three_cycle σ) : σ.support.card = 3 :=
by rw [←sum_cycle_type, h.cycle_type, multiset.sum_singleton]

lemma _root_.card_support_eq_three_iff : σ.support.card = 3 ↔ σ.is_three_cycle :=
begin
  refine ⟨λ h, _, is_three_cycle.card_support⟩,
  by_cases h0 : σ.cycle_type = 0,
  { rw [←sum_cycle_type, h0, sum_zero] at h,
    exact (ne_of_lt zero_lt_three h).elim },
  obtain ⟨n, hn⟩ := exists_mem_of_ne_zero h0,
  by_cases h1 : σ.cycle_type.erase n = 0,
  { rw [←sum_cycle_type, ←cons_erase hn, h1, ←singleton_eq_cons, multiset.sum_singleton] at h,
    rw [is_three_cycle, ←cons_erase hn, h1, h, singleton_eq_cons] },
  obtain ⟨m, hm⟩ := exists_mem_of_ne_zero h1,
  rw [←sum_cycle_type, ←cons_erase hn, ←cons_erase hm, multiset.sum_cons, multiset.sum_cons] at h,
  -- TODO: linarith [...] should solve this directly
  have : ∀ {k}, 2 ≤ m → 2 ≤ n → n + (m + k) = 3 → false, { intros, linarith },
  cases this (two_le_of_mem_cycle_type (mem_of_mem_erase hm)) (two_le_of_mem_cycle_type hn) h,
end

lemma is_cycle (h : is_three_cycle σ) : is_cycle σ :=
by rw [←card_cycle_type_eq_one, h.cycle_type, card_singleton]

lemma sign (h : is_three_cycle σ) : sign σ = 1 :=
begin
  rw [equiv.perm.sign_of_cycle_type, h.cycle_type],
  refl,
end

lemma inv {f : perm α} (h : is_three_cycle f) : is_three_cycle (f⁻¹) :=
by rwa [is_three_cycle, cycle_type_inv]

@[simp] lemma inv_iff {f : perm α} : is_three_cycle (f⁻¹) ↔ is_three_cycle f :=
⟨by { rw ← inv_inv f, apply inv }, inv⟩

lemma order_of {g : perm α} (ht : is_three_cycle g) :
  order_of g = 3 :=
by rw [←lcm_cycle_type, ht.cycle_type, multiset.lcm_singleton, normalize_eq]

lemma is_three_cycle_sq {g : perm α} (ht : is_three_cycle g) :
  is_three_cycle (g * g) :=
begin
  rw [←pow_two, ←card_support_eq_three_iff, support_pow_coprime, ht.card_support],
  rw [ht.order_of, nat.coprime_iff_gcd_eq_one],
  norm_num,
end

end is_three_cycle

section
variable [decidable_eq α]

lemma is_three_cycle_swap_mul_swap_same
  {a b c : α} (ab : a ≠ b) (ac : a ≠ c) (bc : b ≠ c) :
  is_three_cycle (swap a b * swap a c) :=
begin
  suffices h : support (swap a b * swap a c) = {a, b, c},
  { rw [←card_support_eq_three_iff, h],
    simp [ab, ac, bc] },
  apply le_antisymm ((support_mul_le _ _).trans (λ x, _)) (λ x hx, _),
  { simp [ab, ac, bc] },
  { simp only [finset.mem_insert, finset.mem_singleton] at hx,
    rw mem_support,
    simp only [perm.coe_mul, function.comp_app, ne.def],
    obtain rfl | rfl | rfl := hx,
    { rw [swap_apply_left, swap_apply_of_ne_of_ne ac.symm bc.symm],
      exact ac.symm },
    { rw [swap_apply_of_ne_of_ne ab.symm bc, swap_apply_right],
      exact ab },
    { rw [swap_apply_right, swap_apply_left],
      exact bc } }
end

open subgroup

lemma swap_mul_swap_same_mem_closure_three_cycles
  {a b c : α} (ab : a ≠ b) (ac : a ≠ c) :
  (swap a b * swap a c) ∈ closure {σ : perm α | is_three_cycle σ } :=
begin
  by_cases bc : b = c,
  { subst bc,
    simp [one_mem] },
  exact subset_closure (is_three_cycle_swap_mul_swap_same ab ac bc)
end

lemma is_swap.mul_mem_closure_three_cycles {σ τ : perm α}
  (hσ : is_swap σ) (hτ : is_swap τ) :
  σ * τ ∈ closure {σ : perm α | is_three_cycle σ } :=
begin
  obtain ⟨a, b, ab, rfl⟩ := hσ,
  obtain ⟨c, d, cd, rfl⟩ := hτ,
  by_cases ac : a = c,
  { subst ac,
    exact swap_mul_swap_same_mem_closure_three_cycles ab cd },
  have h' : swap a b * swap c d = swap a b * swap a c * (swap c a * swap c d),
  { simp [swap_comm c a, mul_assoc] },
  rw h',
  exact mul_mem (swap_mul_swap_same_mem_closure_three_cycles ab ac)
    (swap_mul_swap_same_mem_closure_three_cycles (ne.symm ac) cd),
end

end

end equiv.perm


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.at_top_bot
import Mathlib.algebra.archimedean
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# `at_top` filter and archimedean (semi)rings/fields

In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
the function `coe ∘ f : α → R` tends to `at_top` along a filter `l` if and only if so does `f`.
We also prove that `coe : ℕ → R` tends to `at_top` along `at_top`, as well as version of these
two results for `ℤ` (and a ring `R`) and `ℚ` (and a field `R`).
-/

theorem tendsto_coe_nat_at_top_iff {α : Type u_1} {R : Type u_2} [ordered_semiring R] [nontrivial R]
    [archimedean R] {f : α → ℕ} {l : filter α} :
    filter.tendsto (fun (n : α) => ↑(f n)) l filter.at_top ↔ filter.tendsto f l filter.at_top :=
  filter.tendsto_at_top_embedding (fun (a₁ a₂ : ℕ) => nat.cast_le) exists_nat_ge

theorem tendsto_coe_nat_at_top_at_top {R : Type u_2} [ordered_semiring R] [archimedean R] :
    filter.tendsto coe filter.at_top filter.at_top :=
  monotone.tendsto_at_top_at_top nat.mono_cast exists_nat_ge

theorem tendsto_coe_int_at_top_iff {α : Type u_1} {R : Type u_2} [ordered_ring R] [nontrivial R]
    [archimedean R] {f : α → ℤ} {l : filter α} :
    filter.tendsto (fun (n : α) => ↑(f n)) l filter.at_top ↔ filter.tendsto f l filter.at_top :=
  sorry

theorem tendsto_coe_int_at_top_at_top {R : Type u_2} [ordered_ring R] [archimedean R] :
    filter.tendsto coe filter.at_top filter.at_top :=
  sorry

theorem tendsto_coe_rat_at_top_iff {α : Type u_1} {R : Type u_2} [linear_ordered_field R]
    [archimedean R] {f : α → ℚ} {l : filter α} :
    filter.tendsto (fun (n : α) => ↑(f n)) l filter.at_top ↔ filter.tendsto f l filter.at_top :=
  sorry

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the left) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.const_mul_at_top`). -/
theorem filter.tendsto.const_mul_at_top' {α : Type u_1} {R : Type u_2} [linear_ordered_semiring R]
    [archimedean R] {l : filter α} {f : α → R} {r : R} (hr : 0 < r)
    (hf : filter.tendsto f l filter.at_top) :
    filter.tendsto (fun (x : α) => r * f x) l filter.at_top :=
  sorry

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the right) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.at_top_mul_const`). -/
theorem filter.tendsto.at_top_mul_const' {α : Type u_1} {R : Type u_2} [linear_ordered_semiring R]
    [archimedean R] {l : filter α} {f : α → R} {r : R} (hr : 0 < r)
    (hf : filter.tendsto f l filter.at_top) :
    filter.tendsto (fun (x : α) => f x * r) l filter.at_top :=
  sorry

end Mathlib