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

import ring_theory.algebraic
import ring_theory.localization.at_prime
import ring_theory.localization.integral

/-!
# Ideals over/under ideals

This file concerns ideals lying over other ideals.
Let `f : R →+* S` be a ring homomorphism (typically a ring extension), `I` an ideal of `R` and
`J` an ideal of `S`. We say `J` lies over `I` (and `I` under `J`) if `I` is the `f`-preimage of `J`.
This is expressed here by writing `I = J.comap f`.

## Implementation notes

The proofs of the `comap_ne_bot` and `comap_lt_comap` families use an approach
specific for their situation: we construct an element in `I.comap f` from the
coefficients of a minimal polynomial.
Once mathlib has more material on the localization at a prime ideal, the results
can be proven using more general going-up/going-down theory.
-/

variables {R : Type*} [comm_ring R]

namespace ideal

open polynomial
open_locale polynomial
open submodule

section comm_ring
variables {S : Type*} [comm_ring S] {f : R →+* S} {I J : ideal S}

lemma coeff_zero_mem_comap_of_root_mem_of_eval_mem {r : S} (hr : r ∈ I) {p : R[X]}
  (hp : p.eval₂ f r ∈ I) : p.coeff 0 ∈ I.comap f :=
begin
  rw [←p.div_X_mul_X_add, eval₂_add, eval₂_C, eval₂_mul, eval₂_X] at hp,
  refine mem_comap.mpr ((I.add_mem_iff_right _).mp hp),
  exact I.mul_mem_left _ hr
end

lemma coeff_zero_mem_comap_of_root_mem {r : S} (hr : r ∈ I) {p : R[X]}
  (hp : p.eval₂ f r = 0) : p.coeff 0 ∈ I.comap f :=
coeff_zero_mem_comap_of_root_mem_of_eval_mem hr (hp.symm ▸ I.zero_mem)

lemma exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem {r : S}
  (r_non_zero_divisor : ∀ {x}, x * r = 0 → x = 0) (hr : r ∈ I)
  {p : R[X]} : ∀ (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0),
  ∃ i, p.coeff i ≠ 0 ∧ p.coeff i ∈ I.comap f :=
begin
  refine p.rec_on_horner _ _ _,
  { intro h, contradiction },
  { intros p a coeff_eq_zero a_ne_zero ih p_ne_zero hp,
    refine ⟨0, _, coeff_zero_mem_comap_of_root_mem hr hp⟩,
    simp [coeff_eq_zero, a_ne_zero] },
  { intros p p_nonzero ih mul_nonzero hp,
    rw [eval₂_mul, eval₂_X] at hp,
    obtain ⟨i, hi, mem⟩ := ih p_nonzero (r_non_zero_divisor hp),
    refine ⟨i + 1, _, _⟩; simp [hi, mem] }
end

/-- Let `P` be an ideal in `R[x]`.  The map
`R[x]/P → (R / (P ∩ R))[x] / (P / (P ∩ R))`
is injective.
-/
lemma injective_quotient_le_comap_map (P : ideal R[X]) :
  function.injective ((map (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) P).quotient_map
    (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) le_comap_map) :=
begin
  refine quotient_map_injective' (le_of_eq _),
  rw comap_map_of_surjective
    (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X]))))
      (map_surjective (quotient.mk (P.comap (C : R →+* R[X]))) quotient.mk_surjective),
  refine le_antisymm (sup_le le_rfl _) (le_sup_of_le_left le_rfl),
  refine λ p hp, polynomial_mem_ideal_of_coeff_mem_ideal P p (λ n, quotient.eq_zero_iff_mem.mp _),
  simpa only [coeff_map, coe_map_ring_hom] using ext_iff.mp (ideal.mem_bot.mp (mem_comap.mp hp)) n,
end

/--
The identity in this lemma asserts that the "obvious" square
```
    R    → (R / (P ∩ R))
    ↓          ↓
R[x] / P → (R / (P ∩ R))[x] / (P / (P ∩ R))
```
commutes.  It is used, for instance, in the proof of `quotient_mk_comp_C_is_integral_of_jacobson`,
in the file `ring_theory/jacobson`.
-/
lemma quotient_mk_maps_eq (P : ideal R[X]) :
  ((quotient.mk (map (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) P)).comp C).comp
    (quotient.mk (P.comap (C : R →+* R[X]))) =
  ((map (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) P).quotient_map
    (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) le_comap_map).comp
      ((quotient.mk P).comp C) :=
begin
  refine ring_hom.ext (λ x, _),
  repeat { rw [ring_hom.coe_comp, function.comp_app] },
  rw [quotient_map_mk, coe_map_ring_hom, map_C],
end

/--
This technical lemma asserts the existence of a polynomial `p` in an ideal `P ⊂ R[x]`
that is non-zero in the quotient `R / (P ∩ R) [x]`.  The assumptions are equivalent to
`P ≠ 0` and `P ∩ R = (0)`.
-/
lemma exists_nonzero_mem_of_ne_bot {P : ideal R[X]}
  (Pb : P ≠ ⊥) (hP : ∀ (x : R), C x ∈ P → x = 0) :
  ∃ p : R[X], p ∈ P ∧ (polynomial.map (quotient.mk (P.comap (C : R →+* R[X]))) p) ≠ 0 :=
begin
  obtain ⟨m, hm⟩ := submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr Pb),
  refine ⟨m, submodule.coe_mem m, λ pp0, hm (submodule.coe_eq_zero.mp _)⟩,
  refine (injective_iff_map_eq_zero
    (polynomial.map_ring_hom (quotient.mk (P.comap (C : R →+* R[X]))))).mp _ _ pp0,
  refine map_injective _ ((quotient.mk (P.comap C)).injective_iff_ker_eq_bot.mpr _),
  rw [mk_ker],
  exact (submodule.eq_bot_iff _).mpr (λ x hx, hP x (mem_comap.mp hx)),
end

variables {p : ideal R} {P : ideal S}

/-- If there is an injective map `R/p → S/P` such that following diagram commutes:
```
R   → S
↓     ↓
R/p → S/P
```
then `P` lies over `p`.
-/
lemma comap_eq_of_scalar_tower_quotient [algebra R S] [algebra (R ⧸ p) (S ⧸ P)]
  [is_scalar_tower R (R ⧸ p) (S ⧸ P)]
  (h : function.injective (algebra_map (R ⧸ p) (S ⧸ P))) :
  comap (algebra_map R S) P = p :=
begin
  ext x, split; rw [mem_comap, ← quotient.eq_zero_iff_mem, ← quotient.eq_zero_iff_mem,
    quotient.mk_algebra_map, is_scalar_tower.algebra_map_apply _ (R ⧸ p),
    quotient.algebra_map_eq],
  { intro hx,
    exact (injective_iff_map_eq_zero (algebra_map (R ⧸ p) (S ⧸ P))).mp h _ hx },
  { intro hx,
    rw [hx, ring_hom.map_zero] },
end

/-- If `P` lies over `p`, then `R / p` has a canonical map to `S / P`. -/
def quotient.algebra_quotient_of_le_comap (h : p ≤ comap f P) :
  algebra (R ⧸ p) (S ⧸ P) :=
ring_hom.to_algebra $ quotient_map _ f h

/-- `R / p` has a canonical map to `S / pS`. -/
instance quotient.algebra_quotient_map_quotient :
  algebra (R ⧸ p) (S ⧸ map f p) :=
by exact quotient.algebra_quotient_of_le_comap le_comap_map

@[simp] lemma quotient.algebra_map_quotient_map_quotient (x : R) :
  algebra_map (R ⧸ p) (S ⧸ map f p) (quotient.mk p x) = quotient.mk _ (f x) :=
rfl

@[simp] lemma quotient.mk_smul_mk_quotient_map_quotient (x : R) (y : S) :
  quotient.mk p x • quotient.mk (map f p) y = quotient.mk _ (f x * y) :=
rfl

instance quotient.tower_quotient_map_quotient [algebra R S] :
  is_scalar_tower R (R ⧸ p) (S ⧸ map (algebra_map R S) p) :=
is_scalar_tower.of_algebra_map_eq $ λ x,
by rw [quotient.algebra_map_eq, quotient.algebra_map_quotient_map_quotient,
       quotient.mk_algebra_map]

instance quotient_map_quotient.is_noetherian [algebra R S] [is_noetherian R S] (I : ideal R) :
  is_noetherian (R ⧸ I) (S ⧸ ideal.map (algebra_map R S) I) :=
is_noetherian_of_tower R $
is_noetherian_of_surjective S (ideal.quotient.mkₐ R _).to_linear_map $
linear_map.range_eq_top.mpr ideal.quotient.mk_surjective

end comm_ring

section is_domain
variables {S : Type*} [comm_ring S] {f : R →+* S} {I J : ideal S}

lemma exists_coeff_ne_zero_mem_comap_of_root_mem
  [is_domain S] {r : S} (r_ne_zero : r ≠ 0) (hr : r ∈ I)
  {p : R[X]} : ∀ (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0),
  ∃ i, p.coeff i ≠ 0 ∧ p.coeff i ∈ I.comap f :=
exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem
  (λ _ h, or.resolve_right (mul_eq_zero.mp h) r_ne_zero) hr

lemma exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff
  [is_prime I] (hIJ : I ≤ J) {r : S} (hr : r ∈ (J : set S) \ I)
  {p : R[X]} (p_ne_zero : p.map (quotient.mk (I.comap f)) ≠ 0) (hpI : p.eval₂ f r ∈ I) :
  ∃ i, p.coeff i ∈ (J.comap f : set R) \ (I.comap f) :=
begin
  obtain ⟨hrJ, hrI⟩ := hr,
  have rbar_ne_zero : quotient.mk I r ≠ 0 := mt (quotient.mk_eq_zero I).mp hrI,
  have rbar_mem_J : quotient.mk I r ∈ J.map (quotient.mk I) := mem_map_of_mem _ hrJ,
  have quotient_f : ∀ x ∈ I.comap f, (quotient.mk I).comp f x = 0,
  { simp [quotient.eq_zero_iff_mem] },
  have rbar_root : (p.map (quotient.mk (I.comap f))).eval₂
    (quotient.lift (I.comap f) _ quotient_f)
    (quotient.mk I r) = 0,
  { convert quotient.eq_zero_iff_mem.mpr hpI,
    exact trans (eval₂_map _ _ _) (hom_eval₂ p f (quotient.mk I) r).symm },
  obtain ⟨i, ne_zero, mem⟩ :=
    exists_coeff_ne_zero_mem_comap_of_root_mem rbar_ne_zero rbar_mem_J p_ne_zero rbar_root,
  rw coeff_map at ne_zero mem,
  refine ⟨i, (mem_quotient_iff_mem hIJ).mp _, mt _ ne_zero⟩,
  { simpa using mem },
  simp [quotient.eq_zero_iff_mem],
end

lemma comap_lt_comap_of_root_mem_sdiff [I.is_prime] (hIJ : I ≤ J)
  {r : S} (hr : r ∈ (J : set S) \ I)
  {p : R[X]} (p_ne_zero : p.map (quotient.mk (I.comap f)) ≠ 0) (hp : p.eval₂ f r ∈ I) :
  I.comap f < J.comap f :=
let ⟨i, hJ, hI⟩ := exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff hIJ hr p_ne_zero hp
in set_like.lt_iff_le_and_exists.mpr ⟨comap_mono hIJ, p.coeff i, hJ, hI⟩

lemma mem_of_one_mem (h : (1 : S) ∈ I) (x) : x ∈ I :=
(I.eq_top_iff_one.mpr h).symm ▸ mem_top

lemma comap_lt_comap_of_integral_mem_sdiff [algebra R S] [hI : I.is_prime] (hIJ : I ≤ J)
  {x : S} (mem : x ∈ (J : set S) \ I) (integral : is_integral R x) :
  I.comap (algebra_map R S) < J.comap (algebra_map R S) :=
