/-
Copyright (c) 2021 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import topology.algebra.order.basic
import topology.constructions

/-!
# Topological lattices

In this file we define mixin classes `has_continuous_inf` and `has_continuous_sup`. We define the
class `topological_lattice` as a topological space and lattice `L` extending `has_continuous_inf`
and `has_continuous_sup`.

## References

* [Gierz et al, A Compendium of Continuous Lattices][GierzEtAl1980]

## Tags

topological, lattice
-/

open filter
open_locale topological_space

/--
Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be an infimum. Then `L` is said to have *(jointly) continuous infimum* if the map
`⊓:L×L → L` is continuous.
-/
class has_continuous_inf (L : Type*) [topological_space L] [has_inf L] : Prop :=
(continuous_inf : continuous (λ p : L × L, p.1 ⊓ p.2))

/--
Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be a supremum. Then `L` is said to have *(jointly) continuous supremum* if the map
`⊓:L×L → L` is continuous.
-/
class has_continuous_sup (L : Type*) [topological_space L] [has_sup L] : Prop :=
(continuous_sup : continuous (λ p : L × L, p.1 ⊔ p.2))

@[priority 100] -- see Note [lower instance priority]
instance order_dual.has_continuous_sup
  (L : Type*) [topological_space L] [has_inf L] [has_continuous_inf L] :
  has_continuous_sup (order_dual L) :=
{ continuous_sup := @has_continuous_inf.continuous_inf L _ _ _ }

@[priority 100] -- see Note [lower instance priority]
instance order_dual.has_continuous_inf
  (L : Type*) [topological_space L] [has_sup L] [has_continuous_sup L] :
  has_continuous_inf (order_dual L) :=
{ continuous_inf := @has_continuous_sup.continuous_sup L _ _ _ }

/--
Let `L` be a lattice equipped with a topology such that `L` has continuous infimum and supremum.
Then `L` is said to be a *topological lattice*.
-/
class topological_lattice (L : Type*) [topological_space L] [lattice L]
  extends has_continuous_inf L, has_continuous_sup L

@[priority 100] -- see Note [lower instance priority]
instance order_dual.topological_lattice
  (L : Type*) [topological_space L] [lattice L] [topological_lattice L] :
  topological_lattice (order_dual L) := {}

variables {L : Type*} [topological_space L]
variables {X : Type*} [topological_space X]

@[continuity] lemma continuous_inf [has_inf L] [has_continuous_inf L] :
  continuous (λp:L×L, p.1 ⊓ p.2) :=
has_continuous_inf.continuous_inf

@[continuity] lemma continuous.inf [has_inf L] [has_continuous_inf L]
  {f g : X → L} (hf : continuous f) (hg : continuous g) :
  continuous (λx, f x ⊓ g x) :=
continuous_inf.comp (hf.prod_mk hg : _)

@[continuity] lemma continuous_sup [has_sup L] [has_continuous_sup L] :
  continuous (λp:L×L, p.1 ⊔ p.2) :=
has_continuous_sup.continuous_sup

@[continuity] lemma continuous.sup [has_sup L] [has_continuous_sup L]
  {f g : X → L} (hf : continuous f) (hg : continuous g) :
  continuous (λx, f x ⊔ g x) :=
continuous_sup.comp (hf.prod_mk hg : _)

lemma filter.tendsto.sup_right_nhds' {ι β} [topological_space β] [has_sup β] [has_continuous_sup β]
  {l : filter ι} {f g : ι → β} {x y : β}
  (hf : tendsto f l (𝓝 x)) (hg : tendsto g l (𝓝 y)) :
  tendsto (f ⊔ g) l (𝓝 (x ⊔ y)) :=
(continuous_sup.tendsto _).comp (tendsto.prod_mk_nhds hf hg)

lemma filter.tendsto.sup_right_nhds {ι β} [topological_space β] [has_sup β] [has_continuous_sup β]
  {l : filter ι} {f g : ι → β} {x y : β}
  (hf : tendsto f l (𝓝 x)) (hg : tendsto g l (𝓝 y)) :
  tendsto (λ i, f i ⊔ g i) l (𝓝 (x ⊔ y)) :=
hf.sup_right_nhds' hg

lemma filter.tendsto.inf_right_nhds' {ι β} [topological_space β] [has_inf β] [has_continuous_inf β]
  {l : filter ι} {f g : ι → β} {x y : β}
  (hf : tendsto f l (𝓝 x)) (hg : tendsto g l (𝓝 y)) :
  tendsto (f ⊓ g) l (𝓝 (x ⊓ y)) :=
(continuous_inf.tendsto _).comp (tendsto.prod_mk_nhds hf hg)

lemma filter.tendsto.inf_right_nhds {ι β} [topological_space β] [has_inf β] [has_continuous_inf β]
  {l : filter ι} {f g : ι → β} {x y : β}
  (hf : tendsto f l (𝓝 x)) (hg : tendsto g l (𝓝 y)) :
  tendsto (λ i, f i ⊓ g i) l (𝓝 (x ⊓ y)) :=
hf.inf_right_nhds' hg


import tactic.ext
import tactic.linarith
import pending_lemmas

open list

variables {R : Type*} {I : Type*} (op : R → R → R) (nil: R)
          (r : list I) (P : I → Prop) [decidable_pred P] (F : I → R)

local infix ` ◆ `:70 := op -- type using \di

/- Starting from `F : I → R`, `r : list I`, a composition law `op` on `R`,
   a element `nil` in R, and a decidable predicate `P` on `I`,
   `apply_bigop op nil r P F` is the big "product", for operation `op`,
   of all `F i` for `i` in `r` if `P i`. All parenthesis are closed after
   inserting `nil` at the very end, like in `(a op (b op (c op nil)))`
   (using infix notation for op) -/
def apply_bigop := foldr (λ i, op (F i)) nil (filter P r)

-- alternate definition : foldr (λ i x, if P i then op (F i) x else x) nil r

/- We now define a notation with many variations depending on the list,
   predicate, operation -/

/- variable in filtered list -/

notation `big[`:0 op`/`:0 nil`]_(`:0 binder `∈` r `|` P:(scoped p, p)`)` F:(scoped f, f) :=
apply_bigop op nil r P F

notation `Σ_(`:0 binder `∈` r `|` P:(scoped p, p) `)` F:(scoped f, f) :=
apply_bigop (+) 0 r P F

notation `Π_(`:0 binder `∈` r `|` P:(scoped p, p) `)` F:(scoped f, f) :=
apply_bigop (*) 1 r P F

/- variable in unfiltered list -/

notation `big[`:0 op `/`:0 nil `]_(`:0 binder `∈` r `)` F:(scoped f, f) :=
apply_bigop op nil r (λ i, true) F

notation `Σ_(`:0 binder `∈` r `)` F:(scoped f, f) :=
apply_bigop (+) 0 r (λ i, true) F

notation `Π_(`:0 binder `∈` r `)` F:(scoped f, f) :=
apply_bigop (*) 1 r (λ i, true) F

/- variable is integers from a to b, b exclued, filtered -/

notation `big[`op`/`:0 nil`]_(`:0 binder`=`a`..`b `|` P:(scoped p, p)`)` F:(scoped f, f) :=
apply_bigop op nil (int.range a b) P F

notation `Σ_(`:0 binder`=`a`..`b `|` P:(scoped p, p)`)` F:(scoped f, f) :=
apply_bigop (+) 0 (int.range a b) P F

notation `Π_(`:0 binder`=`a`..` b `|` P:(scoped p, p)`)` F:(scoped f, f) :=
apply_bigop (*) 1 (int.range a b) P F

/- variable is integers from a to b, b exclued, unfiltered -/

notation `big[`:0 op `/`:0 nil `]_(`:0 binder `=` a `..` b `)` F:(scoped f, f) :=
apply_bigop op nil (int.range a b) (λ i, true) F

notation `Σ_(`:0 binder `=` a `..` b `)` F:(scoped f, f) :=
apply_bigop (+) 0 (int.range a b) (λ i, true) F

notation `Π_(`:0 binder `=` a `..` b `)` F:(scoped f, f) :=
apply_bigop (*) 1 (int.range a b) (λ i, true) F

local notation `?(F` h`)` := if P h then F h else nil

/- First lemmas, without assuming anything on `op` and `nil` -/

@[simp]
lemma big.nil : (big[(◆)/nil]_(i ∈ [] | (P i)) (F i)) = nil :=
by simp [apply_bigop]

lemma big.filter_mem [decidable_pred (λ i, i ∈ r)] :
  (big[(◆)/nil]_(i ∈ r) (F i)) = (big[(◆)/nil]_(i ∈ r | i ∈ r) (F i)) :=
by simp [apply_bigop]

lemma big_cons_true {h} (t) (Ph : P h) :
  (big[(◆)/nil]_(i ∈ h::t | (P i)) (F i)) = F h ◆ (big[(◆)/nil]_(i ∈ t | (P i)) (F i)):=
by simp [apply_bigop, Ph]

lemma big_cons_false {h} (t) (Ph : ¬ P h) :
  (big[(◆)/nil]_(i ∈ h::t | (P i)) (F i)) = (big[(◆)/nil]_(i ∈ t | (P i)) (F i)) :=
by simp [apply_bigop, Ph]

lemma big_rec (K : R → Prop) (Knil : K nil) (Kop : ∀ i x, P i → K x → K ((F i) ◆ x)) :
  K (big[(◆)/nil]_(i ∈ r | (P i)) (F i)) :=
begin
  induction r with h t IH,
  { simp[big.nil, Knil] },
  { by_cases H : P h,
    { simp [big_cons_true, H, Kop _ _ H IH] },
    { simp [big_cons_false, H, IH] } }
end

lemma big_ind (K : R → Prop) (Knil : K nil) (Kop : ∀ x y, K x → K y → K (x ◆ y))
(K_F : ∀ i, P i → K (F i)) :
  K (big[(◆)/nil]_(i ∈ r | (P i)) (F i)) :=
begin
  apply big_rec,
    exact Knil,
  intros i x P_i K_x,
  apply Kop ; tauto
end

lemma big_append_eq_of_not_mem [decidable_eq I] {j} (H : j ∉ r) :
  (big[(◆)/nil]_(i ∈ j::r | ((P i) ∧ i ≠ j)) (F i)) = big[(◆)/nil]_(i ∈ r | (P i)) (F i) :=
begin
  unfold apply_bigop,
  congr' 1,
  rw list.filter_cons_of_neg,
  apply list.filter_congr,
  { intros x x_in,
    simp [show x ≠ j, by { intro H', rw ←H' at H, contradiction }] },
  { finish }
end

