/-
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.invertible
import ring_theory.adjoin.fg
import linear_algebra.basis
import algebra.algebra.tower
import algebra.algebra.restrict_scalars

/-!
# Towers of algebras

We set up the basic theory of algebra towers.
An algebra tower A/S/R is expressed by having instances of `algebra A S`,
`algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the
compatibility condition `(r • s) • a = r • (s • a)`.

In `field_theory/tower.lean` we use this to prove the tower law for finite extensions,
that if `R` and `S` are both fields, then `[A:R] = [A:S] [S:A]`.

In this file we prepare the main lemma:
if `{bi | i ∈ I}` is an `R`-basis of `S` and `{cj | j ∈ J}` is a `S`-basis
of `A`, then `{bi cj | i ∈ I, j ∈ J}` is an `R`-basis of `A`. This statement does not require the
base rings to be a field, so we also generalize the lemma to rings in this file.
-/

open_locale pointwise
universes u v w u₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace is_scalar_tower

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R S A B)

/-- Suppose that `R -> S -> A` is a tower of algebras.
If an element `r : R` is invertible in `S`, then it is invertible in `A`. -/
def invertible.algebra_tower (r : R) [invertible (algebra_map R S r)] :
  invertible (algebra_map R A r) :=
invertible.copy (invertible.map (algebra_map S A : S →* A) (algebra_map R S r)) (algebra_map R A r)
  (by rw [ring_hom.coe_monoid_hom, is_scalar_tower.algebra_map_apply R S A])

/-- A natural number that is invertible when coerced to `R` is also invertible
when coerced to any `R`-algebra. -/
def invertible_algebra_coe_nat (n : ℕ) [inv : invertible (n : R)] :
  invertible (n : A) :=
by { haveI : invertible (algebra_map ℕ R n) := inv, exact invertible.algebra_tower ℕ R A n }

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]

end comm_semiring

end is_scalar_tower

namespace algebra

theorem adjoin_algebra_map' {R : Type u} {S : Type v} {A : Type w}
  [comm_semiring R] [comm_semiring S] [semiring A] [algebra R S] [algebra S A] (s : set S) :
  adjoin R (algebra_map S (restrict_scalars R S A) '' s) = (adjoin R s).map
  ((algebra.of_id S (restrict_scalars R S A)).restrict_scalars R) :=
le_antisymm (adjoin_le $ set.image_subset_iff.2 $ λ y hy, ⟨y, subset_adjoin hy, rfl⟩)
  (subalgebra.map_le.2 $ adjoin_le $ λ y hy, subset_adjoin ⟨y, hy, rfl⟩)

theorem adjoin_algebra_map (R : Type u) (S : Type v) (A : Type w)
  [comm_semiring R] [comm_semiring S] [semiring A] [algebra R S] [algebra S A] [algebra R A]
  [is_scalar_tower R S A] (s : set S) :
  adjoin R (algebra_map S A '' s) =
    subalgebra.map (adjoin R s) (is_scalar_tower.to_alg_hom R S A) :=
le_antisymm (adjoin_le $ set.image_subset_iff.2 $ λ y hy, ⟨y, subset_adjoin hy, rfl⟩)
  (subalgebra.map_le.2 $ adjoin_le $ λ y hy, subset_adjoin ⟨y, hy, rfl⟩)

lemma adjoin_restrict_scalars (C D E : Type*) [comm_semiring C] [comm_semiring D] [comm_semiring E]
  [algebra C D] [algebra C E] [algebra D E] [is_scalar_tower C D E] (S : set E) :
(algebra.adjoin D S).restrict_scalars C =
  (algebra.adjoin
    ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) S).restrict_scalars C :=
begin
  suffices : set.range (algebra_map D E) =
    set.range (algebra_map ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) E),
  { ext x, change x ∈ subsemiring.closure (_ ∪ S) ↔ x ∈ subsemiring.closure (_ ∪ S), rw this },
  ext x,
  split,
  { rintros ⟨y, hy⟩,
    exact ⟨⟨algebra_map D E y, ⟨y, ⟨algebra.mem_top, rfl⟩⟩⟩, hy⟩ },
  { rintros ⟨⟨y, ⟨z, ⟨h0, h1⟩⟩⟩, h2⟩,
    exact ⟨z, eq.trans h1 h2⟩ },
end

lemma adjoin_res_eq_adjoin_res (C D E F : Type*) [comm_semiring C] [comm_semiring D]
  [comm_semiring E] [comm_semiring F] [algebra C D] [algebra C E] [algebra C F] [algebra D F]
  [algebra E F] [is_scalar_tower C D F] [is_scalar_tower C E F] {S : set D} {T : set E}
  (hS : algebra.adjoin C S = ⊤) (hT : algebra.adjoin C T = ⊤) :
(algebra.adjoin E (algebra_map D F '' S)).restrict_scalars C =
  (algebra.adjoin D (algebra_map E F '' T)).restrict_scalars C :=
by rw [adjoin_restrict_scalars C E, adjoin_restrict_scalars C D, ←hS, ←hT, ←algebra.adjoin_image,
  ←algebra.adjoin_image, ←alg_hom.coe_to_ring_hom, ←alg_hom.coe_to_ring_hom,
  is_scalar_tower.coe_to_alg_hom, is_scalar_tower.coe_to_alg_hom, ←adjoin_union_eq_adjoin_adjoin,
  ←adjoin_union_eq_adjoin_adjoin, set.union_comm]

end algebra

section
open_locale classical
lemma algebra.fg_trans' {R S A : Type*} [comm_semiring R] [comm_semiring S] [comm_semiring A]
  [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]
  (hRS : (⊤ : subalgebra R S).fg) (hSA : (⊤ : subalgebra S A).fg) :
  (⊤ : subalgebra R A).fg :=
let ⟨s, hs⟩ := hRS, ⟨t, ht⟩ := hSA in ⟨s.image (algebra_map S A) ∪ t,
by rw [finset.coe_union, finset.coe_image, algebra.adjoin_union_eq_adjoin_adjoin,
  algebra.adjoin_algebra_map, hs, algebra.map_top, is_scalar_tower.adjoin_range_to_alg_hom, ht,
  subalgebra.restrict_scalars_top]⟩
end

section algebra_map_coeffs

variables {R} (A) {ι M : Type*} [comm_semiring R] [semiring A] [add_comm_monoid M]
variables [algebra R A] [module A M] [module R M] [is_scalar_tower R A M]
variables (b : basis ι R M) (h : function.bijective (algebra_map R A))

/-- If `R` and `A` have a bijective `algebra_map R A` and act identically on `M`,
then a basis for `M` as `R`-module is also a basis for `M` as `R'`-module. -/
@[simps]
noncomputable def basis.algebra_map_coeffs : basis ι A M :=
b.map_coeffs (ring_equiv.of_bijective _ h) (λ c x, by simp)

lemma basis.algebra_map_coeffs_apply (i : ι) : b.algebra_map_coeffs A h i = b i :=
b.map_coeffs_apply _ _ _

@[simp] lemma basis.coe_algebra_map_coeffs : (b.algebra_map_coeffs A h : ι → M) = b :=
b.coe_map_coeffs _ _

end algebra_map_coeffs

section semiring

open finsupp
open_locale big_operators classical
universes v₁ w₁

variables {R S A}
variables [comm_semiring R] [semiring S] [add_comm_monoid A]
variables [algebra R S] [module S A] [module R A] [is_scalar_tower R S A]

