/-
An example of why eq and heq for structures is not completely unreasonable.
-/

/-
We want equality of foo's to mean:
* equivalent predicates P, and
* functions f which agree on the subset defined by P.
-/
structure foo : Type :=
  (P : nat → Prop)
  (f : subtype P → bool)

lemma foo.congr_P (A B : foo) :
  (A = B) → forall (n : nat),
  A.P n ↔ B.P n :=
fun (h : A = B) n, eq.to_iff (congr_fun (congr_arg foo.P h) n)

lemma foo.congr_f (A B : foo) :
  (A = B) → forall (n : nat) (hA : A.P n) (hB : B.P n),
  A.f ⟨n, hA⟩ = B.f ⟨n, hB⟩ :=
fun (h : A = B) n hA hB,
  @eq.rec foo A
  (fun C, forall hC : C.P n, A.f ⟨n, hA⟩ = C.f ⟨n, hC⟩)
  (fun _, eq.refl (A.f ⟨n, hA⟩))
  B h hB

lemma foo.ext : forall (A B : foo),
  (forall (n : nat), A.P n ↔ B.P n) →
  (forall (n : nat) (hA : A.P n) (hB : B.P n), A.f ⟨n, hA⟩ = B.f ⟨n, hB⟩) →
  (A = B) :=
@foo.rec
(fun A, forall (B : foo),
  (forall (n : nat), A.P n ↔ B.P n) →
  (forall (n : nat) (hA : A.P n) (hB : B.P n), A.f ⟨n, hA⟩ = B.f ⟨n, hB⟩) →
  (A = B))
(fun A_P A_f, @foo.rec
  (fun B,
    (forall (n : nat), A_P n ↔ B.P n) →
    (forall (n : nat) (hA : A_P n) (hB : B.P n), A_f ⟨n, hA⟩ = B.f ⟨n, hB⟩) →
    (foo.mk A_P A_f = B))
  (fun B_P B_f,
    fun (hP_iff : forall (n : nat), A_P n ↔ B_P n),
    let hP_eq : A_P = B_P := funext (fun n, propext (hP_iff n)) in
    @eq.rec (nat → Prop) A_P
    (fun C_P, forall (C_f : subtype C_P → bool),
      (forall (n : nat) (hA : A_P n) (hC : C_P n), A_f ⟨n, hA⟩ = C_f ⟨n, hC⟩) →
      (foo.mk A_P A_f = foo.mk C_P C_f))
    (fun C_f,
      fun (hf_ext : forall (n : nat) (hA hC : A_P n), A_f ⟨n, hA⟩ = C_f ⟨n, hC⟩),
      let hf_eq : A_f = C_f := funext (@subtype.rec nat A_P (fun nhA, A_f nhA = C_f nhA) (fun n hA, hf_ext n hA hA)) in
      @eq.rec (subtype A_P → bool) A_f
      (fun f, foo.mk A_P A_f = foo.mk A_P f)
      (eq.refl (foo.mk A_P A_f))
      C_f hf_eq)
    B_P hP_eq B_f))


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yaël Dillies, Patrick Stevens

! This file was ported from Lean 3 source module data.nat.cast.field
! leanprover-community/mathlib commit acee671f47b8e7972a1eb6f4eed74b4b3abce829
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Field.Basic
import Mathlib.Algebra.Order.Ring.CharZero
import Mathlib.Data.Nat.Cast.Basic

/-!
# Cast of naturals into fields

This file concerns the canonical homomorphism `ℕ → F`, where `F` is a field.

## Main results

 * `Nat.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
 * `Nat.cast_div_le`: in all cases, `↑(m / n) ≤ ↑m / ↑ n`
-/

namespace Nat

variable {α : Type _}

@[simp]
theorem cast_div [DivisionSemiring α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
    ((m / n : ℕ) : α) = m / n := by
  rcases n_dvd with ⟨k, rfl⟩
  have : n ≠ 0 := by
    rintro rfl
    simp at n_nonzero
  rw [Nat.mul_div_cancel_left _ this.bot_lt, mul_comm n k,cast_mul, mul_div_cancel _ n_nonzero]
#align nat.cast_div Nat.cast_div

theorem cast_div_div_div_cancel_right [DivisionSemiring α] [CharZero α] {m n d : ℕ}
  (hn : d ∣ n) (hm : d ∣ m) :
    (↑(m / d) : α) / (↑(n / d) : α) = (m : α) / n := by
  rcases eq_or_ne d 0 with (rfl | hd); · simp [zero_dvd_iff.mp hm]
  replace hd : (d : α) ≠ 0;
  · norm_cast
  rw [cast_div hm, cast_div hn, div_div_div_cancel_right _ hd] <;> exact hd

#align nat.cast_div_div_div_cancel_right Nat.cast_div_div_div_cancel_right

section LinearOrderedSemifield

variable [LinearOrderedSemifield α]

/-- Natural division is always less than division in the field. -/
theorem cast_div_le {m n : ℕ} : ((m / n : ℕ) : α) ≤ m / n := by
  cases n
  · rw [cast_zero, div_zero, Nat.div_zero, cast_zero]
  rw [le_div_iff, ← Nat.cast_mul, @Nat.cast_le]
  exact (Nat.div_mul_le_self m _)
  · exact Nat.cast_pos.2 (Nat.succ_pos _)
#align nat.cast_div_le Nat.cast_div_le

theorem inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ :=
  inv_pos.2 <| add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one
#align nat.inv_pos_of_nat Nat.inv_pos_of_nat

theorem one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) := by
  refine' one_div_le_one_div_of_le _ _
  exact Nat.cast_add_one_pos _
  simpa
#align nat.one_div_le_one_div Nat.one_div_le_one_div

theorem one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) := by
  refine' one_div_lt_one_div_of_lt _ _
  exact Nat.cast_add_one_pos _
  simpa
#align nat.one_div_lt_one_div Nat.one_div_lt_one_div

end LinearOrderedSemifield

end Nat


/-
Copyright (c) 2017 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Mario Carneiro
-/
import data.real.sqrt

/-!
# The complex numbers

The complex numbers are modelled as ℝ^2 in the obvious way and it is shown that they form a field
of characteristic zero. The result that the complex numbers are algebraically closed, see
`field_theory.algebraic_closure`.
-/

open_locale big_operators
open set function

/-! ### Definition and basic arithmmetic -/

/-- Complex numbers consist of two `real`s: a real part `re` and an imaginary part `im`. -/
structure complex : Type :=
(re : ℝ) (im : ℝ)

notation `ℂ` := complex

namespace complex

open_locale complex_conjugate

noncomputable instance : decidable_eq ℂ := classical.dec_eq _

/-- The equivalence between the complex numbers and `ℝ × ℝ`. -/
@[simps] def equiv_real_prod : ℂ ≃ (ℝ × ℝ) :=
{ to_fun := λ z, ⟨z.re, z.im⟩,
  inv_fun := λ p, ⟨p.1, p.2⟩,
  left_inv := λ ⟨x, y⟩, rfl,
  right_inv := λ ⟨x, y⟩, rfl }

@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨a, b⟩ := rfl

@[ext]
theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

theorem re_surjective : surjective re := λ x, ⟨⟨x, 0⟩, rfl⟩
theorem im_surjective : surjective im := λ y, ⟨⟨0, y⟩, rfl⟩

@[simp] theorem range_re : range re = univ := re_surjective.range_eq
@[simp] theorem range_im : range im = univ := im_surjective.range_eq

instance : has_coe ℝ ℂ := ⟨λ r, ⟨r, 0⟩⟩

@[simp, norm_cast] lemma of_real_re (r : ℝ) : (r : ℂ).re = r := rfl
@[simp, norm_cast] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl
lemma of_real_def (r : ℝ) : (r : ℂ) = ⟨r, 0⟩ := rfl

@[simp, norm_cast] theorem of_real_inj {z w : ℝ} : (z : ℂ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

theorem of_real_injective : function.injective (coe : ℝ → ℂ) :=
λ z w, congr_arg re

instance : can_lift ℂ ℝ :=
{ cond := λ z, z.im = 0,
  coe := coe,
  prf := λ z hz, ⟨z.re, ext rfl hz.symm⟩ }

/-- The product of a set on the real axis and a set on the imaginary axis of the complex plane,
denoted by `s ×ℂ t`. -/
def _root_.set.re_prod_im (s t : set ℝ) : set ℂ := re ⁻¹' s ∩ im ⁻¹' t

infix ` ×ℂ `:72 := set.re_prod_im

lemma mem_re_prod_im {z : ℂ} {s t : set ℝ} : z ∈ s ×ℂ t ↔ z.re ∈ s ∧ z.im ∈ t := iff.rfl

instance : has_zero ℂ := ⟨(0 : ℝ)⟩
instance : inhabited ℂ := ⟨0⟩

@[simp] lemma zero_re : (0 : ℂ).re = 0 := rfl
@[simp] lemma zero_im : (0 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℂ) = 0 ↔ z = 0 := of_real_inj
theorem of_real_ne_zero {z : ℝ} : (z : ℂ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

instance : has_one ℂ := ⟨(1 : ℝ)⟩

@[simp] lemma one_re : (1 : ℂ).re = 1 := rfl
@[simp] lemma one_im : (1 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

@[simp] theorem of_real_eq_one {z : ℝ} : (z : ℂ) = 1 ↔ z = 1 := of_real_inj
theorem of_real_ne_one {z : ℝ} : (z : ℂ) ≠ 1 ↔ z ≠ 1 := not_congr of_real_eq_one

instance : has_add ℂ := ⟨λ z w, ⟨z.re + w.re, z.im + w.im⟩⟩

@[simp] lemma add_re (z w : ℂ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℂ) : (z + w).im = z.im + w.im := rfl

@[simp] lemma bit0_re (z : ℂ) : (bit0 z).re = bit0 z.re := rfl
@[simp] lemma bit1_re (z : ℂ) : (bit1 z).re = bit1 z.re := rfl
@[simp] lemma bit0_im (z : ℂ) : (bit0 z).im = bit0 z.im := eq.refl _
@[simp] lemma bit1_im (z : ℂ) : (bit1 z).im = bit0 z.im := add_zero _

@[simp, norm_cast] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s :=
ext_iff.2 $ by simp

@[simp, norm_cast] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r :=
ext_iff.2 $ by simp [bit0]

@[simp, norm_cast] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r :=
ext_iff.2 $ by simp [bit1]

instance : has_neg ℂ := ⟨λ z, ⟨-z.re, -z.im⟩⟩

@[simp] lemma neg_re (z : ℂ) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℂ) : (-z).im = -z.im := rfl
@[simp, norm_cast] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r := ext_iff.2 $ by simp

instance : has_sub ℂ := ⟨λ z w, ⟨z.re - w.re, z.im - w.im⟩⟩

instance : has_mul ℂ := ⟨λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩⟩

@[simp] lemma mul_re (z w : ℂ) : (z * w).re = z.re * w.re - z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℂ) : (z * w).im = z.re * w.im + z.im * w.re := rfl
@[simp, norm_cast] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s := ext_iff.2 $ by simp

lemma of_real_mul_re (r : ℝ) (z : ℂ) : (↑r * z).re = r * z.re := by simp
lemma of_real_mul_im (r : ℝ) (z : ℂ) : (↑r * z).im = r * z.im := by simp
lemma of_real_mul' (r : ℝ) (z : ℂ) : (↑r * z) = ⟨r * z.re, r * z.im⟩ :=
ext (of_real_mul_re _ _) (of_real_mul_im _ _)

/-! ### The imaginary unit, `I` -/

/-- The imaginary unit. -/
def I : ℂ := ⟨0, 1⟩

@[simp] lemma I_re : I.re = 0 := rfl
@[simp] lemma I_im : I.im = 1 := rfl

@[simp] lemma I_mul_I : I * I = -1 := ext_iff.2 $ by simp
lemma I_mul (z : ℂ) : I * z = ⟨-z.im, z.re⟩ :=
ext_iff.2 $ by simp

lemma I_ne_zero : (I : ℂ) ≠ 0 := mt (congr_arg im) zero_ne_one.symm

lemma mk_eq_add_mul_I (a b : ℝ) : complex.mk a b = a + b * I :=
ext_iff.2 $ by simp

@[simp] lemma re_add_im (z : ℂ) : (z.re : ℂ) + z.im * I = z :=
ext_iff.2 $ by simp

lemma mul_I_re (z : ℂ) : (z * I).re = -z.im := by simp
lemma mul_I_im (z : ℂ) : (z * I).im = z.re := by simp
lemma I_mul_re (z : ℂ) : (I * z).re = -z.im := by simp
lemma I_mul_im (z : ℂ) : (I * z).im = z.re := by simp

/-! ### Commutative ring instance and lemmas -/

/- We use a nonstandard formula for the `ℕ` and `ℤ` actions to make sure there is no
diamond from the other actions they inherit through the `ℝ`-action on `ℂ` and action transitivity
defined in `data.complex.module.lean`. -/

instance : add_comm_group ℂ :=
by refine_struct
  { zero := (0 : ℂ),
    add := (+),
    neg := has_neg.neg,
    sub := has_sub.sub,
    nsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩,
    zsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩ };
intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf}

instance : add_group_with_one ℂ :=
{ nat_cast := λ n, ⟨n, 0⟩,
  nat_cast_zero := by ext; simp [nat.cast],
  nat_cast_succ := λ _, by ext; simp [nat.cast],
  int_cast := λ n, ⟨n, 0⟩,
  int_cast_of_nat := λ _, by ext; simp [λ n, show @coe ℕ ℂ ⟨_⟩ n = ⟨n, 0⟩, from rfl],
  int_cast_neg_succ_of_nat := λ _, by ext; simp [λ n, show @coe ℕ ℂ ⟨_⟩ n = ⟨n, 0⟩, from rfl],
  one := 1,
  .. complex.add_comm_group }

instance : comm_ring ℂ :=
by refine_struct
  { zero := (0 : ℂ),
    add := (+),
    one := 1,
    mul := (*),
    npow := @npow_rec _ ⟨(1 : ℂ)⟩ ⟨(*)⟩,
    .. complex.add_group_with_one };
intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf}

/-- This shortcut instance ensures we do not find `ring` via the noncomputable `complex.field`
instance. -/
instance : ring ℂ := by apply_instance

/-- This shortcut instance ensures we do not find `comm_semiring` via the noncomputable
`complex.field` instance. -/
instance : comm_semiring ℂ := infer_instance

/-- The "real part" map, considered as an additive group homomorphism. -/
def re_add_group_hom : ℂ →+ ℝ :=
{ to_fun := re,
  map_zero' := zero_re,
  map_add' := add_re }

@[simp] lemma coe_re_add_group_hom : (re_add_group_hom : ℂ → ℝ) = re := rfl

/-- The "imaginary part" map, considered as an additive group homomorphism. -/
def im_add_group_hom : ℂ →+ ℝ :=
{ to_fun := im,
  map_zero' := zero_im,
  map_add' := add_im }

@[simp] lemma coe_im_add_group_hom : (im_add_group_hom : ℂ → ℝ) = im := rfl

@[simp] lemma I_pow_bit0 (n : ℕ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [pow_bit0', I_mul_I]

@[simp] lemma I_pow_bit1 (n : ℕ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [pow_bit1', I_mul_I]

/-! ### Complex conjugation -/

/-- This defines the complex conjugate as the `star` operation of the `star_ring ℂ`. It
is recommended to use the ring endomorphism version `star_ring_end`, available under the
notation `conj` in the locale `complex_conjugate`. -/
instance : star_ring ℂ :=
{ star := λ z, ⟨z.re, -z.im⟩,
  star_involutive := λ x, by simp only [eta, neg_neg],
  star_mul := λ a b, by ext; simp [add_comm]; ring,
  star_add := λ a b, by ext; simp [add_comm] }

@[simp] lemma conj_re (z : ℂ) : (conj z).re = z.re := rfl
@[simp] lemma conj_im (z : ℂ) : (conj z).im = -z.im := rfl

lemma conj_of_real (r : ℝ) : conj (r : ℂ) = r := ext_iff.2 $ by simp [conj]

@[simp] lemma conj_I : conj I = -I := ext_iff.2 $ by simp

lemma conj_bit0 (z : ℂ) : conj (bit0 z) = bit0 (conj z) := ext_iff.2 $ by simp [bit0]
lemma conj_bit1 (z : ℂ) : conj (bit1 z) = bit1 (conj z) := ext_iff.2 $ by simp [bit0]

@[simp] lemma conj_neg_I : conj (-I) = I := ext_iff.2 $ by simp

lemma eq_conj_iff_real {z : ℂ} : conj z = z ↔ ∃ r : ℝ, z = r :=
⟨λ h, ⟨z.re, ext rfl $ eq_zero_of_neg_eq (congr_arg im h)⟩,
 λ ⟨h, e⟩, by rw [e, conj_of_real]⟩

lemma eq_conj_iff_re {z : ℂ} : conj z = z ↔ (z.re : ℂ) = z :=
eq_conj_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩

lemma eq_conj_iff_im {z : ℂ} : conj z = z ↔ z.im = 0 :=
⟨λ h, add_self_eq_zero.mp (neg_eq_iff_add_eq_zero.mp (congr_arg im h)),
  λ h, ext rfl (neg_eq_iff_add_eq_zero.mpr (add_self_eq_zero.mpr h))⟩

-- `simp_nf` complains about this being provable by `is_R_or_C.star_def` even
-- though it's not imported by this file.
@[simp, nolint simp_nf] lemma star_def : (has_star.star : ℂ → ℂ) = conj := rfl

/-! ### Norm squared -/

/-- The norm squared function. -/
@[pp_nodot] def norm_sq : ℂ →*₀ ℝ :=
{ to_fun := λ z, z.re * z.re + z.im * z.im,
  map_zero' := by simp,
  map_one' := by simp,
  map_mul' := λ z w, by { dsimp, ring } }

lemma norm_sq_apply (z : ℂ) : norm_sq z = z.re * z.re + z.im * z.im := rfl

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
by simp [norm_sq]

@[simp] lemma norm_sq_mk (x y : ℝ) : norm_sq ⟨x, y⟩ = x * x + y * y := rfl

lemma norm_sq_add_mul_I (x y : ℝ) : norm_sq (x + y * I) = x ^ 2 + y ^ 2 :=
by rw [← mk_eq_add_mul_I, norm_sq_mk, sq, sq]

lemma norm_sq_eq_conj_mul_self {z : ℂ} : (norm_sq z : ℂ) = conj z * z :=
by { ext; simp [norm_sq, mul_comm], }

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := norm_sq.map_zero
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := norm_sq.map_one
@[simp] lemma norm_sq_I : norm_sq I = 1 := by simp [norm_sq]

lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z :=
add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)

@[simp] lemma range_norm_sq : range norm_sq = Ici 0 :=
subset.antisymm (range_subset_iff.2 norm_sq_nonneg) $ λ x hx,
  ⟨real.sqrt x, by rw [norm_sq_of_real, real.mul_self_sqrt hx]⟩

lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 :=
⟨λ h, ext
  (eq_zero_of_mul_self_add_mul_self_eq_zero h)
  (eq_zero_of_mul_self_add_mul_self_eq_zero $ (add_comm _ _).trans h),
 λ h, h.symm ▸ norm_sq_zero⟩

@[simp] lemma norm_sq_pos {z : ℂ} : 0 < norm_sq z ↔ z ≠ 0 :=
(norm_sq_nonneg z).lt_iff_ne.trans $ not_congr (eq_comm.trans norm_sq_eq_zero)

@[simp] lemma norm_sq_neg (z : ℂ) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_conj (z : ℂ) : norm_sq (conj z) = norm_sq z :=
by simp [norm_sq]

lemma norm_sq_mul (z w : ℂ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
norm_sq.map_mul z w

lemma norm_sq_add (z w : ℂ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
by dsimp [norm_sq]; ring

lemma re_sq_le_norm_sq (z : ℂ) : z.re * z.re ≤ norm_sq z :=
le_add_of_nonneg_right (mul_self_nonneg _)

lemma im_sq_le_norm_sq (z : ℂ) : z.im * z.im ≤ norm_sq z :=
le_add_of_nonneg_left (mul_self_nonneg _)

theorem mul_conj (z : ℂ) : z * conj z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm, sub_eq_neg_add, add_comm]

theorem add_conj (z : ℂ) : z + conj z = (2 * z.re : ℝ) :=
ext_iff.2 $ by simp [two_mul]

/-- The coercion `ℝ → ℂ` as a `ring_hom`. -/
def of_real : ℝ →+* ℂ := ⟨coe, of_real_one, of_real_mul, of_real_zero, of_real_add⟩

@[simp] lemma of_real_eq_coe (r : ℝ) : of_real r = r := rfl

@[simp] lemma I_sq : I ^ 2 = -1 := by rw [sq, I_mul_I]

@[simp] lemma sub_re (z w : ℂ) : (z - w).re = z.re - w.re := rfl
@[simp] lemma sub_im (z w : ℂ) : (z - w).im = z.im - w.im := rfl
@[simp, norm_cast] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : ℂ) = r - s := ext_iff.2 $ by simp
@[simp, norm_cast] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : ℂ) = r ^ n :=
by induction n; simp [*, of_real_mul, pow_succ]

theorem sub_conj (z : ℂ) : z - conj z = (2 * z.im : ℝ) * I :=
ext_iff.2 $ by simp [two_mul, sub_eq_add_neg]

lemma norm_sq_sub (z w : ℂ) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * (z * conj w).re :=
by { rw [sub_eq_add_neg, norm_sq_add],
     simp only [ring_hom.map_neg, mul_neg, neg_re,
                tactic.ring.add_neg_eq_sub, norm_sq_neg] }

/-! ### Inversion -/

noncomputable instance : has_inv ℂ := ⟨λ z, conj z * ((norm_sq z)⁻¹:ℝ)⟩

theorem inv_def (z : ℂ) : z⁻¹ = conj z * ((norm_sq z)⁻¹:ℝ) := rfl
@[simp] lemma inv_re (z : ℂ) : (z⁻¹).re = z.re / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_im (z : ℂ) : (z⁻¹).im = -z.im / norm_sq z := by simp [inv_def, division_def]

@[simp, norm_cast] lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : ℂ) = r⁻¹ :=
ext_iff.2 $ by simp

protected

protected theorem mul_inv_cancel {z : ℂ} (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul,
  mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

/-! ### Field instance and lemmas -/

noncomputable instance : field ℂ :=
{ inv := has_inv.inv,
  exists_pair_ne := ⟨0, 1, mt (congr_arg re) zero_ne_one⟩,
  mul_inv_cancel := @complex.mul_inv_cancel,
  inv_zero := complex.inv_zero,
  ..complex.comm_ring }

@[simp] lemma I_zpow_bit0 (n : ℤ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [zpow_bit0', I_mul_I]

@[simp] lemma I_zpow_bit1 (n : ℤ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [zpow_bit1', I_mul_I]

lemma div_re (z w : ℂ) : (z / w).re = z.re * w.re / norm_sq w + z.im * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg]
lemma div_im (z w : ℂ) : (z / w).im = z.im * w.re / norm_sq w - z.re * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm]

lemma conj_inv (x : ℂ) : conj (x⁻¹) = (conj x)⁻¹ := star_inv' _

@[simp, norm_cast] lemma of_real_div (r s : ℝ) : ((r / s : ℝ) : ℂ) = r / s :=
of_real.map_div r s

@[simp, norm_cast] lemma of_real_zpow (r : ℝ) (n : ℤ) : ((r ^ n : ℝ) : ℂ) = (r : ℂ) ^ n :=
of_real.map_zpow r n

@[simp] lemma div_I (z : ℂ) : z / I = -(z * I) :=
(div_eq_iff_mul_eq I_ne_zero).2 $ by simp [mul_assoc]

@[simp] lemma inv_I : I⁻¹ = -I :=
by simp [inv_eq_one_div]

@[simp] lemma norm_sq_inv (z : ℂ) : norm_sq z⁻¹ = (norm_sq z)⁻¹ :=
norm_sq.map_inv z

@[simp] lemma norm_sq_div (z w : ℂ) : norm_sq (z / w) = norm_sq z / norm_sq w :=
norm_sq.map_div z w

/-! ### Cast lemmas -/

@[simp, norm_cast] theorem of_real_nat_cast (n : ℕ) : ((n : ℝ) : ℂ) = n :=
map_nat_cast of_real n

@[simp, norm_cast] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n :=
by rw [← of_real_nat_cast, of_real_re]

@[simp, norm_cast] lemma nat_cast_im (n : ℕ) : (n : ℂ).im = 0 :=
by rw [← of_real_nat_cast, of_real_im]

@[simp, norm_cast] theorem of_real_int_cast (n : ℤ) : ((n : ℝ) : ℂ) = n :=
of_real.map_int_cast n

@[simp, norm_cast] lemma int_cast_re (n : ℤ) : (n : ℂ).re = n :=
by rw [← of_real_int_cast, of_real_re]

@[simp, norm_cast] lemma int_cast_im (n : ℤ) : (n : ℂ).im = 0 :=
by rw [← of_real_int_cast, of_real_im]

@[simp, norm_cast] theorem of_real_rat_cast (n : ℚ) : ((n : ℝ) : ℂ) = n := map_rat_cast of_real n

@[simp, norm_cast] lemma rat_cast_re (q : ℚ) : (q : ℂ).re = q :=
by rw [← of_real_rat_cast, of_real_re]

@[simp, norm_cast] lemma rat_cast_im (q : ℚ) : (q : ℂ).im = 0 :=
by rw [← of_real_rat_cast, of_real_im]

/-! ### Characteristic zero -/

instance char_zero_complex : char_zero ℂ :=
char_zero_of_inj_zero $ λ n h,
by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h

/-- A complex number `z` plus its conjugate `conj z` is `2` times its real part. -/
theorem re_eq_add_conj (z : ℂ) : (z.re : ℂ) = (z + conj z) / 2 :=
by simp only [add_conj, of_real_mul, of_real_one, of_real_bit0,
     mul_div_cancel_left (z.re:ℂ) two_ne_zero']

/-- A complex number `z` minus its conjugate `conj z` is `2i` times its imaginary part. -/
theorem im_eq_sub_conj (z : ℂ) : (z.im : ℂ) = (z - conj(z))/(2 * I) :=
by simp only [sub_conj, of_real_mul, of_real_one, of_real_bit0, mul_right_comm,
     mul_div_cancel_left _ (mul_ne_zero two_ne_zero' I_ne_zero : 2 * I ≠ 0)]

/-! ### Absolute value -/

/-- The complex absolute value function, defined as the square root of the norm squared. -/
@[pp_nodot] noncomputable def abs (z : ℂ) : ℝ := (norm_sq z).sqrt

local notation `abs'` := has_abs.abs

