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

/-!
# Theory of univariate polynomials

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

This file starts looking like the ring theory of $ R[X] $

-/

noncomputable theory
open_locale classical big_operators polynomial

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

section is_domain
variables [comm_ring R] [is_domain R]

lemma derivative_root_multiplicity_of_root [char_zero R] {p : R[X]} {t : R} (hpt : p.is_root t) :
  p.derivative.root_multiplicity t = p.root_multiplicity t - 1 :=
begin
  rcases eq_or_ne p 0 with rfl | hp,
  { simp },
  nth_rewrite 0 [←p.div_by_monic_mul_pow_root_multiplicity_eq t],
  simp only [derivative_pow, derivative_mul, derivative_sub, derivative_X,
             derivative_C, sub_zero, mul_one],
  set n := p.root_multiplicity t - 1,
  have hn : n + 1 = _ := tsub_add_cancel_of_le ((root_multiplicity_pos hp).mpr hpt),
  rw ←hn,
  set q := p /ₘ (X - C t) ^ (n + 1) with hq,
  convert_to root_multiplicity t ((X - C t) ^ n * (derivative q * (X - C t) + q * C ↑(n + 1))) = n,
  { congr,
    rw [mul_add, mul_left_comm $ (X - C t) ^ n, ←pow_succ'],
    congr' 1,
    rw [mul_left_comm $ (X - C t) ^ n, mul_comm $ (X - C t) ^ n] },
  have h : (derivative q * (X - C t) + q * C ↑(n + 1)).eval t ≠ 0,
  { suffices : eval t q * ↑(n + 1) ≠ 0,
    { simpa },
    refine mul_ne_zero _ (nat.cast_ne_zero.mpr n.succ_ne_zero),
    convert eval_div_by_monic_pow_root_multiplicity_ne_zero t hp,
    exact hn ▸ hq },
  rw [root_multiplicity_mul, root_multiplicity_X_sub_C_pow, root_multiplicity_eq_zero h, add_zero],
  refine mul_ne_zero (pow_ne_zero n $ X_sub_C_ne_zero t) _,
  contrapose! h,
  rw [h, eval_zero]
end

lemma root_multiplicity_sub_one_le_derivative_root_multiplicity [char_zero R] (p : R[X]) (t : R) :
  p.root_multiplicity t - 1 ≤ p.derivative.root_multiplicity t :=
begin
  by_cases p.is_root t,
  { exact (derivative_root_multiplicity_of_root h).symm.le },
  { rw [root_multiplicity_eq_zero h, zero_tsub],
    exact zero_le _ }
end

section normalization_monoid
variables [normalization_monoid R]

instance : normalization_monoid R[X] :=
{ norm_unit := λ p, ⟨C ↑(norm_unit (p.leading_coeff)), C ↑(norm_unit (p.leading_coeff))⁻¹,
    by rw [← ring_hom.map_mul, units.mul_inv, C_1], by rw [← ring_hom.map_mul, units.inv_mul, C_1]⟩,
  norm_unit_zero := units.ext (by simp),
  norm_unit_mul := λ p q hp0 hq0, units.ext (begin
      dsimp,
      rw [ne.def, ← leading_coeff_eq_zero] at *,
      rw [leading_coeff_mul, norm_unit_mul hp0 hq0, units.coe_mul, C_mul],
    end),
  norm_unit_coe_units := λ u,
    units.ext begin
      rw [← mul_one u⁻¹, units.coe_mul, units.eq_inv_mul_iff_mul_eq],
      dsimp,
      rcases polynomial.is_unit_iff.1 ⟨u, rfl⟩ with ⟨_, ⟨w, rfl⟩, h2⟩,
      rw [← h2, leading_coeff_C, norm_unit_coe_units, ← C_mul, units.mul_inv, C_1],
    end }

@[simp]
lemma coe_norm_unit {p : R[X]} :
  (norm_unit p : R[X]) = C ↑(norm_unit p.leading_coeff) :=
by simp [norm_unit]

lemma leading_coeff_normalize (p : R[X]) :
  leading_coeff (normalize p) = normalize (leading_coeff p) := by simp

lemma monic.normalize_eq_self {p : R[X]} (hp : p.monic) :
  normalize p = p :=
by simp only [polynomial.coe_norm_unit, normalize_apply, hp.leading_coeff, norm_unit_one,
  units.coe_one, polynomial.C.map_one, mul_one]

lemma roots_normalize {p : R[X]} : (normalize p).roots = p.roots :=
by rw [normalize_apply, mul_comm, coe_norm_unit,
  roots_C_mul _ (norm_unit (leading_coeff p)).ne_zero]

end normalization_monoid

end is_domain

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

lemma degree_pos_of_ne_zero_of_nonunit (hp0 : p ≠ 0) (hp : ¬is_unit p) :
  0 < degree p :=
lt_of_not_ge (λ h, begin
  rw [eq_C_of_degree_le_zero h] at hp0 hp,
  exact hp (is_unit.map C
    (is_unit.mk0 (coeff p 0) (mt C_inj.2 (by simpa using hp0)))),
end)

lemma monic_mul_leading_coeff_inv (h : p ≠ 0) :
  monic (p * C (leading_coeff p)⁻¹) :=
by rw [monic, leading_coeff_mul, leading_coeff_C,
  mul_inv_cancel (show leading_coeff p ≠ 0, from mt leading_coeff_eq_zero.1 h)]

lemma degree_mul_leading_coeff_inv (p : R[X]) (h : q ≠ 0) :
  degree (p * C (leading_coeff q)⁻¹) = degree p :=
have h₁ : (leading_coeff q)⁻¹ ≠ 0 :=
  inv_ne_zero (mt leading_coeff_eq_zero.1 h),
by rw [degree_mul, degree_C h₁, add_zero]

@[simp] lemma map_eq_zero [semiring S] [nontrivial S] (f : R →+* S) : p.map f = 0 ↔ p = 0 :=
by simp only [polynomial.ext_iff, map_eq_zero, coeff_map, coeff_zero]

lemma map_ne_zero [semiring S] [nontrivial S] {f : R →+* S} (hp : p ≠ 0) : p.map f ≠ 0 :=
mt (map_eq_zero f).1 hp

end division_ring

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

lemma is_unit_iff_degree_eq_zero : is_unit p ↔ degree p = 0 :=
⟨degree_eq_zero_of_is_unit,
  λ h, have degree p ≤ 0, by simp [*, le_refl],
    have hc : coeff p 0 ≠ 0, from λ hc,
        by rw [eq_C_of_degree_le_zero this, hc] at h;
        simpa using h,
    is_unit_iff_dvd_one.2 ⟨C (coeff p 0)⁻¹, begin
      conv in p { rw eq_C_of_degree_le_zero this },
      rw [← C_mul, _root_.mul_inv_cancel hc, C_1]
    end⟩⟩

/-- Division of polynomials. See `polynomial.div_by_monic` for more details.-/
def div (p q : R[X]) :=
C (leading_coeff q)⁻¹ * (p /ₘ (q * C (leading_coeff q)⁻¹))

/-- Remainder of polynomial division. See `polynomial.mod_by_monic` for more details. -/
def mod (p q : R[X]) :=
p %ₘ (q * C (leading_coeff q)⁻¹)

private lemma quotient_mul_add_remainder_eq_aux (p q : R[X]) :
  q * div p q + mod p q = p :=
if h : q = 0 then by simp only [h, zero_mul, mod, mod_by_monic_zero, zero_add]
else begin
  conv {to_rhs, rw ← mod_by_monic_add_div p (monic_mul_leading_coeff_inv h)},
  rw [div, mod, add_comm, mul_assoc]
end

private lemma remainder_lt_aux (p : R[X]) (hq : q ≠ 0) :
  degree (mod p q) < degree q :=
by rw ← degree_mul_leading_coeff_inv q hq; exact
  degree_mod_by_monic_lt p (monic_mul_leading_coeff_inv hq)

instance : has_div R[X] := ⟨div⟩

instance : has_mod R[X] := ⟨mod⟩

lemma div_def : p / q = C (leading_coeff q)⁻¹ * (p /ₘ (q * C (leading_coeff q)⁻¹)) := rfl

lemma mod_def : p % q = p %ₘ (q * C (leading_coeff q)⁻¹) := rfl

lemma mod_by_monic_eq_mod (p : R[X]) (hq : monic q) : p %ₘ q = p % q :=
show p %ₘ q = p %ₘ (q * C (leading_coeff q)⁻¹), by simp only [monic.def.1 hq, inv_one, mul_one, C_1]

lemma div_by_monic_eq_div (p : R[X]) (hq : monic q) : p /ₘ q = p / q :=
show p /ₘ q = C (leading_coeff q)⁻¹ * (p /ₘ (q * C (leading_coeff q)⁻¹)),
by simp only [monic.def.1 hq, inv_one, C_1, one_mul, mul_one]

lemma mod_X_sub_C_eq_C_eval (p : R[X]) (a : R) : p % (X - C a) = C (p.eval a) :=
mod_by_monic_eq_mod p (monic_X_sub_C a) ▸ mod_by_monic_X_sub_C_eq_C_eval _ _

lemma mul_div_eq_iff_is_root : (X - C a) * (p / (X - C a)) = p ↔ is_root p a :=
div_by_monic_eq_div p (monic_X_sub_C a) ▸ mul_div_by_monic_eq_iff_is_root

instance : euclidean_domain R[X] :=
{ quotient := (/),
  quotient_zero := by simp [div_def],
  remainder := (%),
  r := _,
  r_well_founded := degree_lt_wf,
  quotient_mul_add_remainder_eq := quotient_mul_add_remainder_eq_aux,
  remainder_lt := λ p q hq, remainder_lt_aux _ hq,
  mul_left_not_lt := λ p q hq, not_lt_of_ge (degree_le_mul_left _ hq),
  .. polynomial.comm_ring,
  .. polynomial.nontrivial }

lemma mod_eq_self_iff (hq0 : q ≠ 0) : p % q = p ↔ degree p < degree q :=
⟨λ h, h ▸ euclidean_domain.mod_lt _ hq0,
λ h, have ¬degree (q * C (leading_coeff q)⁻¹) ≤ degree p :=
  not_le_of_gt $ by rwa degree_mul_leading_coeff_inv q hq0,
begin
  rw [mod_def, mod_by_monic, dif_pos (monic_mul_leading_coeff_inv hq0)],
  unfold div_mod_by_monic_aux,
  simp only [this, false_and, if_false]
end⟩

lemma div_eq_zero_iff (hq0 : q ≠ 0) : p / q = 0 ↔ degree p < degree q :=
⟨λ h, by have := euclidean_domain.div_add_mod p q;
  rwa [h, mul_zero, zero_add, mod_eq_self_iff hq0] at this,
λ h, have hlt : degree p < degree (q * C (leading_coeff q)⁻¹),
    by rwa degree_mul_leading_coeff_inv q hq0,
  have hm : monic (q * C (leading_coeff q)⁻¹) := monic_mul_leading_coeff_inv hq0,
  by rw [div_def, (div_by_monic_eq_zero_iff hm).2 hlt, mul_zero]⟩

lemma degree_add_div (hq0 : q ≠ 0) (hpq : degree q ≤ degree p) :
  degree q + degree (p / q) = degree p :=
have degree (p % q) < degree (q * (p / q)) :=
  calc degree (p % q) < degree q : euclidean_domain.mod_lt _ hq0
  ... ≤ _ : degree_le_mul_left _ (mt (div_eq_zero_iff hq0).1 (not_lt_of_ge hpq)),
by conv_rhs { rw [← euclidean_domain.div_add_mod p q,
    degree_add_eq_left_of_degree_lt this, degree_mul] }

lemma degree_div_le (p q : R[X]) : degree (p / q) ≤ degree p :=
if hq : q = 0 then by simp [hq]
else by rw [div_def, mul_comm, degree_mul_leading_coeff_inv _ hq];
  exact degree_div_by_monic_le _ _

lemma degree_div_lt (hp : p ≠ 0) (hq : 0 < degree q) : degree (p / q) < degree p :=
have hq0 : q ≠ 0, from λ hq0, by simpa [hq0] using hq,
by rw [div_def, mul_comm, degree_mul_leading_coeff_inv _ hq0];
  exact degree_div_by_monic_lt _ (monic_mul_leading_coeff_inv hq0) hp
    (by rw degree_mul_leading_coeff_inv _ hq0; exact hq)

@[simp] lemma degree_map [division_ring k] (p : R[X]) (f : R →+* k) :
  degree (p.map f) = degree p :=
p.degree_map_eq_of_injective f.injective

@[simp] lemma nat_degree_map [division_ring k] (f : R →+* k) :
  nat_degree (p.map f) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_map _ f)

@[simp] lemma leading_coeff_map [division_ring k] (f : R →+* k) :
  leading_coeff (p.map f) = f (leading_coeff p) :=
by simp only [← coeff_nat_degree, coeff_map f, nat_degree_map]

theorem monic_map_iff [division_ring k] {f : R →+* k} {p : R[X]} :
  (p.map f).monic ↔ p.monic :=
by rw [monic, leading_coeff_map, ← f.map_one, function.injective.eq_iff f.injective, monic]

theorem is_unit_map [field k] (f : R →+* k) :
  is_unit (p.map f) ↔ is_unit p :=
by simp_rw [is_unit_iff_degree_eq_zero, degree_map]

lemma map_mod [field k] (f : R →+* k) :
  (p % q).map f = p.map f % q.map f :=
if hq0 : q = 0 then by simp [hq0]
else by rw [mod_def, mod_def, leading_coeff_map f, ← map_inv₀ f, ← map_C f,
  ← polynomial.map_mul f, map_mod_by_monic f (monic_mul_leading_coeff_inv hq0)]

section
open euclidean_domain
theorem gcd_map [field k] (f : R →+* k) :
  gcd (p.map f) (q.map f) = (gcd p q).map f :=
gcd.induction p q (λ x, by simp_rw [polynomial.map_zero, euclidean_domain.gcd_zero_left]) $
                    λ x y hx ih,
by rw [gcd_val, ← map_mod, ih, ← gcd_val]
end

lemma eval₂_gcd_eq_zero [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k}
  (hf : f.eval₂ ϕ α = 0) (hg : g.eval₂ ϕ α = 0) : (euclidean_domain.gcd f g).eval₂ ϕ α = 0 :=
by rw [euclidean_domain.gcd_eq_gcd_ab f g, polynomial.eval₂_add, polynomial.eval₂_mul,
       polynomial.eval₂_mul, hf, hg, zero_mul, zero_mul, zero_add]

lemma eval_gcd_eq_zero {f g : R[X]} {α : R} (hf : f.eval α = 0) (hg : g.eval α = 0) :
  (euclidean_domain.gcd f g).eval α = 0 := eval₂_gcd_eq_zero hf hg

lemma root_left_of_root_gcd [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k}
  (hα : (euclidean_domain.gcd f g).eval₂ ϕ α = 0) : f.eval₂ ϕ α = 0 :=
by { cases euclidean_domain.gcd_dvd_left f g with p hp,
     rw [hp, polynomial.eval₂_mul, hα, zero_mul] }

lemma root_right_of_root_gcd [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k}
  (hα : (euclidean_domain.gcd f g).eval₂ ϕ α = 0) : g.eval₂ ϕ α = 0 :=
by { cases euclidean_domain.gcd_dvd_right f g with p hp,
     rw [hp, polynomial.eval₂_mul, hα, zero_mul] }

lemma root_gcd_iff_root_left_right [comm_semiring k] {ϕ : R →+* k} {f g : R[X]} {α : k} :
  (euclidean_domain.gcd f g).eval₂ ϕ α = 0 ↔ (f.eval₂ ϕ α = 0) ∧ (g.eval₂ ϕ α = 0) :=
⟨λ h, ⟨root_left_of_root_gcd h, root_right_of_root_gcd h⟩, λ h, eval₂_gcd_eq_zero h.1 h.2⟩