begin
  obtain ⟨p, p_monic, hpx⟩ := integral,
  refine comap_lt_comap_of_root_mem_sdiff hIJ mem _ _,
  swap,
  { apply map_monic_ne_zero p_monic,
    apply quotient.nontrivial,
    apply mt comap_eq_top_iff.mp,
    apply hI.1 },
  convert I.zero_mem
end

lemma comap_ne_bot_of_root_mem [is_domain S] {r : S} (r_ne_zero : r ≠ 0) (hr : r ∈ I)
  {p : R[X]} (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0) :
  I.comap f ≠ ⊥ :=
λ h, let ⟨i, hi, mem⟩ := exists_coeff_ne_zero_mem_comap_of_root_mem r_ne_zero hr p_ne_zero hp in
absurd (mem_bot.mp (eq_bot_iff.mp h mem)) hi

lemma is_maximal_of_is_integral_of_is_maximal_comap
  [algebra R S] (hRS : algebra.is_integral R S) (I : ideal S) [I.is_prime]
  (hI : is_maximal (I.comap (algebra_map R S))) : is_maximal I :=
⟨⟨mt comap_eq_top_iff.mpr hI.1.1,
  λ J I_lt_J, let ⟨I_le_J, x, hxJ, hxI⟩ := set_like.lt_iff_le_and_exists.mp I_lt_J in
  comap_eq_top_iff.1 $ hI.1.2 _ (comap_lt_comap_of_integral_mem_sdiff I_le_J ⟨hxJ, hxI⟩ (hRS x))⟩⟩