-- A version of extensionality where we assume same (◆)/nil and same list
lemma big.ext (P') [decidable_pred P'] (F' : I → R)
  (HP : ∀ i ∈ r, P i ↔ P' i) (HF : ∀ i ∈ r, F i = F' i) :
  (big[(◆)/nil]_(i ∈ r | (P i)) (F i)) = (big[(◆)/nil]_(i ∈ r | (P' i)) (F' i)) :=
begin
  unfold apply_bigop,
  rw list.filter_congr HP,
  apply list.foldr_ext,
  intros _ i_r _,
  simp[HF, mem_filter.1 i_r]
end

lemma big.map {J : Type*} (f : I → J) (P : J → Prop) [decidable_pred P] (F : J → R) :
  (big[(◆)/nil]_(j ∈ map f r | (P j)) (F j)) = (big[(◆)/nil]_(i ∈ r | (P (f i))) (F (f i))) :=
by simp[apply_bigop, filter_map_comm, foldr_map]

--set_option pp.all true

lemma big.empty_range (P : ℤ → Prop) [decidable_pred P] (F : ℤ → R) (a b : ℤ)
  (H : b ≤ a) : (big[(◆)/nil]_(i=a..b | (P i)) (F i)) = nil :=
begin
  convert big.nil op nil P F,
  exact (int.range_eq_nil _ _).2 H
end

lemma big.shift (P : ℤ → Prop) [decidable_pred P] (F : ℤ → R) (a b k : ℤ) :
  (big[(◆)/nil]_(i=a..b | (P i)) (F i)) = (big[(◆)/nil]_(i=(a+k)..(b+k) | (P (i-k))) (F (i-k))) :=
begin
  rw [int.range_shift, big.map],
  congr ; ext ; ring
end

/- Now we go towards assuming (R, op, nil) is a monoid -/

/- Also need to make sure old hierarchy talks to new one.
   Associativity seems ok but we need: -/
instance add_monoid_is_left_id (α : Type*) [add_monoid α] : is_left_id α (+) 0 := ⟨by simp⟩

instance add_monoid_is_right_id (α : Type*) [add_monoid α] : is_right_id α (+) 0 := ⟨by simp⟩

instance monoid_is_left_id (α : Type*) [monoid α] : is_left_id α (*) 1 := ⟨by simp⟩

instance monoid_is_right_id (α : Type*) [monoid α] : is_right_id α (*) 1 := ⟨by simp⟩

section nil_left_id
/- Assuming only that nil is left neutral for op -/
variable [is_left_id R op nil]
open is_left_id

lemma big.cons {h} (t) :
  (big[(◆)/nil]_(i ∈ h::t | (P i)) (F i)) = ?(F h) ◆ (big[(◆)/nil]_(i ∈ t | (P i)) (F i)):=
begin
  by_cases H : P h,
  { simp [H, big_cons_true] },
  { simp [H, big_cons_false, left_id op] }
end
end nil_left_id

section nil_right_id
/- Assuming only that nil is left neutral for op -/
variable [is_right_id R op nil]
open is_right_id

lemma big.one_term (i₀ : I) : (big[(◆)/nil]_(i ∈ [i₀]) F i) = F i₀ :=
by simp [apply_bigop, right_id op]

lemma big.one_term' (i₀ : I) :
  (big[(◆)/nil]_(i ∈ [i₀] | P i) F i) = if P i₀ then F i₀ else nil :=
by by_cases H : P i₀;  simp [H, apply_bigop, right_id op]

end nil_right_id

section left_monoid
/- Assume that (R, op) is almost a monoid with neutral element nil -/

variables [is_left_id R op nil] [is_associative R op]
open is_left_id is_associative

lemma big.append (r₁ r₂ : list I) :
  (big[(◆)/nil]_(i ∈ r₁++r₂ | (P i)) (F i)) =
  (big[(◆)/nil]_(i ∈ r₁ | (P i)) (F i)) ◆ (big[(◆)/nil]_(i ∈ r₂ | (P i)) (F i)) :=
begin
  let Op := λ l, big[(◆)/nil]_(i ∈ l | (P i)) (F i),
  induction r₁ with h t IH,
  { exact (eq.symm $ calc
    Op [] ◆ Op r₂ =  nil ◆ (big[(◆)/nil]_(i ∈ r₂ | P i)F i) : by {dsimp [Op], rw big.nil}
    ... = _ : left_id _ _ )},
  { have : ?(F h) ◆ Op t = Op (h :: t) :=
    eq.symm (big.cons _ _ _ _ _),
    exact calc
    Op (h :: t ++ r₂)
        = Op (h :: (t ++ r₂))      : rfl
    ... = ?(F h) ◆ Op (t ++ r₂)    : big.cons _ _ _ _ _
    ... = ?(F h) ◆ (Op t ◆ Op r₂)  : by simp [Op, IH]
    ... = (?(F h) ◆ Op t) ◆ Op r₂  : eq.symm $ assoc _ _ _ _
    ... = Op (h::t) ◆ Op r₂        : by rw this }
end
end left_monoid

section monoid
variables [is_left_id R op nil] [is_right_id R op nil] [is_associative R op]
open is_left_id is_right_id is_associative

lemma big.concat (i) :
  (big[(◆)/nil]_(j ∈ concat r i | (P j)) (F j)) =
  (big[(◆)/nil]_(j ∈ r | (P j)) (F j)) ◆ (if P i then F i else nil) :=
by simp [big.append,big.one_term']

lemma big.concat_true (i) :
  (big[(◆)/nil]_(i ∈ concat r i) (F i)) =
  (big[(◆)/nil]_(i ∈ r) (F i)) ◆ F i :=
by apply big.concat

lemma big.concat_range_true (F : ℤ → R) {a b : ℤ} (h : a < b) :
  (big[(◆)/nil]_(i =a..b) (F i)) =
  (big[(◆)/nil]_(i =a..b-1) (F i)) ◆ F (b-1) :=
by rw int_range_eq_concat h ; apply big.concat_true

lemma big.commute_through {a : R} (H : ∀ i, P i → a ◆ F i = F i ◆ a) :
  a ◆ (big[(◆)/nil]_(i ∈ r | (P i)) F i) = (big[(◆)/nil]_(i ∈ r | (P i)) (F i)) ◆ a :=
 begin
  let K := λ x, (a ◆ x = x ◆ a),
  change K (big[(◆)/nil]_(i ∈ r | (P i)) F i),
  apply big_ind ; dsimp [K],
  { simp [left_id op, right_id op] },
  { intros x y xop yop,
    rw [assoc op, ←assoc op, xop, ← yop, assoc op]},
  { exact H }
end

lemma big.reverse_of_commute (H : ∀ i j, P i  → P j → F i ◆ F j = F j ◆ F i) :
  (big[(◆)/nil]_(i ∈ r | (P i)) F i) = (big[(◆)/nil]_(i ∈ reverse r | (P i)) (F i)) :=
begin
  induction r with h t IH,
  { simp },
  { rw [big.cons, reverse_cons, ←concat_eq_append, big.concat],
    by_cases Ph : P h,
    { simp only [Ph],
      rw IH,
      apply big.commute_through,
      simp * {contextual := true } },
    { simp [Ph, left_id op, right_id op, IH, H] { contextual := true } } }
end

lemma big.reverse_range_of_commute (P : ℤ → Prop) [decidable_pred P] (F : ℤ → R) (a b : ℤ) (H : ∀ i j, P i  → P j → F i ◆ F j = F j ◆ F i) :
  (big[(◆)/nil]_(i=a..b | (P i)) F i) = (big[(◆)/nil]_(i=a..b | (P (a+b-i-1))) (F (a+b-i-1))) :=
by rw [big.reverse_of_commute _ _ _ _ _ H, reverse_int_range_map_int_range, big.map]

lemma big.gather_of_commute (F G : I → R) [decidable_eq I]
  (H : ∀ n n' (h : n < r.length) (h' : n' < r.length),
    n ≠ n' → F (r.nth_le n h) ◆ G (r.nth_le n' h') = G (r.nth_le n' h') ◆ F (r.nth_le n h)) :
  (big[(◆)/nil]_(i ∈ r) F i) ◆ (big[(◆)/nil]_(i ∈ r) G i) =
  big[(◆)/nil]_(i ∈ r) F i ◆ G i :=
begin
  induction r with a t IH,
  { simp,
    rw left_id op },
  { have key : ∀ i ∈ t, G a ◆ F i = F i ◆ G a,
    { intros i i_in,
      rcases nth_le_of_mem i_in with ⟨n, h, Hn⟩,
      specialize H (n+1) 0 (nat.succ_lt_succ h) (nat.succ_pos _),
      simp at H,
      rw ←Hn,
      exact H.symm },
    simp only [big_cons_true] ,
    conv_lhs {
      rw assoc op,
      congr, skip,
      rw ←assoc op,
      congr,
      rw big.filter_mem,
      rw ←big.commute_through _ _ _ _ _ key,
    },
    rw [assoc op, assoc op, ←big.filter_mem],
    congr,
    apply IH,
    introv neq,
    replace neq : n + 1 ≠ n' + 1 := λ hneq, neq (nat.succ_inj hneq),
    specialize H (n+1) (n'+1) (nat.succ_lt_succ h) (nat.succ_lt_succ h') neq,
    rwa nth_le_cons at H },
end

lemma big.gather_of_commute_int (F G : ℤ → R) (a b) (H : ∀ i j, i ≠ j → F i ◆ G j = G j ◆ F i) :
  (big[(◆)/nil]_(i = a..b) F i) ◆ (big[(◆)/nil]_(i = a..b) G i) = big[(◆)/nil]_(i = a..b) F i ◆ G i :=
begin
  apply big.gather_of_commute,
  introv neq,
  apply H,
  simp [int.range, neq],
end

lemma apply_ite {nil : R} {φ : R → R} (Hnil : φ nil = nil) (h : I) :
  φ (ite (P h) (F h) nil) = ite (P h) (φ (F h)) nil :=
calc
      φ (ite (P h) (F h) nil) = ite (P h) (φ $ F h) (φ nil) : by { by_cases H : P h; simp[H] }
      ... = ite (P h) (φ $ F h) nil : by rw Hnil

lemma big.mph {φ : R → R}
  (Hop : ∀ a b : R, φ (a ◆ b) = φ a ◆ φ b) (Hnil : φ nil = nil) :
  φ (big[(◆)/nil]_(i ∈ r | (P i)) F i) = big[(◆)/nil]_(i ∈ r | (P i)) φ (F i) :=
begin
  induction r with h t IH,
  { simp [big.nil, Hnil] },
  { rw [big.cons, Hop, IH, apply_ite _ _ Hnil, ←(big.cons op nil P _ t)] }
end

lemma big.anti_mph {φ : R → R}
  (Hop : ∀ a b : R, φ (a ◆ b) = φ b ◆ φ a) (Hnil : φ nil = nil) :
  φ (big[(◆)/nil]_(i ∈ r | (P i)) F i) = big[(◆)/nil]_(i ∈ r.reverse | (P i)) φ (F i) :=
begin
  induction r with h t IH,
  { simp [big.nil, Hnil] },
  { rw [big.cons, Hop, apply_ite _ _ Hnil, reverse_cons', concat_eq_append, big.append, IH, big.one_term'] }
end

lemma big.range_anti_mph {φ : R → R} (P : ℤ → Prop) [decidable_pred P] (F : ℤ → R) (a b : ℤ)
  (Hop : ∀ a b : R, φ (a ◆ b) = φ b ◆ φ a) (Hnil : φ nil = nil) :
  φ (big[(◆)/nil]_(i=a..b | (P i)) F i) = big[(◆)/nil]_(i=a..b | (P (a+b-i-1))) φ (F (a+b-i-1)) :=
by rw [big.anti_mph _ _ _ _ _ Hop Hnil, reverse_int_range_map_int_range, big.map]

end monoid


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.set.pointwise.smul
import algebra.support

/-!
# Support of a function composed with a scalar action

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

We show that the support of `x ↦ f (c⁻¹ • x)` is equal to `c • support f`.
-/

open_locale pointwise
open function set

section group

variables {α β γ : Type*} [group α] [mul_action α β]

lemma mul_support_comp_inv_smul [has_one γ] (c : α) (f : β → γ) :
  mul_support (λ x, f (c⁻¹ • x)) = c • mul_support f :=
by { ext x, simp only [mem_smul_set_iff_inv_smul_mem, mem_mul_support] }

lemma support_comp_inv_smul [has_zero γ] (c : α) (f : β → γ) :
  support (λ x, f (c⁻¹ • x)) = c • support f :=
by { ext x, simp only [mem_smul_set_iff_inv_smul_mem, mem_support] }

attribute [to_additive support_comp_inv_smul] mul_support_comp_inv_smul

end group

section group_with_zero

variables {α β γ : Type*} [group_with_zero α] [mul_action α β]

lemma mul_support_comp_inv_smul₀ [has_one γ] {c : α} (hc : c ≠ 0) (f : β → γ) :
  mul_support (λ x, f (c⁻¹ • x)) = c • mul_support f :=
by { ext x, simp only [mem_smul_set_iff_inv_smul_mem₀ hc, mem_mul_support] }

lemma support_comp_inv_smul₀ [has_zero γ] {c : α} (hc : c ≠ 0) (f : β → γ) :
  support (λ x, f (c⁻¹ • x)) = c • support f :=
by { ext x, simp only [mem_smul_set_iff_inv_smul_mem₀ hc, mem_support] }

attribute [to_additive support_comp_inv_smul₀] mul_support_comp_inv_smul₀

end group_with_zero


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

! This file was ported from Lean 3 source module data.bool.all_any
! leanprover-community/mathlib commit 5a3e819569b0f12cbec59d740a2613018e7b8eec
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.Basic

/-!
# Boolean quantifiers

This proves a few properties about `List.all` and `List.any`, which are the `Bool` universal and
existential quantifiers. Their definitions are in core Lean.
-/

variable {α : Type _} {p : α → Prop} [DecidablePred p] {l : List α} {a : α}

namespace List

-- Porting note: in Std
#align list.all_nil List.all_nil

#align list.all_cons List.all_consₓ

theorem all_iff_forall {p : α → Bool} : all l p ↔ ∀ a ∈ l, p a := by
  induction' l with a l ih
  · exact iff_of_true rfl (forall_mem_nil _)
  simp only [all_cons, Bool.and_coe_iff, ih, forall_mem_cons]
#align list.all_iff_forall List.all_iff_forall

theorem all_iff_forall_prop : (all l fun a => p a) ↔ ∀ a ∈ l, p a := by
  simp only [all_iff_forall, Bool.of_decide_iff]
#align list.all_iff_forall_prop List.all_iff_forall_prop

-- Porting note: in Std
#align list.any_nil List.any_nil

#align list.any_cons List.any_consₓ

theorem any_iff_exists {p : α → Bool} : any l p ↔ ∃ a ∈ l, p a := by
  induction' l with a l ih
  · exact iff_of_false Bool.not_false' (not_exists_mem_nil _)
  simp only [any_cons, Bool.or_coe_iff, ih, exists_mem_cons_iff]
#align list.any_iff_exists List.any_iff_exists

theorem any_iff_exists_prop : (any l fun a => p a) ↔ ∃ a ∈ l, p a := by simp [any_iff_exists]
#align list.any_iff_exists_prop List.any_iff_exists_prop

theorem any_of_mem {p : α → Bool} (h₁ : a ∈ l) (h₂ : p a) : any l p :=
  any_iff_exists.2 ⟨_, h₁, h₂⟩
#align list.any_of_mem List.any_of_mem

end List


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

import ring_theory.finite_type
import ring_theory.mv_polynomial.tower
import ring_theory.ideal.quotient_operations

/-!
# Finiteness conditions in commutative algebra

In this file we define several notions of finiteness that are common in commutative algebra.

## Main declarations

- `module.finite`, `algebra.finite`, `ring_hom.finite`, `alg_hom.finite`
  all of these express that some object is finitely generated *as module* over some base ring.
- `algebra.finite_type`, `ring_hom.finite_type`, `alg_hom.finite_type`
  all of these express that some object is finitely generated *as algebra* over some base ring.
- `algebra.finite_presentation`, `ring_hom.finite_presentation`, `alg_hom.finite_presentation`
  all of these express that some object is finitely presented *as algebra* over some base ring.

-/

open function (surjective)
open_locale big_operators polynomial

section module_and_algebra

variables (R A B M N : Type*)

/-- An algebra over a commutative semiring is `finite_presentation` if it is the quotient of a
polynomial ring in `n` variables by a finitely generated ideal. -/
def algebra.finite_presentation [comm_semiring R] [semiring A] [algebra R A] : Prop :=
∃ (n : ℕ) (f : mv_polynomial (fin n) R →ₐ[R] A),
  surjective f ∧ f.to_ring_hom.ker.fg

namespace algebra

variables [comm_ring R] [comm_ring A] [algebra R A] [comm_ring B] [algebra R B]
variables [add_comm_group M] [module R M]
variables [add_comm_group N] [module R N]

namespace finite_type

variables {R A B}

/-- A finitely presented algebra is of finite type. -/
lemma of_finite_presentation : finite_presentation R A → finite_type R A :=
begin
  rintro ⟨n, f, hf⟩,
  apply (finite_type.iff_quotient_mv_polynomial'').2,
  exact ⟨n, f, hf.1⟩
end

end finite_type

namespace finite_presentation

variables {R A B}

/-- An algebra over a Noetherian ring is finitely generated if and only if it is finitely
presented. -/
lemma of_finite_type [is_noetherian_ring R] : finite_type R A ↔ finite_presentation R A :=
begin
  refine ⟨λ h, _, algebra.finite_type.of_finite_presentation⟩,
  obtain ⟨n, f, hf⟩ := algebra.finite_type.iff_quotient_mv_polynomial''.1 h,
  refine ⟨n, f, hf, _⟩,
  have hnoet : is_noetherian_ring (mv_polynomial (fin n) R) := by apply_instance,
  replace hnoet := (is_noetherian_ring_iff.1 hnoet).noetherian,
  exact hnoet f.to_ring_hom.ker,
end

/-- If `e : A ≃ₐ[R] B` and `A` is finitely presented, then so is `B`. -/
lemma equiv (hfp : finite_presentation R A) (e : A ≃ₐ[R] B) : finite_presentation R B :=
begin
  obtain ⟨n, f, hf⟩ := hfp,
  use [n, alg_hom.comp ↑e f],
  split,
  { exact function.surjective.comp e.surjective hf.1 },
  suffices hker : (alg_hom.comp ↑e f).to_ring_hom.ker = f.to_ring_hom.ker,
  { rw hker, exact hf.2 },
  { have hco : (alg_hom.comp ↑e f).to_ring_hom = ring_hom.comp ↑e.to_ring_equiv f.to_ring_hom,
    { have h : (alg_hom.comp ↑e f).to_ring_hom = e.to_alg_hom.to_ring_hom.comp f.to_ring_hom := rfl,
      have h1 : ↑(e.to_ring_equiv) = (e.to_alg_hom).to_ring_hom := rfl,
      rw [h, h1] },
    rw [ring_hom.ker_eq_comap_bot, hco, ← ideal.comap_comap, ← ring_hom.ker_eq_comap_bot,
      ring_hom.ker_coe_equiv (alg_equiv.to_ring_equiv e), ring_hom.ker_eq_comap_bot] }
end

variable (R)

/-- The ring of polynomials in finitely many variables is finitely presented. -/
protected lemma mv_polynomial (ι : Type u_2) [finite ι] :
  finite_presentation R (mv_polynomial ι R) :=
by casesI nonempty_fintype ι; exact
let eqv := (mv_polynomial.rename_equiv R $ fintype.equiv_fin ι).symm in
⟨fintype.card ι, eqv, eqv.surjective,
  ((ring_hom.injective_iff_ker_eq_bot _).1 eqv.injective).symm ▸ submodule.fg_bot⟩

/-- `R` is finitely presented as `R`-algebra. -/
lemma self : finite_presentation R R :=
equiv (finite_presentation.mv_polynomial R pempty) (mv_polynomial.is_empty_alg_equiv R pempty)

/-- `R[X]` is finitely presented as `R`-algebra. -/
lemma polynomial : finite_presentation R R[X] :=
equiv (finite_presentation.mv_polynomial R punit) (mv_polynomial.punit_alg_equiv R)

variable {R}

/-- The quotient of a finitely presented algebra by a finitely generated ideal is finitely
presented. -/
protected lemma quotient {I : ideal A} (h : I.fg) (hfp : finite_presentation R A) :
  finite_presentation R (A ⧸ I) :=
begin
  obtain ⟨n, f, hf⟩ := hfp,
  refine ⟨n, (ideal.quotient.mkₐ R I).comp f, _, _⟩,
  { exact (ideal.quotient.mkₐ_surjective R I).comp hf.1 },
  { refine ideal.fg_ker_comp _ _ hf.2 _ hf.1,
    simp [h] }
end

/-- If `f : A →ₐ[R] B` is surjective with finitely generated kernel and `A` is finitely presented,
then so is `B`. -/
lemma of_surjective {f : A →ₐ[R] B} (hf : function.surjective f) (hker : f.to_ring_hom.ker.fg)
  (hfp : finite_presentation R A) : finite_presentation R B :=
equiv (hfp.quotient hker) (ideal.quotient_ker_alg_equiv_of_surjective hf)

lemma iff : finite_presentation R A ↔
  ∃ n (I : ideal (mv_polynomial (fin n) R)) (e : (_ ⧸ I) ≃ₐ[R] A), I.fg :=
begin
  split,
  { rintros ⟨n, f, hf⟩,
    exact ⟨n, f.to_ring_hom.ker, ideal.quotient_ker_alg_equiv_of_surjective hf.1, hf.2⟩ },
  { rintros ⟨n, I, e, hfg⟩,
    exact equiv ((finite_presentation.mv_polynomial R _).quotient hfg) e }
end

/-- An algebra is finitely presented if and only if it is a quotient of a polynomial ring whose
variables are indexed by a fintype by a finitely generated ideal. -/

/-- If `A` is a finitely presented `R`-algebra, then `mv_polynomial (fin n) A` is finitely presented
as `R`-algebra. -/
lemma mv_polynomial_of_finite_presentation (hfp : finite_presentation R A) (ι : Type*)
  [finite ι] : finite_presentation R (mv_polynomial ι A) :=
begin
  rw iff_quotient_mv_polynomial' at hfp ⊢,
  classical,
  obtain ⟨ι', _, f, hf_surj, hf_ker⟩ := hfp,
  resetI,
  let g := (mv_polynomial.map_alg_hom f).comp (mv_polynomial.sum_alg_equiv R ι ι').to_alg_hom,
  casesI nonempty_fintype (ι ⊕ ι'),
  refine ⟨ι ⊕ ι', by apply_instance, g,
    (mv_polynomial.map_surjective f.to_ring_hom hf_surj).comp (alg_equiv.surjective _),
    ideal.fg_ker_comp _ _ _ _ (alg_equiv.surjective _)⟩,
  { convert submodule.fg_bot,
    exact ring_hom.ker_coe_equiv (mv_polynomial.sum_alg_equiv R ι ι').to_ring_equiv },
  { rw [alg_hom.to_ring_hom_eq_coe, mv_polynomial.map_alg_hom_coe_ring_hom, mv_polynomial.ker_map],
    exact hf_ker.map mv_polynomial.C, }
end

/-- If `A` is an `R`-algebra and `S` is an `A`-algebra, both finitely presented, then `S` is
  finitely presented as `R`-algebra. -/
lemma trans [algebra A B] [is_scalar_tower R A B] (hfpA : finite_presentation R A)
  (hfpB : finite_presentation A B) : finite_presentation R B :=
begin
  obtain ⟨n, I, e, hfg⟩ := iff.1 hfpB,
  exact equiv ((mv_polynomial_of_finite_presentation hfpA _).quotient hfg) (e.restrict_scalars R)
end

open mv_polynomial

-- We follow the proof of https://stacks.math.columbia.edu/tag/0561
-- TODO: extract out helper lemmas and tidy proof.
lemma of_restrict_scalars_finite_presentation [algebra A B] [is_scalar_tower R A B]
  (hRB : finite_presentation R B) [hRA : finite_type R A] : finite_presentation A B :=
begin
  classical,
  obtain ⟨n, f, hf, s, hs⟩ := hRB,
  let RX := mv_polynomial (fin n) R, let AX := mv_polynomial (fin n) A,
  refine ⟨n, mv_polynomial.aeval (f ∘ X), _, _⟩,
  { rw [← algebra.range_top_iff_surjective, ← algebra.adjoin_range_eq_range_aeval, set.range_comp,
      _root_.eq_top_iff, ← @adjoin_adjoin_of_tower R A B, adjoin_image,
      adjoin_range_X, algebra.map_top, (algebra.range_top_iff_surjective _).mpr hf],
    exact subset_adjoin },
  { obtain ⟨t, ht⟩ := hRA.out,
    have := λ i : t, hf (algebra_map A B i),
    choose t' ht',
    have ht'' : algebra.adjoin R ((algebra_map A AX) '' t ∪ set.range (X : _ → AX)) = ⊤,
    { rw [adjoin_union_eq_adjoin_adjoin, ← subalgebra.restrict_scalars_top R],
      congr' 1,
      swap, { exact subalgebra.is_scalar_tower_mid _ },
      rw [adjoin_algebra_map, ht],
      apply subalgebra.restrict_scalars_injective R,
      rw [← adjoin_restrict_scalars, adjoin_range_X, subalgebra.restrict_scalars_top,
        subalgebra.restrict_scalars_top] },
    let g : t → AX := λ x, C (x : A) - map (algebra_map R A) (t' x),
    refine ⟨s.image (map (algebra_map R A)) ∪ t.attach.image g, _⟩,
    rw [finset.coe_union, finset.coe_image, finset.coe_image, finset.attach_eq_univ,
      finset.coe_univ, set.image_univ],
    let s₀ := _, let I := _, change ideal.span s₀ = I,
    have leI : ideal.span s₀ ≤ I,
    { rw [ideal.span_le],
      rintros _ (⟨x, hx, rfl⟩|⟨⟨x, hx⟩, rfl⟩),
      all_goals
        { dsimp [g], rw [ring_hom.mem_ker, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom] },
      { rw [mv_polynomial.aeval_map_algebra_map, ← aeval_unique],
        have := ideal.subset_span hx,
        rwa hs at this },
      { rw [map_sub, mv_polynomial.aeval_map_algebra_map, ← aeval_unique,
          aeval_C, ht', subtype.coe_mk, sub_self] } },
    apply leI.antisymm,
    intros x hx,
    rw [ring_hom.mem_ker, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom] at hx,
    let s₀ := _, change x ∈ ideal.span s₀,
    have : x ∈ (map (algebra_map R A) : _ →+* AX).srange.to_add_submonoid ⊔
      (ideal.span s₀).to_add_submonoid,
    { have : x ∈ (⊤ : subalgebra R AX) := trivial,
      rw ← ht'' at this,
      apply adjoin_induction this,
      { rintros _ (⟨x, hx, rfl⟩|⟨i, rfl⟩),
        { rw [algebra_map_eq, ← sub_add_cancel (C x) (map (algebra_map R A) (t' ⟨x, hx⟩)),
          add_comm],
          apply add_submonoid.add_mem_sup,
          { exact set.mem_range_self _ },
          { apply ideal.subset_span,
            apply set.mem_union_right,
            exact set.mem_range_self ⟨x, hx⟩ } },
        { apply add_submonoid.mem_sup_left,
          exact ⟨X i, map_X _ _⟩ } },
      { intro r, apply add_submonoid.mem_sup_left, exact ⟨C r, map_C _ _⟩ },
      { intros _ _ h₁ h₂, exact add_mem h₁ h₂ },
      { intros x₁ x₂ h₁ h₂,
        obtain ⟨_, ⟨p₁, rfl⟩, q₁, hq₁, rfl⟩ := add_submonoid.mem_sup.mp h₁,
        obtain ⟨_, ⟨p₂, rfl⟩, q₂, hq₂, rfl⟩ := add_submonoid.mem_sup.mp h₂,
        rw [add_mul, mul_add, add_assoc, ← map_mul],
        apply add_submonoid.add_mem_sup,
        { exact set.mem_range_self _ },
        { refine add_mem (ideal.mul_mem_left _ _ hq₂) (ideal.mul_mem_right _ _ hq₁) } } },
    obtain ⟨_, ⟨p, rfl⟩, q, hq, rfl⟩ := add_submonoid.mem_sup.mp this,
    rw [map_add, aeval_map_algebra_map, ← aeval_unique, (show aeval (f ∘ X) q = 0, from leI hq),
      add_zero] at hx,
    suffices : ideal.span (s : set RX) ≤ (ideal.span s₀).comap (map $ algebra_map R A),
    { refine add_mem _ hq, rw hs at this, exact this hx },
    rw ideal.span_le,
    intros x hx,
    apply ideal.subset_span,
    apply set.mem_union_left,
    exact set.mem_image_of_mem _ hx }
end

/-- This is used to prove the strictly stronger `ker_fg_of_surjective`. Use it instead. -/
-- TODO: extract out helper lemmas and tidy proof.
lemma ker_fg_of_mv_polynomial {n : ℕ} (f : mv_polynomial (fin n) R →ₐ[R] A)
  (hf : function.surjective f) (hfp : finite_presentation R A) : f.to_ring_hom.ker.fg :=
begin
  classical,
  obtain ⟨m, f', hf', s, hs⟩ := hfp,
  let RXn := mv_polynomial (fin n) R, let RXm := mv_polynomial (fin m) R,
  have := λ (i : fin n), hf' (f $ X i),
  choose g hg,
  have := λ (i : fin m), hf (f' $ X i),
  choose h hh,
  let aeval_h : RXm →ₐ[R] RXn := aeval h,
  let g' : fin n → RXn := λ i, X i - aeval_h (g i),
  refine ⟨finset.univ.image g' ∪ s.image aeval_h, _⟩,
  simp only [finset.coe_image, finset.coe_union, finset.coe_univ, set.image_univ],
  have hh' : ∀ x, f (aeval_h x) = f' x,
  { intro x, rw [← f.coe_to_ring_hom, map_aeval], simp_rw [alg_hom.coe_to_ring_hom, hh],
    rw [alg_hom.comp_algebra_map, ← aeval_eq_eval₂_hom, ← aeval_unique] },
  let s' := set.range g' ∪ aeval_h '' s,
  have leI : ideal.span s' ≤ f.to_ring_hom.ker,
  { rw ideal.span_le,
    rintros _ (⟨i, rfl⟩|⟨x, hx, rfl⟩),
    { change f (g' i) = 0, rw [map_sub, ← hg, hh', sub_self], },
    { change f (aeval_h x) = 0,
      rw hh',
      change x ∈ f'.to_ring_hom.ker,
      rw ← hs,
      exact ideal.subset_span hx } },
  apply leI.antisymm,
  intros x hx,
  have : x ∈ aeval_h.range.to_add_submonoid ⊔ (ideal.span s').to_add_submonoid,
  { have : x ∈ adjoin R (set.range X : set RXn) := by { rw [adjoin_range_X], trivial },
    apply adjoin_induction this,
    { rintros _ ⟨i, rfl⟩,
      rw [← sub_add_cancel (X i) (aeval h (g i)), add_comm],
      apply add_submonoid.add_mem_sup,
    { exact set.mem_range_self _ },
    { apply submodule.subset_span,
      apply set.mem_union_left,
      exact set.mem_range_self _ } },
    { intros r, apply add_submonoid.mem_sup_left, exact ⟨C r, aeval_C _ _⟩ },
    { intros _ _ h₁ h₂, exact add_mem h₁ h₂ },
    { intros p₁ p₂ h₁ h₂,
      obtain ⟨_, ⟨x₁, rfl⟩, y₁, hy₁, rfl⟩ := add_submonoid.mem_sup.mp h₁,
      obtain ⟨_, ⟨x₂, rfl⟩, y₂, hy₂, rfl⟩ := add_submonoid.mem_sup.mp h₂,
      rw [mul_add, add_mul, add_assoc, ← map_mul],
      apply add_submonoid.add_mem_sup,
    { exact set.mem_range_self _ },
    { exact add_mem (ideal.mul_mem_right _ _ hy₁) (ideal.mul_mem_left _ _ hy₂) } } },
  obtain ⟨_, ⟨x, rfl⟩, y, hy, rfl⟩ := add_submonoid.mem_sup.mp this,
  refine add_mem _ hy,
  simp only [ring_hom.mem_ker, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom, map_add,
    (show f y = 0, from leI hy), add_zero, hh'] at hx,
  suffices : ideal.span (s : set RXm) ≤ (ideal.span s').comap aeval_h,
  { apply this, rwa hs },
  rw ideal.span_le,
  intros x hx,
  apply submodule.subset_span,
  apply set.mem_union_right,
  exact set.mem_image_of_mem _ hx
end

/-- If `f : A →ₐ[R] B` is a sujection between finitely-presented `R`-algebras, then the kernel of
`f` is finitely generated. -/
lemma ker_fg_of_surjective (f : A →ₐ[R] B) (hf : function.surjective f)
  (hRA : finite_presentation R A) (hRB : finite_presentation R B) : f.to_ring_hom.ker.fg :=
begin
  obtain ⟨n, g, hg, hg'⟩ := hRA,
  convert (ker_fg_of_mv_polynomial (f.comp g) (hf.comp hg) hRB).map g.to_ring_hom,
  simp_rw [ring_hom.ker_eq_comap_bot, alg_hom.to_ring_hom_eq_coe, alg_hom.comp_to_ring_hom],
  rw [← ideal.comap_comap, ideal.map_comap_of_surjective (g : mv_polynomial (fin n) R →+* A) hg],
end

end finite_presentation

end algebra

end module_and_algebra

namespace ring_hom
variables {A B C : Type*} [comm_ring A] [comm_ring B] [comm_ring C]

/-- A ring morphism `A →+* B` is of `finite_presentation` if `B` is finitely presented as
`A`-algebra. -/
def finite_presentation (f : A →+* B) : Prop := @algebra.finite_presentation A B _ _ f.to_algebra

namespace finite_type

lemma of_finite_presentation {f : A →+* B} (hf : f.finite_presentation) : f.finite_type :=
@algebra.finite_type.of_finite_presentation A B _ _ f.to_algebra hf

end finite_type

namespace finite_presentation

variables (A)

lemma id : finite_presentation (ring_hom.id A) := algebra.finite_presentation.self A

variables {A}

lemma comp_surjective {f : A →+* B} {g : B →+* C} (hf : f.finite_presentation) (hg : surjective g)
  (hker : g.ker.fg) :  (g.comp f).finite_presentation :=
@algebra.finite_presentation.of_surjective A B C _ _ f.to_algebra _ (g.comp f).to_algebra
{ to_fun := g, commutes' := λ a, rfl, .. g } hg hker hf

lemma of_surjective (f : A →+* B) (hf : surjective f) (hker : f.ker.fg) : f.finite_presentation :=
by { rw ← f.comp_id, exact (id A).comp_surjective hf hker}

lemma of_finite_type [is_noetherian_ring A] {f : A →+* B} : f.finite_type ↔ f.finite_presentation :=
@algebra.finite_presentation.of_finite_type A B _ _ f.to_algebra _

lemma comp {g : B →+* C} {f : A →+* B} (hg : g.finite_presentation) (hf : f.finite_presentation) :
  (g.comp f).finite_presentation :=
@algebra.finite_presentation.trans A B C _ _ f.to_algebra _ (g.comp f).to_algebra g.to_algebra
{ smul_assoc := λ a b c, begin
    simp only [algebra.smul_def, ring_hom.map_mul, mul_assoc],
    refl
  end }
hf hg

lemma of_comp_finite_type (f : A →+* B) {g : B →+* C} (hg : (g.comp f).finite_presentation)
  (hf : f.finite_type) : g.finite_presentation :=
@@algebra.finite_presentation.of_restrict_scalars_finite_presentation _ _ f.to_algebra _
  (g.comp f).to_algebra g.to_algebra
  (@@is_scalar_tower.of_algebra_map_eq' _ _ _ f.to_algebra g.to_algebra (g.comp f).to_algebra rfl)
  hg hf

end finite_presentation

end ring_hom

namespace alg_hom

variables {R A B C : Type*} [comm_ring R]
variables [comm_ring A] [comm_ring B] [comm_ring C]
variables [algebra R A] [algebra R B] [algebra R C]

/-- An algebra morphism `A →ₐ[R] B` is of `finite_presentation` if it is of finite presentation as
ring morphism. In other words, if `B` is finitely presented as `A`-algebra. -/
def finite_presentation (f : A →ₐ[R] B) : Prop := f.to_ring_hom.finite_presentation

namespace finite_type

variables {R A}

lemma of_finite_presentation {f : A →ₐ[R] B} (hf : f.finite_presentation) : f.finite_type :=
ring_hom.finite_type.of_finite_presentation hf

end finite_type

namespace finite_presentation

variables (R A)

lemma id : finite_presentation (alg_hom.id R A) := ring_hom.finite_presentation.id A

variables {R A}

lemma comp {g : B →ₐ[R] C} {f : A →ₐ[R] B} (hg : g.finite_presentation)
  (hf : f.finite_presentation) : (g.comp f).finite_presentation :=
ring_hom.finite_presentation.comp hg hf

lemma comp_surjective {f : A →ₐ[R] B} {g : B →ₐ[R] C} (hf : f.finite_presentation)
  (hg : surjective g) (hker : g.to_ring_hom.ker.fg) : (g.comp f).finite_presentation :=
ring_hom.finite_presentation.comp_surjective hf hg hker

lemma of_surjective (f : A →ₐ[R] B) (hf : surjective f) (hker : f.to_ring_hom.ker.fg) :
  f.finite_presentation :=
ring_hom.finite_presentation.of_surjective f hf hker

lemma of_finite_type [is_noetherian_ring A] {f : A →ₐ[R] B} :
  f.finite_type ↔ f.finite_presentation :=
ring_hom.finite_presentation.of_finite_type

lemma of_comp_finite_type (f : A →ₐ[R] B) {g : B →ₐ[R] C} (h : (g.comp f).finite_presentation)
  (h' : f.finite_type) : g.finite_presentation :=
h.of_comp_finite_type _ h'

end finite_presentation

end alg_hom


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

! This file was ported from Lean 3 source module ring_theory.euclidean_domain
! leanprover-community/mathlib commit c085f3044fe585c575e322bfab45b3633c48d820
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GcdMonoid.Basic
import Mathbin.Algebra.EuclideanDomain.Basic
import Mathbin.RingTheory.Ideal.Basic
import Mathbin.RingTheory.PrincipalIdealDomain

/-!
# Lemmas about Euclidean domains

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

Various about Euclidean domains are proved; all of them seem to be true
more generally for principal ideal domains, so these lemmas should
probably be reproved in more generality and this file perhaps removed?

## Tags

euclidean domain
-/

noncomputable section

open Classical

open EuclideanDomain Set Ideal

section GCDMonoid

variable {R : Type _} [EuclideanDomain R] [GCDMonoid R]

/- warning: gcd_ne_zero_of_left -> gcd_ne_zero_of_left is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1))] (p : R) (q : R), (Ne.{succ u1} R p (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1))))))))))) -> (Ne.{succ u1} R (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1)) _inst_2 p q) (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))] (p : R) (q : R), (Ne.{succ u1} R p (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))))))) -> (Ne.{succ u1} R (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)) _inst_2 p q) (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align gcd_ne_zero_of_left gcd_ne_zero_of_leftₓ'. -/
theorem gcd_ne_zero_of_left (p q : R) (hp : p ≠ 0) : GCDMonoid.gcd p q ≠ 0 := fun h =>
  hp <| eq_zero_of_zero_dvd (h ▸ gcd_dvd_left p q)
#align gcd_ne_zero_of_left gcd_ne_zero_of_left

/- warning: gcd_ne_zero_of_right -> gcd_ne_zero_of_right is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1))] (p : R) (q : R), (Ne.{succ u1} R q (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1))))))))))) -> (Ne.{succ u1} R (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1)) _inst_2 p q) (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))] (p : R) (q : R), (Ne.{succ u1} R q (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))))))) -> (Ne.{succ u1} R (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)) _inst_2 p q) (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align gcd_ne_zero_of_right gcd_ne_zero_of_rightₓ'. -/
theorem gcd_ne_zero_of_right (p q : R) (hp : q ≠ 0) : GCDMonoid.gcd p q ≠ 0 := fun h =>
  hp <| eq_zero_of_zero_dvd (h ▸ gcd_dvd_right p q)
#align gcd_ne_zero_of_right gcd_ne_zero_of_right

/- warning: left_div_gcd_ne_zero -> left_div_gcd_ne_zero is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1))] {p : R} {q : R}, (Ne.{succ u1} R p (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1))))))))))) -> (Ne.{succ u1} R (HDiv.hDiv.{u1, u1, u1} R R R (instHDiv.{u1} R (EuclideanDomain.hasDiv.{u1} R _inst_1)) p (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1)) _inst_2 p q)) (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))] {p : R} {q : R}, (Ne.{succ u1} R p (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))))))) -> (Ne.{succ u1} R (HDiv.hDiv.{u1, u1, u1} R R R (instHDiv.{u1} R (EuclideanDomain.instDiv.{u1} R _inst_1)) p (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)) _inst_2 p q)) (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align left_div_gcd_ne_zero left_div_gcd_ne_zeroₓ'. -/
/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:132:4: warning: unsupported: rw with cfg: { occs := occurrences.pos[occurrences.pos] «expr[ ,]»([1]) } -/
theorem left_div_gcd_ne_zero {p q : R} (hp : p ≠ 0) : p / GCDMonoid.gcd p q ≠ 0 :=
  by
  obtain ⟨r, hr⟩ := GCDMonoid.gcd_dvd_left p q
  obtain ⟨pq0, r0⟩ : GCDMonoid.gcd p q ≠ 0 ∧ r ≠ 0 := mul_ne_zero_iff.mp (hr ▸ hp)
  rw [hr, mul_comm, mul_div_cancel _ pq0]
  exact r0
#align left_div_gcd_ne_zero left_div_gcd_ne_zero

/- warning: right_div_gcd_ne_zero -> right_div_gcd_ne_zero is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1))] {p : R} {q : R}, (Ne.{succ u1} R q (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1))))))))))) -> (Ne.{succ u1} R (HDiv.hDiv.{u1, u1, u1} R R R (instHDiv.{u1} R (EuclideanDomain.hasDiv.{u1} R _inst_1)) q (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.isDomain.{u1} R _inst_1)) _inst_2 p q)) (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : EuclideanDomain.{u1} R] [_inst_2 : GCDMonoid.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))] {p : R} {q : R}, (Ne.{succ u1} R q (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1))))))) -> (Ne.{succ u1} R (HDiv.hDiv.{u1, u1, u1} R R R (instHDiv.{u1} R (EuclideanDomain.instDiv.{u1} R _inst_1)) q (GCDMonoid.gcd.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)) _inst_2 p q)) (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R (IsDomain.toCancelCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R (EuclideanDomain.toCommRing.{u1} R _inst_1)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} R _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align right_div_gcd_ne_zero right_div_gcd_ne_zeroₓ'. -/
/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:132:4: warning: unsupported: rw with cfg: { occs := occurrences.pos[occurrences.pos] «expr[ ,]»([1]) } -/
theorem right_div_gcd_ne_zero {p q : R} (hq : q ≠ 0) : q / GCDMonoid.gcd p q ≠ 0 :=
  by
  obtain ⟨r, hr⟩ := GCDMonoid.gcd_dvd_right p q
  obtain ⟨pq0, r0⟩ : GCDMonoid.gcd p q ≠ 0 ∧ r ≠ 0 := mul_ne_zero_iff.mp (hr ▸ hq)
  rw [hr, mul_comm, mul_div_cancel _ pq0]
  exact r0
#align right_div_gcd_ne_zero right_div_gcd_ne_zero

end GCDMonoid

namespace EuclideanDomain

#print EuclideanDomain.gcdMonoid /-
/-- Create a `gcd_monoid` whose `gcd_monoid.gcd` matches `euclidean_domain.gcd`. -/
def gcdMonoid (R) [EuclideanDomain R] : GCDMonoid R
    where
  gcd := gcd
  lcm := lcm
  gcd_dvd_left := gcd_dvd_left
  gcd_dvd_right := gcd_dvd_right
  dvd_gcd a b c := dvd_gcd
  gcd_mul_lcm a b := by rw [EuclideanDomain.gcd_mul_lcm]
  lcm_zero_left := lcm_zero_left
  lcm_zero_right := lcm_zero_right
#align euclidean_domain.gcd_monoid EuclideanDomain.gcdMonoid
-/

variable {α : Type _} [EuclideanDomain α] [DecidableEq α]

#print EuclideanDomain.span_gcd /-
theorem span_gcd {α} [EuclideanDomain α] (x y : α) :
    span ({gcd x y} : Set α) = span ({x, y} : Set α) :=
  letI := EuclideanDomain.gcdMonoid α
  span_gcd x y
#align euclidean_domain.span_gcd EuclideanDomain.span_gcd
-/

/- warning: euclidean_domain.gcd_is_unit_iff -> EuclideanDomain.gcd_isUnit_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_3 : EuclideanDomain.{u1} α] {x : α} {y : α}, Iff (IsUnit.{u1} α (Ring.toMonoid.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))) (EuclideanDomain.gcd.{u1} α _inst_3 (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) x y)) (IsCoprime.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) x y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_3 : EuclideanDomain.{u1} α] {x : α} {y : α}, Iff (IsUnit.{u1} α (MonoidWithZero.toMonoid.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))) (EuclideanDomain.gcd.{u1} α _inst_3 (fun (a : α) (b : α) => Classical.propDecidable (Eq.{succ u1} α a b)) x y)) (IsCoprime.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) x y)
Case conversion may be inaccurate. Consider using '#align euclidean_domain.gcd_is_unit_iff EuclideanDomain.gcd_isUnit_iffₓ'. -/
theorem gcd_isUnit_iff {α} [EuclideanDomain α] {x y : α} : IsUnit (gcd x y) ↔ IsCoprime x y :=
  letI := EuclideanDomain.gcdMonoid α
  gcd_isUnit_iff x y
