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

import algebra.polynomial.big_operators
import algebra.squarefree
import field_theory.minpoly
import field_theory.splitting_field

/-!

# Separable polynomials

We define a polynomial to be separable if it is coprime with its derivative. We prove basic
properties about separable polynomials here.

## Main definitions

* `polynomial.separable f`: a polynomial `f` is separable iff it is coprime with its derivative.
* `polynomial.expand R p f`: expand the polynomial `f` with coefficients in a
  commutative semiring `R` by a factor of p, so `expand R p (∑ aₙ xⁿ)` is `∑ aₙ xⁿᵖ`.
* `polynomial.contract p f`: the opposite of `expand`, so it sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`.

-/

universes u v w
open_locale classical big_operators polynomial
open finset

namespace polynomial

section comm_semiring

variables {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S]

/-- A polynomial is separable iff it is coprime with its derivative. -/
def separable (f : R[X]) : Prop :=
is_coprime f f.derivative

lemma separable_def (f : R[X]) :
  f.separable ↔ is_coprime f f.derivative :=
iff.rfl

lemma separable_def' (f : R[X]) :
  f.separable ↔ ∃ a b : R[X], a * f + b * f.derivative = 1 :=
iff.rfl

lemma not_separable_zero [nontrivial R] : ¬ separable (0 : R[X]) :=
begin
  rintro ⟨x, y, h⟩,
  simpa only [derivative_zero, mul_zero, add_zero, zero_ne_one] using h,
end

lemma separable_one : (1 : R[X]).separable :=
is_coprime_one_left

@[nontriviality] lemma separable_of_subsingleton [subsingleton R] (f : R[X]) :
  f.separable := by simp [separable]

lemma separable_X_add_C (a : R) : (X + C a).separable :=
by { rw [separable_def, derivative_add, derivative_X, derivative_C, add_zero],
  exact is_coprime_one_right }

lemma separable_X : (X : R[X]).separable :=
by { rw [separable_def, derivative_X], exact is_coprime_one_right }

lemma separable_C (r : R) : (C r).separable ↔ is_unit r :=
by rw [separable_def, derivative_C, is_coprime_zero_right, is_unit_C]

lemma separable.of_mul_left {f g : R[X]} (h : (f * g).separable) : f.separable :=
begin
  have := h.of_mul_left_left, rw derivative_mul at this,
  exact is_coprime.of_mul_right_left (is_coprime.of_add_mul_left_right this)
end

lemma separable.of_mul_right {f g : R[X]} (h : (f * g).separable) : g.separable :=
by { rw mul_comm at h, exact h.of_mul_left }

lemma separable.of_dvd {f g : R[X]} (hf : f.separable) (hfg : g ∣ f) : g.separable :=
by { rcases hfg with ⟨f', rfl⟩, exact separable.of_mul_left hf }

lemma separable_gcd_left {F : Type*} [field F] {f : F[X]}
  (hf : f.separable) (g : F[X]) : (euclidean_domain.gcd f g).separable :=
separable.of_dvd hf (euclidean_domain.gcd_dvd_left f g)

lemma separable_gcd_right {F : Type*} [field F] {g : F[X]}
  (f : F[X]) (hg : g.separable) : (euclidean_domain.gcd f g).separable :=
separable.of_dvd hg (euclidean_domain.gcd_dvd_right f g)

lemma separable.is_coprime {f g : R[X]} (h : (f * g).separable) : is_coprime f g :=
begin
  have := h.of_mul_left_left, rw derivative_mul at this,
  exact is_coprime.of_mul_right_right (is_coprime.of_add_mul_left_right this)
end

theorem separable.of_pow' {f : R[X]} :
  ∀ {n : ℕ} (h : (f ^ n).separable), is_unit f ∨ (f.separable ∧ n = 1) ∨ n = 0
| 0     := λ h, or.inr $ or.inr rfl
| 1     := λ h, or.inr $ or.inl ⟨pow_one f ▸ h, rfl⟩
| (n+2) := λ h, by { rw [pow_succ, pow_succ] at h,
    exact or.inl (is_coprime_self.1 h.is_coprime.of_mul_right_left) }

theorem separable.of_pow {f : R[X]} (hf : ¬is_unit f) {n : ℕ} (hn : n ≠ 0)
  (hfs : (f ^ n).separable) : f.separable ∧ n = 1 :=
(hfs.of_pow'.resolve_left hf).resolve_right hn

theorem separable.map {p : R[X]} (h : p.separable) {f : R →+* S} : (p.map f).separable :=
let ⟨a, b, H⟩ := h in ⟨a.map f, b.map f,
by rw [derivative_map, ← map_mul, ← map_mul, ← map_add, H, map_one]⟩

variables (R) (p q : ℕ)

/-- Expand the polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`. -/
noncomputable def expand : R[X] →ₐ[R] R[X] :=
{ commutes' := λ r, eval₂_C _ _,
  .. (eval₂_ring_hom C (X ^ p) : R[X] →+* R[X]) }

lemma coe_expand : (expand R p : R[X] → R[X]) = eval₂ C (X ^ p) := rfl

variables {R}

lemma expand_eq_sum {f : R[X]} :
  expand R p f = f.sum (λ e a, C a * (X ^ p) ^ e) :=
by { dsimp [expand, eval₂], refl, }

@[simp] lemma expand_C (r : R) : expand R p (C r) = C r := eval₂_C _ _
@[simp] lemma expand_X : expand R p X = X ^ p := eval₂_X _ _
@[simp] lemma expand_monomial (r : R) : expand R p (monomial q r) = monomial (q * p) r :=
by simp_rw [monomial_eq_smul_X, alg_hom.map_smul, alg_hom.map_pow, expand_X, mul_comm, pow_mul]

theorem expand_expand (f : R[X]) : expand R p (expand R q f) = expand R (p * q) f :=
polynomial.induction_on f (λ r, by simp_rw expand_C)
  (λ f g ihf ihg, by simp_rw [alg_hom.map_add, ihf, ihg])
  (λ n r ih, by simp_rw [alg_hom.map_mul, expand_C, alg_hom.map_pow, expand_X,
    alg_hom.map_pow, expand_X, pow_mul])

theorem expand_mul (f : R[X]) : expand R (p * q) f = expand R p (expand R q f) :=
(expand_expand p q f).symm

@[simp] theorem expand_zero (f : R[X]) : expand R 0 f = C (eval 1 f) :=
by simp [expand]

@[simp] theorem expand_one (f : R[X]) : expand R 1 f = f :=
polynomial.induction_on f
  (λ r, by rw expand_C)
  (λ f g ihf ihg, by rw [alg_hom.map_add, ihf, ihg])
  (λ n r ih, by rw [alg_hom.map_mul, expand_C, alg_hom.map_pow, expand_X, pow_one])