@[simp, norm_cast] lemma abs_of_real (r : ℝ) : abs r = |r| :=
by simp [abs, norm_sq_of_real, real.sqrt_mul_self_eq_abs]

lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : abs r = r :=
(abs_of_real _).trans (abs_of_nonneg h)

lemma abs_of_nat (n : ℕ) : complex.abs n = n :=
calc complex.abs n = complex.abs (n:ℝ) : by rw [of_real_nat_cast]
  ... = _ : abs_of_nonneg (nat.cast_nonneg n)

lemma mul_self_abs (z : ℂ) : abs z * abs z = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

lemma sq_abs (z : ℂ) : abs z ^ 2 = norm_sq z :=
real.sq_sqrt (norm_sq_nonneg _)

@[simp] lemma sq_abs_sub_sq_re (z : ℂ) : abs z ^ 2 - z.re ^ 2 = z.im ^ 2 :=
by rw [sq_abs, norm_sq_apply, ← sq, ← sq, add_sub_cancel']

@[simp] lemma sq_abs_sub_sq_im (z : ℂ) : abs z ^ 2 - z.im ^ 2 = z.re ^ 2 :=
by rw [← sq_abs_sub_sq_re, sub_sub_cancel]

@[simp] lemma abs_zero : abs 0 = 0 := by simp [abs]
@[simp] lemma abs_one : abs 1 = 1 := by simp [abs]
@[simp] lemma abs_I : abs I = 1 := by simp [abs]

@[simp] lemma abs_two : abs 2 = 2 :=
calc abs 2 = abs (2 : ℝ) : by rw [of_real_bit0, of_real_one]
... = (2 : ℝ) : abs_of_nonneg (by norm_num)

lemma abs_nonneg (z : ℂ) : 0 ≤ abs z :=
real.sqrt_nonneg _

@[simp] lemma range_abs : range abs = Ici 0 :=
subset.antisymm (range_subset_iff.2 abs_nonneg) $ λ x hx, ⟨x, abs_of_nonneg hx⟩

@[simp] lemma abs_eq_zero {z : ℂ} : abs z = 0 ↔ z = 0 :=
(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero

lemma abs_ne_zero {z : ℂ} : abs z ≠ 0 ↔ z ≠ 0 :=
not_congr abs_eq_zero

@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z :=
by simp [abs]

@[simp] lemma abs_mul (z w : ℂ) : abs (z * w) = abs z * abs w :=
by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl

/-- `complex.abs` as a `monoid_with_zero_hom`. -/
@[simps] noncomputable def abs_hom : ℂ →*₀ ℝ :=
{ to_fun := abs,
  map_zero' := abs_zero,
  map_one' := abs_one,
  map_mul' := abs_mul }

@[simp] lemma abs_prod {ι : Type*} (s : finset ι) (f : ι → ℂ) :
  abs (s.prod f) = s.prod (λ i, abs (f i)) :=
map_prod abs_hom _ _

@[simp] lemma abs_pow (z : ℂ) (n : ℕ) : abs (z ^ n) = abs z ^ n :=
map_pow abs_hom z n

@[simp] lemma abs_zpow (z : ℂ) (n : ℤ) : abs (z ^ n) = abs z ^ n :=
abs_hom.map_zpow z n

lemma abs_re_le_abs (z : ℂ) : |z.re| ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.re) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply re_sq_le_norm_sq

lemma abs_im_le_abs (z : ℂ) : |z.im| ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.im) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply im_sq_le_norm_sq

lemma re_le_abs (z : ℂ) : z.re ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

lemma im_le_abs (z : ℂ) : z.im ≤ abs z :=
(abs_le.1 (abs_im_le_abs _)).2

@[simp] lemma abs_re_lt_abs {z : ℂ} : |z.re| < abs z ↔ z.im ≠ 0 :=
by rw [abs, real.lt_sqrt (_root_.abs_nonneg _), norm_sq_apply, _root_.sq_abs, ← sq,
  lt_add_iff_pos_right, mul_self_pos]

@[simp] lemma abs_im_lt_abs {z : ℂ} : |z.im| < abs z ↔ z.re ≠ 0 :=
by simpa using @abs_re_lt_abs (z * I)

/--
The **triangle inequality** for complex numbers.
-/
lemma abs_add (z w : ℂ) : abs (z + w) ≤ abs z + abs w :=
(mul_self_le_mul_self_iff (abs_nonneg _)
  (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $
begin
  rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs,
      add_right_comm, norm_sq_add, add_le_add_iff_left,
      mul_assoc, mul_le_mul_left (@zero_lt_two ℝ _ _)],
  simpa [-mul_re] using re_le_abs (z * conj w)
end

instance : is_absolute_value abs :=
{ abv_nonneg  := abs_nonneg,
  abv_eq_zero := λ _, abs_eq_zero,
  abv_add     := abs_add,
  abv_mul     := abs_mul }
open is_absolute_value

@[simp] lemma abs_abs (z : ℂ) : |(abs z)| = abs z :=
_root_.abs_of_nonneg (abs_nonneg _)

@[simp] lemma abs_pos {z : ℂ} : 0 < abs z ↔ z ≠ 0 := abv_pos abs
@[simp] lemma abs_neg : ∀ z, abs (-z) = abs z := abv_neg abs
lemma abs_sub_comm : ∀ z w, abs (z - w) = abs (w - z) := abv_sub abs
lemma abs_sub_le : ∀ a b c, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs
@[simp] theorem abs_inv : ∀ z, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs
@[simp] theorem abs_div : ∀ z w, abs (z / w) = abs z / abs w := abv_div abs

lemma abs_abs_sub_le_abs_sub : ∀ z w, |abs z - abs w| ≤ abs (z - w) :=
abs_abv_sub_le_abv_sub abs

lemma abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ |z.re| + |z.im| :=
by simpa [re_add_im] using abs_add z.re (z.im * I)

lemma abs_le_sqrt_two_mul_max (z : ℂ) : abs z ≤ real.sqrt 2 * max (|z.re|) (|z.im|) :=
begin
  cases z with x y,
  simp only [abs, norm_sq_mk, ← sq],
  wlog hle : |x| ≤ |y| := le_total (|x|) (|y|) using [x y, y x] tactic.skip,
  { calc real.sqrt (x ^ 2 + y ^ 2) ≤ real.sqrt (y ^ 2 + y ^ 2) :
      real.sqrt_le_sqrt (add_le_add_right (sq_le_sq.2 hle) _)
    ... = real.sqrt 2 * max (|x|) (|y|) :
      by rw [max_eq_right hle, ← two_mul, real.sqrt_mul two_pos.le, real.sqrt_sq_eq_abs] },
  { rwa [add_comm, max_comm] }
end

lemma abs_re_div_abs_le_one (z : ℂ) : |z.re / z.abs| ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_re_le_abs] }