#align euclidean_domain.gcd_is_unit_iff EuclideanDomain.gcd_isUnit_iff

/- warning: euclidean_domain.is_coprime_of_dvd -> EuclideanDomain.isCoprime_of_dvd is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_3 : EuclideanDomain.{u1} α] {x : α} {y : α}, (Not (And (Eq.{succ u1} α x (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))))))) (Eq.{succ u1} α y (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))))))))) -> (forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z (nonunits.{u1} α (Ring.toMonoid.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))) -> (Ne.{succ u1} α z (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))))))) -> (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α (CommRing.toNonUnitalCommRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))) z x) -> (Not (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α (CommRing.toNonUnitalCommRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))) z y))) -> (IsCoprime.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) x y)
but is expected to have type
  forall {α : Type.{u1}} [_inst_3 : EuclideanDomain.{u1} α] {x : α} {y : α}, (Not (And (Eq.{succ u1} α x (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (CommMonoidWithZero.toZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α (IsDomain.toCancelCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} α _inst_3))))))) (Eq.{succ u1} α y (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (CommMonoidWithZero.toZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α (IsDomain.toCancelCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} α _inst_3))))))))) -> (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z (nonunits.{u1} α (MonoidWithZero.toMonoid.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))) -> (Ne.{succ u1} α z (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (CommMonoidWithZero.toZero.{u1} α (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} α (IsDomain.toCancelCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) (EuclideanDomain.instIsDomainToSemiringToRingToCommRing.{u1} α _inst_3))))))) -> (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α (CommRing.toNonUnitalCommRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))) z x) -> (Not (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α (CommRing.toNonUnitalCommRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))) z y))) -> (IsCoprime.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) x y)