theorem linear_independent_smul {ι : Type v₁} {b : ι → S} {ι' : Type w₁} {c : ι' → A}
  (hb : linear_independent R b) (hc : linear_independent S c) :
  linear_independent R (λ p : ι × ι', b p.1 • c p.2) :=
begin
  rw linear_independent_iff' at hb hc, rw linear_independent_iff'', rintros s g hg hsg ⟨i, k⟩,
  by_cases hik : (i, k) ∈ s,
  { have h1 : ∑ i in (s.image prod.fst).product (s.image prod.snd), g i • b i.1 • c i.2 = 0,
    { rw ← hsg, exact (finset.sum_subset finset.subset_product $ λ p _ hp,
        show g p • b p.1 • c p.2 = 0, by rw [hg p hp, zero_smul]).symm },
    rw finset.sum_product_right at h1,
    simp_rw [← smul_assoc, ← finset.sum_smul] at h1,
    exact hb _ _ (hc _ _ h1 k (finset.mem_image_of_mem _ hik)) i (finset.mem_image_of_mem _ hik) },
  exact hg _ hik
end

/-- `basis.smul (b : basis ι R S) (c : basis ι S A)` is the `R`-basis on `A`
where the `(i, j)`th basis vector is `b i • c j`. -/
noncomputable def basis.smul {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) : basis (ι × ι') R A :=
basis.of_repr ((c.repr.restrict_scalars R) ≪≫ₗ
  ((finsupp.lcongr (equiv.refl _) b.repr) ≪≫ₗ
  ((finsupp_prod_lequiv R).symm ≪≫ₗ
  ((finsupp.lcongr (equiv.prod_comm ι' ι) (linear_equiv.refl _ _))))))

@[simp] theorem basis.smul_repr {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (x ij):
  (b.smul c).repr x ij = b.repr (c.repr x ij.2) ij.1 :=
by simp [basis.smul]

theorem basis.smul_repr_mk {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (x i j):
  (b.smul c).repr x (i, j) = b.repr (c.repr x j) i :=
b.smul_repr c x (i, j)

@[simp] theorem basis.smul_apply {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (ij) :
  (b.smul c) ij = b ij.1 • c ij.2 :=
begin
  obtain ⟨i, j⟩ := ij,
  rw basis.apply_eq_iff,
  ext ⟨i', j'⟩,
  rw [basis.smul_repr, linear_equiv.map_smul, basis.repr_self, finsupp.smul_apply,
      finsupp.single_apply],
  dsimp only,
  split_ifs with hi,
  { simp [hi, finsupp.single_apply] },
  { simp [hi] },
end

end semiring

section ring

variables {R S}
variables [comm_ring R] [ring S] [algebra R S]

lemma basis.algebra_map_injective {ι : Type*} [no_zero_divisors R] [nontrivial S]
  (b : basis ι R S) :
  function.injective (algebra_map R S) :=
have no_zero_smul_divisors R S := b.no_zero_smul_divisors,
by exactI no_zero_smul_divisors.algebra_map_injective R S

end ring

section artin_tate

variables (C : Type*)

section semiring

variables [comm_semiring A] [comm_semiring B] [semiring C]
variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]

open finset submodule
open_locale classical

lemma exists_subalgebra_of_fg (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg) :
  ∃ B₀ : subalgebra A B, B₀.fg ∧ (⊤ : submodule B₀ C).fg :=
begin
  cases hAC with x hx,
  cases hBC with y hy, have := hy,
  simp_rw [eq_top_iff', mem_span_finset] at this, choose f hf,
  let s : finset B := (finset.product (x ∪ (y * y)) y).image (function.uncurry f),
  have hsx : ∀ (xi ∈ x) (yj ∈ y), f xi yj ∈ s := λ xi hxi yj hyj,
    show function.uncurry f (xi, yj) ∈ s,
    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_left _ hxi, hyj⟩,
  have hsy : ∀ (yi yj yk ∈ y), f (yi * yj) yk ∈ s := λ yi yj yk hyi hyj hyk,
    show function.uncurry f (yi * yj, yk) ∈ s,
    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_right _ $ finset.mul_mem_mul hyi hyj, hyk⟩,
  have hxy : ∀ xi ∈ x, xi ∈ span (algebra.adjoin A (↑s : set B))
               (↑(insert 1 y : finset C) : set C) :=
    λ xi hxi, hf xi ▸ sum_mem _ (λ yj hyj, smul_mem
      (span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C))
      ⟨f xi yj, algebra.subset_adjoin $ hsx xi hxi yj hyj⟩
      (subset_span $ mem_insert_of_mem hyj)),
  have hyy : span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) *
      span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) ≤
    span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C),
  { rw [span_mul_span, span_le, coe_insert], rintros _ ⟨yi, yj, rfl | hyi, rfl | hyj, rfl⟩,
    { rw mul_one, exact subset_span (set.mem_insert _ _) },
    { rw one_mul, exact subset_span (set.mem_insert_of_mem _ hyj) },
    { rw mul_one, exact subset_span (set.mem_insert_of_mem _ hyi) },
    { rw ← hf (yi * yj), exact set_like.mem_coe.2 (sum_mem _ $ λ yk hyk, smul_mem
        (span (algebra.adjoin A (↑s : set B)) (insert 1 ↑y : set C))
        ⟨f (yi * yj) yk, algebra.subset_adjoin $ hsy yi yj yk hyi hyj hyk⟩
        (subset_span $ set.mem_insert_of_mem _ hyk : yk ∈ _)) } },
  refine ⟨algebra.adjoin A (↑s : set B), subalgebra.fg_adjoin_finset _, insert 1 y, _⟩,
  refine restrict_scalars_injective A _ _ _,
  rw [restrict_scalars_top, eq_top_iff, ← algebra.top_to_submodule, ← hx,
    algebra.adjoin_eq_span, span_le],
  refine λ r hr, submonoid.closure_induction hr (λ c hc, hxy c hc)
    (subset_span $ mem_insert_self _ _) (λ p q hp hq, hyy $ submodule.mul_mem_mul hp hq)
end

end semiring

section ring

variables [comm_ring A] [comm_ring B] [comm_ring C]
variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]

/-- Artin--Tate lemma: if A ⊆ B ⊆ C is a chain of subrings of commutative rings, and
A is noetherian, and C is algebra-finite over A, and C is module-finite over B,
then B is algebra-finite over A.

References: Atiyah--Macdonald Proposition 7.8; Stacks 00IS; Altman--Kleiman 16.17. -/
theorem fg_of_fg_of_fg [is_noetherian_ring A]
  (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg)
  (hBCi : function.injective (algebra_map B C)) :
  (⊤ : subalgebra A B).fg :=
let ⟨B₀, hAB₀, hB₀C⟩ := exists_subalgebra_of_fg A B C hAC hBC in
algebra.fg_trans' (B₀.fg_top.2 hAB₀) $ subalgebra.fg_of_submodule_fg $
have is_noetherian_ring B₀, from is_noetherian_ring_of_fg hAB₀,
have is_noetherian B₀ C, by exactI is_noetherian_of_fg_of_noetherian' hB₀C,
by exactI fg_of_injective (is_scalar_tower.to_alg_hom B₀ B C).to_linear_map hBCi

end ring

end artin_tate

section alg_hom_tower

variables {A} {C D : Type*} [comm_semiring A] [comm_semiring C] [comm_semiring D]
  [algebra A C] [algebra A D]

variables (f : C →ₐ[A] D) (B) [comm_semiring B] [algebra A B] [algebra B C] [is_scalar_tower A B C]

/-- Restrict the domain of an `alg_hom`. -/
def alg_hom.restrict_domain : B →ₐ[A] D := f.comp (is_scalar_tower.to_alg_hom A B C)

/-- Extend the scalars of an `alg_hom`. -/
def alg_hom.extend_scalars : @alg_hom B C D _ _ _ _ (f.restrict_domain B).to_ring_hom.to_algebra :=
{ commutes' := λ _, rfl .. f }

variables {B}

/-- `alg_hom`s from the top of a tower are equivalent to a pair of `alg_hom`s. -/
def alg_hom_equiv_sigma :
  (C →ₐ[A] D) ≃ Σ (f : B →ₐ[A] D), @alg_hom B C D _ _ _ _ f.to_ring_hom.to_algebra :=
{ to_fun := λ f, ⟨f.restrict_domain B, f.extend_scalars B⟩,
  inv_fun := λ fg,
    let alg := fg.1.to_ring_hom.to_algebra in by exactI fg.2.restrict_scalars A,
  left_inv := λ f, by { dsimp only, ext, refl },
  right_inv :=
  begin
    rintros ⟨⟨f, _, _, _, _, _⟩, g, _, _, _, _, hg⟩,
    have : f = λ x, g (algebra_map B C x) := by { ext, exact (hg x).symm },
    subst this,
    refl,
  end }

end alg_hom_tower


import data.matrix.pequiv tactic.fin_cases
import linear_algebra.finite_dimensional

local infix ` ⬝ `:70 := matrix.mul
local postfix `ᵀ` : 1500 := matrix.transpose

universes u v w

namespace matrix

section
variables {l m n o : Type u} [fintype l] [fintype m] [fintype n] [fintype o]
variables {one : Type u} [unique one] [fintype one] [decidable_eq one] {R : Type*} --[comm_ring R]

open function pequiv

local notation `£` := default _

instance matrix.vector_space [discrete_field R] : vector_space R (matrix m n R) :=
{ ..matrix.module }

instance [discrete_field R] : finite_dimensional R (matrix m n R) :=
@is_noetherian_pi R m _ _ _ _ _ (λ _, is_noetherian_pi)

@[simp] lemma symm_single_apply {α β : Type*} [decidable_eq α] [decidable_eq β] (a : α) (b : β) :
  (single a b).symm b = some a := by dsimp; simp

lemma mul_single_ext' [semiring R] (one : Type u) [unique one] [fintype one] [decidable_eq one]
  [decidable_eq m] [decidable_eq n] {A B : matrix m n R}
  (h : ∀ j, A ⬝ (single j (default one)).to_matrix = B ⬝
    (single j (default one)).to_matrix) : A = B :=
begin
  ext i j,
  have := congr_fun (congr_fun (h j) i) (default one),
  rwa [matrix_mul_apply, matrix_mul_apply, symm_single_apply] at this
end

lemma single_mul_ext' [semiring R] (one : Type u) [unique one] [fintype one] [decidable_eq one]
  [decidable_eq m] [decidable_eq n] {A B : matrix m n R}
  (h : ∀ i, (single (default one) i).to_matrix ⬝ A =
    (single (default one) i).to_matrix ⬝ B) : A = B :=
begin
  ext i j,
  have := congr_fun (congr_fun (h i) (default one)) j,
  rwa [mul_matrix_apply, mul_matrix_apply, single_apply] at this
end

lemma matrix_eq_sum_single_mul [semiring R] [decidable_eq m] (M : matrix m n R) :
  M = finset.univ.sum (λ i : m, (single i i).to_matrix ⬝ M) :=
by letI := classical.dec_eq n; exact single_mul_ext' punit (begin
  assume i,
  simp only [matrix.mul_sum, single_mul_single],
  rw [finset.sum_eq_single i],
  { simp },
  { assume _ _ hbi,
    rw [← matrix.mul_assoc, single_mul_single_of_ne hbi.symm, matrix.zero_mul] },
  { simp }
end)

lemma matrix_eq_sum_mul_single [semiring R] [decidable_eq n] (M : matrix m n R) :
  M = finset.univ.sum (λ j : n, M ⬝ (single j j).to_matrix) :=
by letI := classical.dec_eq m; exact mul_single_ext' punit (begin
  assume j,
  simp only [matrix.sum_mul, single_mul_single],
  rw [finset.sum_eq_single j],
  { simp [matrix.mul_assoc] },
  { assume _ _ hbj,
    rw [matrix.mul_assoc, single_mul_single_of_ne hbj, matrix.mul_zero] },
  { simp }
end)

@[simp] lemma univ_unique {α : Type*} [unique α] [f : fintype α] : @finset.univ α _ = {default α} :=
by rw [subsingleton.elim f (@unique.fintype α _)]; refl

lemma mul_eq_smul [comm_semiring R] {M : matrix n one R} (a : matrix one one R) :
  M ⬝ a = a (default one) (default one) • M :=
begin
  ext i j,
  rw unique.eq_default j,
  simp [matrix.mul, mul_comm]
end

set_option class.instance_max_depth 100
def linear_equiv_linear_map (m n one : Type u) (R : Type v) [fintype m] [fintype n]
  [unique one] [fintype one] [decidable_eq one] [comm_ring R] [decidable_eq m] [decidable_eq n] :
  matrix m n R ≃ₗ[R] ((matrix n one R) →ₗ[R] (matrix m one R)) :=
{ to_fun := λ A,
  { to_fun := λ x, A ⬝ x,
    add := matrix.mul_add A,
    smul := matrix.mul_smul A },
  inv_fun := λ f, finset.univ.sum
    (λ j : n, f (single j (default one)).to_matrix ⬝
        (single (default one) j).to_matrix),
  left_inv := λ A, begin
      conv_rhs {rw [matrix_eq_sum_mul_single A]},
      dsimp, simp [matrix.mul_assoc],
    end,
  right_inv := λ f, linear_map.ext $ λ v, begin
      dsimp,
      rw [matrix.sum_mul],
      simp only [matrix.mul_assoc, mul_eq_smul, (f.map_smul _ _).symm, finset.sum_hom f],
      simp only [(mul_eq_smul _).symm],
      conv_rhs { rw [matrix_eq_sum_single_mul v] },
      simp,
    end,
  add := by simp only [matrix.add_mul]; intros; refl,
  smul := λ f g, linear_map.ext $ λ x, by dsimp; simp only [matrix.smul_mul]; refl }

lemma linear_equiv_linear_map_comp [comm_ring R] [decidable_eq m] [decidable_eq n] [decidable_eq o]
  {M : matrix m n R} {N : matrix n o R} :
  (linear_equiv_linear_map m o one R).to_equiv (M ⬝ N) =
  ((linear_equiv_linear_map m n one R).to_equiv M).comp
    ((linear_equiv_linear_map n o one R).to_equiv N) :=
linear_map.ext $ matrix.mul_assoc M N

lemma linear_equiv_linear_map_one [comm_ring R] [decidable_eq n] :
  (linear_equiv_linear_map n n one R).to_equiv (1 : matrix n n R) = linear_map.id :=
linear_map.ext matrix.one_mul

def ring_equiv_linear_map (n one : Type u) (R : Type v) [fintype n]
  [unique one] [fintype one] [decidable_eq one] [comm_ring R] [decidable_eq n] :
  matrix n n R ≃r ((matrix n one R) →ₗ[R] (matrix n one R)) :=
{ hom :=
  { map_add := (linear_equiv_linear_map n n one R).add,
    map_mul := @linear_equiv_linear_map_comp _ _ _ _ _ _ _ _ _ _ _ _ _ _ _,
    map_one := @linear_equiv_linear_map_one _ _ _ _ _ _ _ _ _ },
  ..linear_equiv_linear_map n n one R }

/-- the same as row free if `R` is a field -/
def has_right_inverse [semiring R] [decidable_eq m] (M : matrix m n R) : Prop :=
∃ N : matrix n m R, M ⬝ N = 1

/-- the same as column free if `R` is a field -/
def has_left_inverse [semiring R] [decidable_eq n] (M : matrix m n R) : Prop :=
∃ N : matrix n m R, N ⬝ M = 1

lemma has_left_inverse_one [semiring R] [decidable_eq n] : (1 : matrix n n R).has_left_inverse :=
⟨1, matrix.one_mul 1⟩

lemma has_right_inverse_one [semiring R] [decidable_eq n] : (1 : matrix n n R).has_right_inverse :=
⟨1, matrix.one_mul 1⟩

lemma has_left_inverse_mul [semiring R] [decidable_eq m] [decidable_eq n] {M : matrix l m R}
  {N : matrix m n R} (hM : M.has_left_inverse) : N.has_left_inverse ↔ (M ⬝ N).has_left_inverse :=
let ⟨Mi, hMi⟩ := hM in
⟨λ ⟨Ni, hNi⟩, ⟨Ni ⬝ Mi, by rw [matrix.mul_assoc, ← Mi.mul_assoc, hMi, matrix.one_mul, hNi]⟩,
  λ ⟨MNi, hMNi⟩, ⟨MNi ⬝ M, by rw [matrix.mul_assoc, hMNi]⟩⟩

lemma has_right_inverse_mul [semiring R] [decidable_eq l] [decidable_eq m] {M : matrix l m R}
  {N : matrix m n R} (hN : N.has_right_inverse) : M.has_right_inverse ↔ (M ⬝ N).has_right_inverse :=
let ⟨Ni, hNi⟩ := hN in
⟨λ ⟨Mi, hMi⟩, ⟨Ni ⬝ Mi, by rw [M.mul_assoc, ← N.mul_assoc, hNi, matrix.one_mul, hMi]⟩,
  λ ⟨MNi, hMNi⟩, ⟨N ⬝ MNi, by rw [← matrix.mul_assoc, hMNi]⟩⟩

lemma mul_eq_one_comm [discrete_field R] [decidable_eq n] {M N : matrix n n R} :
  M ⬝ N = 1 ↔ N ⬝ M = 1 :=
by rw [← matrix.mul_eq_mul, ← matrix.mul_eq_mul,
  ← (ring_equiv_linear_map n punit R).to_equiv.injective.eq_iff,
  ← (ring_equiv_linear_map n punit R).to_equiv.injective.eq_iff,
  is_ring_hom.map_mul (ring_equiv_linear_map n punit R).to_equiv,
  is_ring_hom.map_one (ring_equiv_linear_map n punit R).to_equiv,
  linear_map.mul_eq_one_comm,
  ← is_ring_hom.map_mul (ring_equiv_linear_map n punit R).to_equiv,
  ← is_ring_hom.map_one (ring_equiv_linear_map n punit R).to_equiv]

lemma has_right_inverse_iff_has_left_inverse [discrete_field R] [decidable_eq n]
  {M : matrix n n R} : has_right_inverse M ↔ has_left_inverse M :=
by simp [has_left_inverse, has_right_inverse, mul_eq_one_comm]

lemma mul_right_inj [semiring R] [decidable_eq m] {L M : matrix l m R} {N : matrix m n R}
  (hN : N.has_right_inverse) : L ⬝ N = M ⬝ N ↔ L = M :=
let ⟨I, hI⟩ := hN in
⟨λ h, by rw [← L.mul_one, ← hI, ← matrix.mul_assoc, h, matrix.mul_assoc, hI, matrix.mul_one],
  λ h, by rw h⟩

lemma mul_left_inj [semiring R] [decidable_eq m] {L : matrix l m R} {M N : matrix m n R}
  (hL : L.has_left_inverse) : L ⬝ M = L ⬝ N ↔ M = N :=
let ⟨I, hI⟩ := hL in
⟨λ h, by rw [← M.one_mul, ← hI, matrix.mul_assoc, h, ← matrix.mul_assoc, hI, matrix.one_mul],
  λ h, by rw h⟩

def write [decidable_eq m] [decidable_eq n] (A : matrix m n R) (i : m) (j : n) (x : R) :
  matrix m n R
| i' j' := if i' = i ∧ j' = j then x else A i' j'

@[simp] lemma write_apply [decidable_eq m] [decidable_eq n] (A : matrix m n R) (i : m) (j : n)
  (x : R) : (A.write i j x) i j = x :=
if_pos ⟨rfl, rfl⟩

lemma write_apply_of_ne [decidable_eq m] [decidable_eq n] (A : matrix m n R) {i i' : m} {j j' : n}
  (h : i' ≠ i ∨ j' ≠ j) (x : R) : (A.write i j x) i' j' = A i' j' :=
if_neg (not_and_distrib.2 h)

def write_row [decidable_eq m] (A : matrix m n R) (i : m) (x : n → R) :
  matrix m n R
| i' j := if i = i' then x j else A i' j

def write_column [decidable_eq n] (A : matrix m n R) (j : n) (x : m → R) :
  matrix m n R
| i j' := if j = j' then x i else A i j'

@[simp] lemma write_row_apply_of_eq [decidable_eq m] (A : matrix m n R) (i : m)
  (j : n) (x : n → R) : (A.write_row i x) i j = x j :=
if_pos rfl

@[simp] lemma write_column_apply_of_eq [decidable_eq n] (A : matrix m n R) (i : m)
  (j : n) (x : m → R) : (A.write_column j x) i j = x i :=
if_pos rfl

lemma write_row_apply [decidable_eq m] (A : matrix m n R) {i i' : m}
  (j : n) (x : n → R) : (A.write_row i x) i' j = ite (i = i') (x j) (A i' j) := rfl

lemma write_column_apply [decidable_eq n] (A : matrix m n R) (i : m) (j j' : n)
  (x : m → R) : (A.write_column j x) i j' = ite (j = j') (x i) (A i j') := rfl

lemma write_row_apply_of_ne [decidable_eq m] (A : matrix m n R) {i i' : m} (h : i ≠ i')
  (j : n) (x : n → R) : (A.write_row i x) i' j = A i' j := dif_neg h

lemma write_column_apply_of_ne [decidable_eq n] (A : matrix m n R) {j j' : n} (h : j ≠ j') (i : m)
  (x : m → R) : (A.write_column j x) i j' = A i j' := dif_neg h

section inverse

variables [discrete_field R]

/-- noncomputable inverse function for square matrices,
  returns `0` for noninvertible matrices -/
noncomputable def inverse (M : matrix n n R) : matrix n n R :=
by classical; exact if h : has_left_inverse M then classical.some h else 0

lemma inverse_mul [decidable_eq n] {M : matrix n n R} (h : M.has_left_inverse) : inverse M ⬝ M = 1 :=
begin
  rw [inverse, dif_pos],
  swap,
  convert h,
  convert classical.some_spec h, funext, congr
end

/-- false with current inverse definition. True when `M` is square -/
lemma mul_inverse [decidable_eq n] {M : matrix n n R} (h : M.has_right_inverse) :
  M ⬝ inverse M = 1 :=
by rw [mul_eq_one_comm, inverse_mul (has_right_inverse_iff_has_left_inverse.1 h)]

lemma mul_inverse_rev [decidable_eq n] {M : matrix n n R} {N : matrix n n R}
  (hM : M.has_left_inverse) (hN : N.has_left_inverse) :
  inverse (M ⬝ N) = inverse N ⬝ inverse M :=
by rw [← mul_left_inj hN, ← matrix.mul_assoc,
  mul_inverse (has_right_inverse_iff_has_left_inverse.2 hN), matrix.one_mul,
  ← mul_left_inj hM, mul_inverse (has_right_inverse_iff_has_left_inverse.2 hM),
  ← matrix.mul_assoc, mul_inverse
  (has_right_inverse_iff_has_left_inverse.2 ((has_left_inverse_mul hM).1 hN))]

lemma inverse_has_right_inverse [decidable_eq n] {M : matrix n n R} (h : M.has_left_inverse) :
  M.inverse.has_right_inverse :=
⟨_, inverse_mul h⟩

lemma inverse_has_left_inverse [decidable_eq n] {M : matrix n n R} (h : M.has_right_inverse) :
  M.inverse.has_left_inverse :=
⟨_, mul_inverse h⟩

lemma eq_inverse_of_mul_eq_one [decidable_eq n] {M N : matrix n n R} (h : M ⬝ N = 1) :
  M = inverse N :=
by rw [← matrix.one_mul (inverse N), ← h, matrix.mul_assoc, mul_inverse
    (has_right_inverse_iff_has_left_inverse.2 ⟨_, h⟩), matrix.mul_one]

@[simp] lemma inverse_one [decidable_eq n] : inverse (1 : matrix n n R) = 1 :=
(eq_inverse_of_mul_eq_one (matrix.one_mul 1)).symm

@[simp] lemma inverse_zero : inverse (0 : matrix n n R) = 0 :=
by letI := classical.dec_eq n; exact
if h01 : (0 : matrix n n R) = 1
then (eq_inverse_of_mul_eq_one $ by rw [h01, matrix.one_mul]).symm
else begin
  rw [inverse, dif_neg],
  rintros ⟨M, h⟩,
  rw [matrix.mul_zero] at h,
  apply h01, convert h
end

end inverse

-- lemma minor_mul [ring R] (M : matrix m n R) (N : matrix n o R) (row : l → m) :
--   minor M row id ⬝ N = minor (M ⬝ N) row id := rfl

-- lemma mul_minor [ring R] {M : matrix m n R} {N : matrix n l R} (col : o → l) :
--   M ⬝ minor N id col = minor (M ⬝ N) id col := rfl

-- lemma minor_eq_mul_minor_one [ring R] [decidable_eq m] [decidable_eq n] (M : matrix m n R)
--   (row : l → m) : minor M row id = minor 1 row id ⬝ M :=
-- by rw [minor_mul, M.one_mul]

-- lemma minor_eq_minor_one_mul [ring R] [decidable_eq m] [decidable_eq n] (M : matrix m n R)
--   (col : o → n) : minor M id col = M ⬝ minor 1 id col :=
-- by rw [mul_minor, M.mul_one]

-- lemma transpose_diagonal [has_zero R] [decidable_eq n] (d : n → R) :
--   (diagonal d)ᵀ = diagonal d :=
-- by ext; dsimp [diagonal, transpose]; split_ifs; cc

-- @[simp] lemma transpose_one [has_zero R] [has_one R] [decidable_eq n] :
--   (1 : matrix n n R)ᵀ = 1 := transpose_diagonal _

-- lemma transpose_minor [ring R] [decidable_eq m] [decidable_eq n] (M : matrix m n R)
--   (row : l → m) (col : o → n) : (minor M row col)ᵀ = minor Mᵀ col row := rfl

-- lemma minor_minor {k l m n o p : Type u} [fintype k] [fintype l] [fintype m] [fintype n]
--   [fintype o] [fintype p] (M : matrix m n R)
--   (row₁ : l → m) (row₂ : k → l) (col₁ : o → n) (col₂ : p → o) :
--   minor (minor M row₁ col₁) row₂ col₂ = minor M (row₁ ∘ row₂) (col₁ ∘ col₂) := rfl

-- lemma minor_diagonal_eq_diagonal [has_zero R] [decidable_eq m] [decidable_eq n]
--   {f : m → n} (hf : injective f) (d : n → R) : minor (diagonal d) f f = diagonal (d ∘ f) :=
-- by ext; simp [diagonal, minor, hf.eq_iff]; congr

-- lemma minor_one_eq_one [has_zero R] [has_one R] [decidable_eq m] [decidable_eq n]
--   {f : m → n} (hf : injective f) : minor (1 : matrix n n R) f f = 1 :=
-- minor_diagonal_eq_diagonal hf _

-- open finset

-- lemma minor_one_mul_transpose_eq_one [ring R] [decidable_eq n] [decidable_eq m] {f : m → n}
--   (hf : injective f) : minor (1 : matrix n n R) f id ⬝ (minor 1 f id)ᵀ = 1 :=
-- by rw [minor_mul, transpose_minor, mul_minor, transpose_one, matrix.one_mul, minor_minor];
--   exact minor_one_eq_one hf

-- lemma transpose_mul_minor_one_eq_diagonal [ring R] [decidable_eq n] [decidable_eq m] {f : m → n}
--   (hf : injective f) : (minor (1 : matrix n n R) f id)ᵀ ⬝ (minor (1 : matrix n n R) f id) =
--   diagonal (λ i, if i ∈ set.range f then 1 else 0) :=
-- begin
--   ext i j,
--   dsimp [transpose_minor, transpose_one, minor, minor, matrix.mul, diagonal, transpose, one_val],
--   by_cases hi : i ∈ set.range f,
--   { cases id hi with k hk,
--     rw [sum_eq_single k];
--     simp [hk.symm, hi, -set.mem_range, hf.eq_iff] {contextual := tt}; try {congr} },
--   { rw [sum_eq_zero, if_neg hi]; simp * at * }
-- end

-- lemma transpose_mul_minor_one_eq_diagonal [ring R] [decidable_eq n] [decidable_eq m]
--   {f : m → n} {g : l → n} (hf : injective f) (hg : injective g) :
--   (minor (1 : matrix n n R) f id) ⬝ (minor (1 : matrix n n R) g id)ᵀ =
--   diagonal (λ i, if i ∈ set.range f then 1 else 0) :=

-- lemma tranpose_mul_minor_one_add_transpose_mul_minor_one
--   [ring R] [decidable_eq l] [decidable_eq m] [decidable_eq n] {f : m → n} {g : l → n}
--   (hf : injective f) (hg : injective g) (hfg : ∀ i, i ∈ set.range f ∪ set.range g)
--   (hd : disjoint (set.range f) (set.range g)):
--   (minor (1 : matrix n n R) f id)ᵀ ⬝ (minor (1 : matrix n n R) f id) +
--   (minor (1 : matrix n n R) g id)ᵀ ⬝ (minor (1 : matrix n n R) g id) = 1 :=
-- matrix.ext $ λ i j, begin
--   have : i ∈ set.range f → i ∈ set.range g → false,
--     from λ hf hg, set.disjoint_iff.1 hd ⟨hf, hg⟩,
--   have := hfg i,
--   rw [transpose_mul_minor_one_eq_diagonal hf, transpose_mul_minor_one_eq_diagonal hg,
--     diagonal_add, diagonal],
--   dsimp only,
--   split_ifs;
--   simp * at *
-- end

-- local attribute [instance] finsupp.add_comm_group finsupp.module

-- def finsupp_equiv_cvec [ring R] [decidable_eq R] [decidable_eq m] :
--   (m →₀ R) ≃ₗ[R] matrix m one R :=
-- { to_fun := λ x i _, x i,
--   inv_fun := λ v, finsupp.equiv_fun_on_fintype.2 (λ i, v i £),
--   left_inv := λ _, finsupp.ext (λ _, rfl),
--   right_inv := λ _, cvec.ext (λ _, rfl),
--   add := λ x y, rfl,
--   smul := λ c x, rfl }

-- def to_lin' (one : Type u) [unique one] [comm_ring R] (A : matrix m n R) :
--   matrix n one R →ₗ[R] matrix m one R :=
-- { to_fun := (⬝) A,
--   add := matrix.mul_add _,
--   smul := matrix.mul_smul _, }

-- def is_invertible [comm_ring R] : Prop :=
-- bijective (A.to_lin' punit : matrix n punit R → matrix m punit R)

def one_by_one_equiv (one R : Type*) [unique one] [ring R] [decidable_eq one] :
  matrix one one R ≃ R :=
{ to_fun := λ M, M (default _) (default _),
  inv_fun := λ x _ _, x,
  left_inv := λ _, matrix.ext
    (λ i j, by rw [unique.eq_default i, unique.eq_default j]),
  right_inv := λ _, rfl }

lemma one_by_one_equiv.is_ring_hom (one R : Type*) [unique one] [decidable_eq one] [ring R] :
  is_ring_hom (one_by_one_equiv one R) :=
{ map_one := if_pos rfl,
  map_add := λ _ _, rfl,
  map_mul := λ _ _, by dsimp [one_by_one_equiv, matrix.mul]; simp }

instance [comm_ring R] : comm_ring (matrix one one R) :=
{ mul_comm := λ a b, show a ⬝ b = b ⬝ a, from
    matrix.ext $ λ i j, by rw [unique.eq_default i, unique.eq_default j];
      simp [matrix.mul]; exact mul_comm _ _,
  ..matrix.ring }

/- should be changed once there is a computable matrix inverse -/
instance [discrete_field R] : discrete_field (matrix one one R) :=
have mul_inv : ∀ (M : matrix one one R), M ≠ 0 →
    (λ i j, M i j) ⬝ (λ i j, (M i j)⁻¹) = 1,
  begin
    assume M h,
    ext i j,
    have h : M (default one) (default one) ≠ 0,
      from λ hM, h (matrix.ext $ λ i j, by convert hM),
    rw [unique.eq_default i, unique.eq_default j],
    simp [matrix.mul, mul_inv_cancel h],
  end,
{ mul := (*),
  inv := λ M i j, (M i j)⁻¹,
  zero_ne_one := mt (matrix.ext_iff).2 (λ h, absurd (h (default one) (default one)) $
    by rw [matrix.one_val, if_pos rfl]; exact zero_ne_one),
  mul_inv_cancel := mul_inv,
  inv_mul_cancel := λ M h, eq.trans (mul_comm _ _) (mul_inv M h),
  has_decidable_eq := by apply_instance,
  inv_zero := matrix.ext $ λ _ _, inv_zero,
  ..matrix.comm_ring }

section matrix_order
variables {α : Type*}

def matrix.partial_order [partial_order α] :
  partial_order (matrix m n α) := pi.partial_order

def matrix.ordered_comm_group [ordered_comm_group α] :
  ordered_comm_group (matrix m n α) :=
pi.ordered_comm_group

local attribute [instance] matrix.partial_order matrix.ordered_comm_group

lemma matrix.mul_nonneg [ordered_semiring α] {M : matrix m n α}
  {N : matrix n o α} (hM : 0 ≤ M) (hN : 0 ≤ N) : 0 ≤ M ⬝ N :=
λ i j, by classical; exact finset.sum_nonneg (λ _ _, mul_nonneg (hM _ _) (hN _ _))

lemma matrix.mul_nonpos_of_nonpos_of_nonneg [ordered_semiring α] {M : matrix m n α}
  {N : matrix n o α} (hM : M ≤ 0) (hN : 0 ≤ N) : M ⬝ N ≤ 0 :=
λ i j, by classical; exact finset.sum_nonpos
  (λ _ _, mul_nonpos_of_nonpos_of_nonneg (hM _ _) (hN _ _))

lemma pequiv_nonneg [decidable_eq m] [decidable_eq n] [linear_ordered_semiring α] (f : pequiv m n) :
  (0 : matrix _ _ α) ≤ f.to_matrix :=
λ i j, by rw [pequiv.to_matrix]; split_ifs; [exact zero_le_one, exact le_refl _]

def matrix.decidable_le [partial_order α] [decidable_rel ((≤) : α → α → Prop)] :
  decidable_rel ((≤) : Π a b : matrix m n α, Prop) :=
λ M N, show decidable (∀ i j, M i j ≤ N i j), by apply_instance

lemma le_iff_single_mul_le [decidable_eq l] [decidable_eq m] [decidable_eq n]
  [linear_ordered_semiring R] (x : l) (a b : matrix m n R) : a ≤ b ↔
  (∀ i : m, (single x i).to_matrix ⬝ a ≤ (single x i).to_matrix ⬝ b) :=
show (∀ i j, a i j ≤ b i j) ↔
  (∀ i j k, ((single x i).to_matrix ⬝ a) j k ≤ ((single x i).to_matrix ⬝ b) j k),
begin
  simp only [mul_matrix_apply],
  split,
  { intros h i j k,
    dsimp [single], split_ifs,
    { rw if_pos h_1, exact h _ _ },
    { rw if_neg h_1 } },
  { intros h i j,
    convert h i x j;
    dsimp [single]; rw [if_pos rfl] }
end

lemma le_iff_mul_single_le [decidable_eq l] [decidable_eq m] [decidable_eq n]
  [linear_ordered_semiring R] (x : l) (a b : matrix m n R) : a ≤ b ↔
  (∀ j : n, a ⬝ (single j x).to_matrix ≤ b ⬝ (single j x).to_matrix) :=
show (∀ i j, a i j ≤ b i j) ↔
  (∀ (j : n) (i k), (a ⬝ (single j x).to_matrix) i k ≤ (b ⬝ (single j x).to_matrix) i k),
begin
  simp only [matrix_mul_apply],
  split,
  { intros h i j k,
    dsimp [single, pequiv.symm], split_ifs,
    { rw if_pos h_1, exact h _ _ },
    { rw if_neg h_1 } },
  { intros h i j,
    convert h j i x;
    dsimp [single, pequiv.symm]; rw [if_pos rfl] }
end

lemma one_by_one_lt_iff [partial_order α] {a b : matrix one one α} : a < b ↔
  a (default one) (default one) < b (default one) (default one) :=
begin
  simp only [lt_iff_le_not_le],
  show (∀ i j, a i j ≤ b i j) ∧ (¬ ∀ i j, b i j ≤ a i j) ↔ _,
  simp [unique.forall_iff],
end

instance [decidable_linear_order α] : decidable_linear_order (matrix one one α) :=
{ le_total := λ a b, (le_total (a (default one) (default one)) (b (default one) (default one))).elim
    (λ hab, or.inl $ λ i j, by rw [unique.eq_default i, unique.eq_default j]; exact hab)
    (λ hba, or.inr $ λ i j, by rw [unique.eq_default i, unique.eq_default j]; exact hba),
  decidable_le := matrix.decidable_le,
  ..matrix.partial_order }

instance [discrete_linear_ordered_field R] : discrete_linear_ordered_field
  (matrix one one R) :=
{ mul_nonneg := λ a b ha0 hb0 i j, by simp [matrix.mul];
    exact mul_nonneg (ha0 _ _) (hb0 _ _),
  mul_pos := λ a b ha0 hb0,
    begin
      rw [one_by_one_lt_iff] at *,
      simp [matrix.mul],
      exact mul_pos ha0 hb0
    end,
  one := 1,
  zero_lt_one := one_by_one_lt_iff.2 $ by rw [one_val, if_pos rfl]; exact zero_lt_one,
  ..matrix.discrete_field,
  ..matrix.ordered_comm_group,
  ..matrix.decidable_linear_order }

lemma inv_def [discrete_field R] (a : matrix one one R) :
  a⁻¹ = (λ _ _, (a (default one) (default one))⁻¹) :=
by ext i j; rw [unique.eq_default i, unique.eq_default j]; refl

end matrix_order

lemma mul_right_eq_of_mul_eq [semiring R] {M : matrix l m R} {N : matrix m n R} {O : matrix l n R}
  {P : matrix n o R} (h : M ⬝ N = O) : M ⬝ (N ⬝ P) = O ⬝ P :=
by classical; rw [← matrix.mul_assoc, h]

lemma inv_eq_inverse [discrete_field R] (a : matrix one one R) : a⁻¹ = inverse a :=
if ha : a = 0 then by simp [ha]
else eq_inverse_of_mul_eq_one (by rw [← matrix.mul_eq_mul, inv_mul_cancel ha]; congr)

lemma one_by_one_mul_inv_cancel {M : matrix one one ℚ} (hM : M ≠ 0) :
  M ⬝ inverse M = 1 :=
by rw [← matrix.mul_eq_mul, ← inv_eq_inverse, mul_inv_cancel hM]

lemma one_by_one_inv_mul_cancel {M : matrix (fin 1) (fin 1) ℚ} (hM : M ≠ 0) :
  inverse M ⬝ M = 1 :=
by rw [← matrix.mul_eq_mul, ← inv_eq_inverse, inv_mul_cancel hM]

end
end matrix
open pequiv

lemma mul_single_ext {R : Type*} {m n : ℕ} [semiring R]
  {A B : matrix (fin m) (fin n) R} (h : ∀ j : fin n, A ⬝ (single j (0 : fin 1)).to_matrix = B ⬝
    (single j (0 : fin 1)).to_matrix) : A = B :=
by ext i j; simpa [matrix_mul_apply] using congr_fun (congr_fun (h j) i) 0

lemma single_mul_ext {R : Type*} {m n : ℕ} [semiring R]
  {A B : matrix (fin m) (fin n) R} (h : ∀ i, (single (0 : fin 1) i).to_matrix ⬝ A =
    (single (0 : fin 1) i).to_matrix ⬝ B) : A = B :=
by ext i j; simpa [mul_matrix_apply] using congr_fun (congr_fun (h i) 0) j


/-
Copyright (c) 2019 Chris Hughes All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import analysis.special_functions.pow
import field_theory.algebraic_closure
import topology.algebra.polynomial

/-!
# The fundamental theorem of algebra

This file proves that every nonconstant complex polynomial has a root.

As a consequence, the complex numbers are algebraically closed.
-/

open complex polynomial metric filter is_absolute_value set
open_locale classical

namespace complex

/- The following proof uses the method given at
<https://ncatlab.org/nlab/show/fundamental+theorem+of+algebra#classical_fta_via_advanced_calculus>
-/
/-- The fundamental theorem of algebra. Every non constant complex polynomial
  has a root. -/
lemma exists_root {f : polynomial ℂ} (hf : 0 < degree f) : ∃ z : ℂ, is_root f z :=
let ⟨z₀, hz₀⟩ := f.exists_forall_norm_le in
exists.intro z₀ $ classical.by_contradiction $ λ hf0,
have hfX : f - C (f.eval z₀) ≠ 0,
  from mt sub_eq_zero.1 (λ h, not_le_of_gt hf (h.symm ▸ degree_C_le)),
let n := root_multiplicity z₀ (f - C (f.eval z₀)) in
let g := (f - C (f.eval z₀)) /ₘ ((X - C z₀) ^ n) in
have hg0 : g.eval z₀ ≠ 0, from eval_div_by_monic_pow_root_multiplicity_ne_zero _ hfX,
have hg : g * (X - C z₀) ^ n = f - C (f.eval z₀),
  from div_by_monic_mul_pow_root_multiplicity_eq _ _,
have hn0 : 0 < n, from nat.pos_of_ne_zero $ λ hn0, by simpa [g, hn0] using hg0,
let ⟨δ', hδ'₁, hδ'₂⟩ := continuous_iff.1 (polynomial.continuous g) z₀
  ((g.eval z₀).abs) (complex.abs_pos.2 hg0) in
let δ := min (min (δ' / 2) 1) (((f.eval z₀).abs / (g.eval z₀).abs) / 2) in
have hf0' : 0 < (f.eval z₀).abs, from complex.abs_pos.2 hf0,
have hg0' : 0 < abs (eval z₀ g), from complex.abs_pos.2 hg0,
have hfg0 : 0 < (f.eval z₀).abs / abs (eval z₀ g), from div_pos hf0' hg0',
have hδ0 : 0 < δ, from lt_min (lt_min (half_pos hδ'₁) (by norm_num)) (half_pos hfg0),
have hδ : ∀ z : ℂ, abs (z - z₀) = δ → abs (g.eval z - g.eval z₀) < (g.eval z₀).abs,
  from λ z hz, hδ'₂ z (by rw [complex.dist_eq, hz];
    exact ((min_le_left _ _).trans (min_le_left _ _)).trans_lt (half_lt_self hδ'₁)),
have hδ1 : δ ≤ 1, from le_trans (min_le_left _ _) (min_le_right _ _),
let F : polynomial ℂ := C (f.eval z₀) + C (g.eval z₀) * (X - C z₀) ^ n in
let z' := (-f.eval z₀ * (g.eval z₀).abs * δ ^ n /
  ((f.eval z₀).abs * g.eval z₀)) ^ (n⁻¹ : ℂ) + z₀ in
have hF₁ : F.eval z' = f.eval z₀ - f.eval z₀ * (g.eval z₀).abs * δ ^ n / (f.eval z₀).abs,
  by simp only [F, cpow_nat_inv_pow _ hn0, div_eq_mul_inv, eval_pow, mul_assoc,
      mul_comm (g.eval z₀), mul_left_comm (g.eval z₀), mul_left_comm (g.eval z₀)⁻¹, mul_inv',
      inv_mul_cancel hg0, eval_C, eval_add, eval_neg, sub_eq_add_neg, eval_mul, eval_X,
      add_neg_cancel_right, neg_mul_eq_neg_mul_symm, mul_one, div_eq_mul_inv];
    simp only [mul_comm, mul_left_comm, mul_assoc],
have hδs : (g.eval z₀).abs * δ ^ n / (f.eval z₀).abs < 1,
  from (div_lt_one hf0').2 $ (lt_div_iff' hg0').1 $
  calc δ ^ n ≤ δ ^ 1 : pow_le_pow_of_le_one (le_of_lt hδ0) hδ1 hn0
         ... = δ : pow_one _
         ... ≤ ((f.eval z₀).abs / (g.eval z₀).abs) / 2 : min_le_right _ _
         ... < _ : half_lt_self (div_pos hf0' hg0'),
have hF₂ : (F.eval z').abs = (f.eval z₀).abs - (g.eval z₀).abs * δ ^ n,
  from calc (F.eval z').abs = (f.eval z₀ - f.eval z₀ * (g.eval z₀).abs
    * δ ^ n / (f.eval z₀).abs).abs : congr_arg abs hF₁
  ... = abs (f.eval z₀) * complex.abs (1 - (g.eval z₀).abs * δ ^ n /
      (f.eval z₀).abs : ℝ) : by rw [← complex.abs_mul];
        exact congr_arg complex.abs
          (by simp [mul_add, add_mul, mul_assoc, div_eq_mul_inv, sub_eq_add_neg])
  ... = _ : by rw [complex.abs_of_nonneg (sub_nonneg.2 (le_of_lt hδs)),
      mul_sub, mul_div_cancel' _ (ne.symm (ne_of_lt hf0')), mul_one],
have hef0 : abs (eval z₀ g) * (eval z₀ f).abs ≠ 0,
  from mul_ne_zero (mt complex.abs_eq_zero.1 hg0) (mt complex.abs_eq_zero.1 hf0),
have hz'z₀ : abs (z' - z₀) = δ,
  by simp [z', mul_assoc, mul_left_comm _ (_ ^ n), mul_comm _ (_ ^ n),
    mul_comm (eval z₀ f).abs, _root_.mul_div_cancel _ hef0, of_real_mul,
    neg_mul_eq_neg_mul_symm, neg_div, is_absolute_value.abv_pow complex.abs,
    complex.abs_of_nonneg (le_of_lt hδ0), real.pow_nat_rpow_nat_inv (le_of_lt hδ0) hn0],
have hF₃ : (f.eval z' - F.eval z').abs < (g.eval z₀).abs * δ ^ n,
  from calc (f.eval z' - F.eval z').abs
      = (g.eval z' - g.eval z₀).abs * (z' - z₀).abs ^ n :
        by rw [← eq_sub_iff_add_eq.1 hg, ← is_absolute_value.abv_pow complex.abs,
            ← complex.abs_mul, sub_mul];
          simp [F, eval_pow, eval_add, eval_mul, eval_sub, eval_C, eval_X, eval_neg, add_sub_cancel,
                sub_eq_add_neg, add_assoc]
  ... = (g.eval z' - g.eval z₀).abs * δ ^ n : by rw hz'z₀
  ... < _ : (mul_lt_mul_right (pow_pos hδ0 _)).2 (hδ _ hz'z₀),
lt_irrefl (f.eval z₀).abs $
  calc (f.eval z₀).abs ≤ (f.eval z').abs : hz₀ _
    ... = (F.eval z' + (f.eval z' - F.eval z')).abs : by simp
    ... ≤ (F.eval z').abs + (f.eval z' - F.eval z').abs : complex.abs_add _ _
    ... < (f.eval z₀).abs - (g.eval z₀).abs * δ ^ n + (g.eval z₀).abs * δ ^ n :
      add_lt_add_of_le_of_lt (by rw hF₂) hF₃
    ... = (f.eval z₀).abs : sub_add_cancel _ _

instance is_alg_closed : is_alg_closed ℂ :=
is_alg_closed.of_exists_root _ $ λ p _ hp, complex.exists_root $ degree_pos_of_irreducible hp

end complex


lemma mul_pow (a b n : mynat) : (a * b) ^ n = a ^ n * b ^ n :=
begin
induction n with m hm,
repeat {rw pow_zero},
simp,
repeat {rw pow_succ},
rw hm,
simp,
end


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

! This file was ported from Lean 3 source module algebra.field.opposite
! leanprover-community/mathlib commit 76de8ae01554c3b37d66544866659ff174e66e1f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Field.Defs
import Mathlib.Algebra.Ring.Opposite
import Mathlib.Data.Int.Cast.Lemmas

/-!
# Field structure on the multiplicative/additive opposite
-/

namespace MulOpposite

variable (α : Type _)

@[to_additive]
instance ratCast [RatCast α] : RatCast αᵐᵒᵖ :=
  ⟨fun n => op n⟩

variable {α}

@[to_additive (attr := simp, norm_cast)]
theorem op_ratCast [RatCast α] (q : ℚ) : op (q : α) = q :=
  rfl
#align mul_opposite.op_rat_cast MulOpposite.op_ratCast
#align add_opposite.op_rat_cast AddOpposite.op_ratCast

@[to_additive (attr := simp, norm_cast)]
theorem unop_ratCast [RatCast α] (q : ℚ) : unop (q : αᵐᵒᵖ) = q :=
  rfl
#align mul_opposite.unop_rat_cast MulOpposite.unop_ratCast
#align add_opposite.unop_rat_cast AddOpposite.unop_ratCast

variable (α)

instance divisionSemiring [DivisionSemiring α] : DivisionSemiring αᵐᵒᵖ :=
  { MulOpposite.groupWithZero α, MulOpposite.semiring α with }

instance divisionRing [DivisionRing α] : DivisionRing αᵐᵒᵖ :=
  { MulOpposite.divisionSemiring α, MulOpposite.ring α, MulOpposite.ratCast α with
    ratCast_mk := fun a b hb h => unop_injective $ by
      rw [unop_ratCast, Rat.cast_def, unop_mul, unop_inv, unop_natCast, unop_intCast,
        Int.commute_cast, div_eq_mul_inv] }

instance semifield [Semifield α] : Semifield αᵐᵒᵖ :=
  { MulOpposite.divisionSemiring α, MulOpposite.commSemiring α with }

instance field [Field α] : Field αᵐᵒᵖ :=
  { MulOpposite.divisionRing α, MulOpposite.commRing α with }

end MulOpposite

namespace AddOpposite

instance divisionSemiring [DivisionSemiring α] : DivisionSemiring αᵃᵒᵖ :=
  { AddOpposite.groupWithZero α, AddOpposite.semiring α with }

instance divisionRing [DivisionRing α] : DivisionRing αᵃᵒᵖ :=
  { AddOpposite.ring α, AddOpposite.groupWithZero α, AddOpposite.ratCast α with
    ratCast_mk := fun a b hb h => unop_injective $ by
      rw [unop_ratCast, Rat.cast_def, unop_mul, unop_inv, unop_natCast, unop_intCast,
        div_eq_mul_inv] }

instance semifield [Semifield α] : Semifield αᵃᵒᵖ :=
  { AddOpposite.divisionSemiring, AddOpposite.commSemiring α with }

instance field [Field α] : Field αᵃᵒᵖ :=
  { AddOpposite.divisionRing, AddOpposite.commRing α with }

end AddOpposite


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

! This file was ported from Lean 3 source module topology.extend_from
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Separation

/-!
# Extending a function from a subset

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

The main definition of this file is `extend_from A f` where `f : X → Y`
and `A : set X`. This defines a new function `g : X → Y` which maps any
`x₀ : X` to the limit of `f` as `x` tends to `x₀`, if such a limit exists.

This is analoguous to the way `dense_inducing.extend` "extends" a function
`f : X → Z` to a function `g : Y → Z` along a dense inducing `i : X → Y`.

The main theorem we prove about this definition is `continuous_on_extend_from`
which states that, for `extend_from A f` to be continuous on a set `B ⊆ closure A`,
it suffices that `f` converges within `A` at any point of `B`, provided that
`f` is a function to a T₃ space.

-/

noncomputable section

open Topology

open Filter Set

variable {X Y : Type _} [TopologicalSpace X] [TopologicalSpace Y]

#print extendFrom /-
/-- Extend a function from a set `A`. The resulting function `g` is such that
at any `x₀`, if `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `g x₀` is defined to be one of these `y`. Else, `g x₀` could be anything. -/
def extendFrom (A : Set X) (f : X → Y) : X → Y := fun x => @limUnder _ ⟨f x⟩ (𝓝[A] x) f
#align extend_from extendFrom
-/

/- warning: tendsto_extend_from -> tendsto_extendFrom is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {A : Set.{u1} X} {f : X -> Y} {x : X}, (Exists.{succ u2} Y (fun (y : Y) => Filter.Tendsto.{u1, u2} X Y f (nhdsWithin.{u1} X _inst_1 x A) (nhds.{u2} Y _inst_2 y))) -> (Filter.Tendsto.{u1, u2} X Y f (nhdsWithin.{u1} X _inst_1 x A) (nhds.{u2} Y _inst_2 (extendFrom.{u1, u2} X Y _inst_1 _inst_2 A f x)))
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {A : Set.{u2} X} {f : X -> Y} {x : X}, (Exists.{succ u1} Y (fun (y : Y) => Filter.Tendsto.{u2, u1} X Y f (nhdsWithin.{u2} X _inst_1 x A) (nhds.{u1} Y _inst_2 y))) -> (Filter.Tendsto.{u2, u1} X Y f (nhdsWithin.{u2} X _inst_1 x A) (nhds.{u1} Y _inst_2 (extendFrom.{u2, u1} X Y _inst_1 _inst_2 A f x)))
Case conversion may be inaccurate. Consider using '#align tendsto_extend_from tendsto_extendFromₓ'. -/
/-- If `f` converges to some `y` as `x` tends to `x₀` within `A`,
then `f` tends to `extend_from A f x` as `x` tends to `x₀`. -/
theorem tendsto_extendFrom {A : Set X} {f : X → Y} {x : X} (h : ∃ y, Tendsto f (𝓝[A] x) (𝓝 y)) :
    Tendsto f (𝓝[A] x) (𝓝 <| extendFrom A f x) :=
  tendsto_nhds_limUnder h
#align tendsto_extend_from tendsto_extendFrom

#print extendFrom_eq /-
theorem extendFrom_eq [T2Space Y] {A : Set X} {f : X → Y} {x : X} {y : Y} (hx : x ∈ closure A)
    (hf : Tendsto f (𝓝[A] x) (𝓝 y)) : extendFrom A f x = y :=
  haveI := mem_closure_iff_nhds_within_ne_bot.mp hx
  tendsto_nhds_unique (tendsto_nhds_limUnder ⟨y, hf⟩) hf
#align extend_from_eq extendFrom_eq
-/

#print extendFrom_extends /-
theorem extendFrom_extends [T2Space Y] {f : X → Y} {A : Set X} (hf : ContinuousOn f A) :
    ∀ x ∈ A, extendFrom A f x = f x := fun x x_in => extendFrom_eq (subset_closure x_in) (hf x x_in)
#align extend_from_extends extendFrom_extends
-/

#print continuousOn_extendFrom /-
/-- If `f` is a function to a T₃ space `Y` which has a limit within `A` at any
point of a set `B ⊆ closure A`, then `extend_from A f` is continuous on `B`. -/
theorem continuousOn_extendFrom [RegularSpace Y] {f : X → Y} {A B : Set X} (hB : B ⊆ closure A)
    (hf : ∀ x ∈ B, ∃ y, Tendsto f (𝓝[A] x) (𝓝 y)) : ContinuousOn (extendFrom A f) B :=
  by
  set φ := extendFrom A f
  intro x x_in
  suffices ∀ V' ∈ 𝓝 (φ x), IsClosed V' → φ ⁻¹' V' ∈ 𝓝[B] x by
    simpa [ContinuousWithinAt, (closed_nhds_basis _).tendsto_right_iff]
  intro V' V'_in V'_closed
  obtain ⟨V, V_in, V_op, hV⟩ : ∃ V ∈ 𝓝 x, IsOpen V ∧ V ∩ A ⊆ f ⁻¹' V' :=
    by
    have := tendsto_extendFrom (hf x x_in)
    rcases(nhdsWithin_basis_open x A).tendsto_left_iffₓ.mp this V' V'_in with ⟨V, ⟨hxV, V_op⟩, hV⟩
    use V, IsOpen.mem_nhds V_op hxV, V_op, hV
  suffices : ∀ y ∈ V ∩ B, φ y ∈ V'
  exact mem_of_superset (inter_mem_inf V_in <| mem_principal_self B) this
  rintro y ⟨hyV, hyB⟩
  haveI := mem_closure_iff_nhds_within_ne_bot.mp (hB hyB)
  have limy : tendsto f (𝓝[A] y) (𝓝 <| φ y) := tendsto_extendFrom (hf y hyB)
  have hVy : V ∈ 𝓝 y := IsOpen.mem_nhds V_op hyV
  have : V ∩ A ∈ 𝓝[A] y := by simpa [inter_comm] using inter_mem_nhdsWithin _ hVy
  exact V'_closed.mem_of_tendsto limy (mem_of_superset this hV)
#align continuous_on_extend_from continuousOn_extendFrom
-/

#print continuous_extendFrom /-
/-- If a function `f` to a T₃ space `Y` has a limit within a
dense set `A` for any `x`, then `extend_from A f` is continuous. -/
theorem continuous_extendFrom [RegularSpace Y] {f : X → Y} {A : Set X} (hA : Dense A)
    (hf : ∀ x, ∃ y, Tendsto f (𝓝[A] x) (𝓝 y)) : Continuous (extendFrom A f) :=
  by
  rw [continuous_iff_continuousOn_univ]
  exact continuousOn_extendFrom (fun x _ => hA x) (by simpa using hf)
#align continuous_extend_from continuous_extendFrom
-/


import analysis.normed_space.finite_dimension
import analysis.convolution
import measure_theory.function.jacobian
import measure_theory.integral.bochner
import measure_theory.measure.lebesgue

open set filter
open_locale topological_space filter ennreal
open measure_theory

noncomputable theory

variables {α : Type*} [measurable_space α]
variables {μ : measure α}

/- TEXT:
.. _integration:

Integration
-----------

Now that we have measurable spaces and measures we can consider integrals. As explained above, mathlib uses a very general notion of
integration that allows any Banach space as the target.
As usual, we don't want our notation to
carry around assumptions, so we define integration in such a way
that an integral is equal to zero if the function in question is
not integrable.
Most lemmas having to do with integerals have integrability assumptions.
EXAMPLES: -/
-- QUOTE:
section

variables {E : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]
  {f : α → E}

example {f g : α → E} (hf : integrable f μ) (hg : integrable g μ) :
  ∫ a, f a + g a ∂μ = ∫ a, f a ∂μ + ∫ a, g a ∂μ :=
integral_add hf hg
-- QUOTE.

/- TEXT:
As an example of the complex interactions between our various conventions, let us see how to integrate constant functions.
Recall that a measure ``μ`` takes values in ``ℝ≥0∞``, the type of extended non-negative reals.
There is a function ``ennreal.to_real : ℝ≥0∞ → ℝ`` which sends ``⊤``,
the point at infinity, to zero.
For any ``s : set α``, if ``μ s = ⊤``, then nonzero constant functions are not integrable on ``s``.
In that case, their integrals are equal to zero by definition, as is ``(μ s).to_real``.
So in all cases we have the following lemma.
EXAMPLES: -/
-- QUOTE:
example {s : set α} (c : E) :
  ∫ x in s, c ∂μ = (μ s).to_real • c :=
set_integral_const c
-- QUOTE.

/- TEXT:
We now quickly explain how to access the most important theorems in integration theory, starting
with the dominated convergence theorem. There are several versions in mathlib,
and here we only show the most basic one.
EXAMPLES: -/
-- QUOTE:
example {F : ℕ → α → E} {f : α → E} (bound : α → ℝ)
  (hmeas : ∀ n, ae_strongly_measurable (F n) μ)
  (hint : integrable bound μ)
  (hbound : ∀ n, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound a)
  (hlim : ∀ᵐ a ∂μ, tendsto (λ (n : ℕ), F n a) at_top (𝓝 (f a))) :
  tendsto (λ n, ∫ a, F n a ∂μ) at_top (𝓝 (∫ a, f a ∂μ)) :=
tendsto_integral_of_dominated_convergence bound hmeas hint hbound hlim
-- QUOTE.

/- TEXT:
Then we have Fubini's theorem for integrals on product type.
EXAMPLES: -/
-- QUOTE:
example
  {α : Type*} [measurable_space α]
  {μ : measure α} [sigma_finite μ]
  {β : Type*} [measurable_space β] {ν : measure β} [sigma_finite ν]
  (f : α × β → E) (hf : integrable f (μ.prod ν)) :
  ∫ z, f z ∂μ.prod ν = ∫ x, ∫ y, f (x, y) ∂ν ∂μ :=
integral_prod f hf
-- QUOTE.

end
/- TEXT:
There is a very general version of convolution that applies to any
continuous bilinear form.
EXAMPLES: -/
section
-- QUOTE:
open_locale convolution

-- EXAMPLES:
variables {𝕜 : Type*} {G : Type*} {E : Type*} {E' : Type*} {F : Type*} [normed_group E]
  [normed_group E'] [normed_group F] [nondiscrete_normed_field 𝕜]
  [normed_space 𝕜 E] [normed_space 𝕜 E'] [normed_space 𝕜 F]
  [measurable_space G] [normed_space ℝ F] [complete_space F] [has_sub G]

example (f : G → E) (g : G → E') (L : E →L[𝕜] E' →L[𝕜] F) (μ : measure G) :
  f ⋆[L, μ] g = λ x, ∫ t, L (f t) (g (x - t)) ∂μ :=
rfl
-- QUOTE.

end
/- TEXT:
Finally, mathlib has a very general version of the change-of-variables formula.
In the statement below, ``borel_space E`` means the
:math:`\sigma`-algebra on ``E`` is generated by the open sets of ``E``,
and ``is_add_haar_measure μ`` means that the measure ``μ`` is left-invariant,
gives finite mass to compact sets, and give positive mass to open sets.
EXAMPLES: -/
-- QUOTE:
example {E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
  [measurable_space E] [borel_space E] (μ : measure E) [μ.is_add_haar_measure]
  {F : Type*}[normed_group F] [normed_space ℝ F] [complete_space F]
  {s : set E} {f : E → E} {f' : E → (E →L[ℝ] E)}
  (hs : measurable_set s)
  (hf : ∀ (x : E), x ∈ s → has_fderiv_within_at f (f' x) s x)
  (h_inj : inj_on f s)
  (g : E → F) :
  ∫ x in f '' s, g x ∂μ = ∫ x in s, |(f' x).det| • g (f x) ∂μ :=
integral_image_eq_integral_abs_det_fderiv_smul μ hs hf h_inj g
-- QUOTE.


import data.real.basic
import tactic
import real_definitions
import utils

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open expr

-- useful lemmas:
-- ge_iff_le
-- gt_iff_lt
-- lt_of_le_of_ne
-- le_of_lt
-- div_pos
-- mul_pos
-- inv_pos

open tactic.interactive

-------------------------------------------
-------------------------------------------
-- Make 'a < b' from 'a ≠ b' and 'a ≤ b' --
-------------------------------------------
-------------------------------------------
-- This is achieved by the following sequence of tactics:
-- * make_ineq  take "a ≤ b" and "a' ≠ b'" and try to make "a < b"
-- * extract_gt extract the list of inequalities "a ≤ b" from a list of expressions
-- * extract_non_eq does the same for "a ≠ b"
-- * list_prod make the product list of two lists
-- * get_pos_from_pos_eq_from_list is build on the previous ones:
-- it takes a list of expressions,
-- extract inequalities and non-equalities,
-- take all pairs and try to make "a < b" by applying make_ineq
-- * get_pos_from_pos_eq is an interactive tactic that applies this to the local context

meta def make_ineq : expr × expr × expr → expr × expr × expr → tactic unit
/-  Take H1 of type "a ≤ b", H2 of type "a' ≠ b'", and if a=a' and b = b'
    then add H3 of type "a < b" in the local context -/
| (H1, a, b) (H2, a', b') :=
    tactic.unify a a' >> tactic.unify b b' >> do
    {
    H ← mk_fresh_name,
    «have» H none ``(lt_of_le_of_ne %%H1 %%H2),
    tactic.trace("EFFECTIVE LEAN CODE: have H := lt_of_le_of_ne " ++ to_string H1 ++ " " ++ to_string H1)
    }
    <|>
    tactic.unify a b' >> tactic.unify a' b >> do
    {
    H ← mk_fresh_name,
    «have» H none ``(lt_of_le_of_ne %%H1 (ne.symm %%H2)),
    tactic.trace("EFFECTIVE LEAN CODE: have H := lt_of_le_of_ne " ++ to_string H1 ++ " (ne.symm " ++ to_string H2 ++ ")")
    }
    <|>
    skip

meta def make_ineq' : expr → expr → tactic unit
/- The same, but remove H1 and H2 from context
  TODO
  -/
| H1 H2 := do skip

meta def extract_gt : list expr → tactic (list (expr × expr × expr))
/- Extract from list of expr the couples (H, a,b)
where the expr H of type "a ≤ b" in is the list -/
-- match hypos with
| []                    := return []
| (hypo :: less_hypos)  := do
    {
    ineq ← infer_type hypo,
    remaining_list ← (extract_gt less_hypos),
    match ineq with
        | `(%%a ≤ %%b)  := return $ (hypo, a, b) :: remaining_list
        | _             := return $ remaining_list
        end
    }

meta def extract_non_eq : list expr → tactic (list (expr × expr × expr))
/- Extract from list of expr the couples (H, a,b)
where the expr H of type "a ≠ b" in is the list -/
-- match hypos with
| []                    := return []
| (hypo :: less_hypos)  := do
    {
    ineq ← infer_type hypo,
    remaining_list ← (extract_non_eq less_hypos),
    match ineq with
        | `(%%a ≠ %%b)      := return $ (hypo, a, b) :: remaining_list
        | `(¬ %%a = %%b)    := return $ (hypo, a, b) :: remaining_list
        | _                 := return $ remaining_list
        end
    }

meta def list_prod {α β : Type} : list α → list β → list (α × β)
/- Return the product list -/
| []    l2                  := []
| l1    []                  := []
| (h1 :: l1)  (h2 :: l2)    :=
    (h1, h2) ::
    append  (append (list_prod [h1] l2)
                    (list_prod l1 [h2]))
            (list_prod l1 l2)

meta def get_pos_from_pos_eq_from_list (hypos: list expr) : tactic unit :=
do
{
    inequalities    ← extract_gt hypos,     -- tactic.trace inequalities,
    equalities      ← extract_non_eq hypos, -- tactic.trace equalities,
    -- take all pairs and try to build " a < b "
    (list_prod inequalities equalities).mmap (λh, make_ineq h.1 h.2),
    return ()
}

meta def get_pos_from_pos_eq : tactic unit :=
/- To be applied after "norm_num at *"
    This tactic search in the hypotheses for two hypotheses of the for
    a ≤ b  and a ≠ b
    and deduces
    a < b
-/
do
{
hypos ← tactic.local_context,
get_pos_from_pos_eq_from_list hypos
}

-------------------
-------------------
-- Tactic compute -
-------------------
-------------------

lemma inv_pos_mpr {α : Type} [linear_ordered_field α] (a:α) :
0 < a → 0 < a⁻¹ := inv_pos.mpr

open linarith
meta def nl_linarith (cfg : linarith_config := {}): tactic unit :=
do
{
tactic.linarith false false []
  { cfg with preprocessors := some $
      cfg.preprocessors.get_or_else default_preprocessors ++ [nlinarith_extras] }
}

meta def compute1 : tactic unit :=
/- try several computing tactics for STRICT inequalities -/
do
{
    do {assumption, tactic.trace "EFFECTIVE LEAN CODE: assumption"}
    <|>
    -- solve e.g. "n_0 ≤ n_0 ∨ n_0 ≤ n_1"
    -- with norm_num, solves "n_0 ≤ max n_0 n_1"
    do {tactic.tautology, tactic.trace "EFFECTIVE LEAN CODE: tautology"}
    <|>
    do {nl_linarith, tactic.trace "EFFECTIVE LEAN CODE: nl_linarith"}
    <|>
    do {tactic.applyc ``mul_pos, tactic.trace "EFFECTIVE LEAN CODE: apply mul_pos"}
    <|>
    -- a>0 → a⁻¹ >0
    do {tactic.applyc ``inv_pos_mpr, tactic.trace "EFFECTIVE LEAN CODE: apply inv_pos.mpr"}
    <|>
 -- a≠0 → b≠0 → ab≠0
     do {tactic.applyc ``mul_ne_zero, tactic.trace "EFFECTIVE LEAN CODE: apply mul_ne_zero"}
--  div_pos is now useless
}

meta def compute_n (n: nat): tactic unit :=
/- Repeat n times the tactic compute1 ; never fails -/
do
{
    get_pos_from_pos_eq, -- try to add strict inequalities to the context
    tactic.iterate_exactly' n (tactic.try (compute1))
}

end tactic.interactive


import analysis.normed_space.lp_space
import topology.instances.real
import banach

open_locale nnreal big_operators uniformity topological_space

noncomputable theory

namespace pBanach

/-- The type of sequences `ℕ → ℝ` where `∑' n, |f n|^p` converges. -/
@[derive (module ℝ)]
def lp_type (p : ℝ≥0) := lp (λ n : ℕ, ℝ) p

variable (p : ℝ≥0)

instance : has_coe_to_fun (lp_type p) (λ f, ℕ → ℝ) :=
by { dsimp [lp_type], apply_instance }

instance : has_nnnorm (lp_type p) := has_nnnorm.mk $
λ f, ∑' n : ℕ, ∥ f n ∥₊^(p : ℝ)

@[simps]
instance : has_norm (lp_type p) := has_norm.mk $
λ f, ∑' n : ℕ, ∥ f n ∥^(p : ℝ)

variables {p} [fact (0 < p)]

lemma lp_type.summable (f : lp_type p) :
  summable (λ n, | f n |^(p : ℝ)) :=
begin
  have := f.2, dsimp [lp_type, lp, mem_ℓp] at this,
  rw if_neg at this, rwa if_neg at this,
  { exact ennreal.coe_ne_top },
  { refine (ne_of_gt _),
    exact_mod_cast (fact.out (0 < p)) },
end

variables [fact (p ≤ 1)]

lemma lp_type.triangle (f g : lp_type p) :
  ∥ f + g ∥ ≤ ∥ f ∥ + ∥ g ∥ :=
begin
  dsimp,
  have : ∀ n, |f n + g n| ^ (p : ℝ) ≤ | f n | ^(p : ℝ) + |g n|^(p : ℝ),
  { intros n,
    suffices : ∥f n + g n∥₊ ^ (p : ℝ) ≤ ∥ f n ∥₊ ^(p : ℝ) + ∥ g n ∥₊^(p : ℝ),
    { exact_mod_cast this },
    refine le_trans _ (nnreal.rpow_add_le_add_rpow _ _ _ _),
    apply nnreal.rpow_le_rpow, apply nnnorm_add_le,
    { exact_mod_cast (fact.out (0 < p)).le },
    { exact_mod_cast (fact.out (0 < p)).le },
    { exact_mod_cast (fact.out (p ≤ 1)) } },
  refine le_trans (tsum_le_tsum this _ _) (le_of_eq _),
  { have hh := lp_type.summable (f + g), dsimp at hh, exact hh },
  { apply summable.add,
    exact lp_type.summable f,
    exact lp_type.summable g },
  apply tsum_add,
  exact lp_type.summable f,
  exact lp_type.summable g,
end

instance : pseudo_metric_space (lp_type p) :=
{ dist := λ f g, ∥ f - g ∥,
  dist_self := begin
    have : (p : ℝ) ≠ (0 : ℝ),
    { refine ne_of_gt _, exact_mod_cast (fact.out (0 < p)) },
    intros f, dsimp,
    simp only [abs_zero, sub_self, real.zero_rpow this, tsum_zero],
  end,
  dist_comm := begin
    intros f g, dsimp,
    have : ∀ n, | f n - g n | = | g n - f n |,
    { intros n,
      rw [← neg_neg (f n - g n), abs_neg, neg_sub] },
    simp_rw this,
  end,
  dist_triangle := begin
    intros f g h,
    have := lp_type.triangle (f - g) (g - h),
    rw (show f - g + (g - h) = f - h, by abel) at this,
    exact this,
  end }

variable (p)
/-- The p-norm structure on `lp_type p`. -/
def has_p_norm : has_p_norm (lp_type p) p :=
{ norm_smul := begin
    intros a f, dsimp,
    have : ∀ n, |a * f n|^(p : ℝ) = |a|^(p : ℝ) * |f n|^(p : ℝ),
    { intros n, rw [abs_mul, real.mul_rpow],
      any_goals { exact abs_nonneg _ } },
    simp_rw this,
    rw tsum_mul_left,
  end,
  triangle := begin
    intros f g, apply lp_type.triangle,
  end,
  uniformity := rfl,
  ..(infer_instance : has_norm (lp_type p)) } .

instance : normed_add_comm_group (lp_type p) :=
normed_add_comm_group.of_core _
{ norm_eq_zero_iff := begin
    intros f, dsimp, split,
    { intros hf,
      ext n, suffices : | f n |^(p : ℝ) = 0,
      { rw real.rpow_eq_zero_iff_of_nonneg at this,
        simpa using this.1,
        apply abs_nonneg },
      refine le_antisymm (le_trans _ (le_of_eq hf)) _,
      { apply le_tsum (lp_type.summable f) n,
        intros m hm, dsimp,
        apply real.rpow_nonneg_of_nonneg,
        exact abs_nonneg _, },
      { apply real.rpow_nonneg_of_nonneg, apply abs_nonneg } },
    { intros hf, rw hf,
      simp only [lp.coe_fn_zero, pi.zero_apply, abs_zero],
      rw real.zero_rpow, simp only [tsum_zero],
      refine ne_of_gt _,
      exact_mod_cast (fact.out (0 < p)) }
  end,
  triangle := λ f g, has_p_norm.triangle (has_p_norm p) f g,
  norm_neg := λ f, by { dsimp, simp } }

.

lemma has_continuous_smul_δ_aux₁ (A ε : ℝ) (hA : 0 ≤ A) (hε : 0 < ε) :
  ∃ (δ : ℝ) (hδ : 0 < δ), A * δ < ε :=
begin
  --TODO: Golf!
  by_cases hhA : A = 0,
  { use 1, split, linarith, simp [hhA], assumption },
  use ε/(2 * A), split,
  have : ε / (2 * A) = (2 * A)⁻¹ * ε, by field_simp, rw this, clear this,
  apply mul_pos,
  simp only [mul_inv_rev, zero_lt_mul_right, inv_pos, zero_lt_bit0, zero_lt_one],
  exact (ne.symm hhA).lt_of_le hA, assumption,
  rw (show A * (ε / (2 * A)) = ε/2, by { field_simp, ring }), linarith,
end

lemma has_continuous_smul_δ_aux₂ (p : ℝ≥0) [fact (0 < p)] (ε : ℝ) (hε : 0 < ε) :
  ∃ (δ : ℝ) (hδ : 0 < δ), δ^((p : ℝ) + 1) < ε :=
begin
  --TODO: Golf!
  use (ε/2)^(1/((p : ℝ)+1)), split,
  { apply real.rpow_pos_of_pos, linarith },
  { rw ← real.rpow_mul,
    have : 1 / ((p : ℝ) + 1) * (p + 1) = 1,
    { have : (p : ℝ)+1 ≠ 0,
      { apply ne_of_gt,
        have : 0 < (p : ℝ) := by exact_mod_cast (fact.out (0 < p)),
        linarith },
      field_simp },
    rw [this, real.rpow_one], linarith, linarith, }
end

lemma has_continuous_smul_δ_aux₃  (p : ℝ≥0) [fact (0 < p)] (B ε : ℝ) (hB : 0 ≤ B) (hε : 0 < ε) :
  ∃ (δ : ℝ) (hδ : 0 < δ), δ^(p : ℝ) * B < ε :=
begin
  --TODO: Golf!
  by_cases hhB : B = 0,
  { use 1, split, simp, simp [hhB], assumption },
  use (ε/(2 * B))^(1/(p : ℝ)),
  split,
  { apply real.rpow_pos_of_pos,
    have : ε / (2 * B) = (2 * B)⁻¹ * ε, by field_simp, rw this, clear this,
    apply mul_pos,
    simp only [mul_inv_rev, zero_lt_mul_right, inv_pos, zero_lt_bit0, zero_lt_one],
    exact (ne.symm hhB).lt_of_le hB, assumption },
  { rw ← real.rpow_mul,
    have : 1 / (p : ℝ) * p = 1,
    { have : (p : ℝ) ≠ 0,
      { apply ne_of_gt, exact_mod_cast (fact.out (0 < p)) },
      field_simp },
    rw [this, real.rpow_one],
    rw (show ε / (2 * B) * B = ε/2, by field_simp; ring), linarith,
    have : ε / (2 * B) = (2 * B)⁻¹ * ε, by field_simp, rw this, clear this,
    apply mul_nonneg,
    simp only [mul_inv_rev, zero_le_mul_right, inv_pos, zero_lt_bit0, zero_lt_one, inv_nonneg],
    assumption,
    exact (le_of_lt hε) }
end

lemma has_continuous_smul_δ_aux  (p : ℝ≥0) [fact (0 < p)]
  (A B ε : ℝ) (hA : 0 ≤ A) (hB : 0 ≤ B) (hε : 0 < ε) :
  ∃ (δ : ℝ) (hδ : 0 < δ), A * δ + δ^(p : ℝ) * (δ + B) < ε :=
begin
  --TODO: Golf!
  have hh : 0 < ε/3, by linarith,
  obtain ⟨δ₁,hδ₁,Hδ₁⟩ := has_continuous_smul_δ_aux₁ A _ hA hh,
  obtain ⟨δ₂,hδ₂,Hδ₂⟩ := has_continuous_smul_δ_aux₂ p _ hh,
  obtain ⟨δ₃,hδ₃,Hδ₃⟩ := has_continuous_smul_δ_aux₃ p B _ hB hh,
  refine ⟨δ₁ ⊓ δ₂ ⊓ δ₃,_,_⟩,
  { rw lt_inf_iff,
    split,
    rw lt_inf_iff,
    split,
    assumption' },
  { rw mul_add,
    have : ε = ε/3 + ε/3 + ε/3, { field_simp, ring },
    rw this, clear this,
    simp only [← add_assoc],
    apply add_lt_add,
    apply add_lt_add,
    { refine lt_of_le_of_lt _ Hδ₁,
      refine mul_le_mul (le_refl _) _ _ _,
      rw inf_assoc,
      apply inf_le_left,
      rw le_inf_iff, split,
      rw le_inf_iff, split,
      all_goals { assumption <|> { apply le_of_lt, assumption } } },
    { have : (δ₁ ⊓ δ₂ ⊓ δ₃) ^ (p : ℝ) * (δ₁ ⊓ δ₂ ⊓ δ₃) =
        (δ₁ ⊓ δ₂ ⊓ δ₃) ^ ((p : ℝ) + 1),
      { rw [real.rpow_add, real.rpow_one],
        rw lt_inf_iff, split,
        rw lt_inf_iff, split,
        assumption' },
      rw this, clear this,
      refine lt_of_le_of_lt _ Hδ₂,
      apply real.rpow_le_rpow,
      rw le_inf_iff, split,
      rw le_inf_iff, split,
      { apply le_of_lt, assumption },
      { apply le_of_lt, assumption },
      { apply le_of_lt, assumption },
      rw [inf_comm, ← inf_assoc], exact inf_le_right,
      have : 0 < (p : ℝ) := by exact_mod_cast (fact.out (0 < p)),
      linarith },
    { refine lt_of_le_of_lt _ Hδ₃,
      apply mul_le_mul,
      { apply real.rpow_le_rpow,
        rw le_inf_iff, split,
        rw le_inf_iff, split,
        { apply le_of_lt, assumption },
        { apply le_of_lt, assumption },
        { apply le_of_lt, assumption },
        exact inf_le_right,
        apply le_of_lt,
        exact_mod_cast (fact.out (0 < p)) },
      { exact le_refl _ },
      { assumption },
      { apply real.rpow_nonneg_of_nonneg, apply le_of_lt, assumption } } }
end

instance : has_continuous_smul ℝ (lp_type p) :=
begin
  constructor,
  rw metric.continuous_iff,
  rintros ⟨a,f⟩ ε hε,
  obtain ⟨δ,hδ,Hδ⟩ : ∃ (δ : ℝ) (hδ : 0 < δ),
    |a|^(p : ℝ) * δ + δ^(p : ℝ) * (δ + ∥ f ∥) < ε,
  { apply has_continuous_smul_δ_aux,
    apply real.rpow_nonneg_of_nonneg, exact abs_nonneg _,
    exact norm_nonneg _,
    exact hε },
  refine ⟨δ,hδ,_⟩,
  rintros ⟨b,g⟩ (h : max _ _ < _), dsimp only [has_dist.dist] at h ⊢,
  refine lt_trans _ Hδ,
  rw [← norm_neg, neg_sub],
  have : ∥a • f - b • g∥ ≤ ∥ a • f - a • g ∥ + ∥ a • g - b • g ∥,
  { refine le_trans (le_of_eq _) (norm_add_le _ _),
    congr' 1, abel },
  refine lt_of_le_of_lt this _, clear this,
  apply add_lt_add_of_le_of_lt,
  { rw [← smul_sub, (has_p_norm p).norm_smul a (f - g)],
    apply mul_le_mul, exact le_refl _,
    rw [← neg_neg (f - g), norm_neg, neg_sub],
    refine le_trans (le_max_right _ _) (le_of_lt h),
    exact norm_nonneg (f - g),
    apply real.rpow_nonneg_of_nonneg, exact abs_nonneg _ },
  { rw [← sub_smul, (has_p_norm p).norm_smul (a - b) g, smul_eq_mul],
    apply mul_lt_mul',
    { apply real.rpow_le_rpow,
      exact abs_nonneg _,
      refine le_trans _ (le_of_lt h),
      rw [← neg_neg (a - b), abs_neg, neg_sub],
      exact le_max_left _ _,
      refine le_of_lt (by exact_mod_cast (fact.out (0 < p))) },
    { rw (show g = (g - f) + f, by abel),
      refine lt_of_le_of_lt (norm_add_le _ _) _,
      refine add_lt_add_of_lt_of_le _ (le_refl _),
      refine lt_of_le_of_lt (le_max_right _ _) h },
    { exact norm_nonneg _ },
    { have : (0 : ℝ) = 0^(p : ℝ),
      { rw real.zero_rpow,
        refine ne_of_gt (by exact_mod_cast (fact.out (0 < p))) },
      rw this, clear this,
      apply real.rpow_lt_rpow,
      exact le_refl _,
      exact hδ,
      exact_mod_cast (fact.out (0 < p)) } }
end

lemma uniform_continuous_coe :
  uniform_continuous (λ f n, f n : lp_type p → ℕ → ℝ) :=
begin
  rw uniform_continuous_pi, intros i,
  rw normed_add_comm_group.uniformity_basis_dist.uniform_continuous_iff
    normed_add_comm_group.uniformity_basis_dist,
  intros ε hε, dsimp,
  refine ⟨ε^(p : ℝ), _, _⟩,
  { apply real.rpow_pos_of_pos, assumption },
  rintros f g (hfg : ∥f - g∥ < ε^_),
  suffices : |f i - g i|^(p : ℝ) < ε^(p : ℝ),
  { rw real.rpow_lt_rpow_iff at this, assumption, exact abs_nonneg _, exact le_of_lt hε,
    exact_mod_cast (fact.out (0 < p)) },
  refine lt_of_le_of_lt _ hfg,
  apply le_tsum (lp_type.summable (f - g)) i,
  intros j _, apply real.rpow_nonneg_of_nonneg, exact abs_nonneg _,
end

lemma sum_rpow_le_norm  (p : ℝ≥0) [fact (0 < p)] (F : lp_type p) (S : finset ℕ) :
  ∑ i in S, | F i |^(p : ℝ) ≤ ∥ F ∥ :=
begin
  apply sum_le_tsum,
  intros i hi, apply real.rpow_nonneg_of_nonneg, exact abs_nonneg _,
  exact lp_type.summable _,
end

lemma sum_rpow_le_of_tendsto (p : ℝ≥0) [fact (0 < p)]
  {C : ℝ} {F : ℕ → lp_type p} (hCF : ∀ᶠ k in filter.at_top, ∥F k∥ ≤ C)
  {f : ℕ → ℝ} (hf : filter.tendsto (λ i j, F i j) (filter.at_top : filter ℕ) (𝓝 f))
  (s : finset ℕ) :
  ∑ i in s, |f i| ^ (p : ℝ) ≤ C :=
begin
  let G : (Π a, ℝ) → ℝ := λ f, ∑ a in s, ∥f a∥ ^ (p : ℝ),
  have hG : continuous G,
  { refine continuous_finset_sum s _,
    intros a ha,
    have : continuous (λ f : Π a, ℝ, f a):= continuous_apply a,
    refine this.norm.rpow_const (_),
    intros _, right, apply le_of_lt, exact_mod_cast (fact.out (0 < p)) },
  refine le_of_tendsto (hG.continuous_at.tendsto.comp hf) _,
  refine hCF.mono _,
  intros k hCFk,
  refine (sum_rpow_le_norm _ (F k) s).trans _, assumption,
end

lemma norm_le_of_forall_sum_le  (p : ℝ≥0) [fact (0 < p)] (f : lp_type p) (C)
  (hf : ∀ s : finset ℕ, ∑ i in s, | f i |^(p : ℝ) ≤ C) :
  ∥ f ∥ ≤ C :=
begin
  apply tsum_le_of_sum_le, exact lp_type.summable f, assumption
end

lemma norm_le_of_tendsto (p : ℝ≥0) [fact (0 < p)] {C : ℝ} (F : ℕ → lp_type p)
  (hCF : ∀ᶠ k in filter.at_top, ∥F k∥ ≤ C) (f : lp_type p)
  (hf : filter.tendsto (λ j i, F j i) (filter.at_top : filter ℕ) (𝓝 (λ i, f i))) :
  ∥f∥ ≤ C :=
begin
  obtain ⟨i, hi⟩ := hCF.exists,
  have hC : 0 ≤ C := le_trans _ hi,
  apply norm_le_of_forall_sum_le,
  apply sum_rpow_le_of_tendsto, exact hCF, exact hf,
  apply tsum_nonneg, intros _, apply real.rpow_nonneg_of_nonneg, exact abs_nonneg _,
end

instance : complete_space (lp_type p) :=
begin
  apply metric.complete_of_cauchy_seq_tendsto,
  intros u hu,
  obtain ⟨f, hf⟩ := cauchy_seq_tendsto_of_complete
    ((uniform_continuous_coe p).comp_cauchy_seq hu),
  have hf' : mem_ℓp f p,
  { obtain ⟨C,hC,H⟩ := hu.bounded_range.exists_pos_norm_le,
    replace H : ∀ n, ∥ u n ∥ ≤ C := λ n, H _ ⟨n,rfl⟩,
    apply mem_ℓp_gen', swap, use C,
    intros S, simp only [real.norm_eq_abs, ennreal.coe_to_real],
    apply sum_rpow_le_of_tendsto, apply filter.eventually_of_forall, exact H, assumption },
  refine ⟨⟨f,hf'⟩, _⟩,
  rw metric.nhds_basis_closed_ball.tendsto_right_iff,
  intros ε hε,
  have hε' : {p : (lp_type p) × (lp_type p) | ∥p.1 - p.2∥ < ε} ∈ 𝓤 (lp_type p),
  { exact normed_add_comm_group.uniformity_basis_dist.mem_of_mem hε },
  refine (hu.eventually_eventually hε').mono _, clear hε',
  rintros n (hn : ∀ᶠ j in filter.at_top, ∥ u n - u j ∥ < _),
  apply norm_le_of_tendsto,
  apply hn.mono, intros j hj, exact hj.le,
  rw tendsto_pi_nhds, intros k,
  exact (hf.apply k).const_sub (u n k),
end

lemma p_banach : p_banach (lp_type p) p :=
{ exists_p_norm := nonempty.intro $ has_p_norm p }

/-- The `lp` space of sequences `ℕ → ℝ`, as an element of `pBanach p`. -/
def lp (p : ℝ≥0) [fact (0 < p)] [fact (p ≤ 1)] : pBanach p :=
{ V := lp_type p,
  p_banach' := p_banach p }

instance : nontrivial (pBanach.lp p) :=
nontrivial.mk $
⟨0,⟨λ i, if i = 0 then 1 else 0, begin
  change ite _ _ _, rw if_neg, rw if_neg,
  use 1, intros S hS, dsimp,
  simp only [filter.mem_at_top_sets, ge_iff_le, finset.le_eq_subset, set.mem_preimage],
  use {0}, intros T hT,
  suffices : T.sum (λ (i : ℕ), |ite (i = 0) (1 : ℝ) 0| ^ ↑p) = 1,
  { rw this, exact mem_of_mem_nhds hS },
  have : (λ (i : ℕ), |ite (i = 0) (1 : ℝ) 0| ^ (p : ℝ)) =
    (λ i, if i = 0 then 1 else 0),
  { ext ⟨_|i⟩, simp, simp, rw real.zero_rpow, apply ne_of_gt, exact_mod_cast (fact.out (0 < p)) },
  erw [this, finset.sum_dite], simp,
  have : finset.filter (λ (x : ℕ), x = 0) T = {0},
  { ext, simp, intros ha, apply hT, rw ha, simp, },
  rw this, simp,
  exact ennreal.coe_ne_top,
  apply ne_of_gt,
  exact_mod_cast (fact.out (0 < p))
end⟩, λ c, begin
  apply_fun (λ t, t.1 0) at c,
  change (0 : ℝ) = (1 : ℝ) at c,
  exact zero_ne_one c,
end⟩

end pBanach


-- TODO -- post this on M1F blackboard and on Xena blackboard
-- No -- put it on M1F example class questions github site
/-
   Equivalent formulations of the law of the excluded middle.

   Dr Britnell's axioms were:

   1) P → (Q → P)
   2) (¬ Q → ¬ P) → (P → Q)
   3) (P → (Q → R)) → ((P → Q) → (P → R))

   Here I formalise the assertion that the second axiom is
   equivalent to the so-called "law of the excluded middle", that
   not not P implies P.
-/

inductive fml
| atom (i : ℕ)
| imp (a b : fml)
| not (a : fml)

-- namespace fml -- haven't defined things like and and iff

open fml

infixr ` →' `:50 := imp -- right associative

prefix `¬' `:40 := fml.not

inductive prf : fml → Type
| axk (p q) : prf (p →' q →' p)
| axs (p q r) : prf $ (p →' q →' r) →' (p →' q) →' (p →' r)
| mp {q r} : prf (q →' r) → prf q → prf r

open prf

-- contrapositive
definition contra (p q : fml) : fml := ((¬' q) →' (¬' p)) →' p →' q

-- excluded middle
definition lem (p : fml) : fml := (¬' (¬' p)) →' p

-- those definitions can be used to create extra
-- constructors for `fml`, equivalent to extra axioms.

-- Here is what I hope is a correct formalisation of the
-- assertion that the law of the excluded middle is equivalent
-- to Dr Britnell's choice (which is also Prof Evans' choice, I
-- think someone told me, in his P65 course)
-- of the contrapositive.

-- Solving these lemmas is the challenge then.

lemma lem_of_contra (p q : fml) :
(∀ r, prf (lem r)) → ∀ p q, prf (contra p q) :=
begin
  intro Hlem,
  intros p q,
  -- example usage
  have H : prf ((¬' (¬' q)) →' q) := Hlem q,
  have H2 : prf ((¬' q) →' ¬' p) → prf ¬' q → prf ¬' p := mp,
  sorry
end

lemma contra_of_lem (p q : fml) :
(∀ p q, prf (contra p q)) → (∀ r, prf (lem r)) :=
sorry


import game.sets.sets_level01
import data.set.basic
import tactic

namespace xena -- hide

variable X : Type -- hide

open_locale classical

theorem distr_union (A B C : set X) : A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C) :=
begin
  rw ext_iff,
  intro h,
  split,
  intro j,
  rw mem_inter_iff,
  rw mem_union_iff,
  rw mem_union_iff,
  rw mem_union_iff at j,
  rw mem_inter_iff at j,
  cases j with d hd,
  split,
  left,
  exact d,
  left,
  exact d,
  cases hd with t ht,
  split,
  right,
  exact t,
  right,
  exact ht,
  intro j,
  rw mem_inter_iff at j,
  cases j with d hd,
  cases d with t ht,
  left,
  exact t,
  cases hd with y hy,
  left,
  exact y,
  right,
  split,
  exact ht,
  exact hy,
end

end xena -- hide


import data.nat.prime

open nat

theorem t011 : Π (n : ℕ), ∃ p, p ≥ n ∧ prime p
:= exists_infinite_primes


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import tactic.monotonicity
import tactic.norm_num
import algebra.order.ring
import measure_theory.measure.lebesgue
import data.list.defs

open list tactic tactic.interactive set

example
  (h : 3 + 6 ≤ 4 + 5)
: 1 + 3 + 2 + 6 ≤ 4 + 2 + 1 + 5 :=
begin
  ac_mono,
end

example
  (h : 3 ≤ (4 : ℤ))
  (h' : 5 ≤ (6 : ℤ))
: (1 + 3 + 2) - 6 ≤ (4 + 2 + 1 : ℤ) - 5 :=
begin
  ac_mono,
  mono,
end

example
  (h : 3 ≤ (4 : ℤ))
  (h' : 5 ≤ (6 : ℤ))
: (1 + 3 + 2) - 6 ≤ (4 + 2 + 1 : ℤ) - 5 :=
begin
  transitivity (1 + 3 + 2 - 5 : ℤ),
  { ac_mono },
  { ac_mono },
end

example (x y z k : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y)
: (k + 3 + x) - y ≤ (k + 4 + x) - z :=
begin
  mono, norm_num
end

example (x y z a b : ℤ)
  (h : a ≤ (b : ℤ))
  (h' : z ≤ y)
: (1 + a + x) - y ≤ (1 + b + x) - z :=
begin
  transitivity (1 + a + x - z),
  { mono, },
  { mono, mono, mono },
end

example (x y z : ℤ)
  (h' : z ≤ y)
: (1 + 3 + x) - y ≤ (1 + 4 + x) - z :=
begin
  transitivity (1 + 3 + x - z),
  { mono },
  { mono, mono, norm_num },
end

example (x y z : ℤ)
  (h : 3 ≤ (4 : ℤ))
  (h' : z ≤ y)
: (1 + 3 + x) - y ≤ (1 + 4 + x) - z :=
begin
  ac_mono, mono*
end

@[simp]
def list.le' {α : Type*} [has_le α] : list α → list α → Prop
 | (x::xs) (y::ys) := x ≤ y ∧ list.le' xs ys
 | [] [] := true
 | _ _ := false

@[simp]
instance list_has_le {α : Type*} [has_le α] : has_le (list α) :=
⟨ list.le' ⟩

lemma list.le_refl {α : Type*} [preorder α] {xs : list α}
: xs ≤ xs :=
begin
  induction xs with x xs,
  { trivial },
  { simp [has_le.le,list.le],
    split, apply le_refl, apply xs_ih }
end

-- @[trans]
lemma list.le_trans {α : Type*} [preorder α]
  {xs zs : list α} (ys : list α)
  (h  : xs ≤ ys)
  (h' : ys ≤ zs)
: xs ≤ zs :=
begin
  revert ys zs,
  induction xs with x xs
  ; intros ys zs h h'
  ; cases ys with y ys
  ; cases zs with z zs
  ; try { cases h ; cases h' ; done },
  { apply list.le_refl },
  { simp [has_le.le,list.le],
    split,
    apply le_trans h.left h'.left,
    apply xs_ih _ h.right h'.right, }
end

@[mono]
lemma list_le_mono_left {α : Type*} [preorder α] {xs ys zs : list α}
  (h : xs ≤ ys)
: xs ++ zs ≤ ys ++ zs :=
begin
  revert ys,
  induction xs with x xs ; intros ys h,
  { cases ys, apply list.le_refl, cases h },
  { cases ys with y ys, cases h, simp [has_le.le,list.le] at *,
    revert h, apply and.imp_right,
    apply xs_ih }
end

@[mono]
lemma list_le_mono_right {α : Type*} [preorder α] {xs ys zs : list α}
  (h : xs ≤ ys)
: zs ++ xs ≤ zs ++ ys :=
begin
  revert ys zs,
  induction xs with x xs ; intros ys zs h,
  { cases ys, { simp, apply list.le_refl }, cases h },
  { cases ys with y ys, cases h, simp [has_le.le,list.le] at *,
    suffices : list.le' ((zs ++ [x]) ++ xs) ((zs ++ [y]) ++ ys),
    { refine cast _ this, simp, },
    apply list.le_trans (zs ++ [y] ++ xs),
    { apply list_le_mono_left,
      induction zs with z zs,
      { simp [has_le.le,list.le], apply h.left },
      { simp [has_le.le,list.le], split, apply le_refl,
        apply zs_ih, } },
    { apply xs_ih h.right, } }
end

lemma bar_bar'
  (h : [] ++ [3] ++ [2] ≤ [1] ++ [5] ++ [4])
: [] ++ [3] ++ [2] ++ [2] ≤ [1] ++ [5] ++ ([4] ++ [2]) :=
begin
  ac_mono,
end

lemma bar_bar''
  (h : [3] ++ [2] ++ [2] ≤ [5] ++ [4] ++ [])
: [1] ++ ([3] ++ [2]) ++ [2] ≤ [1] ++ [5] ++ ([4] ++ []) :=
begin
  ac_mono,
end

lemma bar_bar
  (h : [3] ++ [2] ≤ [5] ++ [4])
: [1] ++ [3] ++ [2] ++ [2] ≤ [1] ++ [5] ++ ([4] ++ [2]) :=
begin
  ac_mono,
end

def P (x : ℕ) := 7 ≤ x
def Q (x : ℕ) := x ≤ 7

@[mono]
lemma P_mono {x y : ℕ}
  (h : x ≤ y)
: P x → P y :=
by { intro h', apply le_trans h' h }

@[mono]
lemma Q_mono {x y : ℕ}
  (h : y ≤ x)
: Q x → Q y :=
by apply le_trans h

example (x y z : ℕ)
  (h : x ≤ y)
: P (x + z) → P (z + y) :=
begin
  ac_mono,
  ac_mono,
end

example (x y z : ℕ)
  (h : y ≤ x)
: Q (x + z) → Q (z + y) :=
begin
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℤ)
  (h₀ : z ≤ 0)
  (h₁ : y ≤ x)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  ac_mono,
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono,
  -- ⊢ (m + x + n) * z ≤ z * (y + n + m)
  ac_mono,
  -- ⊢ m + x + n ≤ y + n + m
  ac_mono,
end

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : x ≤ y)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by { ac_mono* := h₁ }

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : m + x + n ≤ y + n + m)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
by { ac_mono* := h₁ }

example (x y z k m n : ℕ)
  (h₀ : z ≥ 0)
  (h₁ : n + x + m ≤ y + n + m)
: (m + x + n) * z + k ≤ z * (y + n + m) + k :=
begin
  ac_mono* : m + x + n ≤ y + n + m,
  transitivity ; [ skip , apply h₁ ],
  apply le_of_eq,
  ac_refl,
end

example (x y z k m n : ℤ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono,
    success_if_fail { ac_mono },
    admit },
  trivial
end

example (x y z k m n : ℕ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono*,
    change 0 ≤ z, apply nat.zero_le, },
  trivial
end

example (x y z k m n : ℕ)
  (h₁ : x ≤ y)
: true :=
begin
  have : (m + x + n) * z + k ≤ z * (y + n + m) + k,
  { ac_mono,
    change (m + x + n) * z ≤ z * (y + n + m),
    admit },
  trivial,
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: (m + x + n + i) * z + k = z * (j + n + m + y) + k :=
begin
  ac_mono^3,
  cc
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: z * (x + i + n + m) + k = z * (y + j + n + m) + k :=
begin
  congr,
  simp [h₁],
end

example (x y z k m n i j : ℕ)
  (h₁ : x + i = y + j)
: (m + x + n + i) * z + k = z * (j + n + m + y) + k :=
begin
  ac_mono*,
  cc,
end

example (x y : ℕ)
  (h : x ≤ y)
: true :=
begin
  (do v ← mk_mvar,
      p ← to_expr ```(%%v + x ≤ y + %%v),
      assert `h' p),
  ac_mono := h,
  trivial,
  exact 1,
end

example {x y z : ℕ} : true :=
begin
  have : y + x ≤ y + z,
  { mono,
    guard_target' x ≤ z,
    admit },
  trivial
end

example {x y z : ℕ} : true :=
begin
  suffices : x + y ≤ z + y, trivial,
  mono,
  guard_target' x ≤ z,
  admit,
end

example {x y z w : ℕ} : true :=
begin
  have : x + y ≤ z + w,
  { mono,
    guard_target' x ≤ z, admit,
    guard_target' y ≤ w, admit },
  trivial
end

example {x y z w : ℕ} : true :=
begin
  have : x * y ≤ z * w,
  { mono with [0 ≤ z,0 ≤ y],
    { guard_target 0 ≤ z, admit },
    { guard_target 0 ≤ y, admit },
    guard_target' x ≤ z, admit,
    guard_target' y ≤ w, admit },
  trivial
end

example {x y z w : Prop} : true :=
begin
  have : x ∧ y → z ∧ w,
  { mono,
    guard_target' x → z, admit,
    guard_target' y → w, admit },
  trivial
end

example {x y z w : Prop} : true :=
begin
  have : x ∨ y → z ∨ w,
  { mono,
    guard_target' x → z, admit,
    guard_target' y → w, admit },
  trivial
end

example {x y z w : ℤ} : true :=
begin
  suffices : x + y < w + z, trivial,
  have : x < w, admit,
  have : y ≤ z, admit,
  mono right,
end

example {x y z w : ℤ} : true :=
begin
  suffices : x * y < w * z, trivial,
  have : x < w, admit,
  have : y ≤ z, admit,
  mono right,
  { guard_target' 0 < y, admit },
  { guard_target' 0 ≤ w, admit },
end

open tactic

example (x y : ℕ)
  (h : x ≤ y)
: true :=
begin
  (do v ← mk_mvar,
      p ← to_expr ```(%%v + x ≤ y + %%v),
      assert `h' p),
  ac_mono := h,
  trivial,
  exact 3
end

example {α} [linear_order α]
  (a b c d e : α) :
  max a b ≤ e → b ≤ e :=
by { mono, apply le_max_right }

example (a b c d e : Prop)
  (h : d → a) (h' : c → e) :
  (a ∧ b → c) ∨ d → (d ∧ b → e) ∨ a :=
begin
  mono,
  mono,
  mono,
end

example : ∫ x in Icc 0 1, real.exp x ≤ ∫ x in Icc 0 1, real.exp (x+1) :=
begin
  mono,
  { exact real.continuous_exp.integrable_on_compact is_compact_Icc },
  { exact (real.continuous_exp.comp $ continuous_add_right 1).integrable_on_compact
      is_compact_Icc },
  intro x,
  dsimp only,
  mono,
  linarith
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.lattice

/-!
# Relations holding pairwise on finite sets

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

In this file we prove a few results about the interaction of `set.pairwise_disjoint` and `finset`,
as well as the interaction of `list.pairwise disjoint` and the condition of
`disjoint` on `list.to_finset`, in `set` form.
-/

open finset

variables {α ι ι' : Type*}

instance [decidable_eq α] {r : α → α → Prop} [decidable_rel r] {s : finset α} :
  decidable ((s : set α).pairwise r) :=
decidable_of_iff' (∀ a ∈ s, ∀ b ∈ s, a ≠ b → r a b) iff.rfl

lemma finset.pairwise_disjoint_range_singleton :
  (set.range (singleton : α → finset α)).pairwise_disjoint id :=
begin
  rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h,
  exact disjoint_singleton.2 (ne_of_apply_ne _ h),
end

namespace set

lemma pairwise_disjoint.elim_finset {s : set ι} {f : ι → finset α}
  (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i)
  (haj : a ∈ f j) :
  i = j :=
hs.elim hi hj (finset.not_disjoint_iff.2 ⟨a, hai, haj⟩)

variables [lattice α] [order_bot α]

/-- Bind operation for `set.pairwise_disjoint`. In a complete lattice, you can use
`set.pairwise_disjoint.bUnion`. -/
lemma pairwise_disjoint.bUnion_finset {s : set ι'} {g : ι' → finset ι} {f : ι → α}
  (hs : s.pairwise_disjoint (λ i' : ι', (g i').sup f))
  (hg : ∀ i ∈ s, (g i : set ι).pairwise_disjoint f) :
  (⋃ i ∈ s, ↑(g i)).pairwise_disjoint f :=
begin
  rintro a ha b hb hab,
  simp_rw set.mem_Union at ha hb,
  obtain ⟨c, hc, ha⟩ := ha,
  obtain ⟨d, hd, hb⟩ := hb,
  obtain hcd | hcd := eq_or_ne (g c) (g d),
  { exact hg d hd (by rwa hcd at ha) hb hab },
  { exact (hs hc hd (ne_of_apply_ne _ hcd)).mono (finset.le_sup ha) (finset.le_sup hb) }
end

end set

namespace list
variables {β : Type*} [decidable_eq α] {r : α → α → Prop} {l : list α}

lemma pairwise_of_coe_to_finset_pairwise (hl : (l.to_finset : set α).pairwise r) (hn : l.nodup) :
  l.pairwise r :=
by { rw coe_to_finset at hl, exact hn.pairwise_of_set_pairwise hl }

lemma pairwise_iff_coe_to_finset_pairwise (hn : l.nodup) (hs : symmetric r) :
  (l.to_finset : set α).pairwise r ↔ l.pairwise r :=
by { rw [coe_to_finset, hn.pairwise_coe], exact ⟨hs⟩ }

lemma pairwise_disjoint_of_coe_to_finset_pairwise_disjoint {α ι}
  [semilattice_inf α] [order_bot α] [decidable_eq ι] {l : list ι} {f : ι → α}
  (hl : (l.to_finset : set ι).pairwise_disjoint f) (hn : l.nodup) :
  l.pairwise (_root_.disjoint on f) :=
pairwise_of_coe_to_finset_pairwise hl hn

lemma pairwise_disjoint_iff_coe_to_finset_pairwise_disjoint {α ι}
  [semilattice_inf α] [order_bot α] [decidable_eq ι] {l : list ι} {f : ι → α} (hn : l.nodup) :
  (l.to_finset : set ι).pairwise_disjoint f ↔ l.pairwise (_root_.disjoint on f) :=
pairwise_iff_coe_to_finset_pairwise hn (symmetric_disjoint.comap f)

end list


/-
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ä
-/
import data.is_R_or_C.basic
import analysis.normed_space.operator_norm
import analysis.normed_space.pointwise

/-!
# Normed spaces over R or C

This file is about results on normed spaces over the fields `ℝ` and `ℂ`.

## Main definitions

None.

## Main theorems

* `continuous_linear_map.op_norm_bound_of_ball_bound`: A bound on the norms of values of a linear
  map in a ball yields a bound on the operator norm.

## Notes

This file exists mainly to avoid importing `is_R_or_C` in the main normed space theory files.
-/

open metric

variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_add_comm_group E]

lemma is_R_or_C.norm_coe_norm {z : E} : ‖(‖z‖ : 𝕜)‖ = ‖z‖ := by simp

variables [normed_space 𝕜 E]

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to unit length. -/
@[simp] lemma norm_smul_inv_norm {x : E} (hx : x ≠ 0) : ‖(‖x‖⁻¹ : 𝕜) • x‖ = 1 :=
begin
  have : ‖x‖ ≠ 0 := by simp [hx],
  field_simp [norm_smul]
end

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to length `r`. -/
lemma norm_smul_inv_norm' {r : ℝ} (r_nonneg : 0 ≤ r) {x : E} (hx : x ≠ 0) :
  ‖(r * ‖x‖⁻¹ : 𝕜) • x‖ = r :=
begin
  have : ‖x‖ ≠ 0 := by simp [hx],
  field_simp [norm_smul, is_R_or_C.norm_eq_abs, r_nonneg] with is_R_or_C_simps
end

lemma linear_map.bound_of_sphere_bound
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜) (h : ∀ z ∈ sphere (0 : E) r, ‖f z‖ ≤ c) (z : E) :
  ‖f z‖ ≤ c / r * ‖z‖ :=
begin
  by_cases z_zero : z = 0,
  { rw z_zero, simp only [linear_map.map_zero, norm_zero, mul_zero], },
  set z₁ := (r * ‖z‖⁻¹ : 𝕜) • z with hz₁,
  have norm_f_z₁ : ‖f z₁‖ ≤ c,
  { apply h,
    rw mem_sphere_zero_iff_norm,
    exact norm_smul_inv_norm' r_pos.le z_zero },
  have r_ne_zero : (r : 𝕜) ≠ 0 := is_R_or_C.of_real_ne_zero.mpr r_pos.ne',
  have eq : f z = ‖z‖ / r * (f z₁),
  { rw [hz₁, linear_map.map_smul, smul_eq_mul],
    rw [← mul_assoc, ← mul_assoc, div_mul_cancel _ r_ne_zero, mul_inv_cancel, one_mul],
    simp only [z_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero, ne.def, not_false_iff], },
  rw [eq, norm_mul, norm_div, is_R_or_C.norm_coe_norm,
      is_R_or_C.norm_of_nonneg r_pos.le, div_mul_eq_mul_div, div_mul_eq_mul_div, mul_comm],
  apply div_le_div _ _ r_pos rfl.ge,
  { exact mul_nonneg ((norm_nonneg _).trans norm_f_z₁) (norm_nonneg z), },
  apply mul_le_mul norm_f_z₁ rfl.le (norm_nonneg z) ((norm_nonneg _).trans norm_f_z₁),
end

/--
`linear_map.bound_of_ball_bound` is a version of this over arbitrary nontrivially normed fields.
It produces a less precise bound so we keep both versions. -/
lemma linear_map.bound_of_ball_bound' {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜)
  (h : ∀ z ∈ closed_ball (0 : E) r, ‖f z‖ ≤ c) (z : E) :
  ‖f z‖ ≤ c / r * ‖z‖ :=
f.bound_of_sphere_bound r_pos c (λ z hz, h z hz.le) z

lemma continuous_linear_map.op_norm_bound_of_ball_bound
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →L[𝕜] 𝕜) (h : ∀ z ∈ closed_ball (0 : E) r, ‖f z‖ ≤ c) :
  ‖f‖ ≤ c / r :=
begin
  apply continuous_linear_map.op_norm_le_bound,
  { apply div_nonneg _ r_pos.le,
    exact (norm_nonneg _).trans
          (h 0 (by simp only [norm_zero, mem_closed_ball, dist_zero_left, r_pos.le])), },
  apply linear_map.bound_of_ball_bound' r_pos,
  exact λ z hz, h z hz,
end

variables (𝕜)
include 𝕜
lemma normed_space.sphere_nonempty_is_R_or_C [nontrivial E] {r : ℝ} (hr : 0 ≤ r) :
  nonempty (sphere (0:E) r) :=
begin
  letI : normed_space ℝ E := normed_space.restrict_scalars ℝ 𝕜 E,
  exact (normed_space.sphere_nonempty.mpr hr).coe_sort,
end


/-
  A ring with the localization property at a prime ideal is a local ring.
-/

import ring_theory.ideals
import ring_theory.localization
import to_mathlib.localization.localization_alt

universes u v

local attribute [instance] classical.prop_decidable

open localization_alt

variables {α : Type u} {β : Type v} [comm_ring α] [comm_ring β]
variables {f : α → β} [is_ring_hom f]
variables {P : ideal α} (HP : ideal.is_prime P)
variables (Hloc : is_localization_data (-P : set α) f)

include Hloc

lemma local_ring.of_is_localization_data_at_prime : local_ring β :=
begin
  apply local_of_nonunits_ideal,
  { -- 0 ≠ 1.
    intros HC,
    rw ←is_ring_hom.map_one f at HC,
    have Hone : (1 : α) ∈ ker f := HC.symm,
    replace Hone := Hloc.ker_le Hone,
    rcases Hone with ⟨⟨⟨u, ⟨v, HvnP⟩⟩, Huv⟩, Heq⟩,
    dsimp at Huv,
    dsimp at Heq,
    rw Heq at Huv,
    have Hzero : (0 : α) ∈ P := ideal.zero_mem P,
    rw ←Huv at Hzero,
    cases (HP.2 Hzero) with Hone Hv,
    { apply HP.1,
      rw ideal.eq_top_iff_one,
      exact Hone, },
    { change v ∉ P at HvnP,
      exact (HvnP Hv), }, },
  { -- x and y nonunits then x + y is not a unit.
    intros x y Hx Hy HC,
    change ¬is_unit x at Hx,
    change ¬is_unit y at Hy,
    rcases is_unit_iff_exists_inv.1 HC with ⟨inv, Hinv⟩,
    rcases Hloc.has_denom x with ⟨⟨⟨q₁, Hq₁⟩, p₁⟩, Hp₁q₁⟩,
    rcases Hloc.has_denom y with ⟨⟨⟨q₂, Hq₂⟩, p₂⟩, Hp₂q₂⟩,
    rcases Hloc.has_denom inv with ⟨⟨⟨q₃, Hq₃⟩, p₃⟩, Hp₃q₃⟩,
    change q₁ ∉ P at Hq₁,
    change q₂ ∉ P at Hq₂,
    change q₃ ∉ P at Hq₃,
    change f q₁ * x = f p₁ at Hp₁q₁,
    change f q₂ * y = f p₂ at Hp₂q₂,
    change f q₃ * inv = f p₃ at Hp₃q₃,
    have Hp₁P : p₁ ∈ P,
      by_contra Hp₁,
      apply Hx,
      rcases (Hloc.inverts ⟨p₁, Hp₁⟩) with ⟨w₁, Hw₁⟩,
      change f p₁ * w₁ = 1 at Hw₁,
      apply is_unit_of_mul_one x (f q₁ * w₁),
      rw [←mul_assoc, mul_comm x, Hp₁q₁],
      exact Hw₁,
    have Hp₂P : p₂ ∈ P,
      by_contra Hp₂,
      apply Hy,
      rcases (Hloc.inverts ⟨p₂, Hp₂⟩) with ⟨w₂, Hw₂⟩,
      change f p₂ * w₂ = 1 at Hw₂,
      apply is_unit_of_mul_one y (f q₂ * w₂),
      rw [←mul_assoc, mul_comm y, Hp₂q₂],
      exact Hw₂,
    have Hp₃q₂p₁P : p₃ * q₂ * p₁ ∈ P := ideal.mul_mem_left P Hp₁P,
    have Hp₃q₁p₂P : p₃ * q₁ * p₂ ∈ P := ideal.mul_mem_left P Hp₂P,
    have Hmem := (ideal.neg_mem_iff P).2 (ideal.add_mem P Hp₃q₂p₁P Hp₃q₁p₂P),
    have Hq₁q₂q₃nP : q₁ * q₂ * q₃ ∉ P,
      intros HC,
      cases (HP.2 HC) with HC₁₂ HC₃,
      { cases (HP.2 HC₁₂) with HC₁ HC₂,
        { exact (Hq₁ HC₁), },
        { exact (Hq₂ HC₂), } },
      { exact (Hq₃ HC₃), },
    have Hzero : f (q₁ * q₂ * q₃ + -(p₃ * q₂ * p₁ + p₃ * q₁ * p₂)) = 0,
      rw [←sub_eq_add_neg, is_ring_hom.map_sub f, sub_eq_zero, is_ring_hom.map_add f],
      iterate 6 { rw is_ring_hom.map_mul f, },
      iterate 2 { rw mul_assoc (f p₃), },
      rw [←mul_add (f p₃), ←Hp₃q₃, mul_comm (f q₃ * inv), mul_comm (f q₃), ←mul_assoc _ inv],
      rw [←Hp₁q₁, ←mul_assoc (f q₂), mul_comm (f q₂)],
      rw [←Hp₂q₂, ←mul_assoc (f q₁)],
      rw [←mul_add (f q₁ * f q₂), mul_assoc _ (x + y) inv, Hinv, mul_one],
    rcases (Hloc.ker_le Hzero) with ⟨⟨⟨u, ⟨v, HvnP⟩⟩, Huv⟩, Helem⟩,
    change v ∉ P at HvnP,
    dsimp only [subtype.coe_mk] at Huv,
    dsimp only [subtype.coe_mk] at Helem,
    rw Helem at Huv; clear Helem,
    cases (HP.mem_or_mem_of_mul_eq_zero Huv) with Helem HvP,
    { rw ideal.add_mem_iff_left P Hmem at Helem,
      exact (Hq₁q₂q₃nP Helem), },
    { exact (HvnP HvP), } }
end


import tactic

variable (Man : Type)
variable (shaves : Man → Man → Prop)

-- 1ª demostración
example
  ( h : ∃ x : Man,  ∀ y : Man, shaves x y ↔ ¬ shaves y y )
  : false :=
exists.elim h
( assume barber,
  begin
    intro h,
    have hbarbermpr : ¬shaves barber barber → shaves barber barber,
        from iff.mpr (h barber),
    have hbarbermp  : shaves barber barber → ¬shaves barber barber,
        from iff.mp (h barber),
    have nsbb : ¬shaves barber barber, from
        assume sbb : shaves barber barber,
        show false, from hbarbermp sbb sbb,
    show false, from nsbb (hbarbermpr nsbb)
  end )

-- 2ª demostración
example
  ( h : ∃ x : Man,  ∀ y : Man, shaves x y ↔ ¬ shaves y y )
  : false :=
exists.elim h
  ( assume barber,
    begin
        intro h2,
        have hbarber := h2 barber,
        tauto!,
    end )

-- 3ª demostración
-- ===============

example : ¬ (∃ x : Man,  ∀ y : Man, shaves x y ↔ ¬ shaves y y ) :=
begin
  rintros ⟨barber, h2⟩,
  have hbarber := h2 barber,
  -- library_search,
  exact (not_iff_self (shaves barber barber)).mp (iff.symm (h2 barber)),
end

-- 4ª demostración
example : ¬ (∃ x : Man,  ∀ y : Man, shaves x y ↔ ¬ shaves y y ) :=
λ ⟨x, hx⟩, (not_iff_self _).1 (hx x).symm

-- 5ª demostración
example
  (h : ∃ x : Man, ∀ y : Man, shaves x y ↔ ¬shaves y y) :
  false :=
exists.elim h $
  assume barber : Man,
  assume h : ∀ y : Man, shaves barber y ↔ ¬shaves y y,
    have hbarber : shaves barber barber ↔ ¬shaves barber barber,
      from h barber,
    have nsbb : ¬shaves barber barber, from
      assume sbb : shaves barber barber,
      show false, from hbarber.mp sbb sbb,
    show false, from nsbb (hbarber.mpr nsbb)

-- 6ª demostración
example
  ( h : ∃ barber : Man,  ∀ m : Man, shaves barber m ↔ ¬ shaves m m )
  : false :=
begin
  obtain ⟨barber, barber_shaves_only_who_doesnt_self_shave⟩ := h,
  have self_shaving_dilemma := barber_shaves_only_who_doesnt_self_shave barber,
  have dilemma_implies_false := (iff_not_self (shaves barber barber)).mp,
  exact dilemma_implies_false self_shaving_dilemma,
end