/-
Copyright (c) 2020 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import category_theory.limits.shapes.pullbacks
import ring_theory.tensor_product
import algebra.category.CommRing.basic

/-!
# Explicit pushout cocone for CommRing

In this file we prove that tensor product is indeed the fibered coproduct in `CommRing`, and
provide the explicit pushout cocone.

-/

universe u

open category_theory
open_locale tensor_product

variables {R A B : CommRing.{u}} (f : R ⟶ A) (g : R ⟶ B)

namespace CommRing

/-- The explicit cocone with tensor products as the fibered product in `CommRing`. -/
def pushout_cocone : limits.pushout_cocone f g :=
begin
  letI := ring_hom.to_algebra f,
  letI := ring_hom.to_algebra g,
  apply limits.pushout_cocone.mk,
  show CommRing, from CommRing.of (A ⊗[R] B),
  show A ⟶ _,  from algebra.tensor_product.include_left.to_ring_hom,
  show B ⟶ _,  from algebra.tensor_product.include_right.to_ring_hom,
  ext r,
  transitivity algebra_map R (A ⊗[R] B) r,
  exact algebra.tensor_product.include_left.commutes r,
  exact (algebra.tensor_product.include_right.commutes r).symm,
end

@[simp]
lemma pushout_cocone_inl : (pushout_cocone f g).inl = (by
{ letI := f.to_algebra, letI := g.to_algebra,
  exactI algebra.tensor_product.include_left.to_ring_hom }) := rfl

@[simp]
lemma pushout_cocone_inr : (pushout_cocone f g).inr = (by
{ letI := f.to_algebra, letI := g.to_algebra,
  exactI algebra.tensor_product.include_right.to_ring_hom }) := rfl

@[simp]
lemma pushout_cocone_X : (pushout_cocone f g).X = (by
{ letI := f.to_algebra, letI := g.to_algebra,
  exactI CommRing.of (A ⊗[R] B) }) := rfl

/-- Verify that the `pushout_cocone` is indeed the colimit. -/
def pushout_cocone_is_colimit : limits.is_colimit (pushout_cocone f g) :=
limits.pushout_cocone.is_colimit_aux' _ (λ s,
begin
  letI := ring_hom.to_algebra f,
  letI := ring_hom.to_algebra g,
  letI := ring_hom.to_algebra (f ≫ s.inl),
  let f' : A →ₐ[R] s.X := { commutes' := λ r, by
      { change s.inl.to_fun (f r) = (f ≫ s.inl) r, refl }, ..s.inl },
  let g' : B →ₐ[R] s.X := { commutes' := λ r, by
      { change (g ≫ s.inr) r = (f ≫ s.inl) r,
        congr' 1,
        exact (s.ι.naturality limits.walking_span.hom.snd).trans
          (s.ι.naturality limits.walking_span.hom.fst).symm }, ..s.inr },
  /- The factor map is a ⊗ b ↦ f(a) * g(b). -/
  use alg_hom.to_ring_hom (algebra.tensor_product.product_map f' g'),
  simp only [pushout_cocone_inl, pushout_cocone_inr],
  split, { ext x, exact algebra.tensor_product.product_map_left_apply  _ _ x, },
  split, { ext x, exact algebra.tensor_product.product_map_right_apply _ _ x, },
  intros h eq1 eq2,
  let h' : (A ⊗[R] B) →ₐ[R] s.X :=
    { commutes' := λ r, by
    { change h ((f r) ⊗ₜ[R] 1) = s.inl (f r),
      rw ← eq1, simp }, ..h },
  suffices : h' = algebra.tensor_product.product_map f' g',
  { ext x,
    change h' x = algebra.tensor_product.product_map f' g' x,
    rw this },
  apply algebra.tensor_product.ext,
  intros a b,
  simp [← eq1, ← eq2, ← h.map_mul],
end)

end CommRing


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Std.Data.Nat.Lemmas

import Algdata.Init.Logic

namespace Nat

instance instNatLEDecidableRel : DecidableRel Nat.le := λ m n =>
  match m with
  | zero => Decidable.isTrue n.zero_le
  | succ m =>
    match n with
    | zero => Decidable.isFalse m.not_lt_zero
    | succ n =>
      match instNatLEDecidableRel m n with
      | isTrue h => Decidable.isTrue (Nat.succ_le_succ h)
      | isFalse h => Decidable.isFalse $ λ hcontra =>
        h (Nat.le_of_succ_le_succ hcontra)

instance instNatLTDecidableRel : DecidableRel Nat.lt := λ m n =>
  instNatLEDecidableRel m.succ n

theorem le_iff_eq_or_lt {m n : Nat} : m ≤ n ↔ (m = n ∨ m < n) where
  mp hle := by
    cases Nat.lt_or_ge m n
    case inl h => exact Or.inr h
    case inr h => exact Or.inl $ Nat.le_antisymm hle h
  mpr hor := by
    cases hor
    case inl heq => cases heq; simp
    case inr hlt => exact Nat.le_of_lt hlt

theorem ge_iff_eq_or_gt {m n : Nat} : m ≥ n ↔ (m = n ∨ m > n) :=
  Iff.trans le_iff_eq_or_lt $ Or.substIff (Iff.intro Eq.symm Eq.symm) (Iff.refl _)

theorem lt_iff_ne_and_ngt {m n : Nat} : m < n ↔ (m ≠ n ∧ ¬ m > n) where
  mp hlt := by
    constructor
    case left => exact ne_of_lt hlt
    case right =>
      rw [Nat.not_lt_eq]; exact Nat.le_of_lt hlt
  mpr hand := by
    cases Nat.lt_or_ge m n
    case inl hlt => exact hlt
    case inr hge =>
      apply False.elim
      cases le_iff_eq_or_lt.mp hge
      case inl heq =>
        exact hand.left heq.symm
      case inr hgt =>
        exact hand.right hgt

protected
theorem min_eq_right' {m n : Nat} (h : m ≥ n) : min m n = n := by
  rw [Nat.min_def]
  by_cases m ≤ n
  case pos hle =>
    have : m = n := Nat.le_antisymm hle h
    rw [if_pos hle, this]
  case neg hnle =>
    rw [if_neg hnle]

theorem min_succ_succ' (m n : Nat) : min m.succ n.succ = (min m n).succ := by
  by_cases m ≤ n
  case pos hle =>
    rw [Nat.min_eq_left hle, Nat.min_eq_left (Nat.succ_le_succ hle)]
  case neg hnle =>
    have : m ≥ n := Nat.le_of_lt (Nat.gt_of_not_le hnle)
    rw [Nat.min_eq_right' this, Nat.min_eq_right' (Nat.succ_le_succ this)]

theorem min_eq (n : Nat) : min n n = n := Nat.min_eq_left n.le_refl

theorem add_sub_assoc' {m k : Nat} : m ≤ k → ∀ (n : Nat), n + m - k = n - (k - m) := by
  intro hmk n
  have : k = (k-m) + m := Eq.symm $ Nat.sub_add_cancel hmk
  conv => lhs; rw [this, Nat.add_sub_add_right]

theorem lt_add_succ (n k : Nat) : n < n + k.succ := calc
  n ≤ n + k := Nat.le_add_right n k
  _ < (n+k).succ := Nat.lt_succ_self _
  _ = n + k.succ := Nat.add_succ n k

theorem lt_of_add_succ_eq {m k n : Nat} : m + k.succ = n → m < n := fun h =>
  calc
    m < m + k.succ := lt_add_succ m k
    _ = n := h

theorem not_lt_of_ge {m n : Nat} : m ≥ n → ¬(m < n) := by
  intro h hn
  exact Nat.not_le_of_gt hn h

theorem one_le_succ (n : Nat) : 1 ≤ n.succ :=
  n.casesOn (motive:=λ n => 1 ≤ n.succ) le.refl (λ n => Nat.succ_le_succ (zero_le n.succ))

theorem gt_zero_of_not_eq_zero {n : Nat} : n ≠ 0 → n > 0 :=
  n.casesOn (motive:=λ k => k≠0 → k > 0)
    (λ h => (h rfl).elim)
    (λ _ _ => Nat.zero_lt_succ _)

theorem ge_one_of_not_eq_zero {n : Nat} : n ≠ 0 → n ≥ 1 :=
  n.casesOn (motive:=λ n => n≠ 0 → n ≥ 1)
    (λ h => (h rfl).elim)
    (λ _ _ => one_le_succ _)

theorem add_pred {m n : Nat} : n > 0 → m + n.pred = (m+n).pred := by
  intro hn
  cases n
  case zero =>
    exact (zero.not_lt_zero hn).elim
  case succ n =>
    simp [Nat.add_succ]

theorem sub_lt_of_lt_add {l m n : Nat} : l ≥ n → l < m + n → l-n < m := by
  intro hln hlmn
  apply Nat.lt_of_add_lt_add_right
  rw [Nat.sub_add_cancel hln]
  assumption

theorem mod_mul_mod (a b n : Nat) : a % n * b % n = (a*b)%n :=
  Eq.symm $ calc
    a * b % n = (n*(a/n) + a % n) * b % n := by conv => lhs; rw [←Nat.div_add_mod a n]
    _         = (n * (a/n * b) + a % n * b) % n := by rw [Nat.right_distrib, Nat.mul_assoc]
    _         = a % n * b % n := by rw [Nat.add_comm,Nat.add_mul_mod_self_left]

theorem div_mod_unique (n : Nat) : ∀ {q₁ q₂ r₁ r₂ : Nat}, r₁ < n → r₂ < n → q₁*n + r₁ = q₂*n + r₂ → q₁=q₂ ∧ r₁=r₂ := by
  intros q₁ q₂ r₁ r₂ hr₁ hr₂ heq
  suffices q₁ = q₂ by
    constructor; assumption
    rw [this] at heq
    exact Nat.add_left_cancel heq
  revert q₂
  induction q₁
  case zero =>
    intro q₂ heq
    simp at *
    rw [heq] at hr₁
    cases q₂
    case zero => rfl
    case succ k =>
      rw [succ_mul, Nat.add_comm _ n, Nat.add_assoc] at hr₁
      conv at hr₁ =>
        rhs
        rw [←Nat.add_zero n]
      have : k*n+r₂ < 0 := Nat.lt_of_add_lt_add_left (k:=n) hr₁
      exact False.elim $ not_lt_zero _ this
  case succ q₁ h_ind =>
    intro q₂ heq
    rw [succ_mul, Nat.add_comm _ n, Nat.add_assoc] at heq
    cases q₂
    case zero =>
      simp at heq
      rw [←heq] at hr₂
      conv at hr₂ =>
        rhs
        rw [←Nat.add_zero n]
      have : q₁*n + r₁ < 0 :=
        Nat.lt_of_add_lt_add_left (k:=n) hr₂
      exact False.elim $ not_lt_zero _ this
    case succ q₂=>
      conv at heq =>
        rhs
        rw [succ_mul, Nat.add_comm _ n, Nat.add_assoc]
      apply congrArg succ
      apply h_ind
      exact Nat.add_left_cancel heq

/-!
## Ordering
-/
theorem compare_lt {m n : Nat} : m < n → compare m n = Ordering.lt := by
  intro h
  simp [compare, instOrdNat, compareOfLessAndEq]
  rw [if_pos h]

theorem compare_eq {m n : Nat} : m = n → compare m n = Ordering.eq := by
  intro h; cases h
  simp [compare, instOrdNat, compareOfLessAndEq]

theorem compare_gt {m n : Nat} : m > n → compare m n = Ordering.gt := by
  intro h
  simp [compare, instOrdNat, compareOfLessAndEq]
  have := lt_iff_ne_and_ngt.mp h
  rw [if_neg this.2, if_neg (this.1 ∘ Eq.symm)]

/-!
## Bit operations
-/

theorem shiftRight_one (n : Nat) : n.shiftRight 1 = n/2 := rfl

theorem shiftRight_lt {n k : Nat} : n ≠ 0 → k > 0 → n.shiftRight k < n := by
  intro hn hk
  induction k
  case zero => exact absurd hk (Nat.lt_irrefl 0)
  case succ k h_ind =>
    unfold shiftRight
    cases Nat.eq_zero_or_pos k
    case inl h =>
      cases h; dsimp [shiftRight]
      exact Nat.div_lt_self (Nat.zero_lt_of_ne_zero hn) (Nat.lt_succ_self 1)
    case inr h =>
      calc
        shiftRight n k / 2
          ≤ shiftRight n k := Nat.div_le_self _ _
        _ < n := h_ind h

theorem land_zero {n : Nat} : n.land 0 = 0 := by
  unfold land; unfold bitwise
  rw [Bool.false_and, Bool.and_false]
  have : false ≠ true := (λ h => Bool.noConfusion h); rw [if_neg this, if_neg this]
  rw [if_pos rfl]
  cases n
  case zero => rw [if_pos rfl]
  case succ _ => rw [if_neg (Nat.succ_ne_zero _)]

theorem land_one {n : Nat} : n.land 1 = n % 2 := by
  unfold land; unfold bitwise
  rw [Bool.false_and, Bool.and_false]
  have : false ≠ true := (λ h => by cases h); rw [if_neg this, if_neg this]
  rw [if_neg Nat.one_ne_zero]
  dsimp
  have : 1 % 2 = 1 := rfl; rw [this]
  rw [decide_eq_true (p:=1=1) rfl]
  rw [Bool.and_true]
  have : 1 / 2 = 0 := rfl; rw [this]
  have : bitwise and (n/2) 0 = 0 := Nat.land_zero
  rw [this, Nat.zero_add, Nat.zero_add]
  cases n
  case zero => rfl
  case succ n =>
    rw [if_neg (Nat.succ_ne_zero n)]
    have mod_two_eq_zero_or_one : ∀ (m : Nat), m % 2 = 0 ∨ m % 2 = 1 :=by
      intro m
      cases Nat.eq_zero_or_pos (m % 2)
      case inl hzero => exact Or.inl hzero
      case inr hpos =>
        have : m % 2 ≥ 1 := Nat.succ_le_of_lt hpos
        have : m % 2 < 2 := Nat.mod_lt m (y:=2) (Nat.zero_lt_succ 1)
        have : m % 2 ≤ 1 := Nat.le_of_lt_succ this
        exact Or.inr (Nat.le_antisymm this ‹m % 2 ≥ 1›)
    by_cases n.succ % 2 = 1
    case pos hn => rw [decide_eq_true hn, if_pos rfl]; exact hn.symm
    case neg hn =>
      rw [decide_eq_false hn, if_neg ‹false ≠ true›]
      have : succ n % 2 = 0 := Or.resolve_right (mod_two_eq_zero_or_one _) hn
      exact this.symm

end Nat


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

! This file was ported from Lean 3 source module topology.metric_space.holder
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.MetricSpace.Lipschitz
import Mathbin.Analysis.SpecialFunctions.Pow

/-!
# Hölder continuous functions

In this file we define Hölder continuity on a set and on the whole space. We also prove some basic
properties of Hölder continuous functions.

## Main definitions

* `holder_on_with`: `f : X → Y` is said to be *Hölder continuous* with constant `C : ℝ≥0` and
  exponent `r : ℝ≥0` on a set `s`, if `edist (f x) (f y) ≤ C * edist x y ^ r` for all `x y ∈ s`;