Case conversion may be inaccurate. Consider using '#align euclidean_domain.is_coprime_of_dvd EuclideanDomain.isCoprime_of_dvdₓ'. -/
-- this should be proved for UFDs surely?
theorem isCoprime_of_dvd {α} [EuclideanDomain α] {x y : α} (nonzero : ¬(x = 0 ∧ y = 0))
    (H : ∀ z ∈ nonunits α, z ≠ 0 → z ∣ x → ¬z ∣ y) : IsCoprime x y :=
  letI := EuclideanDomain.gcdMonoid α
  isCoprime_of_dvd x y nonzero H
#align euclidean_domain.is_coprime_of_dvd EuclideanDomain.isCoprime_of_dvd

/- warning: euclidean_domain.dvd_or_coprime -> EuclideanDomain.dvd_or_coprime is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_3 : EuclideanDomain.{u1} α] (x : α) (y : α), (Irreducible.{u1} α (Ring.toMonoid.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))) x) -> (Or (Dvd.Dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α (CommRing.toNonUnitalCommRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))) x y) (IsCoprime.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) x y))
but is expected to have type
  forall {α : Type.{u1}} [_inst_3 : EuclideanDomain.{u1} α] (x : α) (y : α), (Irreducible.{u1} α (MonoidWithZero.toMonoid.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α (CommRing.toRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))) x) -> (Or (Dvd.dvd.{u1} α (semigroupDvd.{u1} α (SemigroupWithZero.toSemigroup.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α (CommRing.toNonUnitalCommRing.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3))))))) x y) (IsCoprime.{u1} α (CommRing.toCommSemiring.{u1} α (EuclideanDomain.toCommRing.{u1} α _inst_3)) x y))