theorem expand_pow (f : R[X]) : expand R (p ^ q) f = (expand R p ^[q] f) :=
nat.rec_on q (by rw [pow_zero, expand_one, function.iterate_zero, id]) $ λ n ih,
by rw [function.iterate_succ_apply', pow_succ, expand_mul, ih]

theorem derivative_expand (f : R[X]) :
  (expand R p f).derivative = expand R p f.derivative * (p * X ^ (p - 1)) :=
by rw [coe_expand, derivative_eval₂_C, derivative_pow, derivative_X, mul_one]

theorem coeff_expand {p : ℕ} (hp : 0 < p) (f : R[X]) (n : ℕ) :
  (expand R p f).coeff n = if p ∣ n then f.coeff (n / p) else 0 :=
begin
  simp only [expand_eq_sum],
  simp_rw [coeff_sum, ← pow_mul, C_mul_X_pow_eq_monomial, coeff_monomial, sum],
  split_ifs with h,
  { rw [finset.sum_eq_single (n/p), nat.mul_div_cancel' h, if_pos rfl],
    { intros b hb1 hb2, rw if_neg, intro hb3, apply hb2, rw [← hb3, nat.mul_div_cancel_left b hp] },
    { intro hn, rw not_mem_support_iff.1 hn, split_ifs; refl } },
  { rw finset.sum_eq_zero, intros k hk, rw if_neg, exact λ hkn, h ⟨k, hkn.symm⟩, },
end

@[simp] theorem coeff_expand_mul {p : ℕ} (hp : 0 < p) (f : R[X]) (n : ℕ) :
  (expand R p f).coeff (n * p) = f.coeff n :=
by rw [coeff_expand hp, if_pos (dvd_mul_left _ _), nat.mul_div_cancel _ hp]

@[simp] theorem coeff_expand_mul' {p : ℕ} (hp : 0 < p) (f : R[X]) (n : ℕ) :
  (expand R p f).coeff (p * n) = f.coeff n :=
by rw [mul_comm, coeff_expand_mul hp]

theorem expand_inj {p : ℕ} (hp : 0 < p) {f g : R[X]} :
  expand R p f = expand R p g ↔ f = g :=
⟨λ H, ext $ λ n, by rw [← coeff_expand_mul hp, H, coeff_expand_mul hp], congr_arg _⟩

theorem expand_eq_zero {p : ℕ} (hp : 0 < p) {f : R[X]} : expand R p f = 0 ↔ f = 0 :=
by rw [← (expand R p).map_zero, expand_inj hp, alg_hom.map_zero]

theorem expand_eq_C {p : ℕ} (hp : 0 < p) {f : R[X]} {r : R} :
  expand R p f = C r ↔ f = C r :=
by rw [← expand_C, expand_inj hp, expand_C]

theorem nat_degree_expand (p : ℕ) (f : R[X]) :
  (expand R p f).nat_degree = f.nat_degree * p :=
begin
  cases p.eq_zero_or_pos with hp hp,
  { rw [hp, coe_expand, pow_zero, mul_zero, ← C_1, eval₂_hom, nat_degree_C] },
  by_cases hf : f = 0,
  { rw [hf, alg_hom.map_zero, nat_degree_zero, zero_mul] },
  have hf1 : expand R p f ≠ 0 := mt (expand_eq_zero hp).1 hf,
  rw [← with_bot.coe_eq_coe, ← degree_eq_nat_degree hf1],
  refine le_antisymm ((degree_le_iff_coeff_zero _ _).2 $ λ n hn, _) _,
  { rw coeff_expand hp, split_ifs with hpn,
    { rw coeff_eq_zero_of_nat_degree_lt, contrapose! hn,
      rw [with_bot.coe_le_coe, ← nat.div_mul_cancel hpn], exact nat.mul_le_mul_right p hn },
    { refl } },
  { refine le_degree_of_ne_zero _,
    rw [coeff_expand_mul hp, ← leading_coeff], exact mt leading_coeff_eq_zero.1 hf }
end

lemma monic.expand {p : ℕ} {f : R[X]} (hp : 0 < p) (h : f.monic) : (expand R p f).monic :=
begin
  rw [monic.def, leading_coeff, nat_degree_expand, coeff_expand hp],
  simp [hp, h],
end

theorem map_expand {p : ℕ} {f : R →+* S} {q : R[X]} :
  map f (expand R p q) = expand S p (map f q) :=
begin
  by_cases hp : p = 0,
  { simp [hp] },
  ext,
  rw [coeff_map, coeff_expand (nat.pos_of_ne_zero hp), coeff_expand (nat.pos_of_ne_zero hp)],
  split_ifs; simp,
end

/-- Expansion is injective. -/
lemma expand_injective {n : ℕ} (hn : 0 < n) :
  function.injective (expand R n) :=
λ g g' h, begin
  ext,
  have h' : (expand R n g).coeff (n * n_1) = (expand R n g').coeff (n * n_1) :=
  begin
    apply polynomial.ext_iff.1,
    exact h,
  end,

  rw [polynomial.coeff_expand hn g (n * n_1), polynomial.coeff_expand hn g' (n * n_1)] at h',
  simp only [if_true, dvd_mul_right] at h',
  rw (nat.mul_div_right n_1 hn) at h',
  exact h',
end

@[simp]
lemma expand_eval (p : ℕ) (P : R[X]) (r : R) : eval r (expand R p P) = eval (r ^ p) P :=
begin
  refine polynomial.induction_on P (λ a, by simp) (λ f g hf hg, _) (λ n a h, by simp),
  rw [alg_hom.map_add, eval_add, eval_add, hf, hg]
end

lemma is_unit_of_self_mul_dvd_separable {p q : R[X]}
  (hp : p.separable) (hq : q * q ∣ p) : is_unit q :=
begin
  obtain ⟨p, rfl⟩ := hq,
  apply is_coprime_self.mp,
  have : is_coprime (q * (q * p)) (q * (q.derivative * p + q.derivative * p + q * p.derivative)),
  { simp only [← mul_assoc, mul_add],
    convert hp,
    rw [derivative_mul, derivative_mul],
    ring },
  exact is_coprime.of_mul_right_left (is_coprime.of_mul_left_left this)
end

/-- The opposite of `expand`: sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`. -/
noncomputable def contract (p : ℕ) (f : R[X]) : R[X] :=
∑ n in range (f.nat_degree + 1), monomial n (f.coeff (n * p))

theorem coeff_contract {p : ℕ} (hp : p ≠ 0) (f : R[X]) (n : ℕ) :
  (contract p f).coeff n = f.coeff (n * p) :=
begin
  simp only [contract, coeff_monomial, sum_ite_eq', finset_sum_coeff, mem_range, not_lt,
    ite_eq_left_iff],
  assume hn,
  apply (coeff_eq_zero_of_nat_degree_lt _).symm,
  calc f.nat_degree < f.nat_degree + 1 : nat.lt_succ_self _
    ... ≤ n * 1 : by simpa only [mul_one] using hn
    ... ≤ n * p : mul_le_mul_of_nonneg_left (show 1 ≤ p, from hp.bot_lt) (zero_le n)
end

theorem contract_expand {f : R[X]} (hp : p ≠ 0) : contract p (expand R p f) = f :=
begin
  ext,
  simp [coeff_contract hp, coeff_expand hp.bot_lt, nat.mul_div_cancel _ hp.bot_lt]
end

section char_p

variable [char_p R p]

theorem expand_contract [no_zero_divisors R] {f : R[X]} (hf : f.derivative = 0)
  (hp : p ≠ 0) : expand R p (contract p f) = f :=
begin
  ext n,
  rw [coeff_expand hp.bot_lt, coeff_contract hp],
  split_ifs with h,
  { rw nat.div_mul_cancel h },
  { cases n,
    { exact absurd (dvd_zero p) h },
    have := coeff_derivative f n,
    rw [hf, coeff_zero, zero_eq_mul] at this,
    cases this,
    { rw this },
    rw [← nat.cast_succ, char_p.cast_eq_zero_iff R p] at this,
    exact absurd this h }
end

variable [hp : fact p.prime]
include hp

theorem expand_char (f : R[X]) : map (frobenius R p) (expand R p f) = f ^ p :=
begin
  refine f.induction_on' (λ a b ha hb, _) (λ n a, _),
  { rw [alg_hom.map_add, map_add, ha, hb, add_pow_char], },
  { rw [expand_monomial, map_monomial, monomial_eq_C_mul_X, monomial_eq_C_mul_X,
        mul_pow, ← C.map_pow, frobenius_def],
    ring_exp }
end

theorem map_expand_pow_char (f : R[X]) (n : ℕ) :
   map ((frobenius R p) ^ n) (expand R (p ^ n) f) = f ^ (p ^ n) :=
begin
  induction n,
  { simp [ring_hom.one_def] },
  symmetry,
  rw [pow_succ', pow_mul, ← n_ih, ← expand_char, pow_succ, ring_hom.mul_def,
      ← map_map, mul_comm, expand_mul, ← map_expand]
end

end char_p

lemma multiplicity_le_one_of_separable {p q : R[X]} (hq : ¬ is_unit q)
  (hsep : separable p) : multiplicity q p ≤ 1 :=
begin
  contrapose! hq,
  apply is_unit_of_self_mul_dvd_separable hsep,
  rw ← sq,
  apply multiplicity.pow_dvd_of_le_multiplicity,
  simpa only [nat.cast_one, nat.cast_bit0] using enat.add_one_le_of_lt hq
end

lemma separable.squarefree {p : R[X]} (hsep : separable p) : squarefree p :=
begin
  rw multiplicity.squarefree_iff_multiplicity_le_one p,
  intro f,
  by_cases hunit : is_unit f,
  { exact or.inr hunit },
  exact or.inl (multiplicity_le_one_of_separable hunit hsep)
end

end comm_semiring

section comm_ring

variables {R : Type u} [comm_ring R]

lemma separable_X_sub_C {x : R} : separable (X - C x) :=
by simpa only [sub_eq_add_neg, C_neg] using separable_X_add_C (-x)

lemma separable.mul {f g : R[X]} (hf : f.separable) (hg : g.separable)
  (h : is_coprime f g) : (f * g).separable :=
by { rw [separable_def, derivative_mul], exact ((hf.mul_right h).add_mul_left_right _).mul_left
  ((h.symm.mul_right hg).mul_add_right_right _) }

lemma separable_prod' {ι : Sort*} {f : ι → R[X]} {s : finset ι} :
  (∀x∈s, ∀y∈s, x ≠ y → is_coprime (f x) (f y)) → (∀x∈s, (f x).separable) →
  (∏ x in s, f x).separable :=
finset.induction_on s (λ _ _, separable_one) $ λ a s has ih h1 h2, begin
  simp_rw [finset.forall_mem_insert, forall_and_distrib] at h1 h2, rw prod_insert has,
  exact h2.1.mul (ih h1.2.2 h2.2) (is_coprime.prod_right $ λ i his, h1.1.2 i his $
    ne.symm $ ne_of_mem_of_not_mem his has)
end

lemma separable_prod {ι : Sort*} [fintype ι] {f : ι → R[X]}
  (h1 : pairwise (is_coprime on f)) (h2 : ∀ x, (f x).separable) : (∏ x, f x).separable :=
separable_prod' (λ x hx y hy hxy, h1 x y hxy) (λ x hx, h2 x)

lemma separable.inj_of_prod_X_sub_C [nontrivial R] {ι : Sort*} {f : ι → R} {s : finset ι}
  (hfs : (∏ i in s, (X - C (f i))).separable)
  {x y : ι} (hx : x ∈ s) (hy : y ∈ s) (hfxy : f x = f y) : x = y :=
begin
  by_contra hxy,
  rw [← insert_erase hx, prod_insert (not_mem_erase _ _),
      ← insert_erase (mem_erase_of_ne_of_mem (ne.symm hxy) hy),
      prod_insert (not_mem_erase _ _), ← mul_assoc, hfxy, ← sq] at hfs,
  cases (hfs.of_mul_left.of_pow (by exact not_is_unit_X_sub_C _) two_ne_zero).2
end

lemma separable.injective_of_prod_X_sub_C [nontrivial R] {ι : Sort*} [fintype ι] {f : ι → R}
  (hfs : (∏ i, (X - C (f i))).separable) : function.injective f :=
λ x y hfxy, hfs.inj_of_prod_X_sub_C (mem_univ _) (mem_univ _) hfxy

lemma nodup_of_separable_prod [nontrivial R] {s : multiset R}
  (hs : separable (multiset.map (λ a, X - C a) s).prod) : s.nodup :=
begin
  rw multiset.nodup_iff_ne_cons_cons,
  rintros a t rfl,
  refine not_is_unit_X_sub_C a (is_unit_of_self_mul_dvd_separable hs _),
  simpa only [multiset.map_cons, multiset.prod_cons] using mul_dvd_mul_left _ (dvd_mul_right _ _)
end

/--If `is_unit n` in a `comm_ring R`, then `X ^ n - u` is separable for any unit `u`. -/
lemma separable_X_pow_sub_C_unit {n : ℕ} (u : Rˣ) (hn : is_unit (n : R)) :
  separable (X ^ n - C (u : R)) :=
begin
  nontriviality R,
  rcases n.eq_zero_or_pos with rfl | hpos,
  { simpa using hn },
  apply (separable_def' (X ^ n - C (u : R))).2,
  obtain ⟨n', hn'⟩ := hn.exists_left_inv,
  refine ⟨-C ↑u⁻¹, C ↑u⁻¹ * C n' * X, _⟩,
  rw [derivative_sub, derivative_C, sub_zero, derivative_pow X n, derivative_X, mul_one],
  calc  - C ↑u⁻¹ * (X ^ n - C ↑u) + C ↑u⁻¹ * C n' * X * (↑n * X ^ (n - 1))
      = C (↑u⁻¹ * ↑ u) - C ↑u⁻¹ * X^n + C ↑ u ⁻¹ * C (n' * ↑n) * (X * X ^ (n - 1)) :
    by { simp only [C.map_mul, C_eq_nat_cast], ring }
  ... = 1 : by simp only [units.inv_mul, hn', C.map_one, mul_one, ← pow_succ,
              nat.sub_add_cancel (show 1 ≤ n, from hpos), sub_add_cancel]
end

lemma root_multiplicity_le_one_of_separable [nontrivial R] {p : R[X]}
  (hsep : separable p) (x : R) : root_multiplicity x p ≤ 1 :=
begin
  by_cases hp : p = 0,
  { simp [hp], },
  rw [root_multiplicity_eq_multiplicity, dif_neg hp, ← enat.coe_le_coe, enat.coe_get, nat.cast_one],
  exact multiplicity_le_one_of_separable (not_is_unit_X_sub_C _) hsep
end

end comm_ring

section is_domain

variables (R : Type u) [comm_ring R] [is_domain R]

theorem is_local_ring_hom_expand {p : ℕ} (hp : 0 < p) :
  is_local_ring_hom (↑(expand R p) : R[X] →+* R[X]) :=
begin
  refine ⟨λ f hf1, _⟩, rw ← coe_fn_coe_base at hf1,
  have hf2 := eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf1),
  rw [coeff_expand hp, if_pos (dvd_zero _), p.zero_div] at hf2,
  rw [hf2, is_unit_C] at hf1, rw expand_eq_C hp at hf2, rwa [hf2, is_unit_C]
end

variable {R}

theorem of_irreducible_expand {p : ℕ} (hp : p ≠ 0) {f : R[X]}
  (hf : irreducible (expand R p f)) : irreducible f :=
@@of_irreducible_map _ _ _ (is_local_ring_hom_expand R hp.bot_lt) hf

theorem of_irreducible_expand_pow {p : ℕ} (hp : p ≠ 0) {f : R[X]} {n : ℕ} :
  irreducible (expand R (p ^ n) f) → irreducible f :=
nat.rec_on n (λ hf, by rwa [pow_zero, expand_one] at hf) $ λ n ih hf,
ih $ of_irreducible_expand hp $ by { rw pow_succ at hf, rwa [expand_expand] }

lemma count_roots_le_one {p : R[X]} (hsep : separable p) (x : R) :
  p.roots.count x ≤ 1 :=
begin
  rw count_roots p,
  exact root_multiplicity_le_one_of_separable hsep x
end

lemma nodup_roots {p : R[X]} (hsep : separable p) : p.roots.nodup :=
multiset.nodup_iff_count_le_one.mpr (count_roots_le_one hsep)

end is_domain

section field

variables {F : Type u} [field F] {K : Type v} [field K]

theorem separable_iff_derivative_ne_zero {f : F[X]} (hf : irreducible f) :
  f.separable ↔ f.derivative ≠ 0 :=
⟨λ h1 h2, hf.not_unit $ is_coprime_zero_right.1 $ h2 ▸ h1,
  λ h, euclidean_domain.is_coprime_of_dvd (mt and.right h) $ λ g hg1 hg2 ⟨p, hg3⟩ hg4,
let ⟨u, hu⟩ := (hf.is_unit_or_is_unit hg3).resolve_left hg1 in
  have f ∣ f.derivative, by { conv_lhs { rw [hg3, ← hu] }, rwa units.mul_right_dvd },
  not_lt_of_le (nat_degree_le_of_dvd this h) $
  nat_degree_derivative_lt $ mt derivative_of_nat_degree_zero h⟩

theorem separable_map (f : F →+* K) {p : F[X]} : (p.map f).separable ↔ p.separable :=
by simp_rw [separable_def, derivative_map, is_coprime_map]

lemma separable_prod_X_sub_C_iff' {ι : Sort*} {f : ι → F} {s : finset ι} :
  (∏ i in s, (X - C (f i))).separable ↔ (∀ (x ∈ s) (y ∈ s), f x = f y → x = y) :=
⟨λ hfs x hx y hy hfxy, hfs.inj_of_prod_X_sub_C hx hy hfxy,
λ H, by { rw ← prod_attach, exact separable_prod' (λ x hx y hy hxy,
    @pairwise_coprime_X_sub _ _ { x // x ∈ s } (λ x, f x)
      (λ x y hxy, subtype.eq $ H x.1 x.2 y.1 y.2 hxy) _ _ hxy)
  (λ _ _, separable_X_sub_C) }⟩

lemma separable_prod_X_sub_C_iff {ι : Sort*} [fintype ι] {f : ι → F} :
  (∏ i, (X - C (f i))).separable ↔ function.injective f :=
separable_prod_X_sub_C_iff'.trans $ by simp_rw [mem_univ, true_implies_iff, function.injective]

section char_p

variables (p : ℕ) [HF : char_p F p]
include HF

theorem separable_or {f : F[X]} (hf : irreducible f) : f.separable ∨
  ¬f.separable ∧ ∃ g : F[X], irreducible g ∧ expand F p g = f :=
if H : f.derivative = 0 then
begin
  unfreezingI { rcases p.eq_zero_or_pos with rfl | hp },
  { haveI := char_p.char_p_to_char_zero F,
    have := nat_degree_eq_zero_of_derivative_eq_zero H,
    have := (nat_degree_pos_iff_degree_pos.mpr $ degree_pos_of_irreducible hf).ne',
    contradiction },
  haveI := is_local_ring_hom_expand F hp,
  exact or.inr
        ⟨by rw [separable_iff_derivative_ne_zero hf, not_not, H],
        contract p f,
        of_irreducible_map ↑(expand F p) (by rwa ← expand_contract p H hp.ne' at hf),
        expand_contract p H hp.ne'⟩
end
else or.inl $ (separable_iff_derivative_ne_zero hf).2 H

theorem exists_separable_of_irreducible {f : F[X]} (hf : irreducible f) (hp : p ≠ 0) :
  ∃ (n : ℕ) (g : F[X]), g.separable ∧ expand F (p ^ n) g = f :=
begin
  replace hp : p.prime := (char_p.char_is_prime_or_zero F p).resolve_right hp,
  unfreezingI
  { induction hn : f.nat_degree using nat.strong_induction_on with N ih generalizing f },
  rcases separable_or p hf with h | ⟨h1, g, hg, hgf⟩,
  { refine ⟨0, f, h, _⟩, rw [pow_zero, expand_one] },
  { cases N with N,
    { rw [nat_degree_eq_zero_iff_degree_le_zero, degree_le_zero_iff] at hn,
      rw [hn, separable_C, is_unit_iff_ne_zero, not_not] at h1,
      have hf0 : f ≠ 0 := hf.ne_zero,
      rw [h1, C_0] at hn, exact absurd hn hf0 },
    have hg1 : g.nat_degree * p = N.succ,
    { rwa [← nat_degree_expand, hgf] },
    have hg2 : g.nat_degree ≠ 0,
    { intro this, rw [this, zero_mul] at hg1, cases hg1 },
    have hg3 : g.nat_degree < N.succ,
    { rw [← mul_one g.nat_degree, ← hg1],
      exact nat.mul_lt_mul_of_pos_left hp.one_lt hg2.bot_lt },
    rcases ih _ hg3 hg rfl with ⟨n, g, hg4, rfl⟩, refine ⟨n+1, g, hg4, _⟩,
    rw [← hgf, expand_expand, pow_succ] }
end

theorem is_unit_or_eq_zero_of_separable_expand {f : F[X]} (n : ℕ) (hp : 0 < p)
  (hf : (expand F (p ^ n) f).separable) : is_unit f ∨ n = 0 :=
begin
  rw or_iff_not_imp_right,
  rintro hn : n ≠ 0,
  have hf2 : (expand F (p ^ n) f).derivative = 0,
  { rw [derivative_expand, nat.cast_pow, char_p.cast_eq_zero,
      zero_pow hn.bot_lt, zero_mul, mul_zero] },
  rw [separable_def, hf2, is_coprime_zero_right, is_unit_iff] at hf,
  rcases hf with ⟨r, hr, hrf⟩,
  rw [eq_comm, expand_eq_C (pow_pos hp _)] at hrf,
  rwa [hrf, is_unit_C]
end

theorem unique_separable_of_irreducible {f : F[X]} (hf : irreducible f) (hp : 0 < p)
  (n₁ : ℕ) (g₁ : F[X]) (hg₁ : g₁.separable) (hgf₁ : expand F (p ^ n₁) g₁ = f)
  (n₂ : ℕ) (g₂ : F[X]) (hg₂ : g₂.separable) (hgf₂ : expand F (p ^ n₂) g₂ = f) :
  n₁ = n₂ ∧ g₁ = g₂ :=
begin
  revert g₁ g₂,
  wlog hn : n₁ ≤ n₂ := le_total n₁ n₂ using [n₁ n₂, n₂ n₁],
  have hf0 : f ≠ 0 := hf.ne_zero,
  unfreezingI { intros, rw le_iff_exists_add at hn, rcases hn with ⟨k, rfl⟩,
    rw [← hgf₁, pow_add, expand_mul, expand_inj (pow_pos hp n₁)] at hgf₂, subst hgf₂,
    subst hgf₁,
    rcases is_unit_or_eq_zero_of_separable_expand p k hp hg₁ with h | rfl,
    { rw is_unit_iff at h, rcases h with ⟨r, hr, rfl⟩,
      simp_rw expand_C at hf, exact absurd (is_unit_C.2 hr) hf.1 },
    { rw [add_zero, pow_zero, expand_one], split; refl } },
  obtain ⟨hn, hg⟩ := this g₂ g₁ hg₂ hgf₂ hg₁ hgf₁,
  exact ⟨hn.symm, hg.symm⟩
end

end char_p

/--If `n ≠ 0` in `F`, then ` X ^ n - a` is separable for any `a ≠ 0`. -/
lemma separable_X_pow_sub_C {n : ℕ} (a : F) (hn : (n : F) ≠ 0) (ha : a ≠ 0) :
  separable (X ^ n - C a) :=
separable_X_pow_sub_C_unit (units.mk0 a ha) (is_unit.mk0 n hn)

-- this can possibly be strengthened to making `separable_X_pow_sub_C_unit` a
-- bi-implication, but it is nontrivial!
/-- In a field `F`, `X ^ n - 1` is separable iff `↑n ≠ 0`. -/
lemma X_pow_sub_one_separable_iff {n : ℕ} :
  (X ^ n - 1 : F[X]).separable ↔ (n : F) ≠ 0 :=
begin
  refine ⟨_, λ h, separable_X_pow_sub_C_unit 1 (is_unit.mk0 ↑n h)⟩,
  rw [separable_def', derivative_sub, derivative_X_pow, derivative_one, sub_zero],
  -- Suppose `(n : F) = 0`, then the derivative is `0`, so `X ^ n - 1` is a unit, contradiction.
  rintro (h : is_coprime _ _) hn',
  rw [← C_eq_nat_cast, hn', C.map_zero, zero_mul, is_coprime_zero_right] at h,
  have := not_is_unit_X_pow_sub_one F n,
  contradiction
end

section splits

lemma card_root_set_eq_nat_degree [algebra F K] {p : F[X]} (hsep : p.separable)
  (hsplit : splits (algebra_map F K) p) : fintype.card (p.root_set K) = p.nat_degree :=
begin
  simp_rw [root_set_def, finset.coe_sort_coe, fintype.card_coe],
  rw [multiset.to_finset_card_of_nodup, ←nat_degree_eq_card_roots hsplit],
  exact nodup_roots hsep.map,
end

variable {i : F →+* K}

lemma eq_X_sub_C_of_separable_of_root_eq {x : F} {h : F[X]}
  (h_sep : h.separable) (h_root : h.eval x = 0) (h_splits : splits i h)
  (h_roots : ∀ y ∈ (h.map i).roots, y = i x) : h = (C (leading_coeff h)) * (X - C x) :=
begin
  have h_ne_zero : h ≠ 0 := by { rintro rfl, exact not_separable_zero h_sep },
  apply polynomial.eq_X_sub_C_of_splits_of_single_root i h_splits,
  apply finset.mk.inj,
  { change _ = {i x},
    rw finset.eq_singleton_iff_unique_mem,
    split,
    { apply finset.mem_mk.mpr,
      rw mem_roots (show h.map i ≠ 0, by exact map_ne_zero h_ne_zero),
      rw [is_root.def,←eval₂_eq_eval_map,eval₂_hom,h_root],
      exact ring_hom.map_zero i },
    { exact h_roots } },
  { exact nodup_roots (separable.map h_sep) },
end

lemma exists_finset_of_splits
  (i : F →+* K) {f : F[X]} (sep : separable f) (sp : splits i f) :
  ∃ (s : finset K), f.map i =
    C (i f.leading_coeff) * (s.prod (λ a : K, (X : K[X]) - C a)) :=
begin
  classical,
  obtain ⟨s, h⟩ := exists_multiset_of_splits i sp,
  use s.to_finset,
  rw [h, finset.prod_eq_multiset_prod, ←multiset.to_finset_eq],
  apply nodup_of_separable_prod,
  apply separable.of_mul_right,
  rw ←h,
  exact sep.map,
end

end splits

theorem _root_.irreducible.separable [char_zero F] {f : F[X]}
  (hf : irreducible f) : f.separable :=
begin
  rw [separable_iff_derivative_ne_zero hf, ne, ← degree_eq_bot, degree_derivative_eq],
  { rintro ⟨⟩ },
  rw [pos_iff_ne_zero, ne, nat_degree_eq_zero_iff_degree_le_zero, degree_le_zero_iff],
  refine λ hf1, hf.not_unit _,
  rw [hf1, is_unit_C, is_unit_iff_ne_zero],
  intro hf2,
  rw [hf2, C_0] at hf1,
  exact absurd hf1 hf.ne_zero
end

end field

end polynomial

open polynomial

section comm_ring

variables (F K : Type*) [comm_ring F] [ring K] [algebra F K]

-- TODO: refactor to allow transcendental extensions?
-- See: https://en.wikipedia.org/wiki/Separable_extension#Separability_of_transcendental_extensions
-- Note that right now a Galois extension (class `is_galois`) is defined to be an extension which
-- is separable and normal, so if the definition of separable changes here at some point
-- to allow non-algebraic extensions, then the definition of `is_galois` must also be changed.

/-- Typeclass for separable field extension: `K` is a separable field extension of `F` iff
the minimal polynomial of every `x : K` is separable.

We define this for general (commutative) rings and only assume `F` and `K` are fields if this
is needed for a proof.
-/
class is_separable : Prop :=
(is_integral' (x : K) : is_integral F x)
(separable' (x : K) : (minpoly F x).separable)

variables (F) {K}

theorem is_separable.is_integral [is_separable F K] :
  ∀ x : K, is_integral F x := is_separable.is_integral'

theorem is_separable.separable [is_separable F K] :
  ∀ x : K, (minpoly F x).separable := is_separable.separable'

variables {F K}

theorem is_separable_iff : is_separable F K ↔ ∀ x : K, is_integral F x ∧ (minpoly F x).separable :=
⟨λ h x, ⟨@@is_separable.is_integral F _ _ _ h x, @@is_separable.separable F _ _ _ h x⟩,
 λ h, ⟨λ x, (h x).1, λ x, (h x).2⟩⟩

end comm_ring

instance is_separable_self (F : Type*) [field F] : is_separable F F :=
⟨λ x, is_integral_algebra_map, λ x, by { rw minpoly.eq_X_sub_C', exact separable_X_sub_C }⟩

/-- A finite field extension in characteristic 0 is separable. -/
@[priority 100] -- See note [lower instance priority]
instance is_separable.of_finite (F K : Type*) [field F] [field K] [algebra F K]
  [finite_dimensional F K] [char_zero F] : is_separable F K :=
have ∀ (x : K), is_integral F x,
from λ x, algebra.is_integral_of_finite _ _ _,
⟨this, λ x, (minpoly.irreducible (this x)).separable⟩

section is_separable_tower
variables (F K E : Type*) [field F] [field K] [field E] [algebra F K] [algebra F E]
  [algebra K E] [is_scalar_tower F K E]

lemma is_separable_tower_top_of_is_separable [is_separable F E] : is_separable K E :=
⟨λ x, is_integral_of_is_scalar_tower x (is_separable.is_integral F x),
 λ x, (is_separable.separable F x).map.of_dvd (minpoly.dvd_map_of_is_scalar_tower _ _ _)⟩

lemma is_separable_tower_bot_of_is_separable [h : is_separable F E] : is_separable F K :=
is_separable_iff.2 $ λ x, begin
  refine (is_separable_iff.1 h (algebra_map K E x)).imp
    is_integral_tower_bot_of_is_integral_field (λ hs, _),
  obtain ⟨q, hq⟩ := minpoly.dvd F x
    (is_scalar_tower.aeval_eq_zero_of_aeval_algebra_map_eq_zero_field
      (minpoly.aeval F ((algebra_map K E) x))),
  rw hq at hs,
  exact hs.of_mul_left
end

variables {E}

lemma is_separable.of_alg_hom (E' : Type*) [field E'] [algebra F E']
  (f : E →ₐ[F] E') [is_separable F E'] : is_separable F E :=
begin
  letI : algebra E E' := ring_hom.to_algebra f.to_ring_hom,
  haveI : is_scalar_tower F E E' := is_scalar_tower.of_algebra_map_eq (λ x, (f.commutes x).symm),
  exact is_separable_tower_bot_of_is_separable F E E',
end

end is_separable_tower

section card_alg_hom

variables {R S T : Type*} [comm_ring S]
variables {K L F : Type*} [field K] [field L] [field F]
variables [algebra K S] [algebra K L]

lemma alg_hom.card_of_power_basis (pb : power_basis K S) (h_sep : (minpoly K pb.gen).separable)
  (h_splits : (minpoly K pb.gen).splits (algebra_map K L)) :
  @fintype.card (S →ₐ[K] L) (power_basis.alg_hom.fintype pb) = pb.dim :=
begin
  let s := ((minpoly K pb.gen).map (algebra_map K L)).roots.to_finset,
  have H := λ x, multiset.mem_to_finset,
  rw [fintype.card_congr pb.lift_equiv', fintype.card_of_subtype s H,
      ← pb.nat_degree_minpoly, nat_degree_eq_card_roots h_splits, multiset.to_finset_card_of_nodup],
  exact nodup_roots ((separable_map (algebra_map K L)).mpr h_sep)
end

end card_alg_hom


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

! This file was ported from Lean 3 source module analysis.normed.field.unit_ball
! leanprover-community/mathlib commit 3339976e2bcae9f1c81e620836d1eb736e3c4700
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Analysis.Normed.Field.Basic
import Mathlib.Analysis.Normed.Group.BallSphere

/-!
# Algebraic structures on unit balls and spheres

In this file we define algebraic structures (`Semigroup`, `CommSemigroup`, `Monoid`, `CommMonoid`,
`Group`, `CommGroup`) on `Metric.ball (0 : 𝕜) 1`, `Metric.closedBall (0 : 𝕜) 1`, and
`Metric.sphere (0 : 𝕜) 1`. In each case we use the weakest possible typeclass assumption on `𝕜`,
from `NonUnitalSeminormedRing` to `NormedField`.
-/

open Set Metric

variable {𝕜 : Type _}

/-- Unit ball in a non unital semi normed ring as a bundled `Subsemigroup`. -/
def Subsemigroup.unitBall (𝕜 : Type _) [NonUnitalSeminormedRing 𝕜] : Subsemigroup 𝕜
    where
  carrier := ball (0 : 𝕜) 1
  mul_mem' hx hy := by
    rw [mem_ball_zero_iff] at *
    exact (norm_mul_le _ _).trans_lt (mul_lt_one_of_nonneg_of_lt_one_left (norm_nonneg _) hx hy.le)
#align subsemigroup.unit_ball Subsemigroup.unitBall

instance Metric.unitBall.semigroup [NonUnitalSeminormedRing 𝕜] : Semigroup (ball (0 : 𝕜) 1) :=
  MulMemClass.toSemigroup (Subsemigroup.unitBall 𝕜)

instance Metric.unitBall.continuousMul [NonUnitalSeminormedRing 𝕜] :
    ContinuousMul (ball (0 : 𝕜) 1) :=
  (Subsemigroup.unitBall 𝕜).continuousMul

instance Metric.unitBall.commSemigroup [SeminormedCommRing 𝕜] : CommSemigroup (ball (0 : 𝕜) 1) :=
  MulMemClass.toCommSemigroup (Subsemigroup.unitBall 𝕜)

instance Metric.unitBall.hasDistribNeg [NonUnitalSeminormedRing 𝕜] :
    HasDistribNeg (ball (0 : 𝕜) 1) :=
  Subtype.coe_injective.hasDistribNeg ((↑) : ball (0 : 𝕜) 1 → 𝕜) (fun _ => rfl) fun _ _ => rfl

@[simp, norm_cast]
theorem coe_mul_unitBall [NonUnitalSeminormedRing 𝕜] (x y : ball (0 : 𝕜) 1) :
    ↑(x * y) = (x * y : 𝕜) :=
  rfl
#align coe_mul_unit_ball coe_mul_unitBall

/-- Closed unit ball in a non unital semi normed ring as a bundled `Subsemigroup`. -/
def Subsemigroup.unitClosedBall (𝕜 : Type _) [NonUnitalSeminormedRing 𝕜] : Subsemigroup 𝕜
    where
  carrier := closedBall 0 1
  mul_mem' hx hy := by
    rw [mem_closedBall_zero_iff] at *
    exact (norm_mul_le _ _).trans (mul_le_one hx (norm_nonneg _) hy)
#align subsemigroup.unit_closed_ball Subsemigroup.unitClosedBall

instance Metric.unitClosedBall.semigroup [NonUnitalSeminormedRing 𝕜] :
    Semigroup (closedBall (0 : 𝕜) 1) :=
  MulMemClass.toSemigroup (Subsemigroup.unitClosedBall 𝕜)

instance Metric.unitClosedBall.hasDistribNeg [NonUnitalSeminormedRing 𝕜] :
    HasDistribNeg (closedBall (0 : 𝕜) 1) :=
  Subtype.coe_injective.hasDistribNeg ((↑) : closedBall (0 : 𝕜) 1 → 𝕜) (fun _ => rfl) fun _ _ => rfl

instance Metric.unitClosedBall.continuousMul [NonUnitalSeminormedRing 𝕜] :
    ContinuousMul (closedBall (0 : 𝕜) 1) :=
  (Subsemigroup.unitClosedBall 𝕜).continuousMul

@[simp, norm_cast]
theorem coe_mul_unitClosedBall [NonUnitalSeminormedRing 𝕜] (x y : closedBall (0 : 𝕜) 1) :
    ↑(x * y) = (x * y : 𝕜) :=
  rfl
#align coe_mul_unit_closed_ball coe_mul_unitClosedBall

/-- Closed unit ball in a semi normed ring as a bundled `Submonoid`. -/
def Submonoid.unitClosedBall (𝕜 : Type _) [SeminormedRing 𝕜] [NormOneClass 𝕜] : Submonoid 𝕜 :=
  { Subsemigroup.unitClosedBall 𝕜 with
    carrier := closedBall 0 1
    one_mem' := mem_closedBall_zero_iff.2 norm_one.le }
#align submonoid.unit_closed_ball Submonoid.unitClosedBall

instance Metric.unitClosedBall.monoid [SeminormedRing 𝕜] [NormOneClass 𝕜] :
    Monoid (closedBall (0 : 𝕜) 1) :=
  SubmonoidClass.toMonoid (Submonoid.unitClosedBall 𝕜)

instance Metric.unitClosedBall.commMonoid [SeminormedCommRing 𝕜] [NormOneClass 𝕜] :
    CommMonoid (closedBall (0 : 𝕜) 1) :=
  SubmonoidClass.toCommMonoid (Submonoid.unitClosedBall 𝕜)

@[simp, norm_cast]
theorem coe_one_unitClosedBall [SeminormedRing 𝕜] [NormOneClass 𝕜] :
    ((1 : closedBall (0 : 𝕜) 1) : 𝕜) = 1 :=
  rfl
#align coe_one_unit_closed_ball coe_one_unitClosedBall

@[simp, norm_cast]
theorem coe_pow_unitClosedBall [SeminormedRing 𝕜] [NormOneClass 𝕜] (x : closedBall (0 : 𝕜) 1)
    (n : ℕ) : ↑(x ^ n) = (x : 𝕜) ^ n :=
  rfl
#align coe_pow_unit_closed_ball coe_pow_unitClosedBall

/-- Unit sphere in a normed division ring as a bundled `Submonoid`. -/
def Submonoid.unitSphere (𝕜 : Type _) [NormedDivisionRing 𝕜] : Submonoid 𝕜
    where
  carrier := sphere (0 : 𝕜) 1
  mul_mem' hx hy := by
    rw [mem_sphere_zero_iff_norm] at *
    simp [*]
  one_mem' := mem_sphere_zero_iff_norm.2 norm_one
#align submonoid.unit_sphere Submonoid.unitSphere

instance Metric.unitSphere.inv [NormedDivisionRing 𝕜] : Inv (sphere (0 : 𝕜) 1) :=
  ⟨fun x =>
    ⟨x⁻¹,
      mem_sphere_zero_iff_norm.2 <| by
        rw [norm_inv, mem_sphere_zero_iff_norm.1 x.coe_prop, inv_one]⟩⟩

@[simp, norm_cast]
theorem coe_inv_unitSphere [NormedDivisionRing 𝕜] (x : sphere (0 : 𝕜) 1) : ↑x⁻¹ = (x⁻¹ : 𝕜) :=
  rfl
#align coe_inv_unit_sphere coe_inv_unitSphere

instance Metric.unitSphere.div [NormedDivisionRing 𝕜] : Div (sphere (0 : 𝕜) 1) :=
  ⟨fun x y =>
    ⟨x / y,
      mem_sphere_zero_iff_norm.2 <| by
        rw [norm_div, mem_sphere_zero_iff_norm.1 x.coe_prop, mem_sphere_zero_iff_norm.1 y.coe_prop,
          div_one]⟩⟩

@[simp, norm_cast]
theorem coe_div_unitSphere [NormedDivisionRing 𝕜] (x y : sphere (0 : 𝕜) 1) :
    ↑(x / y) = (x / y : 𝕜) :=
  rfl
#align coe_div_unit_sphere coe_div_unitSphere

instance Metric.unitSphere.pow [NormedDivisionRing 𝕜] : Pow (sphere (0 : 𝕜) 1) ℤ :=
  ⟨fun x n =>
    ⟨(x : 𝕜) ^ n, by
      rw [mem_sphere_zero_iff_norm, norm_zpow, mem_sphere_zero_iff_norm.1 x.coe_prop, one_zpow]⟩⟩

@[simp, norm_cast]
theorem coe_zpow_unitSphere [NormedDivisionRing 𝕜] (x : sphere (0 : 𝕜) 1) (n : ℤ) :
    ↑(x ^ n) = (x : 𝕜) ^ n :=
  rfl
#align coe_zpow_unit_sphere coe_zpow_unitSphere

instance Metric.unitSphere.monoid [NormedDivisionRing 𝕜] : Monoid (sphere (0 : 𝕜) 1) :=
  SubmonoidClass.toMonoid (Submonoid.unitSphere 𝕜)

@[simp, norm_cast]
theorem coe_one_unitSphere [NormedDivisionRing 𝕜] : ((1 : sphere (0 : 𝕜) 1) : 𝕜) = 1 :=
  rfl
#align coe_one_unit_sphere coe_one_unitSphere

@[simp, norm_cast]
theorem coe_mul_unitSphere [NormedDivisionRing 𝕜] (x y : sphere (0 : 𝕜) 1) :
    ↑(x * y) = (x * y : 𝕜) :=
  rfl
#align coe_mul_unit_sphere coe_mul_unitSphere

@[simp, norm_cast]
theorem coe_pow_unitSphere [NormedDivisionRing 𝕜] (x : sphere (0 : 𝕜) 1) (n : ℕ) :
    ↑(x ^ n) = (x : 𝕜) ^ n :=
  rfl
#align coe_pow_unit_sphere coe_pow_unitSphere

/-- Monoid homomorphism from the unit sphere to the group of units. -/
def unitSphereToUnits (𝕜 : Type _) [NormedDivisionRing 𝕜] : sphere (0 : 𝕜) 1 →* Units 𝕜 :=
  Units.liftRight (Submonoid.unitSphere 𝕜).subtype
    (fun x => Units.mk0 x <| ne_zero_of_mem_unit_sphere _) fun _x => rfl
#align unit_sphere_to_units unitSphereToUnits

@[simp]
theorem unitSphereToUnits_apply_coe [NormedDivisionRing 𝕜] (x : sphere (0 : 𝕜) 1) :
    (unitSphereToUnits 𝕜 x : 𝕜) = x :=
  rfl
#align unit_sphere_to_units_apply_coe unitSphereToUnits_apply_coe

theorem unitSphereToUnits_injective [NormedDivisionRing 𝕜] :
    Function.Injective (unitSphereToUnits 𝕜) := fun x y h =>
  Subtype.eq <| by convert congr_arg Units.val h
#align unit_sphere_to_units_injective unitSphereToUnits_injective

instance Metric.sphere.group [NormedDivisionRing 𝕜] : Group (sphere (0 : 𝕜) 1) :=
  unitSphereToUnits_injective.group (unitSphereToUnits 𝕜) (Units.ext rfl)
    (fun _x _y => Units.ext rfl)
    (fun _x => Units.ext rfl) (fun _x _y => Units.ext <| div_eq_mul_inv _ _)
    (fun x n => Units.ext (Units.val_pow_eq_pow_val (unitSphereToUnits 𝕜 x) n).symm) fun x n =>
    Units.ext (Units.val_zpow_eq_zpow_val (unitSphereToUnits 𝕜 x) n).symm

instance Metric.sphere.hasDistribNeg [NormedDivisionRing 𝕜] : HasDistribNeg (sphere (0 : 𝕜) 1) :=
  Subtype.coe_injective.hasDistribNeg ((↑) : sphere (0 : 𝕜) 1 → 𝕜) (fun _ => rfl) fun _ _ => rfl

instance Metric.sphere.topologicalGroup [NormedDivisionRing 𝕜] : TopologicalGroup (sphere (0 : 𝕜) 1)
    where
  toContinuousMul := (Submonoid.unitSphere 𝕜).continuousMul
  continuous_inv := (continuous_subtype_val.inv₀ ne_zero_of_mem_unit_sphere).subtype_mk _

instance Metric.unitSphere.commGroup [NormedField 𝕜] : CommGroup (sphere (0 : 𝕜) 1) :=
  { Metric.sphere.group,
    Subtype.coe_injective.commMonoid (↑) rfl (fun _ _ => rfl) (fun _ _ => rfl) with }
  -- porting note: Lean couldn't see past the type synonym into the subtype.


--------------
-- Learning --

namespace dfa

  -- Defining a DFA as a tuple of its components
  structure DFA (Q) (Γ) (δ : Q → Γ → Q) (q0 : Q) (F : set Q)

  -- Defining whether a DFA accepts a string
  def arg_accept (Q)
                 (Γ)
                 (δ : Q → Γ → Q)
                 (F : set Q) : Q → list Γ → Prop
    | q list.nil := F q
    | q (list.cons γ l) := arg_accept (δ q γ) l

  def accepts {Q}
              {Γ}
              {δ : Q → Γ → Q}
              {q0 : Q}
              {F : set Q} :  DFA Q Γ δ q0 F → list Γ → Prop :=
    (λ _ l, arg_accept Q Γ δ F q0 l)

  -- A concrete example of a DFA accepting a string.
  section
    inductive Q
      | qstart : Q
      | qlose : Q

    inductive Γ
      | a : Γ
      | b : Γ

    open Q
    open Γ

    def δ : Q → Γ → Q
      | qstart a := qstart
      | qstart b := qlose
      | qlose  _ := qlose

    def q0 := qstart

    def F : set Q
      | qstart := true
      | _      := false

    variable (dfa : DFA Q Γ δ q0 F)

    #reduce accepts dfa [a, a, a]
  end
end dfa


import tactic
import data.nat.basic
import data.nat.prime

namespace lecture7

open nat

example : ∀ n, ¬ prime (2 * n * n + 11 * n + 15) :=
begin
  intro n,
  let m := (2 * n + 5) * (n + 3),
  have factored : (2 * n * n + 11 * n + 15 = m) := by linarith,
  rw factored,
  refine not_prime_mul _ _,
  linarith,
  linarith,
end

example (a b c : ℕ) : (∀ x, a ∣ (b * x + c)) -> a ∣ b + c :=
begin
  intro h,
  specialize h 1,
  rw mul_one at h,
  exact h,
end

example (x : ℤ) : (x^2 + 4 * x + 7 > 0) :=
begin
  have factored : (x^2 + 4 * x + 7 = (x + 2)^2 + 3) := by linarith,
  rw factored,
  have h : (x + 2)^2 ≥ 0 := begin
    rw pow_two,
    exact mul_self_nonneg (x + 2),
  end,
  refine lt_add_of_nonneg_of_lt h _,
  linarith,
end

end lecture7


import data.nat data.set algebra.binary
open nat set quot binary function

definition injective [reducible] {T U : Type} (f : T → U) := ∀ (x y : T), f x = f y → x = y

private definition equiv (T1 T2 : Type) := ∃ (f : T1 → T2), bijective f
local infix ~ := equiv

private definition equiv.refl (T : Type) : T ~ T := sorry
private definition equiv.symm ⦃T1 T2 : Type⦄ : T1 ~ T2 → T2 ~ T1 := sorry
private definition equiv.trans ⦃T1 T2 T3 : Type⦄ : T1 ~ T2 → T2 ~ T3 → T1 ~ T3 := sorry

definition cardinality.bij_setoid [instance] : setoid Type :=
  setoid.mk equiv (mk_equivalence equiv equiv.refl equiv.symm equiv.trans)

definition cardinality : Type := quot cardinality.bij_setoid

namespace cardinality

definition aleph_zero := ⟦ ℕ ⟧

definition le [reducible] (C1 C2 : cardinality) : Prop :=
quot.lift_on₂ C1 C2 (λ T1 T2, ∃ (f : T1 → T2), injective f) sorry

infix `≤` := le

definition lt [reducible] (C1 C2 : cardinality) : Prop := C1 ≤ C2 ∧ C1 ≠ C2
infix `<` := lt

theorem cantor (T : Type) : ⟦T⟧ < ⟦T → bool⟧ :=
  assume (C : ⟦T⟧),
  quot.rec₂
  -- proof that there is an injection from T to T → bool
  -- proof that it doesn't matter which representatives you choose (rep1 → T → (T → bool) → rep2) using the given bijections

end cardinality


import MyNat.lemma
open Lean Core

example (P Q : Prop) (p : P) (h : P → Q) : Q := by
  exact h p

lemma imp_self (P : Prop) : P → P := by
  intro p
  exact p

lemma maze1 (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U := by
  exact l (j (h p))

lemma maze2 (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U := by
  apply l
  apply j
  apply h
  exact p

example (P Q : Prop) : P → (Q → P) := by
 intro p _
 exact p

example (P Q R : Prop) : (P → (Q → R)) → ((P → Q) → (P → R)) := by
  intro a b c
  exact (a c (b c))

lemma imp_trans (P Q R : Prop) : (P → Q) → ((Q → R) → (P → R)) := by
  intro hpq hqr p
  exact hqr (hpq p)

lemma not_iff_imp_false (P : Prop) : ¬ P ↔ (P → False) := by
  rewrite [Not]
  exact Iff.rfl

lemma contrapositive (P Q : Prop) : (P → Q) → (¬ Q → ¬ P) := by
  rewrite [not_iff_imp_false, not_iff_imp_false]
  intro a b c
  apply b
  apply a
  exact c

example (A B C D E F G H I J K L : Prop)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L := by
  intro a
  exact f15 (f11 (f9 (f8 (f5 (f2 (f1 a))))))


import linear_algebra.bilinear_form
import analysis.normed_space.inner_product

noncomputable theory

open submodule bilin_form
open_locale real_inner_product_space classical

section bilin_form_eq

variables {E F : Type*} [inner_product_space ℝ E] [inner_product_space ℝ F]
  [complete_space E]

lemma bilin_form_sub_div_mul_eq_zero
  {B : bilin_form ℝ E} (hB : ∀ (u v : E), ⟪u, v⟫ = 0 → B u v = 0)
  (v w : E) : B v w - B v v / ⟪v, v⟫ * ⟪v, w⟫ = 0 :=
begin
  by_cases hv : v ≠ 0,
  { have minor₁ : ⟪v, v⟫ ≠ 0 := λ W, hv (inner_self_eq_zero.mp W),
    have minor₂ : is_complete ↑(span ℝ {v} : submodule ℝ E),
    { rw [span_singleton_eq_range, ← set.image_univ],
      exact (is_closed_map_smul_left v set.univ is_closed_univ).is_complete },
    rw ← complete_space_coe_iff_is_complete at minor₂; resetI,
    rcases exists_sum_mem_mem_orthogonal (span ℝ {v} : submodule ℝ E) w with ⟨x, hx, y, hy, hxy⟩,
    rcases mem_span_singleton.mp hx with ⟨s, hs⟩,
    simp only [hxy, ← hs, add_right, inner_add_right, real_inner_smul_right, smul_right,
               inner_right_of_mem_orthogonal (mem_span_singleton_self v) hy,
               hB v y (inner_right_of_mem_orthogonal (mem_span_singleton_self v) hy)],
    field_simp [minor₁],
    ring },
  { rw [not_not.mp hv],
    simp only [zero_left, div_zero, zero_mul, sub_zero, inner_zero_left] }
end

lemma sym_bilin_form_div_inner_self_const_aux
  {B : bilin_form ℝ E} (hB : ∀ (u v : E), ⟪u, v⟫ = 0 → B u v = 0) (hB' : sym_bilin_form.is_sym B)
  {v w : E} (hv : v ≠ 0) (hw : w ≠ 0) (hvw : ⟪v, w⟫ ≠ 0) : B v v / ⟪v, v⟫ = B w w / ⟪w, w⟫ :=
begin
  let p := bilin_form_sub_div_mul_eq_zero hB v w,
  let q := bilin_form_sub_div_mul_eq_zero hB w v,
  rw [sym_bilin_form.sym hB', ← q, sub_eq_sub_iff_sub_eq_sub, sub_self] at p,
  have p' := p.symm,
  rw [sub_eq_zero, real_inner_comm v w] at p',
  exact mul_right_cancel' hvw p'
end

/-- One has to state this with the hypotheses that `v ≠ 0` and `w ≠ 0`, because even though the
  equality holds under Lean's definition of zero division, the equality does not hold for a
  trivial versus nontrivial pair. -/
lemma sym_bilin_form_div_inner_self_const
  {B : bilin_form ℝ E} (hB : ∀ (u v : E), ⟪u, v⟫ = 0 → B u v = 0) (hB' : sym_bilin_form.is_sym B)
  {v w : E} (hv : v ≠ 0) (hw : w ≠ 0) : B v v / ⟪v, v⟫ = B w w / ⟪w, w⟫ :=
begin
  by_cases hvw : ⟪v, w⟫ ≠ 0,
  { exact sym_bilin_form_div_inner_self_const_aux hB hB' hv hw hvw },
  { rw not_not at hvw,
    let u := v + w,
    have minor₁ : u ≠ 0 :=
    λ p, begin
      have : ⟪v, w⟫ < 0 :=
      calc ⟪v, w⟫ = ⟪v + w - w, w⟫ : by rw add_sub_cancel
        ... = ⟪u - w, w⟫ : by simp only [u]
        ... = ⟪u, w⟫ - ⟪w, w⟫ : by rw inner_sub_left
        ... = 0 - ⟪w, w⟫ : by rw [p, inner_zero_left]
        ... = - (∥w∥ * ∥w∥) : by rw [zero_sub, real_inner_self_eq_norm_sq, neg_mul_eq_neg_mul]
        ... < 0 : neg_lt_zero.mpr (mul_self_pos $ ne_of_gt $ norm_pos_iff.mpr hw),
      exact (ne_of_lt this) hvw,
    end,
    have minor₂ : ⟪v, u⟫ ≠ 0,
    { simp only [u, inner_add_right, hvw, add_zero], exact λ p, hv (inner_self_eq_zero.mp p), },
    have minor₃ : ⟪w, u⟫ ≠ 0,
    { simp only [u, inner_add_right, real_inner_comm, hvw, zero_add],
      exact λ p, hw (inner_self_eq_zero.mp p), },
    let p := sym_bilin_form_div_inner_self_const_aux hB hB' hv minor₁ minor₂,
    let q := sym_bilin_form_div_inner_self_const_aux hB hB' hw minor₁ minor₃,
    rw ← q at p,
    exact p },
end

lemma sym_bilin_form_eq_const_mul_inner
  {B : bilin_form ℝ E} (hB : ∀ (u v : E), ⟪u, v⟫ = 0 → B u v = 0)
  (hB' : sym_bilin_form.is_sym B) :
  ∃ (r : ℝ), ∀ (v w : E), B v w = r * ⟪v, w⟫ :=
begin
  cases subsingleton_or_nontrivial E with h h; resetI,
  { refine ⟨0, λ v w, _⟩,
    simp only [subsingleton.elim v 0, bilin_form.zero_left, zero_mul] },
  { rcases exists_ne (0 : E) with ⟨v₀, hv₀⟩,
    refine ⟨B v₀ v₀ / ⟪v₀, v₀⟫, λ v w, _⟩,
    by_cases h' : v = 0,
    { rw [h', inner_zero_left, hB 0 w (inner_zero_left), mul_zero] },
    { rw [← sub_eq_zero],
      rw sym_bilin_form_div_inner_self_const hB hB' hv₀ h',
      exact bilin_form_sub_div_mul_eq_zero hB v w } }
end

/-- The scaling factor. This factor must be defined as an extension of a bilinear form that
  satifies some property locally because the conformality of the local inverse of a conformal map is
  local, and the corresponding bilinear form does not inherits nice properties from the former for
  inputs outside the source of the local inverse. -/
def bilin_form_factor {B : E → (bilin_form ℝ E)} {s : set E}
  (hB : ∀ x (hx : x ∈ s) u v, ⟪u, v⟫ = 0 → B x u v = 0)
  (hB' : ∀ x (hx : x ∈ s), sym_bilin_form.is_sym (B x)) (x : E) : ℝ :=
dite (x ∈ s)
(λ (hx : x ∈ s), classical.some $ sym_bilin_form_eq_const_mul_inner (hB x hx) $ hB' x hx)
(λ (hx : ¬ x ∈ s), 0)

lemma bilin_form_factor_prop {B : E → (bilin_form ℝ E)} {s : set E}
  (hB : ∀ x (hx : x ∈ s) u v, ⟪u, v⟫ = 0 → B x u v = 0)
  (hB' : ∀ x (hx : x ∈ s), sym_bilin_form.is_sym (B x)) {x : E} (hx : x ∈ s) :
  ∀ u v, B x u v = (bilin_form_factor hB hB' x) * ⟪u, v⟫ :=
begin
  simp only [bilin_form_factor, dif_pos hx],
  exact classical.some_spec (sym_bilin_form_eq_const_mul_inner (hB x hx) $ hB' x hx)
end

end bilin_form_eq


import game.basic
import list.min.basic

open list
open game

/--the value of a non-empty game consisting of loops and chains-/
def game.value : game 2 → ℤ := @game.rec_on_size2 (λ G, ℤ) (0 : ℤ) $ λ n hn G hG,
  list.min (list.bind [(0 : fin 2), (1 : fin 2)] (λ j,
  list.of_fn $ λ (i : fin (G.f j).length),
      (G.f j).nth_le i.val i.is_lt - (2 * j.val + 2) + abs (2 * j.val + 2 -
      hn (G.remove j i) (by rw [game.size2_remove, hG, nat.add_sub_cancel])) --last bracket proves size2 (remove G j i) = n
  ))
  begin
    /- we need to prove list.bind [0, 1]
      (λ (j : fin 2),
         of_fn
           (λ (i : fin (length (G.f j))),
              nth_le (G.f j) (i.val) _ - (2 * ↑(j.val) + 2) + abs (2 * ↑(j.val) + 2 - hn (remove G j i) _))) ≠
    nil
      for list.min  (as it is not defined for empty lists-/
    intro h, -- a ≠ b  is the same as (a = b) → false so h is ... = nil

    /- we simplify h to sum [length (G.f 0), length (G.f 1)] = 0-/
    rw [←list.length_eq_zero, list.length_bind] at h,
    dsimp at h,
    rw [list.length_of_fn, list.length_of_fn] at h,

    change size G = 0 at h,
    -- now this cannot be true as size G = n + 1 by one of our assumptions
    rw [size_eq_size2, hG] at h,
    revert h, exact dec_trivial,
  end

  /- Note (2 * j.val + 2) is 2 if j corresponds to chains (j.val = 0)
     and 4 if j corresponds to loops (j.val = 1)

     The value was defined recursively on the number of components using our recursor
     from game.basic-/

/--equivalence to a simpler definition given the size of the game-/
theorem game.value_def (G : game 2) (n : ℕ) (hG : G.size2 = nat.succ n):
  game.value G =
  list.min (list.bind [(0 : fin 2), (1 : fin 2)] (λ j,
  list.of_fn $ λ (i : fin (G.f j).length),
      (G.f j).nth_le i.val i.is_lt - (2 * j.val + 2) + abs (2 * j.val + 2 -
  game.value (G.remove j i))))
  begin -- for list.min. see proof above
    intro h,
    rw [←list.length_eq_zero, list.length_bind] at h,
    dsimp at h,
    rw [list.length_of_fn, list.length_of_fn] at h,
    change size G = 0 at h,
    rw [size_eq_size2, hG] at h,
    revert h, exact dec_trivial,
  end
:=
begin
  unfold game.value,
  unfold game.rec_on_size2,
  unfold game.rec_on_size2',
  simp only [hG],
  congr', --can prove the lists are the same which then implies the minimums are

  /-reduce outrageously long goal-/
  ext i n0 n1, --apply extensionality lemmas
  congr',
  ext j, --apply extensionality lemmas
  congr', /- goal is n = size2 (remove G i j), which implies the previous one
             (goal was of form g(n) = g (size2 (remove G i j)) for some function g)-/

  rw game.size2_remove, -- see game.basic
  rw hG,
  exact (nat.add_sub_cancel n 1).symm, -- as nat.succ n is defined as n + 1, +1 and -1 cancel
end


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import data.set.lattice
/-!
# Accumulate

The function `accumulate` takes a set `s` and returns `⋃ y ≤ x, s y`.
-/

variables {α β γ : Type*} {s : α → set β} {t : α → set γ}

namespace set

/-- `accumulate s` is the union of `s y` for `y ≤ x`. -/
def accumulate [has_le α] (s : α → set β) (x : α) : set β := ⋃ y ≤ x, s y

variable {s}
lemma accumulate_def [has_le α] {x : α} : accumulate s x = ⋃ y ≤ x, s y := rfl
@[simp] lemma mem_accumulate [has_le α] {x : α} {z : β} : z ∈ accumulate s x ↔ ∃ y ≤ x, z ∈ s y :=
mem_bUnion_iff

lemma subset_accumulate [preorder α] {x : α} : s x ⊆ accumulate s x :=
λ z, mem_bUnion le_rfl

lemma monotone_accumulate [preorder α] : monotone (accumulate s) :=
λ x y hxy, bUnion_subset_bUnion_left $ λ z hz, le_trans hz hxy

lemma bUnion_accumulate [preorder α] (x : α) : (⋃ y ≤ x, accumulate s y) = ⋃ y ≤ x, s y :=
begin
  apply subset.antisymm,
  { exact bUnion_subset (λ x hx, (monotone_accumulate hx : _)) },
  { exact bUnion_mono (λ x hx, subset_accumulate) }
end

lemma Union_accumulate [preorder α] : (⋃ x, accumulate s x) = ⋃ x, s x :=
begin
  apply subset.antisymm,
  { simp only [subset_def, mem_Union, exists_imp_distrib, mem_accumulate],
    intros z x x' hx'x hz, exact ⟨x', hz⟩ },
  { exact Union_subset_Union (λ i, subset_accumulate), }
end

end set


import ring_theory.polynomial.content

noncomputable theory
open_locale polynomial classical

open polynomial

variables {k: Type*} [field k]

/-- Wronskian: W(a, b) = ab' - a'b. -/
def wronskian (a b : k[X]) : k[X] :=
  a * b.derivative - a.derivative * b

@[simp]
lemma wronskian_zero_left (a : k[X]) : wronskian 0 a = 0 :=
by simp_rw wronskian; simp only [zero_mul, derivative_zero, sub_self]

@[simp]
lemma wronskian_zero_right (a : k[X]) : wronskian a 0 = 0 :=
by simp_rw wronskian; simp only [derivative_zero, mul_zero, sub_self]

lemma wronskian_neg_left (a b : k[X]) : wronskian (-a) b = - (wronskian a b) :=
by simp_rw [wronskian, derivative_neg]; ring

lemma wronskian_neg_right (a b : k[X]) : wronskian a (-b) = - wronskian a b :=
by simp_rw [wronskian, derivative_neg]; ring

lemma wronskian_add_right (a b c : k[X]) :
  wronskian a (b + c) = wronskian a b + wronskian a c :=
by simp_rw [wronskian, derivative_add]; ring

lemma wronskian_self (a : k[X]) : wronskian a a = 0 :=
by rw [wronskian, mul_comm, sub_self]

lemma wronskian_anticomm (a b : k[X]) : wronskian a b = - wronskian b a :=
by rw [wronskian, wronskian]; ring

lemma wronskian_eq_of_sum_zero {a b c : k[X]}
  (h : a + b + c = 0) : wronskian a b = wronskian b c :=
begin
  rw ← neg_eq_iff_add_eq_zero at h,
  rw ← h,
  rw wronskian_neg_right,
  rw wronskian_add_right,
  rw wronskian_self,
  rw add_zero,
  rw ← wronskian_anticomm,
end

private lemma degree_ne_bot {a : k[X]} (ha : a ≠ 0) : a.degree ≠ ⊥ :=
  by intro h; rw polynomial.degree_eq_bot at h; exact ha h

lemma wronskian.degree_lt_add {a b : k[X]} (ha : a ≠ 0) (hb : b ≠ 0) :
  (wronskian a b).degree < a.degree + b.degree :=
begin
  calc (wronskian a b).degree ≤
    max (a * b.derivative).degree (a.derivative * b).degree :
      polynomial.degree_sub_le _ _
    ... < a.degree + b.degree : _,
  rw max_lt_iff, split; rw degree_mul,
  { rw with_bot.add_lt_add_iff_left (degree_ne_bot ha),
    exact polynomial.degree_derivative_lt hb, },
  { rw with_bot.add_lt_add_iff_right (degree_ne_bot hb),
    exact polynomial.degree_derivative_lt ha, },
end

-- Note: the following is false!
-- Counterexample: b = a = 1 →
-- (wronskian a b).nat_degree = a.nat_degree = b.nat_degree = 0
/-
lemma wronskian.nat_degree_lt_add {a b : k[X]}
  (ha : a ≠ 0) (hb : b ≠ 0) :
  (wronskian a b).nat_degree < a.nat_degree + b.nat_degree := sorry
-/

lemma wronskian.nat_degree_lt_add {a b : k[X]}
  (hw : wronskian a b ≠ 0) :
  (wronskian a b).nat_degree < a.nat_degree + b.nat_degree :=
begin
  have ha : a ≠ 0 :=
    by intro h; subst h; rw wronskian_zero_left at hw; exact hw rfl,
  have hb : b ≠ 0 :=
    by intro h; subst h; rw wronskian_zero_right at hw; exact hw rfl,
  rw [←with_bot.coe_lt_coe, with_bot.coe_add],
  convert ←wronskian.degree_lt_add ha hb,
  exact polynomial.degree_eq_nat_degree hw,
  exact polynomial.degree_eq_nat_degree ha,
  exact polynomial.degree_eq_nat_degree hb,
end


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.real.basic

/-!
# IMO 2005 Q3
Let x, y and z be positive real numbers such that xyz ≥ 1. Prove that:
(x^5 - x^2)/(x^5 + y^2 + z^2) + (y^5 - y^2)/(y^5 + z^2 + x^2) + (z^5 - z^2)/(z^5 + x^2 + y^2) ≥ 0

# Solution
The solution by Iurie Boreico from Moldova is presented, which won a special prize during the exam.
The key insignt is that (x^5-x^2)/(x^5+y^2+z^2) ≥ (x^2-y*z)/(x^2+y^2+z^2), which is proven by
factoring (x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2)) into a non-negative expression
and then making use of xyz ≥ 1 to show (x^5-x^2)/(x^3*(x^2+y^2+z^2)) ≥ (x^2-y*z)/(x^2+y^2+z^2).
-/

lemma key_insight (x y z : ℝ) (hx : x > 0) (hy : y > 0) (hz : z > 0) (h : x*y*z ≥ 1) :
  (x^5-x^2)/(x^5+y^2+z^2) ≥ (x^2-y*z)/(x^2+y^2+z^2) :=
begin
  have h₁ : x^5+y^2+z^2 > 0, linarith [pow_pos hx 5, pow_pos hy 2, pow_pos hz 2],
  have h₂ : x^3 > 0, exact pow_pos hx 3,
  have h₃ : x^2+y^2+z^2 > 0, linarith [pow_pos hx 2, pow_pos hy 2, pow_pos hz 2],
  have h₄ : x^3*(x^2+y^2+z^2) > 0, exact mul_pos h₂ h₃,

  have key : (x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2))
           = ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))),
  calc  (x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2))
      = ((x^5-x^2)*(x^3*(x^2+y^2+z^2))-(x^5+y^2+z^2)*(x^5-x^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))):
        by exact div_sub_div _ _ (ne_of_gt h₁) (ne_of_gt h₄)    -- a/b - c/d = (a*d-b*c)/(b*d)
  ... = ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))) :
        by ring,

  have h₅ : ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))) ≥ 0,
  { refine div_nonneg _ _,
    refine mul_nonneg (mul_nonneg (pow_two_nonneg _) (pow_two_nonneg _)) _,
    exact add_nonneg (pow_two_nonneg _) (pow_two_nonneg _),
    exact le_of_lt (mul_pos h₁ h₄) },

  calc  (x^5-x^2)/(x^5+y^2+z^2)
      ≥ (x^5-x^2)/(x^3*(x^2+y^2+z^2)) : by linarith [key, h₅]
  ... ≥ (x^5-x^2*(x*y*z))/(x^3*(x^2+y^2+z^2)) :
        by { refine (div_le_div_right h₄).mpr _, simp,
             exact (le_mul_iff_one_le_right (pow_pos hx 2)).mpr h }
  ... = (x^2-y*z)/(x^2+y^2+z^2) :
        by { field_simp [ne_of_gt h₂, ne_of_gt h₃], ring },
end

theorem imo2005_q3 (x y z : ℝ) (hx : x > 0) (hy : y > 0) (hz : z > 0) (h : x*y*z ≥ 1) :
  (x^5-x^2)/(x^5+y^2+z^2) + (y^5-y^2)/(y^5+z^2+x^2) + (z^5-z^2)/(z^5+x^2+y^2) ≥ 0 :=
begin
  calc  (x^5-x^2)/(x^5+y^2+z^2) + (y^5-y^2)/(y^5+z^2+x^2) + (z^5-z^2)/(z^5+x^2+y^2)
      ≥ (x^2-y*z)/(x^2+y^2+z^2) + (y^2-z*x)/(y^2+z^2+x^2) + (z^2-x*y)/(z^2+x^2+y^2) :
        by { linarith [key_insight x y z hx hy hz h,
                       key_insight y z x hy hz hx (by linarith [h]),
                       key_insight z x y hz hx hy (by linarith [h])] }
  ... = (x^2 + y^2 + z^2 - y*z - z*x - x*y) / (x^2+y^2+z^2) :
        by { have h₁ : y^2+z^2+x^2 = x^2+y^2+z^2, linarith,
             have h₂ : z^2+x^2+y^2 = x^2+y^2+z^2, linarith,
             rw [h₁, h₂], ring }
  ... = 1/2*( (x-y)^2 + (y-z)^2 + (z-x)^2 ) / (x^2+y^2+z^2) : by ring
  ... ≥ 0 :
        by { exact div_nonneg
                (by linarith [pow_two_nonneg (x-y), pow_two_nonneg (y-z), pow_two_nonneg (z-x)])
                (by linarith [pow_two_nonneg x, pow_two_nonneg y, pow_two_nonneg z]) },
end


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import data.seq.seq
import algebra.field.basic
/-!
# Basic Definitions/Theorems for Continued Fractions

## Summary

We define generalised, simple, and regular continued fractions and functions to evaluate their
convergents. We follow the naming conventions from Wikipedia and [wall2018analytic], Chapter 1.

## Main definitions

1. Generalised continued fractions (gcfs)
2. Simple continued fractions (scfs)
3. (Regular) continued fractions ((r)cfs)
4. Computation of convergents using the recurrence relation in `convergents`.
5. Computation of convergents by directly evaluating the fraction described by the gcf in
`convergents'`.

## Implementation notes

1. The most commonly used kind of continued fractions in the literature are regular continued
fractions. We hence just call them `continued_fractions` in the library.
2. We use sequences from `data.seq` to encode potentially infinite sequences.

## References

- <https://en.wikipedia.org/wiki/Generalized_continued_fraction>
- [Wall, H.S., *Analytic Theory of Continued Fractions*][wall2018analytic]

## Tags

numerics, number theory, approximations, fractions
-/

-- Fix a carrier `α`.
variable (α : Type*)
/-!### Definitions-/

/-- We collect a partial numerator `aᵢ` and partial denominator `bᵢ` in a pair `⟨aᵢ,bᵢ⟩`. -/
@[derive inhabited]
protected structure generalized_continued_fraction.pair := (a : α) (b : α)

open generalized_continued_fraction

/-! Interlude: define some expected coercions and instances. -/
namespace generalized_continued_fraction.pair

variable {α}

/-- Make a `gcf.pair` printable. -/
instance [has_repr α] : has_repr (pair α) :=
⟨λ p, "(a : " ++ (repr p.a) ++ ", b : " ++ (repr p.b) ++ ")"⟩

/-- Maps a function `f` on both components of a given pair. -/
def map {β : Type*} (f : α → β) (gp : pair α) : pair β :=
⟨f gp.a, f gp.b⟩

section coe
/- Fix another type `β` which we will convert to. -/
variables {β : Type*} [has_coe α β]

/-- Coerce a pair by elementwise coercion. -/
instance has_coe_to_generalized_continued_fraction_pair : has_coe (pair α) (pair β) :=
⟨map coe⟩

@[simp, norm_cast]

end coe
end generalized_continued_fraction.pair

variable (α)

/--
A *generalised continued fraction* (gcf) is a potentially infinite expression of the form

                                a₀
                h + ---------------------------
                                  a₁
                      b₀ + --------------------
                                    a₂
                            b₁ + --------------
                                        a₃
                                  b₂ + --------
                                      b₃ + ...

where `h` is called the *head term* or *integer part*, the `aᵢ` are called the
*partial numerators* and the `bᵢ` the *partial denominators* of the gcf.
We store the sequence of partial numerators and denominators in a sequence of
generalized_continued_fraction.pairs `s`.
For convenience, one often writes `[h; (a₀, b₀), (a₁, b₁), (a₂, b₂),...]`.
-/
structure generalized_continued_fraction :=
(h : α) (s : seq $ pair α)

variable {α}

namespace generalized_continued_fraction

/-- Constructs a generalized continued fraction without fractional part. -/
def of_integer (a : α) : generalized_continued_fraction α :=
⟨a, seq.nil⟩

instance [inhabited α] : inhabited (generalized_continued_fraction α) := ⟨of_integer (default _)⟩

/-- Returns the sequence of partial numerators `aᵢ` of `g`. -/
def partial_numerators (g : generalized_continued_fraction α) : seq α :=
g.s.map pair.a
/-- Returns the sequence of partial denominators `bᵢ` of `g`. -/
def partial_denominators (g : generalized_continued_fraction α) : seq α :=
g.s.map pair.b

/-- A gcf terminated at position `n` if its sequence terminates at position `n`. -/
def terminated_at (g : generalized_continued_fraction α) (n : ℕ) : Prop := g.s.terminated_at n

/-- It is decidable whether a gcf terminated at a given position. -/
instance terminated_at_decidable (g : generalized_continued_fraction α) (n : ℕ) :
  decidable (g.terminated_at n) :=
by { unfold terminated_at, apply_instance }

/-- A gcf terminates if its sequence terminates. -/
def terminates (g : generalized_continued_fraction α) : Prop := g.s.terminates

section coe
/-! Interlude: define some expected coercions. -/
/- Fix another type `β` which we will convert to. -/
variables {β : Type*} [has_coe α β]

/-- Coerce a gcf by elementwise coercion. -/
instance has_coe_to_generalized_continued_fraction :
  has_coe (generalized_continued_fraction α) (generalized_continued_fraction β) :=
⟨λ g, ⟨(g.h : β), (g.s.map coe : seq $ pair β)⟩⟩

@[simp, norm_cast]
lemma coe_to_generalized_continued_fraction {g : generalized_continued_fraction α} :
  (↑(g : generalized_continued_fraction α) : generalized_continued_fraction β) =
    ⟨(g.h : β), (g.s.map coe : seq $ pair β)⟩ :=
rfl

end coe
end generalized_continued_fraction

/--
A generalized continued fraction is a *simple continued fraction* if all partial numerators are
equal to one.

                                1
                h + ---------------------------
                                  1
                      b₀ + --------------------
                                    1
                            b₁ + --------------
                                        1
                                  b₂ + --------
                                      b₃ + ...

-/
def generalized_continued_fraction.is_simple_continued_fraction
  (g : generalized_continued_fraction α) [has_one α] : Prop :=
∀ (n : ℕ) (aₙ : α), g.partial_numerators.nth n = some aₙ → aₙ = 1

variable (α)
/--
A *simple continued fraction* (scf) is a generalized continued fraction (gcf) whose partial
numerators are equal to one.

                                1
                h + ---------------------------
                                  1
                      b₀ + --------------------
                                    1
                            b₁ + --------------
                                        1
                                  b₂ + --------
                                      b₃ + ...

For convenience, one often writes `[h; b₀, b₁, b₂,...]`.
It is encoded as the subtype of gcfs that satisfy
`generalized_continued_fraction.is_simple_continued_fraction`.
 -/
def simple_continued_fraction [has_one α] :=
{g : generalized_continued_fraction α // g.is_simple_continued_fraction}

variable {α}
/- Interlude: define some expected coercions. -/
namespace simple_continued_fraction

variable [has_one α]

/-- Constructs a simple continued fraction without fractional part. -/
def of_integer (a : α) : simple_continued_fraction α :=
⟨generalized_continued_fraction.of_integer a, λ n aₙ h, by cases h⟩

instance : inhabited (simple_continued_fraction α) := ⟨of_integer 1⟩

/-- Lift a scf to a gcf using the inclusion map. -/
instance has_coe_to_generalized_continued_fraction :
  has_coe (simple_continued_fraction α) (generalized_continued_fraction α) :=
by {unfold simple_continued_fraction, apply_instance}

lemma coe_to_generalized_continued_fraction {s : simple_continued_fraction α} :
  (↑s : generalized_continued_fraction α) = s.val := rfl

end simple_continued_fraction

/--
A simple continued fraction is a *(regular) continued fraction* ((r)cf) if all partial denominators
`bᵢ` are positive, i.e. `0 < bᵢ`.
-/
def simple_continued_fraction.is_continued_fraction [has_one α] [has_zero α] [has_lt α]
  (s : simple_continued_fraction α) : Prop :=
∀ (n : ℕ) (bₙ : α),
  (↑s : generalized_continued_fraction α).partial_denominators.nth n = some bₙ → 0 < bₙ

variable (α)

/--
A *(regular) continued fraction* ((r)cf) is a simple continued fraction (scf) whose partial
denominators are all positive. It is the subtype of scfs that satisfy
`simple_continued_fraction.is_continued_fraction`.
 -/
def continued_fraction [has_one α] [has_zero α] [has_lt α] :=
{s : simple_continued_fraction α // s.is_continued_fraction}

variable {α}

/-! Interlude: define some expected coercions. -/
namespace continued_fraction

variables [has_one α] [has_zero α] [has_lt α]

/-- Constructs a continued fraction without fractional part. -/
def of_integer (a : α) : continued_fraction α :=
⟨simple_continued_fraction.of_integer a, λ n bₙ h, by cases h⟩

instance : inhabited (continued_fraction α) := ⟨of_integer 0⟩

/-- Lift a cf to a scf using the inclusion map. -/
instance has_coe_to_simple_continued_fraction :
  has_coe (continued_fraction α) (simple_continued_fraction α) :=
by {unfold continued_fraction, apply_instance}

lemma coe_to_simple_continued_fraction {c : continued_fraction α} :
  (↑c : simple_continued_fraction α) = c.val := rfl

/-- Lift a cf to a scf using the inclusion map. -/
instance has_coe_to_generalized_continued_fraction :
  has_coe (continued_fraction α) (generalized_continued_fraction α) :=
⟨λ c, ↑(↑c : simple_continued_fraction α)⟩

lemma coe_to_generalized_continued_fraction {c : continued_fraction α} :
  (↑c : generalized_continued_fraction α) = c.val := rfl

end continued_fraction

namespace generalized_continued_fraction
/-!
### Computation of Convergents

We now define how to compute the convergents of a gcf. There are two standard ways to do this:
directly evaluating the (infinite) fraction described by the gcf or using a recurrence relation.
For (r)cfs, these computations are equivalent as shown in
`algebra.continued_fractions.convergents_equiv`.
-/

-- Fix a division ring for the computations.
variables {K : Type*} [division_ring K]

/-!
We start with the definition of the recurrence relation. Given a gcf `g`, for all `n ≥ 1`, we define
- `A₋₁ = 1,  A₀ = h,  Aₙ = bₙ₋₁ * Aₙ₋₁ + aₙ₋₁ * Aₙ₋₂`, and
- `B₋₁ = 0,  B₀ = 1,  Bₙ = bₙ₋₁ * Bₙ₋₁ + aₙ₋₁ * Bₙ₋₂`.

`Aₙ, `Bₙ` are called the *nth continuants*, Aₙ the *nth numerator*, and `Bₙ` the
*nth denominator* of `g`. The *nth convergent* of `g` is given by `Aₙ / Bₙ`.
-/

/--
Returns the next numerator `Aₙ = bₙ₋₁ * Aₙ₋₁ + aₙ₋₁ * Aₙ₋₂`, where `predA` is `Aₙ₋₁`,
`ppredA` is `Aₙ₋₂`, `a` is `aₙ₋₁`, and `b` is `bₙ₋₁`.
-/
def next_numerator (a b ppredA predA : K) : K := b * predA + a * ppredA

/--
Returns the next denominator `Bₙ = bₙ₋₁ * Bₙ₋₁ + aₙ₋₁ * Bₙ₋₂``, where `predB` is `Bₙ₋₁` and
`ppredB` is `Bₙ₋₂`, `a` is `aₙ₋₁`, and `b` is `bₙ₋₁`.
-/
def next_denominator (aₙ bₙ ppredB predB : K) : K := bₙ * predB + aₙ * ppredB

/--
Returns the next continuants `⟨Aₙ, Bₙ⟩` using `next_numerator` and `next_denominator`, where `pred`
is `⟨Aₙ₋₁, Bₙ₋₁⟩`, `ppred` is `⟨Aₙ₋₂, Bₙ₋₂⟩`, `a` is `aₙ₋₁`, and `b` is `bₙ₋₁`.
-/
def next_continuants (a b : K) (ppred pred : pair K) : pair K :=
⟨next_numerator a b ppred.a pred.a, next_denominator a b ppred.b pred.b⟩

/-- Returns the continuants `⟨Aₙ₋₁, Bₙ₋₁⟩` of `g`. -/
def continuants_aux (g : generalized_continued_fraction K) : stream (pair K)
| 0 := ⟨1, 0⟩
| 1 := ⟨g.h, 1⟩
| (n + 2) :=
  match g.s.nth n with
  | none := continuants_aux (n + 1)
  | some gp := next_continuants gp.a gp.b (continuants_aux n) (continuants_aux $ n + 1)
  end

/-- Returns the continuants `⟨Aₙ, Bₙ⟩` of `g`. -/
def continuants (g : generalized_continued_fraction K) : stream (pair K) :=
g.continuants_aux.tail

/-- Returns the numerators `Aₙ` of `g`. -/
def numerators (g : generalized_continued_fraction K) : stream K :=
g.continuants.map pair.a

/-- Returns the denominators `Bₙ` of `g`. -/
def denominators (g : generalized_continued_fraction K) : stream K :=
g.continuants.map pair.b

/-- Returns the convergents `Aₙ / Bₙ` of `g`, where `Aₙ, Bₙ` are the nth continuants of `g`. -/
def convergents (g : generalized_continued_fraction K) : stream K :=
λ (n : ℕ), (g.numerators n) / (g.denominators n)

/--
Returns the approximation of the fraction described by the given sequence up to a given position n.
For example, `convergents'_aux [(1, 2), (3, 4), (5, 6)] 2 = 1 / (2 + 3 / 4)` and
`convergents'_aux [(1, 2), (3, 4), (5, 6)] 0 = 0`.
-/
def convergents'_aux : seq (pair K) → ℕ → K
| s 0 := 0
| s (n + 1) := match s.head with
  | none := 0
  | some gp := gp.a / (gp.b + convergents'_aux s.tail n)
  end

/--
Returns the convergents of `g` by evaluating the fraction described by `g` up to a given
position `n`. For example, `convergents' [9; (1, 2), (3, 4), (5, 6)] 2 = 9 + 1 / (2 + 3 / 4)` and
`convergents' [9; (1, 2), (3, 4), (5, 6)] 0 = 9`
-/
def convergents' (g : generalized_continued_fraction K) (n : ℕ) : K := g.h + convergents'_aux g.s n

end generalized_continued_fraction

-- Now, some basic, general theorems
namespace generalized_continued_fraction

/-- Two gcfs `g` and `g'` are equal if and only if their components are equal. -/
protected lemma ext_iff {g g' : generalized_continued_fraction α} :
  g = g' ↔ g.h = g'.h ∧ g.s = g'.s :=
by { cases g, cases g', simp }

@[ext]
protected lemma ext {g g' : generalized_continued_fraction α} (hyp : g.h = g'.h ∧ g.s = g'.s) :
  g = g' :=
generalized_continued_fraction.ext_iff.elim_right hyp

end generalized_continued_fraction


/-  Math40001 : Introduction to university mathematics.

Problem Sheet 3, October 2020.

This is a Lean file. It can be read with the Lean theorem prover.

You can work on this file online via the link at
https://github.com/ImperialCollegeLondon/M40001_lean/blob/master/README.md

or you can install Lean and its maths library following the
instructions at
https://leanprover-community.github.io/get_started.html

and then just clone the project onto your own computer
with `leanproject get ImperialCollegeLondon/M40001_lean`.

There are advantages to installing Lean on your own computer
(for example it's faster), but it's more hassle than
just using it online.

In the below, delete "sorry" and replace it with some
tactics which prove the result.

-/

import data.real.basic -- the real numbers

/- Question 1.

  Say $X$, $Y$ and $Z$ are sets, and $f:X\to Y$ and $g:Y\to Z$ are functions. In lectures we proved that if
$f$ and $g$ are injective, then $g\circ f$ is also injective, and we will prove on Monday that if $f$ and $g
$ are surjective, then $g\circ f$ is surjective. But what about the other way?
  \begin{enumerate}
  \item If $g\circ f$ is injective, then is $f$ injective? Give a proof or a counterexample.
  \item If $g\circ f$ is injective, then is $g$ injective? Give a proof or a counterexample.
  \item If $g\circ f$ is surjective, then is $f$ surjective? Give a proof or a counterexample.
  \item If $g\circ f$ is surjective, then is $g$ surjective? Give a proof or a counterexample.
  \end{enumerate}
-/

open function

-- in Q1 you would be best off defining the counterexample explicitly before you embark upon the
-- disproofs of the false statements

-- put ¬ in front of the ∀ and put everything in brackets if you want to disprove it
lemma question_one_a_true : ∀ (X Y Z : Type) (f : X → Y) (g : Y → Z), injective (g ∘ f) → injective f :=
begin
  sorry
end

-- put ¬ in front of the ∀ and put everything in brackets if you want to disprove it
lemma question_one_b_true : ∀ (X Y Z : Type) (f : X → Y) (g : Y → Z), injective (g ∘ f) → injective g :=
begin
  sorry
end

-- put ¬ in front of the ∀ and put everything in brackets if you want to disprove it
lemma question_one_c_true : ∀ (X Y Z : Type) (f : X → Y) (g : Y → Z), surjective (g ∘ f) → surjective f :=
begin
  sorry
end

-- put ¬ in front of the ∀ and put everything in brackets if you want to disprove it
lemma question_one_d_true : ∀ (X Y Z : Type) (f : X → Y) (g : Y → Z), surjective (g ∘ f) → surjective g :=
begin
  sorry
end

/-
% Q2
\item For each of the following functions, decide whether or not they are injective, surjective, bijective.
Proofs required!

  \begin{enumerate}
    \item $f:\R\to\R$, $f(x)=1/x$ if $x\not=0$ and $f(0)=0$.
\item  $f : \R\to\R$, $f(x)=2x+1$.
\item  $f:\Z\to\Z$, $f(x)=2x+1$.
\item  $f:\R\to\R$ defined by $f(x)=3-x$ if the Riemann hypothesis is true, and $f(x)=2+x$ if not. [NB the \
href{https://en.wikipedia.org/wiki/Riemann_hypothesis}{Riemann Hypothesis} is a hard unsolved problem in mat
hematics; nobody currently knows if it is true or false.]
\item $f:\Z\to\Z$, $f(n)=n^3-2n^2+2n-1$.
\end{enumerate}

-/

-- this line just says "we're mathematicians so every proposition is either true or false"
open_locale classical

-- this line says "a function might not be defined by an algorithm"
noncomputable theory

-- definition of the functions in Q2."λ x," is the way computer scientists say "x ↦"

def fa : ℝ → ℝ := λ x, 1 / x -- Lean defines 1/0 to be 0

def fb : ℝ → ℝ := λ x, 2 * x + 1

def fc : ℤ → ℤ := λ x, 2 * x + 1

constant Riemann_Hypothesis : Prop -- doesn't matter what it says

def fd : ℝ → ℝ := λ x, if Riemann_Hypothesis then 3 - x else 2 + x

def fe : ℤ → ℤ := λ n, n ^ 3 - 2 * n ^ 2 + 2 * n - 1

-- now write your own questions, below are some examples (that may or may not be possible to prove)
lemma Q2a1 : injective fa := sorry
lemma Q2a2 : ¬ (surjective fa) := sorry
lemma Q2c3 : bijective fc := sorry

/-
Question 3 is "why does this not make sense" so it can't be formalised.
-/

/-
  % Q4
\item  Prove the claim I will make in lecture on Monday, saying that if $f:X\to Y$ is a function, and $g:Y\t
o X$ is a two-sided inverse of~$f$, then~$f$ is a two-sided inverse for~$g$. Deduce that if~$X$ and~$Y$ are
sets, and there exists a bijection from~$X$ to~$Y$, then there exists a bijection from~$Y$ to~$X$.
-/

lemma Q4a (X Y : Type) (f : X → Y) (g : Y → X) (h2sided : (∀ x : X, g (f x) = x) ∧ (∀ y : Y, f (g y) = y)) :
(∀ y : Y, f (g y) = y) ∧ (∀ x : X, g (f x) = x) := sorry

-- you will need this result to do the second part. Ignore the proof, I'm using term mode just to
-- make it quicker. Note that this crazy-looking proof is an indication that there are other
-- ways of using Lean apart from tactic mode.

lemma exists_bijection_iff_has_two_sided_inverse (X Y : Type) :
(∃ f : X → Y, bijective f) ↔ (∃ (f : X → Y), ∃ (g : Y → X), (∀ x : X, g (f x) = x) ∧ (∀ y : Y, f (g y) = y)) :=
⟨λ ⟨f, hf⟩, ⟨f, bijective_iff_has_inverse.1 hf⟩,
 λ ⟨f, g, hgf, hfg⟩, ⟨f, bijective_iff_has_inverse.2 ⟨g, hgf, hfg⟩⟩⟩

lemma Q4b (X Y : Type) : (∃ f : X → Y, bijective f) ↔ (∃ g : Y → X, bijective g) := sorry

/-
  % Q5
  \item Let~$Z$ be a set. If $f:X\to Z$ and $g:Y\to Z$ are injective functions, let's say that $f$ \emph{is
friends with} $g$ if there is a bijection $h:X\to Y$ such that $f=g\circ h$. Prove that $f$ is friends with
$g$ if and only if the image of~$f$ equals the image of~$g$. NB: by the \emph{image} of $f:X\to Z$ I mean th
e subset of~$Z$ consisting of things ``hit'' by $f$, in other words the set $\{z\in Z\,:\,\exists x\in X, f(
x)=z\}$. Some people call this the ``range'' of $f$, although other people use ``range'' to mean the same th
ing as ``codomain'' :-|

-/

def friends {X Y Z : Type} (f : X → Z) (g : Y → Z) (hf : injective f) (hg : injective g) :=
  ∃ h : X → Y, bijective h ∧ f = g ∘ h

lemma Q5 (X Y Z : Type) (f : X → Z) (g : Y → Z) (hf : injective f) (hg : injective g) :
friends f g hf hg ↔ set.range f = set.range g := sorry


import GMLInit.Data.Basic
import GMLInit.Meta.Basic
import GMLInit.Meta.Relation

structure Equiv.{u,v} (α : Sort u) (β : Sort v) : Sort (max 1 (max u v)) where
  fwd : α → β
  rev : β → α
  spec {x y} : fwd x = y ↔ rev y = x

namespace Equiv
variable {α β γ δ}

@[scoped simp] lemma fwd_rev (e : Equiv α β) (x) : e.fwd (e.rev x) = x := by rw [Equiv.spec]

@[scoped simp] lemma rev_fwd (e : Equiv α β) (x) : e.rev (e.fwd x) = x := by rw [←Equiv.spec]

@[scoped simp] lemma comp_fwd_rev (e : Equiv α β) : e.fwd ∘ e.rev = id := funext e.fwd_rev

@[scoped simp] lemma comp_rev_fwd (e : Equiv α β) : e.rev ∘ e.fwd = id := funext e.rev_fwd

private theorem eq_aux : {e₁ e₂ : Equiv α β} → e₁.fwd = e₂.fwd → e₁.rev = e₂.rev → e₁ = e₂
| ⟨_,_,_⟩, ⟨_,_,_⟩, rfl, rfl => rfl

protected theorem eq {e₁ e₂ : Equiv α β} : e₁.fwd = e₂.fwd → e₁ = e₂ := by
  intro hfwd
  apply eq_aux
  exact hfwd
  funext x
  rw [← fwd_rev e₁ x, rev_fwd, hfwd, rev_fwd]

protected theorem ext {e₁ e₂ : Equiv α β} : (∀ x, e₁.fwd x = e₂.fwd x) → e₁ = e₂ := by
  intro hext
  apply Equiv.eq
  funext x
  exact hext x

protected def id : Equiv α α where
  fwd := id
  rev := id
  spec := by intros; constr <;> intro | rfl => rfl

@[scoped simp] lemma id_fwd (x : α) : Equiv.id.fwd x = x := rfl

@[scoped simp] lemma id_rev (x : α) : Equiv.id.rev x = x := rfl

protected def comp (f : Equiv β γ) (e : Equiv α β) : Equiv α γ where
  fwd := f.fwd ∘ e.fwd
  rev := e.rev ∘ f.rev
  spec := by
    intros
    clean unfold Function.comp
    constr
    · intro | rfl => rw [f.rev_fwd, e.rev_fwd]
    · intro | rfl => rw [e.fwd_rev, f.fwd_rev]

@[scoped simp] lemma comp_fwd (f : Equiv β γ) (e : Equiv α β) (x) : (Equiv.comp f e).fwd x = f.fwd (e.fwd x) := rfl

@[scoped simp] lemma comp_rev (f : Equiv β γ) (e : Equiv α β) (x) : (Equiv.comp f e).rev x = e.rev (f.rev x) := rfl

protected def inv (e : Equiv α β) : Equiv β α where
  fwd := e.rev
  rev := e.fwd
  spec := e.spec.symm

@[scoped simp] lemma inv_fwd (e : Equiv α β) (x) : (Equiv.inv e).fwd x = e.rev x := rfl

@[scoped simp] lemma inv_rev (e : Equiv α β) (x) : (Equiv.inv e).rev x = e.fwd x := rfl

protected theorem comp_assoc (g : Equiv γ δ) (f : Equiv β γ) (e : Equiv α β) :
  Equiv.comp (Equiv.comp g f) e = Equiv.comp g (Equiv.comp f e) := by
  apply Equiv.ext; intro x; rfl

@[scoped simp] protected theorem comp_id_right (e : Equiv α β) : Equiv.comp e Equiv.id = e := by
  apply Equiv.ext; intro x; rfl

@[scoped simp] protected theorem comp_id_left (e : Equiv α β) : Equiv.comp e Equiv.id = e := by
  apply Equiv.ext; intro x; rfl

@[scoped simp] protected theorem comp_inv_right (e : Equiv α β) : Equiv.comp e (Equiv.inv e) = Equiv.id := by
  apply Equiv.ext; intro x; simp

@[scoped simp] protected theorem comp_inv_left (e : Equiv α β) : Equiv.comp (Equiv.inv e) e = Equiv.id := by
  apply Equiv.ext; intro x; simp

@[scoped simp] protected theorem inv_id : Equiv.inv (Equiv.id (α:=α)) = Equiv.id := by
  apply Equiv.ext; intro x; rfl

@[scoped simp] protected theorem inv_inv (e : Equiv α β) : Equiv.inv (Equiv.inv e) = e := by
  apply Equiv.ext; intro x; rfl

protected theorem inv_comp (f : Equiv β γ) (e : Equiv α β) : Equiv.inv (Equiv.comp f e) = Equiv.comp (Equiv.inv e) (Equiv.inv f) := by
  apply Equiv.ext; intro x; rfl

end Equiv


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.set.intervals.unordered_interval
import data.set.lattice

/-!
# Order-connected sets

We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α` is a
`linear_ordered_field`, then this condition is also equivalent to `convex α s`.

In this file we prove that intersection of a family of `ord_connected` sets is `ord_connected` and
that all standard intervals are `ord_connected`.
-/

namespace set
section preorder
variables {α β : Type*} [preorder α] [preorder β] {s t : set α}

/--
We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α` is a
`linear_ordered_field`, then this condition is also equivalent to `convex α s`.
-/
class ord_connected (s : set α) : Prop :=
(out' ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) : Icc x y ⊆ s)

lemma ord_connected.out (h : ord_connected s) :
  ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), Icc x y ⊆ s := h.1

lemma ord_connected_def : ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), Icc x y ⊆ s :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

/-- It suffices to prove `[x, y] ⊆ s` for `x y ∈ s`, `x ≤ y`. -/
lemma ord_connected_iff : ord_connected s ↔ ∀ (x ∈ s) (y ∈ s), x ≤ y → Icc x y ⊆ s :=
ord_connected_def.trans
⟨λ hs x hx y hy hxy, hs hx hy, λ H x hx y hy z hz, H x hx y hy (le_trans hz.1 hz.2) hz⟩

lemma ord_connected_of_Ioo {α : Type*} [partial_order α] {s : set α}
  (hs : ∀ (x ∈ s) (y ∈ s), x < y → Ioo x y ⊆ s) :
  ord_connected s :=
begin
  rw ord_connected_iff,
  intros x hx y hy hxy,
  rcases eq_or_lt_of_le hxy with rfl|hxy', { simpa },
  rw [←Ioc_insert_left hxy, ←Ioo_insert_right hxy'],
  exact insert_subset.2 ⟨hx, insert_subset.2 ⟨hy, hs x hx y hy hxy'⟩⟩,
end

protected lemma Icc_subset (s : set α) [hs : ord_connected s] {x y} (hx : x ∈ s) (hy : y ∈ s) :
  Icc x y ⊆ s := hs.out hx hy

lemma ord_connected.inter {s t : set α} (hs : ord_connected s) (ht : ord_connected t) :
  ord_connected (s ∩ t) :=
⟨λ x hx y hy, subset_inter (hs.out hx.1 hy.1) (ht.out hx.2 hy.2)⟩

instance ord_connected.inter' {s t : set α} [ord_connected s] [ord_connected t] :
  ord_connected (s ∩ t) :=
ord_connected.inter ‹_› ‹_›

lemma ord_connected.dual {s : set α} (hs : ord_connected s) :
  ord_connected (order_dual.of_dual ⁻¹' s) :=
⟨λ x hx y hy z hz, hs.out hy hx ⟨hz.2, hz.1⟩⟩

lemma ord_connected_dual {s : set α} : ord_connected (order_dual.of_dual ⁻¹' s) ↔ ord_connected s :=
⟨λ h, by simpa only [ord_connected_def] using h.dual, λ h, h.dual⟩

lemma ord_connected_sInter {S : set (set α)} (hS : ∀ s ∈ S, ord_connected s) :
  ord_connected (⋂₀ S) :=
⟨λ x hx y hy, subset_sInter $ λ s hs, (hS s hs).out (hx s hs) (hy s hs)⟩

lemma ord_connected_Inter {ι : Sort*} {s : ι → set α} (hs : ∀ i, ord_connected (s i)) :
  ord_connected (⋂ i, s i) :=
ord_connected_sInter $ forall_range_iff.2 hs

instance ord_connected_Inter' {ι : Sort*} {s : ι → set α} [∀ i, ord_connected (s i)] :
  ord_connected (⋂ i, s i) :=
ord_connected_Inter ‹_›

lemma ord_connected_bInter {ι : Sort*} {p : ι → Prop} {s : Π (i : ι) (hi : p i), set α}
  (hs : ∀ i hi, ord_connected (s i hi)) :
  ord_connected (⋂ i hi, s i hi) :=
ord_connected_Inter $ λ i, ord_connected_Inter $ hs i

lemma ord_connected_pi {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s : set ι}
  {t : Π i, set (α i)} (h : ∀ i ∈ s, ord_connected (t i)) : ord_connected (s.pi t) :=
⟨λ x hx y hy z hz i hi, (h i hi).out (hx i hi) (hy i hi) ⟨hz.1 i, hz.2 i⟩⟩

instance ord_connected_pi' {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s : set ι}
  {t : Π i, set (α i)} [h : ∀ i, ord_connected (t i)] : ord_connected (s.pi t) :=
ord_connected_pi $ λ i hi, h i

@[instance] lemma ord_connected_Ici {a : α} : ord_connected (Ici a) :=
⟨λ x hx y hy z hz, le_trans hx hz.1⟩

@[instance] lemma ord_connected_Iic {a : α} : ord_connected (Iic a) :=
⟨λ x hx y hy z hz, le_trans hz.2 hy⟩

@[instance] lemma ord_connected_Ioi {a : α} : ord_connected (Ioi a) :=
⟨λ x hx y hy z hz, lt_of_lt_of_le hx hz.1⟩

@[instance] lemma ord_connected_Iio {a : α} : ord_connected (Iio a) :=
⟨λ x hx y hy z hz, lt_of_le_of_lt hz.2 hy⟩

@[instance] lemma ord_connected_Icc {a b : α} : ord_connected (Icc a b) :=
ord_connected_Ici.inter ord_connected_Iic

@[instance] lemma ord_connected_Ico {a b : α} : ord_connected (Ico a b) :=
ord_connected_Ici.inter ord_connected_Iio

@[instance] lemma ord_connected_Ioc {a b : α} : ord_connected (Ioc a b) :=
ord_connected_Ioi.inter ord_connected_Iic

@[instance] lemma ord_connected_Ioo {a b : α} : ord_connected (Ioo a b) :=
ord_connected_Ioi.inter ord_connected_Iio

@[instance] lemma ord_connected_singleton {α : Type*} [partial_order α] {a : α} :
  ord_connected ({a} : set α) :=
by { rw ← Icc_self, exact ord_connected_Icc }

@[instance] lemma ord_connected_empty : ord_connected (∅ : set α) := ⟨λ x, false.elim⟩

@[instance] lemma ord_connected_univ : ord_connected (univ : set α) := ⟨λ _ _ _ _, subset_univ _⟩

/-- In a dense order `α`, the subtype from an `ord_connected` set is also densely ordered. -/
instance [densely_ordered α] {s : set α} [hs : ord_connected s] :
  densely_ordered s :=
⟨λ a b (h : (a : α) < b), let ⟨x, H⟩ := exists_between h in
    ⟨⟨x, (hs.out a.2 b.2) (Ioo_subset_Icc_self H)⟩, H⟩ ⟩

@[instance] lemma ord_connected_image {E : Type*} [order_iso_class E α β] (e : E) {s : set α}
  [hs : ord_connected s] : ord_connected (e '' s) :=
begin
  constructor,
  rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ z ⟨hxz, hzy⟩,
  exact ⟨equiv_like.inv e z, hs.out hx hy ⟨(le_map_inv_iff e).mpr hxz, (map_inv_le_iff e).mpr hzy⟩,
    equiv_like.right_inv e z⟩
end

@[instance] lemma ord_connected_range {E : Type*} [order_iso_class E α β] (e : E) :
  ord_connected (range e) :=
by simp_rw [← image_univ, ord_connected_image e]

end preorder

section linear_order
variables {α : Type*} [linear_order α] {s : set α} {x : α}

@[instance] lemma ord_connected_interval {a b : α} : ord_connected (interval a b) :=
ord_connected_Icc

lemma ord_connected.interval_subset (hs : ord_connected s) ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) :
  interval x y ⊆ s :=
by cases le_total x y; simp only [interval_of_le, interval_of_ge, *]; apply hs.out; assumption

lemma ord_connected_iff_interval_subset :
  ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), interval x y ⊆ s :=
⟨λ h, h.interval_subset,
  λ h, ord_connected_iff.2 $ λ x hx y hy hxy, by simpa only [interval_of_le hxy] using h hx hy⟩

lemma ord_connected_iff_interval_subset_left (hx : x ∈ s) :
  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → interval x y ⊆ s :=
begin
  refine ⟨λ hs, hs.interval_subset hx, λ hs, ord_connected_iff_interval_subset.2 $ λ y hy z hz, _⟩,
  suffices h : interval y x ∪ interval x z ⊆ s,
  { exact interval_subset_interval_union_interval.trans h },
  rw [interval_swap, union_subset_iff],
  exact ⟨hs hy, hs hz⟩,
end

lemma ord_connected_iff_interval_subset_right (hx : x ∈ s) :
  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → interval y x ⊆ s :=
by simp_rw [ord_connected_iff_interval_subset_left hx, interval_swap]

end linear_order
end set


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä, Moritz Doll
-/
import topology.algebra.module.basic

/-!
# Weak dual topology

This file defines the weak topology given two vector spaces `E` and `F` over a commutative semiring
`𝕜` and a bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`. The weak topology on `E` is the coarest topology
such that for all `y : F` every map `λ x, B x y` is continuous.

In the case that `F = E →L[𝕜] 𝕜` and `B` being the canonical pairing, we obtain the weak-* topology,
`weak_dual 𝕜 E := (E →L[𝕜] 𝕜)`. Interchanging the arguments in the bilinear form yields the
weak topology `weak_space 𝕜 E := E`.

## Main definitions

The main definitions are the types `weak_bilin B` for the general case and the two special cases
`weak_dual 𝕜 E` and `weak_space 𝕜 E` with the respective topology instances on it.

* Given `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`, the type `weak_bilin B` is a type synonym for `E`.
* The instance `weak_bilin.topological_space` is the weak topology induced by the bilinear form `B`.
* `weak_dual 𝕜 E` is a type synonym for `dual 𝕜 E` (when the latter is defined): both are equal to
  the type `E →L[𝕜] 𝕜` of continuous linear maps from a module `E` over `𝕜` to the ring `𝕜`.
* The instance `weak_dual.topological_space` is the weak-* topology on `weak_dual 𝕜 E`, i.e., the
  coarsest topology making the evaluation maps at all `z : E` continuous.
* `weak_space 𝕜 E` is a type synonym for `E` (when the latter is defined).
* The instance `weak_dual.topological_space` is the weak topology on `E`, i.e., the
  coarsest topology such that all `v : dual 𝕜 E` remain continuous.

## Main results

We establish that `weak_bilin B` has the following structure:
* `weak_bilin.has_continuous_add`: The addition in `weak_bilin B` is continuous.
* `weak_bilin.has_continuous_smul`: The scalar multiplication in `weak_bilin B` is continuous.

We prove the following results characterizing the weak topology:
* `eval_continuous`: For any `y : F`, the evaluation mapping `λ x, B x y` is continuous.
* `continuous_of_continuous_eval`: For a mapping to `weak_bilin B` to be continuous,
  it suffices that its compositions with pairing with `B` at all points `y : F` is continuous.
* `tendsto_iff_forall_eval_tendsto`: Convergence in `weak_bilin B` can be characterized
  in terms of convergence of the evaluations at all points `y : F`.

## Notations

No new notation is introduced.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

weak-star, weak dual, duality

-/

noncomputable theory
open filter
open_locale topological_space

variables {α 𝕜 𝕝 R E F M : Type*}

section weak_topology

/-- The space `E` equipped with the weak topology induced by the bilinear form `B`. -/
@[derive [add_comm_monoid, module 𝕜],
nolint has_inhabited_instance unused_arguments]
def weak_bilin [comm_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] [add_comm_monoid F]
  [module 𝕜 F] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) := E

instance [comm_semiring 𝕜] [a : add_comm_group E] [module 𝕜 E] [add_comm_monoid F]
  [module 𝕜 F] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : add_comm_group (weak_bilin B) := a

@[priority 100]
instance module_weak_bilin [comm_semiring 𝕜] [comm_semiring 𝕝] [add_comm_group E] [module 𝕜 E]
  [add_comm_group F] [module 𝕜 F] [m : module 𝕝 E] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) :
  module 𝕝 (weak_bilin B) := m

instance scalar_tower_weak_bilin [comm_semiring 𝕜] [comm_semiring 𝕝] [add_comm_group E] [module 𝕜 E]
  [add_comm_group F] [module 𝕜 F] [has_scalar 𝕝 𝕜] [module 𝕝 E] [s : is_scalar_tower 𝕝 𝕜 E]
  (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : is_scalar_tower 𝕝 𝕜 (weak_bilin B) := s

section semiring

variables [topological_space 𝕜] [comm_semiring 𝕜]
variables [add_comm_monoid E] [module 𝕜 E]
variables [add_comm_monoid F] [module 𝕜 F]
variables (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

instance : topological_space (weak_bilin B) :=
topological_space.induced (λ x y, B x y) Pi.topological_space

lemma coe_fn_continuous : continuous (λ (x : weak_bilin B) y, B x y) :=
continuous_induced_dom

lemma eval_continuous (y : F) : continuous (λ x : weak_bilin B, B x y) :=
( continuous_pi_iff.mp (coe_fn_continuous B)) y

lemma continuous_of_continuous_eval [topological_space α] {g : α → weak_bilin B}
  (h : ∀ y, continuous (λ a, B (g a) y)) : continuous g :=
continuous_induced_rng (continuous_pi_iff.mpr h)

/-- The coercion `(λ x y, B x y) : E → (F → 𝕜)` is an embedding. -/
lemma bilin_embedding {B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜} (hB : function.injective B) :
  embedding (λ (x : weak_bilin B)  y, B x y) :=
function.injective.embedding_induced $ linear_map.coe_injective.comp hB

theorem tendsto_iff_forall_eval_tendsto {l : filter α} {f : α → (weak_bilin B)} {x : weak_bilin B}
  (hB : function.injective B) : tendsto f l (𝓝 x) ↔ ∀ y, tendsto (λ i, B (f i) y) l (𝓝 (B x y)) :=
by rw [← tendsto_pi_nhds, embedding.tendsto_nhds_iff (bilin_embedding hB)]

/-- Addition in `weak_space B` is continuous. -/
instance [has_continuous_add 𝕜] : has_continuous_add (weak_bilin B) :=
begin
  refine ⟨continuous_induced_rng _⟩,
  refine cast (congr_arg _ _) (((coe_fn_continuous B).comp continuous_fst).add
    ((coe_fn_continuous B).comp continuous_snd)),
  ext,
  simp only [function.comp_app, pi.add_apply, map_add, linear_map.add_apply],
end

/-- Scalar multiplication by `𝕜` on `weak_bilin B` is continuous. -/
instance [has_continuous_smul 𝕜 𝕜] : has_continuous_smul 𝕜 (weak_bilin B) :=
begin
  refine ⟨continuous_induced_rng _⟩,
  refine cast (congr_arg _ _) (continuous_fst.smul ((coe_fn_continuous B).comp continuous_snd)),
  ext,
  simp only [function.comp_app, pi.smul_apply, linear_map.map_smulₛₗ, ring_hom.id_apply,
    linear_map.smul_apply],
end

end semiring

section ring

variables [topological_space 𝕜] [comm_ring 𝕜]
variables [add_comm_group E] [module 𝕜 E]
variables [add_comm_group F] [module 𝕜 F]
variables (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

/-- `weak_space B` is a `topological_add_group`, meaning that addition and negation are
continuous. -/
instance [has_continuous_add 𝕜] : topological_add_group (weak_bilin B) :=
{ to_has_continuous_add := by apply_instance,
  continuous_neg := begin
    refine continuous_induced_rng (continuous_pi_iff.mpr (λ y, _)),
    refine cast (congr_arg _ _) (eval_continuous B (-y)),
    ext,
    simp only [map_neg, function.comp_app, linear_map.neg_apply],
  end }

end ring

end weak_topology

section weak_star_topology

/-- The canonical pairing of a vector space and its topological dual. -/
def top_dual_pairing (𝕜 E) [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [add_comm_monoid E] [module 𝕜 E] [topological_space E]
  [has_continuous_const_smul 𝕜 𝕜] :
  (E →L[𝕜] 𝕜) →ₗ[𝕜] E →ₗ[𝕜] 𝕜 := continuous_linear_map.coe_lm 𝕜

variables [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
variables [has_continuous_const_smul 𝕜 𝕜]
variables [add_comm_monoid E] [module 𝕜 E] [topological_space E]

lemma dual_pairing_apply (v : (E →L[𝕜] 𝕜)) (x : E) : top_dual_pairing 𝕜 E v x = v x := rfl

/-- The weak star topology is the topology coarsest topology on `E →L[𝕜] 𝕜` such that all
functionals `λ v, top_dual_pairing 𝕜 E v x` are continuous. -/
@[derive [add_comm_monoid, module 𝕜, topological_space, has_continuous_add]]
def weak_dual (𝕜 E) [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [has_continuous_const_smul 𝕜 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E] :=
weak_bilin (top_dual_pairing 𝕜 E)

instance : inhabited (weak_dual 𝕜 E) := continuous_linear_map.inhabited

instance fun_like_weak_dual : fun_like (weak_dual 𝕜 E) E (λ _, 𝕜) :=
by {dunfold weak_dual, dunfold weak_bilin, apply_instance}

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts on `weak_dual 𝕜 E`. -/
instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [has_continuous_const_smul M 𝕜] :
  mul_action M (weak_dual 𝕜 E) :=
continuous_linear_map.mul_action

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it acts distributively on `weak_dual 𝕜 E`. -/
instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [has_continuous_const_smul M 𝕜] :
  distrib_mul_action M (weak_dual 𝕜 E) :=
continuous_linear_map.distrib_mul_action

/-- If `𝕜` is a topological module over a semiring `R` and scalar multiplication commutes with the
multiplication on `𝕜`, then `weak_dual 𝕜 E` is a module over `R`. -/
instance weak_dual_module (R) [semiring R] [module R 𝕜] [smul_comm_class 𝕜 R 𝕜]
  [has_continuous_const_smul R 𝕜] :
  module R (weak_dual 𝕜 E) :=
continuous_linear_map.module

instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [has_continuous_const_smul M 𝕜] : has_continuous_const_smul M (weak_dual 𝕜 E) :=
⟨λ m, continuous_induced_rng $ (coe_fn_continuous (top_dual_pairing 𝕜 E)).const_smul m⟩

/-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
multiplication on `𝕜`, then it continuously acts on `weak_dual 𝕜 E`. -/
instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
  [topological_space M] [has_continuous_smul M 𝕜] :
  has_continuous_smul M (weak_dual 𝕜 E) :=
⟨continuous_induced_rng $ continuous_fst.smul ((coe_fn_continuous (top_dual_pairing 𝕜 E)).comp
  continuous_snd)⟩

/-- The weak topology is the topology coarsest topology on `E` such that all
functionals `λ x, top_dual_pairing 𝕜 E v x` are continuous. -/
@[derive [add_comm_monoid, module 𝕜, topological_space, has_continuous_add],
nolint has_inhabited_instance]
def weak_space (𝕜 E) [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
  [has_continuous_const_smul 𝕜 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E] :=
weak_bilin (top_dual_pairing 𝕜 E).flip

end weak_star_topology