* `holder_with`: `f : X → Y` is said to be *Hölder continuous* with constant `C : ℝ≥0` and exponent
  `r : ℝ≥0`, if `edist (f x) (f y) ≤ C * edist x y ^ r` for all `x y : X`.

## Implementation notes

We use the type `ℝ≥0` (a.k.a. `nnreal`) for `C` because this type has coercion both to `ℝ` and
`ℝ≥0∞`, so it can be easily used both in inequalities about `dist` and `edist`. We also use `ℝ≥0`
for `r` to ensure that `d ^ r` is monotone in `d`. It might be a good idea to use
`ℝ>0` for `r` but we don't have this type in `mathlib` (yet).

## Tags

Hölder continuity, Lipschitz continuity

 -/

variable {X Y Z : Type _}

open Filter Set

open NNReal ENNReal Topology

section Emetric

variable [PseudoEMetricSpace X] [PseudoEMetricSpace Y] [PseudoEMetricSpace Z]

/-- A function `f : X → Y` between two `pseudo_emetric_space`s is Hölder continuous with constant
`C : ℝ≥0` and exponent `r : ℝ≥0`, if `edist (f x) (f y) ≤ C * edist x y ^ r` for all `x y : X`. -/
def HolderWith (C r : ℝ≥0) (f : X → Y) : Prop :=
  ∀ x y, edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ)
#align holder_with HolderWith

/-- A function `f : X → Y` between two `pseudo_emeteric_space`s is Hölder continuous with constant
`C : ℝ≥0` and exponent `r : ℝ≥0` on a set `s : set X`, if `edist (f x) (f y) ≤ C * edist x y ^ r`
for all `x y ∈ s`. -/
def HolderOnWith (C r : ℝ≥0) (f : X → Y) (s : Set X) : Prop :=
  ∀ x ∈ s, ∀ y ∈ s, edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ)
#align holder_on_with HolderOnWith

@[simp]
theorem holderOnWith_empty (C r : ℝ≥0) (f : X → Y) : HolderOnWith C r f ∅ := fun x hx => hx.elim
#align holder_on_with_empty holderOnWith_empty

@[simp]
theorem holderOnWith_singleton (C r : ℝ≥0) (f : X → Y) (x : X) : HolderOnWith C r f {x} :=
  by
  rintro a (rfl : a = x) b (rfl : b = a)
  rw [edist_self]
  exact zero_le _
#align holder_on_with_singleton holderOnWith_singleton

theorem Set.Subsingleton.holderOnWith {s : Set X} (hs : s.Subsingleton) (C r : ℝ≥0) (f : X → Y) :
    HolderOnWith C r f s :=
  hs.inductionOn (holderOnWith_empty C r f) (holderOnWith_singleton C r f)
#align set.subsingleton.holder_on_with Set.Subsingleton.holderOnWith

theorem holderOnWith_univ {C r : ℝ≥0} {f : X → Y} : HolderOnWith C r f univ ↔ HolderWith C r f := by
  simp only [HolderOnWith, HolderWith, mem_univ, true_imp_iff]
#align holder_on_with_univ holderOnWith_univ

@[simp]
theorem holderOnWith_one {C : ℝ≥0} {f : X → Y} {s : Set X} :
    HolderOnWith C 1 f s ↔ LipschitzOnWith C f s := by
  simp only [HolderOnWith, LipschitzOnWith, NNReal.coe_one, ENNReal.rpow_one]
#align holder_on_with_one holderOnWith_one

alias holderOnWith_one ↔ _ LipschitzOnWith.holderOnWith
#align lipschitz_on_with.holder_on_with LipschitzOnWith.holderOnWith

@[simp]
theorem holderWith_one {C : ℝ≥0} {f : X → Y} : HolderWith C 1 f ↔ LipschitzWith C f :=
  holderOnWith_univ.symm.trans <| holderOnWith_one.trans lipschitz_on_univ
#align holder_with_one holderWith_one

alias holderWith_one ↔ _ LipschitzWith.holderWith
#align lipschitz_with.holder_with LipschitzWith.holderWith

theorem holderWith_id : HolderWith 1 1 (id : X → X) :=
  LipschitzWith.id.HolderWith
#align holder_with_id holderWith_id

protected theorem HolderWith.holderOnWith {C r : ℝ≥0} {f : X → Y} (h : HolderWith C r f)
    (s : Set X) : HolderOnWith C r f s := fun x _ y _ => h x y
#align holder_with.holder_on_with HolderWith.holderOnWith

namespace HolderOnWith

variable {C r : ℝ≥0} {f : X → Y} {s t : Set X}

theorem edist_le (h : HolderOnWith C r f s) {x y : X} (hx : x ∈ s) (hy : y ∈ s) :
    edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ) :=
  h x hx y hy
#align holder_on_with.edist_le HolderOnWith.edist_le

theorem edist_le_of_le (h : HolderOnWith C r f s) {x y : X} (hx : x ∈ s) (hy : y ∈ s) {d : ℝ≥0∞}
    (hd : edist x y ≤ d) : edist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
  (h.edist_le hx hy).trans (mul_le_mul_left' (ENNReal.rpow_le_rpow hd r.coe_nonneg) _)
#align holder_on_with.edist_le_of_le HolderOnWith.edist_le_of_le

theorem comp {Cg rg : ℝ≥0} {g : Y → Z} {t : Set Y} (hg : HolderOnWith Cg rg g t) {Cf rf : ℝ≥0}
    {f : X → Y} (hf : HolderOnWith Cf rf f s) (hst : MapsTo f s t) :
    HolderOnWith (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) s :=
  by
  intro x hx y hy
  rw [ENNReal.coe_mul, mul_comm rg, NNReal.coe_mul, ENNReal.rpow_mul, mul_assoc, ←
    ENNReal.coe_rpow_of_nonneg _ rg.coe_nonneg, ← ENNReal.mul_rpow_of_nonneg _ _ rg.coe_nonneg]
  exact hg.edist_le_of_le (hst hx) (hst hy) (hf.edist_le hx hy)
#align holder_on_with.comp HolderOnWith.comp

theorem comp_holderWith {Cg rg : ℝ≥0} {g : Y → Z} {t : Set Y} (hg : HolderOnWith Cg rg g t)
    {Cf rf : ℝ≥0} {f : X → Y} (hf : HolderWith Cf rf f) (ht : ∀ x, f x ∈ t) :
    HolderWith (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) :=
  holderOnWith_univ.mp <| hg.comp (hf.HolderOnWith univ) fun x _ => ht x
#align holder_on_with.comp_holder_with HolderOnWith.comp_holderWith

/-- A Hölder continuous function is uniformly continuous -/
protected theorem uniformContinuousOn (hf : HolderOnWith C r f s) (h0 : 0 < r) :
    UniformContinuousOn f s :=
  by
  refine' EMetric.uniformContinuousOn_iff.2 fun ε εpos => _
  have : tendsto (fun d : ℝ≥0∞ => (C : ℝ≥0∞) * d ^ (r : ℝ)) (𝓝 0) (𝓝 0) :=
    ENNReal.tendsto_const_mul_rpow_nhds_zero_of_pos ENNReal.coe_ne_top h0
  rcases ennreal.nhds_zero_basis.mem_iff.1 (this (gt_mem_nhds εpos)) with ⟨δ, δ0, H⟩
  exact ⟨δ, δ0, fun x hx y hy h => (hf.edist_le hx hy).trans_lt (H h)⟩
#align holder_on_with.uniform_continuous_on HolderOnWith.uniformContinuousOn

protected theorem continuousOn (hf : HolderOnWith C r f s) (h0 : 0 < r) : ContinuousOn f s :=
  (hf.UniformContinuousOn h0).ContinuousOn
#align holder_on_with.continuous_on HolderOnWith.continuousOn

protected theorem mono (hf : HolderOnWith C r f s) (ht : t ⊆ s) : HolderOnWith C r f t :=
  fun x hx y hy => hf.edist_le (ht hx) (ht hy)
#align holder_on_with.mono HolderOnWith.mono

theorem ediam_image_le_of_le (hf : HolderOnWith C r f s) {d : ℝ≥0∞} (hd : EMetric.diam s ≤ d) :
    EMetric.diam (f '' s) ≤ C * d ^ (r : ℝ) :=
  EMetric.diam_image_le_iff.2 fun x hx y hy =>
    hf.edist_le_of_le hx hy <| (EMetric.edist_le_diam_of_mem hx hy).trans hd
#align holder_on_with.ediam_image_le_of_le HolderOnWith.ediam_image_le_of_le

theorem ediam_image_le (hf : HolderOnWith C r f s) :
    EMetric.diam (f '' s) ≤ C * EMetric.diam s ^ (r : ℝ) :=
  hf.ediam_image_le_of_le le_rfl
#align holder_on_with.ediam_image_le HolderOnWith.ediam_image_le

theorem ediam_image_le_of_subset (hf : HolderOnWith C r f s) (ht : t ⊆ s) :
    EMetric.diam (f '' t) ≤ C * EMetric.diam t ^ (r : ℝ) :=
  (hf.mono ht).ediam_image_le
#align holder_on_with.ediam_image_le_of_subset HolderOnWith.ediam_image_le_of_subset

theorem ediam_image_le_of_subset_of_le (hf : HolderOnWith C r f s) (ht : t ⊆ s) {d : ℝ≥0∞}
    (hd : EMetric.diam t ≤ d) : EMetric.diam (f '' t) ≤ C * d ^ (r : ℝ) :=
  (hf.mono ht).ediam_image_le_of_le hd
#align holder_on_with.ediam_image_le_of_subset_of_le HolderOnWith.ediam_image_le_of_subset_of_le

theorem ediam_image_inter_le_of_le (hf : HolderOnWith C r f s) {d : ℝ≥0∞}
    (hd : EMetric.diam t ≤ d) : EMetric.diam (f '' (t ∩ s)) ≤ C * d ^ (r : ℝ) :=
  hf.ediam_image_le_of_subset_of_le (inter_subset_right _ _) <|
    (EMetric.diam_mono <| inter_subset_left _ _).trans hd
#align holder_on_with.ediam_image_inter_le_of_le HolderOnWith.ediam_image_inter_le_of_le

theorem ediam_image_inter_le (hf : HolderOnWith C r f s) (t : Set X) :
    EMetric.diam (f '' (t ∩ s)) ≤ C * EMetric.diam t ^ (r : ℝ) :=
  hf.ediam_image_inter_le_of_le le_rfl
#align holder_on_with.ediam_image_inter_le HolderOnWith.ediam_image_inter_le

end HolderOnWith

namespace HolderWith

variable {C r : ℝ≥0} {f : X → Y}

theorem edist_le (h : HolderWith C r f) (x y : X) : edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ) :=
  h x y
#align holder_with.edist_le HolderWith.edist_le

theorem edist_le_of_le (h : HolderWith C r f) {x y : X} {d : ℝ≥0∞} (hd : edist x y ≤ d) :
    edist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
  (h.HolderOnWith univ).edist_le_of_le trivial trivial hd
#align holder_with.edist_le_of_le HolderWith.edist_le_of_le

theorem comp {Cg rg : ℝ≥0} {g : Y → Z} (hg : HolderWith Cg rg g) {Cf rf : ℝ≥0} {f : X → Y}
    (hf : HolderWith Cf rf f) : HolderWith (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) :=
  (hg.HolderOnWith univ).comp_holderWith hf fun _ => trivial
#align holder_with.comp HolderWith.comp

theorem comp_holderOnWith {Cg rg : ℝ≥0} {g : Y → Z} (hg : HolderWith Cg rg g) {Cf rf : ℝ≥0}
    {f : X → Y} {s : Set X} (hf : HolderOnWith Cf rf f s) :
    HolderOnWith (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) s :=
  (hg.HolderOnWith univ).comp hf fun _ _ => trivial
#align holder_with.comp_holder_on_with HolderWith.comp_holderOnWith

/-- A Hölder continuous function is uniformly continuous -/
protected theorem uniformContinuous (hf : HolderWith C r f) (h0 : 0 < r) : UniformContinuous f :=
  uniformContinuousOn_univ.mp <| (hf.HolderOnWith univ).UniformContinuousOn h0
#align holder_with.uniform_continuous HolderWith.uniformContinuous

protected theorem continuous (hf : HolderWith C r f) (h0 : 0 < r) : Continuous f :=
  (hf.UniformContinuous h0).Continuous
#align holder_with.continuous HolderWith.continuous

theorem ediam_image_le (hf : HolderWith C r f) (s : Set X) :
    EMetric.diam (f '' s) ≤ C * EMetric.diam s ^ (r : ℝ) :=
  EMetric.diam_image_le_iff.2 fun x hx y hy =>
    hf.edist_le_of_le <| EMetric.edist_le_diam_of_mem hx hy
#align holder_with.ediam_image_le HolderWith.ediam_image_le

end HolderWith

end Emetric

section Metric

variable [PseudoMetricSpace X] [PseudoMetricSpace Y] {C r : ℝ≥0} {f : X → Y}

namespace HolderWith

theorem nndist_le_of_le (hf : HolderWith C r f) {x y : X} {d : ℝ≥0} (hd : nndist x y ≤ d) :
    nndist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
  by
  rw [← ENNReal.coe_le_coe, ← edist_nndist, ENNReal.coe_mul, ←
    ENNReal.coe_rpow_of_nonneg _ r.coe_nonneg]
  apply hf.edist_le_of_le
  rwa [edist_nndist, ENNReal.coe_le_coe]
#align holder_with.nndist_le_of_le HolderWith.nndist_le_of_le

theorem nndist_le (hf : HolderWith C r f) (x y : X) :
    nndist (f x) (f y) ≤ C * nndist x y ^ (r : ℝ) :=
  hf.nndist_le_of_le le_rfl
#align holder_with.nndist_le HolderWith.nndist_le

theorem dist_le_of_le (hf : HolderWith C r f) {x y : X} {d : ℝ} (hd : dist x y ≤ d) :
    dist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
  by
  lift d to ℝ≥0 using dist_nonneg.trans hd
  rw [dist_nndist] at hd⊢
  norm_cast  at hd⊢
  exact hf.nndist_le_of_le hd
#align holder_with.dist_le_of_le HolderWith.dist_le_of_le

theorem dist_le (hf : HolderWith C r f) (x y : X) : dist (f x) (f y) ≤ C * dist x y ^ (r : ℝ) :=
  hf.dist_le_of_le le_rfl
#align holder_with.dist_le HolderWith.dist_le

end HolderWith

end Metric


/- LoVe Exercise 10: Denotational Semantics -/

import .love10_denotational_semantics_demo

namespace LoVe

/- Question 1: Monotonicity -/

/- Prove the following two lemmas from the lecture. -/