Case conversion may be inaccurate. Consider using '#align euclidean_domain.dvd_or_coprime EuclideanDomain.dvd_or_coprimeₓ'. -/
-- this should be proved for UFDs surely?
theorem dvd_or_coprime {α} [EuclideanDomain α] (x y : α) (h : Irreducible x) :
    x ∣ y ∨ IsCoprime x y :=
  letI := EuclideanDomain.gcdMonoid α
  dvd_or_coprime x y h
#align euclidean_domain.dvd_or_coprime EuclideanDomain.dvd_or_coprime

end EuclideanDomain


def Set (α : Type u) : Type u := α → Prop

def Set.in (elem : α) (set : Set α): Prop := set elem

notation "{" a "|" b "}" => λa => b

notation:40 a "∈" b:40 => Set.in a b
notation:40 a "∉" b:40 => ¬ Set.in a b

def Set.subset (a: Set α) (b: Set α) : Prop := ∀x, x ∈ a → x ∈ b
def Set.union  (a: Set α) (b: Set α) : Set α := { x | x ∈ a ∨ x ∈ b}
def Set.inter  (a: Set α) (b: Set α) : Set α := { x | x ∈ a ∧ x ∈ b}
def Set.diff   (a: Set α) (b: Set α) : Set α := { x | x ∈ a ∧ x ∉ b}
def Set.compl  (a: Set α)            : Set α := { x | x ∉ a}

def Set.bigUnion (a: Set (Set α)) : Set α := { x | ∃(y: Set α), x ∈ y ∧ y ∈ a }

notation:64 "⬝∅" => {x | False}
prefix:64 "⋃." => Set.bigUnion
infix:64 "⊆" => Set.subset
infix:65 "∪" => Set.union
infix:66 "∩" => Set.inter
infix:67 "–" => Set.diff
prefix:67 "⬝~" => Set.compl

def Set.power  (a: Set α)          : Set (Set α) := { x      | x ⊆ a }
def Set.prod (a: Set α) (b: Set β) : Set (α × β) := { (x, y) | x ∈ a ∧ y ∈ b}
def Set.fun  (a: Set α) (b: Set β) : Set (α × β) := { (x, y) | x ∈ a ∧ y ∈ b}

infix:67 "`×" => Set.prod

theorem Set.Eq (h₁: p ⊆ q) (h₂: q ⊆ p): (p = q) := (funext (λ x => propext (Iff.intro (h₁ x) (h₂ x))))

theorem Set.Compl.InterEq {a b: Set α} : a – b = a ∩ ⬝~b := by
  simp [Set.in, Set.diff, Set.inter, Set.compl]

@[simp]
def Set.Relation.Closure.Trans (r: Set (α × α)) : Set (α × α) :=
  { (x, y) | (x,y) ∈ r ∨ (∃z, (x, z) ∈ r ∧ (z, y) ∈ r) }

@[simp]
def Set.Relation.Closure.ReflTrans (r: Set (α × α)) : Set (α × α) :=
  { (x, y) | (x,y) ∈ r ∨ (∃z, (x, z) ∈ r ∧ (z, y) ∈ r) }

@[simp]
def setEx : Set (Int × Int) :=
  { (x, y) | (x,y) = (1,2) ∨ (x,y) = (2,3) ∨ (x,y) = (3,4) ∨ (x,y) = (1,5) }

example : ((1, 3) ∈ (Set.Relation.Closure.Trans setEx)) := by
  simp [Set.in]
  apply ⟨2, And.intro (Or.inl rfl) rfl⟩

example : 3 ∈ Set.bigUnion {x | x = {y | y == 1 ∨ y == 2} ∨  x = {y | y == 3 ∨ y == 4 } } := by
  simp [Set.bigUnion, Set.in]
  exists {y | y == 3 ∨ y == 4 }
  simp


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

Given a finite poset `P`, we define `upper P` to be the set of
subsets `U ⊆ P` that are closed upwards.  We order this by
*reverse* inclusion, to ensure that the map
`u : p ↦ {x : p ≤ x}` is a morphism of posets.  We prove that
`upper P` is a bounded distributive lattice with this order.
-/

import basic

universes uP uQ uR uS

variables (P : Type uP) [decidable_eq P] [fintype P]
variables [partial_order P] [decidable_rel (has_le.le : P → P → Prop)]

namespace poset

variable {P}
def is_upper : finset P → Prop :=
 λ (U : finset P), ∀ (p₀ p₁ : P), (p₀ ≤ p₁) → (p₀ ∈ U) → (p₁ ∈ U)
variable (P)

instance is_upper_decidable (U : finset P) : decidable (is_upper U) :=
  by { dsimp[is_upper], apply_instance }

lemma is_upper_empty : is_upper (@finset.empty P) :=
 λ p₀ p₁ hp hU, (finset.not_mem_empty p₀ hU).elim

lemma is_upper_univ : is_upper (@finset.univ P _) :=
  λ p₀ p₁ hp hU, (finset.mem_univ p₁)

variable {P}

lemma is_upper_union (U V : finset P) (hU : is_upper U) (hV : is_upper V) :
  is_upper (U ∪ V) :=
   λ p₀ p₁ hp hpUV,
  begin
   rcases (finset.mem_union.mp hpUV) with hpU | hpV,
   {exact finset.mem_union_left  V (hU p₀ p₁ hp hpU)},
   {exact finset.mem_union_right U (hV p₀ p₁ hp hpV)},
  end

lemma is_upper_inter (U V : finset P) (hU : is_upper U) (hV : is_upper V) :
  is_upper (U ∩ V) :=
   λ p₀ p₁ hp hpUV,
  begin
   replace hpUV := finset.mem_inter.mp  hpUV,
   apply finset.mem_inter.mpr,
   split,
   {exact (hU p₀ p₁ hp hpUV.left)},
   {exact (hV p₀ p₁ hp hpUV.right)},
  end

def distrib (U V W : finset P) :
 U ∩ (V ∪ W) ⊆ (U ∩ V) ∪ (U ∩ W) :=
begin
 intros A h,
 rw[finset.mem_inter,finset.mem_union] at h,
 rw[finset.mem_union,finset.mem_inter,finset.mem_inter],
 rcases h with ⟨hU,hV | hW⟩,
 exact or.inl ⟨hU,hV⟩,
 exact or.inr ⟨hU,hW⟩
end

variable (P)