lemma abs_im_div_abs_le_one (z : ℂ) : |z.im / z.abs| ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_im_le_abs] }

@[simp, norm_cast] lemma abs_cast_nat (n : ℕ) : abs (n : ℂ) = n :=
by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)]

@[simp, norm_cast] lemma int_cast_abs (n : ℤ) : ↑|n| = abs n :=
by rw [← of_real_int_cast, abs_of_real, int.cast_abs]

lemma norm_sq_eq_abs (x : ℂ) : norm_sq x = abs x ^ 2 :=
by rw [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)]

/--
We put a partial order on ℂ so that `z ≤ w` exactly if `w - z` is real and nonnegative.
Complex numbers with different imaginary parts are incomparable.
-/
protected def partial_order : partial_order ℂ :=
{ le := λ z w, z.re ≤ w.re ∧ z.im = w.im,
  lt := λ z w, z.re < w.re ∧ z.im = w.im,
  lt_iff_le_not_le := λ z w, by { dsimp, rw lt_iff_le_not_le, tauto },
  le_refl := λ x, ⟨le_rfl, rfl⟩,
  le_trans := λ x y z h₁ h₂, ⟨h₁.1.trans h₂.1, h₁.2.trans h₂.2⟩,
  le_antisymm := λ z w h₁ h₂, ext (h₁.1.antisymm h₂.1) h₁.2 }

section complex_order

localized "attribute [instance] complex.partial_order" in complex_order

lemma le_def {z w : ℂ} : z ≤ w ↔ z.re ≤ w.re ∧ z.im = w.im := iff.rfl
lemma lt_def {z w : ℂ} : z < w ↔ z.re < w.re ∧ z.im = w.im := iff.rfl

@[simp, norm_cast] lemma real_le_real {x y : ℝ} : (x : ℂ) ≤ (y : ℂ) ↔ x ≤ y := by simp [le_def]

@[simp, norm_cast] lemma real_lt_real {x y : ℝ} : (x : ℂ) < (y : ℂ) ↔ x < y := by simp [lt_def]

@[simp, norm_cast] lemma zero_le_real {x : ℝ} : (0 : ℂ) ≤ (x : ℂ) ↔ 0 ≤ x := real_le_real
@[simp, norm_cast] lemma zero_lt_real {x : ℝ} : (0 : ℂ) < (x : ℂ) ↔ 0 < x := real_lt_real

lemma not_le_iff {z w : ℂ} : ¬(z ≤ w) ↔ w.re < z.re ∨ z.im ≠ w.im :=
by rw [le_def, not_and_distrib, not_le]

lemma not_lt_iff {z w : ℂ} : ¬(z < w) ↔ w.re ≤ z.re ∨ z.im ≠ w.im :=
by rw [lt_def, not_and_distrib, not_lt]

lemma not_le_zero_iff {z : ℂ} : ¬z ≤ 0 ↔ 0 < z.re ∨ z.im ≠ 0 := not_le_iff
lemma not_lt_zero_iff {z : ℂ} : ¬z < 0 ↔ 0 ≤ z.re ∨ z.im ≠ 0 := not_lt_iff

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is an ordered ring.
-/
protected def ordered_comm_ring : ordered_comm_ring ℂ :=
{ zero_le_one := ⟨zero_le_one, rfl⟩,
  add_le_add_left := λ w z h y, ⟨add_le_add_left h.1 _, congr_arg2 (+) rfl h.2⟩,
  mul_pos := λ z w hz hw,
    by simp [lt_def, mul_re, mul_im, ← hz.2, ← hw.2, mul_pos hz.1 hw.1],
  .. complex.partial_order,
  .. complex.comm_ring }

localized "attribute [instance] complex.ordered_comm_ring" in complex_order

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is a star ordered ring.
(That is, a star ring in which the nonnegative elements are those of the form `star z * z`.)
-/
protected def star_ordered_ring : star_ordered_ring ℂ :=
{ nonneg_iff := λ r, by
  { refine ⟨λ hr, ⟨real.sqrt r.re, _⟩, λ h, _⟩,
    { have h₁ : 0 ≤ r.re := by { rw [le_def] at hr, exact hr.1 },
      have h₂ : r.im = 0 := by { rw [le_def] at hr, exact hr.2.symm },
      ext,
      { simp only [of_real_im, star_def, of_real_re, sub_zero, conj_re, mul_re, mul_zero,
                   ←real.sqrt_mul h₁ r.re, real.sqrt_mul_self h₁] },
      { simp only [h₂, add_zero, of_real_im, star_def, zero_mul, conj_im,
                   mul_im, mul_zero, neg_zero] } },
    { obtain ⟨s, rfl⟩ := h,
      simp only [←norm_sq_eq_conj_mul_self, norm_sq_nonneg, zero_le_real, star_def] } },
  ..complex.ordered_comm_ring }

localized "attribute [instance] complex.star_ordered_ring" in complex_order

end complex_order

/-! ### Cauchy sequences -/

theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).re) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij)

theorem is_cau_seq_im (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).im) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij)