lemma is_root_gcd_iff_is_root_left_right {f g : R[X]} {α : R} :
  (euclidean_domain.gcd f g).is_root α ↔ f.is_root α ∧ g.is_root α :=
root_gcd_iff_root_left_right

theorem is_coprime_map [field k] (f : R →+* k) :
  is_coprime (p.map f) (q.map f) ↔ is_coprime p q :=
by rw [← euclidean_domain.gcd_is_unit_iff, ← euclidean_domain.gcd_is_unit_iff, gcd_map, is_unit_map]

lemma mem_roots_map [comm_ring k] [is_domain k] {f : R →+* k} {x : k} (hp : p ≠ 0) :
  x ∈ (p.map f).roots ↔ p.eval₂ f x = 0 :=
by rw [mem_roots (map_ne_zero hp), is_root, polynomial.eval_map]; apply_instance

lemma root_set_monomial [comm_ring S] [is_domain S] [algebra R S]
  {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (monomial n a).root_set S = {0} :=
by rw [root_set, map_monomial, roots_monomial ((_root_.map_ne_zero (algebra_map R S)).2 ha),
  multiset.to_finset_nsmul _ _ hn, multiset.to_finset_singleton, finset.coe_singleton]

lemma root_set_C_mul_X_pow [comm_ring S] [is_domain S] [algebra R S]
  {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (C a * X ^ n).root_set S = {0} :=
by rw [C_mul_X_pow_eq_monomial, root_set_monomial hn ha]

lemma root_set_X_pow [comm_ring S] [is_domain S] [algebra R S]
  {n : ℕ} (hn : n ≠ 0) : (X ^ n : R[X]).root_set S = {0} :=
by { rw [←one_mul (X ^ n : R[X]), ←C_1, root_set_C_mul_X_pow hn], exact one_ne_zero }

lemma root_set_prod [comm_ring S] [is_domain S] [algebra R S]
  {ι : Type*} (f : ι → R[X]) (s : finset ι) (h : s.prod f ≠ 0) :
  (s.prod f).root_set S = ⋃ (i ∈ s), (f i).root_set S :=
begin
  simp only [root_set, ←finset.mem_coe],
  rw [polynomial.map_prod, roots_prod, finset.bind_to_finset, s.val_to_finset, finset.coe_bUnion],
  rwa [←polynomial.map_prod, ne, map_eq_zero],
end

lemma exists_root_of_degree_eq_one (h : degree p = 1) : ∃ x, is_root p x :=
⟨-(p.coeff 0 / p.coeff 1),
  have p.coeff 1 ≠ 0,
    by rw ← nat_degree_eq_of_degree_eq_some h;
    exact mt leading_coeff_eq_zero.1 (λ h0, by simpa [h0] using h),
  by conv in p { rw [eq_X_add_C_of_degree_le_one (show degree p ≤ 1, by rw h; exact le_rfl)] };
    simp [is_root, mul_div_cancel' _ this]⟩

lemma coeff_inv_units (u : R[X]ˣ) (n : ℕ) :
  ((↑u : R[X]).coeff n)⁻¹ = ((↑u⁻¹ : R[X]).coeff n) :=
begin
  rw [eq_C_of_degree_eq_zero (degree_coe_units u), eq_C_of_degree_eq_zero (degree_coe_units u⁻¹),
    coeff_C, coeff_C, inv_eq_one_div],
  split_ifs,
  { rw [div_eq_iff_mul_eq (coeff_coe_units_zero_ne_zero u), coeff_zero_eq_eval_zero,
      coeff_zero_eq_eval_zero, ← eval_mul, ← units.coe_mul, inv_mul_self];
    simp },
  { simp }
end

lemma monic_normalize (hp0 : p ≠ 0) : monic (normalize p) :=
begin
  rw [ne.def, ← leading_coeff_eq_zero, ← ne.def, ← is_unit_iff_ne_zero] at hp0,
  rw [monic, leading_coeff_normalize, normalize_eq_one],
  apply hp0,
end

lemma leading_coeff_div (hpq : q.degree ≤ p.degree) :
  (p / q).leading_coeff = p.leading_coeff / q.leading_coeff :=
begin
  by_cases hq : q = 0, { simp [hq] },
  rw [div_def, leading_coeff_mul, leading_coeff_C,
      leading_coeff_div_by_monic_of_monic (monic_mul_leading_coeff_inv hq) _,
      mul_comm, div_eq_mul_inv],
  rwa [degree_mul_leading_coeff_inv q hq]
end

lemma div_C_mul : p / (C a * q) = C a⁻¹ * (p / q) :=
begin
  by_cases ha : a = 0,
  { simp [ha] },
  simp only [div_def, leading_coeff_mul, mul_inv,
    leading_coeff_C, C.map_mul, mul_assoc],
  congr' 3,
  rw [mul_left_comm q, ← mul_assoc, ← C.map_mul, mul_inv_cancel ha,
      C.map_one, one_mul]
end

lemma C_mul_dvd (ha : a ≠ 0) : C a * p ∣ q ↔ p ∣ q :=
⟨λ h, dvd_trans (dvd_mul_left _ _) h, λ ⟨r, hr⟩, ⟨C a⁻¹ * r,
  by rw [mul_assoc, mul_left_comm p, ← mul_assoc, ← C.map_mul, _root_.mul_inv_cancel ha,
         C.map_one, one_mul, hr]⟩⟩

lemma dvd_C_mul (ha : a ≠ 0) : p ∣ polynomial.C a * q ↔ p ∣ q :=
⟨λ ⟨r, hr⟩, ⟨C a⁻¹ * r,
  by rw [mul_left_comm p, ← hr, ← mul_assoc, ← C.map_mul, _root_.inv_mul_cancel ha,
         C.map_one, one_mul]⟩,
 λ h, dvd_trans h (dvd_mul_left _ _)⟩

lemma coe_norm_unit_of_ne_zero (hp : p ≠ 0) : (norm_unit p : R[X]) = C p.leading_coeff⁻¹ :=
have p.leading_coeff ≠ 0 := mt leading_coeff_eq_zero.mp hp,
by simp [comm_group_with_zero.coe_norm_unit _ this]

lemma normalize_monic (h : monic p) : normalize p = p := by simp [h]

theorem map_dvd_map' [field k] (f : R →+* k) {x y : R[X]} : x.map f ∣ y.map f ↔ x ∣ y :=
if H : x = 0 then by rw [H, polynomial.map_zero, zero_dvd_iff, zero_dvd_iff, map_eq_zero]
else by rw [← normalize_dvd_iff, ← @normalize_dvd_iff R[X],
    normalize_apply, normalize_apply,
    coe_norm_unit_of_ne_zero H, coe_norm_unit_of_ne_zero (mt (map_eq_zero f).1 H),
    leading_coeff_map, ← map_inv₀ f, ← map_C, ← polynomial.map_mul,
    map_dvd_map _ f.injective (monic_mul_leading_coeff_inv H)]

lemma degree_normalize : degree (normalize p) = degree p := by simp

lemma prime_of_degree_eq_one (hp1 : degree p = 1) : prime p :=
have prime (normalize p),
  from monic.prime_of_degree_eq_one (hp1 ▸ degree_normalize)
    (monic_normalize (λ hp0, absurd hp1 (hp0.symm ▸ by simp; exact dec_trivial))),
(normalize_associated _).prime this

lemma irreducible_of_degree_eq_one (hp1 : degree p = 1) : irreducible p :=
(prime_of_degree_eq_one hp1).irreducible

theorem not_irreducible_C (x : R) : ¬irreducible (C x) :=
if H : x = 0 then by { rw [H, C_0], exact not_irreducible_zero }
else λ hx, irreducible.not_unit hx $ is_unit_C.2 $ is_unit_iff_ne_zero.2 H

theorem degree_pos_of_irreducible (hp : irreducible p) : 0 < p.degree :=
lt_of_not_ge $ λ hp0, have _ := eq_C_of_degree_le_zero hp0,
  not_irreducible_C (p.coeff 0) $ this ▸ hp

/-- If `f` is a polynomial over a field, and `a : K` satisfies `f' a ≠ 0`,
then `f / (X - a)` is coprime with `X - a`.
Note that we do not assume `f a = 0`, because `f / (X - a) = (f - f a) / (X - a)`. -/
lemma is_coprime_of_is_root_of_eval_derivative_ne_zero {K : Type*} [field K]
  (f : K[X]) (a : K) (hf' : f.derivative.eval a ≠ 0) :
  is_coprime (X - C a : K[X]) (f /ₘ (X - C a)) :=
begin
  refine or.resolve_left (euclidean_domain.dvd_or_coprime (X - C a) (f /ₘ (X - C a))
    (irreducible_of_degree_eq_one (polynomial.degree_X_sub_C a))) _,
  contrapose! hf' with h,
  have key : (X - C a) * (f /ₘ (X - C a)) = f - (f %ₘ (X - C a)),
  { rw [eq_sub_iff_add_eq, ← eq_sub_iff_add_eq', mod_by_monic_eq_sub_mul_div],
    exact monic_X_sub_C a },
  replace key := congr_arg derivative key,
  simp only [derivative_X, derivative_mul, one_mul, sub_zero, derivative_sub,
    mod_by_monic_X_sub_C_eq_C_eval, derivative_C] at key,
  have : (X - C a) ∣ derivative f := key ▸ (dvd_add h (dvd_mul_right _ _)),
  rw [← dvd_iff_mod_by_monic_eq_zero (monic_X_sub_C _), mod_by_monic_X_sub_C_eq_C_eval] at this,
  rw [← C_inj, this, C_0],
end

end field
end polynomial


import group_theory.p_group

--open p_group

open fintype
open is_p_group

variables (p : ℕ) (G : Type*) [fintype G] [group G] [is_p_group p G]

def order_psq {H : Type*} (p : ℕ) [fintype H] [group H] (p : ℕ) [fact p.prime]: Prop := card G = p^2

variables {p} {G}

namespace order_psq

lemma iff_ord_psq : order_psq G ↔ card G = p^2 :=
begin
  refl,
end

variable (hG : order_psq p G)
include hG

lemma center_nontrivial : nontrivial (subgroup.center G) :=
begin

  sorry,
end

end order_psq


import data.real.sqrt

/-!
# Roots of quadratic equations over ℝ
-/

open real

namespace IMOSL
namespace extra

lemma exists_add_eq_mul_eq {x y : ℝ} (h : 4 * y ≤ x ^ 2) : ∃ u v : ℝ, u + v = x ∧ u * v = y :=
begin
  use [(x + sqrt (x ^ 2 - 4 * y)) / 2, (x - sqrt (x ^ 2 - 4 * y)) / 2]; split,
  rw [← add_div, add_add_sub_cancel, ← mul_two, mul_div_cancel x two_ne_zero],
  rw [div_mul_div_comm, ← sq_sub_sq, sq_sqrt, sub_sub_cancel, bit0, ← two_mul, mul_div_cancel_left],
  apply mul_ne_zero; exact two_ne_zero,
  rwa sub_nonneg
end

lemma add_mul_root_quadr {u v x y : ℝ} (h : u + v = x) (h0 : u * v = y) : u ^ 2 - x * u + y = 0 :=
  by rw [← h, ← h0, sq, ← sub_mul, sub_add_cancel', mul_comm, mul_neg, neg_add_self]

lemma exists_root_quadr {x y : ℝ} (h : 4 * y ≤ x ^ 2) : ∃ t : ℝ, t ^ 2 + x * t + y = 0 :=
begin
  rcases exists_add_eq_mul_eq h with ⟨u, v, h0, h1⟩,
  use -u; rw [neg_sq, mul_neg, ← sub_eq_add_neg],
  exact add_mul_root_quadr h0 h1
end

end extra
end IMOSL


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Archimedean groups and fields.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.field_power
import Mathlib.data.rat.default
import Mathlib.PostPort

universes u_2 l u_1

namespace Mathlib

/-- An ordered additive commutative monoid is called `archimedean` if for any two elements `x`, `y`
such that `0 < y` there exists a natural number `n` such that `x ≤ n •ℕ y`. -/
class archimedean (α : Type u_2) [ordered_add_comm_monoid α]
where
  arch : ∀ (x : α) {y : α}, 0 < y → ∃ (n : ℕ), x ≤ n •ℕ y

namespace linear_ordered_add_comm_group

/-- An archimedean decidable linearly ordered `add_comm_group` has a version of the floor: for
`a > 0`, any `g` in the group lies between some two consecutive multiples of `a`. -/
theorem exists_int_smul_near_of_pos {α : Type u_1} [linear_ordered_add_comm_group α] [archimedean α] {a : α} (ha : 0 < a) (g : α) : ∃ (k : ℤ), k •ℤ a ≤ g ∧ g < (k + 1) •ℤ a := sorry

theorem exists_int_smul_near_of_pos' {α : Type u_1} [linear_ordered_add_comm_group α] [archimedean α] {a : α} (ha : 0 < a) (g : α) : ∃ (k : ℤ), 0 ≤ g - k •ℤ a ∧ g - k •ℤ a < a := sorry

end linear_ordered_add_comm_group

theorem exists_nat_gt {α : Type u_1} [ordered_semiring α] [nontrivial α] [archimedean α] (x : α) : ∃ (n : ℕ), x < ↑n := sorry

theorem exists_nat_ge {α : Type u_1} [ordered_semiring α] [archimedean α] (x : α) : ∃ (n : ℕ), x ≤ ↑n := sorry

theorem add_one_pow_unbounded_of_pos {α : Type u_1} [ordered_semiring α] [nontrivial α] [archimedean α] (x : α) {y : α} (hy : 0 < y) : ∃ (n : ℕ), x < (y + 1) ^ n := sorry

theorem pow_unbounded_of_one_lt {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α) {y : α} (hy1 : 1 < y) : ∃ (n : ℕ), x < y ^ n :=
  sub_add_cancel y 1 ▸ add_one_pow_unbounded_of_pos x (iff.mpr sub_pos hy1)

/-- Every x greater than or equal to 1 is between two successive
natural-number powers of every y greater than one. -/
theorem exists_nat_pow_near {α : Type u_1} [linear_ordered_ring α] [archimedean α] {x : α} {y : α} (hx : 1 ≤ x) (hy : 1 < y) : ∃ (n : ℕ), y ^ n ≤ x ∧ x < y ^ (n + 1) := sorry

theorem exists_int_gt {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α) : ∃ (n : ℤ), x < ↑n := sorry

theorem exists_int_lt {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α) : ∃ (n : ℤ), ↑n < x := sorry

theorem exists_floor {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α) : ∃ (fl : ℤ), ∀ (z : ℤ), z ≤ fl ↔ ↑z ≤ x := sorry

/-- Every positive `x` is between two successive integer powers of
another `y` greater than one. This is the same as `exists_int_pow_near'`,
but with ≤ and < the other way around. -/
theorem exists_int_pow_near {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α} (hx : 0 < x) (hy : 1 < y) : ∃ (n : ℤ), y ^ n ≤ x ∧ x < y ^ (n + 1) := sorry

/-- Every positive `x` is between two successive integer powers of
another `y` greater than one. This is the same as `exists_int_pow_near`,
but with ≤ and < the other way around. -/
theorem exists_int_pow_near' {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α} (hx : 0 < x) (hy : 1 < y) : ∃ (n : ℤ), y ^ n < x ∧ x ≤ y ^ (n + 1) := sorry

/-- For any `y < 1` and any positive `x`, there exists `n : ℕ` with `y ^ n < x`. -/
theorem exists_pow_lt_of_lt_one {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α} (hx : 0 < x) (hy : y < 1) : ∃ (n : ℕ), y ^ n < x := sorry

/-- Given `x` and `y` between `0` and `1`, `x` is between two successive powers of `y`.
This is the same as `exists_nat_pow_near`, but for elements between `0` and `1` -/
theorem exists_nat_pow_near_of_lt_one {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α} (xpos : 0 < x) (hx : x ≤ 1) (ypos : 0 < y) (hy : y < 1) : ∃ (n : ℕ), y ^ (n + 1) < x ∧ x ≤ y ^ n := sorry

theorem sub_floor_div_mul_nonneg {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α) {y : α} (hy : 0 < y) : 0 ≤ x - ↑(floor (x / y)) * y := sorry

theorem sub_floor_div_mul_lt {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α) {y : α} (hy : 0 < y) : x - ↑(floor (x / y)) * y < y := sorry

protected instance nat.archimedean : archimedean ℕ :=
  archimedean.mk
    fun (n m : ℕ) (m0 : 0 < m) =>
      Exists.intro n
        (eq.mpr
          (id
            ((fun (ᾰ ᾰ_1 : ℕ) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℕ) (e_3 : ᾰ_2 = ᾰ_3) => congr (congr_arg LessEq e_2) e_3) n n
              (Eq.refl n) (n •ℕ m) (n * m) (nat.nsmul_eq_mul n m)))
          (eq.mp
            ((fun (ᾰ ᾰ_1 : ℕ) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℕ) (e_3 : ᾰ_2 = ᾰ_3) => congr (congr_arg LessEq e_2) e_3)
              (n * Nat.succ 0) n (mul_one n) (n * m) (n * m) (Eq.refl (n * m)))
            (nat.mul_le_mul_left n m0)))

protected instance int.archimedean : archimedean ℤ := sorry

/-- A linear ordered archimedean ring is a floor ring. This is not an `instance` because in some
cases we have a computable `floor` function. -/
def archimedean.floor_ring (α : Type u_1) [linear_ordered_ring α] [archimedean α] : floor_ring α :=
  floor_ring.mk (fun (x : α) => classical.some (exists_floor x)) sorry

theorem archimedean_iff_nat_lt {α : Type u_1} [linear_ordered_field α] : archimedean α ↔ ∀ (x : α), ∃ (n : ℕ), x < ↑n := sorry

theorem archimedean_iff_nat_le {α : Type u_1} [linear_ordered_field α] : archimedean α ↔ ∀ (x : α), ∃ (n : ℕ), x ≤ ↑n := sorry

theorem exists_rat_gt {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : α) : ∃ (q : ℚ), x < ↑q := sorry

theorem archimedean_iff_rat_lt {α : Type u_1} [linear_ordered_field α] : archimedean α ↔ ∀ (x : α), ∃ (q : ℚ), x < ↑q := sorry

theorem archimedean_iff_rat_le {α : Type u_1} [linear_ordered_field α] : archimedean α ↔ ∀ (x : α), ∃ (q : ℚ), x ≤ ↑q := sorry

theorem exists_rat_lt {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : α) : ∃ (q : ℚ), ↑q < x := sorry

theorem exists_rat_btwn {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α} (h : x < y) : ∃ (q : ℚ), x < ↑q ∧ ↑q < y := sorry

theorem exists_nat_one_div_lt {α : Type u_1} [linear_ordered_field α] [archimedean α] {ε : α} (hε : 0 < ε) : ∃ (n : ℕ), 1 / (↑n + 1) < ε := sorry

theorem exists_pos_rat_lt {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} (x0 : 0 < x) : ∃ (q : ℚ), 0 < q ∧ ↑q < x := sorry

@[simp] theorem rat.cast_floor {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : ℚ) : floor ↑x = floor x := sorry

/-- `round` rounds a number to the nearest integer. `round (1 / 2) = 1` -/
def round {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α) : ℤ :=
  floor (x + 1 / bit0 1)

theorem abs_sub_round {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α) : abs (x - ↑(round x)) ≤ 1 / bit0 1 := sorry

theorem exists_rat_near {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : α) {ε : α} (ε0 : 0 < ε) : ∃ (q : ℚ), abs (x - ↑q) < ε := sorry

protected instance rat.archimedean : archimedean ℚ :=
  iff.mpr archimedean_iff_rat_le
    fun (q : ℚ) => Exists.intro q (eq.mpr (id (Eq._oldrec (Eq.refl (q ≤ ↑q)) (rat.cast_id q))) (le_refl q))

@[simp] theorem rat.cast_round {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : ℚ) : round ↑x = round x := sorry


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

import topology.algebra.ordered.basic
import algebra.order.with_zero

/-!
# The topology on linearly ordered commutative groups with zero

Let `Γ₀` be a linearly ordered commutative group to which we have adjoined a zero element.
Then `Γ₀` may naturally be endowed with a topology that turns `Γ₀` into a topological monoid.
Neighborhoods of zero are sets containing `{γ | γ < γ₀}` for some invertible element `γ₀`
and every invertible element is open.
In particular the topology is the following:
"a subset `U ⊆ Γ₀` is open if `0 ∉ U` or if there is an invertible
`γ₀ ∈ Γ₀ such that {γ | γ < γ₀} ⊆ U`", but this fact is not proven here since the neighborhoods
description is what is actually useful.

We prove this topology is ordered and regular (in addition to be compatible with the monoid
structure).

All this is useful to extend a valuation to a completion. This is an abstract version of how the
absolute value (resp. `p`-adic absolute value) on `ℚ` is extended to `ℝ` (resp. `ℚₚ`).

## Implementation notes

This topology is not defined as an instance since it may not be the desired topology on
a linearly ordered commutative group with zero. You can locally activate this topology using
`local attribute [instance] linear_ordered_comm_group_with_zero.topological_space`
All other instances will (`ordered_topology`, `regular_space`, `has_continuous_mul`) then follow.

-/

open_locale topological_space
open topological_space filter set

namespace linear_ordered_comm_group_with_zero

variables (Γ₀ : Type*) [linear_ordered_comm_group_with_zero Γ₀]

/-- The neighbourhoods around γ ∈ Γ₀, used in the definition of the topology on Γ₀.
These neighbourhoods are defined as follows:
A set s is a neighbourhood of 0 if there is an invertible γ₀ ∈ Γ₀ such that {γ | γ < γ₀} ⊆ s.
If γ ≠ 0, then every set that contains γ is a neighbourhood of γ. -/
def nhds_fun (x : Γ₀) : filter Γ₀ :=
if x = 0 then ⨅ (γ₀ : units Γ₀), principal {γ | γ < γ₀} else pure x

/-- The topology on a linearly ordered commutative group with a zero element adjoined.
A subset U is open if 0 ∉ U or if there is an invertible element γ₀ such that {γ | γ < γ₀} ⊆ U. -/
protected def topological_space : topological_space Γ₀ :=
topological_space.mk_of_nhds (nhds_fun Γ₀)

local attribute [instance] linear_ordered_comm_group_with_zero.topological_space

/-- The neighbourhoods {γ | γ < γ₀} of 0 form a directed set indexed by the invertible
elements γ₀. -/
lemma directed_lt : directed (≥) (λ γ₀ : units Γ₀, principal {γ : Γ₀ | γ < γ₀}) :=
begin
  intros γ₁ γ₂,
  use linear_order.min γ₁ γ₂ ; dsimp only,
  split ; rw [ge_iff_le, principal_mono] ; intros x x_in,
  { calc x < ↑(linear_order.min γ₁ γ₂) : x_in
        ... ≤ γ₁ : min_le_left γ₁ γ₂ },
  { calc x < ↑(linear_order.min γ₁ γ₂) : x_in
        ... ≤ γ₂ : min_le_right γ₁ γ₂ }
end

-- We need two auxilliary lemmas to show that nhds_fun accurately describes the neighbourhoods
-- coming from the topology (that is defined in terms of nhds_fun).

/-- At all points of a linearly ordered commutative group with a zero element adjoined,
the pure filter is smaller than the filter given by nhds_fun. -/
lemma pure_le_nhds_fun : pure ≤ nhds_fun Γ₀ :=
λ x, by { by_cases hx : x = 0; simp [hx, nhds_fun] }

/-- For every point Γ₀, and every “neighbourhood” s of it (described by nhds_fun), there is a
smaller “neighbourhood” t ⊆ s, such that s is a “neighbourhood“ of all the points in t. -/
lemma nhds_fun_ok (x : Γ₀) {s} (s_in : s ∈ nhds_fun Γ₀ x) :
  (∃ t ∈ nhds_fun Γ₀ x, t ⊆ s ∧ ∀ y ∈ t, s ∈ nhds_fun Γ₀ y) :=
begin
  by_cases hx : x = 0,
  { simp only [hx, nhds_fun, exists_prop, if_true, eq_self_iff_true] at s_in ⊢,
    cases (mem_infi_of_directed (directed_lt Γ₀) _).mp s_in with γ₀ h,
    use {γ : Γ₀ | γ < γ₀},
    rw mem_principal at h,
    split,
    { apply mem_infi_of_mem γ₀,
      rw mem_principal },
    { refine ⟨h, λ y y_in, _⟩,
      by_cases hy : y = 0,
      { simp only [hy, if_true, eq_self_iff_true],
        apply mem_infi_of_mem γ₀,
        rwa mem_principal },
      { simp [hy, h y_in] } } },
  { simp only [hx, nhds_fun, exists_prop, if_false, mem_pure] at s_in ⊢,
    refine ⟨{x}, mem_singleton _, singleton_subset_iff.2 s_in, λ y y_in, _⟩,
    simpa [mem_singleton_iff.mp y_in, hx] }
end

variables  {Γ₀}

/-- The neighbourhood filter of an invertible element consists of all sets containing that
element. -/
lemma nhds_coe_units (γ : units Γ₀) : 𝓝 (γ : Γ₀) = pure (γ : Γ₀) :=
calc 𝓝 (γ : Γ₀) = nhds_fun Γ₀ γ : nhds_mk_of_nhds (nhds_fun Γ₀) γ (pure_le_nhds_fun Γ₀)
                                                   (nhds_fun_ok Γ₀)
              ... = pure (γ : Γ₀) : if_neg γ.ne_zero

/-- The neighbourhood filter of a nonzero element consists of all sets containing that
element. -/
@[simp] lemma nhds_of_ne_zero (γ : Γ₀) (h : γ ≠ 0) :
  𝓝 γ = pure γ :=
nhds_coe_units (units.mk0 _ h)

/-- If γ is an invertible element of a linearly ordered group with zero element adjoined,
then {γ} is a neighbourhood of γ. -/
lemma singleton_nhds_of_units (γ : units Γ₀) : ({γ} : set Γ₀) ∈ 𝓝 (γ : Γ₀) :=
by simp

/-- If γ is a nonzero element of a linearly ordered group with zero element adjoined,
then {γ} is a neighbourhood of γ. -/
lemma singleton_nhds_of_ne_zero (γ : Γ₀) (h : γ ≠ 0) : ({γ} : set Γ₀) ∈ 𝓝 (γ : Γ₀) :=
by simp [h]

/-- If U is a neighbourhood of 0 in a linearly ordered group with zero element adjoined,
then there exists an invertible element γ₀ such that {γ | γ < γ₀} ⊆ U. -/
lemma has_basis_nhds_zero :
  has_basis (𝓝 (0 : Γ₀)) (λ _, true) (λ γ₀ : units Γ₀, {γ : Γ₀ | γ < γ₀}) :=
⟨begin
  intro U,
  rw nhds_mk_of_nhds (nhds_fun Γ₀) 0 (pure_le_nhds_fun Γ₀) (nhds_fun_ok Γ₀),
  simp only [nhds_fun, if_true, eq_self_iff_true, exists_true_left],
  simp_rw [mem_infi_of_directed (directed_lt Γ₀), mem_principal]
end⟩

/-- If γ is an invertible element of a linearly ordered group with zero element adjoined,
then {x | x < γ} is a neighbourhood of 0. -/
lemma nhds_zero_of_units (γ : units Γ₀) : {x : Γ₀ | x < γ} ∈ 𝓝 (0 : Γ₀) :=
by { rw has_basis_nhds_zero.mem_iff, use γ, simp }

lemma tendsto_zero {α : Type*} {F : filter α} {f : α → Γ₀} :
  tendsto f F (𝓝 (0 : Γ₀)) ↔ ∀ γ₀ : units Γ₀, { x : α | f x < γ₀ } ∈ F :=
by simpa using has_basis_nhds_zero.tendsto_right_iff

/-- If γ is a nonzero element of a linearly ordered group with zero element adjoined,
then {x | x < γ} is a neighbourhood of 0. -/
lemma nhds_zero_of_ne_zero (γ : Γ₀) (h : γ ≠ 0) : {x : Γ₀ | x < γ} ∈ 𝓝 (0 : Γ₀) :=
nhds_zero_of_units (units.mk0 _ h)

lemma has_basis_nhds_units (γ : units Γ₀) :
  has_basis (𝓝 (γ : Γ₀)) (λ i : unit, true) (λ i, {γ}) :=
begin
  rw nhds_of_ne_zero _ γ.ne_zero,
  exact has_basis_pure γ
end

lemma has_basis_nhds_of_ne_zero {x : Γ₀} (h : x ≠ 0) :
  has_basis (𝓝 x) (λ i : unit, true) (λ i, {x}) :=
has_basis_nhds_units (units.mk0 x h)

lemma tendsto_units {α : Type*} {F : filter α} {f : α → Γ₀} {γ₀ : units Γ₀} :
  tendsto f F (𝓝 (γ₀ : Γ₀)) ↔ { x : α | f x = γ₀ } ∈ F :=
begin
  rw (has_basis_nhds_units γ₀).tendsto_right_iff,
  simpa
end

lemma tendsto_of_ne_zero {α : Type*} {F : filter α} {f : α → Γ₀} {γ : Γ₀} (h : γ ≠ 0) :
  tendsto f F (𝓝 γ) ↔ { x : α | f x = γ } ∈ F :=
@tendsto_units _ _ _ F f (units.mk0 γ h)

variable (Γ₀)

/-- The topology on a linearly ordered group with zero element adjoined
is compatible with the order structure. -/
@[priority 100]
instance ordered_topology : order_closed_topology Γ₀ :=
{ is_closed_le' :=
  begin
    rw ← is_open_compl_iff,
    show is_open {p : Γ₀ × Γ₀ | ¬p.fst ≤ p.snd},
    simp only [not_le],
    rw is_open_iff_mem_nhds,
    rintros ⟨a,b⟩ hab,
    change b < a at hab,
    have ha : a ≠ 0 := ne_zero_of_lt hab,
    rw [nhds_prod_eq, mem_prod_iff],
    by_cases hb : b = 0,
    { subst b,
      use [{a}, singleton_nhds_of_ne_zero _ ha, {x : Γ₀ | x < a}, nhds_zero_of_ne_zero _ ha],
      intros p p_in,
      cases mem_prod.1 p_in with h1 h2,
      rw mem_singleton_iff at h1,
      change p.2 < p.1,
      rwa h1 },
    { use [{a}, singleton_nhds_of_ne_zero _ ha, {b}, singleton_nhds_of_ne_zero _ hb],
      intros p p_in,
      cases mem_prod.1 p_in with h1 h2,
      rw mem_singleton_iff at h1 h2,
      change p.2 < p.1,
      rwa [h1, h2] }
  end }

/-- The topology on a linearly ordered group with zero element adjoined is T₃ (aka regular). -/
@[priority 100]
instance regular_space : regular_space Γ₀ :=
begin
  haveI : t1_space Γ₀ := t2_space.t1_space,
  split,
  intros s x s_closed x_not_in_s,
  by_cases hx : x = 0,
  { refine ⟨s, _, subset.rfl, _⟩,
    { subst x,
      rw is_open_iff_mem_nhds,
      intros y hy,
      by_cases hy' : y = 0, { subst y, contradiction },
      simpa [hy'] },
    { erw inf_eq_bot_iff,
      use sᶜ,
      simp only [exists_prop, mem_principal],
      exact ⟨s_closed.compl_mem_nhds x_not_in_s, ⟨s, subset.refl s, by simp⟩⟩ } },
  { simp only [nhds_within, inf_eq_bot_iff, exists_prop, mem_principal],
    exact ⟨{x}ᶜ, is_open_compl_iff.mpr is_closed_singleton, by rwa subset_compl_singleton_iff,
           {x}, singleton_nhds_of_ne_zero x hx, {x}ᶜ, by simp [subset.refl]⟩ }
end

/-- The topology on a linearly ordered group with zero element adjoined makes it a topological
monoid. -/
@[priority 100]
instance : has_continuous_mul Γ₀ :=
⟨begin
  have common : ∀ y ≠ (0 : Γ₀), continuous_at (λ (p : Γ₀ × Γ₀), p.fst * p.snd) (0, y),
  { intros y hy,
    set γ := units.mk0 y hy,
    suffices : tendsto (λ (p : Γ₀ × Γ₀), p.fst * p.snd) ((𝓝 0).prod (𝓝 γ)) (𝓝 0),
    by simpa [continuous_at, nhds_prod_eq],
    suffices : ∀ (γ' : units Γ₀), ∃ (γ''  : units Γ₀), ∀ (a b : Γ₀), a < γ'' → b = y → a * b < γ',
    { rw (has_basis_nhds_zero.prod $ has_basis_nhds_units γ).tendsto_iff has_basis_nhds_zero,
      simpa },
    intros γ',
    use γ⁻¹*γ',
    rintros a b ha hb,
    rw [hb, mul_comm],
    rw [units.coe_mul] at ha,
    simpa using inv_mul_lt_of_lt_mul₀ ha },
  rw continuous_iff_continuous_at,
  rintros ⟨x, y⟩,
  by_cases hx : x = 0; by_cases hy : y = 0,
  { suffices : tendsto (λ (p : Γ₀ × Γ₀), p.fst * p.snd) (𝓝 (0, 0)) (𝓝 0),
    by simpa [hx, hy, continuous_at],
    suffices : ∀ (γ : units Γ₀), ∃ (γ' : units Γ₀), ∀ (a b : Γ₀), a < γ' → b < γ' → a * b < γ,
    by simpa [nhds_prod_eq, has_basis_nhds_zero.prod_self.tendsto_iff has_basis_nhds_zero],
    intros γ,
    rcases exists_square_le γ with ⟨γ', h⟩,
    use γ',
    intros a b ha hb,
    calc a*b < γ'*γ' : mul_lt_mul₀ ha hb
    ... ≤ γ : by exact_mod_cast h },
  { rw hx,
    exact common y hy },
  { rw hy,
    have : (λ (p : Γ₀ × Γ₀), p.fst * p.snd) =
           (λ (p : Γ₀ × Γ₀), p.fst * p.snd) ∘ (λ p : Γ₀ × Γ₀, (p.2, p.1)),
    by { ext, rw [mul_comm] },
    rw this,
    apply continuous_at.comp _ continuous_swap.continuous_at,
    exact common x hx },
  { change tendsto _ _ _,
    rw [nhds_prod_eq],
    rw ((has_basis_nhds_of_ne_zero hx).prod (has_basis_nhds_of_ne_zero hy)).tendsto_iff
       (has_basis_nhds_of_ne_zero $ mul_ne_zero hx hy),
    suffices : ∀ (a b : Γ₀), a = x → b = y → a * b = x * y, by simpa,
    rintros a b rfl rfl,
    refl },
end⟩

end linear_ordered_comm_group_with_zero


import tactic

variables (x y : ℕ)

open nat

theorem Q1a : x + y = y + x :=
begin
  sorry
end

theorem Q1b : x + y = x → y = 0 :=
begin
  sorry
end

theorem Q1c : x + y = 0 → x = 0 ∧ y = 0 :=
begin
  sorry
end

theorem Q1d : x * y = y * x :=
begin
  sorry
end

theorem Q2a : 1 * x = x ∧ x = x * 1 :=
begin
  sorry
end

variable z : ℕ

theorem Q2b : (x + y) * z = x * z + y * z :=
begin
  sorry
end

theorem Q2c : (x * y) * z = x * (y * z) :=
begin
  sorry
end

-- Q3 def
def is_pred (x y : ℕ) := x.succ = y

theorem Q3a : ¬ ∃ x : ℕ, is_pred x 0 :=
begin
  sorry
end

theorem Q3b : y ≠ 0 → ∃! x, is_pred x y :=
begin
  sorry
end


/- Remove the placeholder and complete the following proofs -/
open classical

variables A B C : Prop
variables p q r : Prop

-- 1
example : A ∨ B → B ∨ A := _

-- 2
example : A ∧ (B ∨ C) → (A ∧ B) ∨ (A ∧ C) := _

-- 3
example : ¬(A ∨ B) ↔ ¬A ∧ ¬B := _

-- 4
example : ((p → q) ∧ (¬r → ¬q)) → (p → r) := _


theorem succ_succ_inj {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=
begin
exact succ_inj(succ_inj(h)),
end


/- The aim here is to make a prover of not equal statements
about integers, e.g. 3 = 5 → false -/

open tactic

meta def no_confusion_false_prover : expr → tactic expr
-- Argumet: the neq statement we want to prove
-- returns proof term
| `(0 = nat.succ %%n → false) := to_expr ``(@nat.no_confusion false _ _)
| `(nat.succ %%n = 0 → false) := to_expr ``(@nat.no_confusion false _ _)
| `(nat.succ %%n₁ = nat.succ %%n₂ → false) :=
  do h ← get_unused_name `h >>= intro,
    e ← to_expr ``(@nat.no_confusion false _ _ %%h),
    let tp := `((%%n₁ : ℕ) = %%n₂ → false),
    nm₁ ← get_unused_name `t,
    -- introduce previous step as a subgoal
    t ← to_expr ``(%%tp: Prop) >>= assert nm₁,
      prev ← no_confusion_false_prover tp,
      exact prev,
    return (expr.app e t)
| _ := failed

open nat

-- 0 ≠ 1
example : 0 = succ 0 → false :=
by do target >>= no_confusion_false_prover >>= exact

-- 2 ≠ 0
example : succ (succ 0) = 0 → false :=
by do target >>= no_confusion_false_prover >>= exact

-- 1 ≠ 2
example : succ 0 = succ (succ 0) → false :=
by do target >>= no_confusion_false_prover >>= exact

-- 3 ≠ 5
example : succ (succ (succ 0)) =
succ (succ (succ (succ (succ 0)))) → false :=
by do target >>= no_confusion_false_prover >>= exact


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import algebra.group_with_zero.power
import tactic.linarith

/-!
# Integer power operation on fields and division rings

This file collects basic facts about the operation of raising an element of a `division_ring` to an
integer power. More specialised results are provided in the case of a linearly ordered field.
-/

universe u

@[simp] lemma ring_hom.map_fpow {K L : Type*} [division_ring K] [division_ring L] (f : K →+* L) :
  ∀ (a : K) (n : ℤ), f (a ^ n) = f a ^ n :=
f.to_monoid_with_zero_hom.map_fpow

@[simp] lemma fpow_bit0_neg {K : Type*} [division_ring K] (x : K) (n : ℤ) :
  (-x) ^ (bit0 n) = x ^ bit0 n :=
by rw [fpow_bit0', fpow_bit0', neg_mul_neg]

lemma fpow_even_neg {K : Type*} [division_ring K] (a : K) {n : ℤ} (h : even n) :
  (-a) ^ n = a ^ n :=
begin
  obtain ⟨k, rfl⟩ := h,
  simp [←bit0_eq_two_mul]
end

@[simp] lemma fpow_bit1_neg {K : Type*} [division_ring K] (x : K) (n : ℤ) :
  (-x) ^ (bit1 n) = - x ^ bit1 n :=
by rw [fpow_bit1', fpow_bit1', neg_mul_neg, neg_mul_eq_mul_neg]

section ordered_field_power
open int

variables {K : Type u} [linear_ordered_field K] {a : K} {n : ℤ}

lemma fpow_eq_zero_iff (hn : 0 < n) :
  a ^ n = 0 ↔ a = 0 :=
begin
  refine ⟨fpow_eq_zero, _⟩,
  rintros rfl,
  exact zero_fpow _ hn.ne'
end

lemma fpow_nonneg {a : K} (ha : 0 ≤ a) : ∀ (z : ℤ), 0 ≤ a ^ z
| (n : ℕ) := by { rw gpow_coe_nat, exact pow_nonneg ha _ }
| -[1+n]  := by { rw gpow_neg_succ_of_nat, exact inv_nonneg.2 (pow_nonneg ha _) }

lemma fpow_pos_of_pos {a : K} (ha : 0 < a) : ∀ (z : ℤ), 0 < a ^ z
| (n : ℕ) := by { rw gpow_coe_nat, exact pow_pos ha _ }
| -[1+n]  := by { rw gpow_neg_succ_of_nat, exact inv_pos.2 (pow_pos ha _) }

lemma fpow_le_of_le {x : K} (hx : 1 ≤ x) {a b : ℤ} (h : a ≤ b) : x ^ a ≤ x ^ b :=
begin
  induction a with a a; induction b with b b,
  { simp only [of_nat_eq_coe, gpow_coe_nat],
    apply pow_le_pow hx,
    apply le_of_coe_nat_le_coe_nat h },
  { apply absurd h,
    apply not_le_of_gt,
    exact lt_of_lt_of_le (neg_succ_lt_zero _) (of_nat_nonneg _) },
  { simp only [gpow_neg_succ_of_nat, one_div, of_nat_eq_coe, gpow_coe_nat],
    apply le_trans (inv_le_one _); apply one_le_pow_of_one_le hx },
  { simp only [gpow_neg_succ_of_nat],
    apply (inv_le_inv _ _).2,
    { apply pow_le_pow hx,
      have : -(↑(a+1) : ℤ) ≤ -(↑(b+1) : ℤ), from h,
      have h' := le_of_neg_le_neg this,
      apply le_of_coe_nat_le_coe_nat h' },
    repeat { apply pow_pos (lt_of_lt_of_le zero_lt_one hx) } }
end

lemma pow_le_max_of_min_le {x : K} (hx : 1 ≤ x) {a b c : ℤ} (h : min a b ≤ c) :
      x ^ (-c) ≤ max (x ^ (-a)) (x ^ (-b)) :=
begin
  wlog hle : a ≤ b,
  have hnle : -b ≤ -a, from neg_le_neg hle,
  have hfle : x ^ (-b) ≤ x ^ (-a), from fpow_le_of_le hx hnle,
  have : x ^ (-c) ≤ x ^ (-a),
  { apply fpow_le_of_le hx,
    simpa only [min_eq_left hle, neg_le_neg_iff] using h },
  simpa only [max_eq_left hfle]
end

lemma fpow_le_one_of_nonpos {p : K} (hp : 1 ≤ p) {z : ℤ} (hz : z ≤ 0) : p ^ z ≤ 1 :=
calc p ^ z ≤ p ^ 0 : fpow_le_of_le hp hz
          ... = 1        : by simp

lemma one_le_fpow_of_nonneg {p : K} (hp : 1 ≤ p) {z : ℤ} (hz : 0 ≤ z) : 1 ≤ p ^ z :=
calc p ^ z ≥ p ^ 0 : fpow_le_of_le hp hz
          ... = 1        : by simp

theorem fpow_bit0_nonneg (a : K) (n : ℤ) : 0 ≤ a ^ bit0 n :=
by { rw fpow_bit0, exact mul_self_nonneg _ }

theorem fpow_two_nonneg (a : K) : 0 ≤ a ^ 2 :=
pow_bit0_nonneg a 1

theorem fpow_bit0_pos {a : K} (h : a ≠ 0) (n : ℤ) : 0 < a ^ bit0 n :=
(fpow_bit0_nonneg a n).lt_of_ne (fpow_ne_zero _ h).symm

theorem fpow_two_pos_of_ne_zero (a : K) (h : a ≠ 0) : 0 < a ^ 2 :=
pow_bit0_pos h 1

@[simp] theorem fpow_bit1_neg_iff : a ^ bit1 n < 0 ↔ a < 0 :=
⟨λ h, not_le.1 $ λ h', not_le.2 h $ fpow_nonneg h' _,
 λ h, by rw [bit1, fpow_add_one h.ne]; exact mul_neg_of_pos_of_neg (fpow_bit0_pos h.ne _) h⟩

@[simp] theorem fpow_bit1_nonneg_iff : 0 ≤ a ^ bit1 n ↔ 0 ≤ a :=
le_iff_le_iff_lt_iff_lt.2 fpow_bit1_neg_iff

@[simp] theorem fpow_bit1_nonpos_iff : a ^ bit1 n ≤ 0 ↔ a ≤ 0 :=
begin
  rw [le_iff_lt_or_eq, fpow_bit1_neg_iff],
  split,
  { rintro (h | h),
    { exact h.le },
    { exact (fpow_eq_zero h).le } },
  { intro h,
    rcases eq_or_lt_of_le h with rfl|h,
    { exact or.inr (zero_fpow _ (bit1_ne_zero n)) },
    { exact or.inl h } }
end

@[simp] theorem fpow_bit1_pos_iff : 0 < a ^ bit1 n ↔ 0 < a :=
lt_iff_lt_of_le_iff_le fpow_bit1_nonpos_iff

lemma fpow_even_nonneg (a : K) {n : ℤ} (hn : even n) :
  0 ≤ a ^ n :=
begin
  cases le_or_lt 0 a with h h,
  { exact fpow_nonneg h _ },
  { rw [←fpow_even_neg _ hn],
    replace h : 0 ≤ -a := neg_nonneg_of_nonpos (le_of_lt h),
    exact fpow_nonneg h _ }
end

theorem fpow_even_pos (ha : a ≠ 0) (hn : even n) : 0 < a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using fpow_bit0_pos ha k

theorem fpow_odd_nonneg (ha : 0 ≤ a) (hn : odd n) : 0 ≤ a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using fpow_bit1_nonneg_iff.mpr ha

theorem fpow_odd_pos (ha : 0 < a) (hn : odd n) : 0 < a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using fpow_bit1_pos_iff.mpr ha

theorem fpow_odd_nonpos (ha : a ≤ 0) (hn : odd n) : a ^ n ≤ 0:=
by cases hn with k hk; simpa only [hk, two_mul] using fpow_bit1_nonpos_iff.mpr ha

theorem fpow_odd_neg (ha : a < 0) (hn : odd n) : a ^ n < 0:=
by cases hn with k hk; simpa only [hk, two_mul] using fpow_bit1_neg_iff.mpr ha

lemma fpow_even_abs (a : K) {p : ℤ} (hp : even p) :
  abs a ^ p = a ^ p :=
begin
  cases le_or_lt a (-a) with h h;
  simp [abs, h, max_eq_left_of_lt, fpow_even_neg _ hp]
end

@[simp] lemma fpow_bit0_abs (a : K) (p : ℤ) :
  (abs a) ^ bit0 p = a ^ bit0 p :=
fpow_even_abs _ (even_bit0 _)

lemma abs_fpow_even (a : K) {p : ℤ} (hp : even p) :
  abs (a ^ p) = a ^ p :=
begin
  rw [←fpow_even_abs _ hp, abs_eq_self],
  exact fpow_even_nonneg _ hp
end

@[simp] lemma abs_fpow_bit0 (a : K) (p : ℤ) :
  abs (a ^ bit0 p) = a ^ bit0 p :=
abs_fpow_even _ (even_bit0 _)

end ordered_field_power

lemma one_lt_pow {K} [linear_ordered_semiring K] {p : K} (hp : 1 < p) : ∀ {n : ℕ}, 1 ≤ n → 1 < p ^ n
| 1 h := by simp; assumption
| (k+2) h :=
  begin
    rw [←one_mul (1 : K), pow_succ],
    apply mul_lt_mul,
    { assumption },
    { apply le_of_lt, simpa using one_lt_pow (nat.le_add_left 1 k)},
    { apply zero_lt_one },
    { apply le_of_lt (lt_trans zero_lt_one hp) }
  end

section
local attribute [semireducible] int.nonneg
lemma one_lt_fpow {K}  [linear_ordered_field K] {p : K} (hp : 1 < p) :
  ∀ z : ℤ, 0 < z → 1 < p ^ z
| (n : ℕ) h := by { rw [gpow_coe_nat],
    exact one_lt_pow hp (nat.succ_le_of_lt (int.lt_of_coe_nat_lt_coe_nat h)) }
end

section ordered
variables  {K : Type*} [linear_ordered_field K]

lemma nat.fpow_pos_of_pos {p : ℕ} (h : 0 < p) (n:ℤ) : 0 < (p:K)^n :=
by { apply fpow_pos_of_pos, exact_mod_cast h }

lemma nat.fpow_ne_zero_of_pos {p : ℕ} (h : 0 < p) (n:ℤ) : (p:K)^n ≠ 0 :=
ne_of_gt (nat.fpow_pos_of_pos h n)

lemma fpow_strict_mono {x : K} (hx : 1 < x) :
  strict_mono (λ n:ℤ, x ^ n) :=
λ m n h, show x ^ m < x ^ n,
begin
  have xpos : 0 < x := by linarith,
  have h₀ : x ≠ 0 := by linarith,
  have hxm : 0 < x^m := fpow_pos_of_pos xpos m,
  have hxm₀ : x^m ≠ 0 := ne_of_gt hxm,
  suffices : 1 < x^(n-m),
  { replace := mul_lt_mul_of_pos_right this hxm,
    simp [sub_eq_add_neg] at this,
    simpa [*, fpow_add, mul_assoc, fpow_neg, inv_mul_cancel], },
  apply one_lt_fpow hx, linarith,
end

@[simp] lemma fpow_lt_iff_lt {x : K} (hx : 1 < x) {m n : ℤ} :
  x ^ m < x ^ n ↔ m < n :=
(fpow_strict_mono hx).lt_iff_lt

@[simp] lemma fpow_le_iff_le {x : K} (hx : 1 < x) {m n : ℤ} :
  x ^ m ≤ x ^ n ↔ m ≤ n :=
(fpow_strict_mono hx).le_iff_le

@[simp] lemma pos_div_pow_pos {a b : K} (ha : 0 < a) (hb : 0 < b) (k : ℕ) : 0 < a/b^k :=
div_pos ha (pow_pos hb k)

@[simp] lemma div_pow_le {a b : K} (ha : 0 < a) (hb : 1 ≤ b) (k : ℕ) : a/b^k ≤ a :=
(div_le_iff $ pow_pos (lt_of_lt_of_le zero_lt_one hb) k).mpr
(calc a = a * 1 : (mul_one a).symm
   ...  ≤ a*b^k : (mul_le_mul_left ha).mpr $ one_le_pow_of_one_le hb _)

lemma fpow_injective {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1) :
  function.injective ((^) x : ℤ → K) :=
begin
  intros m n h,
  rcases lt_trichotomy x 1 with H|rfl|H,
  { apply (fpow_strict_mono (one_lt_inv h₀ H)).injective,
    show x⁻¹ ^ m = x⁻¹ ^ n,
    rw [← fpow_neg_one, ← fpow_mul, ← fpow_mul, mul_comm _ m, mul_comm _ n, fpow_mul, fpow_mul,
      h], },
  { contradiction },
  { exact (fpow_strict_mono H).injective h, },
end

@[simp] lemma fpow_inj {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1) {m n : ℤ} :
  x ^ m = x ^ n ↔ m = n :=
(fpow_injective h₀ h₁).eq_iff

end ordered

section
variables {K : Type*} [field K]

@[simp, norm_cast] theorem rat.cast_fpow [char_zero K] (q : ℚ) (n : ℤ) :
  ((q ^ n : ℚ) : K) = q ^ n :=
(rat.cast_hom K).map_fpow q n

end


/-
Copyright (c) 2021 Jakob Scholbach. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob Scholbach
-/
import algebra.char_p.basic
import algebra.char_zero
import data.nat.prime

/-!
# Exponential characteristic

This file defines the exponential characteristic and establishes a few basic results relating
it to the (ordinary characteristic).
The definition is stated for a semiring, but the actual results are for nontrivial rings
(as far as exponential characteristic one is concerned), respectively a ring without zero-divisors
(for prime characteristic).

## Main results
- `exp_char`: the definition of exponential characteristic
- `exp_char_is_prime_or_one`: the exponential characteristic is a prime or one
- `char_eq_exp_char_iff`: the characteristic equals the exponential characteristic iff the
  characteristic is prime

## Tags
exponential characteristic, characteristic
-/

universe u
variables (R : Type u)

section semiring

variables [semiring R]

/-- The definition of the exponential characteristic of a semiring. -/
class inductive exp_char (R : Type u) [semiring R] : ℕ → Prop
| zero [char_zero R] : exp_char 1
| prime {q : ℕ} (hprime : q.prime) [hchar : char_p R q] : exp_char q

/-- The exponential characteristic is one if the characteristic is zero. -/
lemma exp_char_one_of_char_zero (q : ℕ) [hp : char_p R 0] [hq : exp_char R q] :
  q = 1 :=
begin
  casesI hq with q hq_one hq_prime,
  { refl },
  { exact false.elim (lt_irrefl _ ((hp.eq R hq_hchar).symm ▸ hq_prime : (0 : ℕ).prime).pos) }
end

/-- The characteristic equals the exponential characteristic iff the former is prime. -/
theorem char_eq_exp_char_iff (p q : ℕ) [hp : char_p R p] [hq : exp_char R q] :
  p = q ↔ p.prime :=
begin
  casesI hq with q hq_one hq_prime,
  { apply iff_of_false,
    { unfreezingI {rintro rfl},
      exact one_ne_zero (hp.eq R (char_p.of_char_zero R)) },
    { intro pprime,
      rw (char_p.eq R hp infer_instance : p = 0) at pprime,
      exact nat.not_prime_zero pprime } },
  { exact ⟨λ hpq, hpq.symm ▸ hq_prime, λ _, char_p.eq R hp hq_hchar⟩ },
end

section nontrivial

variables [nontrivial R]

/-- The exponential characteristic is one if the characteristic is zero. -/
lemma char_zero_of_exp_char_one (p : ℕ) [hp : char_p R p] [hq : exp_char R 1] :
  p = 0 :=
begin
  casesI hq,
  { exact char_p.eq R hp infer_instance, },
  { exact false.elim (char_p.char_ne_one R 1 rfl), }
end

/-- The characteristic is zero if the exponential characteristic is one. -/
@[priority 100] -- see Note [lower instance priority]
instance char_zero_of_exp_char_one' [hq : exp_char R 1] : char_zero R :=
begin
  casesI hq,
  { assumption, },
  { exact false.elim (char_p.char_ne_one R 1 rfl), }
end

/-- The exponential characteristic is one iff the characteristic is zero. -/
theorem exp_char_one_iff_char_zero (p q : ℕ) [char_p R p] [exp_char R q] :
  q = 1 ↔ p = 0 :=
begin
  split,
  { unfreezingI {rintro rfl},
    exact char_zero_of_exp_char_one R p, },
  { unfreezingI {rintro rfl},
    exact exp_char_one_of_char_zero R q, }
end

section no_zero_divisors

variable [no_zero_divisors R]

/-- A helper lemma: the characteristic is prime if it is non-zero. -/
lemma char_prime_of_ne_zero {p : ℕ} [hp : char_p R p] (p_ne_zero : p ≠ 0) : nat.prime p :=
begin
  cases char_p.char_is_prime_or_zero R p with h h,
  { exact h, },
  { contradiction, }
end

/-- The exponential characteristic is a prime number or one. -/
theorem exp_char_is_prime_or_one (q : ℕ) [hq : exp_char R q] : nat.prime q ∨ q = 1 :=
or_iff_not_imp_right.mpr $ λ h,
begin
  casesI char_p.exists R with p hp,
  have p_ne_zero : p ≠ 0,
  { intro p_zero,
    haveI : char_p R 0, { rwa ←p_zero },
    have : q = 1 := exp_char_one_of_char_zero R q,
    contradiction, },
  have p_eq_q : p = q := (char_eq_exp_char_iff R p q).mpr (char_prime_of_ne_zero R p_ne_zero),
  cases char_p.char_is_prime_or_zero R p with pprime,
  { rwa p_eq_q at pprime },
  { contradiction },
end

end no_zero_divisors

end nontrivial

end semiring


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import data.real.ennreal

/-!
# Real conjugate exponents

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

`p.is_conjugate_exponent q` registers the fact that the real numbers `p` and `q` are `> 1` and
satisfy `1/p + 1/q = 1`. This property shows up often in analysis, especially when dealing with
`L^p` spaces.

We make several basic facts available through dot notation in this situation.

We also introduce `p.conjugate_exponent` for `p / (p-1)`. When `p > 1`, it is conjugate to `p`.
-/

noncomputable theory
namespace real

/-- Two real exponents `p, q` are conjugate if they are `> 1` and satisfy the equality
`1/p + 1/q = 1`. This condition shows up in many theorems in analysis, notably related to `L^p`
norms. -/
structure is_conjugate_exponent (p q : ℝ) : Prop :=
(one_lt : 1 < p)
(inv_add_inv_conj : 1/p + 1/q = 1)

/-- The conjugate exponent of `p` is `q = p/(p-1)`, so that `1/p + 1/q = 1`. -/
def conjugate_exponent (p : ℝ) : ℝ := p/(p-1)

namespace is_conjugate_exponent

variables {p q : ℝ} (h : p.is_conjugate_exponent q)
include h

/- Register several non-vanishing results following from the fact that `p` has a conjugate exponent
`q`: many computations using these exponents require clearing out denominators, which can be done
with `field_simp` given a proof that these denominators are non-zero, so we record the most usual
ones. -/
lemma pos : 0 < p :=
lt_trans zero_lt_one h.one_lt

lemma nonneg : 0 ≤ p := le_of_lt h.pos

lemma ne_zero : p ≠ 0 :=
ne_of_gt h.pos

lemma sub_one_pos : 0 < p - 1 :=
sub_pos.2 h.one_lt

lemma sub_one_ne_zero : p - 1 ≠ 0 :=
ne_of_gt h.sub_one_pos

lemma one_div_pos : 0 < 1/p :=
one_div_pos.2 h.pos

lemma one_div_nonneg : 0 ≤ 1/p :=
le_of_lt h.one_div_pos

lemma one_div_ne_zero : 1/p ≠ 0 :=
ne_of_gt (h.one_div_pos)

lemma conj_eq : q = p/(p-1) :=
begin
  have := h.inv_add_inv_conj,
  rw [← eq_sub_iff_add_eq', one_div, inv_eq_iff_eq_inv] at this,
  field_simp [this, h.ne_zero]
end

lemma conjugate_eq : conjugate_exponent p = q := h.conj_eq.symm

lemma sub_one_mul_conj : (p - 1) * q = p :=
mul_comm q (p - 1) ▸ (eq_div_iff h.sub_one_ne_zero).1 h.conj_eq

lemma mul_eq_add : p * q = p + q :=
by simpa only [sub_mul, sub_eq_iff_eq_add, one_mul] using h.sub_one_mul_conj

@[symm] protected lemma symm : q.is_conjugate_exponent p :=
{ one_lt := by { rw [h.conj_eq], exact (one_lt_div h.sub_one_pos).mpr (sub_one_lt p) },
  inv_add_inv_conj := by simpa [add_comm] using h.inv_add_inv_conj }

lemma div_conj_eq_sub_one : p / q = p - 1 :=
begin
  field_simp [h.symm.ne_zero],
  rw h.sub_one_mul_conj
end

lemma one_lt_nnreal : 1 < real.to_nnreal p :=
begin
  rw [←real.to_nnreal_one, real.to_nnreal_lt_to_nnreal_iff h.pos],
  exact h.one_lt,
end

lemma inv_add_inv_conj_nnreal : 1 / real.to_nnreal p + 1 / real.to_nnreal q = 1 :=
by rw [← real.to_nnreal_one, ← real.to_nnreal_div' h.nonneg, ← real.to_nnreal_div' h.symm.nonneg,
  ← real.to_nnreal_add h.one_div_nonneg h.symm.one_div_nonneg, h.inv_add_inv_conj]

lemma inv_add_inv_conj_ennreal : 1 / ennreal.of_real p + 1 / ennreal.of_real q = 1 :=
by rw [← ennreal.of_real_one, ← ennreal.of_real_div_of_pos h.pos,
  ← ennreal.of_real_div_of_pos h.symm.pos,
  ← ennreal.of_real_add h.one_div_nonneg h.symm.one_div_nonneg, h.inv_add_inv_conj]

end is_conjugate_exponent

lemma is_conjugate_exponent_iff {p q : ℝ} (h : 1 < p) :
  p.is_conjugate_exponent q ↔ q = p/(p-1) :=
⟨λ H, H.conj_eq, λ H, ⟨h, by field_simp [H, ne_of_gt (lt_trans zero_lt_one h)]⟩⟩

lemma is_conjugate_exponent_conjugate_exponent {p : ℝ} (h : 1 < p) :
  p.is_conjugate_exponent (conjugate_exponent p) :=
(is_conjugate_exponent_iff h).2 rfl

lemma is_conjugate_exponent_one_div {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) :
  (1 / a).is_conjugate_exponent (1 / b) :=
⟨by { rw [lt_div_iff ha, one_mul], linarith }, by { simp_rw one_div_one_div, exact hab }⟩

end real


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import logic.function.basic
import tactic.basic

/-!
# Relations holding pairwise

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

This file defines pairwise relations.

## Main declarations

* `pairwise`: `pairwise r` states that `r i j` for all `i ≠ j`.
* `set.pairwise`: `s.pairwise r` states that `r i j` for all `i ≠ j` with `i, j ∈ s`.
-/

open set function

variables {α β γ ι ι' : Type*} {r p q : α → α → Prop}

section pairwise
variables {f g : ι → α} {s t u : set α} {a b : α}

/-- A relation `r` holds pairwise if `r i j` for all `i ≠ j`. -/
def pairwise (r : α → α → Prop) := ∀ ⦃i j⦄, i ≠ j → r i j

lemma pairwise.mono (hr : pairwise r) (h : ∀ ⦃i j⦄, r i j → p i j) : pairwise p :=
λ i j hij, h $ hr hij

protected lemma pairwise.eq (h : pairwise r) : ¬ r a b → a = b := not_imp_comm.1 $ @h _ _

lemma function.injective_iff_pairwise_ne : injective f ↔ pairwise ((≠) on f) :=
forall₂_congr $ λ i j, not_imp_not.symm

alias function.injective_iff_pairwise_ne ↔ function.injective.pairwise_ne _

namespace set

/-- The relation `r` holds pairwise on the set `s` if `r x y` for all *distinct* `x y ∈ s`. -/
protected def pairwise (s : set α) (r : α → α → Prop) := ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → r x y

lemma pairwise_of_forall (s : set α) (r : α → α → Prop) (h : ∀ a b, r a b) : s.pairwise r :=
λ a _ b _ _, h a b

lemma pairwise.imp_on (h : s.pairwise r) (hrp : s.pairwise (λ ⦃a b : α⦄, r a b → p a b)) :
  s.pairwise p :=
λ a ha b hb hab, hrp ha hb hab $ h ha hb hab

lemma pairwise.imp (h : s.pairwise r) (hpq : ∀ ⦃a b : α⦄, r a b → p a b) : s.pairwise p :=
h.imp_on $ pairwise_of_forall s _ hpq

protected lemma pairwise.eq (hs : s.pairwise r) (ha : a ∈ s) (hb : b ∈ s) (h : ¬ r a b) : a = b :=
of_not_not $ λ hab, h $ hs ha hb hab

lemma _root_.reflexive.set_pairwise_iff (hr : reflexive r) :
  s.pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
forall₄_congr $ λ a _ b _, or_iff_not_imp_left.symm.trans $ or_iff_right_of_imp $ eq.rec $ hr a

lemma pairwise.on_injective (hs : s.pairwise r) (hf : function.injective f)
  (hfs : ∀ x, f x ∈ s) :
  pairwise (r on f) :=
λ i j hij, hs (hfs i) (hfs j) (hf.ne hij)

end set

lemma pairwise.set_pairwise (h : pairwise r) (s : set α) : s.pairwise r := λ x hx y hy w, h w

end pairwise


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Jireh Loreaux
-/
import algebra.star.star_alg_hom
import algebra.algebra.subalgebra.basic
import algebra.star.pointwise
import algebra.star.module
import ring_theory.adjoin.basic

/-!
# Star subalgebras

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

A *-subalgebra is a subalgebra of a *-algebra which is closed under *.

The centralizer of a *-closed set is a *-subalgebra.
-/

universes u v

set_option old_structure_cmd true

/-- A *-subalgebra is a subalgebra of a *-algebra which is closed under *. -/
structure star_subalgebra (R : Type u) (A : Type v) [comm_semiring R] [star_ring R]
  [semiring A] [star_ring A] [algebra R A] [star_module R A] extends subalgebra R A : Type v :=
(star_mem' {a} : a ∈ carrier → star a ∈ carrier)

namespace star_subalgebra

/--
Forgetting that a *-subalgebra is closed under *.
-/
add_decl_doc star_subalgebra.to_subalgebra

variables {F R A B C : Type*} [comm_semiring R] [star_ring R]
variables [semiring A] [star_ring A] [algebra R A] [star_module R A]
variables [semiring B] [star_ring B] [algebra R B] [star_module R B]
variables [semiring C] [star_ring C] [algebra R C] [star_module R C]

instance : set_like (star_subalgebra R A) A :=
⟨star_subalgebra.carrier, λ p q h, by cases p; cases q; congr'⟩

instance : star_mem_class (star_subalgebra R A) A :=
{ star_mem := λ s a, s.star_mem' }

instance : subsemiring_class (star_subalgebra R A) A :=
{ add_mem := add_mem',
  mul_mem := mul_mem',
  one_mem := one_mem',
  zero_mem := zero_mem' }

instance {R A} [comm_ring R] [star_ring R] [ring A] [star_ring A] [algebra R A] [star_module R A] :
  subring_class (star_subalgebra R A) A :=
{ neg_mem := λ s a ha, show -a ∈ s.to_subalgebra, from neg_mem ha }

-- this uses the `has_star` instance `s` inherits from `star_mem_class (star_subalgebra R A) A`
instance (s : star_subalgebra R A) : star_ring s :=
{ star := star,
  star_involutive := λ r, subtype.ext (star_star r),
  star_mul := λ r₁ r₂, subtype.ext (star_mul r₁ r₂),
  star_add := λ r₁ r₂, subtype.ext (star_add r₁ r₂) }

instance (s : star_subalgebra R A) : algebra R s := s.to_subalgebra.algebra'

instance (s : star_subalgebra R A) : star_module R s :=
{ star_smul := λ r a, subtype.ext (star_smul r a) }

@[simp]
lemma mem_carrier {s : star_subalgebra R A} {x : A} : x ∈ s.carrier ↔ x ∈ s := iff.rfl

@[ext] theorem ext {S T : star_subalgebra R A} (h : ∀ x : A, x ∈ S ↔ x ∈ T) : S = T :=
set_like.ext h

@[simp] lemma mem_to_subalgebra {S : star_subalgebra R A} {x} : x ∈ S.to_subalgebra ↔ x ∈ S :=
iff.rfl

@[simp] lemma coe_to_subalgebra (S : star_subalgebra R A) : (S.to_subalgebra : set A) = S := rfl

theorem to_subalgebra_injective :
  function.injective (to_subalgebra : star_subalgebra R A → subalgebra R A) :=
λ S T h, ext $ λ x, by rw [← mem_to_subalgebra, ← mem_to_subalgebra, h]

theorem to_subalgebra_inj {S U : star_subalgebra R A} : S.to_subalgebra = U.to_subalgebra ↔ S = U :=
to_subalgebra_injective.eq_iff

lemma to_subalgebra_le_iff {S₁ S₂ : star_subalgebra R A} :
  S₁.to_subalgebra ≤ S₂.to_subalgebra ↔ S₁ ≤ S₂ := iff.rfl

/-- Copy of a star subalgebra with a new `carrier` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (S : star_subalgebra R A) (s : set A) (hs : s = ↑S) : star_subalgebra R A :=
{ carrier := s,
  add_mem' := λ _ _, hs.symm ▸ S.add_mem',
  mul_mem' := λ _ _, hs.symm ▸ S.mul_mem',
  algebra_map_mem' := hs.symm ▸ S.algebra_map_mem',
  star_mem' := λ _, hs.symm ▸ S.star_mem' }

@[simp] lemma coe_copy (S : star_subalgebra R A) (s : set A) (hs : s = ↑S) :
  (S.copy s hs : set A) = s := rfl

lemma copy_eq (S : star_subalgebra R A) (s : set A) (hs : s = ↑S) : S.copy s hs = S :=
set_like.coe_injective hs

variables (S : star_subalgebra R A)

theorem algebra_map_mem (r : R) : algebra_map R A r ∈ S :=
S.algebra_map_mem' r

theorem srange_le : (algebra_map R A).srange ≤ S.to_subalgebra.to_subsemiring :=
λ x ⟨r, hr⟩, hr ▸ S.algebra_map_mem r

theorem range_subset : set.range (algebra_map R A) ⊆ S :=
λ x ⟨r, hr⟩, hr ▸ S.algebra_map_mem r

theorem range_le : set.range (algebra_map R A) ≤ S :=
S.range_subset

protected theorem smul_mem {x : A} (hx : x ∈ S) (r : R) : r • x ∈ S :=
(algebra.smul_def r x).symm ▸ mul_mem (S.algebra_map_mem r) hx

/-- Embedding of a subalgebra into the algebra. -/
def subtype : S →⋆ₐ[R] A :=
by refine_struct { to_fun := (coe : S → A) }; intros; refl

@[simp] lemma coe_subtype : (S.subtype : S → A) = coe := rfl

lemma subtype_apply (x : S) : S.subtype x = (x : A) := rfl

@[simp] lemma to_subalgebra_subtype : S.to_subalgebra.val = S.subtype.to_alg_hom :=
rfl

/-- The inclusion map between `star_subalgebra`s given by `subtype.map id` as a `star_alg_hom`. -/
@[simps] def inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) : S₁ →⋆ₐ[R] S₂ :=
{ to_fun := subtype.map id h,
  map_one' := rfl,
  map_mul' := λ x y, rfl,
  map_zero' := rfl,
  map_add' := λ x y, rfl,
  commutes' := λ z, rfl,
  map_star' := λ x, rfl }

lemma inclusion_injective {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) :
  function.injective $ inclusion h :=
set.inclusion_injective h

@[simp] lemma subtype_comp_inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) :
  S₂.subtype.comp (inclusion h) = S₁.subtype :=
rfl

section map

/-- Transport a star subalgebra via a star algebra homomorphism. -/
def map (f : A →⋆ₐ[R] B) (S : star_subalgebra R A) : star_subalgebra R B :=
{ star_mem' :=
  begin
    rintro _ ⟨a, ha, rfl⟩,
    exact map_star f a ▸ set.mem_image_of_mem _ (S.star_mem' ha),
  end,
  .. S.to_subalgebra.map f.to_alg_hom }

lemma map_mono {S₁ S₂ : star_subalgebra R A} {f : A →⋆ₐ[R] B} :
  S₁ ≤ S₂ → S₁.map f ≤ S₂.map f :=
set.image_subset f

lemma map_injective {f : A →⋆ₐ[R] B} (hf : function.injective f) :
  function.injective (map f) :=
λ S₁ S₂ ih, ext $ set.ext_iff.1 $ set.image_injective.2 hf $ set.ext $ set_like.ext_iff.mp ih

@[simp] lemma map_id (S : star_subalgebra R A) : S.map (star_alg_hom.id R A) = S :=
set_like.coe_injective $ set.image_id _

lemma map_map (S : star_subalgebra R A) (g : B →⋆ₐ[R] C) (f : A →⋆ₐ[R] B) :
  (S.map f).map g = S.map (g.comp f) :=
set_like.coe_injective $ set.image_image _ _ _

lemma mem_map {S : star_subalgebra R A} {f : A →⋆ₐ[R] B} {y : B} :
  y ∈ map f S ↔ ∃ x ∈ S, f x = y :=
subsemiring.mem_map

lemma map_to_subalgebra {S : star_subalgebra R A} {f : A →⋆ₐ[R] B} :
  (S.map f).to_subalgebra = S.to_subalgebra.map f.to_alg_hom :=
set_like.coe_injective rfl

@[simp] lemma coe_map (S : star_subalgebra R A) (f : A →⋆ₐ[R] B) :
  (S.map f : set B) = f '' S :=
rfl

/-- Preimage of a star subalgebra under an star algebra homomorphism. -/
def comap (f : A →⋆ₐ[R] B) (S : star_subalgebra R B) : star_subalgebra R A :=
{ star_mem' := λ a ha, show f (star a) ∈ S, from (map_star f a).symm ▸ star_mem ha,
  .. S.to_subalgebra.comap f.to_alg_hom }

theorem map_le_iff_le_comap {S : star_subalgebra R A} {f : A →⋆ₐ[R] B} {U : star_subalgebra R B} :
  map f S ≤ U ↔ S ≤ comap f U :=
set.image_subset_iff

lemma gc_map_comap (f : A →⋆ₐ[R] B) : galois_connection (map f) (comap f) :=
λ S U, map_le_iff_le_comap

lemma comap_mono {S₁ S₂ : star_subalgebra R B} {f : A →⋆ₐ[R] B} :
  S₁ ≤ S₂ → S₁.comap f ≤ S₂.comap f :=
set.preimage_mono

lemma comap_injective {f : A →⋆ₐ[R] B} (hf : function.surjective f) :
  function.injective (comap f) :=
λ S₁ S₂ h, ext $ λ b, let ⟨x, hx⟩ := hf b in let this := set_like.ext_iff.1 h x in hx ▸ this

@[simp] lemma comap_id (S : star_subalgebra R A) : S.comap (star_alg_hom.id R A) = S :=
set_like.coe_injective $ set.preimage_id

lemma comap_comap (S : star_subalgebra R C) (g : B →⋆ₐ[R] C) (f : A →⋆ₐ[R] B) :
  (S.comap g).comap f = S.comap (g.comp f) :=
set_like.coe_injective $ set.preimage_preimage

@[simp] lemma mem_comap (S : star_subalgebra R B) (f : A →⋆ₐ[R] B) (x : A) :
  x ∈ S.comap f ↔ f x ∈ S :=
iff.rfl

@[simp, norm_cast] lemma coe_comap (S : star_subalgebra R B) (f : A →⋆ₐ[R] B) :
  (S.comap f : set A) = f ⁻¹' (S : set B) :=
rfl

end map

section centralizer
variables (R) {A}

lemma _root_.set.star_mem_centralizer {a : A} {s : set A}
  (h : ∀ (a : A), a ∈ s → star a ∈ s) (ha : a ∈ set.centralizer s) :
  star a ∈ set.centralizer s :=
λ y hy, by simpa using congr_arg star (ha _ (h _ hy)).symm

/-- The centralizer, or commutant, of a *-closed set as star subalgebra. -/
def centralizer
  (s : set A) (w : ∀ (a : A), a ∈ s → star a ∈ s) : star_subalgebra R A :=
{ star_mem' := λ x, set.star_mem_centralizer w,
  ..subalgebra.centralizer R s, }

@[simp]
lemma coe_centralizer (s : set A) (w : ∀ (a : A), a ∈ s → star a ∈ s) :
  (centralizer R s w : set A) = s.centralizer := rfl

lemma mem_centralizer_iff {s : set A} {w} {z : A} :
  z ∈ centralizer R s w ↔ ∀ g ∈ s, g * z = z * g :=
iff.rfl

lemma centralizer_le (s t : set A)
  (ws : ∀ (a : A), a ∈ s → star a ∈ s) (wt : ∀ (a : A), a ∈ t → star a ∈ t) (h : s ⊆ t) :
  centralizer R t wt ≤ centralizer R s ws :=
set.centralizer_subset h

end centralizer

end star_subalgebra

/-! ### The star closure of a subalgebra -/

namespace subalgebra

open_locale pointwise

variables {F R A B : Type*} [comm_semiring R] [star_ring R]
variables [semiring A] [algebra R A] [star_ring A] [star_module R A]
variables [semiring B] [algebra R B] [star_ring B] [star_module R B]

/-- The pointwise `star` of a subalgebra is a subalgebra. -/
instance : has_involutive_star (subalgebra R A) :=
{ star := λ S,
  { carrier := star S.carrier,
    mul_mem' := λ x y hx hy,
    begin
      simp only [set.mem_star, subalgebra.mem_carrier] at *,
      exact (star_mul x y).symm ▸ mul_mem hy hx,
    end,
    one_mem' := set.mem_star.mp ((star_one A).symm ▸ one_mem S : star (1 : A) ∈ S),
    add_mem' := λ x y hx hy,
    begin
      simp only [set.mem_star, subalgebra.mem_carrier] at *,
      exact (star_add x y).symm ▸ add_mem hx hy,
    end,
    zero_mem' := set.mem_star.mp ((star_zero A).symm ▸ zero_mem S : star (0 : A) ∈ S),
    algebra_map_mem' := λ r, by simpa only [set.mem_star, subalgebra.mem_carrier,
      ←algebra_map_star_comm] using S.algebra_map_mem (star r) },
  star_involutive := λ S, subalgebra.ext $ λ x, ⟨λ hx, (star_star x ▸ hx), λ hx,
    ((star_star x).symm ▸ hx : star (star x) ∈ S)⟩ }

@[simp] lemma mem_star_iff (S : subalgebra R A) (x : A) : x ∈ star S ↔ star x ∈ S := iff.rfl
@[simp] lemma star_mem_star_iff (S : subalgebra R A) (x : A) : star x ∈ star S ↔ x ∈ S :=
by simpa only [star_star] using mem_star_iff S (star x)
@[simp] lemma coe_star (S : subalgebra R A) : ((star S : subalgebra R A) : set A) = star S := rfl

lemma star_mono : monotone (star : subalgebra R A → subalgebra R A) := λ _ _ h _ hx, h hx

variables (R)

/-- The star operation on `subalgebra` commutes with `algebra.adjoin`. -/
lemma star_adjoin_comm (s : set A) : star (algebra.adjoin R s) = algebra.adjoin R (star s) :=
have this : ∀ t : set A, algebra.adjoin R (star t) ≤ star (algebra.adjoin R t),
  from λ t, algebra.adjoin_le (λ x hx, algebra.subset_adjoin hx),
le_antisymm (by simpa only [star_star] using subalgebra.star_mono (this (star s))) (this s)

variables {R}

/-- The `star_subalgebra` obtained from `S : subalgebra R A` by taking the smallest subalgebra
containing both `S` and `star S`. -/
@[simps] def star_closure (S : subalgebra R A) : star_subalgebra R A :=
{ star_mem' := λ a ha,
  begin
    simp only [subalgebra.mem_carrier, ←(@algebra.gi R A _ _ _).l_sup_u _ _] at *,
    rw [←mem_star_iff _ a, star_adjoin_comm],
    convert ha,
    simp [set.union_comm],
  end,
  .. S ⊔ star S }

lemma star_closure_le {S₁ : subalgebra R A} {S₂ : star_subalgebra R A} (h : S₁ ≤ S₂.to_subalgebra) :
  S₁.star_closure ≤ S₂ :=
star_subalgebra.to_subalgebra_le_iff.1 $ sup_le h $
  λ x hx, (star_star x ▸ star_mem (show star x ∈ S₂, from h $ (S₁.mem_star_iff _).1 hx) : x ∈ S₂)

lemma star_closure_le_iff {S₁ : subalgebra R A} {S₂ : star_subalgebra R A} :
  S₁.star_closure ≤ S₂ ↔ S₁ ≤ S₂.to_subalgebra :=
⟨λ h, le_sup_left.trans h, star_closure_le⟩

end subalgebra

/-! ### The star subalgebra generated by a set -/

namespace star_subalgebra

variables {F R A B : Type*} [comm_semiring R] [star_ring R]
variables [semiring A] [algebra R A] [star_ring A] [star_module R A]
variables [semiring B] [algebra R B] [star_ring B] [star_module R B]

variables (R)

/-- The minimal star subalgebra that contains `s`. -/
@[simps] def adjoin (s : set A) : star_subalgebra R A :=
{ star_mem' := λ x hx, by rwa [subalgebra.mem_carrier, ←subalgebra.mem_star_iff,
    subalgebra.star_adjoin_comm, set.union_star, star_star, set.union_comm],
  .. (algebra.adjoin R (s ∪ star s)) }

lemma adjoin_eq_star_closure_adjoin (s : set A) : adjoin R s = (algebra.adjoin R s).star_closure :=
to_subalgebra_injective $
  show algebra.adjoin R (s ∪ star s) = algebra.adjoin R s ⊔ star (algebra.adjoin R s),
  from (subalgebra.star_adjoin_comm R s).symm ▸ algebra.adjoin_union s (star s)

lemma adjoin_to_subalgebra (s : set A) :
  (adjoin R s).to_subalgebra = (algebra.adjoin R (s ∪ star s)) := rfl

lemma subset_adjoin (s : set A) : s ⊆ adjoin R s :=
  (set.subset_union_left s (star s)).trans algebra.subset_adjoin

lemma star_subset_adjoin (s : set A) : star s ⊆ adjoin R s :=
  (set.subset_union_right s (star s)).trans algebra.subset_adjoin

lemma self_mem_adjoin_singleton (x : A) : x ∈ adjoin R ({x} : set A) :=
algebra.subset_adjoin $ set.mem_union_left _ (set.mem_singleton x)

lemma star_self_mem_adjoin_singleton (x : A) : star x ∈ adjoin R ({x} : set A) :=
star_mem $ self_mem_adjoin_singleton R x

variables {R}

protected lemma gc : galois_connection (adjoin R : set A → star_subalgebra R A) coe :=
begin
  intros s S,
  rw [←to_subalgebra_le_iff, adjoin_to_subalgebra, algebra.adjoin_le_iff, coe_to_subalgebra],
  exact ⟨λ h, (set.subset_union_left s _).trans h,
    λ h, set.union_subset h $ λ x hx, star_star x ▸ star_mem (show star x ∈ S, from h hx)⟩,
end

/-- Galois insertion between `adjoin` and `coe`. -/
protected def gi : galois_insertion (adjoin R : set A → star_subalgebra R A) coe :=
{ choice := λ s hs, (adjoin R s).copy s $ le_antisymm (star_subalgebra.gc.le_u_l s) hs,
  gc := star_subalgebra.gc,
  le_l_u := λ S, (star_subalgebra.gc (S : set A) (adjoin R S)).1 $ le_rfl,
  choice_eq := λ _ _, star_subalgebra.copy_eq _ _ _ }

lemma adjoin_le {S : star_subalgebra R A} {s : set A} (hs : s ⊆ S) : adjoin R s ≤ S :=
star_subalgebra.gc.l_le hs

lemma adjoin_le_iff {S : star_subalgebra R A} {s : set A} : adjoin R s ≤ S ↔ s ⊆ S :=
star_subalgebra.gc _ _

lemma _root_.subalgebra.star_closure_eq_adjoin (S : subalgebra R A) :
  S.star_closure = adjoin R (S : set A) :=
le_antisymm (subalgebra.star_closure_le_iff.2 $ subset_adjoin R (S : set A))
  (adjoin_le (le_sup_left : S ≤ S ⊔ star S))

/-- If some predicate holds for all `x ∈ (s : set A)` and this predicate is closed under the
`algebra_map`, addition, multiplication and star operations, then it holds for `a ∈ adjoin R s`. -/
lemma adjoin_induction {s : set A} {p : A → Prop} {a : A} (h : a ∈ adjoin R s)
  (Hs : ∀ (x : A), x ∈ s → p x) (Halg : ∀ (r : R), p (algebra_map R A r))
  (Hadd : ∀ (x y : A), p x → p y → p (x + y)) (Hmul : ∀ (x y : A), p x → p y → p (x * y))
  (Hstar : ∀ (x : A), p x → p (star x)) : p a :=
algebra.adjoin_induction h (λ x hx, hx.elim (λ hx, Hs x hx) (λ hx, star_star x ▸ Hstar _ (Hs _ hx)))
  Halg Hadd Hmul

lemma adjoin_induction₂ {s : set A} {p : A → A → Prop} {a b : A} (ha : a ∈ adjoin R s)
  (hb : b ∈ adjoin R s) (Hs : ∀ (x : A), x ∈ s → ∀ (y : A), y ∈ s → p x y)
  (Halg : ∀ (r₁ r₂ : R), p (algebra_map R A r₁) (algebra_map R A r₂))
  (Halg_left : ∀ (r : R) (x : A), x ∈ s → p (algebra_map R A r) x)
  (Halg_right : ∀ (r : R) (x : A), x ∈ s → p x (algebra_map R A r))
  (Hadd_left : ∀ (x₁ x₂ y : A), p x₁ y → p x₂ y → p (x₁ + x₂) y)
  (Hadd_right : ∀ (x y₁ y₂ : A), p x y₁ → p x y₂ → p x (y₁ + y₂))
  (Hmul_left : ∀ (x₁ x₂ y : A), p x₁ y → p x₂ y → p (x₁ * x₂) y)
  (Hmul_right : ∀ (x y₁ y₂ : A), p x y₁ → p x y₂ → p x (y₁ * y₂))
  (Hstar : ∀ (x y : A), p x y → p (star x) (star y))
  (Hstar_left : ∀ (x y : A), p x y → p (star x) y)
  (Hstar_right : ∀ (x y : A), p x y → p x (star y)) : p a b :=
begin
  refine algebra.adjoin_induction₂ ha hb (λ x hx y hy, _) Halg (λ r x hx, _) (λ r x hx, _)
    Hadd_left Hadd_right Hmul_left Hmul_right,
  { cases hx; cases hy,
    exacts [Hs x hx y hy, star_star y ▸ Hstar_right _ _ (Hs _ hx _ hy),
      star_star x ▸ Hstar_left _ _ (Hs _ hx _ hy),
      star_star x ▸ star_star y ▸ Hstar _ _ (Hs _ hx _ hy)] },
  { cases hx, exacts [Halg_left _ _ hx, star_star x ▸ Hstar_right _ _ (Halg_left r _ hx)] },
  { cases hx, exacts [Halg_right _ _ hx, star_star x ▸ Hstar_left _ _ (Halg_right r _ hx)] },
end

/-- The difference with `star_subalgebra.adjoin_induction` is that this acts on the subtype. -/
lemma adjoin_induction' {s : set A} {p : adjoin R s → Prop} (a : adjoin R s)
  (Hs : ∀ x (h : x ∈ s), p ⟨x, subset_adjoin R s h⟩)
  (Halg : ∀ r, p (algebra_map R _ r)) (Hadd : ∀ x y, p x → p y → p (x + y))
  (Hmul : ∀ x y, p x → p y → p (x * y)) (Hstar : ∀ x, p x → p (star x)) : p a :=
subtype.rec_on a $ λ b hb,
begin
  refine exists.elim _ (λ (hb : b ∈ adjoin R s) (hc : p ⟨b, hb⟩), hc),
  apply adjoin_induction hb,
  exacts [λ x hx, ⟨subset_adjoin R s hx, Hs x hx⟩,
    λ r, ⟨star_subalgebra.algebra_map_mem _ r, Halg r⟩,
    (λ x y hx hy, exists.elim hx $ λ hx' hx,
      exists.elim hy $ λ hy' hy, ⟨add_mem hx' hy', Hadd _ _ hx hy⟩),
    (λ x y hx hy, exists.elim hx $ λ hx' hx,
      exists.elim hy $ λ hy' hy, ⟨mul_mem hx' hy', Hmul _ _ hx hy⟩),
    λ x hx, exists.elim hx (λ hx' hx, ⟨star_mem hx', Hstar _ hx⟩)]
end

variables (R)

/-- If all elements of `s : set A` commute pairwise and also commute pairwise with elements of
`star s`, then `star_subalgebra.adjoin R s` is commutative. See note [reducible non-instances]. -/
@[reducible]
def adjoin_comm_semiring_of_comm {s : set A}
  (hcomm : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * b = b * a)
  (hcomm_star : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * star b = star b * a) :
  comm_semiring (adjoin R s) :=
{ mul_comm :=
  begin
    rintro ⟨x, hx⟩ ⟨y, hy⟩,
    ext,
    simp only [set_like.coe_mk, mul_mem_class.mk_mul_mk],
    rw [←mem_to_subalgebra, adjoin_to_subalgebra] at hx hy,
    letI : comm_semiring (algebra.adjoin R (s ∪ star s)) := algebra.adjoin_comm_semiring_of_comm R
    begin
      intros a ha b hb,
      cases ha; cases hb,
      exacts [hcomm _ ha _ hb, star_star b ▸ hcomm_star _ ha _ hb,
        star_star a ▸ (hcomm_star _ hb _ ha).symm,
        by simpa only [star_mul, star_star] using congr_arg star (hcomm _ hb _ ha)],
    end,
    exact congr_arg coe (mul_comm (⟨x, hx⟩ : algebra.adjoin R (s ∪ star s)) ⟨y, hy⟩),
  end,
  ..(adjoin R s).to_subalgebra.to_semiring }

/-- If all elements of `s : set A` commute pairwise and also commute pairwise with elements of
`star s`, then `star_subalgebra.adjoin R s` is commutative. See note [reducible non-instances]. -/
@[reducible]
def adjoin_comm_ring_of_comm (R : Type u) {A : Type v} [comm_ring R] [star_ring R]
  [ring A] [algebra R A] [star_ring A] [star_module R A] {s : set A}
  (hcomm : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * b = b * a)
  (hcomm_star : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * star b = star b * a) :
  comm_ring (adjoin R s) :=
{ ..star_subalgebra.adjoin_comm_semiring_of_comm R hcomm hcomm_star,
  ..(adjoin R s).to_subalgebra.to_ring }

/-- The star subalgebra `star_subalgebra.adjoin R {x}` generated by a single `x : A` is commutative
if `x` is normal. -/
instance adjoin_comm_semiring_of_is_star_normal (x : A) [is_star_normal x] :
  comm_semiring (adjoin R ({x} : set A)) :=
adjoin_comm_semiring_of_comm R
  (λ a ha b hb, by { rw [set.mem_singleton_iff] at ha hb, rw [ha, hb] })
  (λ a ha b hb,
    by { rw [set.mem_singleton_iff] at ha hb, simpa only [ha, hb] using (star_comm_self' x).symm })

/-- The star subalgebra `star_subalgebra.adjoin R {x}` generated by a single `x : A` is commutative
if `x` is normal. -/
instance adjoin_comm_ring_of_is_star_normal (R : Type u) {A : Type v} [comm_ring R] [star_ring R]
  [ring A] [algebra R A] [star_ring A] [star_module R A]  (x : A) [is_star_normal x] :
  comm_ring (adjoin R ({x} : set A)) :=
{ mul_comm := mul_comm, ..(adjoin R ({x} : set A)).to_subalgebra.to_ring }

/-! ### Complete lattice structure -/

variables {F R A B}

instance : complete_lattice (star_subalgebra R A) :=
galois_insertion.lift_complete_lattice star_subalgebra.gi

instance : inhabited (star_subalgebra R A) := ⟨⊤⟩

@[simp]
lemma coe_top : (↑(⊤ : star_subalgebra R A) : set A) = set.univ := rfl

@[simp] lemma mem_top {x : A} : x ∈ (⊤ : star_subalgebra R A) :=
set.mem_univ x

@[simp] lemma top_to_subalgebra : (⊤ : star_subalgebra R A).to_subalgebra = ⊤ := rfl

@[simp] lemma to_subalgebra_eq_top {S : star_subalgebra R A} : S.to_subalgebra = ⊤ ↔ S = ⊤ :=
star_subalgebra.to_subalgebra_injective.eq_iff' top_to_subalgebra

lemma mem_sup_left {S T : star_subalgebra R A} : ∀ {x : A}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : star_subalgebra R A} : ∀ {x : A}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma mul_mem_sup {S T : star_subalgebra R A} {x y : A} (hx : x ∈ S) (hy : y ∈ T) :
  x * y ∈ S ⊔ T :=
mul_mem (mem_sup_left hx) (mem_sup_right hy)

lemma map_sup (f : A →⋆ₐ[R] B) (S T : star_subalgebra R A) : map f (S ⊔ T) = map f S ⊔ map f T :=
(star_subalgebra.gc_map_comap f).l_sup

@[simp, norm_cast]
lemma coe_inf (S T : star_subalgebra R A) : (↑(S ⊓ T) : set A) = S ∩ T := rfl

@[simp]
lemma mem_inf {S T : star_subalgebra R A} {x : A} : x ∈ S ⊓ T ↔ x ∈ S ∧ x ∈ T := iff.rfl

@[simp] lemma inf_to_subalgebra (S T : star_subalgebra R A) :
  (S ⊓ T).to_subalgebra = S.to_subalgebra ⊓ T.to_subalgebra := rfl

@[simp, norm_cast]
lemma coe_Inf (S : set (star_subalgebra R A)) : (↑(Inf S) : set A) = ⋂ s ∈ S, ↑s := Inf_image

lemma mem_Inf {S : set (star_subalgebra R A)} {x : A} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
by simp only [← set_like.mem_coe, coe_Inf, set.mem_Inter₂]

@[simp] lemma Inf_to_subalgebra (S : set (star_subalgebra R A)) :
  (Inf S).to_subalgebra = Inf (star_subalgebra.to_subalgebra '' S) :=
set_like.coe_injective $ by simp

@[simp, norm_cast]
lemma coe_infi {ι : Sort*} {S : ι → star_subalgebra R A} : (↑(⨅ i, S i) : set A) = ⋂ i, S i :=
by simp [infi]

lemma mem_infi {ι : Sort*} {S : ι → star_subalgebra R A} {x : A} : (x ∈ ⨅ i, S i) ↔ ∀ i, x ∈ S i :=
by simp only [infi, mem_Inf, set.forall_range_iff]

@[simp]

lemma bot_to_subalgebra : (⊥ : star_subalgebra R A).to_subalgebra = ⊥ :=
by { change algebra.adjoin R (∅ ∪ star ∅) = algebra.adjoin R ∅, simp }

theorem mem_bot {x : A} : x ∈ (⊥ : star_subalgebra R A) ↔ x ∈ set.range (algebra_map R A) :=
by rw [←mem_to_subalgebra, bot_to_subalgebra, algebra.mem_bot]

@[simp] theorem coe_bot : ((⊥ : star_subalgebra R A) : set A) = set.range (algebra_map R A) :=
by simp [set.ext_iff, mem_bot]

theorem eq_top_iff {S : star_subalgebra R A} :
  S = ⊤ ↔ ∀ x : A, x ∈ S :=
⟨λ h x, by rw h; exact mem_top, λ h, by ext x; exact ⟨λ _, mem_top, λ _, h x⟩⟩

end star_subalgebra

namespace star_alg_hom
open star_subalgebra

variables {F R A B : Type*} [comm_semiring R] [star_ring R]
variables [semiring A] [algebra R A] [star_ring A] [star_module R A]
variables [semiring B] [algebra R B] [star_ring B]
variables [hF : star_alg_hom_class F R A B] (f g : F)

include hF

/-- The equalizer of two star `R`-algebra homomorphisms. -/
def equalizer : star_subalgebra R A :=
{ carrier := {a | f a = g a},
  mul_mem' := λ a b (ha : f a = g a) (hb : f b = g b),
    by rw [set.mem_set_of_eq, map_mul f, map_mul g, ha, hb],
  add_mem' := λ a b (ha : f a = g a) (hb : f b = g b),
    by rw [set.mem_set_of_eq, map_add f, map_add g, ha, hb],
  algebra_map_mem' := λ r, by simp only [set.mem_set_of_eq, alg_hom_class.commutes],
  star_mem' := λ a (ha : f a = g a), by rw [set.mem_set_of_eq, map_star f, map_star g, ha] }

@[simp] lemma mem_equalizer (x : A) : x ∈ star_alg_hom.equalizer f g ↔ f x = g x := iff.rfl

lemma adjoin_le_equalizer {s : set A} (h : s.eq_on f g) : adjoin R s ≤ star_alg_hom.equalizer f g :=
adjoin_le h

lemma ext_of_adjoin_eq_top {s : set A}
  (h : adjoin R s = ⊤) ⦃f g : F⦄ (hs : s.eq_on f g) : f = g :=
fun_like.ext f g $ λ x, star_alg_hom.adjoin_le_equalizer f g hs $ h.symm ▸ trivial

omit hF

lemma map_adjoin [star_module R B] (f : A →⋆ₐ[R] B) (s : set A) :
  map f (adjoin R s) = adjoin R (f '' s) :=
galois_connection.l_comm_of_u_comm set.image_preimage (gc_map_comap f) star_subalgebra.gc
  star_subalgebra.gc (λ _, rfl)

lemma ext_adjoin {s : set A} [star_alg_hom_class F R (adjoin R s) B] {f g : F}
  (h : ∀ x : adjoin R s, (x : A) ∈ s → f x = g x) : f = g :=
begin
  refine fun_like.ext f g (λ a, adjoin_induction' a (λ x hx, _) (λ r, _) (λ x y hx hy, _)
    (λ x y hx hy, _) (λ x hx, _)),
  { exact h ⟨x, subset_adjoin R s hx⟩ hx },
  { simp only [alg_hom_class.commutes] },
  { rw [map_add, map_add, hx, hy] },
  { rw [map_mul, map_mul, hx, hy] },
  { rw [map_star, map_star, hx] },
end

lemma ext_adjoin_singleton {a : A} [star_alg_hom_class F R (adjoin R ({a} : set A)) B] {f g : F}
  (h : f ⟨a, self_mem_adjoin_singleton R a⟩ = g ⟨a, self_mem_adjoin_singleton R a⟩) : f = g :=
ext_adjoin $ λ x hx, (show x = ⟨a, self_mem_adjoin_singleton R a⟩,
  from subtype.ext $ set.mem_singleton_iff.mp hx).symm ▸ h

end star_alg_hom


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import data.set.lattice
import order.zorn

/-!
# Extend a partial order to a linear order

This file constructs a linear order which is an extension of the given partial order, using Zorn's
lemma.
-/

universes u
open set classical
open_locale classical

/--
Any partial order can be extended to a linear order.
-/
theorem extend_partial_order {α : Type u} (r : α → α → Prop) [is_partial_order α r] :
  ∃ (s : α → α → Prop) (_ : is_linear_order α s), r ≤ s :=
begin
  let S := {s | is_partial_order α s},
  have hS : ∀ c, c ⊆ S → zorn.chain (≤) c → ∀ y ∈ c, (∃ ub ∈ S, ∀ z ∈ c, z ≤ ub),
  { rintro c hc₁ hc₂ s hs,
    haveI := (hc₁ hs).1,
    refine ⟨Sup c, _, λ z hz, le_Sup hz⟩,
    refine { refl := _, trans := _, antisymm := _ }; simp_rw binary_relation_Sup_iff,
    { intro x,
      exact ⟨s, hs, refl x⟩ },
    { rintro x y z ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
      haveI : is_partial_order _ _ := hc₁ h₁s₁,
      haveI : is_partial_order _ _ := hc₁ h₁s₂,
      cases hc₂.total_of_refl h₁s₁ h₁s₂,
      { exact ⟨s₂, h₁s₂, trans (h _ _ h₂s₁) h₂s₂⟩ },
      { exact ⟨s₁, h₁s₁, trans h₂s₁ (h _ _ h₂s₂)⟩ } },
    { rintro x y ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
      haveI : is_partial_order _ _ := hc₁ h₁s₁,
      haveI : is_partial_order _ _ := hc₁ h₁s₂,
      cases hc₂.total_of_refl h₁s₁ h₁s₂,
      { exact antisymm (h _ _ h₂s₁) h₂s₂ },
      { apply antisymm h₂s₁ (h _ _ h₂s₂) } } },
  obtain ⟨s, hs₁ : is_partial_order _ _, rs, hs₂⟩ := zorn.zorn_nonempty_partial_order₀ S hS r ‹_›,
  resetI,
  refine ⟨s, { total := _ }, rs⟩,
  intros x y,
  by_contra h,
  push_neg at h,
  let s' := λ x' y', s x' y' ∨ s x' x ∧ s y y',
  rw ←hs₂ s' _ (λ _ _, or.inl) at h,
  { apply h.1 (or.inr ⟨refl _, refl _⟩) },
  { refine
      { refl := λ x, or.inl (refl _),
        trans := _,
        antisymm := _ },
    { rintro a b c (ab | ⟨ax : s a x, yb : s y b⟩) (bc | ⟨bx : s b x, yc : s y c⟩),
      { exact or.inl (trans ab bc), },
      { exact or.inr ⟨trans ab bx, yc⟩ },
      { exact or.inr ⟨ax, trans yb bc⟩ },
      { exact or.inr ⟨ax, yc⟩ } },
    { rintro a b (ab | ⟨ax : s a x, yb : s y b⟩) (ba | ⟨bx : s b x, ya : s y a⟩),
      { exact antisymm ab ba },
      { exact (h.2 (trans ya (trans ab bx))).elim },
      { exact (h.2 (trans yb (trans ba ax))).elim },
      { exact (h.2 (trans yb bx)).elim } } },
end

/-- A type alias for `α`, intended to extend a partial order on `α` to a linear order. -/
def linear_extension (α : Type u) : Type u := α

noncomputable instance {α : Type u} [partial_order α] : linear_order (linear_extension α) :=
{ le := (extend_partial_order ((≤) : α → α → Prop)).some,
  le_refl := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.1.1,
  le_trans := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.2.1,
  le_antisymm := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.2.1,
  le_total := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.2.1,
  decidable_le := classical.dec_rel _ }

/-- The embedding of `α` into `linear_extension α` as a relation homomorphism. -/
def to_linear_extension {α : Type u} [partial_order α] :
  ((≤) : α → α → Prop) →r ((≤) : linear_extension α → linear_extension α → Prop) :=
{ to_fun := λ x, x,
  map_rel' := λ a b, (extend_partial_order ((≤) : α → α → Prop)).some_spec.some_spec _ _ }

instance {α : Type u} [inhabited α] : inhabited (linear_extension α) :=
⟨(default _ : α)⟩


/- Lemmas about nth -/
universe u

namespace list

theorem nth_is_none_bound {α:Type} {l : list α} {i:ℕ} (pr : l.nth i = none)
: i ≥ l.length :=
begin
  revert i,
  induction l,
  case nil { intros i pr, apply nat.zero_le, },
  case cons h r ind {
    intros i pr,
    cases i; simp at pr,
    contradiction,
    exact nat.succ_le_succ (ind pr),
  }
end

theorem nth_is_some_bound {α:Type} {l : list α} {i:ℕ} {e : α}
(pr : l.nth i = some e)
: i < l.length :=
begin
  revert i,
  induction l,
  case nil { intros i pr, simp at pr, contradiction, },
  case cons h r ind {
    intros i pr,
    cases i,
    { apply nat.zero_lt_succ, },
    { apply nat.succ_le_succ (ind pr), }
  }
end

theorem nth_mem {α:Type} {l : list α} {i:ℕ} {e : α}
(pr : l.nth i = some e)
: e ∈ l :=
begin
  revert i,
  induction l,
  case nil { intros i pr, simp at pr, contradiction, },
  case cons h r ind {
    intros i pr,
    cases i; simp at pr,
    case nat.zero {
      simp [option.some.inj pr],
    },
    case nat.succ i {
      exact or.inr (ind pr),
    }
  }
end

lemma nth_mem_len {A} {x : A} {xs : list A}
  (H : x ∈ xs)
  : ∃ n, xs.nth n = some x :=
begin
  induction xs,
  case nil { simp at H, contradiction, },
  case cons h r ind {
    simp at H,
    cases H with here there,
    { apply exists.intro 0,
      simp [here],
    },
    { apply exists.elim (ind there),
      intros n pr,
      constructor,
      change (nth (h :: r) (nat.succ n) = some x),
      exact pr,
    }
  },
end

lemma nth_append_left {α:Type u} {x : α} (xs ys : list α) {i : ℕ}
  (pr : xs.nth i = some x)
  : (xs ++ ys).nth i = some x :=
begin
  revert i,
  induction xs,
  case nil { intros i pr, contradiction, },
  case cons h r ind {
    intros i pr,
    cases i with i,
    { exact pr, },
    { exact ind pr, },
  }
end

end list


import tactic.linarith

example (e b c a v0 v1 : ℚ) (h1 : v0 = 5*a) (h2 : v1 = 3*b) (h3 : v0 + v1 + c = 10) :
  v0 + 5 + (v1 - 3) + (c - 2) = 10 :=
by linarith

example (ε : ℚ) (h1 : ε > 0) : ε / 2 + ε / 3 + ε / 7 < ε :=
 by linarith

example (x y z : ℚ) (h1 : 2*x  < 3*y) (h2 : -4*x + z/2 < 0)
        (h3 : 12*y - z < 0)  : false :=
by linarith

example (ε : ℚ) (h1 : ε > 0) : ε / 2 < ε :=
by linarith

example (ε : ℚ) (h1 : ε > 0) : ε / 3 + ε / 3 + ε / 3 = ε :=
by linarith

example (a b c : ℚ)  (h2 : b + 2 > 3 + b) : false :=
by linarith {discharger := `[ring SOP]}

example (a b c : ℚ)  (h2 : b + 2 > 3 + b) : false :=
by linarith

example (a b c : ℚ) (x y : ℤ) (h1 : x ≤ 3*y) (h2 : b + 2 > 3 + b) : false :=
by linarith {restrict_type := ℚ}

example (g v V c h : ℚ) (h1 : h = 0) (h2 : v = V) (h3 : V > 0) (h4 : g > 0)
        (h5 : 0 ≤ c) (h6 : c < 1) :
  v ≤ V :=
by linarith

example (x y z : ℚ) (h1 : 2*x + ((-3)*y) < 0) (h2 : (-4)*x + 2*z < 0)
       (h3 : 12*y + (-4)* z < 0) (h4 : nat.prime 7) : false :=
by linarith

example (x y z : ℚ) (h1 : 2*1*x + (3)*(y*(-1)) < 0) (h2 : (-2)*x*2 < -(z + z))
       (h3 : 12*y + (-4)* z < 0) (h4 : nat.prime 7) : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0) (h3 : x*y < 5)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith

example (x y z : ℤ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0) (h3 : x*y < 5) :
        ¬ 12*y - 4* z < 0 :=
by linarith

example (w x y z : ℤ) (h1 : 4*x + (-3)*y + 6*w ≤ 0) (h2 : (-1)*x < 0)
        (h3 : y < 0) (h4 : w ≥ 0) (h5 : nat.prime x.nat_abs) : false :=
by linarith

example (a b c : ℚ) (h1 : a > 0) (h2 : b > 5) (h3 : c < -10)
        (h4 : a + b - c < 3)  : false :=
by linarith

example (a b c : ℚ) (h2 : b > 0) (h3 : ¬ b ≥ 0) : false :=
by linarith

example (a b c : ℚ) (h2 : (2 : ℚ) > 3)  : a + b - c ≥ 3 :=
by linarith {exfalso := ff}

example (x : ℚ) (hx : x > 0) (h : x.num < 0) : false :=
by linarith using [rat.num_pos_iff_pos.mpr hx]

example (x y z : ℚ) (hx : x ≤ 3*y) (h2 : y ≤ 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (x y z : ℕ) (hx : x ≤ 3*y) (h2 : y ≤ 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (x y z : ℚ) (hx : ¬ x > 3*y) (h2 : ¬ y > 2*z) (h3 : x ≥ 6*z) : x = 3*y :=
by linarith

example (h1 : (1 : ℕ) < 1) : false :=
by linarith

example (a b c : ℚ) (h2 : b > 0) (h3 : b < 0) : nat.prime 10 :=
by linarith

example (a b c : ℕ) : a + b ≥ a :=
by linarith

example (a b c : ℕ) : ¬ a + b < a :=
by linarith

example (x y : ℚ) (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3) (h' : (x + 4) * x ≥ 0)
  (h'' : (6 + 3 * y) * y ≥ 0)  : false :=
by linarith

example (x y : ℕ) (h : 6 + ((x + 4) * x + (6 + 3 * y) * y) = 3) : false :=
by linarith

example (a b i : ℕ) (h1 :  ¬ a < i) (h2 : b < i) (h3 : a ≤ b) : false :=
by linarith

example (n : ℕ) (h1 : n ≤ 3) (h2 : n > 2) : n = 3 := by linarith

example (z : ℕ) (hz : ¬ z ≥ 2) (h2 : ¬ z + 1 ≤ 2) : false :=
by linarith

example (z : ℕ) (hz : ¬ z ≥ 2) : z + 1 ≤ 2 :=
by linarith

example (a b c : ℚ) (h1 : 1 / a < b) (h2 : b < c) : 1 / a < c :=
by linarith

example
(N : ℕ) (n : ℕ) (Hirrelevant : n > N)
(A : ℚ) (l : ℚ) (h : A - l ≤ -(A - l)) (h_1 : ¬A ≤ -A) (h_2 : ¬l ≤ -l)
(h_3 : -(A - l) < 1) :  A < l + 1 := by linarith

example (d : ℚ) (q n : ℕ) (h1 : ((q : ℚ) - 1)*n ≥ 0) (h2 : d = 2/3*(((q : ℚ) - 1)*n)) : d ≤ ((q : ℚ) - 1)*n :=
by linarith

example (d : ℚ) (q n : ℕ) (h1 : ((q : ℚ) - 1)*n ≥ 0) (h2 : d = 2/3*(((q : ℚ) - 1)*n)) :
  ((q : ℚ) - 1)*n - d = 1/3 * (((q : ℚ) - 1)*n) :=
by linarith

example (a : ℚ) (ha : 0 ≤ a): 0 * 0 ≤ 2 * a :=
by linarith


import data.set
import data.int.basic
open function int set

section
  def f (x : ℤ) : ℤ := x + 3
  def g (x : ℤ) : ℤ := -x
  def h (x : ℤ) : ℤ := 2 * x + 3

  -- 1
  example : injective h :=
  assume x1 x2,
  assume h1,
  have h2: 2 ≠ (0 : ℤ), from dec_trivial,
  show x1 = x2, from mul_left_cancel₀ h2 (add_right_cancel h1)

  -- 2
  example : surjective g :=
  assume y,
  have h1 : g (-y) = y, from calc
     g (-y) = -(-y) : rfl
        ...  = y : by rw neg_neg,
  show ∃ x, g x = y, from exists.intro (-y) h1

  -- 3
  example (A B : Type) (u : A → B) (v1 : B → A) (v2 : B → A)
    (h1 : left_inverse v1 u) (h2 : right_inverse v2 u) : v1 = v2 :=
  funext
   (assume x,
      calc
        v1 x = v1 (u (v2 x)) : by rw h2
         ... = v2 x          : by rw h1)
end

-- 4
section
  variables {X Y : Type}
  variable f : X → Y
  variables A B : set X

  example : f '' (A ∩ B) ⊆ f '' A ∩ f '' B :=
  assume y,
  assume h1 : y ∈ f '' (A ∩ B),
  exists.elim h1 $
  assume x h,
  have h2 : x ∈ (A ∩ B), from h.left,
  have h3 : f x = y, from h.right,
  have h4 : x ∈ A, from and.left h2,
  have h5 : x ∈ B, from and.right h2,
  have h6 : y ∈ f '' A, from ⟨x, h4, h3⟩,
  have h7 : y ∈ f '' B, from ⟨x, h5, h3⟩,
  show y ∈ f '' A ∩ f '' B, from and.intro (h6)(h7)

end