def upper := { U : finset P // is_upper U }

namespace upper

instance : fintype (upper P) :=
by {dsimp [upper], apply_instance}

/-- To print an upper set, ignore the upperness property and
  just print the underlying set.
-/
instance [has_repr P] : has_repr (upper P) := ⟨λ U, repr U.val⟩

variable {P}
def els (U : upper P) : Type* := {p // p ∈ U.val}
variable (P)

instance els_order (U : upper P) : partial_order U.els :=
by { unfold els, apply_instance }

instance : has_mem P (upper P) := ⟨λ p  U, p ∈ U.val⟩

/-- Two upper sets are equal iff they have the same elements. -/
@[ext] lemma ext (U₀ U₁ : upper P) :
  (∀ (p : P), p ∈ U₀ ↔ p ∈ U₁) → U₀ = U₁ :=
begin
  intro h,
  apply subtype.eq,
  ext p,
  exact h p
end

/-- upper P has a natural structure as a bounded distributive lattice.
-/
instance bdl : lattice.bounded_distrib_lattice (upper P) := {
  le := λ U V, V.val ⊆ U.val,
  le_refl := λ U, le_refl U.val,
  le_antisymm := λ U V (h0 : V.val ⊆ U.val) (h1 : U.val ⊆ V.val),
                   begin apply subtype.eq, exact le_antisymm h1 h0, end,
  le_trans := λ U V W (h0 : V.val ⊆ U.val) (h1 : W.val ⊆ V.val),
                 @le_trans (finset P) _ W.val V.val U.val h1 h0,
  bot := ⟨finset.univ,is_upper_univ P⟩,
  top := ⟨finset.empty,is_upper_empty P⟩,
  inf := λ U V, ⟨U.val ∪ V.val,
                is_upper_union U.val V.val U.property V.property⟩,
  sup := λ U V, ⟨U.val ∩ V.val,
                is_upper_inter U.val V.val U.property V.property⟩,
  bot_le := λ U,finset.subset_univ U.val,
  le_top := λ U,finset.empty_subset U.val,
  le_sup_left  := λ U V,finset.inter_subset_left  U.val V.val,
  le_sup_right := λ U V,finset.inter_subset_right U.val V.val,
  sup_le := λ U V W
             (U_le_W : W.val ⊆ U.val)
             (V_le_W : W.val ⊆ V.val),
             finset.subset_inter U_le_W V_le_W,
  inf_le_left  := λ U V,finset.subset_union_left  U.val V.val,
  inf_le_right := λ U V,finset.subset_union_right U.val V.val,
  le_inf := λ U V W
             (U_le_V : V.val ⊆ U.val)
             (U_le_W : W.val ⊆ U.val),
             finset.union_subset U_le_V U_le_W,
  le_sup_inf := λ U V W A h,
    distrib U.val V.val W.val h,
}

variable {P}

lemma mem_bot (p : P) : p ∈ (⊥ : upper P) := finset.mem_univ p

lemma not_mem_top (p : P) : p ∉ (⊤ : upper P) := finset.not_mem_empty p

lemma mem_inf {U V : upper P} (p : P) : p ∈ U ⊓ V ↔ (p ∈ U ∨ p ∈ V) :=
  finset.mem_union

lemma mem_sup {U V : upper P} (p : P) : p ∈ U ⊔ V ↔ (p ∈ U ∧ p ∈ V) :=
  finset.mem_inter

/-
 We embed `P` in `upper P` using the map `u : A ↦ { B : A ⊆ B }`
-/

def u : poset.hom P (upper P) :=
 ⟨λ p, ⟨finset.univ.filter (λ q, p ≤ q),
  begin intros q r hqr hpq,
   replace hpq := (finset.mem_filter.mp hpq).right,
   exact finset.mem_filter.mpr ⟨finset.mem_univ r,le_trans hpq hqr⟩,
  end
 ⟩, λ p₀ p₁ h q q_in_up₀,
  begin
   have : p₀ ≤ q := le_trans h (finset.mem_filter.mp q_in_up₀).right,
   exact finset.mem_filter.mpr ⟨finset.mem_univ q, this⟩
  end⟩

lemma mem_u (p q : P) : p ∈ (@u P _ _ _ _ q) ↔ q ≤ p :=
begin
  change p ∈ finset.filter _ _ ↔ q ≤ p,
  simp [finset.mem_filter, finset.mem_univ]
end

end upper

end poset


/-
Copyright (c) 2020 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Floris van Doorn, Yury Kudryashov
-/
import topology.algebra.order.monotone_continuity
import topology.instances.nnreal
import tactic.positivity

/-!
# Square root of a real number

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

In this file we define

* `nnreal.sqrt` to be the square root of a nonnegative real number.
* `real.sqrt` to be the square root of a real number, defined to be zero on negative numbers.

Then we prove some basic properties of these functions.

## Implementation notes

We define `nnreal.sqrt` as the noncomputable inverse to the function `x ↦ x * x`. We use general
theory of inverses of strictly monotone functions to prove that `nnreal.sqrt x` exists. As a side
effect, `nnreal.sqrt` is a bundled `order_iso`, so for `nnreal` numbers we get continuity as well as
theorems like `sqrt x ≤ y ↔ x ≤ y * y` for free.

Then we define `real.sqrt x` to be `nnreal.sqrt (real.to_nnreal x)`. We also define a Cauchy
sequence `real.sqrt_aux (f : cau_seq ℚ abs)` which converges to `sqrt (mk f)` but do not prove (yet)
that this sequence actually converges to `sqrt (mk f)`.

## Tags

square root
-/

open set filter
open_locale filter nnreal topology

namespace nnreal

variables {x y : ℝ≥0}

/-- Square root of a nonnegative real number. -/
@[pp_nodot] noncomputable def sqrt : ℝ≥0 ≃o ℝ≥0 :=
order_iso.symm $ pow_order_iso 2 two_ne_zero

lemma sqrt_le_sqrt_iff : sqrt x ≤ sqrt y ↔ x ≤ y :=
sqrt.le_iff_le

lemma sqrt_lt_sqrt_iff : sqrt x < sqrt y ↔ x < y :=
sqrt.lt_iff_lt

lemma sqrt_eq_iff_sq_eq : sqrt x = y ↔ y ^ 2 = x :=
sqrt.to_equiv.apply_eq_iff_eq_symm_apply.trans eq_comm

lemma sqrt_le_iff : sqrt x ≤ y ↔ x ≤ y ^ 2 :=
sqrt.to_galois_connection _ _

lemma le_sqrt_iff : x ≤ sqrt y ↔ x ^ 2 ≤ y :=
(sqrt.symm.to_galois_connection _ _).symm

@[simp] lemma sqrt_eq_zero : sqrt x = 0 ↔ x = 0 :=
sqrt_eq_iff_sq_eq.trans $ by rw [eq_comm, sq, zero_mul]

@[simp] lemma sqrt_zero : sqrt 0 = 0 := sqrt_eq_zero.2 rfl
@[simp] lemma sqrt_one : sqrt 1 = 1 := sqrt_eq_iff_sq_eq.2 $ one_pow _
@[simp] lemma sq_sqrt (x : ℝ≥0) : (sqrt x)^2 = x := sqrt.symm_apply_apply x
@[simp] lemma mul_self_sqrt (x : ℝ≥0) : sqrt x * sqrt x = x := by rw [← sq, sq_sqrt]
@[simp] lemma sqrt_sq (x : ℝ≥0) : sqrt (x^2) = x := sqrt.apply_symm_apply x
@[simp] lemma sqrt_mul_self (x : ℝ≥0) : sqrt (x * x) = x := by rw [← sq, sqrt_sq x]

lemma sqrt_mul (x y : ℝ≥0) : sqrt (x * y) = sqrt x * sqrt y :=
by rw [sqrt_eq_iff_sq_eq, mul_pow, sq_sqrt, sq_sqrt]

/-- `nnreal.sqrt` as a `monoid_with_zero_hom`. -/
noncomputable def sqrt_hom : ℝ≥0 →*₀ ℝ≥0 := ⟨sqrt, sqrt_zero, sqrt_one, sqrt_mul⟩

lemma sqrt_inv (x : ℝ≥0) : sqrt (x⁻¹) = (sqrt x)⁻¹ := map_inv₀ sqrt_hom x

lemma sqrt_div (x y : ℝ≥0) : sqrt (x / y) = sqrt x / sqrt y := map_div₀ sqrt_hom x y

lemma continuous_sqrt : continuous sqrt := sqrt.continuous

end nnreal

namespace real

/-- An auxiliary sequence of rational numbers that converges to `real.sqrt (mk f)`.
Currently this sequence is not used in `mathlib`.  -/
def sqrt_aux (f : cau_seq ℚ abs) : ℕ → ℚ
| 0       := rat.mk_nat (f 0).num.to_nat.sqrt (f 0).denom.sqrt
| (n + 1) := let s := sqrt_aux n in max 0 $ (s + f (n+1) / s) / 2

theorem sqrt_aux_nonneg (f : cau_seq ℚ abs) : ∀ i : ℕ, 0 ≤ sqrt_aux f i
| 0       := by rw [sqrt_aux, rat.mk_nat_eq, rat.mk_eq_div];
  apply div_nonneg; exact int.cast_nonneg.2 (int.of_nat_nonneg _)
| (n + 1) := le_max_left _ _

/- TODO(Mario): finish the proof
theorem sqrt_aux_converges (f : cau_seq ℚ abs) : ∃ h x, 0 ≤ x ∧ x * x = max 0 (mk f) ∧
  mk ⟨sqrt_aux f, h⟩ = x :=
begin
  rcases sqrt_exists (le_max_left 0 (mk f)) with ⟨x, x0, hx⟩,
  suffices : ∃ h, mk ⟨sqrt_aux f, h⟩ = x,
  { exact this.imp (λ h e, ⟨x, x0, hx, e⟩) },
  apply of_near,

  rsuffices ⟨δ, δ0, hδ⟩ : ∃ δ > 0, ∀ i, abs (↑(sqrt_aux f i) - x) < δ / 2 ^ i,
  { intros }
end -/

/-- The square root of a real number. This returns 0 for negative inputs. -/
@[pp_nodot] noncomputable def sqrt (x : ℝ) : ℝ :=
nnreal.sqrt (real.to_nnreal x)
/-quotient.lift_on x
  (λ f, mk ⟨sqrt_aux f, (sqrt_aux_converges f).fst⟩)
  (λ f g e, begin
    rcases sqrt_aux_converges f with ⟨hf, x, x0, xf, xs⟩,
    rcases sqrt_aux_converges g with ⟨hg, y, y0, yg, ys⟩,
    refine xs.trans (eq.trans _ ys.symm),
    rw [← @mul_self_inj_of_nonneg ℝ _ x y x0 y0, xf, yg],
    congr' 1, exact quotient.sound e
  end)-/

variables {x y : ℝ}

@[simp, norm_cast] lemma coe_sqrt {x : ℝ≥0} : (nnreal.sqrt x : ℝ) = real.sqrt x :=
by rw [real.sqrt, real.to_nnreal_coe]

@[continuity]
lemma continuous_sqrt : continuous sqrt :=
nnreal.continuous_coe.comp $ nnreal.sqrt.continuous.comp continuous_real_to_nnreal

theorem sqrt_eq_zero_of_nonpos (h : x ≤ 0) : sqrt x = 0 :=
by simp [sqrt, real.to_nnreal_eq_zero.2 h]

theorem sqrt_nonneg (x : ℝ) : 0 ≤ sqrt x := nnreal.coe_nonneg _

@[simp] theorem mul_self_sqrt (h : 0 ≤ x) : sqrt x * sqrt x = x :=
by rw [sqrt, ← nnreal.coe_mul, nnreal.mul_self_sqrt, real.coe_to_nnreal _ h]

@[simp] theorem sqrt_mul_self (h : 0 ≤ x) : sqrt (x * x) = x :=
(mul_self_inj_of_nonneg (sqrt_nonneg _) h).1 (mul_self_sqrt (mul_self_nonneg _))

theorem sqrt_eq_cases : sqrt x = y ↔ y * y = x ∧ 0 ≤ y ∨ x < 0 ∧ y = 0 :=
begin
  split,
  { rintro rfl,
    cases le_or_lt 0 x with hle hlt,
    { exact or.inl ⟨mul_self_sqrt hle, sqrt_nonneg x⟩ },
    { exact or.inr ⟨hlt, sqrt_eq_zero_of_nonpos hlt.le⟩ } },
  { rintro (⟨rfl, hy⟩|⟨hx, rfl⟩),
    exacts [sqrt_mul_self hy, sqrt_eq_zero_of_nonpos hx.le] }
end

theorem sqrt_eq_iff_mul_self_eq (hx : 0 ≤ x) (hy : 0 ≤ y) :
  sqrt x = y ↔ y * y = x :=
⟨λ h, by rw [← h, mul_self_sqrt hx], λ h, by rw [← h, sqrt_mul_self hy]⟩

theorem sqrt_eq_iff_mul_self_eq_of_pos (h : 0 < y) :
  sqrt x = y ↔ y * y = x :=
by simp [sqrt_eq_cases, h.ne', h.le]

@[simp] lemma sqrt_eq_one : sqrt x = 1 ↔ x = 1 :=
calc sqrt x = 1 ↔ 1 * 1 = x :
  sqrt_eq_iff_mul_self_eq_of_pos zero_lt_one
... ↔ x = 1 : by rw [eq_comm, mul_one]

@[simp] theorem sq_sqrt (h : 0 ≤ x) : (sqrt x)^2 = x :=
by rw [sq, mul_self_sqrt h]

@[simp] theorem sqrt_sq (h : 0 ≤ x) : sqrt (x ^ 2) = x :=
by rw [sq, sqrt_mul_self h]

theorem sqrt_eq_iff_sq_eq (hx : 0 ≤ x) (hy : 0 ≤ y) :
  sqrt x = y ↔ y ^ 2 = x :=
by rw [sq, sqrt_eq_iff_mul_self_eq hx hy]

theorem sqrt_mul_self_eq_abs (x : ℝ) : sqrt (x * x) = |x| :=
by rw [← abs_mul_abs_self x, sqrt_mul_self (abs_nonneg _)]

theorem sqrt_sq_eq_abs (x : ℝ) : sqrt (x ^ 2) = |x| :=
by rw [sq, sqrt_mul_self_eq_abs]

@[simp] theorem sqrt_zero : sqrt 0 = 0 := by simp [sqrt]

@[simp] theorem sqrt_one : sqrt 1 = 1 := by simp [sqrt]

@[simp] theorem sqrt_le_sqrt_iff (hy : 0 ≤ y) : sqrt x ≤ sqrt y ↔ x ≤ y :=
by rw [sqrt, sqrt, nnreal.coe_le_coe, nnreal.sqrt_le_sqrt_iff, real.to_nnreal_le_to_nnreal_iff hy]

@[simp] theorem sqrt_lt_sqrt_iff (hx : 0 ≤ x) : sqrt x < sqrt y ↔ x < y :=
lt_iff_lt_of_le_iff_le (sqrt_le_sqrt_iff hx)

theorem sqrt_lt_sqrt_iff_of_pos (hy : 0 < y) : sqrt x < sqrt y ↔ x < y :=
by rw [sqrt, sqrt, nnreal.coe_lt_coe, nnreal.sqrt_lt_sqrt_iff, to_nnreal_lt_to_nnreal_iff hy]

theorem sqrt_le_sqrt (h : x ≤ y) : sqrt x ≤ sqrt y :=
by { rw [sqrt, sqrt, nnreal.coe_le_coe, nnreal.sqrt_le_sqrt_iff], exact to_nnreal_le_to_nnreal h }

theorem sqrt_lt_sqrt (hx : 0 ≤ x) (h : x < y) : sqrt x < sqrt y :=
(sqrt_lt_sqrt_iff hx).2 h

theorem sqrt_le_iff : sqrt x ≤ y ↔ 0 ≤ y ∧ x ≤ y ^ 2 :=
begin
  rw [← and_iff_right_of_imp (λ h, (sqrt_nonneg x).trans h), and.congr_right_iff],
  exact sqrt_le_left
end

lemma sqrt_lt (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x < y ↔ x < y ^ 2 :=
by rw [←sqrt_lt_sqrt_iff hx, sqrt_sq hy]

lemma sqrt_lt' (hy : 0 < y) : sqrt x < y ↔ x < y ^ 2 :=
by rw [←sqrt_lt_sqrt_iff_of_pos (pow_pos hy _), sqrt_sq hy.le]

/- note: if you want to conclude `x ≤ sqrt y`, then use `le_sqrt_of_sq_le`.
   if you have `x > 0`, consider using `le_sqrt'` -/
theorem le_sqrt (hx : 0 ≤ x) (hy : 0 ≤ y) : x ≤ sqrt y ↔ x ^ 2 ≤ y :=
le_iff_le_iff_lt_iff_lt.2 $ sqrt_lt hy hx

lemma le_sqrt' (hx : 0 < x) : x ≤ sqrt y ↔ x ^ 2 ≤ y := le_iff_le_iff_lt_iff_lt.2 $ sqrt_lt' hx

theorem abs_le_sqrt (h : x^2 ≤ y) : |x| ≤ sqrt y :=
by rw ← sqrt_sq_eq_abs; exact sqrt_le_sqrt h

theorem sq_le (h : 0 ≤ y) : x^2 ≤ y ↔ -sqrt y ≤ x ∧ x ≤ sqrt y :=
begin
  split,
  { simpa only [abs_le] using abs_le_sqrt },
  { rw [← abs_le, ← sq_abs],
    exact (le_sqrt (abs_nonneg x) h).mp },
end

theorem neg_sqrt_le_of_sq_le (h : x^2 ≤ y) : -sqrt y ≤ x :=
((sq_le ((sq_nonneg x).trans h)).mp h).1

theorem le_sqrt_of_sq_le (h : x^2 ≤ y) : x ≤ sqrt y :=
((sq_le ((sq_nonneg x).trans h)).mp h).2

@[simp] theorem sqrt_inj (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x = sqrt y ↔ x = y :=
by simp [le_antisymm_iff, hx, hy]

@[simp] theorem sqrt_eq_zero (h : 0 ≤ x) : sqrt x = 0 ↔ x = 0 :=
by simpa using sqrt_inj h le_rfl

theorem sqrt_eq_zero' : sqrt x = 0 ↔ x ≤ 0 :=
by rw [sqrt, nnreal.coe_eq_zero, nnreal.sqrt_eq_zero, real.to_nnreal_eq_zero]

theorem sqrt_ne_zero (h : 0 ≤ x) : sqrt x ≠ 0 ↔ x ≠ 0 :=
by rw [not_iff_not, sqrt_eq_zero h]

theorem sqrt_ne_zero' : sqrt x ≠ 0 ↔ 0 < x :=
by rw [← not_le, not_iff_not, sqrt_eq_zero']

@[simp] theorem sqrt_pos : 0 < sqrt x ↔ 0 < x :=
lt_iff_lt_of_le_iff_le (iff.trans
  (by simp [le_antisymm_iff, sqrt_nonneg]) sqrt_eq_zero')

alias sqrt_pos ↔ _ sqrt_pos_of_pos

section
open tactic tactic.positivity

/-- Extension for the `positivity` tactic: a square root is nonnegative, and is strictly positive if
its input is. -/
@[positivity]
meta def _root_.tactic.positivity_sqrt : expr → tactic strictness
| `(real.sqrt %%a) := do
  (do -- if can prove `0 < a`, report positivity
    positive pa ← core a,
    positive <$> mk_app ``sqrt_pos_of_pos [pa]) <|>
  nonnegative <$> mk_app ``sqrt_nonneg [a] -- else report nonnegativity
| _ := failed

end

@[simp] theorem sqrt_mul (hx : 0 ≤ x) (y : ℝ) : sqrt (x * y) = sqrt x * sqrt y :=
by simp_rw [sqrt, ← nnreal.coe_mul, nnreal.coe_eq, real.to_nnreal_mul hx, nnreal.sqrt_mul]

@[simp] theorem sqrt_mul' (x) {y : ℝ} (hy : 0 ≤ y) : sqrt (x * y) = sqrt x * sqrt y :=
by rw [mul_comm, sqrt_mul hy, mul_comm]

@[simp] theorem sqrt_inv (x : ℝ) : sqrt x⁻¹ = (sqrt x)⁻¹ :=
by rw [sqrt, real.to_nnreal_inv, nnreal.sqrt_inv, nnreal.coe_inv, sqrt]

@[simp] theorem sqrt_div (hx : 0 ≤ x) (y : ℝ) : sqrt (x / y) = sqrt x / sqrt y :=
by rw [division_def, sqrt_mul hx, sqrt_inv, division_def]

@[simp] theorem sqrt_div' (x) {y : ℝ} (hy : 0 ≤ y) : sqrt (x / y) = sqrt x / sqrt y :=
by rw [division_def, sqrt_mul' x (inv_nonneg.2 hy), sqrt_inv, division_def]

@[simp] theorem div_sqrt : x / sqrt x = sqrt x :=
begin
  cases le_or_lt x 0,
  { rw [sqrt_eq_zero'.mpr h, div_zero] },
  { rw [div_eq_iff (sqrt_ne_zero'.mpr h), mul_self_sqrt h.le] },
end

theorem sqrt_div_self' : sqrt x / x = 1 / sqrt x :=
by rw [←div_sqrt, one_div_div, div_sqrt]

theorem sqrt_div_self : sqrt x / x = (sqrt x)⁻¹ :=
by rw [sqrt_div_self', one_div]

lemma lt_sqrt (hx : 0 ≤ x) : x < sqrt y ↔ x ^ 2 < y :=
by rw [←sqrt_lt_sqrt_iff (sq_nonneg _), sqrt_sq hx]

lemma sq_lt : x^2 < y ↔ -sqrt y < x ∧ x < sqrt y := by rw [←abs_lt, ←sq_abs, lt_sqrt (abs_nonneg _)]

theorem neg_sqrt_lt_of_sq_lt (h : x^2 < y) : -sqrt y < x := (sq_lt.mp h).1

theorem lt_sqrt_of_sq_lt (h : x^2 < y) : x < sqrt y := (sq_lt.mp h).2

lemma lt_sq_of_sqrt_lt {x y : ℝ} (h : sqrt x < y) : x < y ^ 2 :=
by { have hy := x.sqrt_nonneg.trans_lt h,
  rwa [←sqrt_lt_sqrt_iff_of_pos (sq_pos_of_pos hy), sqrt_sq hy.le] }

/-- The natural square root is at most the real square root -/
lemma nat_sqrt_le_real_sqrt {a : ℕ} : ↑(nat.sqrt a) ≤ real.sqrt ↑a :=
begin
  rw real.le_sqrt (nat.cast_nonneg _) (nat.cast_nonneg _),
  norm_cast,
  exact nat.sqrt_le' a,
end

/-- The real square root is at most the natural square root plus one -/
lemma real_sqrt_le_nat_sqrt_succ {a : ℕ} : real.sqrt ↑a ≤ nat.sqrt a + 1 :=
begin
  rw real.sqrt_le_iff,
  split,
  { norm_cast, simp, },
  { norm_cast, exact le_of_lt (nat.lt_succ_sqrt' a), },
end

instance : star_ordered_ring ℝ :=
{ nonneg_iff := λ r, by
  { refine ⟨λ hr, ⟨sqrt r, show r = sqrt r * sqrt r, by rw [←sqrt_mul hr, sqrt_mul_self hr]⟩, _⟩,
    rintros ⟨s, rfl⟩,
    exact mul_self_nonneg s },
  ..real.ordered_add_comm_group }

end real

open real

variables {α : Type*}

lemma filter.tendsto.sqrt {f : α → ℝ} {l : filter α} {x : ℝ} (h : tendsto f l (𝓝 x)) :
  tendsto (λ x, sqrt (f x)) l (𝓝 (sqrt x)) :=
(continuous_sqrt.tendsto _).comp h

variables [topological_space α] {f : α → ℝ} {s : set α} {x : α}

lemma continuous_within_at.sqrt (h : continuous_within_at f s x) :
  continuous_within_at (λ x, sqrt (f x)) s x :=
h.sqrt

lemma continuous_at.sqrt (h : continuous_at f x) : continuous_at (λ x, sqrt (f x)) x := h.sqrt

lemma continuous_on.sqrt (h : continuous_on f s) : continuous_on (λ x, sqrt (f x)) s :=
λ x hx, (h x hx).sqrt

@[continuity]
lemma continuous.sqrt (h : continuous f) : continuous (λ x, sqrt (f x)) := continuous_sqrt.comp h


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.specific_limits.basic
import topology.urysohns_lemma
import topology.continuous_function.bounded
import topology.uniform_space.cauchy

/-!
# Metrizability of a T₃ topological space with second countable topology

In this file we define metrizable topological spaces, i.e., topological spaces for which there
exists a metric space structure that generates the same topology.

We also show that a T₃ topological space with second countable topology `X` is metrizable.

First we prove that `X` can be embedded into `l^∞`, then use this embedding to pull back the metric
space structure.
-/

open set filter metric
open_locale bounded_continuous_function filter topology

namespace topological_space

variables {ι X Y : Type*} {π : ι → Type*} [topological_space X] [topological_space Y]
  [finite ι] [Π i, topological_space (π i)]

/-- A topological space is *pseudo metrizable* if there exists a pseudo metric space structure
compatible with the topology. To endow such a space with a compatible distance, use
`letI : pseudo_metric_space X := topological_space.pseudo_metrizable_space_pseudo_metric X`. -/
class pseudo_metrizable_space (X : Type*) [t : topological_space X] : Prop :=
(exists_pseudo_metric : ∃ (m : pseudo_metric_space X), m.to_uniform_space.to_topological_space = t)

@[priority 100]
instance _root_.pseudo_metric_space.to_pseudo_metrizable_space {X : Type*}
  [m : pseudo_metric_space X] :
  pseudo_metrizable_space X :=
⟨⟨m, rfl⟩⟩

/-- Construct on a metrizable space a metric compatible with the topology. -/
noncomputable def pseudo_metrizable_space_pseudo_metric
  (X : Type*) [topological_space X] [h : pseudo_metrizable_space X] :
  pseudo_metric_space X :=
h.exists_pseudo_metric.some.replace_topology h.exists_pseudo_metric.some_spec.symm

instance pseudo_metrizable_space_prod [pseudo_metrizable_space X] [pseudo_metrizable_space Y] :
  pseudo_metrizable_space (X × Y) :=
begin
  letI : pseudo_metric_space X := pseudo_metrizable_space_pseudo_metric X,
  letI : pseudo_metric_space Y := pseudo_metrizable_space_pseudo_metric Y,
  apply_instance
end

/-- Given an inducing map of a topological space into a pseudo metrizable space, the source space
is also pseudo metrizable. -/
lemma _root_.inducing.pseudo_metrizable_space [pseudo_metrizable_space Y] {f : X → Y}
  (hf : inducing f) :
  pseudo_metrizable_space X :=
begin
  letI : pseudo_metric_space Y := pseudo_metrizable_space_pseudo_metric Y,
  exact ⟨⟨hf.comap_pseudo_metric_space, rfl⟩⟩
end

/-- Every pseudo-metrizable space is first countable. -/
@[priority 100]
instance pseudo_metrizable_space.first_countable_topology [h : pseudo_metrizable_space X] :
  topological_space.first_countable_topology X :=
begin
  unfreezingI { rcases h with ⟨_, hm⟩, rw ←hm },
  exact @uniform_space.first_countable_topology X pseudo_metric_space.to_uniform_space
    emetric.uniformity.filter.is_countably_generated,
end

instance pseudo_metrizable_space.subtype [pseudo_metrizable_space X]
  (s : set X) : pseudo_metrizable_space s :=
inducing_coe.pseudo_metrizable_space

instance pseudo_metrizable_space_pi [Π i, pseudo_metrizable_space (π i)] :
  pseudo_metrizable_space (Π i, π i) :=
by { casesI nonempty_fintype ι, letI := λ i, pseudo_metrizable_space_pseudo_metric (π i),
  apply_instance }

/-- A topological space is metrizable if there exists a metric space structure compatible with the
topology. To endow such a space with a compatible distance, use
`letI : metric_space X := topological_space.metrizable_space_metric X` -/
class metrizable_space (X : Type*) [t : topological_space X] : Prop :=
(exists_metric : ∃ (m : metric_space X), m.to_uniform_space.to_topological_space = t)

@[priority 100]
instance _root_.metric_space.to_metrizable_space {X : Type*} [m : metric_space X] :
  metrizable_space X :=
⟨⟨m, rfl⟩⟩

@[priority 100]
instance metrizable_space.to_pseudo_metrizable_space [h : metrizable_space X] :
  pseudo_metrizable_space X :=
⟨let ⟨m, hm⟩ := h.1 in ⟨m.to_pseudo_metric_space, hm⟩⟩

/-- Construct on a metrizable space a metric compatible with the topology. -/
noncomputable def metrizable_space_metric (X : Type*) [topological_space X]
  [h : metrizable_space X] :
  metric_space X :=
h.exists_metric.some.replace_topology h.exists_metric.some_spec.symm

@[priority 100]
instance t2_space_of_metrizable_space [metrizable_space X] : t2_space X :=
by { letI : metric_space X := metrizable_space_metric X, apply_instance }

instance metrizable_space_prod [metrizable_space X] [metrizable_space Y] :
  metrizable_space (X × Y) :=
begin
  letI : metric_space X := metrizable_space_metric X,
  letI : metric_space Y := metrizable_space_metric Y,
  apply_instance
end

/-- Given an embedding of a topological space into a metrizable space, the source space is also
metrizable. -/
lemma _root_.embedding.metrizable_space [metrizable_space Y] {f : X → Y} (hf : embedding f) :
  metrizable_space X :=
begin
  letI : metric_space Y := metrizable_space_metric Y,
  exact ⟨⟨hf.comap_metric_space f, rfl⟩⟩
end

instance metrizable_space.subtype [metrizable_space X] (s : set X) : metrizable_space s :=
embedding_subtype_coe.metrizable_space

instance metrizable_space_pi [Π i, metrizable_space (π i)] : metrizable_space (Π i, π i) :=
by { casesI nonempty_fintype ι, letI := λ i, metrizable_space_metric (π i), apply_instance }

variables (X) [t3_space X] [second_countable_topology X]

/-- A T₃ topological space with second countable topology can be embedded into `l^∞ = ℕ →ᵇ ℝ`.
-/
lemma exists_embedding_l_infty : ∃ f : X → (ℕ →ᵇ ℝ), embedding f :=
begin
  haveI : normal_space X := normal_space_of_t3_second_countable X,
  -- Choose a countable basis, and consider the set `s` of pairs of set `(U, V)` such that `U ∈ B`,
  -- `V ∈ B`, and `closure U ⊆ V`.
  rcases exists_countable_basis X with ⟨B, hBc, -, hB⟩,
  set s : set (set X × set X) := {UV ∈ B ×ˢ B| closure UV.1 ⊆ UV.2},
  -- `s` is a countable set.
  haveI : encodable s := ((hBc.prod hBc).mono (inter_subset_left _ _)).to_encodable,
  -- We don't have the space of bounded (possibly discontinuous) functions, so we equip `s`
  -- with the discrete topology and deal with `s →ᵇ ℝ` instead.
  letI : topological_space s := ⊥, haveI : discrete_topology s := ⟨rfl⟩,
  rsuffices ⟨f, hf⟩ : ∃ f : X → (s →ᵇ ℝ), embedding f,
  { exact ⟨λ x, (f x).extend (encodable.encode' s) 0, (bounded_continuous_function.isometry_extend
      (encodable.encode' s) (0 : ℕ →ᵇ ℝ)).embedding.comp hf⟩ },
  have hd : ∀ UV : s, disjoint (closure UV.1.1) (UV.1.2ᶜ) :=
    λ UV, disjoint_compl_right.mono_right (compl_subset_compl.2 UV.2.2),
  -- Choose a sequence of `εₙ > 0`, `n : s`, that is bounded above by `1` and tends to zero
  -- along the `cofinite` filter.
  obtain ⟨ε, ε01, hε⟩ : ∃ ε : s → ℝ, (∀ UV, ε UV ∈ Ioc (0 : ℝ) 1) ∧ tendsto ε cofinite (𝓝 0),
  { rcases pos_sum_of_encodable zero_lt_one s with ⟨ε, ε0, c, hεc, hc1⟩,
    refine ⟨ε, λ UV, ⟨ε0 UV, _⟩, hεc.summable.tendsto_cofinite_zero⟩,
    exact (le_has_sum hεc UV $ λ _ _, (ε0 _).le).trans hc1 },
  /- For each `UV = (U, V) ∈ s` we use Urysohn's lemma to choose a function `f UV` that is equal to
  zero on `U` and is equal to `ε UV` on the complement to `V`. -/
  have : ∀ UV : s, ∃ f : C(X, ℝ), eq_on f 0 UV.1.1 ∧ eq_on f (λ _, ε UV) UV.1.2ᶜ ∧
    ∀ x, f x ∈ Icc 0 (ε UV),
  { intro UV,
    rcases exists_continuous_zero_one_of_closed is_closed_closure
      (hB.is_open UV.2.1.2).is_closed_compl (hd UV) with ⟨f, hf₀, hf₁, hf01⟩,
    exact ⟨ε UV • f, λ x hx, by simp [hf₀ (subset_closure hx)], λ x hx, by simp [hf₁ hx],
      λ x, ⟨mul_nonneg (ε01 _).1.le (hf01 _).1, mul_le_of_le_one_right (ε01 _).1.le (hf01 _).2⟩⟩ },
  choose f hf0 hfε hf0ε,
  have hf01 : ∀ UV x, f UV x ∈ Icc (0 : ℝ) 1,
    from λ UV x, Icc_subset_Icc_right (ε01 _).2 (hf0ε _ _),
  /- The embedding is given by `F x UV = f UV x`. -/
  set F : X → s →ᵇ ℝ := λ x, ⟨⟨λ UV, f UV x, continuous_of_discrete_topology⟩, 1, λ UV₁ UV₂,
    real.dist_le_of_mem_Icc_01 (hf01 _ _) (hf01 _ _)⟩,
  have hF : ∀ x UV, F x UV = f UV x := λ _ _, rfl,
  refine ⟨F, embedding.mk' _ (λ x y hxy, _) (λ x, le_antisymm _ _)⟩,
  { /- First we prove that `F` is injective. Indeed, if `F x = F y` and `x ≠ y`, then we can find
    `(U, V) ∈ s` such that `x ∈ U` and `y ∉ V`, hence `F x UV = 0 ≠ ε UV = F y UV`. -/
    refine not_not.1 (λ Hne, _), -- `by_contra Hne` timeouts
    rcases hB.mem_nhds_iff.1 (is_open_ne.mem_nhds Hne) with ⟨V, hVB, hxV, hVy⟩,
    rcases hB.exists_closure_subset (hB.mem_nhds hVB hxV) with ⟨U, hUB, hxU, hUV⟩,
    set UV : ↥s := ⟨(U, V), ⟨hUB, hVB⟩, hUV⟩,
    apply (ε01 UV).1.ne,
    calc (0 : ℝ) = F x UV : (hf0 UV hxU).symm
             ... = F y UV : by rw hxy
             ... = ε UV   : hfε UV (λ h : y ∈ V, hVy h rfl) },
  { /- Now we prove that each neighborhood `V` of `x : X` include a preimage of a neighborhood of
    `F x` under `F`. Without loss of generality, `V` belongs to `B`. Choose `U ∈ B` such that
    `x ∈ V` and `closure V ⊆ U`. Then the preimage of the `(ε (U, V))`-neighborhood of `F x`
    is included by `V`. -/
    refine ((nhds_basis_ball.comap _).le_basis_iff hB.nhds_has_basis).2 _,
    rintro V ⟨hVB, hxV⟩,
    rcases hB.exists_closure_subset (hB.mem_nhds hVB hxV) with ⟨U, hUB, hxU, hUV⟩,
    set UV : ↥s := ⟨(U, V), ⟨hUB, hVB⟩, hUV⟩,
    refine ⟨ε UV, (ε01 UV).1, λ y (hy : dist (F y) (F x) < ε UV), _⟩,
    replace hy : dist (F y UV) (F x UV) < ε UV,
      from (bounded_continuous_function.dist_coe_le_dist _).trans_lt hy,
    contrapose! hy,
    rw [hF, hF, hfε UV hy, hf0 UV hxU, pi.zero_apply, dist_zero_right],
    exact le_abs_self _ },
  { /- Finally, we prove that `F` is continuous. Given `δ > 0`, consider the set `T` of `(U, V) ∈ s`
    such that `ε (U, V) ≥ δ`. Since `ε` tends to zero, `T` is finite. Since each `f` is continuous,
    we can choose a neighborhood such that `dist (F y (U, V)) (F x (U, V)) ≤ δ` for any
    `(U, V) ∈ T`. For `(U, V) ∉ T`, the same inequality is true because both `F y (U, V)` and
    `F x (U, V)` belong to the interval `[0, ε (U, V)]`. -/
    refine (nhds_basis_closed_ball.comap _).ge_iff.2 (λ δ δ0, _),
    have h_fin : {UV : s | δ ≤ ε UV}.finite, by simpa only [← not_lt] using hε (gt_mem_nhds δ0),
    have : ∀ᶠ y in 𝓝 x, ∀ UV, δ ≤ ε UV → dist (F y UV) (F x UV) ≤ δ,
    { refine (eventually_all_finite h_fin).2 (λ UV hUV, _),
      exact (f UV).continuous.tendsto x (closed_ball_mem_nhds _ δ0) },
    refine this.mono (λ y hy, (bounded_continuous_function.dist_le δ0.le).2 $ λ UV, _),
    cases le_total δ (ε UV) with hle hle,
    exacts [hy _ hle, (real.dist_le_of_mem_Icc (hf0ε _ _) (hf0ε _ _)).trans (by rwa sub_zero)] }
end

/-- *Urysohn's metrization theorem* (Tychonoff's version): a T₃ topological space with second
countable topology `X` is metrizable, i.e., there exists a metric space structure that generates the
same topology. -/
lemma metrizable_space_of_t3_second_countable : metrizable_space X :=
let ⟨f, hf⟩ := exists_embedding_l_infty X in hf.metrizable_space

instance : metrizable_space ennreal := metrizable_space_of_t3_second_countable ennreal

end topological_space


def hello : (x : Nat) → (h : x = x) → True := by
  intro x
  --^ goals
  intro
--^ goals
  trivial

def hello2 : (x : Nat) → (h : x = x) → True := by
  intros
--^ goals
  trivial

theorem qqww (x y : Nat) (f : (α → x = y)) (h : y = x) : True := by
  rw [h] at f
   --^ goals
  trivial

theorem qqww2 (x y : Nat) (f : (α → x = y)) (h : y = x) : True := by
  rw [h] at f
       --^ goals
  trivial

theorem adsf : (True ∧ True) := by
  apply And.intro
--^ goals
  trivial
--^ goals
  trivial
--^ goals

theorem comm (x y z : Nat) (h : y = x) : (x + z) = (z + y) := by
  rw [Nat.add_comm, h]
    --^ goals


macro "obtain " p:term " from " d:term "; " body:term : term =>
`(match $d:term with | $p:term => $body:term)

theorem tst1 {p q r} (h : p ∧ q ∧ r) : q ∧ p ∧ r :=
match h with
| ⟨h₁, ⟨h₂, h₃⟩⟩ => ⟨h₂, ⟨h₁, h₃⟩⟩

theorem tst2 {p q r} (h : p ∧ q ∧ r) : q ∧ p ∧ r :=
obtain ⟨h₁, ⟨h₂, h₃⟩⟩ from h;
⟨h₂, ⟨h₁, h₃⟩⟩

macro "obtain " p:term " from " d:term : tactic =>
`(tactic| match $d:term with | $p:term => ?hole)

theorem tst3 {p q r} (h : p ∧ q ∧ r) : q ∧ p ∧ r := by
  obtain ⟨h₁, ⟨h₂, h₃⟩⟩ from h
  apply And.intro
  assumption
  apply And.intro
  assumption
  assumption