/-- The real part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_re (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_re f⟩

/-- The imaginary part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_im (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_im f⟩

lemma is_cau_seq_abs {f : ℕ → ℂ} (hf : is_cau_seq abs f) :
  is_cau_seq abs' (abs ∘ f) :=
λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩

/-- The limit of a Cauchy sequence of complex numbers. -/
noncomputable def lim_aux (f : cau_seq ℂ abs) : ℂ :=
⟨cau_seq.lim (cau_seq_re f), cau_seq.lim (cau_seq_im f)⟩

theorem equiv_lim_aux (f : cau_seq ℂ abs) : f ≈ cau_seq.const abs (lim_aux f) :=
λ ε ε0, (exists_forall_ge_and
  (cau_seq.equiv_lim ⟨_, is_cau_seq_re f⟩ _ (half_pos ε0))
  (cau_seq.equiv_lim ⟨_, is_cau_seq_im f⟩ _ (half_pos ε0))).imp $
λ i H j ij, begin
  cases H _ ij with H₁ H₂,
  apply lt_of_le_of_lt (abs_le_abs_re_add_abs_im _),
  dsimp [lim_aux] at *,
  have := add_lt_add H₁ H₂,
  rwa add_halves at this,
end

instance : cau_seq.is_complete ℂ abs :=
⟨λ f, ⟨lim_aux f, equiv_lim_aux f⟩⟩

open cau_seq

lemma lim_eq_lim_im_add_lim_re (f : cau_seq ℂ abs) : lim f =
  ↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I :=
lim_eq_of_equiv_const $
calc f ≈ _ : equiv_lim_aux f
... = cau_seq.const abs (↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I) :
  cau_seq.ext (λ _, complex.ext (by simp [lim_aux, cau_seq_re]) (by simp [lim_aux, cau_seq_im]))

lemma lim_re (f : cau_seq ℂ abs) : lim (cau_seq_re f) = (lim f).re :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma lim_im (f : cau_seq ℂ abs) : lim (cau_seq_im f) = (lim f).im :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma is_cau_seq_conj (f : cau_seq ℂ abs) : is_cau_seq abs (λ n, conj (f n)) :=
λ ε ε0, let ⟨i, hi⟩ := f.2 ε ε0 in
⟨i, λ j hj, by rw [← ring_hom.map_sub, abs_conj]; exact hi j hj⟩

/-- The complex conjugate of a complex Cauchy sequence, as a complex Cauchy sequence. -/
noncomputable def cau_seq_conj (f : cau_seq ℂ abs) : cau_seq ℂ abs :=
⟨_, is_cau_seq_conj f⟩

lemma lim_conj (f : cau_seq ℂ abs) : lim (cau_seq_conj f) = conj (lim f) :=
complex.ext (by simp [cau_seq_conj, (lim_re _).symm, cau_seq_re])
  (by simp [cau_seq_conj, (lim_im _).symm, cau_seq_im, (lim_neg _).symm]; refl)

/-- The absolute value of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_abs (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_abs f.2⟩

lemma lim_abs (f : cau_seq ℂ abs) : lim (cau_seq_abs f) = abs (lim f) :=
lim_eq_of_equiv_const (λ ε ε0,
let ⟨i, hi⟩ := equiv_lim f ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩)

variables {α : Type*} (s : finset α)

@[simp, norm_cast] lemma of_real_prod (f : α → ℝ) :
  ((∏ i in s, f i : ℝ) : ℂ) = ∏ i in s, (f i : ℂ) :=
ring_hom.map_prod of_real _ _

@[simp, norm_cast] lemma of_real_sum (f : α → ℝ) :
  ((∑ i in s, f i : ℝ) : ℂ) = ∑ i in s, (f i : ℂ) :=
ring_hom.map_sum of_real _ _

@[simp] lemma re_sum (f : α → ℂ) : (∑ i in s, f i).re = ∑ i in s, (f i).re :=
re_add_group_hom.map_sum f s

@[simp] lemma im_sum (f : α → ℂ) : (∑ i in s, f i).im = ∑ i in s, (f i).im :=
im_add_group_hom.map_sum f s

end complex


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.special_functions.exp_deriv

/-!
# Grönwall's inequality

The main technical result of this file is the Grönwall-like inequality
`norm_le_gronwall_bound_of_norm_deriv_right_le`. It states that if `f : ℝ → E` satisfies `∥f a∥ ≤ δ`
and `∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then for all `x ∈ [a, b]` we have `∥f x∥ ≤ δ * exp (K *
x) + (ε / K) * (exp (K * x) - 1)`.

Then we use this inequality to prove some estimates on the possible rate of growth of the distance
between two approximate or exact solutions of an ordinary differential equation.

The proofs are based on [Hubbard and West, *Differential Equations: A Dynamical Systems Approach*,
Sec. 4.5][HubbardWest-ode], where `norm_le_gronwall_bound_of_norm_deriv_right_le` is called
“Fundamental Inequality”.

## TODO

- Once we have FTC, prove an inequality for a function satisfying `∥f' x∥ ≤ K x * ∥f x∥ + ε`,
  or more generally `liminf_{y→x+0} (f y - f x)/(y - x) ≤ K x * f x + ε` with any sign
  of `K x` and `f x`.
-/

variables {E : Type*} [normed_group E] [normed_space ℝ E]
          {F : Type*} [normed_group F] [normed_space ℝ F]

open metric set asymptotics filter real
open_locale classical topological_space nnreal

/-! ### Technical lemmas about `gronwall_bound` -/

/-- Upper bound used in several Grönwall-like inequalities. -/
noncomputable def gronwall_bound (δ K ε x : ℝ) : ℝ :=
if K = 0 then δ + ε * x else δ * exp (K * x) + (ε / K) * (exp (K * x) - 1)

lemma gronwall_bound_K0 (δ ε : ℝ) : gronwall_bound δ 0 ε = λ x, δ + ε * x :=
funext $ λ x, if_pos rfl

lemma gronwall_bound_of_K_ne_0 {δ K ε : ℝ} (hK : K ≠ 0) :
  gronwall_bound δ K ε = λ x, δ * exp (K * x) + (ε / K) * (exp (K * x) - 1) :=
funext $ λ x, if_neg hK

lemma has_deriv_at_gronwall_bound (δ K ε x : ℝ) :
  has_deriv_at (gronwall_bound δ K ε) (K * (gronwall_bound δ K ε x) + ε) x :=
begin
  by_cases hK : K = 0,
  { subst K,
    simp only [gronwall_bound_K0, zero_mul, zero_add],
    convert ((has_deriv_at_id x).const_mul ε).const_add δ,
    rw [mul_one] },
  { simp only [gronwall_bound_of_K_ne_0 hK],
    convert (((has_deriv_at_id x).const_mul K).exp.const_mul δ).add
      ((((has_deriv_at_id x).const_mul K).exp.sub_const 1).const_mul (ε / K)) using 1,
    simp only [id, mul_add, (mul_assoc _ _ _).symm, mul_comm _ K, mul_div_cancel' _ hK],
    ring }
end

lemma has_deriv_at_gronwall_bound_shift (δ K ε x a : ℝ) :
  has_deriv_at (λ y, gronwall_bound δ K ε (y - a)) (K * (gronwall_bound δ K ε (x - a)) + ε) x :=
begin
  convert (has_deriv_at_gronwall_bound δ K ε _).comp x ((has_deriv_at_id x).sub_const a),
  rw [id, mul_one]
end

lemma gronwall_bound_x0 (δ K ε : ℝ) : gronwall_bound δ K ε 0 = δ :=
begin
  by_cases hK : K = 0,
  { simp only [gronwall_bound, if_pos hK, mul_zero, add_zero] },
  { simp only [gronwall_bound, if_neg hK, mul_zero, exp_zero, sub_self, mul_one, add_zero] }
end

lemma gronwall_bound_ε0 (δ K x : ℝ) : gronwall_bound δ K 0 x = δ * exp (K * x) :=
begin
  by_cases hK : K = 0,
  { simp only [gronwall_bound_K0, hK, zero_mul, exp_zero, add_zero, mul_one] },
  { simp only [gronwall_bound_of_K_ne_0 hK, zero_div, zero_mul, add_zero] }
end

lemma gronwall_bound_ε0_δ0 (K x : ℝ) : gronwall_bound 0 K 0 x = 0 :=
by simp only [gronwall_bound_ε0, zero_mul]

lemma gronwall_bound_continuous_ε (δ K x : ℝ) : continuous (λ ε, gronwall_bound δ K ε x) :=
begin
  by_cases hK : K = 0,
  { simp only [gronwall_bound_K0, hK],
    exact continuous_const.add (continuous_id.mul continuous_const) },
  { simp only [gronwall_bound_of_K_ne_0 hK],
    exact continuous_const.add ((continuous_id.mul continuous_const).mul continuous_const) }
end

/-! ### Inequality and corollaries -/

/-- A Grönwall-like inequality: if `f : ℝ → ℝ` is continuous on `[a, b]` and satisfies
the inequalities `f a ≤ δ` and
`∀ x ∈ [a, b), liminf_{z→x+0} (f z - f x)/(z - x) ≤ K * (f x) + ε`, then `f x`
is bounded by `gronwall_bound δ K ε (x - a)` on `[a, b]`.

See also `norm_le_gronwall_bound_of_norm_deriv_right_le` for a version bounding `∥f x∥`,
`f : ℝ → E`. -/
theorem le_gronwall_bound_of_liminf_deriv_right_le {f f' : ℝ → ℝ} {δ K ε : ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r →
    ∃ᶠ z in 𝓝[Ioi x] x, (z - x)⁻¹ * (f z - f x) < r)
  (ha : f a ≤ δ) (bound : ∀ x ∈ Ico a b, f' x ≤ K * f x + ε) :
  ∀ x ∈ Icc a b, f x ≤ gronwall_bound δ K ε (x - a) :=
begin
  have H : ∀ x ∈ Icc a b, ∀ ε' ∈ Ioi ε, f x ≤ gronwall_bound δ K ε' (x - a),
  { assume x hx ε' hε',
    apply image_le_of_liminf_slope_right_lt_deriv_boundary hf hf',
    { rwa [sub_self, gronwall_bound_x0] },
    { exact λ x, has_deriv_at_gronwall_bound_shift δ K ε' x a },
    { assume x hx hfB,
      rw [← hfB],
      apply lt_of_le_of_lt (bound x hx),
      exact add_lt_add_left hε' _ },
    { exact hx } },
  assume x hx,
  change f x ≤ (λ ε', gronwall_bound δ K ε' (x - a)) ε,
  convert continuous_within_at_const.closure_le _ _ (H x hx),
  { simp only [closure_Ioi, left_mem_Ici] },
  exact (gronwall_bound_continuous_ε δ K (x - a)).continuous_within_at
end

/-- A Grönwall-like inequality: if `f : ℝ → E` is continuous on `[a, b]`, has right derivative
`f' x` at every point `x ∈ [a, b)`, and satisfies the inequalities `∥f a∥ ≤ δ`,
`∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then `∥f x∥` is bounded by `gronwall_bound δ K ε (x - a)`
on `[a, b]`. -/
theorem norm_le_gronwall_bound_of_norm_deriv_right_le {f f' : ℝ → E} {δ K ε : ℝ} {a b : ℝ}
  (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x)
  (ha : ∥f a∥ ≤ δ) (bound : ∀ x ∈ Ico a b, ∥f' x∥ ≤ K * ∥f x∥ + ε) :
  ∀ x ∈ Icc a b, ∥f x∥ ≤ gronwall_bound δ K ε (x - a) :=
le_gronwall_bound_of_liminf_deriv_right_le (continuous_norm.comp_continuous_on hf)
  (λ x hx r hr, (hf' x hx).liminf_right_slope_norm_le hr) ha bound

/-- If `f` and `g` are two approximate solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in some time-dependent set `s t`,
and assumes that the solutions never leave this set. -/
theorem dist_le_of_approx_trajectories_ODE_of_mem_set {v : ℝ → E → E} {s : ℝ → set E}
  {K : ℝ} (hv : ∀ t, ∀ x y ∈ s t, dist (v t x) (v t y) ≤ K * dist x y)
  {f g f' g' : ℝ → E} {a b : ℝ} {εf εg δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (f' t) (Ici t) t)
  (f_bound : ∀ t ∈ Ico a b, dist (f' t) (v t (f t)) ≤ εf)
  (hfs : ∀ t ∈ Ico a b, f t ∈ s t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (g' t) (Ici t) t)
  (g_bound : ∀ t ∈ Ico a b, dist (g' t) (v t (g t)) ≤ εg)
  (hgs : ∀ t ∈ Ico a b, g t ∈ s t)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ gronwall_bound δ K (εf + εg) (t - a) :=
begin
  simp only [dist_eq_norm] at ha ⊢,
  have h_deriv : ∀ t ∈ Ico a b, has_deriv_within_at (λ t, f t - g t) (f' t - g' t) (Ici t) t,
    from λ t ht, (hf' t ht).sub (hg' t ht),
  apply norm_le_gronwall_bound_of_norm_deriv_right_le (hf.sub hg) h_deriv ha,
  assume t ht,
  have := dist_triangle4_right (f' t) (g' t) (v t (f t)) (v t (g t)),
  rw [dist_eq_norm] at this,
  apply le_trans this,
  apply le_trans (add_le_add (add_le_add (f_bound t ht) (g_bound t ht))
    (hv t (f t) (g t) (hfs t ht) (hgs t ht))),
  rw [dist_eq_norm, add_comm]
end

/-- If `f` and `g` are two approximate solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in the whole space. -/
theorem dist_le_of_approx_trajectories_ODE {v : ℝ → E → E}
  {K : ℝ≥0} (hv : ∀ t, lipschitz_with K (v t))
  {f g f' g' : ℝ → E} {a b : ℝ} {εf εg δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (f' t) (Ici t) t)
  (f_bound : ∀ t ∈ Ico a b, dist (f' t) (v t (f t)) ≤ εf)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (g' t) (Ici t) t)
  (g_bound : ∀ t ∈ Ico a b, dist (g' t) (v t (g t)) ≤ εg)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ gronwall_bound δ K (εf + εg) (t - a) :=
have hfs : ∀ t ∈ Ico a b, f t ∈ (@univ E), from λ t ht, trivial,
dist_le_of_approx_trajectories_ODE_of_mem_set (λ t x y hx hy, (hv t).dist_le_mul x y)
  hf hf' f_bound hfs hg hg' g_bound (λ t ht, trivial) ha

/-- If `f` and `g` are two exact solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in some time-dependent set `s t`,
and assumes that the solutions never leave this set. -/
theorem dist_le_of_trajectories_ODE_of_mem_set {v : ℝ → E → E} {s : ℝ → set E}
  {K : ℝ} (hv : ∀ t, ∀ x y ∈ s t, dist (v t x) (v t y) ≤ K * dist x y)
  {f g : ℝ → E} {a b : ℝ} {δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hfs : ∀ t ∈ Ico a b, f t ∈ s t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (hgs : ∀ t ∈ Ico a b, g t ∈ s t)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ δ * exp (K * (t - a)) :=
begin
  have f_bound : ∀ t ∈ Ico a b, dist (v t (f t)) (v t (f t)) ≤ 0,
    by { intros, rw [dist_self] },
  have g_bound : ∀ t ∈ Ico a b, dist (v t (g t)) (v t (g t)) ≤ 0,
    by { intros, rw [dist_self] },
  assume t ht,
  have := dist_le_of_approx_trajectories_ODE_of_mem_set hv hf hf' f_bound hfs hg hg' g_bound
    hgs ha t ht,
  rwa [zero_add, gronwall_bound_ε0] at this,
end

/-- If `f` and `g` are two exact solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in the whole space. -/
theorem dist_le_of_trajectories_ODE {v : ℝ → E → E}
  {K : ℝ≥0} (hv : ∀ t, lipschitz_with K (v t))
  {f g : ℝ → E} {a b : ℝ} {δ : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (ha : dist (f a) (g a) ≤ δ) :
  ∀ t ∈ Icc a b, dist (f t) (g t) ≤ δ * exp (K * (t - a)) :=
have hfs : ∀ t ∈ Ico a b, f t ∈ (@univ E), from λ t ht, trivial,
dist_le_of_trajectories_ODE_of_mem_set (λ t x y hx hy, (hv t).dist_le_mul x y)
  hf hf' hfs hg hg' (λ t ht, trivial) ha

/-- There exists only one solution of an ODE \(\dot x=v(t, x)\) in a set `s ⊆ ℝ × E` with
a given initial value provided that RHS is Lipschitz continuous in `x` within `s`,
and we consider only solutions included in `s`. -/
theorem ODE_solution_unique_of_mem_set {v : ℝ → E → E} {s : ℝ → set E}
  {K : ℝ} (hv : ∀ t, ∀ x y ∈ s t, dist (v t x) (v t y) ≤ K * dist x y)
  {f g : ℝ → E} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hfs : ∀ t ∈ Ico a b, f t ∈ s t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (hgs : ∀ t ∈ Ico a b, g t ∈ s t)
  (ha : f a = g a) :
  ∀ t ∈ Icc a b, f t = g t :=
begin
  assume t ht,
  have := dist_le_of_trajectories_ODE_of_mem_set hv hf hf' hfs hg hg' hgs
    (dist_le_zero.2 ha) t ht,
  rwa [zero_mul, dist_le_zero] at this
end

/-- There exists only one solution of an ODE \(\dot x=v(t, x)\) with
a given initial value provided that RHS is Lipschitz continuous in `x`. -/
theorem ODE_solution_unique {v : ℝ → E → E}
  {K : ℝ≥0} (hv : ∀ t, lipschitz_with K (v t))
  {f g : ℝ → E} {a b : ℝ}
  (hf : continuous_on f (Icc a b))
  (hf' : ∀ t ∈ Ico a b, has_deriv_within_at f (v t (f t)) (Ici t) t)
  (hg : continuous_on g (Icc a b))
  (hg' : ∀ t ∈ Ico a b, has_deriv_within_at g (v t (g t)) (Ici t) t)
  (ha : f a = g a) :
  ∀ t ∈ Icc a b, f t = g t :=
have hfs : ∀ t ∈ Ico a b, f t ∈ (@univ E), from λ t ht, trivial,
ODE_solution_unique_of_mem_set (λ t x y hx hy, (hv t).dist_le_mul x y)
  hf hf' hfs hg hg' (λ t ht, trivial) ha


import data.set.basic
open set

variables {α :Type} {β : Type}

def edges (G:set α× set β × (α→  set β)) :set α := G.1
def vertices (G:set α× set β × (α→  set β)) :set β  := G.2.1
def termini (G:set α× set β × (α→ set β)) :α →  set β := G.2.2

def connects  (G:set α× set β × (α→  set β))  (e:α) (a:β  × β ):Prop:= termini G e
={a.1,a.2}

def delete_edge (e:α) (G:set α× set β × (α→  set β)):set α× set β × (α→  set β):=
((edges G) \ {e}, vertices G, termini G )

def eulerian  :(set α× set β × (α→  set β))  → list α → β × β → Prop
|G []         a :=  edges G = {} ∧ a.1=a.2 ∧ a.1 ∈ vertices G
|G (ee :: l)  a := ∃ (c:β), ee ∈ edges(G) ∧  connects G ee a
                  ∧   eulerian (delete_edge ee G)   l (a.2,c)

def V:set ℕ :={1,2,3,4}

def E:set ℕ :={1,2,3,4,5,6,7}

def Ter (e:ℕ):set ℕ :=
match e with
|1     :={1,2}
|2     :={1,2}
|3     :={1,4}
|4     :={1,4}
|5     :={1,3}
|6     :={2,3}
|7     :={3,4}
|_     :={}
end

theorem konigsberg : ¬ (∃ l a b, eulerian (E,V,Ter) l (a,b)) :=
sorry


/-
WR Scott's Group Theory in Lean

Definitions and First Properties
-/
--import .preliminaries
namespace definitions
variables {A : Type}

-- A group is an ordered pair (G , ⬝), ⬝ is an associative binary operation on G
-- ∃ e ∈ G such that
-- (i) a ∈ G → a ⬝ e = a
-- (ii) a ∈ G -> ∃ a⁻¹ ∈ G, a⁻¹ ⬝ a = e
class Group (A : Type) :=
  (one : A)
  (mul : A → A → A)
  (inv : A → A)
  (mul_assoc : ∀ a b c, mul (mul a b) c = mul a (mul b c))
  (mul_one : ∀ a, mul a one = a)
  (mul_inv : ∀ a, mul a (inv a) = one)

postfix ⁻¹ := Group.inv
infix * := Group.mul
notation `one` := Group.one

variables [G : Group A] (a b : A)
#check a * a⁻¹ = one

-- Exercise 1.2.1
lemma inv_mul [G : Group A] (a : A): a⁻¹ * a = one :=
calc  a⁻¹ * a = a⁻¹ * a * one : by rw Group.mul_one
          ... = a⁻¹ * a * (a⁻¹ * (a⁻¹)⁻¹) : by rw Group.mul_inv
          ... = a⁻¹ * (a * a⁻¹) * (a⁻¹)⁻¹ : by simp [←Group.mul_assoc]
          ... = a⁻¹ * one * (a⁻¹)⁻¹ : by rw Group.mul_inv
          ... = ((a⁻¹) * (a⁻¹)⁻¹) : by simp [Group.mul_one]
          ... = one : by rw Group.mul_inv

-- Exercise 1.2.2
lemma one_mul [G : Group A] (a : A): one * a = a :=
calc  one * a = a * a⁻¹ * a : by rw  Group.mul_inv
          ... = a * one : by simp [Group.mul_assoc, inv_mul]
          ... = a : by simp [Group.mul_one]

-- this is essentially the proof strategy for Exercise 1.2.3
lemma prod_to_inv [G : Group A] (a b c : A): a * b = c ↔ b = a⁻¹ * c :=
begin
  split,
  intro p,
  calc b = one * b : by rw one_mul
        ... = a⁻¹ * a * b : by rw ←inv_mul
        ... = a⁻¹ * (a * b) : by rw Group.mul_assoc
        ... = a⁻¹ * c : by rw p,
  intro p,
  calc (a * b) = a * (a⁻¹ * c) : by rw ←p
        ... = (a * a⁻¹) * c : by rw Group.mul_assoc
        ... = one * c : by rw Group.mul_inv
        ... = c : by rw one_mul,
end

lemma prod_to_inv_r [G : Group A] (a b c : A): a * b = c ↔ a = c * b⁻¹ :=
begin
  split,
  intro p,
  calc a = a * one : by rw Group.mul_one
        ... = a * (b * b⁻¹) : by rw ← Group.mul_inv
        ... = (a * b) * b⁻¹: by rw Group.mul_assoc
        ... = c * b⁻¹ : by rw p,
  intro p,
  calc (a * b) = c * b⁻¹ * b : by rw ←p
        ... = c * (b⁻¹ * b) : by rw Group.mul_assoc
        ... = c * one : by rw inv_mul
        ... = c : by rw Group.mul_one,
end

-- Exercise 1.2.3
example [G : Group A] (a b : A) : ∃ x, (a * x = b) :=
begin
  split,
  rw prod_to_inv,
end

-- Exercise 1.2.4
example [G : Group A] (a b : A) : ∃ x, (x * a = b) :=
begin
  split,
  rw prod_to_inv_r,
end

-- Exercise 1.2.5
example [G : Group A] (a x : A) : a * x = a ↔ x = one :=
begin
  split,
  intro p,
  rw prod_to_inv at p,
  rw inv_mul at p,
  exact p,
  intro p,
  rw prod_to_inv,
  rw inv_mul,
  exact p,
end

-- Exercise 1.2.6
lemma prod_one_inv [G : Group A] (a b : A) : a * b = one ↔ b = a⁻¹ :=
begin
  split,
  intro p,
  rw prod_to_inv at p,
  rw Group.mul_one at p,
  exact p,
  intro q,
  rw q,
  rw Group.mul_inv,
end

-- Exercise 1.2.7
example [G : Group A] (a b : A) : (b⁻¹ * a⁻¹) = (a * b)⁻¹ :=
begin
  rw ←prod_one_inv,
  calc a * b * (b⁻¹ * a⁻¹) = a * (b * b⁻¹) * a⁻¹ : by simp [Group.mul_assoc]
                      ... = a * one * a⁻¹ : by rw [Group.mul_inv]
                      ... = a * a⁻¹ : by rw Group.mul_one
                      ... = one : by rw Group.mul_inv,
end

-- Exercise 1.2.8
lemma inv_inv [G : Group A] (a : A) : (a⁻¹)⁻¹ = a :=
  calc  (a⁻¹)⁻¹ = (a⁻¹)⁻¹ * one : by rw Group.mul_one
            ... = (a⁻¹)⁻¹ * (a⁻¹ * a) : by rw inv_mul
            ... = ((a⁻¹)⁻¹ * a⁻¹) * a : by simp [Group.mul_assoc]
            ... =  one * a : by rw inv_mul
            ... = a : by rw one_mul

-- Exercise 1.2.9
constant pow : ℕ → ℕ → ℕ
infix ^ := pow
axiom pow_zero (a : ℕ) : a ^ 0 = 1
axiom pow_succ (a b : ℕ) : a ^ (b.succ) = a ^ b * a
lemma one_add (a b : ℕ) : 1 + a = a.succ := by rw nat.add_comm
lemma succ_group (a b : ℕ) : (a + b).succ = a.succ + b := by admit
example (a b : ℕ) (r s : ℕ) : a^r * a^s = a^(r + s) :=
begin
  induction r with rh r,
  induction s with sh s,
  rw [nat.zero_add, pow_zero, nat.mul_one],
  rw [nat.zero_add, pow_zero, nat.one_mul],
  calc a^rh.succ * a^s = a^rh * (a * a^s) : by rw [pow_succ, nat.mul_assoc]
                  ... = a * (a^s * a^rh) : by rw [nat.mul_comm, nat.mul_assoc]
                  ... = a * (a^rh * a^s) : by simp [nat.mul_comm]
                  ... = a * a^(rh + s): by rw r
                  ... = a^(rh + s) * a: by rw nat.mul_comm
                  ... = a^((rh + s).succ) : by rw ←pow_succ
                  ... = a^(rh.succ + s) : by rw succ_group,
end
end definitions


import Chap6
namespace HTPI
set_option pp.funBinderTypes true

/- Section 6.1 -/
-- 1.
theorem Like_Exercise_6_1_1 :
    ∀ (n : Nat), 2 * Sum i from 0 to n, i = n * (n + 1) := sorry

-- 2.
theorem Like_Exercise_6_1_4 :
    ∀ (n : Nat), Sum i from 0 to n, 2 * i + 1 = (n + 1) ^ 2 := sorry

-- 3.
theorem Exercise_6_1_9a : ∀ (n : Nat), 2 ∣ n ^ 2 + n := sorry

-- 4.
theorem Exercise_6_1_13 :
    ∀ (a b : Int) (n : Nat), (a - b) ∣ (a ^ n - b ^ n) := sorry

-- 5.
theorem Exercise_6_1_15 : ∀ n ≥ 10, 2 ^ n > n ^ 3 := sorry

-- 6.
theorem Exercise_6_1_16a1 :
    ∀ (n : Nat), nat_even n ∨ nat_odd n := sorry

-- 7.
theorem Exercise_6_1_16a2 :
    ∀ (n : Nat), ¬(nat_even n ∧ nat_odd n) := sorry

/- Section 6.2 -/
-- 1.
lemma Lemma_6_2_1_2_ex {A : Type} {R : BinRel A} {B : Set A} {b c : A}
    (h1 : partial_order R) (h2 : b ∈ B) (h3 : minimalElt R c (B \ {b}))
    (h4 : ¬R b c) : minimalElt R c B := sorry

-- 2.
lemma extendPO_is_ref_ex {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : reflexive (extendPO R b) := sorry

-- 3.
lemma extendPO_is_trans_ex {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : transitive (extendPO R b) := sorry

-- 4.
lemma extendPO_is_antisymm_ex {A : Type} (R : BinRel A) (b : A)
    (h : partial_order R) : antisymmetric (extendPO R b) := sorry

-- 5.
theorem Exercise_6_2_3 (A : Type) (R : BinRel A)
    (h : total_order R) : ∀ n ≥ 1, ∀ (B : Set A),
    numElts B n → ∃ (b : A), smallestElt R b B := sorry

-- 6.
--Hint:  First prove that R is reflexive
theorem Exercise_6_2_4a {A : Type} (R : BinRel A)
    (h : ∀ (x y : A), R x y ∨ R y x) : ∀ n ≥ 1, ∀ (B : Set A),
    numElts B n → ∃ x ∈ B, ∀ y ∈ B, ∃ (z : A), R x z ∧ R z y := sorry

-- 7.
theorem Like_Exercise_6_2_16 (f : Nat → Nat) (h : one_to_one f) :
    ∀ (n : Nat) (A : Set Nat), numElts A n →
    closed f A → ∀ y ∈ A, ∃ x ∈ A, f x = y := sorry

-- 8.
--Hint:  Use Exercise_6_2_2
theorem Example_6_2_2 {A : Type} (R : BinRel A)
    (h1 : ∃ (n : Nat), numElts { x : A | x = x } n)
    (h2 : partial_order R) : ∃ (T : BinRel A),
      total_order T ∧ ∀ (x y : A), R x y → T x y := sorry

/- Section 6.3 -/
-- 1.
theorem Exercise_6_3_4 : ∀ (n : Nat),
    3 * (Sum i from 0 to n, (2 * i + 1) ^ 2) =
    (n + 1) * (2 * n + 1) * (2 * n + 3) := sorry

-- 2.
theorem Exercise_6_3_7b (f : Nat → Real) (c : Real) : ∀ (n : Nat),
    Sum i from 0 to n, c * f i = c * Sum i from 0 to n, f i := sorry

-- 3.
theorem fact_pos : ∀ (n : Nat), fact n ≥ 1 := sorry

-- 4.
--Hint:  Use the theorem fact_pos from the previous exercise
theorem Exercise_6_3_13a (k : Nat) : ∀ (n : Nat),
    fact (k ^ 2 + n) ≥ k ^ (2 * n) := sorry

-- 5.
--Hint:  Use the theorem in the previous exercise.
--You may find it useful to first prove a lemma:
--∀ (k : Nat), 2 * k ^ 2 + 1 ≥ k
theorem Exercise_6_3_13b (k : Nat) : ∀ n ≥ 2 * k ^ 2,
    fact n ≥ k ^ n := sorry

-- 6.
def seq_6_3_15 (k : Nat) : Int :=
    match k with
      | 0 => 0
      | n + 1 => 2 * seq_6_3_15 n + n

theorem Exercise_6_3_15 : ∀ (n : Nat),
    seq_6_3_15 n = 2 ^ n - n - 1 := sorry

-- 7.
def seq_6_3_16 (k : Nat) : Nat :=
    match k with
      | 0 => 2
      | n + 1 => (seq_6_3_16 n) ^ 2

theorem Exercise_6_3_16 : ∀ (n : Nat),
    seq_6_3_16 n = ___ := sorry

/- Section 6.4 -/
-- 1.
--Hint: Use Exercise_6_1_16a1 and Exercise_6_1_16a2
lemma sq_even_iff_even_ex (n : Nat) :
    nat_even (n * n) ↔ nat_even n := sorry

-- 2.
--This theorem proves that the square root of 6 is irrational
theorem Exercise_6_4_4a :
    ¬∃ (q p : Nat), p * p = 6 * (q * q) ∧ q ≠ 0 := sorry

-- 3.
theorem Exercise_6_4_5 :
    ∀ n ≥ 12, ∃ (a b : Nat), 3 * a + 7 * b = n := sorry

-- 4.
theorem Exercise_6_4_7a : ∀ (n : Nat),
    (Sum i from 0 to n, Fib i) + 1 = Fib (n + 2) := sorry

-- 5.
theorem Exercise_6_4_7c : ∀ (n : Nat),
    Sum i from 0 to n, Fib (2 * i + 1) = Fib (2 * n + 2) := sorry

-- 6.
theorem Exercise_6_4_8a : ∀ (m n : Nat) ,
    Fib (m + n + 1) = Fib m * Fib n + Fib (m + 1) * Fib (n + 1) := sorry

-- 7.
theorem Exercise_6_4_8d : ∀ (m k : Nat), Fib m ∣ Fib (m * k) := sorry

-- 8.
def Fib_like (n : Nat) : Nat :=
  match n with
    | 0 => 1
    | 1 => 2
    | k + 2 => 2 * (Fib_like k) + Fib_like (k + 1)

theorem Fib_like_formula : ∀ (n : Nat), Fib_like n = 2 ^ n := sorry

-- 9.
def triple_rec (n : Nat) : Nat :=
  match n with
    | 0 => 0
    | 1 => 2
    | 2 => 4
    | k + 3 => 4 * triple_rec k +
                6 * triple_rec (k + 1) + triple_rec (k + 2)

theorem triple_rec_formula :
    ∀ (n : Nat), triple_rec n = 2 ^ n * Fib n := sorry

-- 10.
lemma quot_rem_unique_lemma {m q r q' r' : Nat}
    (h1 : q * m + r = q' * m + r') (h2 : r' < m) : q ≤ q' := sorry

theorem quot_rem_unique (m q r q' r' : Nat)
    (h1 : q * m + r = q' * m + r') (h2 : r < m) (h3 : r' < m) :
    q = q' ∧ r = r' := sorry

/- Section 6.5 -/
-- 1.
theorem rep_image_family_base {A : Type}
    (F : Set (A → A)) (B : Set A) : rep_image_family F 0 B = B := by rfl

theorem rep_image_family_step {A : Type}
    (F : Set (A → A)) (n : Nat) (B : Set A) :
    rep_image_family F (n + 1) B =
    { x : A | ∃ f ∈ F, x ∈ image f (rep_image_family F n B) } := by rfl

lemma rep_image_family_sub_closed {A : Type}
    (F : Set (A → A)) (B D : Set A)
    (h1 : B ⊆ D) (h2 : closed_family F D) :
    ∀ (n : Nat), rep_image_family F n B ⊆ D := sorry

theorem Exercise_6_5_3 {A : Type} (F : Set (A → A)) (B : Set A) :
    closure_family F B (cumul_image_family F B) := sorry

-- 2.
theorem rep_image2_base {A : Type} (f : A → A → A) (B : Set A) :
    rep_image2 f 0 B = B := by rfl

theorem rep_image2_step {A : Type}
    (f : A → A → A) (n : Nat) (B : Set A) :
    rep_image2 f (n + 1) B = image2 f (rep_image2 f n B) := by rfl

--You won't be able to complete this proof
theorem Exercise_6_5_6 {A : Type} (f : A → A → A) (B : Set A) :
    closed2 f (cumul_image2 f B) := sorry

-- 3.
theorem rep_un_image2_base {A : Type} (f : A → A → A) (B : Set A) :
    rep_un_image2 f 0 B = B := by rfl

theorem rep_un_image2_step {A : Type}
    (f : A → A → A) (n : Nat) (B : Set A) :
    rep_un_image2 f (n + 1) B =
    un_image2 f (rep_un_image2 f n B) := by rfl

theorem Exercise_6_5_8a {A : Type} (f : A → A → A) (B : Set A) :
    ∀ (m n : Nat), m ≤ n →
    rep_un_image2 f m B ⊆ rep_un_image2 f n B := sorry

lemma rep_un_image2_sub_closed {A : Type} {f : A → A → A} {B D : Set A}
    (h1 : B ⊆ D) (h2 : closed2 f D) :
    ∀ (n : Nat), rep_un_image2 f n B ⊆ D := sorry

lemma closed_lemma
    {A : Type} {f : A → A → A} {B : Set A} {x y : A} {nx ny n : Nat}
    (h1 : x ∈ rep_un_image2 f nx B) (h2 : y ∈ rep_un_image2 f ny B)
    (h3 : nx ≤ n) (h4 : ny ≤ n) :
    f x y ∈ cumul_un_image2 f B := sorry

theorem Exercise_6_5_8b {A : Type} (f : A → A → A) (B : Set A) :
    closure2 f B (cumul_un_image2 f B) := sorry

-- 4.
theorem rep_comp_one {A : Type} (R : Set (A × A)) :
    rep_comp R 1 = R := sorry

-- 5.
theorem Exercise_6_5_11 {A : Type} (R : Set (A × A)) :
    ∀ (m n : Nat), rep_comp R (m + n) =
    comp (rep_comp R m) (rep_comp R n) := sorry

-- 6.
lemma rep_comp_sub_trans {A : Type} {R S : Set (A × A)}
    (h1 : R ⊆ S) (h2 : transitive (RelFromExt S)) :
    ∀ n ≥ 1, rep_comp R n ⊆ S := sorry

-- 7.
theorem Exercise_6_5_14 {A : Type} (R : Set (A × A)) :
    smallestElt (sub (A × A)) (cumul_comp R)
    { S : Set (A × A) | R ⊆ S ∧ transitive (RelFromExt S) } := sorry


import init.data.set
import set_theory.cardinal.basic

open set

-- proof:
-- First notice that B' ⊆ A. Now suppose f(B') ∈ B,
-- then there is X ⊆ A such that f(B') = f(X) with f(X) ∉ X,
-- but f is injective by assumption and so B' = X.
-- So together with f(X) ∉ X we get f(B') ∉ B'.
-- Conversely if f(B') ∉ B' then combined with B' ⊆ A and f(B') = f(B'),
-- we have that ∃X [f(B') = f(X) ∧ f(X) ∉ X ∧ X ⊆ A], namely X = B'.
-- But that means that f(B') ∈ B.

theorem cantor_injective {α : Type} (f : set α → α) :
  ¬function.injective f :=
begin
  set B := {x : set α | f x ∉ x},
  set B' := {y : α | ∃ x : set α, f x = y ∧ x ∈ B},
  by_contradiction h,
  by_cases hp : f(B') ∈ B',
  { have : ∃ X, f(X) = f(B') ∧ f(X) ∉ X := mem_set_of.mp hp,
    cases this with s hs,
    rw ← (h hs.1) at hp,
    have hp' := hs.2,
    contradiction, },
  { have : f(B') ∈ B',
    { rw mem_set_of,
      use B',
      split,
      { refl, },
      { rw mem_set_of,
        exact hp, }, },
    contradiction, }
end

theorem cantor_injective' {α : Type} (f : set α → α) :
  ¬function.injective f :=
begin
  set B := {x : set α | f x ∉ x},
  set B' := {y : α | ∃ x : set α, f x = y ∧ x ∈ B},
  intro h,
  by_cases hp : f B' ∈ B',
  { obtain ⟨s, hs⟩ : ∃ X, f X = f B' ∧ f X ∉ X := mem_set_of_eq.mp hp,
    rw ← (h hs.1) at hp,
    exact hs.2 hp, },
  { exact hp ⟨B', rfl, hp⟩, }
end


-- import Ints.Lemmas
import Sets.Basic

section Eg

variable (n m : Nat)

#check n < m

end Eg

-- What are the natural numbers in Lean? How do we prove things about them? We
-- will come back to these
namespace Nat

theorem mul_nonzero_cancel {a b c : Nat} (h : a ≠ 0) (h' : a*b = a*c) : b = c := sorry

theorem prod_eq_one { a b : Nat } (h : a*b = 1) : a = 1 ∧ b = 1 := sorry

end Nat

namespace Relations

variable { α : Type }

def Reflexive (R : α → α → Prop) : Prop := ∀ x, R x x

def Irreflexive (R : α → α → Prop) : Prop := ∀ x, ¬ R x x

def Symmetric (R : α → α → Prop) : Prop := ∀ ⦃x y⦄, R x y → R y x

def Asymmetric (R : α → α → Prop) : Prop := ∀ ⦃x y⦄, R x y → ¬ R y x

def AntiSymmetric (R : α → α → Prop) : Prop := ∀ ⦃x y⦄, R x y → R y x → x = y

def Total (R : α → α → Prop) : Prop := ∀ x y, R x y ∨ R y x

def Transitive (R : α → α → Prop) : Prop := ∀ ⦃x y z⦄, R x y → R y z → R x z

class Equiv (R : α → α → Prop) where
  refl : Reflexive R
  symm : Symmetric R
  trans : Transitive R

instance : Equiv (@Eq α) where
  refl := Eq.refl
  symm := @Eq.symm α
  trans := @Eq.trans α

class PartialOrder (R : α → α → Prop) where
  refl : Reflexive R
  antisymm : AntiSymmetric R
  trans : Transitive R

class TotalOrder (R : α → α → Prop) where
  antisymm : AntiSymmetric R
  total : Total R

theorem refl_not_irrefl { R : α → α → Prop } (a : α) (h : Reflexive R) : ¬ Irreflexive R :=
  fun h' => h' a (h a)

theorem irrefl_not_refl { R : α → α → Prop } (a : α) (h : Irreflexive R) : ¬ Reflexive R :=
  fun h' => h a (h' a)

-- theorem eq_or {P : Prop} (h : P ∨ P) : P := by cases h; repeat assumption

theorem total_refl { R : α → α → Prop } (h : Total R) : Reflexive R := fun a => eq_or (h a a) where
  eq_or {P : Prop} (h : P ∨ P) : P := by cases h; repeat assumption

def Divides (a b : Nat) : Prop := ∃ c, b = c*a
infix:60 " | " => Divides

theorem div_refl : Reflexive Divides := by
  intro a
  have : a = 1*a := Eq.symm (Nat.one_mul a)
  exists 1

theorem div_not_irrefl : ¬ Irreflexive Divides := refl_not_irrefl 0 div_refl

theorem div_antisym : AntiSymmetric Divides := by
  intro a b h₁ h₂
  have ⟨c₁,h₁⟩ := h₁
  have ⟨c₂,h₂⟩ := h₂
  by_cases h : a = 0
  · rw [h,Nat.mul_zero,←h] at h₁
    exact Eq.symm h₁
  · rw [h₁,←Nat.mul_assoc,Nat.mul_comm] at h₂
    conv at h₂ => lhs ; rw [←Nat.mul_one a]
    have : 1 = c₂ * c₁ := Nat.mul_nonzero_cancel h h₂
    have : c₁ = 1 := (Nat.prod_eq_one (Eq.symm this)).right
    rw [this,Nat.one_mul a] at h₁
    exact Eq.symm h₁

theorem div_trans : Transitive Divides := by
  intro a b c h₁ h₂
  have ⟨d₁,h₁⟩ := h₁
  have ⟨d₂,h₂⟩ := h₂
  rw [h₁,←Nat.mul_assoc] at h₂
  exists d₂*d₁

instance : PartialOrder Divides where
  refl := div_refl
  antisymm := div_antisym
  trans := div_trans

end Relations


/-
Copyright (c) 2019 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 topology.metric_space.gluing
import topology.metric_space.hausdorff_distance
import topology.continuous_function.bounded

/-!
# The Gromov-Hausdorff distance is realized

In this file, we construct of a good coupling between nonempty compact metric spaces, minimizing
their Hausdorff distance. This construction is instrumental to study the Gromov-Hausdorff
distance between nonempty compact metric spaces.

Given two nonempty compact metric spaces `X` and `Y`, we define `optimal_GH_coupling X Y` as a
compact metric space, together with two isometric embeddings `optimal_GH_injl` and `optimal_GH_injr`
respectively of `X` and `Y` into `optimal_GH_coupling X Y`. The main property of the optimal
coupling is that the Hausdorff distance between `X` and `Y` in `optimal_GH_coupling X Y` is smaller
than the corresponding distance in any other coupling. We do not prove completely this fact in this
file, but we show a good enough approximation of this fact in `Hausdorff_dist_optimal_le_HD`, that
will suffice to obtain the full statement once the Gromov-Hausdorff distance is properly defined,
in `Hausdorff_dist_optimal`.

The key point in the construction is that the set of possible distances coming from isometric
embeddings of `X` and `Y` in metric spaces is a set of equicontinuous functions. By Arzela-Ascoli,
it is compact, and one can find such a distance which is minimal. This distance defines a premetric
space structure on `X ⊕ Y`. The corresponding metric quotient is `optimal_GH_coupling X Y`.
-/

noncomputable theory
open_locale classical topology nnreal
universes u v w

open classical set function topological_space filter metric quotient
open bounded_continuous_function
open sum (inl inr)

local attribute [instance] metric_space_sum

namespace Gromov_Hausdorff

section Gromov_Hausdorff_realized
/- This section shows that the Gromov-Hausdorff distance
is realized. For this, we consider candidate distances on the disjoint union
`X ⊕ Y` of two compact nonempty metric spaces, almost realizing the Gromov-Hausdorff
distance, and show that they form a compact family by applying Arzela-Ascoli
theorem. The existence of a minimizer follows. -/

section definitions
variables (X : Type u) (Y : Type v)
  [metric_space X] [compact_space X] [nonempty X]
  [metric_space Y] [compact_space Y] [nonempty Y]

@[reducible] private def prod_space_fun : Type* := ((X ⊕ Y) × (X ⊕ Y)) → ℝ
@[reducible] private def Cb : Type* := bounded_continuous_function ((X ⊕ Y) × (X ⊕ Y)) ℝ

private def max_var : ℝ≥0 :=
2 * ⟨diam (univ : set X), diam_nonneg⟩ + 1 + 2 * ⟨diam (univ : set Y), diam_nonneg⟩

private lemma one_le_max_var : 1 ≤ max_var X Y := calc
  (1 : real) = 2 * 0 + 1 + 2 * 0 : by simp
  ... ≤ 2 * diam (univ : set X) + 1 + 2 * diam (univ : set Y) :
  by apply_rules [add_le_add, mul_le_mul_of_nonneg_left, diam_nonneg]; norm_num

/-- The set of functions on `X ⊕ Y` that are candidates distances to realize the
minimum of the Hausdorff distances between `X` and `Y` in a coupling -/
def candidates : set (prod_space_fun X Y) :=
  {f | (((((∀ x y : X, f (sum.inl x, sum.inl y) = dist x y)
    ∧ (∀ x y : Y, f (sum.inr x, sum.inr y) = dist x y))
    ∧ (∀ x y,     f (x, y) = f (y, x)))
    ∧ (∀ x y z,   f (x, z) ≤ f (x, y) + f (y, z)))
    ∧ (∀ x,       f (x, x) = 0))
    ∧ (∀ x y,     f (x, y) ≤ max_var X Y) }

/-- Version of the set of candidates in bounded_continuous_functions, to apply
Arzela-Ascoli -/
private def candidates_b : set (Cb X Y) := {f : Cb X Y | (f : _ → ℝ) ∈ candidates X Y}

end definitions --section

section constructions

variables {X : Type u} {Y : Type v}
[metric_space X] [compact_space X] [nonempty X] [metric_space Y] [compact_space Y] [nonempty Y]
{f : prod_space_fun X Y} {x y z t : X ⊕ Y}
local attribute [instance, priority 10] inhabited_of_nonempty'

private lemma max_var_bound : dist x y ≤ max_var X Y := calc
  dist x y ≤ diam (univ : set (X ⊕ Y)) :
    dist_le_diam_of_mem bounded_of_compact_space (mem_univ _) (mem_univ _)
  ... = diam (range inl ∪ range inr : set (X ⊕ Y)) :
    by rw [range_inl_union_range_inr]
  ... ≤ diam (range inl : set (X ⊕ Y)) + dist (inl default) (inr default) +
          diam (range inr : set (X ⊕ Y)) :
    diam_union (mem_range_self _) (mem_range_self _)
  ... = diam (univ : set X) + (dist default default + 1 + dist default default) +
          diam (univ : set Y) :
    by { rw [isometry_inl.diam_range, isometry_inr.diam_range], refl }
  ... = 1 * diam (univ : set X) + 1 + 1 * diam (univ : set Y) : by simp
  ... ≤ 2 * diam (univ : set X) + 1 + 2 * diam (univ : set Y) :
  begin
    apply_rules [add_le_add, mul_le_mul_of_nonneg_right, diam_nonneg, le_refl],
    norm_num, norm_num
  end

private lemma candidates_symm (fA : f ∈ candidates X Y) : f (x, y) = f (y, x) := fA.1.1.1.2 x y

private lemma candidates_triangle (fA : f ∈ candidates X Y) : f (x, z) ≤ f (x, y) + f (y, z) :=
  fA.1.1.2 x y z

private lemma candidates_refl (fA : f ∈ candidates X Y) : f (x, x) = 0 := fA.1.2 x

private lemma candidates_nonneg (fA : f ∈ candidates X Y) : 0 ≤ f (x, y) :=
begin
  have : 0 ≤ 2 * f (x, y) := calc
    0 = f (x, x) : (candidates_refl fA).symm
    ... ≤ f (x, y) + f (y, x) : candidates_triangle fA
    ... = f (x, y) + f (x, y) : by rw [candidates_symm fA]
    ... = 2 * f (x, y) : by ring,
  by linarith
end

private lemma candidates_dist_inl (fA : f ∈ candidates X Y) (x y: X) :
  f (inl x, inl y) = dist x y :=
fA.1.1.1.1.1 x y

private lemma candidates_dist_inr (fA : f ∈ candidates X Y) (x y : Y) :
  f (inr x, inr y) = dist x y :=
fA.1.1.1.1.2 x y

private lemma candidates_le_max_var (fA : f ∈ candidates X Y) : f (x, y) ≤ max_var X Y :=
fA.2 x y

/-- candidates are bounded by `max_var X Y` -/
private lemma candidates_dist_bound  (fA : f ∈ candidates X Y) :
  ∀ {x y : X ⊕ Y}, f (x, y) ≤ max_var X Y * dist x y
| (inl x) (inl y) := calc
    f (inl x, inl y) = dist x y : candidates_dist_inl fA x y
    ... = dist (inl x) (inl y) : by { rw @sum.dist_eq X Y, refl }
    ... = 1 * dist (inl x) (inl y) : by simp
    ... ≤ max_var X Y * dist (inl x) (inl y) :
      mul_le_mul_of_nonneg_right (one_le_max_var X Y) dist_nonneg
| (inl x) (inr y) := calc
    f (inl x, inr y) ≤ max_var X Y : candidates_le_max_var fA
    ... = max_var X Y * 1 : by simp
    ... ≤ max_var X Y * dist (inl x) (inr y) :
      mul_le_mul_of_nonneg_left sum.one_dist_le (le_trans (zero_le_one) (one_le_max_var X Y))
| (inr x) (inl y) := calc
    f (inr x, inl y) ≤ max_var X Y : candidates_le_max_var fA
    ... = max_var X Y * 1 : by simp
    ... ≤ max_var X Y * dist (inl x) (inr y) :
      mul_le_mul_of_nonneg_left sum.one_dist_le (le_trans (zero_le_one) (one_le_max_var X Y))
| (inr x) (inr y) := calc
    f (inr x, inr y) = dist x y : candidates_dist_inr fA x y
    ... = dist (inr x) (inr y) : by { rw @sum.dist_eq X Y, refl }
    ... = 1 * dist (inr x) (inr y) : by simp
    ... ≤ max_var X Y * dist (inr x) (inr y) :
      mul_le_mul_of_nonneg_right (one_le_max_var X Y) dist_nonneg

/-- Technical lemma to prove that candidates are Lipschitz -/
private lemma candidates_lipschitz_aux (fA : f ∈ candidates X Y) :
  f (x, y) - f (z, t) ≤ 2 * max_var X Y * dist (x, y) (z, t) :=
calc
  f (x, y) - f(z, t) ≤ f (x, t) + f (t, y) - f (z, t) : sub_le_sub_right (candidates_triangle fA) _
  ... ≤ (f (x, z) + f (z, t) + f(t, y)) - f (z, t) :
    sub_le_sub_right (add_le_add_right (candidates_triangle fA) _ ) _
  ... = f (x, z) + f (t, y) : by simp [sub_eq_add_neg, add_assoc]
  ... ≤ max_var X Y * dist x z + max_var X Y * dist t y :
    add_le_add (candidates_dist_bound fA) (candidates_dist_bound fA)
  ... ≤ max_var X Y * max (dist x z) (dist t y) + max_var X Y * max (dist x z) (dist t y) :
  begin
    apply add_le_add,
    apply mul_le_mul_of_nonneg_left (le_max_left (dist x z) (dist t y))
      (zero_le_one.trans (one_le_max_var X Y)),
    apply mul_le_mul_of_nonneg_left (le_max_right (dist x z) (dist t y))
      (zero_le_one.trans (one_le_max_var X Y)),
  end
  ... = 2 * max_var X Y * max (dist x z) (dist y t) :
    by { simp [dist_comm], ring }
  ... = 2 * max_var X Y * dist (x, y) (z, t) : by refl

/-- Candidates are Lipschitz -/
private lemma candidates_lipschitz (fA : f ∈ candidates X Y) :
  lipschitz_with (2 * max_var X Y) f :=
begin
  apply lipschitz_with.of_dist_le_mul,
  rintros ⟨x, y⟩ ⟨z, t⟩,
  rw [real.dist_eq, abs_sub_le_iff],
  use candidates_lipschitz_aux fA,
  rw [dist_comm],
  exact candidates_lipschitz_aux fA
end

/-- candidates give rise to elements of bounded_continuous_functions -/
def candidates_b_of_candidates (f : prod_space_fun X Y) (fA : f ∈ candidates X Y) : Cb X Y :=
bounded_continuous_function.mk_of_compact ⟨f, (candidates_lipschitz fA).continuous⟩

lemma candidates_b_of_candidates_mem (f : prod_space_fun X Y) (fA : f ∈ candidates X Y) :
  candidates_b_of_candidates f fA ∈ candidates_b X Y := fA

/-- The distance on `X ⊕ Y` is a candidate -/
private lemma dist_mem_candidates : (λp : (X ⊕ Y) × (X ⊕ Y), dist p.1 p.2) ∈ candidates X Y :=
begin
  simp only [candidates, dist_comm, forall_const, and_true, add_comm, eq_self_iff_true,
             and_self, sum.forall, set.mem_set_of_eq, dist_self],
  repeat { split
    <|> exact (λa y z, dist_triangle_left _ _ _)
    <|> exact (λx y, by refl)
    <|> exact (λx y, max_var_bound) }
end

/-- The distance on `X ⊕ Y` as a candidate -/
def candidates_b_dist (X : Type u) (Y : Type v) [metric_space X] [compact_space X] [inhabited X]
  [metric_space Y] [compact_space Y] [inhabited Y] : Cb X Y :=
candidates_b_of_candidates _ dist_mem_candidates

lemma candidates_b_dist_mem_candidates_b : candidates_b_dist X Y ∈ candidates_b X Y :=
candidates_b_of_candidates_mem _ _

private lemma candidates_b_nonempty : (candidates_b X Y).nonempty :=
⟨_,  candidates_b_dist_mem_candidates_b⟩

/-- To apply Arzela-Ascoli, we need to check that the set of candidates is closed and
equicontinuous. Equicontinuity follows from the Lipschitz control, we check closedness. -/
private lemma closed_candidates_b : is_closed (candidates_b X Y) :=
begin
  have I1 : ∀ x y, is_closed {f : Cb X Y | f (inl x, inl y) = dist x y} :=
    λx y, is_closed_eq continuous_eval_const continuous_const,
  have I2 : ∀ x y, is_closed {f : Cb X Y | f (inr x, inr y) = dist x y } :=
    λx y, is_closed_eq continuous_eval_const continuous_const,
  have I3 : ∀ x y, is_closed {f : Cb X Y | f (x, y) = f (y, x)} :=
    λx y, is_closed_eq continuous_eval_const continuous_eval_const,
  have I4 : ∀ x y z, is_closed {f : Cb X Y | f (x, z) ≤ f (x, y) + f (y, z)} :=
    λx y z, is_closed_le continuous_eval_const (continuous_eval_const.add continuous_eval_const),
  have I5 : ∀ x, is_closed {f : Cb X Y | f (x, x) = 0} :=
    λx, is_closed_eq continuous_eval_const continuous_const,
  have I6 : ∀ x y, is_closed {f : Cb X Y | f (x, y) ≤ max_var X Y} :=
    λx y, is_closed_le continuous_eval_const continuous_const,
  have : candidates_b X Y = (⋂x y, {f : Cb X Y | f ((@inl X Y x), (@inl X Y y)) = dist x y})
               ∩ (⋂x y, {f : Cb X Y | f ((@inr X Y x), (@inr X Y y)) = dist x y})
               ∩ (⋂x y, {f : Cb X Y | f (x, y) = f (y, x)})
               ∩ (⋂x y z, {f : Cb X Y | f (x, z) ≤ f (x, y) + f (y, z)})
               ∩ (⋂x, {f : Cb X Y | f (x, x) = 0})
               ∩ (⋂x y, {f : Cb X Y | f (x, y) ≤ max_var X Y}),
  { ext, simp only [candidates_b, candidates, mem_inter_iff, mem_Inter, mem_set_of_eq] },
  rw this,
  repeat { apply is_closed.inter _ _
       <|> apply is_closed_Inter _
       <|> apply I1 _ _
       <|> apply I2 _ _
       <|> apply I3 _ _
       <|> apply I4 _ _ _
       <|> apply I5 _
       <|> apply I6 _ _
       <|> assume x },
end

/-- Compactness of candidates (in bounded_continuous_functions) follows. -/
private lemma is_compact_candidates_b : is_compact (candidates_b X Y) :=
begin
  refine arzela_ascoli₂ (Icc 0 (max_var X Y)) is_compact_Icc (candidates_b X Y)
  closed_candidates_b _ _,
  { rintros f ⟨x1, x2⟩ hf,
    simp only [set.mem_Icc],
    exact ⟨candidates_nonneg hf, candidates_le_max_var hf⟩ },
  { refine equicontinuous_of_continuity_modulus (λt, 2 * max_var X Y * t) _ _ _,
    { have : tendsto (λ (t : ℝ), 2 * (max_var X Y : ℝ) * t) (𝓝 0) (𝓝 (2 * max_var X Y * 0)) :=
        tendsto_const_nhds.mul tendsto_id,
      simpa using this },
    { rintros x y ⟨f, hf⟩,
      exact (candidates_lipschitz hf).dist_le_mul _ _ } }
end

/-- We will then choose the candidate minimizing the Hausdorff distance. Except that we are not
in a metric space setting, so we need to define our custom version of Hausdorff distance,
called HD, and prove its basic properties. -/
def HD (f : Cb X Y) := max (⨆ x, ⨅ y, f (inl x, inr y)) (⨆ y, ⨅ x, f (inl x, inr y))

/- We will show that HD is continuous on bounded_continuous_functions, to deduce that its
minimum on the compact set candidates_b is attained. Since it is defined in terms of
infimum and supremum on `ℝ`, which is only conditionnally complete, we will need all the time
to check that the defining sets are bounded below or above. This is done in the next few
technical lemmas -/

lemma HD_below_aux1 {f : Cb X Y} (C : ℝ) {x : X} :
  bdd_below (range (λ (y : Y), f (inl x, inr y) + C)) :=
let ⟨cf, hcf⟩ := (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).1 in
⟨cf + C, forall_range_iff.2 (λi, add_le_add_right ((λx, hcf (mem_range_self x)) _) _)⟩

private lemma HD_bound_aux1 (f : Cb X Y) (C : ℝ) :
  bdd_above (range (λ (x : X), ⨅ y, f (inl x, inr y) + C)) :=
begin
  rcases (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).2 with ⟨Cf, hCf⟩,
  refine ⟨Cf + C, forall_range_iff.2 (λx, _)⟩,
  calc (⨅ y, f (inl x, inr y) + C) ≤ f (inl x, inr default) + C :
    cinfi_le (HD_below_aux1 C) default
    ... ≤ Cf + C : add_le_add ((λx, hCf (mem_range_self x)) _) le_rfl
end

lemma HD_below_aux2 {f : Cb X Y} (C : ℝ) {y : Y} :
  bdd_below (range (λ (x : X), f (inl x, inr y) + C)) :=
let ⟨cf, hcf⟩ := (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).1 in
⟨cf + C, forall_range_iff.2 (λi, add_le_add_right ((λx, hcf (mem_range_self x)) _) _)⟩

private lemma HD_bound_aux2 (f : Cb X Y) (C : ℝ) :
  bdd_above (range (λ (y : Y), ⨅ x, f (inl x, inr y) + C)) :=
begin
  rcases (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).2 with ⟨Cf, hCf⟩,
  refine ⟨Cf + C, forall_range_iff.2 (λy, _)⟩,
  calc (⨅ x, f (inl x, inr y) + C) ≤ f (inl default, inr y) + C :
    cinfi_le (HD_below_aux2 C) default
  ... ≤ Cf + C : add_le_add ((λx, hCf (mem_range_self x)) _) le_rfl
end

/-- Explicit bound on `HD (dist)`. This means that when looking for minimizers it will
be sufficient to look for functions with `HD(f)` bounded by this bound. -/
lemma HD_candidates_b_dist_le :
  HD (candidates_b_dist X Y) ≤ diam (univ : set X) + 1 + diam (univ : set Y) :=
begin
  refine max_le (csupr_le (λx, _)) (csupr_le (λy, _)),
  { have A : (⨅ y, candidates_b_dist X Y (inl x, inr y)) ≤
      candidates_b_dist X Y (inl x, inr default) :=
      cinfi_le (by simpa using HD_below_aux1 0) default,
    have B : dist (inl x) (inr default) ≤ diam (univ : set X) + 1 + diam (univ : set Y) := calc
      dist (inl x) (inr (default : Y)) = dist x (default : X) + 1 + dist default default : rfl
      ... ≤ diam (univ : set X) + 1 + diam (univ : set Y) :
      begin
        apply add_le_add (add_le_add _ le_rfl),
        exact dist_le_diam_of_mem bounded_of_compact_space (mem_univ _) (mem_univ _),
        any_goals { exact ordered_add_comm_monoid.to_covariant_class_left ℝ },
        any_goals { exact ordered_add_comm_monoid.to_covariant_class_right ℝ },
        exact dist_le_diam_of_mem bounded_of_compact_space (mem_univ _) (mem_univ _),
      end,
    exact le_trans A B },
  { have A : (⨅ x, candidates_b_dist X Y (inl x, inr y)) ≤
      candidates_b_dist X Y (inl default, inr y) :=
      cinfi_le (by simpa using HD_below_aux2 0) default,
    have B : dist (inl default) (inr y) ≤ diam (univ : set X) + 1 + diam (univ : set Y) := calc
      dist (inl (default : X)) (inr y) = dist default default + 1 + dist default y : rfl
      ... ≤ diam (univ : set X) + 1 + diam (univ : set Y) :
      begin
        apply add_le_add (add_le_add _ le_rfl),
        exact dist_le_diam_of_mem bounded_of_compact_space (mem_univ _) (mem_univ _),
        any_goals { exact ordered_add_comm_monoid.to_covariant_class_left ℝ },
        any_goals { exact ordered_add_comm_monoid.to_covariant_class_right ℝ },
        exact dist_le_diam_of_mem bounded_of_compact_space (mem_univ _) (mem_univ _)
      end,
    exact le_trans A B },
end

/- To check that HD is continuous, we check that it is Lipschitz. As HD is a max, we
prove separately inequalities controlling the two terms (relying too heavily on copy-paste...) -/
private lemma HD_lipschitz_aux1 (f g : Cb X Y) :
  (⨆ x, ⨅ y, f (inl x, inr y)) ≤ (⨆ x, ⨅ y, g (inl x, inr y)) + dist f g :=
begin
  rcases (real.bounded_iff_bdd_below_bdd_above.1 g.bounded_range).1 with ⟨cg, hcg⟩,
  have Hcg : ∀ x, cg ≤ g x := λx, hcg (mem_range_self x),
  rcases (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).1 with ⟨cf, hcf⟩,
  have Hcf : ∀ x, cf ≤ f x := λx, hcf (mem_range_self x),

  -- prove the inequality but with `dist f g` inside, by using inequalities comparing
  -- supr to supr and infi to infi
  have Z : (⨆ x, ⨅ y, f (inl x, inr y)) ≤ ⨆ x, ⨅ y, g (inl x, inr y) + dist f g :=
    csupr_mono (HD_bound_aux1 _ (dist f g))
      (λx, cinfi_mono ⟨cf, forall_range_iff.2(λi, Hcf _)⟩ (λy, coe_le_coe_add_dist)),
  -- move the `dist f g` out of the infimum and the supremum, arguing that continuous monotone maps
  -- (here the addition of `dist f g`) preserve infimum and supremum
  have E1 : ∀ x, (⨅ y, g (inl x, inr y)) + dist f g = ⨅ y, g (inl x, inr y) + dist f g,
  { assume x,
    refine monotone.map_cinfi_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
    { assume x y hx, simpa },
    { show bdd_below (range (λ (y : Y), g (inl x, inr y))),
        from ⟨cg, forall_range_iff.2(λi, Hcg _)⟩ } },
  have E2 : (⨆ x, ⨅ y, g (inl x, inr y)) + dist f g = ⨆ x, (⨅ y, g (inl x, inr y)) + dist f g,
  { refine monotone.map_csupr_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
    { assume x y hx, simpa },
    { simpa using HD_bound_aux1 _ 0 } },
  -- deduce the result from the above two steps
  simpa [E2, E1, function.comp]
end

private lemma HD_lipschitz_aux2 (f g : Cb X Y) :
  (⨆ y, ⨅ x, f (inl x, inr y)) ≤ (⨆ y, ⨅ x, g (inl x, inr y)) + dist f g :=
begin
  rcases (real.bounded_iff_bdd_below_bdd_above.1 g.bounded_range).1 with ⟨cg, hcg⟩,
  have Hcg : ∀ x, cg ≤ g x := λx, hcg (mem_range_self x),
  rcases (real.bounded_iff_bdd_below_bdd_above.1 f.bounded_range).1 with ⟨cf, hcf⟩,
  have Hcf : ∀ x, cf ≤ f x := λx, hcf (mem_range_self x),

  -- prove the inequality but with `dist f g` inside, by using inequalities comparing
  -- supr to supr and infi to infi
  have Z : (⨆ y, ⨅ x, f (inl x, inr y)) ≤ ⨆ y, ⨅ x, g (inl x, inr y) + dist f g :=
    csupr_mono (HD_bound_aux2 _ (dist f g))
      (λy, cinfi_mono  ⟨cf, forall_range_iff.2(λi, Hcf _)⟩ (λy, coe_le_coe_add_dist)),
  -- move the `dist f g` out of the infimum and the supremum, arguing that continuous monotone maps
  -- (here the addition of `dist f g`) preserve infimum and supremum
  have E1 : ∀ y, (⨅ x, g (inl x, inr y)) + dist f g = ⨅ x, g (inl x, inr y) + dist f g,
  { assume y,
    refine monotone.map_cinfi_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
    { assume x y hx, simpa },
    { show bdd_below (range (λx:X, g (inl x, inr y))),
        from ⟨cg, forall_range_iff.2 (λi, Hcg _)⟩ } },
  have E2 : (⨆ y, ⨅ x, g (inl x, inr y)) + dist f g = ⨆ y, (⨅ x, g (inl x, inr y)) + dist f g,
  { refine monotone.map_csupr_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
    { assume x y hx, simpa },
    { simpa using HD_bound_aux2 _ 0 } },
  -- deduce the result from the above two steps
  simpa [E2, E1]
end

private lemma HD_lipschitz_aux3 (f g : Cb X Y) : HD f ≤ HD g + dist f g :=
max_le (le_trans (HD_lipschitz_aux1 f g) (add_le_add_right (le_max_left _ _) _))
       (le_trans (HD_lipschitz_aux2 f g) (add_le_add_right (le_max_right _ _) _))

/-- Conclude that HD, being Lipschitz, is continuous -/
private lemma HD_continuous : continuous (HD : Cb X Y → ℝ) :=
lipschitz_with.continuous (lipschitz_with.of_le_add HD_lipschitz_aux3)

end constructions --section

section consequences
variables (X : Type u) (Y : Type v) [metric_space X] [compact_space X] [nonempty X] [metric_space Y]
  [compact_space Y] [nonempty Y]

/- Now that we have proved that the set of candidates is compact, and that HD is continuous,
we can finally select a candidate minimizing HD. This will be the candidate realizing the
optimal coupling. -/
private lemma exists_minimizer : ∃ f ∈ candidates_b X Y, ∀ g ∈ candidates_b X Y, HD f ≤ HD g :=
is_compact_candidates_b.exists_forall_le candidates_b_nonempty HD_continuous.continuous_on

private definition optimal_GH_dist : Cb X Y := classical.some (exists_minimizer X Y)

private lemma optimal_GH_dist_mem_candidates_b : optimal_GH_dist X Y ∈ candidates_b X Y :=
by cases (classical.some_spec (exists_minimizer X Y)); assumption

private lemma HD_optimal_GH_dist_le (g : Cb X Y) (hg : g ∈ candidates_b X Y) :
  HD (optimal_GH_dist X Y) ≤ HD g :=
let ⟨Z1, Z2⟩ := classical.some_spec (exists_minimizer X Y) in Z2 g hg

/-- With the optimal candidate, construct a premetric space structure on `X ⊕ Y`, on which the
predistance is given by the candidate. Then, we will identify points at `0` predistance
to obtain a genuine metric space -/
def premetric_optimal_GH_dist : pseudo_metric_space (X ⊕ Y) :=
{ dist := λp q, optimal_GH_dist X Y (p, q),
  dist_self := λx, candidates_refl (optimal_GH_dist_mem_candidates_b X Y),
  dist_comm := λx y, candidates_symm (optimal_GH_dist_mem_candidates_b X Y),
  dist_triangle := λx y z, candidates_triangle (optimal_GH_dist_mem_candidates_b X Y) }

local attribute [instance] premetric_optimal_GH_dist

/-- A metric space which realizes the optimal coupling between `X` and `Y` -/
@[derive metric_space, nolint has_nonempty_instance]
definition optimal_GH_coupling : Type* :=
@uniform_space.separation_quotient (X ⊕ Y) (premetric_optimal_GH_dist X Y).to_uniform_space

/-- Injection of `X` in the optimal coupling between `X` and `Y` -/
def optimal_GH_injl (x : X) : optimal_GH_coupling X Y := quotient.mk' (inl x)

/-- The injection of `X` in the optimal coupling between `X` and `Y` is an isometry. -/
lemma isometry_optimal_GH_injl : isometry (optimal_GH_injl X Y) :=
isometry.of_dist_eq $ λ x y, candidates_dist_inl (optimal_GH_dist_mem_candidates_b X Y) _ _

/-- Injection of `Y` in the optimal coupling between `X` and `Y` -/
def optimal_GH_injr (y : Y) : optimal_GH_coupling X Y := quotient.mk' (inr y)

/-- The injection of `Y` in the optimal coupling between `X` and `Y` is an isometry. -/
lemma isometry_optimal_GH_injr : isometry (optimal_GH_injr X Y) :=
isometry.of_dist_eq $ λ x y, candidates_dist_inr (optimal_GH_dist_mem_candidates_b X Y) _ _

/-- The optimal coupling between two compact spaces `X` and `Y` is still a compact space -/
instance compact_space_optimal_GH_coupling : compact_space (optimal_GH_coupling X Y) :=
⟨begin
  rw [← range_quotient_mk'],
  exact is_compact_range (continuous_sum_dom.2 ⟨(isometry_optimal_GH_injl X Y).continuous,
    (isometry_optimal_GH_injr X Y).continuous⟩)
end⟩

/-- For any candidate `f`, `HD(f)` is larger than or equal to the Hausdorff distance in the
optimal coupling. This follows from the fact that HD of the optimal candidate is exactly
the Hausdorff distance in the optimal coupling, although we only prove here the inequality
we need. -/
lemma Hausdorff_dist_optimal_le_HD {f} (h : f ∈ candidates_b X Y) :
  Hausdorff_dist (range (optimal_GH_injl X Y)) (range (optimal_GH_injr X Y)) ≤ HD f :=
begin
  refine le_trans (le_of_forall_le_of_dense (λ r hr, _)) (HD_optimal_GH_dist_le X Y f h),
  have A : ∀ x ∈ range (optimal_GH_injl X Y), ∃ y ∈ range (optimal_GH_injr X Y), dist x y ≤ r,
  { rintro _ ⟨z, rfl⟩,
    have I1 : (⨆ x, ⨅ y, optimal_GH_dist X Y (inl x, inr y)) < r :=
      lt_of_le_of_lt (le_max_left _ _) hr,
    have I2 : (⨅ y, optimal_GH_dist X Y (inl z, inr y)) ≤
        ⨆ x, ⨅ y, optimal_GH_dist X Y (inl x, inr y) :=
      le_cSup (by simpa using HD_bound_aux1 _ 0) (mem_range_self _),
    have I : (⨅ y, optimal_GH_dist X Y (inl z, inr y)) < r := lt_of_le_of_lt I2 I1,
    rcases exists_lt_of_cInf_lt (range_nonempty _) I with ⟨r', ⟨z', rfl⟩, hr'⟩,
    exact ⟨optimal_GH_injr X Y z', mem_range_self _, le_of_lt hr'⟩ },
  refine Hausdorff_dist_le_of_mem_dist _ A _,
  { inhabit X,
    rcases A _ (mem_range_self default) with ⟨y, -, hy⟩,
    exact le_trans dist_nonneg hy },
  { rintro _ ⟨z, rfl⟩,
    have I1 : (⨆ y, ⨅ x, optimal_GH_dist X Y (inl x, inr y)) < r :=
      lt_of_le_of_lt (le_max_right _ _) hr,
    have I2 : (⨅ x, optimal_GH_dist X Y (inl x, inr z)) ≤
        ⨆ y, ⨅ x, optimal_GH_dist X Y (inl x, inr y) :=
      le_cSup (by simpa using HD_bound_aux2 _ 0) (mem_range_self _),
    have I : (⨅ x, optimal_GH_dist X Y (inl x, inr z)) < r := lt_of_le_of_lt I2 I1,
    rcases exists_lt_of_cInf_lt (range_nonempty _) I with ⟨r', ⟨z', rfl⟩, hr'⟩,
    refine ⟨optimal_GH_injl X Y z', mem_range_self _, le_of_lt _⟩,
    rwa dist_comm }
end

end consequences
/- We are done with the construction of the optimal coupling -/
end Gromov_Hausdorff_realized

end Gromov_Hausdorff


-- Calcular el n-ésimo número primo.

import data.nat.prime
open nat

def ith_prime : ℕ → ℕ
| 0       := 2
| (i + 1) := nat.find (exists_infinite_primes $ ith_prime i + 1)

-- #eval ith_prime 4

-- Ver https://bit.ly/3aV0Vhs

-- ------------------------------------------------------------------------

def find_prime : ℕ → ℕ → ℕ
| 0 n     := 0
| (i+1) n := by haveI := decidable_prime_1 n;
                exact if nat.prime n then n else find_prime i (n+1)

def ith_prime2 : ℕ → ℕ
| 0 := 2
| (i + 1) := let n := ith_prime2 i in find_prime n (n+1)

example : ith_prime2 4 = 11 := dec_trivial


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

Examples from the tutorial.
-/
import tactic.finish
open auto

section
variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by finish
example : p ∨ q ↔ q ∨ p := by finish

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by finish
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by finish

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by finish [iff_def]
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by finish [iff_def]

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := by finish [iff_def]
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by finish [iff_def]
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by finish
example : ¬p ∨ ¬q → ¬(p ∧ q) := by finish
example : ¬(p ∧ ¬ p) := by finish
example : p ∧ ¬q → ¬(p → q) := by finish
example : ¬p → (p → q) := by finish
example : (¬p ∨ q) → (p → q) := by finish
example : p ∨ false ↔ p := by finish
example : p ∧ false ↔ false := by finish
example : ¬(p ↔ ¬p) := by finish
example : (p → q) → (¬q → ¬p) := by finish

-- these require classical reasoning
example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := by finish
example : ¬(p ∧ q) → ¬p ∨ ¬q := by finish
example : ¬(p → q) → p ∧ ¬q := by finish
example : (p → q) → (¬p ∨ q) := by finish
example : (¬q → ¬p) → (p → q) := by finish
example : p ∨ ¬p := by finish
example : (((p → q) → p) → p) := by finish
end

section

variables (A : Type) (p q : A → Prop)
variable a : A
variable r : Prop

example : (∃ x : A, r) → r := by finish
-- TODO(Jeremy): can we get these automatically?
example (a : A) : r → (∃ x : A, r) := begin safe; apply a_2; assumption end
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := by finish

theorem foo': (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
by finish [iff_def]

example (h : ∀ x, ¬ ¬ p x) : p a := by finish
example (h : ∀ x, ¬ ¬ p x) : ∀ x, p x := by finish

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := by finish

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := by finish
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := by finish
example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := by finish
example : (∃ x, ¬ p x) → (¬ ∀ x, p x) := by finish

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := by finish [iff_def]
-- TODO(Jeremy): can we get these automatically?
example (a : A) : (∃ x, p x → r) ↔ (∀ x, p x) → r := begin safe [iff_def]; exact h a end
example (a : A) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := begin safe [iff_def]; exact h a end

example : (∃ x, p x → r) → (∀ x, p x) → r := by finish
example : (∃ x, r → p x) → (r → ∃ x, p x) := by finish

end


open list

-- Exercise: 1 star (snd_fst_is_swap)
def swap : ℕ × ℕ → ℕ × ℕ
| (a, b) := (b, a)

lemma snd_fst_is_swap : ∀ p : ℕ × ℕ, (p.snd, p.fst) = swap p
| (a, b) := rfl

-- Exercise: 1 star, optional (fst_swap_is_snd)
theorem fst_swap_is_snd : ∀ p : ℕ × ℕ, (swap p).fst = p.snd
| (a, b) := rfl

-- Exercise: 2 stars, recommended (list_funs)
def nonzeros : list ℕ → list ℕ
| nil := nil
| (cons x xs) := if x ≠ 0 then [x] ++ nonzeros xs else nonzeros xs

lemma test_nonzeros : nonzeros [0, 1, 0, 2, 3, 0, 0] = [1, 2, 3] := rfl

def oddmembers : list ℕ → list ℕ
| nil := nil
| (cons x xs) := if nat.bodd x then [x] ++ oddmembers xs else oddmembers xs

lemma test_oddmembers : oddmembers [0, 1, 0, 2, 3, 0, 0] = [1, 3] := rfl

def countoddmembers (l : list ℕ) : ℕ := length (oddmembers l)

lemma test_countoddmembers1 : countoddmembers [1, 0, 3, 1, 4, 5] = 4 := rfl
lemma test_countoddmembers2 : countoddmembers [0, 2, 4] = 0 := rfl
lemma test_countoddmembers3 : countoddmembers nil = 0 := rfl

-- Exercise: 3 stars, advanced (alternate)
def alternate : list ℕ → list ℕ → list ℕ
| [] [] := []
| [] (y :: ys) := [y] ++ alternate [] ys
| (x :: xs) [] := [x] ++ alternate xs []
| (x :: xs) (y :: ys) := [x, y] ++ alternate xs ys

lemma test_alternate1 : alternate [1,2,3] [4,5,6] = [1,4,2,5,3,6] := rfl
lemma test_alternate2 : alternate [1] [4, 5, 6] = [1,4,5,6] := rfl
lemma test_alternate3 : alternate [1,2,3] [4] = [1,4,2,3] := rfl
lemma test_alternate4 : alternate [] [20,30] = [20, 30] := rfl

-- Exercise: 3 stars, recommended (bag_functions)
def bag : Type := list ℕ

def count : ℕ → bag → ℕ
| n [] := 0
| n (x::xs) := if x = n then 1 + count n xs else count n xs

lemma test_count1 : count 1 [1,2,3,1,4,1] = 3 := rfl
lemma test_count2 : count 6 [1,2,3,1,4,1] = 0 := rfl

def bag.sum : bag → bag → bag := λ a b, @list.append ℕ a b

lemma test_sum1 : count 1 (bag.sum [1,2,3] [1,4,1]) = 3 := rfl

def bag.add : ℕ → bag → bag := λ a b, list.append b [a]

lemma test_add1 : count 1 (bag.add 1 [1,4,1]) = 3 := rfl
lemma test_add2 : count 5 (bag.add 1 [1,4,1]) = 0 := rfl

def bag.mem : ℕ → bag → bool
| n [] := ff
| n (x::xs) := if n = x then tt else bag.mem n xs

lemma test_mem1 : bag.mem 1 [1,4,1] = tt := rfl
lemma test_mem2 : bag.mem 2 [1,4,1] = ff := rfl

-- Exercise: 3 stars, optional (bag_more_functions)
def remove_one : ℕ → bag → bag
| n [] := []
| n (x::xs) := if n = x then xs else x :: (remove_one n xs)

lemma test_remove_one1 : count 5 (remove_one 5 [2,1,5,4,1]) = 0 := rfl
lemma test_remove_one2 : count 5 (remove_one 5 [2,1,4,1]) = 0 := rfl
lemma test_remove_one3 : count 4 (remove_one 5 [2,1,4,5,1,4]) = 2 :=  rfl
lemma test_remove_one4 : count 5 (remove_one 5 [2,1,5,4,5,1,4]) = 1 := rfl

def remove_all : ℕ → bag → bag
| n [] := []
| n (x::xs) := if n = x then remove_all n xs else x :: remove_all n xs

lemma test_remove_all1 : count 5 (remove_all 5 [2,1,5,4,1]) = 0 := rfl
lemma test_remove_all2 : count 5 (remove_all 5 [2,1,4,1]) = 0 := rfl
lemma test_remove_all3 : count 4 (remove_all 5 [2,1,4,5,1,4]) = 2 := rfl
lemma test_remove_all4 :
  count 5 (remove_all 5 [2,1,5,4,5,1,4,5,1,4]) = 0 := rfl

def bag.subset : bag → bag → bool
| [] [] := tt
| [] (y::ys) := tt
| (x::xs) [] := ff
| (x::xs) y := if bag.mem x y then bag.subset xs (remove_one x y) else ff

lemma test_subset1 : bag.subset [1,2] [2,1,4,1] = tt := rfl
lemma test_subset2 : bag.subset [1,2,2] [2,1,4,1] = ff := rfl

-- Exercise: 4 stars, advanced (rev_injective)
def rev : list ℕ → list ℕ
| nil := nil
| (x::xs) := (rev xs) ++ [x]

lemma test_rev1 : rev [3,2,1] = [1,2,3] := rfl
lemma test_rev2 : rev [] = [] := rfl

lemma rev_step : ∀ (hd : ℕ) (tl : list ℕ), rev (hd :: tl) = rev tl ++ [hd] :=
by intros; refl

lemma rev_distrib : ∀ l1 l2 : list ℕ, rev (l1 ++ l2) = rev l2 ++ rev l1 :=
begin
  intros,
  induction l1 with x xs ihl1,
    induction l2 with y ys ihl2,
      refl,
      simp [rev],
    induction l2 with y ys ihl2,
      simp [rev],
      { simp [rev],
        rw [ihl1, rev_step, ←cons_append],
        simp * }
end

lemma rev_involutive : ∀ l : list ℕ, rev (rev l) = l
| nil := rfl
| (x::xs) := by simp [*, rev, rev_step, rev_distrib]

lemma rev_nil : rev nil = nil := rfl
lemma rev_singleton : ∀ n : ℕ, rev [n] = [n] := λ n, rfl

lemma ceqa (hd : ℕ) (tl : list ℕ) : hd :: tl = [hd] ++ tl := rfl

theorem rev_injective : function.injective rev :=
λ a b h, by rw [←rev_involutive a, ←rev_involutive b, h]