lemma is_maximal_of_is_integral_of_is_maximal_comap'
  (f : R →+* S) (hf : f.is_integral) (I : ideal S) [hI' : I.is_prime]
  (hI : is_maximal (I.comap f)) : is_maximal I :=
@is_maximal_of_is_integral_of_is_maximal_comap R _ S _ f.to_algebra hf I hI' hI

variables [algebra R S]

lemma comap_ne_bot_of_algebraic_mem [is_domain S] {x : S}
  (x_ne_zero : x ≠ 0) (x_mem : x ∈ I) (hx : is_algebraic R x) : I.comap (algebra_map R S) ≠ ⊥ :=
let ⟨p, p_ne_zero, hp⟩ := hx
in comap_ne_bot_of_root_mem x_ne_zero x_mem p_ne_zero hp

lemma comap_ne_bot_of_integral_mem [nontrivial R] [is_domain S] {x : S}
  (x_ne_zero : x ≠ 0) (x_mem : x ∈ I) (hx : is_integral R x) : I.comap (algebra_map R S) ≠ ⊥ :=
comap_ne_bot_of_algebraic_mem x_ne_zero x_mem (hx.is_algebraic R)

lemma eq_bot_of_comap_eq_bot [nontrivial R] [is_domain S] (hRS : algebra.is_integral R S)
  (hI : I.comap (algebra_map R S) = ⊥) : I = ⊥ :=
begin
  refine eq_bot_iff.2 (λ x hx, _),
  by_cases hx0 : x = 0,
  { exact hx0.symm ▸ ideal.zero_mem ⊥ },
  { exact absurd hI (comap_ne_bot_of_integral_mem hx0 hx (hRS x)) }
end

lemma is_maximal_comap_of_is_integral_of_is_maximal (hRS : algebra.is_integral R S)
  (I : ideal S) [hI : I.is_maximal] : is_maximal (I.comap (algebra_map R S)) :=
begin
  refine quotient.maximal_of_is_field _ _,
  haveI : is_prime (I.comap (algebra_map R S)) := comap_is_prime _ _,
  exact is_field_of_is_integral_of_is_field (is_integral_quotient_of_is_integral hRS)
    algebra_map_quotient_injective (by rwa ← quotient.maximal_ideal_iff_is_field_quotient),
end

lemma is_maximal_comap_of_is_integral_of_is_maximal'
  {R S : Type*} [comm_ring R] [comm_ring S]
  (f : R →+* S) (hf : f.is_integral) (I : ideal S) (hI : I.is_maximal) : is_maximal (I.comap f) :=
@is_maximal_comap_of_is_integral_of_is_maximal R _ S _ f.to_algebra hf I hI

section is_integral_closure

variables (S) {A : Type*} [comm_ring A]
variables [algebra R A] [algebra A S] [is_scalar_tower R A S] [is_integral_closure A R S]

lemma is_integral_closure.comap_lt_comap {I J : ideal A} [I.is_prime]
  (I_lt_J : I < J) :
  I.comap (algebra_map R A) < J.comap (algebra_map R A) :=
let ⟨I_le_J, x, hxJ, hxI⟩ := set_like.lt_iff_le_and_exists.mp I_lt_J in
comap_lt_comap_of_integral_mem_sdiff I_le_J ⟨hxJ, hxI⟩ (is_integral_closure.is_integral R S x)

lemma is_integral_closure.is_maximal_of_is_maximal_comap
  (I : ideal A) [I.is_prime]
  (hI : is_maximal (I.comap (algebra_map R A))) : is_maximal I :=
is_maximal_of_is_integral_of_is_maximal_comap (λ x, is_integral_closure.is_integral R S x) I hI

variables [is_domain A]

lemma is_integral_closure.comap_ne_bot [nontrivial R] {I : ideal A}
  (I_ne_bot : I ≠ ⊥) : I.comap (algebra_map R A) ≠ ⊥ :=
let ⟨x, x_mem, x_ne_zero⟩ := I.ne_bot_iff.mp I_ne_bot in
comap_ne_bot_of_integral_mem x_ne_zero x_mem (is_integral_closure.is_integral R S x)

lemma is_integral_closure.eq_bot_of_comap_eq_bot [nontrivial R] {I : ideal A} :
  I.comap (algebra_map R A) = ⊥ → I = ⊥ :=
imp_of_not_imp_not _ _ (is_integral_closure.comap_ne_bot S)

end is_integral_closure

lemma integral_closure.comap_lt_comap {I J : ideal (integral_closure R S)} [I.is_prime]
  (I_lt_J : I < J) :
  I.comap (algebra_map R (integral_closure R S)) < J.comap (algebra_map R (integral_closure R S)) :=
is_integral_closure.comap_lt_comap S I_lt_J

lemma integral_closure.is_maximal_of_is_maximal_comap
  (I : ideal (integral_closure R S)) [I.is_prime]
  (hI : is_maximal (I.comap (algebra_map R (integral_closure R S)))) : is_maximal I :=
is_integral_closure.is_maximal_of_is_maximal_comap S I hI

section
variables [is_domain S]

lemma integral_closure.comap_ne_bot [nontrivial R] {I : ideal (integral_closure R S)}
  (I_ne_bot : I ≠ ⊥) : I.comap (algebra_map R (integral_closure R S)) ≠ ⊥ :=
is_integral_closure.comap_ne_bot S I_ne_bot

lemma integral_closure.eq_bot_of_comap_eq_bot [nontrivial R] {I : ideal (integral_closure R S)} :
  I.comap (algebra_map R (integral_closure R S)) = ⊥ → I = ⊥ :=
is_integral_closure.eq_bot_of_comap_eq_bot S

/-- `comap (algebra_map R S)` is a surjection from the prime spec of `R` to prime spec of `S`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
lemma exists_ideal_over_prime_of_is_integral' (H : algebra.is_integral R S)
  (P : ideal R) [is_prime P] (hP : (algebra_map R S).ker ≤ P) :
  ∃ (Q : ideal S), is_prime Q ∧ Q.comap (algebra_map R S) = P :=
begin
  have hP0 : (0 : S) ∉ algebra.algebra_map_submonoid S P.prime_compl,
  { rintro ⟨x, ⟨hx, x0⟩⟩,
    exact absurd (hP x0) hx },
  let Rₚ := localization P.prime_compl,
  let Sₚ := localization (algebra.algebra_map_submonoid S P.prime_compl),
  letI : is_domain (localization (algebra.algebra_map_submonoid S P.prime_compl)) :=
    is_localization.is_domain_localization (le_non_zero_divisors_of_no_zero_divisors hP0),
  obtain ⟨Qₚ : ideal Sₚ, Qₚ_maximal⟩ := exists_maximal Sₚ,
  haveI Qₚ_max : is_maximal (comap _ Qₚ) :=
    @is_maximal_comap_of_is_integral_of_is_maximal Rₚ _ Sₚ _
      (localization_algebra P.prime_compl S)
      (is_integral_localization H) _ Qₚ_maximal,
  refine ⟨comap (algebra_map S Sₚ) Qₚ, ⟨comap_is_prime _ Qₚ, _⟩⟩,
  convert localization.at_prime.comap_maximal_ideal,
  rw [comap_comap, ← local_ring.eq_maximal_ideal Qₚ_max, ← is_localization.map_comp _],
  refl
end

end

/-- More general going-up theorem than `exists_ideal_over_prime_of_is_integral'`.
TODO: Version of going-up theorem with arbitrary length chains (by induction on this)?
  Not sure how best to write an ascending chain in Lean -/
theorem exists_ideal_over_prime_of_is_integral (H : algebra.is_integral R S)
  (P : ideal R) [is_prime P] (I : ideal S) [is_prime I] (hIP : I.comap (algebra_map R S) ≤ P) :
  ∃ Q ≥ I, is_prime Q ∧ Q.comap (algebra_map R S) = P :=
begin
  let quot := (R ⧸ I.comap (algebra_map R S)),
  obtain ⟨Q' : ideal (S ⧸ I), ⟨Q'_prime, hQ'⟩⟩ :=
    @exists_ideal_over_prime_of_is_integral'
      quot _ (S ⧸ I) _
      ideal.quotient_algebra
      _
      (is_integral_quotient_of_is_integral H)
      (map (quotient.mk (I.comap (algebra_map R S))) P)
      (map_is_prime_of_surjective quotient.mk_surjective (by simp [hIP]))
      (le_trans
        (le_of_eq ((ring_hom.injective_iff_ker_eq_bot _).1 algebra_map_quotient_injective))
        bot_le),
  haveI := Q'_prime,
  refine ⟨Q'.comap _, le_trans (le_of_eq mk_ker.symm) (ker_le_comap _), ⟨comap_is_prime _ Q', _⟩⟩,
  rw comap_comap,
  refine trans _ (trans (congr_arg (comap (quotient.mk (comap (algebra_map R S) I))) hQ') _),
  { simpa [comap_comap] },
  { refine trans (comap_map_of_surjective _ quotient.mk_surjective _) (sup_eq_left.2 _),
    simpa [← ring_hom.ker_eq_comap_bot] using hIP},
end

/-- `comap (algebra_map R S)` is a surjection from the max spec of `S` to max spec of `R`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
lemma exists_ideal_over_maximal_of_is_integral [is_domain S] (H : algebra.is_integral R S)
  (P : ideal R) [P_max : is_maximal P] (hP : (algebra_map R S).ker ≤ P) :
  ∃ (Q : ideal S), is_maximal Q ∧ Q.comap (algebra_map R S) = P :=
begin
  obtain ⟨Q, ⟨Q_prime, hQ⟩⟩ := exists_ideal_over_prime_of_is_integral' H P hP,
  haveI : Q.is_prime := Q_prime,
  exact ⟨Q, is_maximal_of_is_integral_of_is_maximal_comap H _ (hQ.symm ▸ P_max), hQ⟩,
end

end is_domain

end ideal


import MyNat.Definition
import MyNat.Addition
import AdditionWorld.Level6
import AdvancedAdditionWorld.Level1 -- succ_inj
import AdvancedAdditionWorld.Level3 -- succ_eq_succ_of_eq
namespace MyNat
open MyNat

/-!

# Advanced Addition World

## Level 4: `eq_iff_succ_eq_succ`

Here is an `iff` goal. You can split it into two goals (the implications in both
directions) using the `constructor` tactic, which is how you're going to have to start.

`constructor`

Now you have two goals. The first is exactly `succ_inj` so you can close
it with

`exact succ_inj`

and the second one you could solve by looking up the name of the theorem
you proved in the last level and doing `exact <that name>`, or alternatively
you could get some more `intro` practice and seeing if you can prove it
using `intro` and `rw`.

Remember that `succ_inj` is `succ a = succ b → a = b`.

## Theorem
Two natural numbers are equal if and only if their successors are equal.
-/
theorem succ_eq_succ_iff (a b : MyNat) : succ a = succ b ↔ a = b := by
  constructor
  exact succ_inj
  exact succ_eq_succ_of_eq

/-!
Next up [Level 5](./Level5.lean.md)
-/


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.degree.definitions
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Cancel the leading terms of two polynomials

## Definition

* `cancel_leads p q`: the polynomial formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting.

## Main Results
The degree of `cancel_leads` is less than that of the larger of the two polynomials being cancelled.
Thus it is useful for induction or minimal-degree arguments.
-/

namespace polynomial

/-- `cancel_leads p q` is formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting. -/
def cancel_leads {R : Type u_1} [comm_ring R] (p : polynomial R) (q : polynomial R) :
    polynomial R :=
  coe_fn C (leading_coeff p) * X ^ (nat_degree p - nat_degree q) * q -
    coe_fn C (leading_coeff q) * X ^ (nat_degree q - nat_degree p) * p

@[simp] theorem neg_cancel_leads {R : Type u_1} [comm_ring R] {p : polynomial R}
    {q : polynomial R} : -cancel_leads p q = cancel_leads q p :=
  neg_sub (coe_fn C (leading_coeff p) * X ^ (nat_degree p - nat_degree q) * q)
    (coe_fn C (leading_coeff q) * X ^ (nat_degree q - nat_degree p) * p)

theorem dvd_cancel_leads_of_dvd_of_dvd {R : Type u_1} [comm_ring R] {p : polynomial R}
    {q : polynomial R} {r : polynomial R} (pq : p ∣ q) (pr : p ∣ r) : p ∣ cancel_leads q r :=
  dvd_sub
    (dvd.trans pr
      (dvd.intro_left (coe_fn C (leading_coeff q) * X ^ (nat_degree q - nat_degree r)) rfl))
    (dvd.trans pq
      (dvd.intro_left (coe_fn C (leading_coeff r) * X ^ (nat_degree r - nat_degree q)) rfl))

theorem nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree {R : Type u_1} [integral_domain R]
    {p : polynomial R} {q : polynomial R} (h : nat_degree p ≤ nat_degree q)
    (hq : 0 < nat_degree q) : nat_degree (cancel_leads p q) < nat_degree q :=
  sorry

end Mathlib


/-
Copyright (c) 2021 François Sunatori. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: François Sunatori
-/
import analysis.complex.circle

/-!
# Isometries of the Complex Plane

The lemma `linear_isometry_complex` states the classification of isometries in the complex plane.
Specifically, isometries with rotations but without translation.
The proof involves:
1. creating a linear isometry `g` with two fixed points, `g(0) = 0`, `g(1) = 1`
2. applying `linear_isometry_complex_aux` to `g`
The proof of `linear_isometry_complex_aux` is separated in the following parts:
1. show that the real parts match up: `linear_isometry.re_apply_eq_re`
2. show that I maps to either I or -I
3. every z is a linear combination of a + b * I

## References

* [Isometries of the Complex Plane](http://helmut.knaust.info/mediawiki/images/b/b5/Iso.pdf)
-/
noncomputable theory

open complex
open_locale complex_conjugate

local notation `|` x `|` := complex.abs x

/-- An element of the unit circle defines a `linear_isometry_equiv` from `ℂ` to itself, by
rotation. This is an auxiliary construction; use `rotation`, which has more structure, by
preference. -/
def rotation_aux (a : circle) : ℂ ≃ₗᵢ[ℝ] ℂ :=
{ to_fun := λ z, a * z,
  map_add' := mul_add ↑a,
  map_smul' := λ t z, by { simp only [real_smul, ring_hom.id_apply], ring },
  inv_fun := λ z, a⁻¹ * z,
  left_inv := λ z, by { field_simp [nonzero_of_mem_circle], ring },
  right_inv := λ z, by { field_simp [nonzero_of_mem_circle], ring },
  norm_map' := by simp }

/-- An element of the unit circle defines a `linear_isometry_equiv` from `ℂ` to itself, by
rotation. -/
def rotation : circle →* (ℂ ≃ₗᵢ[ℝ] ℂ) :=
{ to_fun := rotation_aux,
  map_one' := by { ext1, simp [rotation_aux] },
  map_mul' := λ a b, by { ext1, simp [rotation_aux] } }

@[simp] lemma rotation_apply (a : circle) (z : ℂ) : rotation a z = a * z := rfl

lemma linear_isometry_equiv.congr_fun {R E F}
  [semiring R] [semi_normed_group E] [semi_normed_group F] [module R E] [module R F]
  {f g : E ≃ₗᵢ[R] F} (h : f = g) (x : E) : f x = g x :=
congr_arg _ h

lemma rotation_ne_conj_lie (a : circle) : rotation a ≠ conj_lie :=
begin
  intro h,
  have h1 : rotation a 1 = conj 1 := linear_isometry_equiv.congr_fun h 1,
  have hI : rotation a I = conj I := linear_isometry_equiv.congr_fun h I,
  rw [rotation_apply, ring_equiv.map_one, mul_one] at h1,
  rw [rotation_apply, conj_I, ← neg_one_mul, mul_left_inj' I_ne_zero, h1, eq_neg_self_iff] at hI,
  exact one_ne_zero hI,
end

/-- Takes an element of `ℂ ≃ₗᵢ[ℝ] ℂ` and checks if it is a rotation, returns an element of the
unit circle. -/
@[simps]
def rotation_of (e : ℂ ≃ₗᵢ[ℝ] ℂ) : circle :=
⟨(e 1) / complex.abs (e 1), by simp⟩

@[simp]
lemma rotation_of_rotation (a : circle) : rotation_of (rotation a) = a :=
subtype.ext $ by simp

lemma rotation_injective : function.injective rotation :=
function.left_inverse.injective rotation_of_rotation

lemma linear_isometry.re_apply_eq_re_of_add_conj_eq (f : ℂ →ₗᵢ[ℝ] ℂ)
  (h₃ : ∀ z, z + conj z = f z + conj (f z)) (z : ℂ) : (f z).re = z.re :=
by simpa [ext_iff, add_re, add_im, conj_re, conj_im, ←two_mul,
         (show (2 : ℝ) ≠ 0, by simp [two_ne_zero'])] using (h₃ z).symm

lemma linear_isometry.im_apply_eq_im_or_neg_of_re_apply_eq_re {f : ℂ →ₗᵢ[ℝ] ℂ}
  (h₂ : ∀ z, (f z).re = z.re) (z : ℂ) :
  (f z).im = z.im ∨ (f z).im = -z.im :=
begin
  have h₁ := f.norm_map z,
  simp only [complex.abs, norm_eq_abs] at h₁,
  rwa [real.sqrt_inj (norm_sq_nonneg _) (norm_sq_nonneg _), norm_sq_apply (f z), norm_sq_apply z,
    h₂, add_left_cancel_iff, mul_self_eq_mul_self_iff] at h₁,
end

lemma linear_isometry.im_apply_eq_im {f : ℂ →ₗᵢ[ℝ] ℂ} (h : f 1 = 1) (z : ℂ) :
  z + conj z = f z + conj (f z) :=
begin
  have : ∥f z - 1∥ = ∥z - 1∥ := by rw [← f.norm_map (z - 1), f.map_sub, h],
  apply_fun λ x, x ^ 2 at this,
  simp only [norm_eq_abs, ←norm_sq_eq_abs] at this,
  rw [←of_real_inj, ←mul_conj, ←mul_conj] at this,
  rw [ring_equiv.map_sub, ring_equiv.map_sub] at this,
  simp only [sub_mul, mul_sub, one_mul, mul_one] at this,
  rw [mul_conj, norm_sq_eq_abs, ←norm_eq_abs, linear_isometry.norm_map] at this,
  rw [mul_conj, norm_sq_eq_abs, ←norm_eq_abs] at this,
  simp only [sub_sub, sub_right_inj, mul_one, of_real_pow, ring_equiv.map_one, norm_eq_abs] at this,
  simp only [add_sub, sub_left_inj] at this,
  rw [add_comm, ←this, add_comm],
end

lemma linear_isometry.re_apply_eq_re {f : ℂ →ₗᵢ[ℝ] ℂ} (h : f 1 = 1) (z : ℂ) : (f z).re = z.re :=
begin
  apply linear_isometry.re_apply_eq_re_of_add_conj_eq,
  intro z,
  apply linear_isometry.im_apply_eq_im h,
end

lemma linear_isometry_complex_aux {f : ℂ ≃ₗᵢ[ℝ] ℂ} (h : f 1 = 1) :
  f = linear_isometry_equiv.refl ℝ ℂ ∨ f = conj_lie :=
begin
  have h0 : f I = I ∨ f I = -I,
  { have : |f I| = 1 := by simpa using f.norm_map complex.I,
    simp only [ext_iff, ←and_or_distrib_left, neg_re, I_re, neg_im, neg_zero],
    split,
    { rw ←I_re,
      exact @linear_isometry.re_apply_eq_re f.to_linear_isometry h I, },
    { apply @linear_isometry.im_apply_eq_im_or_neg_of_re_apply_eq_re f.to_linear_isometry,
      intro z, rw @linear_isometry.re_apply_eq_re f.to_linear_isometry h } },
  refine h0.imp (λ h' : f I = I, _) (λ h' : f I = -I, _);
  { apply linear_isometry_equiv.to_linear_equiv_injective,
    apply complex.basis_one_I.ext',
    intros i,
    fin_cases i; simp [h, h'] }
end

lemma linear_isometry_complex (f : ℂ ≃ₗᵢ[ℝ] ℂ) :
  ∃ a : circle, f = rotation a ∨ f = conj_lie.trans (rotation a) :=
begin
  let a : circle := ⟨f 1, by simpa using f.norm_map 1⟩,
  use a,
  have : (f.trans (rotation a).symm) 1 = 1,
  { simpa using rotation_apply a⁻¹ (f 1) },
  refine (linear_isometry_complex_aux this).imp (λ h₁, _) (λ h₂, _),
  { simpa using eq_mul_of_inv_mul_eq h₁ },
  { exact eq_mul_of_inv_mul_eq h₂ }
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Sébastien Gouëzel
The Hausdorff distance on subsets of a metric (or emetric) space.
Given two subsets `s` and `t` of a metric space, their Hausdorff distance is the smallest `d`
such that any point `s` is within `d` of a point in `t`, and conversely. This quantity
is often infinite (think of `s` bounded and `t` unbounded), and therefore better
expressed in the setting of emetric spaces.
This files introduces:
* `inf_edist x s`, the infimum edistance of a point `x` to a set `s` in an emetric space
* `Hausdorff_edist s t`, the Hausdorff edistance of two sets in an emetric space
* Versions of these notions on metric spaces, called respectively `inf_dist` and
`Hausdorff_dist`.
-/

import topology.metric_space.isometry topology.instances.ennreal topology.metric_space.cau_seq_filter
       topology.metric_space.lipschitz
noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable
universes u v w

open classical lattice set function topological_space filter

namespace emetric

section inf_edist
local notation `∞` := (⊤ : ennreal)
variables {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {x y : α} {s t : set α} {Φ : α → β}

/-- The minimal edistance of a point to a set -/
def inf_edist (x : α) (s : set α) : ennreal := Inf ((edist x) '' s)

@[simp] lemma inf_edist_empty : inf_edist x ∅ = ∞ :=
by unfold inf_edist; simp

/-- The edist to a union is the minimum of the edists -/
@[simp] lemma inf_edist_union : inf_edist x (s ∪ t) = inf_edist x s ⊓ inf_edist x t :=
by simp [inf_edist, image_union, Inf_union]

/-- The edist to a singleton is the edistance to the single point of this singleton -/
@[simp] lemma inf_edist_singleton : inf_edist x {y} = edist x y :=
by simp [inf_edist]

/-- The edist to a set is bounded above by the edist to any of its points -/
lemma inf_edist_le_edist_of_mem (h : y ∈ s) : inf_edist x s ≤ edist x y :=
Inf_le ((mem_image _ _ _).2 ⟨y, h, by refl⟩)

/-- If a point `x` belongs to `s`, then its edist to `s` vanishes -/
lemma inf_edist_zero_of_mem (h : x ∈ s) : inf_edist x s = 0 :=
le_zero_iff_eq.1 $ @edist_self _ _ x ▸ inf_edist_le_edist_of_mem h

/-- The edist is monotonous with respect to inclusion -/
lemma inf_edist_le_inf_edist_of_subset (h : s ⊆ t) : inf_edist x t ≤ inf_edist x s :=
Inf_le_Inf (image_subset _ h)

/-- If the edist to a set is `< r`, there exists a point in the set at edistance `< r` -/
lemma exists_edist_lt_of_inf_edist_lt {r : ennreal} (h : inf_edist x s < r) :
  ∃y∈s, edist x y < r :=
let ⟨t, ⟨ht, tr⟩⟩ :=  Inf_lt_iff.1 h in
let ⟨y, ⟨ys, hy⟩⟩ := (mem_image _ _ _).1 ht in
⟨y, ys, by rwa ← hy at tr⟩

/-- The edist of `x` to `s` is bounded by the sum of the edist of `y` to `s` and
the edist from `x` to `y` -/
lemma inf_edist_le_inf_edist_add_edist : inf_edist x s ≤ inf_edist y s + edist x y :=
begin
  have : ∀z ∈ s, Inf (edist x '' s) ≤ edist y z + edist x y := λz hz, calc
    Inf (edist x '' s) ≤ edist x z :
      Inf_le ((mem_image _ _ _).2 ⟨z, hz, by refl⟩)
    ... ≤ edist x y + edist y z : edist_triangle _ _ _
    ... = edist y z + edist x y : add_comm _ _,
  have : (λz, z + edist x y) (Inf (edist y '' s)) = Inf ((λz, z + edist x y) '' (edist y '' s)),
  { refine Inf_of_continuous _ _ (by simp),
    { exact continuous_add continuous_id continuous_const },
    { assume a b h, simp, apply add_le_add_right' h }},
  simp only [inf_edist] at this,
  rw [inf_edist, inf_edist, this, ← image_comp],
  simpa only [and_imp, function.comp_app, lattice.le_Inf_iff, exists_imp_distrib, ball_image_iff]
end

/-- The edist to a set depends continuously on the point -/
lemma continuous_inf_edist : continuous (λx, inf_edist x s) :=
continuous_of_le_add_edist 1 (by simp) $
  by simp only [one_mul, inf_edist_le_inf_edist_add_edist, forall_2_true_iff]

/-- The edist to a set and to its closure coincide -/
lemma inf_edist_closure : inf_edist x (closure s) = inf_edist x s :=
begin
  refine le_antisymm (inf_edist_le_inf_edist_of_subset subset_closure) _,
  refine ennreal.le_of_forall_epsilon_le (λε εpos h, _),
  have εpos' : (0 : ennreal) < ε := by simpa,
  have : inf_edist x (closure s) < inf_edist x (closure s) + ε/2 :=
    ennreal.lt_add_right h (ennreal.half_pos εpos'),
  rcases exists_edist_lt_of_inf_edist_lt this with ⟨y, ycs, hy⟩,
  -- y : α,  ycs : y ∈ closure s,  hy : edist x y < inf_edist x (closure s) + ↑ε / 2
  rcases emetric.mem_closure_iff'.1 ycs (ε/2) (ennreal.half_pos εpos') with ⟨z, zs, dyz⟩,
  -- z : α,  zs : z ∈ s,  dyz : edist y z < ↑ε / 2
  calc inf_edist x s ≤ edist x z : inf_edist_le_edist_of_mem zs
        ... ≤ edist x y + edist y z : edist_triangle _ _ _
        ... ≤ (inf_edist x (closure s) + ε / 2) + (ε/2) : add_le_add' (le_of_lt hy) (le_of_lt dyz)
        ... = inf_edist x (closure s) + ↑ε : by simp [ennreal.add_halves]
end

/-- A point belongs to the closure of `s` iff its infimum edistance to this set vanishes -/
lemma mem_closure_iff_inf_edist_zero : x ∈ closure s ↔ inf_edist x s = 0 :=
⟨λh, by rw ← inf_edist_closure; exact inf_edist_zero_of_mem h,
λh, emetric.mem_closure_iff'.2 $ λε εpos, exists_edist_lt_of_inf_edist_lt (by rwa h)⟩

/-- Given a closed set `s`, a point belongs to `s` iff its infimum edistance to this set vanishes -/
lemma mem_iff_ind_edist_zero_of_closed (h : is_closed s) : x ∈ s ↔ inf_edist x s = 0 :=
begin
  convert ← mem_closure_iff_inf_edist_zero,
  exact closure_eq_iff_is_closed.2 h
end

/-- The infimum edistance is invariant under isometries -/
lemma inf_edist_image (hΦ : isometry Φ) :
  inf_edist (Φ x) (Φ '' t) = inf_edist x t :=
begin
  simp only [inf_edist],
  apply congr_arg,
  ext b, split,
  { assume hb,
    rcases (mem_image _ _ _).1 hb with ⟨y, ⟨hy, hy'⟩⟩,
    rcases (mem_image _ _ _).1 hy with ⟨z, ⟨hz, hz'⟩⟩,
    rw [← hy', ← hz', hΦ x z],
    exact mem_image_of_mem _ hz },
  { assume hb,
    rcases (mem_image _ _ _).1 hb with ⟨y, ⟨hy, hy'⟩⟩,
    rw [← hy', ← hΦ x y],
    exact mem_image_of_mem _ (mem_image_of_mem _ hy) }
end

end inf_edist --section

/-- The Hausdorff edistance between two sets is the smallest `r` such that each set
is contained in the `r`-neighborhood of the other one -/
def Hausdorff_edist {α : Type u} [emetric_space α] (s t : set α) : ennreal :=
  Sup ((λx, inf_edist x t) '' s) ⊔ Sup ((λx, inf_edist x s) '' t)

section Hausdorff_edist
local notation `∞` := (⊤ : ennreal)
variables {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
          {x y : α} {s t u : set α} {Φ : α → β}

/-- The Hausdorff edistance of a set to itself vanishes -/
@[simp] lemma Hausdorff_edist_self : Hausdorff_edist s s = 0 :=
begin
  unfold Hausdorff_edist,
  erw [lattice.sup_idem, ← le_bot_iff],
  apply Sup_le _,
  simp [le_bot_iff, inf_edist_zero_of_mem] {contextual := tt},
end

/-- The Haudorff edistances of `s` to `t` and of `t` to `s` coincide -/
lemma Hausdorff_edist_comm : Hausdorff_edist s t = Hausdorff_edist t s :=
by unfold Hausdorff_edist; apply sup_comm

/-- Bounding the Hausdorff edistance by bounding the edistance of any point
in each set to the other set -/
lemma Hausdorff_edist_le_of_inf_edist {r : ennreal}
  (H1 : ∀x ∈ s, inf_edist x t ≤ r) (H2 : ∀x ∈ t, inf_edist x s ≤ r) :
  Hausdorff_edist s t ≤ r :=
begin
  simp only [Hausdorff_edist, -mem_image, set.ball_image_iff, lattice.Sup_le_iff, lattice.sup_le_iff],
  exact ⟨H1, H2⟩
end

/-- Bounding the Hausdorff edistance by exhibiting, for any point in each set,
another point in the other set at controlled distance -/
lemma Hausdorff_edist_le_of_mem_edist {r : ennreal}
  (H1 : ∀x ∈ s, ∃y ∈ t, edist x y ≤ r) (H2 : ∀x ∈ t, ∃y ∈ s, edist x y ≤ r) :
  Hausdorff_edist s t ≤ r :=
begin
  refine Hausdorff_edist_le_of_inf_edist _ _,
  { assume x xs,
    rcases H1 x xs with ⟨y, yt, hy⟩,
    exact le_trans (inf_edist_le_edist_of_mem yt) hy },
  { assume x xt,
    rcases H2 x xt with ⟨y, ys, hy⟩,
    exact le_trans (inf_edist_le_edist_of_mem ys) hy }
end

/-- The distance to a set is controlled by the Hausdorff distance -/
lemma inf_edist_le_Hausdorff_edist_of_mem (h : x ∈ s) : inf_edist x t ≤ Hausdorff_edist s t :=
begin
  refine le_trans (le_Sup _) le_sup_left,
  exact mem_image_of_mem _ h
end

/-- If the Hausdorff distance is `<r`, then any point in one of the sets has
a corresponding point at distance `<r` in the other set -/
lemma exists_edist_lt_of_Hausdorff_edist_lt {r : ennreal} (h : x ∈ s) (H : Hausdorff_edist s t < r) :
  ∃y∈t, edist x y < r :=
exists_edist_lt_of_inf_edist_lt $ calc
  inf_edist x t ≤ Sup ((λx, inf_edist x t) '' s) : le_Sup (mem_image_of_mem _ h)
  ... ≤ Sup ((λx, inf_edist x t) '' s) ⊔ Sup ((λx, inf_edist x s) '' t) : le_sup_left
  ... < r : H

/-- The distance from `x` to `s`or `t` is controlled in terms of the Hausdorff distance
between `s` and `t` -/
lemma inf_edist_le_inf_edist_add_Hausdorff_edist :
  inf_edist x t ≤ inf_edist x s + Hausdorff_edist s t :=
ennreal.le_of_forall_epsilon_le $ λε εpos h, begin
  have εpos' : (0 : ennreal) < ε := by simpa,
  have : inf_edist x s < inf_edist x s + ε/2 :=
    ennreal.lt_add_right (ennreal.add_lt_top.1 h).1 (ennreal.half_pos εpos'),
  rcases exists_edist_lt_of_inf_edist_lt this with ⟨y, ys, dxy⟩,
  -- y : α,  ys : y ∈ s,  dxy : edist x y < inf_edist x s + ↑ε / 2
  have : Hausdorff_edist s t < Hausdorff_edist s t + ε/2 :=
    ennreal.lt_add_right (ennreal.add_lt_top.1 h).2 (ennreal.half_pos εpos'),
  rcases exists_edist_lt_of_Hausdorff_edist_lt ys this with ⟨z, zt, dyz⟩,
  -- z : α,  zt : z ∈ t,  dyz : edist y z < Hausdorff_edist s t + ↑ε / 2
  calc inf_edist x t ≤ edist x z : inf_edist_le_edist_of_mem zt
    ... ≤ edist x y + edist y z : edist_triangle _ _ _
    ... ≤ (inf_edist x s + ε/2) + (Hausdorff_edist s t + ε/2) : add_le_add' (le_of_lt dxy) (le_of_lt dyz)
    ... = inf_edist x s + Hausdorff_edist s t + ε : by simp [ennreal.add_halves, add_comm]
end

/-- The Hausdorff edistance is invariant under eisometries -/
lemma Hausdorff_edist_image (h : isometry Φ) :
  Hausdorff_edist (Φ '' s) (Φ '' t) = Hausdorff_edist s t :=
begin
  unfold Hausdorff_edist,
  congr,
  { ext b,
    split,
    { assume hb,
      rcases (mem_image _ _ _ ).1 hb with ⟨y, ⟨hy, hy'⟩⟩,
      rcases (mem_image _ _ _ ).1 hy with ⟨z, ⟨hz, hz'⟩⟩,
      rw [← hy', ← hz', inf_edist_image h],
      exact mem_image_of_mem _ hz },
    { assume hb,
      rcases (mem_image _ _ _ ).1 hb with ⟨y, ⟨hy, hy'⟩⟩,
      rw [← hy', ← inf_edist_image h],
      exact mem_image_of_mem _ (mem_image_of_mem _ hy) }},
  { ext b,
    split,
    { assume hb,
      rcases (mem_image _ _ _ ).1 hb with ⟨y, ⟨hy, hy'⟩⟩,
      rcases (mem_image _ _ _ ).1 hy with ⟨z, ⟨hz, hz'⟩⟩,
      rw [← hy', ← hz', inf_edist_image h],
      exact mem_image_of_mem _ hz },
    { assume hb,
      rcases (mem_image _ _ _ ).1 hb with ⟨y, ⟨hy, hy'⟩⟩,
      rw [← hy', ← inf_edist_image h],
      exact mem_image_of_mem _ (mem_image_of_mem _ hy) }}
end

/-- The Hausdorff distance is controlled by the diameter of the union -/
lemma Hausdorff_edist_le_ediam (hs : s ≠ ∅) (ht : t ≠ ∅) : Hausdorff_edist s t ≤ diam (s ∪ t) :=
begin
  rcases ne_empty_iff_exists_mem.1 hs with ⟨x, xs⟩,
  rcases ne_empty_iff_exists_mem.1 ht with ⟨y, yt⟩,
  refine Hausdorff_edist_le_of_mem_edist _ _,
  { exact λz hz, ⟨y, yt, edist_le_diam_of_mem (subset_union_left _ _ hz) (subset_union_right _ _ yt)⟩ },
  { exact λz hz, ⟨x, xs, edist_le_diam_of_mem (subset_union_right _ _ hz) (subset_union_left _ _ xs)⟩ }
end

/-- The Hausdorff distance satisfies the triangular inequality -/
lemma Hausdorff_edist_triangle : Hausdorff_edist s u ≤ Hausdorff_edist s t + Hausdorff_edist t u :=
begin
  change Sup ((λx, inf_edist x u) '' s) ⊔ Sup ((λx, inf_edist x s) '' u) ≤ Hausdorff_edist s t + Hausdorff_edist t u,
  simp only [and_imp, set.mem_image, lattice.Sup_le_iff, exists_imp_distrib,
             lattice.sup_le_iff, -mem_image, set.ball_image_iff],
  split,
  show ∀x ∈ s, inf_edist x u ≤ Hausdorff_edist s t + Hausdorff_edist t u, from λx xs, calc
    inf_edist x u ≤ inf_edist x t + Hausdorff_edist t u : inf_edist_le_inf_edist_add_Hausdorff_edist
    ... ≤ Hausdorff_edist s t + Hausdorff_edist t u :
      add_le_add_right' (inf_edist_le_Hausdorff_edist_of_mem  xs),
  show ∀x ∈ u, inf_edist x s ≤ Hausdorff_edist s t + Hausdorff_edist t u, from λx xu, calc
    inf_edist x s ≤ inf_edist x t + Hausdorff_edist t s : inf_edist_le_inf_edist_add_Hausdorff_edist
    ... ≤ Hausdorff_edist u t + Hausdorff_edist t s :
      add_le_add_right' (inf_edist_le_Hausdorff_edist_of_mem xu)
    ... = Hausdorff_edist s t + Hausdorff_edist t u : by simp [Hausdorff_edist_comm, add_comm]
end

/-- The Hausdorff edistance between a set and its closure vanishes -/
@[simp] lemma Hausdorff_edist_self_closure : Hausdorff_edist s (closure s) = 0 :=
begin
  erw ← le_bot_iff,
  simp only [Hausdorff_edist, inf_edist_closure, -le_zero_iff_eq, and_imp,
    set.mem_image, lattice.Sup_le_iff, exists_imp_distrib, lattice.sup_le_iff,
    set.ball_image_iff, ennreal.bot_eq_zero, -mem_image],
  simp only [inf_edist_zero_of_mem, mem_closure_iff_inf_edist_zero, le_refl, and_self,
             forall_true_iff] {contextual := tt}
end

/-- Replacing a set by its closure does not change the Hausdorff edistance. -/
@[simp] lemma Hausdorff_edist_closure₁ : Hausdorff_edist (closure s) t = Hausdorff_edist s t :=
begin
  refine le_antisymm _ _,
  { calc  _ ≤ Hausdorff_edist (closure s) s + Hausdorff_edist s t : Hausdorff_edist_triangle
    ... = Hausdorff_edist s t : by simp [Hausdorff_edist_comm] },
  { calc _ ≤ Hausdorff_edist s (closure s) + Hausdorff_edist (closure s) t : Hausdorff_edist_triangle
    ... = Hausdorff_edist (closure s) t : by simp }
end

/-- Replacing a set by its closure does not change the Hausdorff edistance. -/
@[simp] lemma Hausdorff_edist_closure₂ : Hausdorff_edist s (closure t) = Hausdorff_edist s t :=
by simp [@Hausdorff_edist_comm _ _ s _]

/-- The Hausdorff edistance between sets or their closures is the same -/
@[simp] lemma Hausdorff_edist_closure : Hausdorff_edist (closure s) (closure t) = Hausdorff_edist s t :=
by simp

/-- Two sets are at zero Hausdorff edistance if and only if they have the same closure -/
lemma Hausdorff_edist_zero_iff_closure_eq_closure : Hausdorff_edist s t = 0 ↔ closure s = closure t :=
⟨begin
  assume h,
  refine subset.antisymm _ _,
  { have : s ⊆ closure t := λx xs, mem_closure_iff_inf_edist_zero.2 $ begin
      erw ← le_bot_iff,
      have := @inf_edist_le_Hausdorff_edist_of_mem _ _ _ _ t xs,
      rwa h at this,
    end,
    by rw ← @closure_closure _ _ t; exact closure_mono this },
  { have : t ⊆ closure s := λx xt, mem_closure_iff_inf_edist_zero.2 $ begin
      erw ← le_bot_iff,
      have := @inf_edist_le_Hausdorff_edist_of_mem _ _ _ _ s xt,
      rw Hausdorff_edist_comm at h,
      rwa h at this,
    end,
    by rw ← @closure_closure _ _ s; exact closure_mono this }
end,
λh, by rw [← Hausdorff_edist_closure, h, Hausdorff_edist_self]⟩

/-- Two closed sets are at zero Hausdorff edistance if and only if they coincide -/
lemma Hausdorff_edist_zero_iff_eq_of_closed (hs : is_closed s) (ht : is_closed t) :
  Hausdorff_edist s t = 0 ↔ s = t :=
by rw [Hausdorff_edist_zero_iff_closure_eq_closure, closure_eq_iff_is_closed.2 hs,
       closure_eq_iff_is_closed.2 ht]

/-- The Haudorff edistance to the empty set is infinite -/
lemma Hausdorff_edist_empty (ne : s ≠ ∅) : Hausdorff_edist s ∅ = ∞ :=
begin
  rcases exists_mem_of_ne_empty ne with ⟨x, xs⟩,
  have : inf_edist x ∅ ≤ Hausdorff_edist s ∅ := inf_edist_le_Hausdorff_edist_of_mem xs,
  simpa using this,
end

/-- If a set is at finite Hausdorff edistance of a nonempty set, it is nonempty -/
lemma ne_empty_of_Hausdorff_edist_ne_top (hs : s ≠ ∅) (fin : Hausdorff_edist s t ≠ ⊤) : t ≠ ∅ :=
begin
  by_contradiction h,
  simp only [not_not, ne.def] at h,
  rw [h, Hausdorff_edist_empty hs] at fin,
  simpa using fin
end

end Hausdorff_edist -- section
end emetric --namespace

/-Now, we turn to the same notions in metric spaces. To avoid the difficulties related to
Inf and Sup on ℝ (which is only conditionnally complete), we use the notions in ennreal formulated
in terms of the edistance, and coerce them to ℝ. Then their properties follow readily from the
corresponding properties in ennreal, modulo some tedious rewriting of inequalities from one to the
other -/

namespace metric
section
variables {α : Type u} {β : Type v} [metric_space α] [metric_space β] {s t u : set α} {x y : α} {Φ : α → β}
open emetric

/-- The minimal distance of a point to a set -/
def inf_dist (x : α) (s : set α) : ℝ := ennreal.to_real (inf_edist x s)

/-- the minimal distance is always nonnegative -/
lemma inf_dist_nonneg : 0 ≤ inf_dist x s := by simp [inf_dist]

/-- the minimal distance to the empty set is 0 (if you want to have the more reasonable
value ∞ instead, use `inf_edist`, which takes values in ennreal) -/
@[simp] lemma inf_dist_empty : inf_dist x ∅ = 0 :=
by simp [inf_dist]

/-- In a metric space, the minimal edistance to a nonempty set is finite -/
lemma inf_edist_ne_top (h : s ≠ ∅) : inf_edist x s ≠ ⊤ :=
begin
  rcases exists_mem_of_ne_empty h with ⟨y, hy⟩,
  apply lt_top_iff_ne_top.1,
  calc inf_edist x s ≤ edist x y : inf_edist_le_edist_of_mem hy
       ... < ⊤ : lt_top_iff_ne_top.2 (edist_ne_top _ _)
end

/-- The minimal distance of a point to a set containing it vanishes -/
lemma inf_dist_zero_of_mem (h : x ∈ s) : inf_dist x s = 0 :=
by simp [inf_edist_zero_of_mem h, inf_dist]

/-- The minimal distance to a singleton is the distance to the unique point in this singleton -/
@[simp] lemma inf_dist_singleton : inf_dist x {y} = dist x y :=
by simp [inf_dist, inf_edist, dist_edist]

/-- The minimal distance to a set is bounded by the distance to any point in this set -/
lemma inf_dist_le_dist_of_mem (h : y ∈ s) : inf_dist x s ≤ dist x y :=
begin
  rw [dist_edist, inf_dist, ennreal.to_real_le_to_real (inf_edist_ne_top (ne_empty_of_mem h)) (edist_ne_top _ _)],
  exact inf_edist_le_edist_of_mem h
end

/-- The minimal distance is monotonous with respect to inclusion -/
lemma inf_dist_le_inf_dist_of_subset (h : s ⊆ t) (hs : s ≠ ∅) :
  inf_dist x t ≤ inf_dist x s :=
begin
  rcases ne_empty_iff_exists_mem.1 hs with ⟨y, hy⟩,
  have ht : t ≠ ∅ := ne_empty_of_mem (h hy),
  rw [inf_dist, inf_dist, ennreal.to_real_le_to_real (inf_edist_ne_top ht) (inf_edist_ne_top hs)],
  exact inf_edist_le_inf_edist_of_subset h
end

/-- If the minimal distance to a set is `<r`, there exists a point in this set at distance `<r` -/
lemma exists_dist_lt_of_inf_dist_lt {r : real} (h : inf_dist x s < r) (hs : s ≠ ∅) :
  ∃y∈s, dist x y < r :=
begin
  have rpos : 0 < r := lt_of_le_of_lt inf_dist_nonneg h,
  have : inf_edist x s < ennreal.of_real r,
  { rwa [inf_dist, ← ennreal.to_real_of_real (le_of_lt rpos), ennreal.to_real_lt_to_real (inf_edist_ne_top hs)] at h,
    simp },
  rcases exists_edist_lt_of_inf_edist_lt this with ⟨y, ys, hy⟩,
  rw [edist_dist, ennreal.of_real_lt_of_real_iff rpos] at hy,
  exact ⟨y, ys, hy⟩,
end

/-- The minimal distance from `x` to `s` is bounded by the distance from `y` to `s`, modulo
the distance between `x` and `y` -/
lemma inf_dist_le_inf_dist_add_dist : inf_dist x s ≤ inf_dist y s + dist x y :=
begin
  by_cases hs : s = ∅,
  { by simp [hs, dist_nonneg] },
  { rw [inf_dist, inf_dist, dist_edist, ← ennreal.to_real_add (inf_edist_ne_top hs) (edist_ne_top _ _),
        ennreal.to_real_le_to_real (inf_edist_ne_top hs)],
    { apply inf_edist_le_inf_edist_add_edist },
    { simp [ennreal.add_eq_top, inf_edist_ne_top hs, edist_ne_top] }}
end

/-- The minimal distance to a set is uniformly continuous -/
lemma uniform_continuous_inf_dist : uniform_continuous (λx, inf_dist x s) :=
uniform_continuous_of_le_add 1 (by simp [inf_dist_le_inf_dist_add_dist])

/-- The minimal distance to a set is continuous -/
lemma continuous_inf_dist : continuous (λx, inf_dist x s) :=
uniform_continuous_inf_dist.continuous

/-- The minimal distance to a set and its closure coincide -/
lemma inf_dist_eq_closure : inf_dist x (closure s) = inf_dist x s :=
by simp [inf_dist, inf_edist_closure]

/-- A point belongs to the closure of `s` iff its infimum distance to this set vanishes -/
lemma mem_closure_iff_inf_dist_zero (h : s ≠ ∅) : x ∈ closure s ↔ inf_dist x s = 0 :=
by simp [mem_closure_iff_inf_edist_zero, inf_dist, ennreal.to_real_eq_zero_iff, inf_edist_ne_top h]

/-- Given a closed set `s`, a point belongs to `s` iff its infimum distance to this set vanishes -/
lemma mem_iff_ind_dist_zero_of_closed (h : is_closed s) (hs : s ≠ ∅) :
  x ∈ s ↔ inf_dist x s = 0 :=
begin
  have := @mem_closure_iff_inf_dist_zero _ _ s x hs,
  rwa closure_eq_iff_is_closed.2 h at this
end

/-- The infimum distance is invariant under isometries -/
lemma inf_dist_image (hΦ : isometry Φ) :
  inf_dist (Φ x) (Φ '' t) = inf_dist x t :=
by simp [inf_dist, inf_edist_image hΦ]

/-- The Hausdorff distance between two sets is the smallest nonnegative `r` such that each set is
included in the `r`-neighborhood of the other. If there is no such `r`, it is defined to
be `0`, arbitrarily -/
def Hausdorff_dist (s t : set α) : ℝ := ennreal.to_real (Hausdorff_edist s t)

/-- The Hausdorff distance is nonnegative -/
lemma Hausdorff_dist_nonneg : 0 ≤ Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- If two sets are nonempty and bounded in a metric space, they are at finite Hausdorff edistance -/
lemma Hausdorff_edist_ne_top_of_ne_empty_of_bounded (hs : s ≠ ∅) (ht : t ≠ ∅)
  (bs : bounded s) (bt : bounded t) : Hausdorff_edist s t ≠ ⊤ :=
begin
  rcases ne_empty_iff_exists_mem.1 hs with ⟨cs, hcs⟩,
  rcases ne_empty_iff_exists_mem.1 ht with ⟨ct, hct⟩,
  rcases (bounded_iff_subset_ball ct).1 bs with ⟨rs, hrs⟩,
  rcases (bounded_iff_subset_ball cs).1 bt with ⟨rt, hrt⟩,
  have : Hausdorff_edist s t ≤ ennreal.of_real (max rs rt),
  { apply Hausdorff_edist_le_of_mem_edist,
    { assume x xs,
      existsi [ct, hct],
      have : dist x ct ≤ max rs rt := le_trans (hrs xs) (le_max_left _ _),
      rwa [edist_dist, ennreal.of_real_le_of_real_iff],
      exact le_trans dist_nonneg this },
    { assume x xt,
      existsi [cs, hcs],
      have : dist x cs ≤ max rs rt := le_trans (hrt xt) (le_max_right _ _),
      rwa [edist_dist, ennreal.of_real_le_of_real_iff],
      exact le_trans dist_nonneg this }},
  exact ennreal.lt_top_iff_ne_top.1 (lt_of_le_of_lt this (by simp [lt_top_iff_ne_top]))
end

/-- The Hausdorff distance between a set and itself is zero -/
@[simp] lemma Hausdorff_dist_self_zero : Hausdorff_dist s s = 0 :=
by simp [Hausdorff_dist]

/-- The Hausdorff distance from `s` to `t` and from `t` to `s` coincide -/
lemma Hausdorff_dist_comm : Hausdorff_dist s t = Hausdorff_dist t s :=
by simp [Hausdorff_dist, Hausdorff_edist_comm]

/-- The Hausdorff distance to the empty set vanishes (if you want to have the more reasonable
value ∞ instead, use `Hausdorff_edist`, which takes values in ennreal) -/
@[simp] lemma Hausdorff_dist_empty : Hausdorff_dist s ∅ = 0 :=
begin
  by_cases h : s = ∅,
  { simp [h] },
  { simp [Hausdorff_dist, Hausdorff_edist_empty h] }
end

/-- The Hausdorff distance to the empty set vanishes (if you want to have the more reasonable
value ∞ instead, use `Hausdorff_edist`, which takes values in ennreal) -/
@[simp] lemma Hausdorff_dist_empty' : Hausdorff_dist ∅ s = 0 :=
by simp [Hausdorff_dist_comm]

/-- Bounding the Hausdorff distance by bounding the distance of any point
in each set to the other set -/
lemma Hausdorff_dist_le_of_inf_dist {r : ℝ} (hr : r ≥ 0)
  (H1 : ∀x ∈ s, inf_dist x t ≤ r) (H2 : ∀x ∈ t, inf_dist x s ≤ r) :
  Hausdorff_dist s t ≤ r :=
begin
  by_cases h : (Hausdorff_edist s t = ⊤) ∨ (s = ∅) ∨ (t = ∅),
  { rcases h with h1 | h2 | h3,
    { simpa [Hausdorff_dist, h1] },
    { simpa [h2] },
    { simpa [h3] }},
  { simp only [not_or_distrib] at h,
    have : Hausdorff_edist s t ≤ ennreal.of_real r,
    { apply Hausdorff_edist_le_of_inf_edist _ _,
      { assume x hx,
        have I := H1 x hx,
        rwa [inf_dist, ← ennreal.to_real_of_real hr,
             ennreal.to_real_le_to_real (inf_edist_ne_top h.2.2) ennreal.of_real_ne_top] at I },
      { assume x hx,
        have I := H2 x hx,
        rwa [inf_dist, ← ennreal.to_real_of_real hr,
             ennreal.to_real_le_to_real (inf_edist_ne_top h.2.1) ennreal.of_real_ne_top] at I }},
    rwa [Hausdorff_dist, ← ennreal.to_real_of_real hr,
         ennreal.to_real_le_to_real h.1 ennreal.of_real_ne_top] }
end

/-- Bounding the Hausdorff distance by exhibiting, for any point in each set,
another point in the other set at controlled distance -/
lemma Hausdorff_dist_le_of_mem_dist {r : ℝ} (hr : 0 ≤ r)
  (H1 : ∀x ∈ s, ∃y ∈ t, dist x y ≤ r) (H2 : ∀x ∈ t, ∃y ∈ s, dist x y ≤ r) :
  Hausdorff_dist s t ≤ r :=
begin
  apply Hausdorff_dist_le_of_inf_dist hr,
  { assume x xs,
    rcases H1 x xs with ⟨y, yt, hy⟩,
    exact le_trans (inf_dist_le_dist_of_mem yt) hy },
  { assume x xt,
    rcases H2 x xt with ⟨y, ys, hy⟩,
    exact le_trans (inf_dist_le_dist_of_mem ys) hy }
end

/-- The Hausdorff distance is controlled by the diameter of the union -/
lemma Hausdorff_dist_le_diam (hs : s ≠ ∅) (bs : bounded s) (ht : t ≠ ∅) (bt : bounded t) :
  Hausdorff_dist s t ≤ diam (s ∪ t) :=
begin
  rcases ne_empty_iff_exists_mem.1 hs with ⟨x, xs⟩,
  rcases ne_empty_iff_exists_mem.1 ht with ⟨y, yt⟩,
  refine Hausdorff_dist_le_of_mem_dist diam_nonneg _ _,
  { exact  λz hz, ⟨y, yt, dist_le_diam_of_mem (bounded_union.2 ⟨bs, bt⟩) (subset_union_left _ _ hz) (subset_union_right _ _ yt)⟩ },
  { exact λz hz, ⟨x, xs, dist_le_diam_of_mem (bounded_union.2 ⟨bs, bt⟩) (subset_union_right _ _ hz) (subset_union_left _ _ xs)⟩ }
end

/-- The distance to a set is controlled by the Hausdorff distance -/
lemma inf_dist_le_Hausdorff_dist_of_mem (hx : x ∈ s) (fin : Hausdorff_edist s t ≠ ⊤) :
  inf_dist x t ≤ Hausdorff_dist s t :=
begin
  have ht : t ≠ ∅ := ne_empty_of_Hausdorff_edist_ne_top (ne_empty_of_mem hx) fin,
  rw [Hausdorff_dist, inf_dist, ennreal.to_real_le_to_real (inf_edist_ne_top ht) fin],
  exact inf_edist_le_Hausdorff_edist_of_mem hx
end

/-- If the Hausdorff distance is `<r`, then any point in one of the sets is at distance
`<r` of a point in the other set -/
lemma exists_dist_lt_of_Hausdorff_dist_lt {r : ℝ} (h : x ∈ s) (H : Hausdorff_dist s t < r)
  (fin : Hausdorff_edist s t ≠ ⊤) : ∃y∈t, dist x y < r :=
begin
  have r0 : 0 < r := lt_of_le_of_lt (Hausdorff_dist_nonneg) H,
  have : Hausdorff_edist s t < ennreal.of_real r,
    by rwa [Hausdorff_dist, ← ennreal.to_real_of_real (le_of_lt r0),
            ennreal.to_real_lt_to_real fin (ennreal.of_real_ne_top)] at H,
  rcases exists_edist_lt_of_Hausdorff_edist_lt h this with ⟨y, hy, yr⟩,
  rw [edist_dist, ennreal.of_real_lt_of_real_iff r0] at yr,
  exact ⟨y, hy, yr⟩
end

/-- If the Hausdorff distance is `<r`, then any point in one of the sets is at distance
`<r` of a point in the other set -/
lemma exists_dist_lt_of_Hausdorff_dist_lt' {r : ℝ} (h : y ∈ t) (H : Hausdorff_dist s t < r)
  (fin : Hausdorff_edist s t ≠ ⊤) : ∃x∈s, dist x y < r :=
begin
  rw Hausdorff_dist_comm at H,
  rw Hausdorff_edist_comm at fin,
  simpa [dist_comm] using exists_dist_lt_of_Hausdorff_dist_lt h H fin
end

/-- The infimum distance to `s` and `t` are the same, up to the Hausdorff distance
between `s` and `t` -/
lemma inf_dist_le_inf_dist_add_Hausdorff_dist (fin : Hausdorff_edist s t ≠ ⊤) :
  inf_dist x t ≤ inf_dist x s + Hausdorff_dist s t :=
begin
  by_cases (s = ∅) ∨ (t = ∅),
  { rcases h with h1 |h2,
    { have : t = ∅,
      { by_contradiction ht,
        rw Hausdorff_edist_comm at fin,
        exact ne_empty_of_Hausdorff_edist_ne_top ht fin h1 },
      simp [‹s = ∅›, ‹t = ∅›] },
    { have : s = ∅,
      { by_contradiction hs,
        exact ne_empty_of_Hausdorff_edist_ne_top hs fin h2 },
      simp [‹s = ∅›, ‹t = ∅›] }},
  { rw not_or_distrib at h,
    rw [inf_dist, inf_dist, Hausdorff_dist, ← ennreal.to_real_add (inf_edist_ne_top h.1) fin,
        ennreal.to_real_le_to_real (inf_edist_ne_top h.2)],
    { exact inf_edist_le_inf_edist_add_Hausdorff_edist },
    { simp [ennreal.add_eq_top, not_or_distrib, fin, inf_edist_ne_top h.1] }}
end

/-- The Hausdorff distance is invariant under isometries -/
lemma Hausdorff_dist_image (h : isometry Φ) :
  Hausdorff_dist (Φ '' s) (Φ '' t) = Hausdorff_dist s t :=
by simp [Hausdorff_dist, Hausdorff_edist_image h]

/-- The Hausdorff distance satisfies the triangular inequality -/
lemma Hausdorff_dist_triangle (fin : Hausdorff_edist s t ≠ ⊤) :
  Hausdorff_dist s u ≤ Hausdorff_dist s t + Hausdorff_dist t u :=
begin
  by_cases Hausdorff_edist s u = ⊤,
  { calc Hausdorff_dist s u = 0 + 0 : by simp [Hausdorff_dist, h]
         ... ≤ Hausdorff_dist s t + Hausdorff_dist t u :
           add_le_add (Hausdorff_dist_nonneg) (Hausdorff_dist_nonneg) },
  { have Dtu : Hausdorff_edist t u < ⊤ := calc
      Hausdorff_edist t u ≤ Hausdorff_edist t s + Hausdorff_edist s u : Hausdorff_edist_triangle
      ... = Hausdorff_edist s t + Hausdorff_edist s u : by simp [Hausdorff_edist_comm]
      ... < ⊤ : by simp  [ennreal.add_lt_top]; simp [ennreal.lt_top_iff_ne_top, h, fin],
    rw [Hausdorff_dist, Hausdorff_dist, Hausdorff_dist,
        ← ennreal.to_real_add fin (lt_top_iff_ne_top.1 Dtu), ennreal.to_real_le_to_real h],
    { exact Hausdorff_edist_triangle },
    { simp [ennreal.add_eq_top, lt_top_iff_ne_top.1 Dtu, fin] }}
end

/-- The Hausdorff distance satisfies the triangular inequality -/
lemma Hausdorff_dist_triangle' (fin : Hausdorff_edist t u ≠ ⊤) :
  Hausdorff_dist s u ≤ Hausdorff_dist s t + Hausdorff_dist t u :=
begin
  rw Hausdorff_edist_comm at fin,
  have I : Hausdorff_dist u s ≤ Hausdorff_dist u t + Hausdorff_dist t s := Hausdorff_dist_triangle fin,
  simpa [add_comm, Hausdorff_dist_comm] using I
end

/-- The Hausdorff distance between a set and its closure vanish -/
@[simp] lemma Hausdorff_dist_self_closure : Hausdorff_dist s (closure s) = 0 :=
by simp [Hausdorff_dist]

/-- Replacing a set by its closure does not change the Hausdorff distance. -/
@[simp] lemma Hausdorff_dist_closure₁ : Hausdorff_dist (closure s) t = Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- Replacing a set by its closure does not change the Hausdorff distance. -/
@[simp] lemma Hausdorff_dist_closure₂ : Hausdorff_dist s (closure t) = Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- The Hausdorff distance between two sets and their closures coincide -/
@[simp] lemma Hausdorff_dist_closure : Hausdorff_dist (closure s) (closure t) = Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- Two sets are at zero Hausdorff distance if and only if they have the same closures -/
lemma Hausdorff_dist_zero_iff_closure_eq_closure (fin : Hausdorff_edist s t ≠ ⊤) :
  Hausdorff_dist s t = 0 ↔ closure s = closure t :=
by simp [Hausdorff_edist_zero_iff_closure_eq_closure.symm, Hausdorff_dist,
         ennreal.to_real_eq_zero_iff, fin]

/-- Two closed sets are at zero Hausdorff distance if and only if they coincide -/
lemma Hausdorff_dist_zero_iff_eq_of_closed (hs : is_closed s) (ht : is_closed t)
  (fin : Hausdorff_edist s t ≠ ⊤) : Hausdorff_dist s t = 0 ↔ s = t :=
by simp [(Hausdorff_edist_zero_iff_eq_of_closed hs ht).symm, Hausdorff_dist,
         ennreal.to_real_eq_zero_iff, fin]

end --section
end metric --namespace


--- Пропрозиционная логика

example {P Q: Prop}(pq: P ∨ Q)(np: ¬P): Q :=
  pq.elim (λp => (np p).elim) id

example {P Q R: Prop}(pqr : P ∧ (Q ∨ R)): (P ∧ Q) ∨ (P ∧ R) :=
  let ⟨p,qr⟩ := pqr;  qr.elim (λq => Or.inl ⟨p,q⟩) (λr => Or.inr ⟨p,r⟩)

example {P Q: Prop}(pq: P → Q)(nq: ¬Q): ¬P :=
  λp => nq (pq p : Q)

-- Простые

example {P Q: Prop}(pq: P ∧ Q): Q ∧ P :=
  let ⟨p,q⟩ := pq;  ⟨q,p⟩

example {P Q R: Prop}(pQr: P ∧ (Q ∧ R)): (P ∧ Q) ∧ R :=
  let ⟨p,⟨q,r⟩⟩ := pQr;  ⟨⟨p,q⟩,r⟩

example {P Q: Prop}(p: P): Q → P :=
  λ_ => p

example {P Q R: Prop}(pqr: P → Q → R): P ∧ Q → R :=
  λpq => pqr (pq.left : P) (pq.right : Q)

example {P Q R: Prop}(pqr: P → Q → R)(pq: P → Q): P → R :=
  λp => pqr p (pq p : Q)

example {P Q R: Prop}(pq: P → Q)(qr: Q → R): P → R :=
  λp => qr (pq p)

example {P Q: Prop}(npq: ¬(P ∨ Q)): ¬P ∧ ¬Q :=
  ⟨λp => npq (Or.inl p), λq => npq (Or.inr q)⟩

example {P Q: Prop}(npQ: ¬P ∨ Q): P → Q :=
  λp => npQ.elim (λnp => (np p).elim) (λq => q)

example {P Q R: Prop}(pQr: P → Q ∧ R): (P → Q) ∧ (P → R) :=
  ⟨λp => (pQr p).left, λp => (pQr p).right⟩

example {P Q R: Prop}(pqR: P ∨ Q → R): (P → R) ∧ (Q → R) :=
  ⟨λp => pqR (Or.inl p), λq => pqR (Or.inr q)⟩

-- Сложнее

example {P Q R: Prop}(pqR: (P ∨ Q) ∨ R): P ∨ (Q ∨ R) :=
  pqR.elim
    (λpq => pq.elim (λp => Or.inl p) (λq => Or.inr (Or.inl q : Q ∨ R)))
    (λr => Or.inr (Or.inr r : Q ∨ R))

example {P Q R: Prop}(pqPr : (P ∧ Q) ∨ (P ∧ R)): P ∧ (Q ∨ R) :=
  ⟨ pqPr.elim And.left And.left,
    pqPr.elim (λpq => Or.inl pq.right) (λpr => Or.inr pr.right) ⟩

example {P Q R: Prop}(pQr: P ∨ (Q ∧ R)): (P ∨ Q) ∧ (P ∨ R) :=
  ⟨ pQr.elim (λp => Or.inl p) (λqr => Or.inr qr.left),
    pQr.elim (λp => Or.inl p) (λqr => Or.inr qr.right) ⟩

--- Предикаты и кванторы

example {P Q: α → Prop}(apq: ∀x, P x ∧ Q x): (∀x, P x) ∧ (∀x, Q x) :=
  ⟨λx => (apq x).left,  λx => (apq x).right⟩

example {P: α → β → Prop}(eap: ∃x, ∀y, P x y): ∀y, ∃x, P x y :=
  let ⟨x,ap⟩ := eap;  λy => ⟨x, (ap y : P x y)⟩

-- Простые

example {P: α → β → Prop}(ap: ∀x, ∀y, P x y): ∀y, ∀x, P x y :=
  λy x => ap x y

example {P: α → β → Prop}(ep: ∃x, ∃y, P x y): ∃y, ∃x, P x y :=
  let ⟨x,⟨y,p⟩⟩ := ep;  ⟨y,⟨x,p⟩⟩

example {P: α → Prop}(ne: ¬∃x, P x): ∀x, ¬(P x) :=
  λx p => ne ⟨x,p⟩

example {P: α → Prop}{Q: Prop}(epQ: (∃x, P x) → Q): ∀x, P x → Q :=
  λx p => epQ ⟨x,p⟩

example {P: α → Prop}{Q: Prop}(apq: ∀x, P x → Q): (∃x, P x) → Q :=
  λ⟨x,p⟩ => apq x p

-- Сложнее

example {P Q: α → Prop}(aa: (∀x, P x) ∨ (∀x, Q x)): ∀x, P x ∨ Q x :=
  λx => aa.elim (λap => Or.inl (ap x : P x)) (λaq => Or.inr (aq x : Q x))

example {P Q: α → Prop}(ee: (∃x, P x) ∨ (∃x, Q x)): ∃x, P x ∨ Q x :=
  ee.elim (λ⟨x,p⟩ => ⟨x, Or.inl p⟩) (λ⟨x,q⟩ => ⟨x, Or.inr q⟩)

-- Классическая логика

example {P: Prop}(nem: ¬(P ∨ ¬P)): False :=
  nem (Or.inr λp => nem (Or.inl p))

section classical
open Classical

example {P: Prop}(nnp: ¬¬P): P :=
  (em P).elim id (λnp => (nnp np).elim)

example {P: Prop}(nnp: ¬¬P): P := by
  refine (em P).elim ?_ ?_
  · intro (p: P)
    exact p
  · intro (np: ¬P)
    exact False.elim $ nnp np

example {P Q: Prop}(pq: P → Q): ¬P ∨ Q :=
  (em P).elim (λp => Or.inr $ pq p) Or.inl

example {P Q: Prop}(npq : ¬(P ∧ Q)): ¬P ∨ ¬Q :=
  (em P).elim (λp => Or.inr $ λq => npq ⟨p,q⟩) Or.inl

example {P Q: Prop}(np_q: ¬P → Q): ¬Q → P :=
  λnq => (em P).elim id (λnp => (nq $ np_q np).elim)

example {P Q: Prop}(pq_p: (P → Q) → P): P :=
  (em P).elim id (λnp => pq_p (λp => (np p).elim))

-- Одновременно em и byContradiction
example {α: Type}{P: α → Prop}(na: ¬∀x, P x): ∃x, ¬P x := by
  refine (em (∃x, ¬P x)).elim id (λne: (¬∃x, ¬P x) => ?_)
  let ap: ∀x, P x :=  λx => byContradiction (λnp => ne ⟨x, np⟩)
  exact (na ap).elim

end classical


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Kevin Buzzard

From: https://github.com/leanprover-community/mathlib/blob/f5138d15f20011136f2d89cfdce6c23980463a22/counterexamples/direct_sum_is_internal.lean
-/

import algebra.direct_sum.module
import tactic.fin_cases

/-!
# Not all complementary decompositions of a module over a semiring make up a direct sum

This shows that while `ℤ≤0` and `ℤ≥0` are complementary `ℕ`-submodules of `ℤ`, which in turn
implies as a collection they are `complete_lattice.independent` and that they span all of `ℤ`, they
do not form a decomposition into a direct sum.

This file demonstrates why `direct_sum.is_internal_submodule_of_independent_of_supr_eq_top` must
take `ring R` and not `semiring R`.
-/

lemma units_int.one_ne_neg_one : (1 : ℤˣ) ≠ -1 := dec_trivial

/-- Submodules of positive and negative integers, keyed by sign. -/
def with_sign (i : ℤˣ) : submodule ℕ ℤ :=
add_submonoid.to_nat_submodule $ show add_submonoid ℤ, from
  { carrier := {z | 0 ≤ i • z},
    zero_mem' := show 0 ≤ i • (0 : ℤ), from (smul_zero _).ge,
    add_mem' := λ x y (hx : 0 ≤ i • x) (hy : 0 ≤ i • y), show _ ≤ _, begin
      rw smul_add,
      exact add_nonneg hx hy
    end }

local notation `ℤ≥0` := with_sign 1
local notation `ℤ≤0` := with_sign (-1)

lemma mem_with_sign_one {x : ℤ} : x ∈ ℤ≥0 ↔ 0 ≤ x :=
show _ ≤ _ ↔ _, by rw one_smul

lemma mem_with_sign_neg_one {x : ℤ} : x ∈ ℤ≤0 ↔ x ≤ 0 :=
show _ ≤ _ ↔ _, by rw [units.neg_smul, le_neg, one_smul, neg_zero]

/-- The two submodules are complements. -/
lemma with_sign.is_compl : is_compl (ℤ≥0) (ℤ≤0) :=
begin
  split,
  { apply submodule.disjoint_def.2,
    intros x hx hx',
    exact le_antisymm (mem_with_sign_neg_one.mp hx') (mem_with_sign_one.mp hx), },
  { intros x hx,
    obtain hp | hn := (le_refl (0 : ℤ)).le_or_le x,
    exact submodule.mem_sup_left (mem_with_sign_one.mpr hp),
    exact submodule.mem_sup_right (mem_with_sign_neg_one.mpr hn), }
end

lemma with_sign.independent : complete_lattice.independent with_sign :=
begin
  refine (complete_lattice.independent_pair units_int.one_ne_neg_one _).mpr
    with_sign.is_compl.disjoint,
  intros i,
  fin_cases i; simp,
end

lemma with_sign.supr : supr with_sign = ⊤ :=
begin
  rw [←finset.sup_univ_eq_supr, units_int.univ, finset.sup_insert, finset.sup_singleton],
  exact with_sign.is_compl.sup_eq_top,
end

/-- But there is no embedding into `ℤ` from the direct sum. -/
lemma with_sign.not_injective :
  ¬function.injective (direct_sum.to_module ℕ ℤˣ ℤ (λ i, (with_sign i).subtype)) :=
begin
  intro hinj,
  let p1 : ℤ≥0 := ⟨1, mem_with_sign_one.2 zero_le_one⟩,
  let n1 : ℤ≤0 := ⟨-1, mem_with_sign_neg_one.2 $ neg_nonpos.2 zero_le_one⟩,
  let z := direct_sum.lof ℕ _ (λ i, with_sign i) 1 p1 +
           direct_sum.lof ℕ _ (λ i, with_sign i) (-1) n1,
  have : z ≠ 0,
  { intro h,
    dsimp [z, direct_sum.lof_eq_of, direct_sum.of] at h,
    replace h := dfinsupp.ext_iff.mp h 1,
    rw [dfinsupp.zero_apply, dfinsupp.add_apply, dfinsupp.single_eq_same,
      dfinsupp.single_eq_of_ne (units_int.one_ne_neg_one.symm), add_zero, subtype.ext_iff,
      submodule.coe_zero] at h,
    apply zero_ne_one h.symm, },
  apply hinj.ne this,
  rw [linear_map.map_zero, linear_map.map_add, direct_sum.to_module_lof, direct_sum.to_module_lof],
  simp,
end

/-- And so they do not represent an internal direct sum. -/
lemma with_sign.not_internal : ¬direct_sum.is_internal with_sign :=
with_sign.not_injective ∘ and.elim_left

/-- And therefore the characterization via `supr` and `complete_lattice.independent` is not
strong enough to define `is_internal` -/
lemma direct_sum.is_internal_contradiction :
  ¬∀ {R A ι : Type} [decidable_eq ι] [semiring R] [add_comm_monoid A],
    by exactI ∀ [module R A], by exactI ∀ (S : ι → submodule R A),
      supr S = ⊤ ∧ complete_lattice.independent S → direct_sum.is_internal S :=
λ h, with_sign.not_internal (h with_sign ⟨with_sign.supr, with_sign.independent⟩)


import .love06_monads_demo

/- # LoVe Exercise 6: Monads -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: A State Monad with Failure

We introduce a richer notion of lawful monad that provides an `orelse`
operator `<|>` satisfying some laws, given below. `emp` denotes failure.
`x <|> y` tries `x` first, falling back on `y` on failure. -/

@[class] structure lawful_monad_with_orelse (m : Type → Type)
  extends lawful_monad m, has_orelse m : Type 1 :=
(emp {} {α : Type} : m α)
(emp_orelse {α : Type} (a : m α) :
  (emp <|> a) = a)
(orelse_emp {α : Type} (a : m α) :
  (a <|> emp) = a)
(orelse_assoc {α : Type} (a b c : m α) :
  ((a <|> b) <|> c) = (a <|> (b <|> c)))
(emp_bind {α β : Type} (f : α → m β) :
  (emp >>= f) = emp)
(bind_emp {α β : Type} (f : m α) :
  (f >>= (λa, emp : α → m β)) = emp)

/- 1.1. We set up the `option` type constructor to be a
`lawful_monad_with_orelse`. Complete the proofs. -/

def option.orelse {α : Type} : option α → option α → option α
| option.none     ma' := ma'
| (option.some a) _   := option.some a

@[instance] def lawful_monad_with_orelse_option :
  lawful_monad_with_orelse option :=
{ emp          := λα, option.none,
  orelse       := @option.orelse,
  emp_orelse   :=
    sorry,
  orelse_emp   :=
    begin
      intros α a,
      cases' a,
      { refl },
      { refl }
    end,
  orelse_assoc :=
    sorry,
  emp_bind     :=
    begin
      intros α β f,
      refl
    end,
  bind_emp     :=
    sorry,
  .. option.lawful_monad }

@[simp] lemma option.some_bind {α β : Type} (a : α) (g : α → option β) :
  (option.some a >>= g) = g a :=
sorry

/- Let us enable some convenient pattern matching syntax, by instantiating
Lean's `monad_fail` type class. (Do not worry if you do not understand what
we are referring to.) -/

@[instance] def lawful_monad_with_orelse.monad_fail {m : Type → Type}
  [lawful_monad_with_orelse m] : monad_fail m :=
{ fail := λα msg, lawful_monad_with_orelse.emp }

/- Now we can write definitions such as the following: -/

def first_of_three {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  [n, _, _] ← c,
  pure n

#eval first_of_three (option.some [1])
#eval first_of_three (option.some [1, 2, 3])
#eval first_of_three (option.some [1, 2, 3, 4])

/- Using `lawful_monad_with_orelse` and the `monad_fail` syntax, we can give a
concise definition for the `sum_2_5_7` function seen in the lecture. -/

def sum_2_5_7₇ {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  (_ :: n2 :: _ :: _ :: n5 :: _ :: n7 :: _) ← c,
  pure (n2 + n5 + n7)

/- 1.2. Now we are ready to define `faction σ` ("eff action"): a monad with an
internal state of type `σ` that can fail (unlike `action σ`).

We start with defining `faction σ α`, where `σ` is the type of the internal
state, and `α` is the type of the value stored in the monad. We use `option` to
model failure. This means we can also use the monadic behavior of `option` when
defining the monadic operations on `faction`.

Hints:

* Remember that `faction σ α` is an alias for a function type, so you can use
  pattern matching and `λs, …` to define values of type `faction σ α`.

* `faction` is very similar to `action` from the lecture's demo. You can look
  there for inspiration. -/

def faction (σ : Type) (α : Type) :=
σ → option (α × σ)

/- 1.3. Define the `get` and `set` function for `faction`, where `get` returns
the state passed along the state monad and `set s` changes the state to `s`. -/

def get {σ : Type} : faction σ σ :=
sorry

def set {σ : Type} (s : σ) : faction σ unit :=
sorry

/- We set up the `>>=` syntax on `faction`: -/

def faction.bind {σ α β : Type} (f : faction σ α) (g : α → faction σ β) :
  faction σ β
| s := f s >>= (λas, g (prod.fst as) (prod.snd as))

@[instance] def faction.has_bind {σ : Type} : has_bind (faction σ) :=
{ bind := @faction.bind σ }

lemma faction.bind_apply {σ α β : Type} (f : faction σ α) (g : α → faction σ β)
    (s : σ) :
  (f >>= g) s = (f s >>= (λas, g (prod.fst as) (prod.snd as))) :=
by refl

/- 1.4. Define the monadic operator `pure` for `faction`, in such a way that it
will satisfy the monad laws. -/

def faction.pure {σ α : Type} (a : α) : faction σ α :=
sorry

/- We set up the syntax for `pure` on `faction`: -/

@[instance] def faction.has_pure {σ : Type} : has_pure (faction σ) :=
{ pure := @faction.pure σ }

lemma faction.pure_apply {σ α : Type} (a : α) (s : σ) :
  (pure a : faction σ α) s = option.some (a, s) :=
by refl

/- 1.3. Register `faction` as a monad.

Hints:

* The `funext` lemma is useful when you need to prove equality between two
  functions.

* `cases' f s` only works when `f s` appears in your goal, so you may need to
  unfold some constants before you can invoke `cases'`. -/

@[instance] def faction.lawful_monad {σ : Type} : lawful_monad (faction σ) :=
{ pure_bind  :=
    begin
      intros α β a f,
      apply funext,
      intro s,
      refl
    end,
  bind_pure  :=
    sorry,
  bind_assoc :=
    sorry,
  .. faction.has_bind,
  .. faction.has_pure }

/- ## Question 2: Kleisli Operator

The Kleisli operator `>=>` (not to be confused with `>>=`) is useful for
pipelining monadic operations. Note that `λa, f a >>= g` is to be parsed as
`λa, (f a >>= g)`, not as `(λa, f a) >>= g`. -/

def kleisli {m : Type → Type} [lawful_monad m] {α β γ : Type} (f : α → m β)
  (g : β → m γ) : α → m γ :=
λa, f a >>= g

infixr ` >=> ` : 90 := kleisli

/- 2.1. Prove that `pure` is a left and right unit for the Kleisli operator. -/

lemma pure_kleisli {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (pure >=> f) = f :=
sorry

lemma kleisli_pure {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (f >=> pure) = f :=
sorry

/- 2.2. Prove associativity of the Kleisli operator. -/

lemma kleisli_assoc {m : Type → Type} [lawful_monad m] {α β γ δ : Type}
    (f : α → m β) (g : β → m γ) (h : γ → m δ) :
  ((f >=> g) >=> h) = (f >=> (g >=> h)) :=
sorry

end LoVe


variables A B C D : Prop

example : A ∧ (A → B) → B :=
assume h: A ∧ (A -> B),
show B, from (and.right h) (and.left h)

example : A → ¬(¬A ∧ B) :=
assume h1: A,
assume h2: ¬A ∧B,
show false, from (and.left h2) h1

example : ¬(A ∧ B) → (A → ¬B) :=
assume h: ¬ (A ∧ B),
assume h₁ : A,
assume h₂ : B,
show false, from h (and.intro h₁ h₂)

example (h₁ : A ∨ B) (h₂ : A → C) (h₃ : B → D) : C ∨ D := /- lots of haves/shows -/

show C ∨ D, from or.elim h₁

(assume optionOne: A, show C ∨ D, from or.inl(h₂ optionOne) )
(assume optionTwo: B, show C ∨ D, from or.inr (h₃ optionTwo) )

example (h : ¬A ∧ ¬B) : ¬(A ∨ B) := /-demorgan's Law-/
assume h2 : A∨B,

 show false, from or.elim h2
(assume optionOne: A, show false, from (and.left h) optionOne)
(assume optionTwo: B, show false, from (and.right h) optionTwo)

example : ¬(A ↔ ¬A) :=
assume h: A ↔ ¬A,
show false, from (assume h1: A,((iff.mp h h1)h1))(iff.mpr h (assume h1: A, ((iff.mp h h1)h1)))