lemma monotone_comp {α β : Type} [partial_order α] (f g : α → set (β × β))
    (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
begin
  intros a₁ a₂ ha b hb,
  cases hb with m hm,
  cases hm,
  use m,
  apply and.intro,
  { exact hf _ _ ha hm_left },
  { exact hg _ _ ha hm_right }
end

lemma monotone_restrict {α β : Type} [partial_order α] (f : α → set (β × β))
    (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
begin
  intros a₁ a₂ ha b hb,
  cases hb,
  apply and.intro,
  { exact hb_left },
  { apply hf _ _ ha,
    exact hb_right }
end

/- Question 2: Kleene's Theorem -/

/- We can compute the fixpoint by iteration by taking the union of all finite
iterations of `f`:

    lfp f = ⋃n, f^^[n] ∅

where

    f^^[n] = f ∘ ⋯ ∘ f ∘ id

iterates the function `f` `n` times. However, the above characterization of
`lfp` only holds for continuous functions, a concept we will introduce below. -/

def iterate {α : Type} (f : α → α) : ℕ → α → α
| 0       a := a
| (n + 1) a := f (iterate n a)

notation f`^^[`n`]` := iterate f n

/- 2.1. Fill in the missing proofs below. -/

def Union {α : Type} (s : ℕ → set α) : set α :=
{a | ∃n, a ∈ s n}

lemma Union_le {α : Type} {s : ℕ → set α} (a : set α) (h : ∀i, s i ≤ a) :
  Union s ≤ a :=
begin
  intros x hx,
  cases hx with i hi,
  exact h i hi
end

/- A continuous function `f` is a function that commutes with the union of any
monotone sequence `s`: -/

def continuous {α : Type} (f : set α → set α) : Prop :=
∀s : ℕ → set α, monotone s → f (Union s) = Union (λn, f (s n))

/- We need to prove that each continuous function is monotone. To achieve this,
we will need the following sequence: -/

def bi_seq {α : Type} (a₁ a₂ : set α) : ℕ → set α
| 0       := a₁
| (n + 1) := a₂

/- For example, `bi_seq 0 1` is the sequence 0, 1, 1, 1, etc. -/

lemma monotone_bi_seq {α : Type} (a₁ a₂ : set α) (h : a₁ ≤ a₂) :
  monotone (bi_seq a₁ a₂)
| 0       0       _ := le_refl _
| 0       (n + 1) _ := h
| (n + 1) (m + 1) _ := le_refl _

lemma Union_bi_seq {α : Type} (a₁ a₂ : set α) (ha : a₁ ≤ a₂) :
  Union (bi_seq a₁ a₂) = a₂ :=
begin
  apply le_antisymm,
  { apply Union_le,
    intros n a h,
    cases n,
    { exact ha h },
    { exact h } },
  { intros a h,
    use 1,
    exact h }
end

lemma monotone_of_continuous {α : Type} (f : set α → set α)
    (hf : continuous f) :
  monotone f :=
begin
  intros a₁ a₂ ha,
  rw [← Union_bi_seq a₁ a₂ ha, hf _ (monotone_bi_seq a₁ a₂ ha)],
  { intros a ha,
    rw Union,
    use 0,
    exact ha }
end

/- 2.2. Provide the following proof, using a similar case distinction as for
`monotone_bi_seq` above. -/

lemma monotone_iterate {α : Type} (f : set α → set α) (hf : monotone f) :
  monotone (λn, f^^[n] ∅)
| 0       0       _ := le_refl _
| 0       (m + 1) _ :=
  assume h,
  false.elim
| (n + 1) (m + 1) h :=
  hf _ _ (monotone_iterate n m (nat.le_of_succ_le_succ h))

/- 2.3. Prove the main theorem. A proof sketch is given below.

We break the proof into two proofs of inclusion.

Case 1. lfp f ≤ Union (λn, f^[n] ∅): The key is to use the lemma `lfp_le`
together with continuity of `f`.

Case 2. Union (λn, f^[n] ∅) ≤ lfp f: The lemma `Union_le` gives us a natural
number `i`, on which you can perform induction. You will also need the lemma
`lfp_eq` to unfold one iteration of `lfp f`. -/

lemma lfp_Kleene {α : Type} (f : set α → set α) (hf : continuous f) :
  complete_lattice.lfp f = Union (λn, f^^[n] ∅) :=
begin
  apply le_antisymm,
  { apply complete_lattice.lfp_le _ _ _,
    rw [hf],
    { apply Union_le,
      intros n a hn,
      use n + 1,
      exact hn },
    { exact monotone_iterate f (monotone_of_continuous f hf) } },
  { apply Union_le (complete_lattice.lfp f),
    intro i,
    induction i,
    { intros a,
      exact false.elim },
    { rw [nat.succ_eq_add_one,
        complete_lattice.lfp_eq f (monotone_of_continuous f hf)],
      exact (monotone_of_continuous f hf) _ _ i_ih } }
end

/- Question 3 (**optional**): Regular Expressions -/

inductive regex (α : Type) : Type
| empty     {} : regex
| nothing   {} : regex
| atom (a : α) : regex
| concat       : regex → regex → regex
| alt          : regex → regex → regex
| star         : regex → regex

/- 3.1 (**optional**). Define a translation of regular expressions to relations.
The idea is that an atom corresponds to a relation, concatenation corresponds to
composition of relations, and alternation is union. -/

def rel_of_regex {α : Type} : regex (set (α × α)) → set (α × α)
| regex.empty          := Id α
| regex.nothing        := ∅
| (regex.atom r)       := r
| (regex.concat r₁ r₂) := rel_of_regex r₁ ◯ rel_of_regex r₂
| (regex.alt r₁ r₂)    := rel_of_regex r₁ ∪ rel_of_regex r₂
| (regex.star r)       := complete_lattice.lfp (λf, (rel_of_regex r ◯ f) ∪ Id α)

/- 3.2 (**optional**). Prove the following recursive equation about your
definition. -/

lemma rel_of_regex_star {α : Type} (r : regex (set (α × α))) :
  rel_of_regex (regex.star r) =
  rel_of_regex (regex.alt (regex.concat r (regex.star r)) regex.empty) :=
begin
  apply complete_lattice.lfp_eq _ _,
  apply monotone.union,
  { apply monotone_comp,
    { exact monotone.const _ },
    { exact monotone.id } },
  { exact monotone.const _ }
end

end LoVe


/-
Copyright (c) 2021 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import ring_theory.adjoin.basic
import linear_algebra.linear_independent
import ring_theory.mv_polynomial.basic
import data.mv_polynomial.supported
import ring_theory.algebraic
import data.mv_polynomial.equiv
/-!
# Algebraic Independence

This file defines algebraic independence of a family of element of an `R` algebra

## Main definitions

* `algebraic_independent` - `algebraic_independent R x` states the family of elements `x`
  is algebraically independent over `R`, meaning that the canonical map out of the multivariable
  polynomial ring is injective.

* `algebraic_independent.repr` - The canonical map from the subalgebra generated by an
  algebraic independent family into the polynomial ring.

## References

* [Stacks: Transcendence](https://stacks.math.columbia.edu/tag/030D)

## TODO
Prove that a ring is an algebraic extension of the subalgebra generated by a transcendence basis.

## Tags
transcendence basis, transcendence degree, transcendence

-/
noncomputable theory

open function set subalgebra mv_polynomial algebra
open_locale classical big_operators

universes x u v w

variables {ι : Type*} {ι' : Type*} (R : Type*) {K : Type*}
variables {A : Type*} {A' A'' : Type*} {V : Type u} {V' : Type*}
variables (x : ι → A)
variables [comm_ring R] [comm_ring A] [comm_ring A'] [comm_ring A'']
variables [algebra R A] [algebra R A'] [algebra R A'']
variables {a b : R}

/-- `algebraic_independent R x` states the family of elements `x`
  is algebraically independent over `R`, meaning that the canonical
  map out of the multivariable polynomial ring is injective. -/
def algebraic_independent : Prop :=
injective (mv_polynomial.aeval x : mv_polynomial ι R →ₐ[R] A)

variables {R} {x}

theorem algebraic_independent_iff_ker_eq_bot : algebraic_independent R x ↔
  (mv_polynomial.aeval x : mv_polynomial ι R →ₐ[R] A).to_ring_hom.ker = ⊥ :=
ring_hom.injective_iff_ker_eq_bot _

theorem algebraic_independent_iff : algebraic_independent R x ↔
  ∀p : mv_polynomial ι R, mv_polynomial.aeval (x : ι → A) p = 0 → p = 0 :=
injective_iff_map_eq_zero _

theorem algebraic_independent.eq_zero_of_aeval_eq_zero (h : algebraic_independent R x) :
  ∀p : mv_polynomial ι R, mv_polynomial.aeval (x : ι → A) p = 0 → p = 0 :=
algebraic_independent_iff.1 h

theorem algebraic_independent_iff_injective_aeval :
  algebraic_independent R x ↔ injective (mv_polynomial.aeval x : mv_polynomial ι R →ₐ[R] A) :=
iff.rfl

@[simp] lemma algebraic_independent_empty_type_iff [is_empty ι] :
  algebraic_independent R x ↔ injective (algebra_map R A) :=
have aeval x = (algebra.of_id R A).comp (@is_empty_alg_equiv R ι _ _).to_alg_hom,
  by { ext i, exact is_empty.elim' ‹is_empty ι› i },
begin
  rw [algebraic_independent, this,
    ← injective.of_comp_iff' _ (@is_empty_alg_equiv R ι _ _).bijective],
  refl
end

namespace algebraic_independent

variables (hx : algebraic_independent R x)

include hx

lemma algebra_map_injective : injective (algebra_map R A) :=
by simpa [← mv_polynomial.algebra_map_eq, function.comp] using
    (injective.of_comp_iff
      (algebraic_independent_iff_injective_aeval.1 hx) (mv_polynomial.C)).2
    (mv_polynomial.C_injective _ _)

lemma linear_independent : linear_independent R x :=
begin
  rw [linear_independent_iff_injective_total],
  have : finsupp.total ι A R x =
    (mv_polynomial.aeval x).to_linear_map.comp (finsupp.total ι _ R X),
  { ext, simp },
  rw this,
  refine hx.comp _,
  rw [← linear_independent_iff_injective_total],
  exact linear_independent_X _ _
end

protected lemma injective [nontrivial R] : injective x :=
hx.linear_independent.injective

lemma ne_zero [nontrivial R] (i : ι) : x i ≠ 0 :=
hx.linear_independent.ne_zero i

lemma comp (f : ι' → ι) (hf : function.injective f) : algebraic_independent R (x ∘ f) :=
λ p q, by simpa [aeval_rename, (rename_injective f hf).eq_iff] using @hx (rename f p) (rename f q)

lemma coe_range : algebraic_independent R (coe : range x → A) :=
by simpa using hx.comp _ (range_splitting_injective x)

lemma map {f : A →ₐ[R] A'} (hf_inj : set.inj_on f (adjoin R (range x))) :
  algebraic_independent R (f ∘ x) :=
have aeval (f ∘ x) = f.comp (aeval x), by ext; simp,
have h : ∀ p : mv_polynomial ι R, aeval x p ∈ (@aeval R _ _ _ _ _ (coe : range x → A)).range,
  { intro p,
    rw [alg_hom.mem_range],
    refine ⟨mv_polynomial.rename (cod_restrict x (range x) (mem_range_self)) p, _⟩,
    simp [function.comp, aeval_rename] },
begin
  intros x y hxy,
  rw [this] at hxy,
  rw [adjoin_eq_range] at hf_inj,
  exact hx (hf_inj (h x) (h y) hxy)
end

lemma map' {f : A →ₐ[R] A'} (hf_inj : injective f) : algebraic_independent R (f ∘ x) :=
hx.map (inj_on_of_injective hf_inj _)

omit hx

lemma of_comp (f : A →ₐ[R] A') (hfv : algebraic_independent R (f ∘ x)) :
  algebraic_independent R x :=
have aeval (f ∘ x) = f.comp (aeval x), by ext; simp,
by rw [algebraic_independent, this] at hfv; exact hfv.of_comp

end algebraic_independent

open algebraic_independent

lemma alg_hom.algebraic_independent_iff (f : A →ₐ[R] A') (hf : injective f) :
  algebraic_independent R (f ∘ x) ↔ algebraic_independent R x :=
⟨λ h, h.of_comp f, λ h, h.map (inj_on_of_injective hf _)⟩

@[nontriviality]
lemma algebraic_independent_of_subsingleton [subsingleton R] : algebraic_independent R x :=
algebraic_independent_iff.2 (λ l hl, subsingleton.elim _ _)

theorem algebraic_independent_equiv (e : ι ≃ ι') {f : ι' → A} :
  algebraic_independent R (f ∘ e) ↔ algebraic_independent R f :=
⟨λ h, function.comp.right_id f ▸ e.self_comp_symm ▸ h.comp _ e.symm.injective,
λ h, h.comp _ e.injective⟩

theorem algebraic_independent_equiv' (e : ι ≃ ι') {f : ι' → A} {g : ι → A} (h : f ∘ e = g) :
  algebraic_independent R g ↔ algebraic_independent R f :=
h ▸ algebraic_independent_equiv e

theorem algebraic_independent_subtype_range {ι} {f : ι → A} (hf : injective f) :
  algebraic_independent R (coe : range f → A) ↔ algebraic_independent R f :=
iff.symm $ algebraic_independent_equiv' (equiv.of_injective f hf) rfl

alias algebraic_independent_subtype_range ↔ algebraic_independent.of_subtype_range _

theorem algebraic_independent_image {ι} {s : set ι} {f : ι → A} (hf : set.inj_on f s) :
  algebraic_independent R (λ x : s, f x) ↔ algebraic_independent R (λ x : f '' s, (x : A)) :=
algebraic_independent_equiv' (equiv.set.image_of_inj_on _ _ hf) rfl

lemma algebraic_independent_adjoin (hs : algebraic_independent R x) :
  @algebraic_independent ι R (adjoin R (range x))
      (λ i : ι, ⟨x i, subset_adjoin (mem_range_self i)⟩) _ _ _ :=
algebraic_independent.of_comp (adjoin R (range x)).val hs

/-- A set of algebraically independent elements in an algebra `A` over a ring `K` is also
algebraically independent over a subring `R` of `K`. -/
lemma algebraic_independent.restrict_scalars {K : Type*} [comm_ring K] [algebra R K]
   [algebra K A] [is_scalar_tower R K A]
  (hinj : function.injective (algebra_map R K)) (ai : algebraic_independent K x) :
  algebraic_independent R x :=
have (aeval x : mv_polynomial ι K →ₐ[K] A).to_ring_hom.comp
    (mv_polynomial.map (algebra_map R K)) =
    (aeval x : mv_polynomial ι R →ₐ[R] A).to_ring_hom,
  by { ext; simp [algebra_map_eq_smul_one] },
begin
  show injective (aeval x).to_ring_hom,
  rw [← this],
  exact injective.comp ai (mv_polynomial.map_injective _ hinj)
end

/-- Every finite subset of an algebraically independent set is algebraically independent. -/
lemma algebraic_independent_finset_map_embedding_subtype
  (s : set A) (li : algebraic_independent R (coe : s → A)) (t : finset s) :
  algebraic_independent R (coe : (finset.map (embedding.subtype s) t) → A) :=
begin
  let f : t.map (embedding.subtype s) → s := λ x, ⟨x.1, begin
    obtain ⟨x, h⟩ := x,
    rw [finset.mem_map] at h,
    obtain ⟨a, ha, rfl⟩ := h,
    simp only [subtype.coe_prop, embedding.coe_subtype],
  end⟩,
  convert algebraic_independent.comp li f _,
  rintros ⟨x, hx⟩ ⟨y, hy⟩,
  rw [finset.mem_map] at hx hy,
  obtain ⟨a, ha, rfl⟩ := hx,
  obtain ⟨b, hb, rfl⟩ := hy,
  simp only [imp_self, subtype.mk_eq_mk],
end

/--
If every finite set of algebraically independent element has cardinality at most `n`,
then the same is true for arbitrary sets of algebraically independent elements.
-/
lemma algebraic_independent_bounded_of_finset_algebraic_independent_bounded {n : ℕ}
  (H : ∀ s : finset A, algebraic_independent R (λ i : s, (i : A)) → s.card ≤ n) :
  ∀ s : set A, algebraic_independent R (coe : s → A) → cardinal.mk s ≤ n :=
begin
  intros s li,
  apply cardinal.card_le_of,
  intro t,
  rw ← finset.card_map (embedding.subtype s),
  apply H,
  apply algebraic_independent_finset_map_embedding_subtype _ li,
end

section subtype

lemma algebraic_independent.restrict_of_comp_subtype {s : set ι}
  (hs : algebraic_independent R (x ∘ coe : s → A)) :
  algebraic_independent R (s.restrict x) :=
hs

variables (R A)
lemma algebraic_independent_empty_iff : algebraic_independent R (λ x, x : (∅ : set A) → A) ↔
  injective (algebra_map R A) :=
by simp
variables {R A}

lemma algebraic_independent.mono {t s : set A} (h : t ⊆ s)
  (hx : algebraic_independent R (λ x, x : s → A)) : algebraic_independent R (λ x, x : t → A) :=
by simpa [function.comp] using hx.comp (inclusion h) (inclusion_injective h)

end subtype

theorem algebraic_independent.to_subtype_range {ι} {f : ι → A} (hf : algebraic_independent R f) :
  algebraic_independent R (coe : range f → A) :=
begin
  nontriviality R,
  { rwa algebraic_independent_subtype_range hf.injective }
end

theorem algebraic_independent.to_subtype_range' {ι} {f : ι → A} (hf : algebraic_independent R f)
  {t} (ht : range f = t) :
  algebraic_independent R (coe : t → A) :=
ht ▸ hf.to_subtype_range

theorem algebraic_independent_comp_subtype {s : set ι} :
  algebraic_independent R (x ∘ coe : s → A) ↔
  ∀ p ∈ (mv_polynomial.supported R s), aeval x p = 0 → p = 0 :=
have (aeval (x ∘ coe : s → A) : _ →ₐ[R] _) =
  (aeval x).comp (rename coe), by ext; simp,
have ∀ p : mv_polynomial s R, rename (coe : s → ι) p = 0 ↔ p = 0,
  from (injective_iff_map_eq_zero' (rename (coe : s → ι) : mv_polynomial s R →ₐ[R] _).to_ring_hom).1
    (rename_injective _ subtype.val_injective),
by simp [algebraic_independent_iff, supported_eq_range_rename, *]

theorem algebraic_independent_subtype {s : set A} :
  algebraic_independent R (λ x, x : s → A) ↔
  ∀ (p : mv_polynomial A R), p ∈ mv_polynomial.supported R s → aeval id p = 0 → p = 0 :=
by apply @algebraic_independent_comp_subtype _ _ _ id

lemma algebraic_independent_of_finite (s : set A)
  (H : ∀ t ⊆ s, t.finite → algebraic_independent R (λ x, x : t → A)) :
  algebraic_independent R (λ x, x : s → A) :=
algebraic_independent_subtype.2 $
  λ p hp, algebraic_independent_subtype.1 (H _ (mem_supported.1 hp) (finset.finite_to_set _)) _
    (by simp)

theorem algebraic_independent.image_of_comp {ι ι'} (s : set ι) (f : ι → ι') (g : ι' → A)
  (hs : algebraic_independent R (λ x : s, g (f x))) :
  algebraic_independent R (λ x : f '' s, g x) :=
begin
  nontriviality R,
  have : inj_on f s, from inj_on_iff_injective.2 hs.injective.of_comp,
  exact (algebraic_independent_equiv' (equiv.set.image_of_inj_on f s this) rfl).1 hs
end

theorem algebraic_independent.image {ι} {s : set ι} {f : ι → A}
  (hs : algebraic_independent R (λ x : s, f x)) : algebraic_independent R (λ x : f '' s, (x : A)) :=
by convert algebraic_independent.image_of_comp s f id hs

lemma algebraic_independent_Union_of_directed {η : Type*} [nonempty η]
  {s : η → set A} (hs : directed (⊆) s)
  (h : ∀ i, algebraic_independent R (λ x, x : s i → A)) :
  algebraic_independent R (λ x, x : (⋃ i, s i) → A) :=
begin
  refine algebraic_independent_of_finite (⋃ i, s i) (λ t ht ft, _),
  rcases finite_subset_Union ft ht with ⟨I, fi, hI⟩,
  rcases hs.finset_le fi.to_finset with ⟨i, hi⟩,
  exact (h i).mono (subset.trans hI $ Union₂_subset $
    λ j hj, hi j (fi.mem_to_finset.2 hj))
end

lemma algebraic_independent_sUnion_of_directed {s : set (set A)}
  (hsn : s.nonempty)
  (hs : directed_on (⊆) s)
  (h : ∀ a ∈ s, algebraic_independent R (λ x, x : (a : set A) → A)) :
  algebraic_independent R (λ x, x : (⋃₀ s) → A) :=
by letI : nonempty s := nonempty.to_subtype hsn;
rw sUnion_eq_Union; exact
algebraic_independent_Union_of_directed hs.directed_coe (by simpa using h)

lemma exists_maximal_algebraic_independent
  (s t : set A) (hst : s ⊆ t)
  (hs : algebraic_independent R (coe : s → A)) :
  ∃ u : set A, algebraic_independent R (coe : u → A) ∧ s ⊆ u ∧ u ⊆ t ∧
    ∀ x : set A, algebraic_independent R (coe : x → A) →
      u ⊆ x → x ⊆ t → x = u :=
begin
  rcases zorn_subset_nonempty
      { u : set A | algebraic_independent R (coe : u → A) ∧ s ⊆ u ∧ u ⊆ t }
    (λ c hc chainc hcn, ⟨⋃₀ c, begin
      refine ⟨⟨algebraic_independent_sUnion_of_directed hcn
        chainc.directed_on
        (λ a ha, (hc ha).1), _, _⟩, _⟩,
      { cases hcn with x hx,
        exact subset_sUnion_of_subset _ x (hc hx).2.1 hx },
      { exact sUnion_subset (λ x hx, (hc hx).2.2) },
      { intros s,
        exact subset_sUnion_of_mem }
    end⟩)
  s ⟨hs, set.subset.refl s, hst⟩ with ⟨u, ⟨huai, hsu, hut⟩, hsu, hx⟩,
  use [u, huai, hsu, hut],
  intros x hxai huv hxt,
  exact hx _ ⟨hxai, trans hsu huv, hxt⟩ huv,
end

section repr
variables (hx : algebraic_independent R x)

/-- Canonical isomorphism between polynomials and the subalgebra generated by
  algebraically independent elements. -/
@[simps] def algebraic_independent.aeval_equiv (hx : algebraic_independent R x) :
  (mv_polynomial ι R) ≃ₐ[R] algebra.adjoin R (range x) :=
begin
  apply alg_equiv.of_bijective
    (alg_hom.cod_restrict (@aeval R A ι _ _ _ x) (algebra.adjoin R (range x)) _),
  swap,
  { intros x,
    rw [adjoin_range_eq_range_aeval],
    exact alg_hom.mem_range_self _ _ },
  { split,
    { exact (alg_hom.injective_cod_restrict _ _ _).2 hx },
    { rintros ⟨x, hx⟩,
      rw [adjoin_range_eq_range_aeval] at hx,
      rcases hx with ⟨y, rfl⟩,
      use y,
      ext,
      simp } }
end

@[simp] lemma algebraic_independent.algebra_map_aeval_equiv (hx : algebraic_independent R x)
  (p : mv_polynomial ι R) : algebra_map (algebra.adjoin R (range x)) A (hx.aeval_equiv p) =
  aeval x p := rfl

/-- The canonical map from the subalgebra generated by an algebraic independent family
  into the polynomial ring.  -/
def algebraic_independent.repr (hx : algebraic_independent R x) :
  algebra.adjoin R (range x) →ₐ[R] mv_polynomial ι R := hx.aeval_equiv.symm

@[simp] lemma algebraic_independent.aeval_repr (p) : aeval x (hx.repr p) = p :=
subtype.ext_iff.1 (alg_equiv.apply_symm_apply hx.aeval_equiv p)

lemma algebraic_independent.aeval_comp_repr :
  (aeval x).comp hx.repr = subalgebra.val _ :=
alg_hom.ext $ hx.aeval_repr

lemma algebraic_independent.repr_ker :
  (hx.repr : adjoin R (range x) →+* mv_polynomial ι R).ker = ⊥ :=
(ring_hom.injective_iff_ker_eq_bot _).1 (alg_equiv.injective _)

end repr

-- TODO - make this an `alg_equiv`
/-- The isomorphism between `mv_polynomial (option ι) R` and the polynomial ring over
the algebra generated by an algebraically independent family.  -/
def algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin
  (hx : algebraic_independent R x) :
  mv_polynomial (option ι) R ≃+* polynomial (adjoin R (set.range x)) :=
(mv_polynomial.option_equiv_left _ _).to_ring_equiv.trans
  (polynomial.map_equiv hx.aeval_equiv.to_ring_equiv)

@[simp]
lemma algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_apply
  (hx : algebraic_independent R x) (y) :
  hx.mv_polynomial_option_equiv_polynomial_adjoin y =
    polynomial.map (hx.aeval_equiv : mv_polynomial ι R →+* adjoin R (range x))
      (aeval (λ (o : option ι), o.elim polynomial.X (λ (s : ι), polynomial.C (X s))) y) :=
rfl

@[simp]
lemma algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_C
  (hx : algebraic_independent R x) (r) :
  hx.mv_polynomial_option_equiv_polynomial_adjoin (C r) =
    polynomial.C (algebra_map _ _ r) :=
begin
  -- TODO: this instance is slow to infer
  have h : is_scalar_tower R (mv_polynomial ι R) (polynomial (mv_polynomial ι R)) :=
    @polynomial.is_scalar_tower (mv_polynomial ι R) _ R _ _ _ _ _ _ _,
  rw [algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_apply, aeval_C,
    @is_scalar_tower.algebra_map_apply _ _ _ _ _ _ _ _ _ h, ← polynomial.C_eq_algebra_map,
    polynomial.map_C, ring_hom.coe_coe, alg_equiv.commutes]
end

@[simp]
lemma algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_X_none
  (hx : algebraic_independent R x) :
  hx.mv_polynomial_option_equiv_polynomial_adjoin (X none) = polynomial.X :=
by rw [algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_apply, aeval_X,
      option.elim, polynomial.map_X]

@[simp]
lemma algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_X_some
  (hx : algebraic_independent R x) (i) :
  hx.mv_polynomial_option_equiv_polynomial_adjoin (X (some i)) =
    polynomial.C (hx.aeval_equiv (X i)) :=
by rw [algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_apply, aeval_X,
      option.elim, polynomial.map_C, ring_hom.coe_coe]

lemma algebraic_independent.aeval_comp_mv_polynomial_option_equiv_polynomial_adjoin
  (hx : algebraic_independent R x) (a : A) :
  (ring_hom.comp (↑(polynomial.aeval a : polynomial (adjoin R (set.range x)) →ₐ[_] A) :
      polynomial (adjoin R (set.range x)) →+* A)
    hx.mv_polynomial_option_equiv_polynomial_adjoin.to_ring_hom) =
    ↑((mv_polynomial.aeval (λ o : option ι, o.elim a x)) :
      mv_polynomial (option ι) R →ₐ[R] A) :=
begin
  refine mv_polynomial.ring_hom_ext _ _;
    simp only [ring_hom.comp_apply, ring_equiv.to_ring_hom_eq_coe, ring_equiv.coe_to_ring_hom,
        alg_hom.coe_to_ring_hom, alg_hom.coe_to_ring_hom],
  { intro r,
    rw [hx.mv_polynomial_option_equiv_polynomial_adjoin_C,
        aeval_C, polynomial.aeval_C, is_scalar_tower.algebra_map_apply R (adjoin R (range x)) A] },
  { rintro (⟨⟩|⟨i⟩),
    { rw [hx.mv_polynomial_option_equiv_polynomial_adjoin_X_none,
          aeval_X, polynomial.aeval_X, option.elim] },
    { rw [hx.mv_polynomial_option_equiv_polynomial_adjoin_X_some, polynomial.aeval_C,
          hx.algebra_map_aeval_equiv, aeval_X, aeval_X, option.elim] } },
end

theorem algebraic_independent.option_iff (hx : algebraic_independent R x) (a : A) :
  (algebraic_independent R (λ o : option ι, o.elim a x)) ↔
    ¬ is_algebraic (adjoin R (set.range x)) a :=
by erw [algebraic_independent_iff_injective_aeval, is_algebraic_iff_not_injective, not_not,
    ← alg_hom.coe_to_ring_hom,
    ← hx.aeval_comp_mv_polynomial_option_equiv_polynomial_adjoin,
    ring_hom.coe_comp, injective.of_comp_iff' _ (ring_equiv.bijective _), alg_hom.coe_to_ring_hom]

variable (R)
/--
  A family is a transcendence basis if it is a maximal algebraically independent subset.
-/
def is_transcendence_basis (x : ι → A) : Prop :=
algebraic_independent R x ∧
  ∀ (s : set A) (i' : algebraic_independent R (coe : s → A)) (h : range x ≤ s), range x = s

lemma exists_is_transcendence_basis (h : injective (algebra_map R A)) :
  ∃ s : set A, is_transcendence_basis R (coe : s → A) :=
begin
  cases exists_maximal_algebraic_independent (∅ : set A) set.univ
    (set.subset_univ _) ((algebraic_independent_empty_iff R A).2 h) with s hs,
  use [s, hs.1],
  intros t ht hr,
  simp only [subtype.range_coe_subtype, set_of_mem_eq] at *,
  exact eq.symm (hs.2.2.2 t ht hr (set.subset_univ _))
end

variable {R}
lemma algebraic_independent.is_transcendence_basis_iff
  {ι : Type w} {R : Type u} [comm_ring R] [nontrivial R]
  {A : Type v} [comm_ring A] [algebra R A] {x : ι → A} (i : algebraic_independent R x) :
  is_transcendence_basis R x ↔ ∀ (κ : Type v) (w : κ → A) (i' : algebraic_independent R w)
    (j : ι → κ) (h : w ∘ j = x), surjective j :=
begin
  fsplit,
  { rintros p κ w i' j rfl,
    have p := p.2 (range w) i'.coe_range (range_comp_subset_range _ _),
    rw [range_comp, ←@image_univ _ _ w] at p,
    exact range_iff_surjective.mp (image_injective.mpr i'.injective p) },
  { intros p,
    use i,
    intros w i' h,
    specialize p w (coe : w → A) i'
      (λ i, ⟨x i, range_subset_iff.mp h i⟩)
      (by { ext, simp, }),
    have q := congr_arg (λ s, (coe : w → A) '' s) p.range_eq,
    dsimp at q,
    rw [←image_univ, image_image] at q,
    simpa using q, },
end

lemma is_transcendence_basis.is_algebraic [nontrivial R]
  (hx : is_transcendence_basis R x) : is_algebraic (adjoin R (range x)) A :=
begin
  intro a,
  rw [← not_iff_comm.1 (hx.1.option_iff _).symm],
  intro ai,
  have h₁ : range x ⊆ range (λ o : option ι, o.elim a x),
  { rintros x ⟨y, rfl⟩, exact ⟨some y, rfl⟩ },
  have h₂ : range x ≠ range (λ o : option ι, o.elim a x),
  { intro h,
    have : a ∈ range x, { rw h, exact ⟨none, rfl⟩ },
    rcases this with ⟨b, rfl⟩,
    have : some b = none := ai.injective rfl,
    simpa },
  exact h₂ (hx.2 (set.range (λ o : option ι, o.elim a x))
    ((algebraic_independent_subtype_range ai.injective).2 ai) h₁)
end

section field
variables [field K] [algebra K A]

@[simp] lemma algebraic_independent_empty_type [is_empty ι] [nontrivial A] :
  algebraic_independent K x :=
begin
  rw [algebraic_independent_empty_type_iff],
  exact ring_hom.injective _,
end

lemma algebraic_independent_empty [nontrivial A] :
  algebraic_independent K (coe : ((∅ : set A) → A)) :=
algebraic_independent_empty_type

end field


/-
Copyright (c) 2021 Alex J. Best. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best
-/
import data.list.big_operators

/-!
# Products / sums of lists of terms of a monoid

This file provides basic results about `list.prod` (definition in `data.list.defs`) in a monoid.
-/

open nat

namespace list

universes u v
variables {α : Type u}

@[simp, priority 500, to_additive]
theorem prod_repeat [monoid α] (a : α) (n : ℕ) : (repeat a n).prod = a ^ n :=
begin
  induction n with n ih,
  { rw pow_zero, refl },
  { rw [list.repeat_succ, list.prod_cons, ih, pow_succ] }
end

@[to_additive]
lemma prod_le_of_forall_le [ordered_comm_monoid α] (l : list α) (n : α) (h : ∀ (x ∈ l), x ≤ n) :
  l.prod ≤ n ^ l.length :=
begin
  induction l with y l IH,
  { simp },
  { specialize IH (λ x hx, h x (mem_cons_of_mem _ hx)),
    have hy : y ≤ n := h y (mem_cons_self _ _),
    simpa [pow_succ] using mul_le_mul' hy IH }
end

end list


/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.complex.determinant
import data.complex.is_R_or_C

/-!
# Normed space structure on `ℂ`.

This file gathers basic facts on complex numbers of an analytic nature.

## Main results

This file registers `ℂ` as a normed field, expresses basic properties of the norm, and gives
tools on the real vector space structure of `ℂ`. Notably, in the namespace `complex`,
it defines functions:

* `re_clm`
* `im_clm`
* `of_real_clm`
* `conj_cle`

They are bundled versions of the real part, the imaginary part, the embedding of `ℝ` in `ℂ`, and
the complex conjugate as continuous `ℝ`-linear maps. The last two are also bundled as linear
isometries in `of_real_li` and `conj_lie`.

We also register the fact that `ℂ` is an `is_R_or_C` field.
-/
noncomputable theory

namespace complex

open_locale complex_conjugate topological_space

instance : has_norm ℂ := ⟨abs⟩

@[simp] lemma norm_eq_abs (z : ℂ) : ∥z∥ = abs z := rfl

instance : normed_group ℂ :=
normed_group.of_core ℂ
{ norm_eq_zero_iff := λ z, abs_eq_zero,
  triangle := abs_add,
  norm_neg := abs_neg }

instance : normed_field ℂ :=
{ norm := abs,
  dist_eq := λ _ _, rfl,
  norm_mul' := abs_mul,
  .. complex.field, .. complex.normed_group }

instance : nondiscrete_normed_field ℂ :=
{ non_trivial := ⟨2, by simp; norm_num⟩ }

instance {R : Type*} [normed_field R] [normed_algebra R ℝ] : normed_algebra R ℂ :=
{ norm_smul_le := λ r x, begin
    rw [norm_eq_abs, norm_eq_abs, ←algebra_map_smul ℝ r x, algebra.smul_def, abs_mul,
      ←norm_algebra_map' ℝ r, coe_algebra_map, abs_of_real],
    refl,
  end,
  to_algebra := complex.algebra }

/-- The module structure from `module.complex_to_real` is a normed space. -/
@[priority 900] -- see Note [lower instance priority]
instance _root_.normed_space.complex_to_real {E : Type*} [normed_group E] [normed_space ℂ E] :
  normed_space ℝ E :=
normed_space.restrict_scalars ℝ ℂ E

lemma dist_eq (z w : ℂ) : dist z w = abs (z - w) := rfl

lemma dist_eq_re_im (z w : ℂ) : dist z w = real.sqrt ((z.re - w.re) ^ 2 + (z.im - w.im) ^ 2) :=
by { rw [sq, sq], refl }

@[simp] lemma dist_mk (x₁ y₁ x₂ y₂ : ℝ) :
  dist (mk x₁ y₁) (mk x₂ y₂) = real.sqrt ((x₁ - x₂) ^ 2 + (y₁ - y₂) ^ 2) :=
dist_eq_re_im _ _

lemma dist_of_re_eq {z w : ℂ} (h : z.re = w.re) : dist z w = dist z.im w.im :=
by rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, zero_add, real.sqrt_sq_eq_abs, real.dist_eq]

lemma nndist_of_re_eq {z w : ℂ} (h : z.re = w.re) : nndist z w = nndist z.im w.im :=
nnreal.eq $ dist_of_re_eq h

lemma edist_of_re_eq {z w : ℂ} (h : z.re = w.re) : edist z w = edist z.im w.im :=
by rw [edist_nndist, edist_nndist, nndist_of_re_eq h]

lemma dist_of_im_eq {z w : ℂ} (h : z.im = w.im) : dist z w = dist z.re w.re :=
by rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, add_zero, real.sqrt_sq_eq_abs, real.dist_eq]

lemma nndist_of_im_eq {z w : ℂ} (h : z.im = w.im) : nndist z w = nndist z.re w.re :=
nnreal.eq $ dist_of_im_eq h

lemma edist_of_im_eq {z w : ℂ} (h : z.im = w.im) : edist z w = edist z.re w.re :=
by rw [edist_nndist, edist_nndist, nndist_of_im_eq h]

lemma dist_conj_self (z : ℂ) : dist (conj z) z = 2 * |z.im| :=
by rw [dist_of_re_eq (conj_re z), conj_im, dist_comm, real.dist_eq, sub_neg_eq_add, ← two_mul,
  _root_.abs_mul, abs_of_pos (@two_pos ℝ _ _)]

lemma nndist_conj_self (z : ℂ) : nndist (conj z) z = 2 * real.nnabs z.im :=
nnreal.eq $ by rw [← dist_nndist, nnreal.coe_mul, nnreal.coe_two, real.coe_nnabs, dist_conj_self]

lemma dist_self_conj (z : ℂ) : dist z (conj z) = 2 * |z.im| :=
by rw [dist_comm, dist_conj_self]

lemma nndist_self_conj (z : ℂ) : nndist z (conj z) = 2 * real.nnabs z.im :=
by rw [nndist_comm, nndist_conj_self]

@[simp] lemma comap_abs_nhds_zero : filter.comap abs (𝓝 0) = 𝓝 0 := comap_norm_nhds_zero

@[simp] lemma norm_real (r : ℝ) : ∥(r : ℂ)∥ = ∥r∥ := abs_of_real _

@[simp] lemma norm_rat (r : ℚ) : ∥(r : ℂ)∥ = |(r : ℝ)| :=
by { rw ← of_real_rat_cast, exact norm_real _ }

@[simp] lemma norm_nat (n : ℕ) : ∥(n : ℂ)∥ = n := abs_of_nat _

@[simp] lemma norm_int {n : ℤ} : ∥(n : ℂ)∥ = |n| :=
by simp [← rat.cast_coe_int] {single_pass := tt}

lemma norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : ∥(n : ℂ)∥ = n :=
by simp [hn]

@[continuity] lemma continuous_abs : continuous abs := continuous_norm

@[continuity] lemma continuous_norm_sq : continuous norm_sq :=
by simpa [← norm_sq_eq_abs] using continuous_abs.pow 2

@[simp, norm_cast] lemma nnnorm_real (r : ℝ) : ∥(r : ℂ)∥₊ = ∥r∥₊ :=
subtype.ext $ norm_real r

@[simp, norm_cast] lemma nnnorm_nat (n : ℕ) : ∥(n : ℂ)∥₊ = n :=
subtype.ext $ by simp

@[simp, norm_cast] lemma nnnorm_int (n : ℤ) : ∥(n : ℂ)∥₊ = ∥n∥₊ :=
subtype.ext $ by simp only [coe_nnnorm, norm_int, int.norm_eq_abs]

lemma nnnorm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) :
  ∥ζ∥₊ = 1 :=
begin
  refine (@pow_left_inj nnreal _ _ _ _ zero_le' zero_le' hn.bot_lt).mp _,
  rw [←nnnorm_pow, h, nnnorm_one, one_pow],
end

lemma norm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) :
  ∥ζ∥ = 1 :=
congr_arg coe (nnnorm_eq_one_of_pow_eq_one h hn)

/-- The `abs` function on `ℂ` is proper. -/
lemma tendsto_abs_cocompact_at_top : filter.tendsto abs (filter.cocompact ℂ) filter.at_top :=
tendsto_norm_cocompact_at_top

/-- The `norm_sq` function on `ℂ` is proper. -/
lemma tendsto_norm_sq_cocompact_at_top :
  filter.tendsto norm_sq (filter.cocompact ℂ) filter.at_top :=
by simpa [mul_self_abs] using
  tendsto_abs_cocompact_at_top.at_top_mul_at_top tendsto_abs_cocompact_at_top

open continuous_linear_map

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def re_clm : ℂ →L[ℝ] ℝ := re_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_re_le_abs])

@[continuity] lemma continuous_re : continuous re := re_clm.continuous

@[simp] lemma re_clm_coe : (coe (re_clm) : ℂ →ₗ[ℝ] ℝ) = re_lm := rfl

@[simp]

@[simp] lemma re_clm_norm : ∥re_clm∥ = 1 :=
le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $
calc 1 = ∥re_clm 1∥ : by simp
   ... ≤ ∥re_clm∥ : unit_le_op_norm _ _ (by simp)

@[simp] lemma re_clm_nnnorm : ∥re_clm∥₊ = 1 := subtype.ext re_clm_norm

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def im_clm : ℂ →L[ℝ] ℝ := im_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_im_le_abs])

@[continuity] lemma continuous_im : continuous im := im_clm.continuous

@[simp] lemma im_clm_coe : (coe (im_clm) : ℂ →ₗ[ℝ] ℝ) = im_lm := rfl

@[simp] lemma im_clm_apply (z : ℂ) : (im_clm : ℂ → ℝ) z = z.im := rfl

@[simp] lemma im_clm_norm : ∥im_clm∥ = 1 :=
le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $
calc 1 = ∥im_clm I∥ : by simp
   ... ≤ ∥im_clm∥ : unit_le_op_norm _ _ (by simp)

@[simp] lemma im_clm_nnnorm : ∥im_clm∥₊ = 1 := subtype.ext im_clm_norm

lemma restrict_scalars_one_smul_right' {E : Type*} [normed_group E] [normed_space ℂ E] (x : E) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] E) =
    re_clm.smul_right x + I • im_clm.smul_right x :=
by { ext ⟨a, b⟩, simp [mk_eq_add_mul_I, add_smul, mul_smul, smul_comm I] }

lemma restrict_scalars_one_smul_right (x : ℂ) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] ℂ) = x • 1 :=
by { ext1 z, dsimp, apply mul_comm }

/-- The complex-conjugation function from `ℂ` to itself is an isometric linear equivalence. -/
def conj_lie : ℂ ≃ₗᵢ[ℝ] ℂ := ⟨conj_ae.to_linear_equiv, abs_conj⟩

@[simp] lemma conj_lie_apply (z : ℂ) : conj_lie z = conj z := rfl

@[simp] lemma conj_lie_symm : conj_lie.symm = conj_lie := rfl

lemma isometry_conj : isometry (conj : ℂ → ℂ) := conj_lie.isometry

@[simp] lemma dist_conj_conj (z w : ℂ) : dist (conj z) (conj w) = dist z w :=
isometry_conj.dist_eq z w

@[simp] lemma nndist_conj_conj (z w : ℂ) : nndist (conj z) (conj w) = nndist z w :=
isometry_conj.nndist_eq z w

lemma dist_conj_comm (z w : ℂ) : dist (conj z) w = dist z (conj w) :=
by rw [← dist_conj_conj, conj_conj]

lemma nndist_conj_comm (z w : ℂ) : nndist (conj z) w = nndist z (conj w) :=
subtype.ext $ dist_conj_comm _ _

/-- The determinant of `conj_lie`, as a linear map. -/
@[simp] lemma det_conj_lie : (conj_lie.to_linear_equiv : ℂ →ₗ[ℝ] ℂ).det = -1 :=
det_conj_ae

/-- The determinant of `conj_lie`, as a linear equiv. -/
@[simp] lemma linear_equiv_det_conj_lie : conj_lie.to_linear_equiv.det = -1 :=
linear_equiv_det_conj_ae

instance : has_continuous_star ℂ := ⟨conj_lie.continuous⟩

@[continuity] lemma continuous_conj : continuous (conj : ℂ → ℂ) := continuous_star

/-- Continuous linear equiv version of the conj function, from `ℂ` to `ℂ`. -/
def conj_cle : ℂ ≃L[ℝ] ℂ := conj_lie

@[simp] lemma conj_cle_coe : conj_cle.to_linear_equiv = conj_ae.to_linear_equiv := rfl

@[simp] lemma conj_cle_apply (z : ℂ) : conj_cle z = conj z := rfl

@[simp] lemma conj_cle_norm : ∥(conj_cle : ℂ →L[ℝ] ℂ)∥ = 1 :=
conj_lie.to_linear_isometry.norm_to_continuous_linear_map

@[simp] lemma conj_cle_nnorm : ∥(conj_cle : ℂ →L[ℝ] ℂ)∥₊ = 1 := subtype.ext conj_cle_norm

/-- Linear isometry version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_li : ℝ →ₗᵢ[ℝ] ℂ := ⟨of_real_am.to_linear_map, norm_real⟩

lemma isometry_of_real : isometry (coe : ℝ → ℂ) := of_real_li.isometry

@[continuity] lemma continuous_of_real : continuous (coe : ℝ → ℂ) := of_real_li.continuous

/-- Continuous linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_clm : ℝ →L[ℝ] ℂ := of_real_li.to_continuous_linear_map

@[simp] lemma of_real_clm_coe : (of_real_clm : ℝ →ₗ[ℝ] ℂ) = of_real_am.to_linear_map := rfl

@[simp] lemma of_real_clm_apply (x : ℝ) : of_real_clm x = x := rfl

@[simp] lemma of_real_clm_norm : ∥of_real_clm∥ = 1 := of_real_li.norm_to_continuous_linear_map

@[simp] lemma of_real_clm_nnnorm : ∥of_real_clm∥₊ = 1 := subtype.ext $ of_real_clm_norm

noncomputable instance : is_R_or_C ℂ :=
{ re := ⟨complex.re, complex.zero_re, complex.add_re⟩,
  im := ⟨complex.im, complex.zero_im, complex.add_im⟩,
  I := complex.I,
  I_re_ax := by simp only [add_monoid_hom.coe_mk, complex.I_re],
  I_mul_I_ax := by simp only [complex.I_mul_I, eq_self_iff_true, or_true],
  re_add_im_ax := λ z, by simp only [add_monoid_hom.coe_mk, complex.re_add_im,
                                     complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_re_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_re,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_im_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_im,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  mul_re_ax := λ z w, by simp only [complex.mul_re, add_monoid_hom.coe_mk],
  mul_im_ax := λ z w, by simp only [add_monoid_hom.coe_mk, complex.mul_im],
  conj_re_ax := λ z, rfl,
  conj_im_ax := λ z, rfl,
  conj_I_ax := by simp only [complex.conj_I, ring_hom.coe_mk],
  norm_sq_eq_def_ax := λ z, by simp only [←complex.norm_sq_eq_abs, ←complex.norm_sq_apply,
    add_monoid_hom.coe_mk, complex.norm_eq_abs],
  mul_im_I_ax := λ z, by simp only [mul_one, add_monoid_hom.coe_mk, complex.I_im],
  inv_def_ax := λ z, by simp only [complex.inv_def, complex.norm_sq_eq_abs, complex.coe_algebra_map,
    complex.of_real_eq_coe, complex.norm_eq_abs],
  div_I_ax := complex.div_I }

lemma _root_.is_R_or_C.re_eq_complex_re : ⇑(is_R_or_C.re : ℂ →+ ℝ) = complex.re := rfl
lemma _root_.is_R_or_C.im_eq_complex_im : ⇑(is_R_or_C.im : ℂ →+ ℝ) = complex.im := rfl

section

variables {α β γ : Type*}
  [add_comm_monoid α] [topological_space α] [add_comm_monoid γ] [topological_space γ]

/-- The natural `add_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }]
def equiv_real_prod_add_hom : ℂ ≃+ ℝ × ℝ :=
{ map_add' := by simp, .. equiv_real_prod }

/-- The natural `linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }]
def equiv_real_prod_add_hom_lm : ℂ ≃ₗ[ℝ] ℝ × ℝ :=
{ map_smul' := by simp [equiv_real_prod_add_hom], .. equiv_real_prod_add_hom }

/-- The natural `continuous_linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }]
def equiv_real_prodₗ : ℂ ≃L[ℝ] ℝ × ℝ :=
equiv_real_prod_add_hom_lm.to_continuous_linear_equiv

end

lemma has_sum_iff {α} (f : α → ℂ) (c : ℂ) :
  has_sum f c ↔ has_sum (λ x, (f x).re) c.re ∧ has_sum (λ x, (f x).im) c.im :=
begin
  -- For some reason, `continuous_linear_map.has_sum` is orders of magnitude faster than
  -- `has_sum.mapL` here:
  refine ⟨λ h, ⟨re_clm.has_sum h, im_clm.has_sum h⟩, _⟩,
  rintro ⟨h₁, h₂⟩,
  convert (h₁.prod_mk h₂).mapL equiv_real_prodₗ.symm.to_continuous_linear_map,
  { ext x; refl },
  { cases c, refl }
end

end complex

namespace is_R_or_C

local notation `reC` := @is_R_or_C.re ℂ _
local notation `imC` := @is_R_or_C.im ℂ _
local notation `IC` := @is_R_or_C.I ℂ _
local notation `absC` := @is_R_or_C.abs ℂ _
local notation `norm_sqC` := @is_R_or_C.norm_sq ℂ _

@[simp] lemma re_to_complex {x : ℂ} : reC x = x.re := rfl
@[simp] lemma im_to_complex {x : ℂ} : imC x = x.im := rfl
@[simp] lemma I_to_complex : IC = complex.I := rfl
@[simp] lemma norm_sq_to_complex {x : ℂ} : norm_sqC x = complex.norm_sq x :=
by simp [is_R_or_C.norm_sq, complex.norm_sq]
@[simp] lemma abs_to_complex {x : ℂ} : absC x = complex.abs x :=
by simp [is_R_or_C.abs, complex.abs]

end is_R_or_C


section

-- set_option pp.all true
-- #print Nat.casesOn
#print Nat.zero
#print Nat.succ
#print Nat.rec

#print Nat.noConfusionType
#print Nat.noConfusion

def Nat.noConfusionType2 : Sort u → Nat → Nat → Sort u
| P, zero, zero => P → P
| P, zero, succ m => P
| P, succ n, zero => P
| P, succ n, succ m => (n = m → P) → P
def Nat.noConfusion2 {P : Sort u} {n m} (h : n = m) : noConfusionType2 P n m :=
match n with
| zero => h ▸ λ g => g
| succ n => h ▸ λ g => g rfl

noncomputable def Nat.rec3 : {motive : Nat → Sort u}
→ motive zero → ((n : Nat) → motive n → motive (succ n)) → (t : Nat) → motive t
:= Nat.rec
noncomputable def Nat.casesOn3 {motive : Nat → Type}
  (t : Nat) (z : motive Nat.zero) (h : (n : Nat) → motive (Nat.succ n)) : motive t :=
  rec3 z (λ n ih => h n) t
noncomputable def Nat.casesOn3' {motive : Nat → Prop}
  (t : Nat) (z : motive Nat.zero) (h : (n : Nat) → motive (Nat.succ n)) : motive t :=
  rec3 z (λ n ih => h n) t
noncomputable def Nat.noConfusionProp3 : Nat → Nat → Prop :=
λ n m => casesOn3 (motive := λ _ => Prop) n
  (casesOn3 (motive := λ _ => Prop) m True (λ m => False))
  (λ n => casesOn3 (motive := λ _ => Prop) m False (λ m => n = m))
theorem Nat.noConfusion3
{n m : Nat} : n = m → noConfusionProp3 n m
 :=
casesOn3' (motive := λ n => n = m → noConfusionProp3 n m) n
  (λ h => h ▸ trivial)
  (λ n h => h ▸ rfl)

theorem Nat.lemma1 : ∀ n m, succ n = succ m → n = m :=
λ n m => noConfusion3

theorem Nat.aaa : zero ≠ succ zero := noConfusion2
theorem Nat.bbb (h : succ n = succ m) : n = m := noConfusion2 h id

end

section

class Is_Nat_Type (Is_Nat : Type → Prop) where
  zero : Type
  zero_is_nat : Is_Nat zero
  succ (x : Type) (hx : Is_Nat x) : Type
  succ_is_nat : ∀ x hx, Is_Nat $ succ x hx

class Is_Nat (x : Type) : Prop
local instance : Is_Nat_Type Is_Nat := sorry
def nat_succ (x : Type) [hx : Is_Nat x] : {y // Is_Nat y} := ⟨Is_Nat_Type.succ x hx, Is_Nat_Type.succ_is_nat ..⟩

end


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.free
import algebra.monoid_algebra.basic

/-!
# Free algebras

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

Given a semiring `R` and a type `X`, we construct the free non-unital, non-associative algebra on
`X` with coefficients in `R`, together with its universal property. The construction is valuable
because it can be used to build free algebras with more structure, e.g., free Lie algebras.

Note that elsewhere we have a construction of the free unital, associative algebra. This is called
`free_algebra`.

## Main definitions

  * `free_non_unital_non_assoc_algebra`
  * `free_non_unital_non_assoc_algebra.lift`
  * `free_non_unital_non_assoc_algebra.of`

## Implementation details

We construct the free algebra as the magma algebra, with coefficients in `R`, of the free magma on
`X`. However we regard this as an implementation detail and thus deliberately omit the lemmas
`of_apply` and `lift_apply`, and we mark `free_non_unital_non_assoc_algebra` and `lift` as
irreducible once we have established the universal property.

## Tags

free algebra, non-unital, non-associative, free magma, magma algebra, universal property,
forgetful functor, adjoint functor
-/

universes u v w

noncomputable theory

variables (R : Type u) (X : Type v) [semiring R]

/-- The free non-unital, non-associative algebra on the type `X` with coefficients in `R`. -/
abbreviation free_non_unital_non_assoc_algebra := monoid_algebra R (free_magma X)

namespace free_non_unital_non_assoc_algebra

variables {X}

/-- The embedding of `X` into the free algebra with coefficients in `R`. -/
def of : X → free_non_unital_non_assoc_algebra R X :=
(monoid_algebra.of_magma R _) ∘ free_magma.of

variables {A : Type w} [non_unital_non_assoc_semiring A]
variables [module R A] [is_scalar_tower R A A] [smul_comm_class R A A]

/-- The functor `X ↦ free_non_unital_non_assoc_algebra R X` from the category of types to the
category of non-unital, non-associative algebras over `R` is adjoint to the forgetful functor in the
other direction. -/
def lift : (X → A) ≃ (free_non_unital_non_assoc_algebra R X →ₙₐ[R] A) :=
free_magma.lift.trans (monoid_algebra.lift_magma R)

@[simp] lemma lift_symm_apply (F : free_non_unital_non_assoc_algebra R X →ₙₐ[R] A) :
  (lift R).symm F = F ∘ (of R) :=
rfl

@[simp] lemma of_comp_lift (f : X → A) : (lift R f) ∘ (of R) = f :=
(lift R).left_inv f

@[simp] lemma lift_unique
  (f : X → A) (F : free_non_unital_non_assoc_algebra R X →ₙₐ[R] A) :
  F ∘ (of R) = f ↔ F = lift R f :=
(lift R).symm_apply_eq

@[simp] lemma lift_of_apply (f : X → A) (x) : lift R f (of R x) = f x :=
congr_fun (of_comp_lift _ f) x

@[simp] lemma lift_comp_of (F : free_non_unital_non_assoc_algebra R X →ₙₐ[R] A) :
  lift R (F ∘ (of R)) = F :=
(lift R).apply_symm_apply F

@[ext] lemma hom_ext {F₁ F₂ : free_non_unital_non_assoc_algebra R X →ₙₐ[R] A}
  (h : ∀ x, F₁ (of R x) = F₂ (of R x)) : F₁ = F₂ :=
(lift R).symm.injective $ funext h

end free_non_unital_non_assoc_algebra


import data.finset
import algebra.field
import order.zorn
import Rings.ToMathlib

open classical
local attribute [instance] prop_decidable

universe u

/-- A pregeometry consists of
  * a type `Carrier`
  * a closure map `Cl` from the powerset of `Carrier` to itself
  such that
  * `Cl` is a morphism of orders (with the natural ordering on the powerset)
  * `Cl` is idempotent
  * Any element in the closure is in the closure of some finite subset
  * The generalized Steinitz exchange works with `Cl` viewed as the span
-/
class Pregeometry : Type (u + 1) :=
(Carrier : Type u)
(Cl : set Carrier → set Carrier)
(Closure : Π {U : set Carrier}, U ⊆ Cl U)
(OrdMor : Π {U V : set Carrier}, U ⊆ V → Cl U ⊆ Cl V)
(Idem : Π (U : set Carrier), Cl (Cl U) = Cl U)
(FinChar : Π {U} {a : Carrier} (h : a ∈ Cl U), finset Carrier)
(FinCharProp : Π {U} {a} (h : a ∈ Cl U), ↑(FinChar h) ⊆ U ∧ a ∈ Cl (FinChar h))
(Exch : Π {U : set Carrier} {a b : Carrier}, a ∈ Cl (U ∪ {b}) → a ∈ Cl U ∨ b ∈ Cl (U ∪ {a}))

namespace Pregeometry
  variables
    {X : Pregeometry} (U V W : set Carrier)

  def Spans : Prop := U ⊆ V ∧ Cl U = Cl V

  def Indep : Prop := Π a : Carrier, (a ∈ U) → a ∉ Cl (U \ {a})

  def Basis : Prop := Spans U V ∧ Indep U

  def Dep : Prop := ∃ (a : Carrier) (haU : a ∈ U), a ∈ Cl (U \ {a})

  variables {U} {V} {W}

  lemma SubIndep : Indep V → Π (U : set Carrier), U ⊆ V → Indep U :=
  begin
    intros hV U hsub a haU hbot,
    have haV := hsub haU,
    apply hV a haV,
    apply OrdMor _ hbot,
    apply set.diff_subset_diff hsub,
    simp,
  end

  lemma SpansTrans : Spans U V → Spans V W → Spans U W :=
  begin
    intros hUV hVW,
    split,
    {apply set.subset.trans hUV.1 hVW.1},
    {rw hUV.2, exact hVW.2}
  end

  lemma SubClSpans : U ⊆ V → V ⊆ Cl U → Spans U V :=
  begin
    intros hUV hVCl,
    split,
    {exact hUV},
    {
      apply set.ext,
      intro x,
      split,
      {apply OrdMor hUV},
      {
        rw ← @Idem _ U,
        apply OrdMor hVCl,
      },
    }
  end

  lemma NotIndep : ¬ Indep U ↔ Dep U :=
  begin
    split,
    {
      intro hnIndU,
      cases not_forall.1 hnIndU with x hx,
      cases not_imp.1 hx with hxU hnn,
      rw not_not at hnn,
      use x,
      exact ⟨ hxU , hnn ⟩
    },
    {
      intros hDep hbot,
      cases hDep with x hx,
      cases hx with hxU hxCl,
      exact hbot x hxU hxCl,
    }
  end

  lemma IndepInsert : Indep U → Π (a : Carrier), (a ∉ Cl U) → Indep (U ∪ {a}) :=
  begin
    intros hU a haClU b hbUa hbot,
    cases hbUa,
    {
      have hExch : b ∈ Cl ((U \ {b}) ∪ {a}),
      {
        apply OrdMor _ hbot,
        intros x hx,
        cases hx with hxUa hxb,
        cases hxUa with hxU hxa,
        {
          left,
          split,
          exact hxU,
          exact hxb,
        },
        {
          right,
          exact hxa,
        },
      },
      cases Pregeometry.Exch hExch with hb ha,
      {apply hU b hbUa hb},
      {
        apply haClU,
        apply OrdMor _ ha,
        tidy,
      },
    },
    {
      have hba : b = a := set.mem_singleton_iff.1 hbUa,
      apply haClU,
      rw hba at hbot,
      apply OrdMor _ hbot,
      simp,
    },
  end

  lemma FinCharIndep :
    Indep U ↔ (Π (F : finset Carrier), (↑F ⊆ U) → Indep (F : set Carrier)) :=
  begin
    split,
    {
      intros hU F hsub,
      apply SubIndep hU F hsub,
    },
    {
      intros hFin a haU hbot,
      have Fp := FinCharProp hbot,
      cases Fp with hFU haF,
      have hsub : ↑(FinChar hbot) ∪ {a} ⊆ U,
      {
        intros x hx,
        cases hx,
        {
          have hsub : U \ {a} ⊆ U := by simp,
          apply hsub (hFU _),
          exact hx,
        },
        {
          rw (set.mem_singleton_iff.1 hx),
          exact haU,
        },
      },
      have ha : a ∈ (FinChar hbot : set Carrier) ∪ {a} := by simp,
      have hcoe : (FinChar hbot : set Carrier) ∪ {a} = ↑(FinChar hbot ∪ {a})
        := by simp,
      rw hcoe at hsub ha,
      apply hFin (FinChar hbot ∪ {a}) hsub a ha,
      have hsub1 : (FinChar hbot : set Carrier) ⊆ ↑(FinChar hbot ∪ {a}) \ {a},
      {
        intros x hx,
        simp,
        split,
        {exact hx},
        {
          intro hxa,
          cases hFU hx with _ hr,
          apply hr,
          simpa using hxa,
        },
      },
      apply OrdMor hsub1,
      exact haF,
    },
  end

  lemma BasisBetweenAux : U ⊆ V → V ⊆ W → Indep U → Spans V W →
    ∃ (B : set Carrier) (hB : B ∈ {Y : set Carrier | U ⊆ Y ∧ Y ⊆ V ∧ Indep Y}),
    U ⊆ B ∧
    ∀ (Y : set Carrier), Y ∈ {Y : set Carrier | U ⊆ Y ∧ Y ⊆ V ∧ Indep Y} → B ⊆ Y → Y = B :=
  λ hUV hVW hIndU hSpV,
    (@zorn.zorn_subset_nonempty Carrier { Y : set Carrier | U ⊆ Y ∧ Y ⊆ V ∧ Indep Y }
      (λ c hcsub hchain hc0,
        ⟨
          -- the upper bound by taking union
          ⋃₀ c ,
          ⟨
            let hUcup : U ⊆ ⋃₀ c :=
            begin
              cases hc0 with Y hY,
              cases hcsub hY with hUY hand,
              have hYcup : Y ⊆ ⋃₀ c := λ y hy , ⟨ Y , hY , hy ⟩,
              exact set.subset.trans hUY hYcup,
            end,
            hcupV : ⋃₀ c ⊆ V :=
            begin
              intros y hy,
              cases hy with Y hY,
              cases hY with hYc hyY,
              cases hcsub hYc with _ hYV,
              cases hYV with hYV,
              exact hYV hyY,
            end,
            hcupInd : Indep (⋃₀ c) :=
            begin
              rw FinCharIndep,
              intros F hF,
              -- F finite → F ⊆ Y for some Y ∈ c
              cases zorn.fin_sub_mem_chain_of_sub_union hchain hc0 F hF with Y hY,
              cases hY with hYc hFY,
              cases hcsub hYc with _ hY,
              cases hY with _ hIndY,
              apply SubIndep hIndY _ hFY,
            end in
            -- the upper bound is in the set
            ⟨ hUcup , hcupV , hcupInd ⟩ ,
            (λ Y hY y hy, ⟨ Y , hY , hy ⟩) -- showing the maximal element is in the set
          ⟩
        ⟩
      )
      U -- give U for the set being non-empty
      ⟨ set.subset.refl _ , hUV , hIndU ⟩)

  -- not sure if it would be better to have a lemma saying maximally independent elements
  -- are bases, the meat of the name theorem

  lemma BasisBetween : U ⊆ V → V ⊆ W → Indep U → Spans V W →
    ∃ (B : set Carrier), Basis B W ∧ U ⊆ B ∧ B ⊆ V :=
  begin
    intros hUV hVW hIndU hSpV,
    have hmax := BasisBetweenAux hUV hVW hIndU hSpV,
    cases hmax with B hB,
    cases hB with hB hmax,
    cases hmax with hUB hmax,
    use B,
    split,
    split,
    { -- B spans W
      -- it suffices that B spans V
      apply SpansTrans _ hSpV,
      -- it suffices that V ⊆ Cl B
      apply SubClSpans (set.subset.trans hB.2.1 (set.subset.refl _)),
      intros x hxV,
      by_cases hxB : x ∈ B,
      {exact Closure hxB},
      {
        -- we will show that B ∪ {x} is dependent, hence giving us an element y ∈ B to
        -- exchange with x
        have hDep : ¬ Indep (B ∪ {x}),
        {
          intro hInd,
          have hBx : B ∪ {x} ∈ {Y : set Carrier | U ⊆ Y ∧ Y ⊆ V ∧ Indep Y},
          {
            split,
            {apply (@set.subset.trans _ U B (B ∪ {x}) hUB), simp,},
            split,
            {
              simp only [set.union_singleton, set.insert_subset],
              exact ⟨ hxV , hB.2.1 ⟩,
            },
            {exact hInd},
          },
          apply hxB,
          rw ← (hmax (B ∪ {x}) hBx (by simp)),
          simp,
        },
        rw NotIndep at hDep,
        cases hDep with y hy,
        cases hy with hyU hyCl,
        by_cases hxy : x = y,
        {
          -- in the case when x = y we just added x to B then removed x again
          rw ← hxy at hyCl,
          rw set.remove_insert_not_mem hxB,
          exact hyCl,
        },
        {
          -- when x ≠ y we can exchange x for y
          have hB2 : (B ∪ {x}) \ {y} = (B \ {y}) ∪ {x} := set.union_sdiff hxy,
          rw hB2 at hyCl,
          have hyB : y ∈ B,
          {
            cases hyU,
            exact hyU,
            rw set.mem_singleton_iff at hyU,
            exfalso,
            apply hxy,
            rw hyU
          },
          cases Exch hyCl with hy hyCl1,
          {
            -- as B is independent the first case is false
            exfalso,
            apply hB.2.2 y hyB hy,
          },
          {
            -- now we have just removed and added y from B
            rw set.remove_insert hyB at hyCl1,
            exact hyCl1,
          },
        },
      },
    },
    {exact hB.2.2},
    {exact ⟨ hB.1 , hB.2.1 ⟩}
  end

  lemma IndepEmpty : @Indep X ∅ :=
  begin
    intros x hx,
    cases hx,
  end

  lemma UnivSpans : @Spans X set.univ set.univ :=
  begin
    split,
    simp,
  end

  lemma HasBasis : ∃ (B : set X.Carrier), Basis B set.univ :=
  begin
    cases BasisBetween (set.empty_subset _) (set.subset_univ _) IndepEmpty UnivSpans with B hB,
    exact ⟨ B , hB.1 ⟩,
  end

  def Degree (X) : cardinal := cardinal.mk (@classical.some _ _ (@HasBasis X))

end Pregeometry


import data.nat.prime
import data.int.modeq

/-
Let p be a prime number, and let a be an integer that is not divisible by p.
Prove that the congruence equation ax ≡ 1 mod p has a solution x ∈ ℤ.
-/

lemma mod_inv_exists (p : ℕ) (hp : prime p) (a : ℤ) (ha : ¬(↑p ∣ a)) : ∃x : ℤ, (a * x) ≡ 1 [ZMOD p] :=
begin
  sorry
end


-- BOTH:
import data.set.lattice
import data.nat.parity
import tactic

/- TEXT:
.. _sets:

Sets
----

.. index:: set operations

If ``α`` is any type, the type ``set α`` consists of sets
of elements of ``α``.
This type supports the usual set-theoretic operations and relations.
For example, ``s ⊆ t`` says that ``s`` is a subset of ``t``,
``s ∩ t`` denotes the intersection of ``s`` and ``t``,
and ``s ∪ t`` denotes their union.
The subset relation can be typed with ``\ss`` or ``\sub``,
intersection can be typed with ``\i`` or ``\cap``,
and union can be typed with ``\un`` or ``\cup``.
The library also defines the set ``univ``,
which consists of all the elements of type ``α``,
and the empty set, ``∅``, which can be typed as ``\empty``.
Given ``x : α`` and ``s : set α``,
the expression ``x ∈ s`` says that ``x`` is a member of ``s``.
Theorems that mention set membership often include ``mem``
in their name.
The expression ``x ∉ s`` abbreviates ``¬ x ∈ s``.
You can type ``∈`` as ``\in`` or ``\mem`` and ``∉`` as ``\notin``.

.. index:: simp, tactics ; simp

One way to prove things about sets is to use ``rw``
or the simplifier to expand the definitions.
In the second example below, we use ``simp only``
to tell the simplifier to use only the list
of identities we give it,
and not its full database of identities.
Unlike ``rw``, ``simp`` can perform simplifications
inside a universal or existential quantifier.
If you step through the proof,
you can see the effects of these commands.
TEXT. -/
-- BOTH:
section
-- QUOTE:
variable {α : Type*}
variables (s t u : set α)

open set

-- EXAMPLES:
example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
begin
  rw [subset_def, inter_def, inter_def],
  rw subset_def at h,
  dsimp,
  rintros x ⟨xs, xu⟩,
  exact ⟨h _ xs, xu⟩,
end

example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
begin
  simp only [subset_def, mem_inter_eq] at *,
  rintros x ⟨xs, xu⟩,
  exact ⟨h _ xs, xu⟩,
end
-- QUOTE.

/- TEXT:
In this example, we open the ``set`` namespace to have
access to the shorter names for the theorems.
But, in fact, we can delete the calls to ``rw`` and ``simp``
entirely:
TEXT. -/
-- QUOTE:
example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
begin
  intros x xsu,
  exact ⟨h xsu.1, xsu.2⟩
end
-- QUOTE.

/- TEXT:
What is going on here is known as *definitional reduction*:
to make sense of the ``intros`` command and the anonymous constructors
Lean is forced to expand the definitions.
The following examples also illustrate the phenomenon:
TEXT. -/
-- QUOTE:
theorem foo (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
λ x ⟨xs, xu⟩, ⟨h xs, xu⟩

example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
by exact λ x ⟨xs, xu⟩, ⟨h xs, xu⟩
-- QUOTE.

/- TEXT:
Due to a quirk of how Lean processes its input,
the first example fails if we replace ``theorem foo`` with ``example``.
This illustrates the pitfalls of relying on definitional reduction
too heavily.
It is often convenient,
but sometimes we have to fall back on unfolding definitions manually.

To deal with unions, we can use ``set.union_def`` and ``set.mem_union``.
Since ``x ∈ s ∪ t`` unfolds to ``x ∈ s ∨ x ∈ t``,
we can also use the ``cases`` tactic to force a definitional reduction.
TEXT. -/
-- QUOTE:
example : s ∩ (t ∪ u) ⊆ (s ∩ t) ∪ (s ∩ u) :=
begin
  intros x hx,
  have xs : x ∈ s := hx.1,
  have xtu : x ∈ t ∪ u := hx.2,
  cases xtu with xt xu,
  { left,
    show x ∈ s ∩ t,
    exact ⟨xs, xt⟩ },
  right,
  show x ∈ s ∩ u,
  exact ⟨xs, xu⟩
end
-- QUOTE.

/- TEXT:
Since intersection binds tighter than union,
the use of parentheses in the expression ``(s ∩ t) ∪ (s ∩ u)``
is unnecessary, but they make the meaning of the expression clearer.
The following is a shorter proof of the same fact:
TEXT. -/
-- QUOTE:
example : s ∩ (t ∪ u) ⊆ (s ∩ t) ∪ (s ∩ u) :=
begin
  rintros x ⟨xs, xt | xu⟩,
  { left, exact ⟨xs, xt⟩ },
  right, exact ⟨xs, xu⟩
end
-- QUOTE.

/- TEXT:
As an exercise, try proving the other inclusion:
BOTH: -/
-- QUOTE:
example : (s ∩ t) ∪ (s ∩ u) ⊆ s ∩ (t ∪ u):=
/- EXAMPLES:
sorry
SOLUTIONS: -/
begin
  rintros x (⟨xs, xt⟩ | ⟨xs, xu⟩),
  { use xs, left, exact xt },
  use xs, right, exact xu
end
-- QUOTE.
-- BOTH:

/- TEXT:
It might help to know that when using ``rintros``,
sometimes we need to use parentheses around a disjunctive pattern
``h1 | h2`` to get Lean to parse it correctly.

The library also defines set difference, ``s \ t``,
where the backslash is a special unicode character
entered as ``\\``.
The expression ``x ∈ s \ t`` expands to ``x ∈ s ∧ x ∉ t``.
(The ``∉`` can be entered as ``\notin``.)
It can be rewritten manually using ``set.diff_eq`` and ``dsimp``
or ``set.mem_diff``,
but the following two proofs of the same inclusion
show how to avoid using them.
TEXT. -/
-- QUOTE:
example : s \ t \ u ⊆ s \ (t ∪ u) :=
begin
  intros x xstu,
  have xs : x ∈ s := xstu.1.1,
  have xnt : x ∉ t := xstu.1.2,
  have xnu : x ∉ u := xstu.2,
  split,
  { exact xs }, dsimp,
  intro xtu, -- x ∈ t ∨ x ∈ u
  cases xtu with xt xu,
  { show false, from xnt xt },
  show false, from xnu xu
end

example : s \ t \ u ⊆ s \ (t ∪ u) :=
begin
  rintros x ⟨⟨xs, xnt⟩, xnu⟩,
  use xs,
  rintros (xt | xu); contradiction
end
-- QUOTE.

/- TEXT:
As an exercise, prove the reverse inclusion:
BOTH: -/
-- QUOTE:
example : s \ (t ∪ u) ⊆ s \ t \ u :=
/- EXAMPLES:
sorry
SOLUTIONS: -/
begin
  rintros x ⟨xs, xntu⟩,
  use xs,
  { intro xt, exact xntu (or.inl xt) },
  intro xu,
  apply xntu (or.inr xu)
end
-- QUOTE.
-- BOTH:

/- TEXT:
To prove that two sets are equal,
it suffices to show that every element of one is an element
of the other.
This principle is known as "extensionality,"
and, unsurprisingly,
the ``ext`` tactic is equipped to handle it.
TEXT. -/
-- QUOTE:
example : s ∩ t = t ∩ s :=
begin
  ext x,
  simp only [mem_inter_eq],
  split,
  { rintros ⟨xs, xt⟩, exact ⟨xt, xs⟩ },
  rintros ⟨xt, xs⟩, exact ⟨xs, xt⟩
end
-- QUOTE.

/- TEXT:
Once again, deleting the line ``simp only [mem_inter_eq]``
does not harm the proof.
In fact, if you like inscrutable proof terms,
the following one-line proof is for you:
TEXT. -/
-- QUOTE:
example : s ∩ t = t ∩ s :=
set.ext $ λ x, ⟨λ ⟨xs, xt⟩, ⟨xt, xs⟩, λ ⟨xt, xs⟩, ⟨xs, xt⟩⟩
-- QUOTE.

/- TEXT:
The dollar sign is a useful syntax:
writing ``f $ ...``
is essentially the same as writing ``f (...)``,
but it saves us the trouble of having to close
a set of parentheses at the end of a long expression.
Here is an even shorter proof,
using the simplifier:
TEXT. -/
-- QUOTE:
example : s ∩ t = t ∩ s :=
by ext x; simp [and.comm]
-- QUOTE.

/- TEXT:
An alternative to using ``ext`` is to use
the theorem ``subset.antisymm``
which allows us to prove an equation ``s = t``
between sets by proving ``s ⊆ t`` and ``t ⊆ s``.
TEXT. -/
-- QUOTE:
example : s ∩ t = t ∩ s :=
begin
  apply subset.antisymm,
  { rintros x ⟨xs, xt⟩, exact ⟨xt, xs⟩ },
  rintros x ⟨xt, xs⟩, exact ⟨xs, xt⟩
end
-- QUOTE.

/- TEXT:
Try finishing this proof term:
BOTH: -/
-- QUOTE:
example : s ∩ t = t ∩ s :=
/- EXAMPLES:
subset.antisymm sorry sorry
SOLUTIONS: -/
subset.antisymm (λ x ⟨xs, xt⟩, ⟨xt, xs⟩) (λ x ⟨xt, xs⟩, ⟨xs, xt⟩)
-- QUOTE.
-- BOTH:

/- TEXT:
Remember that you can replace `sorry` by an underscore,
and when you hover over it,
Lean will show you what it expects at that point.

Here are some set-theoretic identities you might enjoy proving:
TEXT. -/
-- QUOTE:
example : s ∩ (s ∪ t) = s :=
sorry

example : s ∪ (s ∩ t) = s :=
sorry

example : (s \ t) ∪ t = s ∪ t :=
sorry

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
sorry
-- QUOTE.

-- SOLUTIONS:
example : s ∩ (s ∪ t) = s :=
begin
  ext x, split,
  { rintros ⟨xs, _⟩, exact xs },
  intro xs,
  use xs, left, exact xs
end

example : s ∪ (s ∩ t) = s :=
begin
  ext x, split,
  { rintros (xs | ⟨xs, xt⟩); exact xs },
  intro xs, left, exact xs
end

example : (s \ t) ∪ t = s ∪ t :=
begin
  ext x, split,
  { rintros (⟨xs, nxt⟩ | xt),
    { left, exact xs},
    right, exact xt },
  by_cases h : x ∈ t,
  { intro _, right, exact h },
  rintros (xs | xt),
  { left, use [xs, h] },
  right, use xt
end

example : (s \ t) ∪ (t \ s) = (s ∪ t) \ (s ∩ t) :=
begin
  ext x, split,
  { rintros (⟨xs, xnt⟩ | ⟨xt, xns⟩),
    { split, left, exact xs,
      rintros ⟨_, xt⟩, contradiction },
    split , right, exact xt,
    rintros ⟨xs, _⟩, contradiction },
  rintros ⟨xs | xt, nxst⟩,
  { left, use xs, intro xt,
    apply nxst,
    split; assumption },
  right, use xt, intro xs,
  apply nxst,
  split; assumption
end

/- TEXT:
When it comes to representing sets,
here is what is going on underneath the hood.
In type theory, a *property* or *predicate* on a type ``α``
is just a function ``P : α → Prop``.
This makes sense:
given ``a : α``, ``P a`` is just the proposition
that ``P`` holds of ``a``.
In the library, ``set α`` is defined to be ``α → Prop`` and ``x ∈ s`` is defined to be ``s x``.
In other words, sets are really properties, treated as objects.

The library also defines set-builder notation.
The expression ``{ y | P y }`` unfolds to ``(λ y, P y)``,
so ``x ∈ { y | P y }`` reduces to ``P x``.
So we can turn the property of being even into the set of even numbers:
TEXT. -/
-- QUOTE:

def evens : set ℕ := {n | even n}
def odds :  set ℕ := {n | ¬ even n}

example : evens ∪ odds = univ :=
begin
  rw [evens, odds],
  ext n,
  simp,
  apply classical.em
end
-- QUOTE.

/- TEXT:
You should step through this proof and make sure
you understand what is going on.
Try deleting the line ``rw [evens, odds]``
and confirm that the proof still works.

In fact, set-builder notation is used to define

- ``s ∩ t`` as ``{x | x ∈ s ∧ x ∈ t}``,
- ``s ∪ t`` as ``{x | x ∈ s ∨ x ∈ t}``,
- ``∅`` as ``{x | false}``, and
- ``univ`` as ``{x | true}``.

We often need to indicate the type of ``∅`` and ``univ``
explicitly,
because Lean has trouble guessing which ones we mean.
The following examples show how Lean unfolds the last
two definitions when needed. In the second one,
``trivial`` is the canonical proof of ``true`` in the library.
TEXT. -/
-- QUOTE:
example (x : ℕ) (h : x ∈ (∅ : set ℕ)) : false :=
h

example (x : ℕ) : x ∈ (univ : set ℕ) :=
trivial
-- QUOTE.

/- TEXT:
As an exercise, prove the following inclusion.
Use ``intro n`` to unfold the definition of subset,
and use the simplifier to reduce the
set-theoretic constructions to logic.
We also recommend using the theorems
``nat.prime.eq_two_or_odd`` and ``nat.even_iff``.
TEXT. -/
-- QUOTE:
example : { n | nat.prime n } ∩ { n | n > 2} ⊆ { n | ¬ even n } :=
sorry
-- QUOTE.

-- SOLUTIONS:
example : { n | nat.prime n } ∩ { n | n > 2} ⊆ { n | ¬ even n } :=
begin
  intro n,
  simp,
  intro nprime,
  cases nat.prime.eq_two_or_odd nprime with h h,
  { rw h, intro, linarith },
  rw [nat.even_iff, h],
  norm_num
end

/- TEXT:
Be careful: it is somewhat confusing that the library has multiple versions
of the predicate ``prime``.
The most general one makes sense in any commutative monoid with a zero element.
The predicate ``nat.prime`` is specific to the natural numbers.
Fortunately, there is a theorem that says that in the specific case,
the two notions agree, so you can always rewrite one to the other.
TEXT. -/
-- QUOTE:
#print prime
#print nat.prime

example (n : ℕ) : prime n ↔ nat.prime n := nat.prime_iff.symm

example (n : ℕ) (h : prime n) : nat.prime n :=
by { rw nat.prime_iff, exact h }
-- QUOTE.

/- TEXT:
.. index:: rwa, tactics ; rwa

The `rwa` tactic follows a rewrite with the assumption tactic.
TEXT. -/
-- QUOTE:
example (n : ℕ) (h : prime n) : nat.prime n :=
by rwa nat.prime_iff
-- QUOTE.

-- BOTH:
end
/- TEXT:
.. index:: bounded quantifiers

Lean introduces the notation ``∀ x ∈ s, ...``,
"for every ``x`` in ``s`` .,"
as an abbreviation for  ``∀ x, x ∈ s → ...``.
It also introduces the notation ``∃ x ∈ s, ...,``
"there exists an ``x`` in ``s`` such that .."
These are sometimes known as *bounded quantifiers*,
because the construction serves to restrict their significance
to the set ``s``.
As a result, theorems in the library that make use of them
often contain ``ball`` or ``bex`` in the name.
The theorem ``bex_def`` asserts that ``∃ x ∈ s, ...`` is equivalent
to ``∃ x, x ∈ s ∧ ...,``
but when they are used with ``rintros``, ``use``,
and anonymous constructors,
these two expressions behave roughly the same.
As a result, we usually don't need to use ``bex_def``
to transform them explicitly.
Here is are some examples of how they are used:
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables (s t : set ℕ)

-- EXAMPLES:
example (h₀ : ∀ x ∈ s, ¬ even x) (h₁ : ∀ x ∈ s, prime x) :
  ∀ x ∈ s, ¬ even x ∧ prime x :=
begin
  intros x xs,
  split,
  { apply h₀ x xs },
  apply h₁ x xs
end

example (h : ∃ x ∈ s, ¬ even x ∧ prime x) :
  ∃ x ∈ s, prime x :=
begin
  rcases h with ⟨x, xs, _, prime_x⟩,
  use [x, xs, prime_x]
end
-- QUOTE.

/- TEXT:
See if you can prove these slight variations:
TEXT. -/
-- QUOTE:
section
variable (ssubt : s ⊆ t)

include ssubt

example (h₀ : ∀ x ∈ t, ¬ even x) (h₁ : ∀ x ∈ t, prime x) :
  ∀ x ∈ s, ¬ even x ∧ prime x :=
sorry

example (h : ∃ x ∈ s, ¬ even x ∧ prime x) :
  ∃ x ∈ t, prime x :=
sorry

end
-- QUOTE.

-- SOLUTIONS:
section
variable (ssubt : s ⊆ t)

include ssubt

example (h₀ : ∀ x ∈ t, ¬ even x) (h₁ : ∀ x ∈ t, prime x) :
  ∀ x ∈ s, ¬ even x ∧ prime x :=
begin
  intros x xs,
  split,
  { apply h₀ x (ssubt xs) },
  apply h₁ x (ssubt xs)
end

example (h : ∃ x ∈ s, ¬ even x ∧ prime x) :
  ∃ x ∈ t, prime x :=
begin
  rcases h with ⟨x, xs, _, px⟩,
  use [x, ssubt xs, px]
end

end

-- BOTH:
end

/- TEXT:
.. index:: include, commands; include

The ``include`` command is needed because ``ssubt`` does not
appear in the statement of the theorem.
Lean does not look inside tactic blocks when it decides
what variables and hypotheses to include,
so if you delete that line,
you will not see the hypothesis within a ``begin .end`` proof.
If you are proving theorems in a library,
you can delimit the scope of and ``include`` by putting it
between ``section`` and ``end``,
so that later theorems do not include it as an unnecessary hypothesis.

Indexed unions and intersections are
another important set-theoretic construction.
We can model a sequence :math:`A_0, A_1, A_2, \ldots` of sets of
elements of ``α``
as a function ``A : ℕ → set α``,
in which case ``⋃ i, A i`` denotes their union,
and ``⋂ i, A i`` denotes their intersection.
There is nothing special about the natural numbers here,
so ``ℕ`` can be replaced by any type ``I``
used to index the sets.
The following illustrates their use.
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {α I : Type*}
variables A B : I → set α
variable  s : set α
open set

-- EXAMPLES:
example : s ∩ (⋃ i, A i) = ⋃ i, (A i ∩ s) :=
begin
  ext x,
  simp only [mem_inter_eq, mem_Union],
  split,
  { rintros ⟨xs, ⟨i, xAi⟩⟩,
    exact ⟨i, xAi, xs⟩ },
  rintros ⟨i, xAi, xs⟩,
  exact ⟨xs, ⟨i, xAi⟩⟩
end

example : (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i) :=
begin
  ext x,
  simp only [mem_inter_eq, mem_Inter],
  split,
  { intro h,
    split,
    { intro i,
      exact (h i).1 },
    intro i,
    exact (h i).2 },
  rintros ⟨h1, h2⟩ i,
  split,
  { exact h1 i },
  exact h2 i
end
-- QUOTE.

/- TEXT:
Parentheses are often needed with an
indexed union or intersection because,
as with the quantifiers,
the scope of the bound variable extends as far as it can.

Try proving the following identity.
One direction requires classical logic!
We recommend using ``by_cases xs : x ∈ s``
at an appropriate point in the proof.
TEXT. -/
-- QUOTE:
open_locale classical

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
sorry
-- QUOTE.

-- SOLUTIONS:
example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
begin
  ext x,
  simp only [mem_union, mem_Inter],
  split,
  { rintros (xs | xI),
    { intro i, right, exact xs },
    intro i, left, exact xI i },
  intro h,
  by_cases xs : x ∈ s,
  { left, exact xs },
  right,
  intro i,
  cases h i,
  { assumption },
  contradiction
end

/- TEXT:
Mathlib also has bounded unions and intersections,
which are analogous to the bounded quantifiers.
You can unpack their meaning with ``mem_Union₂``
and ``mem_Inter₂``.
As the following examples show,
Lean's simplifier carries out these replacements as well.
TEXT. -/
-- QUOTE:
-- BOTH:
def primes : set ℕ := {x | nat.prime x}

-- EXAMPLES:
example : (⋃ p ∈ primes, {x | p^2 ∣ x}) = {x | ∃ p ∈ primes, p^2 ∣ x} :=
by { ext, rw mem_Union₂, refl }

example : (⋃ p ∈ primes, {x | p^2 ∣ x}) = {x | ∃ p ∈ primes, p^2 ∣ x} :=
by { ext, simp }

example : (⋂ p ∈ primes, {x | ¬ p ∣ x}) ⊆ {x | x = 1} :=
begin
  intro x,
  contrapose!,
  simp,
  apply nat.exists_prime_and_dvd
end
-- QUOTE.

/- TEXT:
Try solving the following example, which is similar.
If you start typing ``eq_univ``,
tab completion will tell you that ``apply eq_univ_of_forall``
is a good way to start the proof.
We also recommend using the theorem ``nat.exists_infinite_primes``.
TEXT. -/
-- QUOTE:
example : (⋃ p ∈ primes, {x | x ≤ p}) = univ :=
sorry
-- QUOTE.

-- SOLUTIONS:
example : (⋃ p ∈ primes, {x | x ≤ p}) = univ :=
begin
  apply eq_univ_of_forall,
  intro x,
  simp,
  rcases nat.exists_infinite_primes x with ⟨p, primep, pge⟩,
  use [p, pge, primep]
end

-- BOTH:
end

/- TEXT:
Give a collection of sets, ``s : set (set α)``,
their union, ``⋃₀ s``, has type ``set α``
and is defined as ``{x | ∃ t ∈ s, x ∈ t}``.
Similarly, their intersection, ``⋂₀ s``, is defined as
``{x | ∀ t ∈ s, x ∈ t}``.
These operations are called ``sUnion`` and ``sInter``, respectively.
The following examples show their relationship to bounded union
and intersection.
TEXT. -/
section
open set

-- QUOTE:
variables {α : Type*} (s : set (set α))

example : ⋃₀ s = ⋃ t ∈ s, t :=
begin
  ext x,
  rw mem_Union₂,
  refl
end

example : ⋂₀ s = ⋂ t ∈ s, t :=
begin
  ext x,
  rw mem_Inter₂,
  refl
end
-- QUOTE.

end

/- TEXT:
In the library, these identities are called
``sUnion_eq_bUnion`` and ``sInter_eq_bInter``.
TEXT. -/


import MyNat.Definition
namespace MyNat
open MyNat
/-!
# Proposition world.

## Level 9: a big maze.

Hint: Lean's "congruence closure" tactic `cc` is good at mazes. You might want to try it now.
Perhaps I should have mentioned it earlier.

## Lemma
There is a way through the following maze.
-/
example (A B C D E F G H I J K L : Prop)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L := by
  intro a
  apply f15
  apply f11
  apply f9
  apply f8
  apply f5
  apply f2
  apply f1
  assumption

-- BUGBUG: NNG uses cc which is missing in lean4...

/-!
Now move onto [advanced proposition world](../AdvancedPropositionWorld.lean.md), where you will see
how to prove goals such as `P ∧ Q` (`P` and `Q`), `P ∨ Q` (`P` or `Q`),
`P ↔ Q` (`P ⟺ Q`).
You will need to learn five more tactics: `split`, `cases`,
`left`, `right`, and `exfalso`,
but they are all straightforward, and furthermore they are
essentially the last tactics you
need to learn in order to complete all the levels of this tutorial,
including all the 17 levels of [Inequality World](../InequalityWorld.lean.md).
-/

/-!
Next up [advanced proposition world](../AdvancedPropositionWorld.lean.md).
-/