/-
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

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

/-!
# Metric space gluing

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

Gluing two metric spaces along a common subset. Formally, we are given

```
     Φ
  Z ---> X
  |
  |Ψ
  v
  Y
```
where `hΦ : isometry Φ` and `hΨ : isometry Ψ`.
We want to complete the square by a space `glue_space hΦ hΨ` and two isometries
`to_glue_l hΦ hΨ` and `to_glue_r hΦ hΨ` that make the square commute.
We start by defining a predistance on the disjoint union `X ⊕ Y`, for which
points `Φ p` and `Ψ p` are at distance 0. The (quotient) metric space associated
to this predistance is the desired space.

This is an instance of a more general construction, where `Φ` and `Ψ` do not have to be isometries,
but the distances in the image almost coincide, up to `2ε` say. Then one can almost glue the two
spaces so that the images of a point under `Φ` and `Ψ` are `ε`-close. If `ε > 0`, this yields a
metric space structure on `X ⊕ Y`, without the need to take a quotient. In particular,
this gives a natural metric space structure on `X ⊕ Y`, where the basepoints
are at distance 1, say, and the distances between other points are obtained by going through the two
basepoints.
(We also register the same metric space structure on a general disjoint union `Σ i, E i`).

We also define the inductive limit of metric spaces. Given
```
     f 0        f 1        f 2        f 3
X 0 -----> X 1 -----> X 2 -----> X 3 -----> ...
```
where the `X n` are metric spaces and `f n` isometric embeddings, we define the inductive
limit of the `X n`, also known as the increasing union of the `X n` in this context, if we
identify `X n` and `X (n+1)` through `f n`. This is a metric space in which all `X n` embed
isometrically and in a way compatible with `f n`.

-/

noncomputable section

universe u v w

open Function Set

open uniformity

namespace Metric

section ApproxGluing

variable {X : Type u} {Y : Type v} {Z : Type w}

variable [MetricSpace X] [MetricSpace Y] {Φ : Z → X} {Ψ : Z → Y} {ε : ℝ}

open _Root_.Sum (inl inr)

#print Metric.glueDist /-
/-- Define a predistance on `X ⊕ Y`, for which `Φ p` and `Ψ p` are at distance `ε` -/
def glueDist (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) : Sum X Y → Sum X Y → ℝ
  | inl x, inl y => dist x y
  | inr x, inr y => dist x y
  | inl x, inr y => (⨅ p, dist x (Φ p) + dist y (Ψ p)) + ε
  | inr x, inl y => (⨅ p, dist y (Φ p) + dist x (Ψ p)) + ε
#align metric.glue_dist Metric.glueDist
-/

private theorem glue_dist_self (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) : ∀ x, glueDist Φ Ψ ε x x = 0
  | inl x => dist_self _
  | inr x => dist_self _
#align metric.glue_dist_self metric.glue_dist_self

#print Metric.glueDist_glued_points /-
theorem glueDist_glued_points [Nonempty Z] (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (p : Z) :
    glueDist Φ Ψ ε (inl (Φ p)) (inr (Ψ p)) = ε :=
  by
  have : (⨅ q, dist (Φ p) (Φ q) + dist (Ψ p) (Ψ q)) = 0 :=
    by
    have A : ∀ q, 0 ≤ dist (Φ p) (Φ q) + dist (Ψ p) (Ψ q) := fun q => by
      rw [← add_zero (0 : ℝ)] <;> exact add_le_add dist_nonneg dist_nonneg
    refine' le_antisymm _ (le_cinfᵢ A)
    have : 0 = dist (Φ p) (Φ p) + dist (Ψ p) (Ψ p) := by simp
    rw [this]
    exact cinfᵢ_le ⟨0, forall_range_iff.2 A⟩ p
  rw [glue_dist, this, zero_add]
#align metric.glue_dist_glued_points Metric.glueDist_glued_points
-/

private theorem glue_dist_comm (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) :
    ∀ x y, glueDist Φ Ψ ε x y = glueDist Φ Ψ ε y x
  | inl x, inl y => dist_comm _ _
  | inr x, inr y => dist_comm _ _
  | inl x, inr y => rfl
  | inr x, inl y => rfl
#align metric.glue_dist_comm metric.glue_dist_comm

variable [Nonempty Z]

private theorem glue_dist_triangle (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
    (H : ∀ p q, |dist (Φ p) (Φ q) - dist (Ψ p) (Ψ q)| ≤ 2 * ε) :
    ∀ x y z, glueDist Φ Ψ ε x z ≤ glueDist Φ Ψ ε x y + glueDist Φ Ψ ε y z
  | inl x, inl y, inl z => dist_triangle _ _ _
  | inr x, inr y, inr z => dist_triangle _ _ _
  | inr x, inl y, inl z =>
    by
    have B : ∀ a b, BddBelow (range fun p : Z => dist a (Φ p) + dist b (Ψ p)) := fun a b =>
      ⟨0, forall_range_iff.2 fun p => add_nonneg dist_nonneg dist_nonneg⟩
    unfold glue_dist
    have : (⨅ p, dist z (Φ p) + dist x (Ψ p)) ≤ (⨅ p, dist y (Φ p) + dist x (Ψ p)) + dist y z :=
      by
      have :
        (⨅ p, dist y (Φ p) + dist x (Ψ p)) + dist y z =
          infᵢ ((fun t => t + dist y z) ∘ fun p => dist y (Φ p) + dist x (Ψ p)) :=
        by
        refine'
          Monotone.map_cinfᵢ_of_continuousAt (continuous_at_id.add continuousAt_const) _ (B _ _)
        intro x y hx
        simpa
      rw [this, comp]
      refine' cinfᵢ_mono (B _ _) fun p => _
      calc
        dist z (Φ p) + dist x (Ψ p) ≤ dist y z + dist y (Φ p) + dist x (Ψ p) :=
          add_le_add (dist_triangle_left _ _ _) le_rfl
        _ = dist y (Φ p) + dist x (Ψ p) + dist y z := by ring

    linarith
  | inr x, inr y, inl z =>
    by
    have B : ∀ a b, BddBelow (range fun p : Z => dist a (Φ p) + dist b (Ψ p)) := fun a b =>
      ⟨0, forall_range_iff.2 fun p => add_nonneg dist_nonneg dist_nonneg⟩
    unfold glue_dist
    have : (⨅ p, dist z (Φ p) + dist x (Ψ p)) ≤ dist x y + ⨅ p, dist z (Φ p) + dist y (Ψ p) :=
      by
      have :
        (dist x y + ⨅ p, dist z (Φ p) + dist y (Ψ p)) =
          infᵢ ((fun t => dist x y + t) ∘ fun p => dist z (Φ p) + dist y (Ψ p)) :=
        by
        refine'
          Monotone.map_cinfᵢ_of_continuousAt (continuous_at_const.add continuousAt_id) _ (B _ _)
        intro x y hx
        simpa
      rw [this, comp]
      refine' cinfᵢ_mono (B _ _) fun p => _
      calc
        dist z (Φ p) + dist x (Ψ p) ≤ dist z (Φ p) + (dist x y + dist y (Ψ p)) :=
          add_le_add le_rfl (dist_triangle _ _ _)
        _ = dist x y + (dist z (Φ p) + dist y (Ψ p)) := by ring

    linarith
  | inl x, inl y, inr z =>
    by
    have B : ∀ a b, BddBelow (range fun p : Z => dist a (Φ p) + dist b (Ψ p)) := fun a b =>
      ⟨0, forall_range_iff.2 fun p => add_nonneg dist_nonneg dist_nonneg⟩
    unfold glue_dist
    have : (⨅ p, dist x (Φ p) + dist z (Ψ p)) ≤ dist x y + ⨅ p, dist y (Φ p) + dist z (Ψ p) :=
      by
      have :
        (dist x y + ⨅ p, dist y (Φ p) + dist z (Ψ p)) =
          infᵢ ((fun t => dist x y + t) ∘ fun p => dist y (Φ p) + dist z (Ψ p)) :=
        by
        refine'
          Monotone.map_cinfᵢ_of_continuousAt (continuous_at_const.add continuousAt_id) _ (B _ _)
        intro x y hx
        simpa
      rw [this, comp]
      refine' cinfᵢ_mono (B _ _) fun p => _
      calc
        dist x (Φ p) + dist z (Ψ p) ≤ dist x y + dist y (Φ p) + dist z (Ψ p) :=
          add_le_add (dist_triangle _ _ _) le_rfl
        _ = dist x y + (dist y (Φ p) + dist z (Ψ p)) := by ring

    linarith
  | inl x, inr y, inr z =>
    by
    have B : ∀ a b, BddBelow (range fun p : Z => dist a (Φ p) + dist b (Ψ p)) := fun a b =>
      ⟨0, forall_range_iff.2 fun p => add_nonneg dist_nonneg dist_nonneg⟩
    unfold glue_dist
    have : (⨅ p, dist x (Φ p) + dist z (Ψ p)) ≤ (⨅ p, dist x (Φ p) + dist y (Ψ p)) + dist y z :=
      by
      have :
        (⨅ p, dist x (Φ p) + dist y (Ψ p)) + dist y z =
          infᵢ ((fun t => t + dist y z) ∘ fun p => dist x (Φ p) + dist y (Ψ p)) :=
        by
        refine'
          Monotone.map_cinfᵢ_of_continuousAt (continuous_at_id.add continuousAt_const) _ (B _ _)
        intro x y hx
        simpa
      rw [this, comp]
      refine' cinfᵢ_mono (B _ _) fun p => _
      calc
        dist x (Φ p) + dist z (Ψ p) ≤ dist x (Φ p) + (dist y z + dist y (Ψ p)) :=
          add_le_add le_rfl (dist_triangle_left _ _ _)
        _ = dist x (Φ p) + dist y (Ψ p) + dist y z := by ring

    linarith
  | inl x, inr y, inl z =>
    le_of_forall_pos_le_add fun δ δpos =>
      by
      obtain ⟨p, hp⟩ : ∃ p, dist x (Φ p) + dist y (Ψ p) < (⨅ p, dist x (Φ p) + dist y (Ψ p)) + δ / 2
      exact exists_lt_of_cinfᵢ_lt (by linarith)
      obtain ⟨q, hq⟩ : ∃ q, dist z (Φ q) + dist y (Ψ q) < (⨅ p, dist z (Φ p) + dist y (Ψ p)) + δ / 2
      exact exists_lt_of_cinfᵢ_lt (by linarith)
      have : dist (Φ p) (Φ q) ≤ dist (Ψ p) (Ψ q) + 2 * ε :=
        by
        have := le_trans (le_abs_self _) (H p q)
        · linarith
      calc
        dist x z ≤ dist x (Φ p) + dist (Φ p) (Φ q) + dist (Φ q) z := dist_triangle4 _ _ _ _
        _ ≤ dist x (Φ p) + dist (Ψ p) (Ψ q) + dist z (Φ q) + 2 * ε := by
          rw [dist_comm z] <;> linarith
        _ ≤ dist x (Φ p) + (dist y (Ψ p) + dist y (Ψ q)) + dist z (Φ q) + 2 * ε :=
          (add_le_add (add_le_add (add_le_add le_rfl (dist_triangle_left _ _ _)) le_rfl) le_rfl)
        _ ≤ (⨅ p, dist x (Φ p) + dist y (Ψ p)) + ε + ((⨅ p, dist z (Φ p) + dist y (Ψ p)) + ε) + δ :=
          by linarith

  | inr x, inl y, inr z =>
    le_of_forall_pos_le_add fun δ δpos =>
      by
      obtain ⟨p, hp⟩ : ∃ p, dist y (Φ p) + dist x (Ψ p) < (⨅ p, dist y (Φ p) + dist x (Ψ p)) + δ / 2
      exact exists_lt_of_cinfᵢ_lt (by linarith)
      obtain ⟨q, hq⟩ : ∃ q, dist y (Φ q) + dist z (Ψ q) < (⨅ p, dist y (Φ p) + dist z (Ψ p)) + δ / 2
      exact exists_lt_of_cinfᵢ_lt (by linarith)
      have : dist (Ψ p) (Ψ q) ≤ dist (Φ p) (Φ q) + 2 * ε :=
        by
        have := le_trans (neg_le_abs_self _) (H p q)
        · linarith
      calc
        dist x z ≤ dist x (Ψ p) + dist (Ψ p) (Ψ q) + dist (Ψ q) z := dist_triangle4 _ _ _ _
        _ ≤ dist x (Ψ p) + dist (Φ p) (Φ q) + dist z (Ψ q) + 2 * ε := by
          rw [dist_comm z] <;> linarith
        _ ≤ dist x (Ψ p) + (dist y (Φ p) + dist y (Φ q)) + dist z (Ψ q) + 2 * ε :=
          (add_le_add (add_le_add (add_le_add le_rfl (dist_triangle_left _ _ _)) le_rfl) le_rfl)
        _ ≤ (⨅ p, dist y (Φ p) + dist x (Ψ p)) + ε + ((⨅ p, dist y (Φ p) + dist z (Ψ p)) + ε) + δ :=
          by linarith

#align metric.glue_dist_triangle metric.glue_dist_triangle

private theorem glue_eq_of_dist_eq_zero (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (ε0 : 0 < ε) :
    ∀ p q : Sum X Y, glueDist Φ Ψ ε p q = 0 → p = q
  | inl x, inl y, h => by rw [eq_of_dist_eq_zero h]
  | inl x, inr y, h =>
    by
    have : 0 ≤ ⨅ p, dist x (Φ p) + dist y (Ψ p) :=
      le_cinfᵢ fun p => by simpa using add_le_add (@dist_nonneg _ _ x _) (@dist_nonneg _ _ y _)
    have : 0 + ε ≤ glue_dist Φ Ψ ε (inl x) (inr y) := add_le_add this (le_refl ε)
    exfalso
    linarith
  | inr x, inl y, h =>
    by
    have : 0 ≤ ⨅ p, dist y (Φ p) + dist x (Ψ p) :=
      le_cinfᵢ fun p => by
        simpa [add_comm] using add_le_add (@dist_nonneg _ _ x _) (@dist_nonneg _ _ y _)
    have : 0 + ε ≤ glue_dist Φ Ψ ε (inr x) (inl y) := add_le_add this (le_refl ε)
    exfalso
    linarith
  | inr x, inr y, h => by rw [eq_of_dist_eq_zero h]
#align metric.glue_eq_of_dist_eq_zero metric.glue_eq_of_dist_eq_zero

/- warning: metric.glue_metric_approx -> Metric.glueMetricApprox is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] [_inst_3 : Nonempty.{succ u3} Z] (Φ : Z -> X) (Ψ : Z -> Y) (ε : Real), (LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) ε) -> (forall (p : Z) (q : Z), LE.le.{0} Real Real.hasLe (Abs.abs.{0} Real (Neg.toHasAbs.{0} Real Real.hasNeg Real.hasSup) (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.hasSub) (Dist.dist.{u1} X (PseudoMetricSpace.toHasDist.{u1} X (MetricSpace.toPseudoMetricSpace.{u1} X _inst_1)) (Φ p) (Φ q)) (Dist.dist.{u2} Y (PseudoMetricSpace.toHasDist.{u2} Y (MetricSpace.toPseudoMetricSpace.{u2} Y _inst_2)) (Ψ p) (Ψ q)))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.hasMul) (OfNat.ofNat.{0} Real 2 (OfNat.mk.{0} Real 2 (bit0.{0} Real Real.hasAdd (One.one.{0} Real Real.hasOne)))) ε)) -> (MetricSpace.{max u1 u2} (Sum.{u1, u2} X Y))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] [_inst_3 : Nonempty.{succ u3} Z] (Φ : Z -> X) (Ψ : Z -> Y) (ε : Real), (LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) ε) -> (forall (p : Z) (q : Z), LE.le.{0} Real Real.instLEReal (Abs.abs.{0} Real (Neg.toHasAbs.{0} Real Real.instNegReal Real.instSupReal) (HSub.hSub.{0, 0, 0} Real Real Real (instHSub.{0} Real Real.instSubReal) (Dist.dist.{u1} X (PseudoMetricSpace.toDist.{u1} X (MetricSpace.toPseudoMetricSpace.{u1} X _inst_1)) (Φ p) (Φ q)) (Dist.dist.{u2} Y (PseudoMetricSpace.toDist.{u2} Y (MetricSpace.toPseudoMetricSpace.{u2} Y _inst_2)) (Ψ p) (Ψ q)))) (HMul.hMul.{0, 0, 0} Real Real Real (instHMul.{0} Real Real.instMulReal) (OfNat.ofNat.{0} Real 2 (instOfNat.{0} Real 2 Real.natCast (instAtLeastTwoHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))))) ε)) -> (MetricSpace.{max u2 u1} (Sum.{u1, u2} X Y))
Case conversion may be inaccurate. Consider using '#align metric.glue_metric_approx Metric.glueMetricApproxₓ'. -/
/-- Given two maps `Φ` and `Ψ` intro metric spaces `X` and `Y` such that the distances between
`Φ p` and `Φ q`, and between `Ψ p` and `Ψ q`, coincide up to `2 ε` where `ε > 0`, one can almost
glue the two spaces `X` and `Y` along the images of `Φ` and `Ψ`, so that `Φ p` and `Ψ p` are
at distance `ε`. -/
def glueMetricApprox (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ) (ε0 : 0 < ε)
    (H : ∀ p q, |dist (Φ p) (Φ q) - dist (Ψ p) (Ψ q)| ≤ 2 * ε) : MetricSpace (Sum X Y)
    where
  dist := glueDist Φ Ψ ε
  dist_self := glueDist_self Φ Ψ ε
  dist_comm := glueDist_comm Φ Ψ ε
  dist_triangle := glueDist_triangle Φ Ψ ε H
  eq_of_dist_eq_zero := glue_eq_of_dist_eq_zero Φ Ψ ε ε0
#align metric.glue_metric_approx Metric.glueMetricApprox

end ApproxGluing

section Sum

/- A particular case of the previous construction is when one uses basepoints in `X` and `Y` and one
glues only along the basepoints, putting them at distance 1. We give a direct definition of
the distance, without infi, as it is easier to use in applications, and show that it is equal to
the gluing distance defined above to take advantage of the lemmas we have already proved. -/
variable {X : Type u} {Y : Type v} {Z : Type w}

variable [MetricSpace X] [MetricSpace Y]

open Sum (inl inr)

#print Metric.Sum.dist /-
/-- Distance on a disjoint union. There are many (noncanonical) ways to put a distance compatible
with each factor.
If the two spaces are bounded, one can say for instance that each point in the first is at distance
`diam X + diam Y + 1` of each point in the second.
Instead, we choose a construction that works for unbounded spaces, but requires basepoints,
chosen arbitrarily.
We embed isometrically each factor, set the basepoints at distance 1,
arbitrarily, and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
def Sum.dist : Sum X Y → Sum X Y → ℝ
  | inl a, inl a' => dist a a'
  | inr b, inr b' => dist b b'
  | inl a, inr b => dist a (Nonempty.some ⟨a⟩) + 1 + dist (Nonempty.some ⟨b⟩) b
  | inr b, inl a => dist b (Nonempty.some ⟨b⟩) + 1 + dist (Nonempty.some ⟨a⟩) a
#align metric.sum.dist Metric.Sum.dist
-/

/- warning: metric.sum.dist_eq_glue_dist -> Metric.Sum.dist_eq_glueDist is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] {p : Sum.{u1, u2} X Y} {q : Sum.{u1, u2} X Y} (x : X) (y : Y), Eq.{1} Real (Metric.Sum.dist.{u1, u2} X Y _inst_1 _inst_2 p q) (Metric.glueDist.{u1, u2, 0} X Y Unit _inst_1 _inst_2 (fun (_x : Unit) => Nonempty.some.{succ u1} X (Nonempty.intro.{succ u1} X x)) (fun (_x : Unit) => Nonempty.some.{succ u2} Y (Nonempty.intro.{succ u2} Y y)) (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) p q)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] {p : Sum.{u1, u2} X Y} {q : Sum.{u1, u2} X Y} (x : X) (y : Y), Eq.{1} Real (Metric.Sum.dist.{u1, u2} X Y _inst_1 _inst_2 p q) (Metric.glueDist.{u1, u2, 0} X Y Unit _inst_1 _inst_2 (fun (_x : Unit) => Nonempty.some.{succ u1} X (Nonempty.intro.{succ u1} X x)) (fun (_x : Unit) => Nonempty.some.{succ u2} Y (Nonempty.intro.{succ u2} Y y)) (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) p q)
Case conversion may be inaccurate. Consider using '#align metric.sum.dist_eq_glue_dist Metric.Sum.dist_eq_glueDistₓ'. -/
theorem Sum.dist_eq_glueDist {p q : Sum X Y} (x : X) (y : Y) :
    Sum.dist p q =
      glueDist (fun _ : Unit => Nonempty.some ⟨x⟩) (fun _ : Unit => Nonempty.some ⟨y⟩) 1 p q :=
  by
  cases p <;> cases q <;> first |rfl|simp [sum.dist, glue_dist, dist_comm, add_comm, add_left_comm]
#align metric.sum.dist_eq_glue_dist Metric.Sum.dist_eq_glueDist

private theorem sum.dist_comm (x y : Sum X Y) : Sum.dist x y = Sum.dist y x := by
  cases x <;> cases y <;> simp only [sum.dist, dist_comm, add_comm, add_left_comm]
#align metric.sum.dist_comm metric.sum.dist_comm

/- warning: metric.sum.one_dist_le -> Metric.Sum.one_le_dist_inl_inr is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] {x : X} {y : Y}, LE.le.{0} Real Real.hasLe (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) (Metric.Sum.dist.{u1, u2} X Y _inst_1 _inst_2 (Sum.inl.{u1, u2} X Y x) (Sum.inr.{u1, u2} X Y y))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] {x : X} {y : Y}, LE.le.{0} Real Real.instLEReal (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) (Metric.Sum.dist.{u1, u2} X Y _inst_1 _inst_2 (Sum.inl.{u1, u2} X Y x) (Sum.inr.{u1, u2} X Y y))
Case conversion may be inaccurate. Consider using '#align metric.sum.one_dist_le Metric.Sum.one_le_dist_inl_inrₓ'. -/
theorem Sum.one_le_dist_inl_inr {x : X} {y : Y} : 1 ≤ Sum.dist (inl x) (inr y) :=
  le_trans (le_add_of_nonneg_right dist_nonneg) <|
    add_le_add_right (le_add_of_nonneg_left dist_nonneg) _
#align metric.sum.one_dist_le Metric.Sum.one_le_dist_inl_inr

/- warning: metric.sum.one_dist_le' -> Metric.Sum.one_le_dist_inr_inl is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] {x : X} {y : Y}, LE.le.{0} Real Real.hasLe (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) (Metric.Sum.dist.{u1, u2} X Y _inst_1 _inst_2 (Sum.inr.{u1, u2} X Y y) (Sum.inl.{u1, u2} X Y x))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : MetricSpace.{u1} X] [_inst_2 : MetricSpace.{u2} Y] {x : X} {y : Y}, LE.le.{0} Real Real.instLEReal (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) (Metric.Sum.dist.{u1, u2} X Y _inst_1 _inst_2 (Sum.inr.{u1, u2} X Y y) (Sum.inl.{u1, u2} X Y x))
Case conversion may be inaccurate. Consider using '#align metric.sum.one_dist_le' Metric.Sum.one_le_dist_inr_inlₓ'. -/
theorem Sum.one_le_dist_inr_inl {x : X} {y : Y} : 1 ≤ Sum.dist (inr y) (inl x) := by
  rw [sum.dist_comm] <;> exact sum.one_dist_le
#align metric.sum.one_dist_le' Metric.Sum.one_le_dist_inr_inl

private theorem sum.mem_uniformity (s : Set (Sum X Y × Sum X Y)) :
    s ∈ 𝓤 (Sum X Y) ↔ ∃ ε > 0, ∀ a b, Sum.dist a b < ε → (a, b) ∈ s :=
  by
  constructor
  · rintro ⟨hsX, hsY⟩
    rcases mem_uniformity_dist.1 hsX with ⟨εX, εX0, hX⟩
    rcases mem_uniformity_dist.1 hsY with ⟨εY, εY0, hY⟩
    refine' ⟨min (min εX εY) 1, lt_min (lt_min εX0 εY0) zero_lt_one, _⟩
    rintro (a | a) (b | b) h
    · exact hX (lt_of_lt_of_le h (le_trans (min_le_left _ _) (min_le_left _ _)))
    · cases not_le_of_lt (lt_of_lt_of_le h (min_le_right _ _)) sum.one_dist_le
    · cases not_le_of_lt (lt_of_lt_of_le h (min_le_right _ _)) sum.one_dist_le'
    · exact hY (lt_of_lt_of_le h (le_trans (min_le_left _ _) (min_le_right _ _)))
  · rintro ⟨ε, ε0, H⟩
    constructor <;> rw [Filter.mem_sets, Filter.mem_map, mem_uniformity_dist] <;>
      exact ⟨ε, ε0, fun x y h => H _ _ h⟩
#align metric.sum.mem_uniformity metric.sum.mem_uniformity

#print Metric.metricSpaceSum /-
/-- The distance on the disjoint union indeed defines a metric space. All the distance properties
follow from our choice of the distance. The harder work is to show that the uniform structure
defined by the distance coincides with the disjoint union uniform structure. -/
def metricSpaceSum : MetricSpace (Sum X Y)
    where
  dist := Sum.dist
  dist_self x := by cases x <;> simp only [sum.dist, dist_self]
  dist_comm := Sum.dist_comm
  dist_triangle p q r := by
    cases p <;> cases q <;> cases r
    · exact dist_triangle _ _ _
    · simp only [dist, sum.dist_eq_glue_dist p r]
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _
    · simp only [dist, sum.dist_eq_glue_dist p q]
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _
    · simp only [dist, sum.dist_eq_glue_dist p q]
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _
    · simp only [dist, sum.dist_eq_glue_dist q p]
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _
    · simp only [dist, sum.dist_eq_glue_dist q p]
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _
    · simp only [dist, sum.dist_eq_glue_dist r p]
      exact glue_dist_triangle _ _ _ (by norm_num) _ _ _
    · exact dist_triangle _ _ _
  eq_of_dist_eq_zero p q := by
    cases p <;> cases q
    · simp only [sum.dist, dist_eq_zero, imp_self]
    · intro h
      simp only [dist, sum.dist_eq_glue_dist p q] at h
      exact glue_eq_of_dist_eq_zero _ _ _ zero_lt_one _ _ h
    · intro h
      simp only [dist, sum.dist_eq_glue_dist q p] at h
      exact glue_eq_of_dist_eq_zero _ _ _ zero_lt_one _ _ h
    · simp only [sum.dist, dist_eq_zero, imp_self]
  toUniformSpace := Sum.uniformSpace
  uniformity_dist := uniformity_dist_of_mem_uniformity _ _ Sum.mem_uniformity
#align metric.metric_space_sum Metric.metricSpaceSum
-/

attribute [local instance] metric_space_sum

#print Metric.Sum.dist_eq /-
theorem Sum.dist_eq {x y : Sum X Y} : dist x y = Sum.dist x y :=
  rfl
#align metric.sum.dist_eq Metric.Sum.dist_eq
-/

#print Metric.isometry_inl /-
/-- The left injection of a space in a disjoint union is an isometry -/
theorem isometry_inl : Isometry (Sum.inl : X → Sum X Y) :=
  Isometry.of_dist_eq fun x y => rfl
#align metric.isometry_inl Metric.isometry_inl
-/

#print Metric.isometry_inr /-
/-- The right injection of a space in a disjoint union is an isometry -/
theorem isometry_inr : Isometry (Sum.inr : Y → Sum X Y) :=
  Isometry.of_dist_eq fun x y => rfl
#align metric.isometry_inr Metric.isometry_inr
-/

end Sum

namespace Sigma

/- Copy of the previous paragraph, but for arbitrary disjoint unions instead of the disjoint union
of two spaces. I.e., work with sigma types instead of sum types. -/
variable {ι : Type _} {E : ι → Type _} [∀ i, MetricSpace (E i)]

open Classical

#print Metric.Sigma.dist /-
/-- Distance on a disjoint union. There are many (noncanonical) ways to put a distance compatible
with each factor.
We choose a construction that works for unbounded spaces, but requires basepoints,
chosen arbitrarily.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
protected def dist : (Σi, E i) → (Σi, E i) → ℝ
  | ⟨i, x⟩, ⟨j, y⟩ =>
    if h : i = j then
      haveI : E j = E i := by rw [h]
      Dist.dist x (cast this y)
    else Dist.dist x (Nonempty.some ⟨x⟩) + 1 + Dist.dist (Nonempty.some ⟨y⟩) y
#align metric.sigma.dist Metric.Sigma.dist
-/

#print Metric.Sigma.instDist /-
/-- A `has_dist` instance on the disjoint union `Σ i, E i`.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
def instDist : Dist (Σi, E i) :=
  ⟨Sigma.dist⟩
#align metric.sigma.has_dist Metric.Sigma.instDist
-/

attribute [local instance] sigma.has_dist

#print Metric.Sigma.dist_same /-
@[simp]
theorem dist_same (i : ι) (x : E i) (y : E i) : dist (⟨i, x⟩ : Σj, E j) ⟨i, y⟩ = dist x y := by
  simp [Dist.dist, sigma.dist]
#align metric.sigma.dist_same Metric.Sigma.dist_same
-/

/- warning: metric.sigma.dist_ne -> Metric.Sigma.dist_ne is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {E : ι -> Type.{u2}} [_inst_1 : forall (i : ι), MetricSpace.{u2} (E i)] {i : ι} {j : ι}, (Ne.{succ u1} ι i j) -> (forall (x : E i) (y : E j), Eq.{1} Real (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (k : ι) => E k)) (Metric.Sigma.instDist.{u1, u2} ι (fun (k : ι) => E k) (fun (i : ι) => _inst_1 i)) (Sigma.mk.{u1, u2} ι (fun (k : ι) => E k) i x) (Sigma.mk.{u1, u2} ι (fun (k : ι) => E k) j y)) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.hasAdd) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.hasAdd) (Dist.dist.{u2} (E i) (PseudoMetricSpace.toHasDist.{u2} (E i) (MetricSpace.toPseudoMetricSpace.{u2} (E i) (_inst_1 i))) x (Nonempty.some.{succ u2} (E i) (Nonempty.intro.{succ u2} (E i) x))) (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne)))) (Dist.dist.{u2} (E j) (PseudoMetricSpace.toHasDist.{u2} (E j) (MetricSpace.toPseudoMetricSpace.{u2} (E j) (_inst_1 j))) (Nonempty.some.{succ u2} (E j) (Nonempty.intro.{succ u2} (E j) y)) y)))
but is expected to have type
  forall {ι : Type.{u2}} {E : ι -> Type.{u1}} [_inst_1 : forall (i : ι), MetricSpace.{u1} (E i)] {i : ι} {j : ι}, (Ne.{succ u2} ι i j) -> (forall (x : E i) (y : E j), Eq.{1} Real (Dist.dist.{max u2 u1} (Sigma.{u2, u1} ι (fun (k : ι) => E k)) (Metric.Sigma.instDist.{u2, u1} ι (fun (k : ι) => E k) (fun (i : ι) => _inst_1 i)) (Sigma.mk.{u2, u1} ι (fun (k : ι) => E k) i x) (Sigma.mk.{u2, u1} ι (fun (k : ι) => E k) j y)) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.instAddReal) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.instAddReal) (Dist.dist.{u1} (E i) (PseudoMetricSpace.toDist.{u1} (E i) (MetricSpace.toPseudoMetricSpace.{u1} (E i) (_inst_1 i))) x (Nonempty.some.{succ u1} (E i) (Nonempty.intro.{succ u1} (E i) x))) (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal))) (Dist.dist.{u1} (E j) (PseudoMetricSpace.toDist.{u1} (E j) (MetricSpace.toPseudoMetricSpace.{u1} (E j) (_inst_1 j))) (Nonempty.some.{succ u1} (E j) (Nonempty.intro.{succ u1} (E j) y)) y)))
Case conversion may be inaccurate. Consider using '#align metric.sigma.dist_ne Metric.Sigma.dist_neₓ'. -/
@[simp]
theorem dist_ne {i j : ι} (h : i ≠ j) (x : E i) (y : E j) :
    dist (⟨i, x⟩ : Σk, E k) ⟨j, y⟩ = dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨y⟩) y :=
  by simp [Dist.dist, sigma.dist, h]
#align metric.sigma.dist_ne Metric.Sigma.dist_ne

/- warning: metric.sigma.one_le_dist_of_ne -> Metric.Sigma.one_le_dist_of_ne is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {E : ι -> Type.{u2}} [_inst_1 : forall (i : ι), MetricSpace.{u2} (E i)] {i : ι} {j : ι}, (Ne.{succ u1} ι i j) -> (forall (x : E i) (y : E j), LE.le.{0} Real Real.hasLe (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (k : ι) => E k)) (Metric.Sigma.instDist.{u1, u2} ι (fun (k : ι) => E k) (fun (i : ι) => _inst_1 i)) (Sigma.mk.{u1, u2} ι (fun (k : ι) => E k) i x) (Sigma.mk.{u1, u2} ι (fun (k : ι) => E k) j y)))
but is expected to have type
  forall {ι : Type.{u2}} {E : ι -> Type.{u1}} [_inst_1 : forall (i : ι), MetricSpace.{u1} (E i)] {i : ι} {j : ι}, (Ne.{succ u2} ι i j) -> (forall (x : E i) (y : E j), LE.le.{0} Real Real.instLEReal (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) (Dist.dist.{max u2 u1} (Sigma.{u2, u1} ι (fun (k : ι) => E k)) (Metric.Sigma.instDist.{u2, u1} ι (fun (k : ι) => E k) (fun (i : ι) => _inst_1 i)) (Sigma.mk.{u2, u1} ι (fun (k : ι) => E k) i x) (Sigma.mk.{u2, u1} ι (fun (k : ι) => E k) j y)))
Case conversion may be inaccurate. Consider using '#align metric.sigma.one_le_dist_of_ne Metric.Sigma.one_le_dist_of_neₓ'. -/
theorem one_le_dist_of_ne {i j : ι} (h : i ≠ j) (x : E i) (y : E j) :
    1 ≤ dist (⟨i, x⟩ : Σk, E k) ⟨j, y⟩ :=
  by
  rw [sigma.dist_ne h x y]
  linarith [@dist_nonneg _ _ x (Nonempty.some ⟨x⟩), @dist_nonneg _ _ (Nonempty.some ⟨y⟩) y]
#align metric.sigma.one_le_dist_of_ne Metric.Sigma.one_le_dist_of_ne

/- warning: metric.sigma.fst_eq_of_dist_lt_one -> Metric.Sigma.fst_eq_of_dist_lt_one is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {E : ι -> Type.{u2}} [_inst_1 : forall (i : ι), MetricSpace.{u2} (E i)] (x : Sigma.{u1, u2} ι (fun (i : ι) => E i)) (y : Sigma.{u1, u2} ι (fun (i : ι) => E i)), (LT.lt.{0} Real Real.hasLt (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u1, u2} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) x y) (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne)))) -> (Eq.{succ u1} ι (Sigma.fst.{u1, u2} ι (fun (i : ι) => E i) x) (Sigma.fst.{u1, u2} ι (fun (i : ι) => E i) y))
but is expected to have type
  forall {ι : Type.{u2}} {E : ι -> Type.{u1}} [_inst_1 : forall (i : ι), MetricSpace.{u1} (E i)] (x : Sigma.{u2, u1} ι (fun (i : ι) => E i)) (y : Sigma.{u2, u1} ι (fun (i : ι) => E i)), (LT.lt.{0} Real Real.instLTReal (Dist.dist.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u2, u1} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) x y) (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal))) -> (Eq.{succ u2} ι (Sigma.fst.{u2, u1} ι (fun (i : ι) => E i) x) (Sigma.fst.{u2, u1} ι (fun (i : ι) => E i) y))
Case conversion may be inaccurate. Consider using '#align metric.sigma.fst_eq_of_dist_lt_one Metric.Sigma.fst_eq_of_dist_lt_oneₓ'. -/
theorem fst_eq_of_dist_lt_one (x y : Σi, E i) (h : dist x y < 1) : x.1 = y.1 :=
  by
  cases x; cases y
  contrapose! h
  apply one_le_dist_of_ne h
#align metric.sigma.fst_eq_of_dist_lt_one Metric.Sigma.fst_eq_of_dist_lt_one

/- warning: metric.sigma.dist_triangle -> Metric.Sigma.dist_triangle is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {E : ι -> Type.{u2}} [_inst_1 : forall (i : ι), MetricSpace.{u2} (E i)] (x : Sigma.{u1, u2} ι (fun (i : ι) => E i)) (y : Sigma.{u1, u2} ι (fun (i : ι) => E i)) (z : Sigma.{u1, u2} ι (fun (i : ι) => E i)), LE.le.{0} Real Real.hasLe (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u1, u2} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) x z) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.hasAdd) (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u1, u2} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) x y) (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u1, u2} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) y z))
but is expected to have type
  forall {ι : Type.{u2}} {E : ι -> Type.{u1}} [_inst_1 : forall (i : ι), MetricSpace.{u1} (E i)] (x : Sigma.{u2, u1} ι (fun (i : ι) => E i)) (y : Sigma.{u2, u1} ι (fun (i : ι) => E i)) (z : Sigma.{u2, u1} ι (fun (i : ι) => E i)), LE.le.{0} Real Real.instLEReal (Dist.dist.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u2, u1} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) x z) (HAdd.hAdd.{0, 0, 0} Real Real Real (instHAdd.{0} Real Real.instAddReal) (Dist.dist.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u2, u1} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) x y) (Dist.dist.{max u2 u1} (Sigma.{u2, u1} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u2, u1} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) y z))
Case conversion may be inaccurate. Consider using '#align metric.sigma.dist_triangle Metric.Sigma.dist_triangleₓ'. -/
protected theorem dist_triangle (x y z : Σi, E i) : dist x z ≤ dist x y + dist y z :=
  by
  rcases x with ⟨i, x⟩; rcases y with ⟨j, y⟩; rcases z with ⟨k, z⟩
  rcases eq_or_ne i k with (rfl | hik)
  · rcases eq_or_ne i j with (rfl | hij)
    · simpa using dist_triangle x y z
    · simp only [hij, hij.symm, sigma.dist_same, sigma.dist_ne, Ne.def, not_false_iff]
      calc
        dist x z ≤ dist x (Nonempty.some ⟨x⟩) + 0 + 0 + (0 + 0 + dist (Nonempty.some ⟨z⟩) z) := by
          simpa only [zero_add, add_zero] using dist_triangle _ _ _
        _ ≤ _ := by apply_rules [add_le_add, le_rfl, dist_nonneg, zero_le_one]

  · rcases eq_or_ne i j with (rfl | hij)
    · simp only [hik, sigma.dist_ne, Ne.def, not_false_iff, sigma.dist_same]
      calc
        dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨z⟩) z ≤
            dist x y + dist y (Nonempty.some ⟨y⟩) + 1 + dist (Nonempty.some ⟨z⟩) z :=
          by apply_rules [add_le_add, le_rfl, dist_triangle]
        _ = _ := by abel

    · rcases eq_or_ne j k with (rfl | hjk)
      · simp only [hij, sigma.dist_ne, Ne.def, not_false_iff, sigma.dist_same]
        calc
          dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨z⟩) z ≤
              dist x (Nonempty.some ⟨x⟩) + 1 + (dist (Nonempty.some ⟨z⟩) y + dist y z) :=
            by apply_rules [add_le_add, le_rfl, dist_triangle]
          _ = _ := by abel

      · simp only [hik, hij, hjk, sigma.dist_ne, Ne.def, not_false_iff]
        calc
          dist x (Nonempty.some ⟨x⟩) + 1 + dist (Nonempty.some ⟨z⟩) z =
              dist x (Nonempty.some ⟨x⟩) + 1 + 0 + (0 + 0 + dist (Nonempty.some ⟨z⟩) z) :=
            by simp only [add_zero, zero_add]
          _ ≤ _ := by apply_rules [add_le_add, zero_le_one, dist_nonneg, le_rfl]

#align metric.sigma.dist_triangle Metric.Sigma.dist_triangle

/- warning: metric.sigma.is_open_iff -> Metric.Sigma.isOpen_iff is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {E : ι -> Type.{u2}} [_inst_1 : forall (i : ι), MetricSpace.{u2} (E i)] (s : Set.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i))), Iff (IsOpen.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Sigma.topologicalSpace.{u1, u2} ι (fun (i : ι) => E i) (fun (a : ι) => UniformSpace.toTopologicalSpace.{u2} (E a) (PseudoMetricSpace.toUniformSpace.{u2} (E a) (MetricSpace.toPseudoMetricSpace.{u2} (E a) (_inst_1 a))))) s) (forall (x : Sigma.{u1, u2} ι (fun (i : ι) => E i)), (Membership.Mem.{max u1 u2, max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Set.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) (Set.hasMem.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) x s) -> (Exists.{1} Real (fun (ε : Real) => Exists.{0} (GT.gt.{0} Real Real.hasLt ε (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero)))) (fun (H : GT.gt.{0} Real Real.hasLt ε (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero)))) => forall (y : Sigma.{u1, u2} ι (fun (i : ι) => E i)), (LT.lt.{0} Real Real.hasLt (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u1, u2} ι (fun (i : ι) => E i) (fun (a : ι) => _inst_1 a)) x y) ε) -> (Membership.Mem.{max u1 u2, max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Set.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) (Set.hasMem.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) y s)))))
but is expected to have type
  forall {ι : Type.{u1}} {E : ι -> Type.{u2}} [_inst_1 : forall (i : ι), MetricSpace.{u2} (E i)] (s : Set.{max u2 u1} (Sigma.{u1, u2} ι (fun (i : ι) => E i))), Iff (IsOpen.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (instTopologicalSpaceSigma.{u1, u2} ι (fun (i : ι) => E i) (fun (a : ι) => UniformSpace.toTopologicalSpace.{u2} (E a) (PseudoMetricSpace.toUniformSpace.{u2} (E a) (MetricSpace.toPseudoMetricSpace.{u2} (E a) (_inst_1 a))))) s) (forall (x : Sigma.{u1, u2} ι (fun (i : ι) => E i)), (Membership.mem.{max u1 u2, max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Set.{max u2 u1} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) (Set.instMembershipSet.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) x s) -> (Exists.{1} Real (fun (ε : Real) => And (GT.gt.{0} Real Real.instLTReal ε (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal))) (forall (y : Sigma.{u1, u2} ι (fun (i : ι) => E i)), (LT.lt.{0} Real Real.instLTReal (Dist.dist.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Metric.Sigma.instDist.{u1, u2} ι (fun (i : ι) => E i) (fun (i : ι) => _inst_1 i)) x y) ε) -> (Membership.mem.{max u1 u2, max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i)) (Set.{max u2 u1} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) (Set.instMembershipSet.{max u1 u2} (Sigma.{u1, u2} ι (fun (i : ι) => E i))) y s)))))
Case conversion may be inaccurate. Consider using '#align metric.sigma.is_open_iff Metric.Sigma.isOpen_iffₓ'. -/
protected theorem isOpen_iff (s : Set (Σi, E i)) :
    IsOpen s ↔ ∀ x ∈ s, ∃ ε > 0, ∀ y, dist x y < ε → y ∈ s :=
  by
  constructor
  · rintro hs ⟨i, x⟩ hx
    obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ)(H : ε > 0), ball x ε ⊆ Sigma.mk i ⁻¹' s :=
      Metric.isOpen_iff.1 (isOpen_sigma_iff.1 hs i) x hx
    refine' ⟨min ε 1, lt_min εpos zero_lt_one, _⟩
    rintro ⟨j, y⟩ hy
    rcases eq_or_ne i j with (rfl | hij)
    · simp only [sigma.dist_same, lt_min_iff] at hy
      exact hε (mem_ball'.2 hy.1)
    · apply (lt_irrefl (1 : ℝ) _).elim
      calc
        1 ≤ sigma.dist ⟨i, x⟩ ⟨j, y⟩ := sigma.one_le_dist_of_ne hij _ _
        _ < 1 := hy.trans_le (min_le_right _ _)

  · intro H
    apply isOpen_sigma_iff.2 fun i => _
    apply Metric.isOpen_iff.2 fun x hx => _
    obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ)(H : ε > 0), ∀ y, dist (⟨i, x⟩ : Σj, E j) y < ε → y ∈ s :=
      H ⟨i, x⟩ hx
    refine' ⟨ε, εpos, fun y hy => _⟩
    apply hε ⟨i, y⟩
    rw [sigma.dist_same]
    exact mem_ball'.1 hy
#align metric.sigma.is_open_iff Metric.Sigma.isOpen_iff

#print Metric.Sigma.metricSpace /-
/-- A metric space structure on the disjoint union `Σ i, E i`.
We embed isometrically each factor, set the basepoints at distance 1, arbitrarily,
and say that the distance from `a` to `b` is the sum of the distances of `a` and `b` to
their respective basepoints, plus the distance 1 between the basepoints.
Since there is an arbitrary choice in this construction, it is not an instance by default. -/
protected def metricSpace : MetricSpace (Σi, E i) :=
  by
  refine' MetricSpace.ofDistTopology sigma.dist _ _ sigma.dist_triangle sigma.is_open_iff _
  · rintro ⟨i, x⟩
    simp [sigma.dist]
  · rintro ⟨i, x⟩ ⟨j, y⟩
    rcases eq_or_ne i j with (rfl | h)
    · simp [sigma.dist, dist_comm]
    · simp only [sigma.dist, dist_comm, h, h.symm, not_false_iff, dif_neg]
      abel
  · rintro ⟨i, x⟩ ⟨j, y⟩
    rcases eq_or_ne i j with (rfl | hij)
    · simp [sigma.dist]
    · intro h
      apply (lt_irrefl (1 : ℝ) _).elim
      calc
        1 ≤ sigma.dist (⟨i, x⟩ : Σk, E k) ⟨j, y⟩ := sigma.one_le_dist_of_ne hij _ _
        _ < 1 := by
          rw [h]
          exact zero_lt_one

#align metric.sigma.metric_space Metric.Sigma.metricSpace
-/

attribute [local instance] sigma.metric_space

open Topology

open Filter

#print Metric.Sigma.isometry_mk /-
/-- The injection of a space in a disjoint union is an isometry -/
theorem isometry_mk (i : ι) : Isometry (Sigma.mk i : E i → Σk, E k) :=
  Isometry.of_dist_eq fun x y => by simp
#align metric.sigma.isometry_mk Metric.Sigma.isometry_mk
-/

#print Metric.Sigma.completeSpace /-
/-- A disjoint union of complete metric spaces is complete. -/
protected theorem completeSpace [∀ i, CompleteSpace (E i)] : CompleteSpace (Σi, E i) :=
  by
  set s : ι → Set (Σi, E i) := fun i => Sigma.fst ⁻¹' {i}
  set U := { p : (Σk, E k) × Σk, E k | dist p.1 p.2 < 1 }
  have hc : ∀ i, IsComplete (s i) := by
    intro i
    simp only [s, ← range_sigma_mk]
    exact (isometry_mk i).UniformInducing.isComplete_range
  have hd : ∀ (i j), ∀ x ∈ s i, ∀ y ∈ s j, (x, y) ∈ U → i = j := fun i j x hx y hy hxy =>
    (Eq.symm hx).trans ((fst_eq_of_dist_lt_one _ _ hxy).trans hy)
  refine' completeSpace_of_isComplete_univ _
  convert isComplete_unionᵢ_separated hc (dist_mem_uniformity zero_lt_one) hd
  simp [s, ← preimage_Union]
#align metric.sigma.complete_space Metric.Sigma.completeSpace
-/

end Sigma

section Gluing

-- Exact gluing of two metric spaces along isometric subsets.
variable {X : Type u} {Y : Type v} {Z : Type w}

variable [Nonempty Z] [MetricSpace Z] [MetricSpace X] [MetricSpace Y] {Φ : Z → X} {Ψ : Z → Y}
  {ε : ℝ}

open _Root_.Sum (inl inr)

attribute [local instance] UniformSpace.separationSetoid

#print Metric.gluePremetric /-
/-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a pseudo metric space
structure on `X ⊕ Y` by declaring that `Φ x` and `Ψ x` are at distance `0`. -/
def gluePremetric (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : PseudoMetricSpace (Sum X Y)
    where
  dist := glueDist Φ Ψ 0
  dist_self := glueDist_self Φ Ψ 0
  dist_comm := glueDist_comm Φ Ψ 0
  dist_triangle := glueDist_triangle Φ Ψ 0 fun p q => by rw [hΦ.dist_eq, hΨ.dist_eq] <;> simp
#align metric.glue_premetric Metric.gluePremetric
-/

#print Metric.GlueSpace /-
/-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a
space  `glue_space hΦ hΨ` by identifying in `X ⊕ Y` the points `Φ x` and `Ψ x`. -/
def GlueSpace (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : Type _ :=
  @UniformSpace.SeparationQuotient _ (gluePremetric hΦ hΨ).toUniformSpace deriving MetricSpace
#align metric.glue_space Metric.GlueSpace
-/

#print Metric.toGlueL /-
/-- The canonical map from `X` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
def toGlueL (hΦ : Isometry Φ) (hΨ : Isometry Ψ) (x : X) : GlueSpace hΦ hΨ :=
  Quotient.mk'' (inl x)
#align metric.to_glue_l Metric.toGlueL
-/

#print Metric.toGlueR /-
/-- The canonical map from `Y` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
def toGlueR (hΦ : Isometry Φ) (hΨ : Isometry Ψ) (y : Y) : GlueSpace hΦ hΨ :=
  Quotient.mk'' (inr y)
#align metric.to_glue_r Metric.toGlueR
-/

#print Metric.inhabitedLeft /-
instance inhabitedLeft (hΦ : Isometry Φ) (hΨ : Isometry Ψ) [Inhabited X] :
    Inhabited (GlueSpace hΦ hΨ) :=
  ⟨toGlueL _ _ default⟩
#align metric.inhabited_left Metric.inhabitedLeft
-/

#print Metric.inhabitedRight /-
instance inhabitedRight (hΦ : Isometry Φ) (hΨ : Isometry Ψ) [Inhabited Y] :
    Inhabited (GlueSpace hΦ hΨ) :=
  ⟨toGlueR _ _ default⟩
#align metric.inhabited_right Metric.inhabitedRight
-/

#print Metric.toGlue_commute /-
theorem toGlue_commute (hΦ : Isometry Φ) (hΨ : Isometry Ψ) :
    toGlueL hΦ hΨ ∘ Φ = toGlueR hΦ hΨ ∘ Ψ :=
  by
  letI i : PseudoMetricSpace (Sum X Y) := glue_premetric hΦ hΨ
  letI := i.to_uniform_space
  funext
  simp only [comp, to_glue_l, to_glue_r]
  refine' UniformSpace.SeparationQuotient.mk_eq_mk.2 (Metric.inseparable_iff.2 _)
  exact glue_dist_glued_points Φ Ψ 0 x
#align metric.to_glue_commute Metric.toGlue_commute
-/

/- warning: metric.to_glue_l_isometry -> Metric.toGlueL_isometry is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : Nonempty.{succ u3} Z] [_inst_2 : MetricSpace.{u3} Z] [_inst_3 : MetricSpace.{u1} X] [_inst_4 : MetricSpace.{u2} Y] {Φ : Z -> X} {Ψ : Z -> Y} (hΦ : Isometry.{u3, u1} Z X (PseudoMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toPseudoMetricSpace.{u3} Z _inst_2)) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} X (MetricSpace.toPseudoMetricSpace.{u1} X _inst_3)) Φ) (hΨ : Isometry.{u3, u2} Z Y (PseudoMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toPseudoMetricSpace.{u3} Z _inst_2)) (PseudoMetricSpace.toPseudoEMetricSpace.{u2} Y (MetricSpace.toPseudoMetricSpace.{u2} Y _inst_4)) Ψ), Isometry.{u1, max u1 u2} X (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} X (MetricSpace.toPseudoMetricSpace.{u1} X _inst_3)) (PseudoMetricSpace.toPseudoEMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (MetricSpace.toPseudoMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (Metric.GlueSpace.metricSpace.{u2, u3, u1} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ))) (Metric.toGlueL.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : Nonempty.{succ u3} Z] [_inst_2 : MetricSpace.{u3} Z] [_inst_3 : MetricSpace.{u1} X] [_inst_4 : MetricSpace.{u2} Y] {Φ : Z -> X} {Ψ : Z -> Y} (hΦ : Isometry.{u3, u1} Z X (EMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toEMetricSpace.{u3} Z _inst_2)) (EMetricSpace.toPseudoEMetricSpace.{u1} X (MetricSpace.toEMetricSpace.{u1} X _inst_3)) Φ) (hΨ : Isometry.{u3, u2} Z Y (EMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toEMetricSpace.{u3} Z _inst_2)) (EMetricSpace.toPseudoEMetricSpace.{u2} Y (MetricSpace.toEMetricSpace.{u2} Y _inst_4)) Ψ), Isometry.{u1, max u1 u2} X (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (EMetricSpace.toPseudoEMetricSpace.{u1} X (MetricSpace.toEMetricSpace.{u1} X _inst_3)) (EMetricSpace.toPseudoEMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (MetricSpace.toEMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (Metric.instMetricSpaceGlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ hΦ Ψ hΨ))) (Metric.toGlueL.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ)
Case conversion may be inaccurate. Consider using '#align metric.to_glue_l_isometry Metric.toGlueL_isometryₓ'. -/
theorem toGlueL_isometry (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : Isometry (toGlueL hΦ hΨ) :=
  Isometry.of_dist_eq fun _ _ => rfl
#align metric.to_glue_l_isometry Metric.toGlueL_isometry

/- warning: metric.to_glue_r_isometry -> Metric.toGlueR_isometry is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : Nonempty.{succ u3} Z] [_inst_2 : MetricSpace.{u3} Z] [_inst_3 : MetricSpace.{u1} X] [_inst_4 : MetricSpace.{u2} Y] {Φ : Z -> X} {Ψ : Z -> Y} (hΦ : Isometry.{u3, u1} Z X (PseudoMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toPseudoMetricSpace.{u3} Z _inst_2)) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} X (MetricSpace.toPseudoMetricSpace.{u1} X _inst_3)) Φ) (hΨ : Isometry.{u3, u2} Z Y (PseudoMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toPseudoMetricSpace.{u3} Z _inst_2)) (PseudoMetricSpace.toPseudoEMetricSpace.{u2} Y (MetricSpace.toPseudoMetricSpace.{u2} Y _inst_4)) Ψ), Isometry.{u2, max u1 u2} Y (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (PseudoMetricSpace.toPseudoEMetricSpace.{u2} Y (MetricSpace.toPseudoMetricSpace.{u2} Y _inst_4)) (PseudoMetricSpace.toPseudoEMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (MetricSpace.toPseudoMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (Metric.GlueSpace.metricSpace.{u2, u3, u1} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ))) (Metric.toGlueR.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : Nonempty.{succ u3} Z] [_inst_2 : MetricSpace.{u3} Z] [_inst_3 : MetricSpace.{u1} X] [_inst_4 : MetricSpace.{u2} Y] {Φ : Z -> X} {Ψ : Z -> Y} (hΦ : Isometry.{u3, u1} Z X (EMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toEMetricSpace.{u3} Z _inst_2)) (EMetricSpace.toPseudoEMetricSpace.{u1} X (MetricSpace.toEMetricSpace.{u1} X _inst_3)) Φ) (hΨ : Isometry.{u3, u2} Z Y (EMetricSpace.toPseudoEMetricSpace.{u3} Z (MetricSpace.toEMetricSpace.{u3} Z _inst_2)) (EMetricSpace.toPseudoEMetricSpace.{u2} Y (MetricSpace.toEMetricSpace.{u2} Y _inst_4)) Ψ), Isometry.{u2, max u1 u2} Y (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (EMetricSpace.toPseudoEMetricSpace.{u2} Y (MetricSpace.toEMetricSpace.{u2} Y _inst_4)) (EMetricSpace.toPseudoEMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (MetricSpace.toEMetricSpace.{max u1 u2} (Metric.GlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ) (Metric.instMetricSpaceGlueSpace.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ hΦ Ψ hΨ))) (Metric.toGlueR.{u1, u2, u3} X Y Z _inst_1 _inst_2 _inst_3 _inst_4 Φ Ψ hΦ hΨ)
Case conversion may be inaccurate. Consider using '#align metric.to_glue_r_isometry Metric.toGlueR_isometryₓ'. -/
theorem toGlueR_isometry (hΦ : Isometry Φ) (hΨ : Isometry Ψ) : Isometry (toGlueR hΦ hΨ) :=
  Isometry.of_dist_eq fun _ _ => rfl
#align metric.to_glue_r_isometry Metric.toGlueR_isometry

end Gluing

--section
section InductiveLimit

/- In this section, we define the inductive limit of
     f 0        f 1        f 2        f 3
X 0 -----> X 1 -----> X 2 -----> X 3 -----> ...
where the X n are metric spaces and f n isometric embeddings. We do it by defining a premetric
space structure on Σ n, X n, where the predistance dist x y is obtained by pushing x and y in a
common X k using composition by the f n, and taking the distance there. This does not depend on
the choice of k as the f n are isometries. The metric space associated to this premetric space
is the desired inductive limit.-/
open Nat

variable {X : ℕ → Type u} [∀ n, MetricSpace (X n)] {f : ∀ n, X n → X (n + 1)}

#print Metric.inductiveLimitDist /-
/-- Predistance on the disjoint union `Σ n, X n`. -/
def inductiveLimitDist (f : ∀ n, X n → X (n + 1)) (x y : Σn, X n) : ℝ :=
  dist (leRecOn (le_max_left x.1 y.1) f x.2 : X (max x.1 y.1))
    (leRecOn (le_max_right x.1 y.1) f y.2 : X (max x.1 y.1))
#align metric.inductive_limit_dist Metric.inductiveLimitDist
-/

#print Metric.inductiveLimitDist_eq_dist /-
/-- The predistance on the disjoint union `Σ n, X n` can be computed in any `X k` for large
enough `k`. -/
theorem inductiveLimitDist_eq_dist (I : ∀ n, Isometry (f n)) (x y : Σn, X n) (m : ℕ) :
    ∀ hx : x.1 ≤ m,
      ∀ hy : y.1 ≤ m,
        inductiveLimitDist f x y = dist (leRecOn hx f x.2 : X m) (leRecOn hy f y.2 : X m) :=
  by
  induction' m with m hm
  · intro hx hy
    have A : max x.1 y.1 = 0 :=
      by
      rw [nonpos_iff_eq_zero.1 hx, nonpos_iff_eq_zero.1 hy]
      simp
    unfold inductive_limit_dist
    congr <;> simp only [A]
  · intro hx hy
    by_cases h : max x.1 y.1 = m.succ
    · unfold inductive_limit_dist
      congr <;> simp only [h]
    · have : max x.1 y.1 ≤ succ m := by simp [hx, hy]
      have : max x.1 y.1 ≤ m := by simpa [h] using of_le_succ this
      have xm : x.1 ≤ m := le_trans (le_max_left _ _) this
      have ym : y.1 ≤ m := le_trans (le_max_right _ _) this
      rw [le_rec_on_succ xm, le_rec_on_succ ym, (I m).dist_eq]
      exact hm xm ym
#align metric.inductive_limit_dist_eq_dist Metric.inductiveLimitDist_eq_dist
-/

#print Metric.inductivePremetric /-
/-- Premetric space structure on `Σ n, X n`.-/
def inductivePremetric (I : ∀ n, Isometry (f n)) : PseudoMetricSpace (Σn, X n)
    where
  dist := inductiveLimitDist f
  dist_self x := by simp [dist, inductive_limit_dist]
  dist_comm x y := by
    let m := max x.1 y.1
    have hx : x.1 ≤ m := le_max_left _ _
    have hy : y.1 ≤ m := le_max_right _ _
    unfold dist
    rw [inductive_limit_dist_eq_dist I x y m hx hy, inductive_limit_dist_eq_dist I y x m hy hx,
      dist_comm]
  dist_triangle x y z := by
    let m := max (max x.1 y.1) z.1
    have hx : x.1 ≤ m := le_trans (le_max_left _ _) (le_max_left _ _)
    have hy : y.1 ≤ m := le_trans (le_max_right _ _) (le_max_left _ _)
    have hz : z.1 ≤ m := le_max_right _ _
    calc
      inductive_limit_dist f x z = dist (le_rec_on hx f x.2 : X m) (le_rec_on hz f z.2 : X m) :=
        inductive_limit_dist_eq_dist I x z m hx hz
      _ ≤
          dist (le_rec_on hx f x.2 : X m) (le_rec_on hy f y.2 : X m) +
            dist (le_rec_on hy f y.2 : X m) (le_rec_on hz f z.2 : X m) :=
        (dist_triangle _ _ _)
      _ = inductive_limit_dist f x y + inductive_limit_dist f y z := by
        rw [inductive_limit_dist_eq_dist I x y m hx hy, inductive_limit_dist_eq_dist I y z m hy hz]

#align metric.inductive_premetric Metric.inductivePremetric
-/

attribute [local instance] inductive_premetric UniformSpace.separationSetoid

#print Metric.InductiveLimit /-
/-- The type giving the inductive limit in a metric space context. -/
def InductiveLimit (I : ∀ n, Isometry (f n)) : Type _ :=
  @UniformSpace.SeparationQuotient _ (inductivePremetric I).toUniformSpace deriving MetricSpace
#align metric.inductive_limit Metric.InductiveLimit
-/

#print Metric.toInductiveLimit /-
/-- Mapping each `X n` to the inductive limit. -/
def toInductiveLimit (I : ∀ n, Isometry (f n)) (n : ℕ) (x : X n) : Metric.InductiveLimit I :=
  Quotient.mk'' (Sigma.mk n x)
#align metric.to_inductive_limit Metric.toInductiveLimit
-/

instance (I : ∀ n, Isometry (f n)) [Inhabited (X 0)] : Inhabited (InductiveLimit I) :=
  ⟨toInductiveLimit _ 0 default⟩

/- warning: metric.to_inductive_limit_isometry -> Metric.toInductiveLimit_isometry is a dubious translation:
lean 3 declaration is
  forall {X : Nat -> Type.{u1}} [_inst_1 : forall (n : Nat), MetricSpace.{u1} (X n)] {f : forall (n : Nat), (X n) -> (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))} (I : forall (n : Nat), Isometry.{u1, u1} (X n) (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} (X n) (MetricSpace.toPseudoMetricSpace.{u1} (X n) (_inst_1 n))) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (MetricSpace.toPseudoMetricSpace.{u1} (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (_inst_1 (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))))) (f n)) (n : Nat), Isometry.{u1, u1} (X n) (Metric.InductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} (X n) (MetricSpace.toPseudoMetricSpace.{u1} (X n) (_inst_1 n))) (PseudoMetricSpace.toPseudoEMetricSpace.{u1} (Metric.InductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I) (MetricSpace.toPseudoMetricSpace.{u1} (Metric.InductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I) (Metric.InductiveLimit.metricSpace.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I))) (Metric.toInductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I n)
but is expected to have type
  forall {X : Nat -> Type.{u1}} [_inst_1 : forall (n : Nat), MetricSpace.{u1} (X n)] {f : forall (n : Nat), (X n) -> (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))} (I : forall (n : Nat), Isometry.{u1, u1} (X n) (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (EMetricSpace.toPseudoEMetricSpace.{u1} (X n) (MetricSpace.toEMetricSpace.{u1} (X n) (_inst_1 n))) (EMetricSpace.toPseudoEMetricSpace.{u1} (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (MetricSpace.toEMetricSpace.{u1} (X (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (_inst_1 (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))) (f n)) (n : Nat), Isometry.{u1, u1} (X n) (Metric.InductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I) (EMetricSpace.toPseudoEMetricSpace.{u1} (X n) (MetricSpace.toEMetricSpace.{u1} (X n) (_inst_1 n))) (EMetricSpace.toPseudoEMetricSpace.{u1} (Metric.InductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I) (MetricSpace.toEMetricSpace.{u1} (Metric.InductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I) (Metric.instMetricSpaceInductiveLimitNat.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I))) (Metric.toInductiveLimit.{u1} (fun (n : Nat) => X n) (fun (n : Nat) => _inst_1 n) (fun (n : Nat) => f n) I n)
Case conversion may be inaccurate. Consider using '#align metric.to_inductive_limit_isometry Metric.toInductiveLimit_isometryₓ'. -/
/-- The map `to_inductive_limit n` mapping `X n` to the inductive limit is an isometry. -/
theorem toInductiveLimit_isometry (I : ∀ n, Isometry (f n)) (n : ℕ) :
    Isometry (toInductiveLimit I n) :=
  Isometry.of_dist_eq fun x y =>
    by
    change inductive_limit_dist f ⟨n, x⟩ ⟨n, y⟩ = dist x y
    rw [inductive_limit_dist_eq_dist I ⟨n, x⟩ ⟨n, y⟩ n (le_refl n) (le_refl n), le_rec_on_self,
      le_rec_on_self]
#align metric.to_inductive_limit_isometry Metric.toInductiveLimit_isometry

#print Metric.toInductiveLimit_commute /-
/-- The maps `to_inductive_limit n` are compatible with the maps `f n`. -/
theorem toInductiveLimit_commute (I : ∀ n, Isometry (f n)) (n : ℕ) :
    toInductiveLimit I n.succ ∘ f n = toInductiveLimit I n :=
  by
  letI := inductive_premetric I
  funext
  simp only [comp, to_inductive_limit]
  refine' UniformSpace.SeparationQuotient.mk_eq_mk.2 (Metric.inseparable_iff.2 _)
  show inductive_limit_dist f ⟨n.succ, f n x⟩ ⟨n, x⟩ = 0
  · rw [inductive_limit_dist_eq_dist I ⟨n.succ, f n x⟩ ⟨n, x⟩ n.succ, le_rec_on_self,
      le_rec_on_succ, le_rec_on_self, dist_self]
    exact le_rfl
    exact le_rfl
    exact le_succ _
#align metric.to_inductive_limit_commute Metric.toInductiveLimit_commute
-/

end InductiveLimit

--section
end Metric

--namespace


import game.world9.level1 -- hide
namespace mynat -- hide

/-
# Advanced Multiplication World

## Level 2: `eq_zero_or_eq_zero_of_mul_eq_zero`

A variant on the previous level.
-/

/- Theorem
If $ab = 0$, then at least one of $a$ or $b$ is equal to zero.
-/
theorem eq_zero_or_eq_zero_of_mul_eq_zero (a b : mynat) (h : a * b = 0) :
  a = 0 ∨ b = 0 :=
begin [nat_num_game]
  cases a with d,
    left,
    refl,
  cases b with e he,
    right,
    refl,
  exfalso,
  rw mul_succ at h,
  rw add_succ at h,
  exact succ_ne_zero _ h,
end

end mynat -- hide


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

import algebraic_topology.fundamental_groupoid.fundamental_group

/-!
# `n`th homotopy group

We define the `n`th homotopy group at `x`, `π n x`, as the equivalence classes
of functions from the nth dimensional cube to the topological space `X`
that send the boundary to the base point `x`, up to homotopic equivalence.
Note that such functions are generalized loops `gen_loop n x`, in particular
`gen_loop 1 x ≃ path x x`

We show that `π 0 x` is equivalent to the path-conected components, and
that `π 1 x` is equivalent to the fundamental group at `x`.

## definitions

* `gen_loop n x` is the type of continous fuctions `I^n → X` that send the boundary to `x`
* `homotopy_group n x` denoted `π n x` is the quotient of `gen_loop n x` by homotopy relative
  to the boundary

TODO: show that `π n x` is a group when `n > 0` and abelian when `n > 1`. Show that
`pi1_equiv_fundamental_group` is an isomorphism of groups.

-/

open_locale unit_interval topology

noncomputable theory

universes u
variables {X : Type u} [topological_space X]
variables {n : ℕ} {x : X}

/--
The `n`-dimensional cube.
-/
@[derive [has_zero, has_one, topological_space]]
def cube (n : ℕ) : Type := fin n → I
local notation `I^` := cube

namespace cube

@[continuity] lemma proj_continuous (i : fin n) : continuous (λ f : I^n, f i) :=
continuous_apply i

/--
The points of the `n`-dimensional cube with at least one projection equal to 0 or 1.
-/
def boundary (n : ℕ) : set (I^n) := {y | ∃ i, y i = 0 ∨ y i = 1}

/--
The first projection of a positive-dimensional cube.
-/
@[simp] def head {n} : I^(n+1) → I := λ c, c 0

@[continuity] lemma head.continuous {n} : continuous (@head n) := proj_continuous 0

/--
The projection to the last `n` coordinates from an `n+1` dimensional cube.
-/
@[simp] def tail {n} : I^(n+1) → I^n := λ c, fin.tail c

instance unique_cube0 : unique (I^0) := pi.unique_of_is_empty _

lemma one_char (f : I^1) : f = λ _, f 0 := by convert eq_const_of_unique f

end cube

/--
The `n`-dimensional generalized loops; functions `I^n → X` that send the boundary to the base point.
-/
structure gen_loop (n : ℕ) (x : X) extends C(I^n, X) :=
(boundary : ∀ y ∈ cube.boundary n, to_fun y = x)

namespace gen_loop

instance fun_like : fun_like (gen_loop n x) (I^n) (λ _, X) :=
{ coe := λ f, f.1,
  coe_injective' := λ ⟨⟨f, _⟩, _⟩ ⟨⟨g, _⟩, _⟩ h, by { congr, exact h } }

@[ext] lemma ext (f g : gen_loop n x) (H : ∀ y, f y = g y) : f = g := fun_like.ext f g H

@[simp] lemma mk_apply (f : C(I^n, X)) (H y) : (⟨f, H⟩ : gen_loop n x) y = f y := rfl

/--
The constant `gen_loop` at `x`.
-/
def const : gen_loop n x := ⟨continuous_map.const _ x, λ _ _, rfl⟩

instance inhabited : inhabited (gen_loop n x) := { default := const }

/--
The "homotopy relative to boundary" relation between `gen_loop`s.
-/
def homotopic (f g : gen_loop n x) : Prop :=
f.to_continuous_map.homotopic_rel g.to_continuous_map (cube.boundary n)

namespace homotopic
section
variables {f g h : gen_loop n x}

@[refl] lemma refl (f : gen_loop n x) : homotopic f f := continuous_map.homotopic_rel.refl _

@[symm] lemma symm (H : f.homotopic g) : g.homotopic f := H.symm

@[trans] lemma trans (H0 : f.homotopic g) (H1 : g.homotopic h) : f.homotopic h := H0.trans H1

lemma equiv : equivalence (@homotopic X _ n x) :=
⟨homotopic.refl, λ _ _, homotopic.symm, λ _ _ _, homotopic.trans⟩

instance setoid (n : ℕ) (x : X) : setoid (gen_loop n x) := ⟨homotopic, equiv⟩

end
end homotopic

end gen_loop

/--
The `n`th homotopy group at `x` defined as the quotient of `gen_loop n x` by the
`homotopic` relation.
-/
@[derive inhabited]
def homotopy_group (n : ℕ) (x : X) : Type _ := quotient (gen_loop.homotopic.setoid n x)
local notation `π` := homotopy_group

/-- The 0-dimensional generalized loops based at `x` are in 1-1 correspondence with `X`. -/
def gen_loop_zero_equiv : gen_loop 0 x ≃ X :=
{ to_fun := λ f, f 0,
  inv_fun := λ x, ⟨continuous_map.const _ x, λ _ ⟨f0,_⟩, f0.elim0⟩,
  left_inv := λ f, by { ext1, exact congr_arg f (subsingleton.elim _ _) },
  right_inv := λ _, rfl }

/--
The 0th homotopy "group" is equivalent to the path components of `X`, aka the `zeroth_homotopy`.
-/
def pi0_equiv_path_components : π 0 x ≃ zeroth_homotopy X :=
quotient.congr gen_loop_zero_equiv
begin
  -- joined iff homotopic
  intros, split; rintro ⟨H⟩,
  exacts
  [⟨{ to_fun := λ t, H ⟨t, fin.elim0⟩,
      source' := (H.apply_zero _).trans (congr_arg a₁ matrix.zero_empty.symm),
      target' := (H.apply_one _).trans (congr_arg a₂ matrix.zero_empty.symm) }⟩,
   ⟨{ to_fun := λ t0, H t0.fst,
      map_zero_left' := λ _, by convert H.source,
      map_one_left' := λ _, by convert H.target,
      prop' := λ _ _ ⟨i,_⟩, i.elim0 }⟩]
end

/-- The 1-dimensional generalized loops based at `x` are in 1-1 correspondence with
  paths from `x` to itself. -/
@[simps] def gen_loop_one_equiv_path_self : gen_loop 1 x ≃ path x x :=
{ to_fun := λ p, path.mk ⟨λ t, p (λ _, t), by {continuity, exact p.1.2}⟩
    (p.boundary (λ _, 0) ⟨0, or.inl rfl⟩)
    (p.boundary (λ _, 1) ⟨1, or.inr rfl⟩),
  inv_fun := λ p,
  { to_fun := λ c, p c.head,
    boundary := begin
      rintro y ⟨i, iH|iH⟩; cases unique.eq_default i;
      apply (congr_arg p iH).trans, exacts [p.source, p.target],
    end },
  left_inv := λ p, by { ext1, exact congr_arg p y.one_char.symm },
  right_inv := λ p, by { ext, refl } }

/--
The first homotopy group at `x` is equivalent to the fundamental group,
i.e. the loops based at `x` up to homotopy.
-/
def pi1_equiv_fundamental_group : π 1 x ≃ fundamental_group X x :=
begin
  refine equiv.trans _ (category_theory.groupoid.iso_equiv_hom _ _).symm,
  refine quotient.congr gen_loop_one_equiv_path_self _,
  -- homotopic iff homotopic
  intros, split; rintros ⟨H⟩,
  exacts
  [⟨{ to_fun := λ tx, H (tx.fst, λ _, tx.snd),
      map_zero_left' := λ _, by convert H.apply_zero _,
      map_one_left' := λ _, by convert H.apply_one _,
      prop' := λ t y iH, H.prop' _ _ ⟨0,iH⟩ }⟩,
   ⟨{ to_fun := λ tx, H (tx.fst, tx.snd.head),
      map_zero_left' := λ y, by { convert H.apply_zero _, exact y.one_char },
      map_one_left' := λ y, by { convert H.apply_one _, exact y.one_char },
      prop' := λ t y ⟨i, iH⟩, begin
        cases unique.eq_default i, split,
        { convert H.eq_fst _ _, exacts [y.one_char, iH] },
        { convert H.eq_snd _ _, exacts [y.one_char, iH] },
      end }⟩],
end


import mynat.definition
import mynat.add

namespace mynat

lemma zero_add (n : mynat) : 0 + n = n :=
begin [nat_num_game]
    induction n with d hd,
    {
        rw add_zero,
        refl,
    },
    {
        rw add_succ,
        rw hd,
        refl,
    },
end

end mynat


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.big_operators.order
import algebra.group.prod
import data.option.n_ary
import data.set.pointwise.basic
import order.interval
import tactic.positivity

/-!
# Interval arithmetic

This file defines arithmetic operations on intervals and prove their correctness. Note that this is
full precision operations. The essentials of float operations can be found
in `data.fp.basic`. We hsve not yet integrated these with the rest of the library.
-/

open function set
open_locale big_operators pointwise

universe u
variables {ι α : Type*}

/-! ### One/zero -/

section one
section preorder
variables [preorder α] [has_one α]

@[to_additive] instance : has_one (nonempty_interval α) := ⟨nonempty_interval.pure 1⟩
@[to_additive] instance : has_one (interval α) := ⟨interval.pure 1⟩

namespace nonempty_interval

@[simp, to_additive to_prod_zero] lemma to_prod_one : (1 : nonempty_interval α).to_prod = 1 := rfl
@[to_additive] lemma fst_one : (1 : nonempty_interval α).fst = 1 := rfl
@[to_additive] lemma snd_one : (1 : nonempty_interval α).snd = 1 := rfl
@[simp, norm_cast, to_additive]
lemma coe_one_interval : ((1 : nonempty_interval α) : interval α) = 1 := rfl
@[simp, to_additive] lemma pure_one : pure (1 : α) = 1 := rfl

end nonempty_interval

namespace interval

@[simp, to_additive] lemma pure_one : pure (1 : α) = 1 := rfl
@[simp, to_additive] lemma one_ne_bot : (1 : interval α) ≠ ⊥ := pure_ne_bot
@[simp, to_additive]

end interval
end preorder

section partial_order
variables [partial_order α] [has_one α]

namespace nonempty_interval

@[simp, to_additive] lemma coe_one : ((1 : nonempty_interval α) : set α) = 1 := coe_pure _
@[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : nonempty_interval α) := ⟨le_rfl, le_rfl⟩

end nonempty_interval

namespace interval

@[simp, to_additive] lemma coe_one : ((1 : interval α) : set α) = 1 := Icc_self _
@[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : interval α) := ⟨le_rfl, le_rfl⟩

end interval
end partial_order
end one

/-!
### Addition/multiplication

Note that this multiplication does not apply to `ℚ` or `ℝ`.
-/

section mul
variables [preorder α] [has_mul α] [covariant_class α α (*) (≤)]
  [covariant_class α α (swap (*)) (≤)]

@[to_additive] instance : has_mul (nonempty_interval α) :=
⟨λ s t, ⟨s.to_prod * t.to_prod, mul_le_mul' s.fst_le_snd t.fst_le_snd⟩⟩

@[to_additive] instance : has_mul (interval α) := ⟨option.map₂ (*)⟩

namespace nonempty_interval
variables (s t : nonempty_interval α) (a b : α)

@[simp, to_additive to_prod_add] lemma to_prod_mul : (s * t).to_prod = s.to_prod * t.to_prod := rfl
@[to_additive] lemma fst_mul : (s * t).fst = s.fst * t.fst := rfl
@[to_additive] lemma snd_mul : (s * t).snd = s.snd * t.snd := rfl
@[simp, to_additive] lemma coe_mul_interval : (↑(s * t) : interval α) = s * t := rfl
@[simp, to_additive] lemma pure_mul_pure : pure a * pure b = pure (a * b) := rfl

end nonempty_interval

namespace interval
variables (s t : interval α)

@[simp, to_additive] lemma bot_mul : ⊥ * t = ⊥ := rfl
@[simp, to_additive] lemma mul_bot : s * ⊥ = ⊥ := option.map₂_none_right _ _

end interval
end mul

/-! ### Powers -/

-- TODO: if `to_additive` gets improved sufficiently, derive this from `has_pow`
instance nonempty_interval.has_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)]
  [covariant_class α α (swap (+)) (≤)] : has_smul ℕ (nonempty_interval α) :=
⟨λ n s, ⟨(n • s.fst, n • s.snd), nsmul_le_nsmul_of_le_right s.fst_le_snd _⟩⟩

section pow
variables [monoid α] [preorder α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)]

@[to_additive nonempty_interval.has_nsmul]
instance nonempty_interval.has_pow : has_pow (nonempty_interval α) ℕ :=
⟨λ s n, ⟨s.to_prod ^ n, pow_le_pow_of_le_left' s.fst_le_snd _⟩⟩

namespace nonempty_interval
variables (s : nonempty_interval α) (a : α) (n : ℕ)

@[simp, to_additive to_prod_nsmul] lemma to_prod_pow : (s ^ n).to_prod = s.to_prod ^ n := rfl
@[to_additive] lemma fst_pow : (s ^ n).fst = s.fst ^ n := rfl
@[to_additive] lemma snd_pow : (s ^ n).snd = s.snd ^ n := rfl
@[simp, to_additive] lemma pure_pow : pure a ^ n = pure (a ^ n) := rfl

end nonempty_interval
end pow

namespace nonempty_interval

@[to_additive]
instance [ordered_comm_monoid α] : comm_monoid (nonempty_interval α) :=
nonempty_interval.to_prod_injective.comm_monoid _ to_prod_one to_prod_mul to_prod_pow

end nonempty_interval

@[to_additive]
instance [ordered_comm_monoid α] : mul_one_class (interval α) :=
{ mul := (*),
  one := 1,
  one_mul := λ s, (option.map₂_coe_left _ _ _).trans $
    by simp only [nonempty_interval.pure_one, one_mul, ←id_def, option.map_id, id],
  mul_one := λ s, (option.map₂_coe_right _ _ _).trans $
    by simp only [nonempty_interval.pure_one, mul_one, ←id_def, option.map_id, id] }

@[to_additive]
instance [ordered_comm_monoid α] : comm_monoid (interval α) :=
{ mul_comm := λ _ _, option.map₂_comm mul_comm,
  mul_assoc := λ _ _ _, option.map₂_assoc mul_assoc,
  ..interval.mul_one_class }

namespace nonempty_interval

@[simp, to_additive] lemma coe_pow_interval [ordered_comm_monoid α] (s : nonempty_interval α)
  (n : ℕ) :
  (↑(s ^ n) : interval α) = s ^ n :=
map_pow (⟨coe, coe_one_interval, coe_mul_interval⟩ : nonempty_interval α →* interval α) _ _

end nonempty_interval

namespace interval
variables [ordered_comm_monoid α] (s : interval α) {n : ℕ}

@[to_additive] lemma bot_pow : ∀ {n : ℕ} (hn : n ≠ 0), (⊥ : interval α) ^ n = ⊥
| 0 h := (h rfl).elim
| (nat.succ n) _ := bot_mul (⊥ ^ n)

end interval

/-!
### Subtraction

Subtraction is defined more generally than division so that it applies to `ℕ` (and `has_ordered_div`
is not a thing and probably should not become one).
-/

section sub
variables [preorder α] [add_comm_semigroup α] [has_sub α] [has_ordered_sub α]
  [covariant_class α α (+) (≤)]

instance : has_sub (nonempty_interval α) :=
⟨λ s t, ⟨(s.fst - t.snd, s.snd - t.fst), tsub_le_tsub s.fst_le_snd t.fst_le_snd⟩⟩

instance : has_sub (interval α) := ⟨option.map₂ has_sub.sub⟩

namespace nonempty_interval
variables (s t : nonempty_interval α) {a b : α}

@[simp] lemma fst_sub : (s - t).fst = s.fst - t.snd := rfl
@[simp] lemma snd_sub : (s - t).snd = s.snd - t.fst := rfl
@[simp] lemma coe_sub_interval : (↑(s - t) : interval α) = s - t := rfl
lemma sub_mem_sub (ha : a ∈ s) (hb : b ∈ t) : a - b ∈ s - t :=
⟨tsub_le_tsub ha.1 hb.2, tsub_le_tsub ha.2 hb.1⟩
@[simp] lemma pure_sub_pure (a b : α) : pure a - pure b = pure (a - b) := rfl

end nonempty_interval

namespace interval
variables (s t : interval α)

@[simp] lemma bot_sub : ⊥ - t = ⊥ := rfl
@[simp] lemma sub_bot : s - ⊥ = ⊥ := option.map₂_none_right _ _

end interval
end sub

/-!
### Division in ordered groups

Note that this division does not apply to `ℚ` or `ℝ`.
-/

section div
variables [preorder α] [comm_group α] [covariant_class α α (*) (≤)]

@[to_additive] instance : has_div (nonempty_interval α) :=
⟨λ s t, ⟨(s.fst / t.snd, s.snd / t.fst), div_le_div'' s.fst_le_snd t.fst_le_snd⟩⟩

@[to_additive] instance : has_div (interval α) := ⟨option.map₂ (/)⟩

namespace nonempty_interval
variables (s t : nonempty_interval α) (a b : α)

@[simp, to_additive] lemma fst_div : (s / t).fst = s.fst / t.snd := rfl
@[simp, to_additive] lemma snd_div : (s / t).snd = s.snd / t.fst := rfl
@[simp, to_additive] lemma coe_div_interval : (↑(s / t) : interval α) = s / t := rfl
@[to_additive] lemma div_mem_div (ha : a ∈ s) (hb : b ∈ t) : a / b ∈ s / t :=
⟨div_le_div'' ha.1 hb.2, div_le_div'' ha.2 hb.1⟩
@[simp, to_additive] lemma pure_div_pure : pure a / pure b = pure (a / b) := rfl

end nonempty_interval

namespace interval
variables (s t : interval α)

@[simp, to_additive] lemma bot_div : ⊥ / t = ⊥ := rfl
@[simp, to_additive] lemma div_bot : s / ⊥ = ⊥ := option.map₂_none_right _ _

end interval
end div

/-! ### Negation/inversion -/

section inv
variables [ordered_comm_group α]

@[to_additive] instance : has_inv (nonempty_interval α) :=
⟨λ s, ⟨(s.snd⁻¹, s.fst⁻¹), inv_le_inv' s.fst_le_snd⟩⟩

@[to_additive] instance : has_inv (interval α) := ⟨option.map has_inv.inv⟩

namespace nonempty_interval
variables (s t : nonempty_interval α) (a : α)

@[simp, to_additive] lemma fst_inv : s⁻¹.fst = s.snd⁻¹ := rfl
@[simp, to_additive] lemma snd_inv : s⁻¹.snd = s.fst⁻¹ := rfl
@[simp, to_additive] lemma coe_inv_interval : (↑(s⁻¹) : interval α) = s⁻¹ := rfl
@[to_additive] lemma inv_mem_inv (ha : a ∈ s) : a⁻¹ ∈ s⁻¹ := ⟨inv_le_inv' ha.2, inv_le_inv' ha.1⟩
@[simp, to_additive] lemma inv_pure : (pure a)⁻¹ = pure a⁻¹ := rfl

end nonempty_interval

@[simp, to_additive] lemma interval.inv_bot : (⊥ : interval α)⁻¹ = ⊥ := rfl

end inv

namespace nonempty_interval
variables [ordered_comm_group α] {s t : nonempty_interval α}

@[to_additive] protected lemma mul_eq_one_iff :
  s * t = 1 ↔ ∃ a b, s = pure a ∧ t = pure b ∧ a * b = 1 :=
begin
  refine ⟨λ h, _, _⟩,
  { rw [ext_iff, prod.ext_iff] at h,
    have := (mul_le_mul_iff_of_ge s.fst_le_snd t.fst_le_snd).1 (h.2.trans h.1.symm).le,
    refine ⟨s.fst, t.fst, _, _, h.1⟩; ext; try { refl },
    exacts [this.1.symm, this.2.symm] },
  { rintro ⟨b, c, rfl, rfl, h⟩,
    rw [pure_mul_pure, h, pure_one] }
end

instance {α : Type u} [ordered_add_comm_group α] : subtraction_comm_monoid (nonempty_interval α) :=
{ neg := has_neg.neg,
  sub := has_sub.sub,
  sub_eq_add_neg := λ s t, by ext; exact sub_eq_add_neg _ _,
  neg_neg := λ s, by ext; exact neg_neg _,
  neg_add_rev := λ s t, by ext; exact neg_add_rev _ _,
  neg_eq_of_add := λ s t h, begin
    obtain ⟨a, b, rfl, rfl, hab⟩ := nonempty_interval.add_eq_zero_iff.1 h,
    rw [neg_pure, neg_eq_of_add_eq_zero_right hab],
  end,
  ..nonempty_interval.add_comm_monoid }

@[to_additive nonempty_interval.subtraction_comm_monoid]
instance : division_comm_monoid (nonempty_interval α) :=
{ inv := has_inv.inv,
  div := (/),
  div_eq_mul_inv := λ s t, by ext; exact div_eq_mul_inv _ _,
  inv_inv := λ s, by ext; exact inv_inv _,
  mul_inv_rev := λ s t, by ext; exact mul_inv_rev _ _,
  inv_eq_of_mul := λ s t h, begin
    obtain ⟨a, b, rfl, rfl, hab⟩ := nonempty_interval.mul_eq_one_iff.1 h,
    rw [inv_pure, inv_eq_of_mul_eq_one_right hab],
  end,
  ..nonempty_interval.comm_monoid }

end nonempty_interval

namespace interval
variables [ordered_comm_group α] {s t : interval α}

@[to_additive] protected lemma mul_eq_one_iff :
  s * t = 1 ↔ ∃ a b, s = pure a ∧ t = pure b ∧ a * b = 1 :=
begin
  cases s,
  { simp [with_bot.none_eq_bot] },
  cases t,
  { simp [with_bot.none_eq_bot] },
  { simp [with_bot.some_eq_coe, ←nonempty_interval.coe_mul_interval,
    nonempty_interval.mul_eq_one_iff] }
end

instance {α : Type u} [ordered_add_comm_group α] : subtraction_comm_monoid (interval α) :=
{ neg := has_neg.neg,
  sub := has_sub.sub,
  sub_eq_add_neg := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (sub_eq_add_neg _ _),
  neg_neg := by rintro (_ | s); refl <|> exact congr_arg some (neg_neg _),
  neg_add_rev := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (neg_add_rev _ _),
  neg_eq_of_add := by rintro (_ | s) (_ | t) h;
    cases h <|> exact congr_arg some (neg_eq_of_add_eq_zero_right $ option.some_injective _ h),
  ..interval.add_comm_monoid }

@[to_additive interval.subtraction_comm_monoid]
instance : division_comm_monoid (interval α) :=
{ inv := has_inv.inv,
  div := (/),
  div_eq_mul_inv := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (div_eq_mul_inv _ _),
  inv_inv := by rintro (_ | s); refl <|> exact congr_arg some (inv_inv _),
  mul_inv_rev := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (mul_inv_rev _ _),
  inv_eq_of_mul := by rintro (_ | s) (_ | t) h;
    cases h <|> exact congr_arg some (inv_eq_of_mul_eq_one_right $ option.some_injective _ h),
  ..interval.comm_monoid }

end interval

section length
variables [ordered_add_comm_group α]

namespace nonempty_interval
variables (s t : nonempty_interval α) (a : α)

/-- The length of an interval is its first component minus its second component. This measures the
accuracy of the approximation by an interval. -/
def length : α := s.snd - s.fst

@[simp] lemma length_nonneg : 0 ≤ s.length := sub_nonneg_of_le s.fst_le_snd
@[simp] lemma length_pure : (pure a).length = 0 := sub_self _
@[simp] lemma length_zero : (0 : nonempty_interval α).length = 0 := length_pure _
@[simp] lemma length_neg : (-s).length = s.length := neg_sub_neg _ _
@[simp] lemma length_add : (s + t).length = s.length + t.length := add_sub_add_comm _ _ _ _
@[simp] lemma length_sub : (s - t).length = s.length + t.length := by simp [sub_eq_add_neg]

@[simp] lemma length_sum (f : ι → nonempty_interval α) (s : finset ι) :
  (∑ i in s, f i).length = ∑ i in s, (f i).length :=
map_sum (⟨length, length_zero, length_add⟩ : nonempty_interval α →+ α) _ _

end nonempty_interval

namespace interval
variables (s t : interval α) (a : α)

/-- The length of an interval is its first component minus its second component. This measures the
accuracy of the approximation by an interval. -/
def length : interval α → α
| ⊥ := 0
| (s : nonempty_interval α) := s.length

@[simp] lemma length_nonneg : ∀ s : interval α, 0 ≤ s.length
| ⊥ := le_rfl
| (s : nonempty_interval α) := s.length_nonneg
@[simp] lemma length_pure : (pure a).length = 0 := nonempty_interval.length_pure _
@[simp] lemma length_zero : (0 : interval α).length = 0 := length_pure _
@[simp] lemma length_neg :  ∀ s : interval α, (-s).length = s.length
| ⊥ := rfl
| (s : nonempty_interval α) := s.length_neg
lemma length_add_le : ∀ s t : interval α, (s + t).length ≤ s.length + t.length
| ⊥ _ := by simp
| _ ⊥ := by simp
| (s : nonempty_interval α) (t : nonempty_interval α) := (s.length_add t).le
lemma length_sub_le : (s - t).length ≤ s.length + t.length :=
by simpa [sub_eq_add_neg] using length_add_le s (-t)

lemma length_sum_le (f : ι → interval α) (s : finset ι) :
  (∑ i in s, f i).length ≤ ∑ i in s, (f i).length :=
finset.le_sum_of_subadditive _ length_zero length_add_le _ _

end interval
end length

namespace tactic
open positivity

/-- Extension for the `positivity` tactic: The length of an interval is always nonnegative. -/
@[positivity]
meta def positivity_interval_length : expr → tactic strictness
| `(nonempty_interval.length %%s) := nonnegative <$> mk_app `nonempty_interval.length_nonneg [s]
| `(interval.length %%s) := nonnegative <$> mk_app `interval.length_nonneg [s]
| e := pp e >>= fail ∘ format.bracket "The expression `"
         "` isn't of the form `nonempty_interval.length s` or `interval.length s`"

end tactic


import data.int.modeq tactic.by_contra tactic.wlog

/-! # IMO 2007 N6 (P5) -/

namespace IMOSL
namespace IMO2007N6

private lemma bad_symm {n : ℤ} {a b : ℕ} (h : n * a * b - 1 ∣ (n * a ^ 2 - 1) ^ 2) :
  n * b * a - 1 ∣ (n * b ^ 2 - 1) ^ 2 :=
begin
  rw [mul_right_comm, sub_sq', add_comm, mul_right_comm _ _ (1 : ℤ), ← sub_sq'],
  replace h := dvd_mul_of_dvd_left h ((n * b ^ 2) ^ 2),
  rw [← mul_pow, sub_one_mul, mul_mul_mul_comm, ← sq, ← mul_pow, ← mul_pow, ← mul_assoc] at h,
  rw ← int.modeq_zero_iff_dvd at h ⊢,
  revert h; refine ((int.modeq.sub_right _ _).pow _).trans,
  nth_rewrite 1 ← one_pow 2,
  exact ((n * a * b).modeq_sub 1).symm.pow 2
end

private lemma bad_exists_descent {n : ℤ} (hn : 1 < n) {a : ℕ}
  (h : 0 < a ∧ ∃ b : ℕ, a < b ∧ n * a * b - 1 ∣ (n * a ^ 2 - 1) ^ 2) :
  ∃ c : ℕ, 0 < c ∧ c < a ∧ n * c * a - 1 ∣ (n * c ^ 2 - 1) ^ 2 :=
begin
  rcases h with ⟨h, b, h0, k, h1⟩,
  rw [sq (a : ℤ), ← mul_assoc] at h1,
  generalize_hyp ht : n * a = t at h1,
  obtain ⟨c, rfl⟩ : ∃ c : ℤ, k = t * c - 1 :=
  begin
    replace h1 : (t * a - 1) ^ 2 ≡ (t * b - 1) * k [ZMOD t] := by rw h1,
    have X : ∀ m : ℤ, t * m - 1 ≡ -1 [ZMOD t] :=
      λ m, by symmetry; rw [int.modeq_iff_dvd, sub_neg_eq_add, sub_add_cancel]; exact ⟨m, rfl⟩,
    replace h1 := ((X a).pow 2).symm.trans (h1.trans ((X b).mul_right _)),
    rw [int.modeq_iff_dvd, sq, ← mul_sub, sub_neg_eq_add, neg_one_mul, dvd_neg] at h1,
    cases h1 with c h1,
    use c; rw [eq_sub_iff_add_eq, h1]
  end,

  ---- It suffices to show that `0 < c` and `c < (a : ℤ)`
  suffices h2 : c < a ∧ 0 < c,
  { lift c to ℕ using le_of_lt h2.2,
    rw [int.coe_nat_pos, int.coe_nat_lt] at h2,
    refine ⟨c, h2.2, h2.1, bad_symm _⟩,
    use t * b - 1; rw [sq (a : ℤ), ← mul_assoc, ht, h1, mul_comm] },

  ---- We do not need `n`; we just use `t` instead.
  replace ht : 1 < t :=
  begin
    rw ← int.coe_nat_pos at h,
    have h2 := le_trans int.one_nonneg (le_of_lt hn),
    rw int.lt_iff_add_one_le at hn h ⊢,
    rw ← ht; refine le_of_eq_of_le _ (mul_le_mul hn h zero_le_one h2),
    rw [zero_add, mul_one]
  end,
  clear hn n,

  ---- Some ordering results
  have h2 := lt_trans one_pos ht,
  have h3 : ∀ x y : ℤ, x < y ↔ t * x - 1 < t * y - 1 :=
    λ x y, by rw [sub_lt_sub_iff_right, ← mul_lt_mul_left h2],
  replace h2 : ∀ x : ℤ, 0 < x ↔ 0 < t * x - 1 :=
  begin
    intros x,
    rw [h3, mul_zero, int.lt_iff_add_one_le, sub_add_cancel, le_iff_eq_or_lt],
    refine or_iff_right (λ h4, _),
    rw [eq_comm, sub_eq_zero] at h4,
    exact ne_of_gt ht (int.eq_one_of_mul_eq_one_right (le_of_lt h2) h4)
  end,

  ---- Rearranging and final step
  rw [← int.coe_nat_pos, h2] at h,
  rw [← int.coe_nat_lt, h3] at h0,
  rw [h2, h3 c],
  generalize_hyp : t * a - 1 = x at h h0 h1 ⊢,
  generalize_hyp : t * b - 1 = y at h0 h1 ⊢,
  generalize_hyp : t * c - 1 = z at h1 ⊢,
  clear ht h2 h3 a b c t; split,
  rwa [← mul_lt_mul_left (lt_trans h h0), ← h1, sq, mul_lt_mul_right h],
  rw [← mul_lt_mul_left (lt_trans h h0), mul_zero, ← h1],
  exact pow_pos h 2
end

private lemma nat_pred_descent {P : ℕ → Prop} [decidable_pred P]
    (h : ∀ k : ℕ, P k → ∃ m : ℕ, m < k ∧ P m) :
  ∀ k : ℕ, ¬P k :=
begin
  by_contra' h0,
  replace h := h (nat.find h0) (nat.find_spec h0),
  rcases h with ⟨m, h, h1⟩,
  exact nat.find_min h0 h h1
end

open_locale classical

/-- Final solution -/
theorem final_solution {n : ℤ} (hn : 1 < n) :
  ∀ a b : ℕ, 0 < a → 0 < b → n * a * b - 1 ∣ (n * a ^ 2 - 1) ^ 2 → a = b :=
begin
  let P : ℕ → Prop := λ k, (0 < k ∧ ∃ m : ℕ, k < m ∧ n * k * m - 1 ∣ (n * k ^ 2 - 1) ^ 2),
  have h : ∀ k : ℕ, P k → ∃ m : ℕ, m < k ∧ P m :=
  begin
    intros k h,
    replace h := bad_exists_descent hn h,
    rcases h with ⟨c, h, h0, h1⟩,
    exact ⟨c, h0, h, k, h0, h1⟩
  end,

  replace h := nat_pred_descent h,
  dsimp only [P] at h,
  intros a b ha hb h0; by_contra' h1,
  rw [← ne.def, ne_iff_lt_or_gt, gt_iff_lt] at h1,
  have h2 := bad_symm h0,
  wlog h1 : a < b := h1 using [a b, b a],
  exact h a ⟨ha, b, h1, h0⟩
end

end IMO2007N6
end IMOSL


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module init.classical
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Subtype.Basic
import Leanbin.Init.Funext

namespace Classical

universe u v

#print Classical.choice /-
/-- The axiom -/
axiom choice {α : Sort u} : Nonempty α → α
#align classical.choice Classical.choice
-/

#print Classical.indefiniteDescription /-
noncomputable irreducible_def indefiniteDescription {α : Sort u} (p : α → Prop) (h : ∃ x, p x) :
  { x // p x } :=
  choice <|
    let ⟨x, px⟩ := h
    ⟨⟨x, px⟩⟩
#align classical.indefinite_description Classical.indefiniteDescription
-/

#print Classical.choose /-
noncomputable def choose {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : α :=
  (indefiniteDescription p h).val
#align classical.some Classical.choose
-/

#print Classical.choose_spec /-
theorem choose_spec {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : p (choose h) :=
  (indefiniteDescription p h).property
#align classical.some_spec Classical.choose_spec
-/

/- Diaconescu's theorem: using function extensionality and propositional extensionality,
   we can get excluded middle from this. -/
section Diaconescu

parameter (p : Prop)

private def U (x : Prop) : Prop :=
  x = True ∨ p
#align classical.U classical.U

private def V (x : Prop) : Prop :=
  x = False ∨ p
#align classical.V classical.V

private theorem exU : ∃ x, U x :=
  ⟨True, Or.inl rfl⟩
#align classical.exU classical.exU

private theorem exV : ∃ x, V x :=
  ⟨False, Or.inl rfl⟩
#align classical.exV classical.exV

private def u : Prop :=
  choose exU
#align classical.u classical.u

private def v : Prop :=
  choose exV
#align classical.v classical.v

private theorem u_def : U u :=
  choose_spec exU
#align classical.u_def classical.u_def

private theorem v_def : V v :=
  choose_spec exV
#align classical.v_def classical.v_def

private theorem not_uv_or_p : u ≠ v ∨ p :=
  Or.elim u_def
    (fun hut : u = True =>
      Or.elim v_def
        (fun hvf : v = False =>
          have hne : u ≠ v := hvf.symm ▸ hut.symm ▸ true_ne_false
          Or.inl hne)
        Or.inr)
    Or.inr
#align classical.not_uv_or_p classical.not_uv_or_p

private theorem p_implies_uv (hp : p) : u = v :=
  have hpred : U = V :=
    funext fun x : Prop =>
      have hl : x = True ∨ p → x = False ∨ p := fun a => Or.inr hp
      have hr : x = False ∨ p → x = True ∨ p := fun a => Or.inr hp
      show (x = True ∨ p) = (x = False ∨ p) from propext (Iff.intro hl hr)
  have h₀ : ∀ exU exV, @choose _ U exU = @choose _ V exV := hpred ▸ fun exU exV => rfl
  show u = v from h₀ _ _
#align classical.p_implies_uv classical.p_implies_uv

#print Classical.em /-
theorem em : p ∨ ¬p :=
  Or.elim not_uv_or_p (fun hne : u ≠ v => Or.inr (mt p_implies_uv hne)) Or.inl
#align classical.em Classical.em
-/

end Diaconescu

#print Classical.exists_true_of_nonempty /-
theorem exists_true_of_nonempty {α : Sort u} : Nonempty α → ∃ x : α, True
  | ⟨x⟩ => ⟨x, trivial⟩
#align classical.exists_true_of_nonempty Classical.exists_true_of_nonempty
-/

#print Classical.inhabited_of_nonempty /-
noncomputable def inhabited_of_nonempty {α : Sort u} (h : Nonempty α) : Inhabited α :=
  ⟨choice h⟩
#align classical.inhabited_of_nonempty Classical.inhabited_of_nonempty
-/

#print Classical.inhabited_of_exists /-
noncomputable def inhabited_of_exists {α : Sort u} {p : α → Prop} (h : ∃ x, p x) : Inhabited α :=
  inhabited_of_nonempty (Exists.elim h fun w hw => ⟨w⟩)
#align classical.inhabited_of_exists Classical.inhabited_of_exists
-/

#print Classical.propDecidable /-
/-- All propositions are decidable -/
noncomputable def propDecidable (a : Prop) : Decidable a :=
  choice <| Or.elim (em a) (fun ha => ⟨isTrue ha⟩) fun hna => ⟨isFalse hna⟩
#align classical.prop_decidable Classical.propDecidable
-/

attribute [local instance] prop_decidable

#print Classical.decidableInhabited /-
noncomputable def decidableInhabited (a : Prop) : Inhabited (Decidable a) :=
  ⟨propDecidable a⟩
#align classical.decidable_inhabited Classical.decidableInhabited
-/

attribute [local instance] decidable_inhabited

#print Classical.typeDecidableEq /-
noncomputable def typeDecidableEq (α : Sort u) : DecidableEq α := fun x y => propDecidable (x = y)
#align classical.type_decidable_eq Classical.typeDecidableEq
-/

#print Classical.typeDecidable /-
noncomputable def typeDecidable (α : Sort u) : PSum α (α → False) :=
  match propDecidable (Nonempty α) with
  | is_true hp => PSum.inl (@Inhabited.default _ (inhabited_of_nonempty hp))
  | is_false hn => PSum.inr fun a => absurd (Nonempty.intro a) hn
#align classical.type_decidable Classical.typeDecidable
-/

#print Classical.strongIndefiniteDescription /-
noncomputable irreducible_def strongIndefiniteDescription {α : Sort u} (p : α → Prop)
  (h : Nonempty α) : { x : α // (∃ y : α, p y) → p x } :=
  if hp : ∃ x : α, p x then
    let xp := indefiniteDescription _ hp
    ⟨xp.val, fun h' => xp.property⟩
  else ⟨choice h, fun h => absurd h hp⟩
#align classical.strong_indefinite_description Classical.strongIndefiniteDescription
-/

#print Classical.epsilon /-
/-- The Hilbert epsilon function -/
noncomputable def epsilon {α : Sort u} [h : Nonempty α] (p : α → Prop) : α :=
  (strongIndefiniteDescription p h).val
#align classical.epsilon Classical.epsilon
-/

#print Classical.epsilon_spec_aux /-
theorem epsilon_spec_aux {α : Sort u} (h : Nonempty α) (p : α → Prop) :
    (∃ y, p y) → p (@epsilon α h p) :=
  (strongIndefiniteDescription p h).property
#align classical.epsilon_spec_aux Classical.epsilon_spec_aux
-/

#print Classical.epsilon_spec /-
theorem epsilon_spec {α : Sort u} {p : α → Prop} (hex : ∃ y, p y) :
    p (@epsilon α (nonempty_of_exists hex) p) :=
  epsilon_spec_aux (nonempty_of_exists hex) p hex
#align classical.epsilon_spec Classical.epsilon_spec
-/

#print Classical.epsilon_singleton /-
theorem epsilon_singleton {α : Sort u} (x : α) : (@epsilon α ⟨x⟩ fun y => y = x) = x :=
  @epsilon_spec α (fun y => y = x) ⟨x, rfl⟩
#align classical.epsilon_singleton Classical.epsilon_singleton
-/

#print Classical.axiom_of_choice /-
/-- The axiom of choice -/
theorem axiom_of_choice {α : Sort u} {β : α → Sort v} {r : ∀ x, β x → Prop} (h : ∀ x, ∃ y, r x y) :
    ∃ f : ∀ x, β x, ∀ x, r x (f x) :=
  ⟨_, fun x => choose_spec (h x)⟩
#align classical.axiom_of_choice Classical.axiom_of_choice
-/

#print Classical.skolem /-
theorem skolem {α : Sort u} {b : α → Sort v} {p : ∀ x, b x → Prop} :
    (∀ x, ∃ y, p x y) ↔ ∃ f : ∀ x, b x, ∀ x, p x (f x) :=
  ⟨axiom_of_choice, fun ⟨f, hw⟩ x => ⟨f x, hw x⟩⟩
#align classical.skolem Classical.skolem
-/

#print Classical.prop_complete /-
theorem prop_complete (a : Prop) : a = True ∨ a = False :=
  Or.elim (em a) (fun t => Or.inl (eq_true t)) fun f => Or.inr (eq_false f)
#align classical.prop_complete Classical.prop_complete
-/

section Aux

#print Classical.cases_true_false /-
@[elab_as_elim]
theorem cases_true_false (p : Prop → Prop) (h1 : p True) (h2 : p False) (a : Prop) : p a :=
  Or.elim (prop_complete a) (fun ht : a = True => ht.symm ▸ h1) fun hf : a = False => hf.symm ▸ h2
#align classical.cases_true_false Classical.cases_true_false
-/

#print Classical.cases_on /-
theorem cases_on (a : Prop) {p : Prop → Prop} (h1 : p True) (h2 : p False) : p a :=
  cases_true_false p h1 h2 a
#align classical.cases_on Classical.cases_on
-/

#print by_cases /-
-- this supercedes by_cases in decidable
theorem by_cases {p q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
  Decidable.byCases hpq hnpq
#align classical.by_cases by_cases
-/

#print by_contradiction /-
-- this supercedes by_contradiction in decidable
theorem by_contradiction {p : Prop} (h : ¬p → False) : p :=
  Decidable.by_contradiction h
#align classical.by_contradiction by_contradiction
-/

#print Classical.eq_false_or_eq_true /-
theorem eq_false_or_eq_true (a : Prop) : a = False ∨ a = True :=
  (prop_complete a).symm
#align classical.eq_false_or_eq_true Classical.eq_false_or_eq_true
-/

end Aux

end Classical


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

universe u
variables {α : Type u}

lemma not_le_of_lt [preorder α] {a b : α} (h : a < b) : ¬ b ≤ a :=
(le_not_le_of_lt h).right

lemma not_lt_of_le [preorder α] {a b : α} (h : a ≤ b) : ¬ b < a
| hab := not_le_of_gt hab h

lemma le_iff_eq_or_lt [partial_order α] {a b : α} : a ≤ b ↔ a = b ∨ a < b :=
le_iff_lt_or_eq.trans or.comm

lemma lt_iff_le_and_ne [partial_order α] {a b : α} : a < b ↔ a ≤ b ∧ a ≠ b :=
⟨λ h, ⟨le_of_lt h, ne_of_lt h⟩, λ ⟨h1, h2⟩, lt_of_le_of_ne h1 h2⟩

lemma eq_or_lt_of_le [partial_order α] {a b : α} (h : a ≤ b) : a = b ∨ a < b :=
(lt_or_eq_of_le h).symm

@[simp] lemma not_lt [linear_order α] {a b : α} : ¬ a < b ↔ b ≤ a := ⟨le_of_not_gt, not_lt_of_ge⟩

lemma le_of_not_lt [linear_order α] {a b : α} : ¬ a < b → b ≤ a := not_lt.1

@[simp] lemma not_le [linear_order α] {a b : α} : ¬ a ≤ b ↔ b < a := (lt_iff_not_ge b a).symm

lemma lt_or_le [linear_order α] : ∀ a b : α, a < b ∨ b ≤ a := lt_or_ge
lemma le_or_lt [linear_order α] : ∀ a b : α, a ≤ b ∨ b < a := le_or_gt

lemma not_lt_iff_eq_or_lt [linear_order α] {a b : α} : ¬ a < b ↔ a = b ∨ b < a :=
not_lt.trans $ le_iff_eq_or_lt.trans $ or_congr eq_comm iff.rfl

lemma exists_ge_of_linear [linear_order α] (a b : α) : ∃ c, a ≤ c ∧ b ≤ c :=
match le_total a b with
| or.inl h := ⟨_, h, le_refl _⟩
| or.inr h := ⟨_, le_refl _, h⟩
end

lemma lt_iff_lt_of_strict_mono {β} [linear_order α] [preorder β]
  (f : α → β) (H : ∀ a b, a < b → f a < f b) {a b} :
  f a < f b ↔ a < b :=
⟨λ h, ((lt_trichotomy b a)
  .resolve_left $ λ h', lt_asymm h $ H _ _ h')
  .resolve_left $ λ e, ne_of_gt h $ congr_arg _ e, H _ _⟩

lemma le_iff_le_of_strict_mono {β} [linear_order α] [preorder β]
  (f : α → β) (H : ∀ a b, a < b → f a < f b) {a b} :
  f a ≤ f b ↔ a ≤ b :=
⟨λ h, le_of_not_gt $ λ h', not_le_of_lt (H b a h') h,
 λ h, (lt_or_eq_of_le h).elim (λ h', le_of_lt (H _ _ h')) (λ h', h' ▸ le_refl _)⟩

lemma injective_of_strict_mono {β} [linear_order α] [preorder β]
  (f : α → β) (H : ∀ a b, a < b → f a < f b) : function.injective f
| a b e := ((lt_trichotomy a b)
  .resolve_left $ λ h, ne_of_lt (H _ _ h) e)
  .resolve_right $ λ h, ne_of_gt (H _ _ h) e

lemma le_imp_le_iff_lt_imp_lt {β} [linear_order α] [linear_order β] {a b : α} {c d : β} :
  (a ≤ b → c ≤ d) ↔ (d < c → b < a) :=
⟨λ H h, lt_of_not_ge $ λ h', not_lt_of_ge (H h') h,
λ H h, le_of_not_gt $ λ h', not_le_of_gt (H h') h⟩

lemma le_iff_le_iff_lt_iff_lt {β} [linear_order α] [linear_order β] {a b : α} {c d : β} :
  (a ≤ b ↔ c ≤ d) ↔ (b < a ↔ d < c) :=
⟨λ H, not_le.symm.trans $ iff.trans (not_congr H) $ not_le,
λ H, not_lt.symm.trans $ iff.trans (not_congr H) $ not_lt⟩

lemma eq_of_forall_le_iff [partial_order α] {a b : α}
  (H : ∀ c, c ≤ a ↔ c ≤ b) : a = b :=
le_antisymm ((H _).1 (le_refl _)) ((H _).2 (le_refl _))

lemma le_of_forall_le [preorder α] {a b : α}
  (H : ∀ c, c ≤ a → c ≤ b) : a ≤ b :=
H _ (le_refl _)

lemma le_of_forall_lt [linear_order α] {a b : α}
  (H : ∀ c, c < a → c < b) : a ≤ b :=
le_of_not_lt $ λ h, lt_irrefl _ (H _ h)

lemma eq_of_forall_ge_iff [partial_order α] {a b : α}
  (H : ∀ c, a ≤ c ↔ b ≤ c) : a = b :=
le_antisymm ((H _).2 (le_refl _)) ((H _).1 (le_refl _))

namespace ordering

/-- `compares o a b` means that `a` and `b` have the ordering relation
  `o` between them, assuming that the relation `a < b` is defined -/
@[simp] def compares [has_lt α] : ordering → α → α → Prop
| lt a b := a < b
| eq a b := a = b
| gt a b := a > b

theorem compares.eq_lt [preorder α] :
  ∀ {o} {a b : α}, compares o a b → (o = lt ↔ a < b)
| lt a b h := ⟨λ _, h, λ _, rfl⟩
| eq a b h := ⟨λ h, by injection h, λ h', (ne_of_lt h' h).elim⟩
| gt a b h := ⟨λ h, by injection h, λ h', (lt_asymm h h').elim⟩

theorem compares.eq_eq [preorder α] :
  ∀ {o} {a b : α}, compares o a b → (o = eq ↔ a = b)
| lt a b h := ⟨λ h, by injection h, λ h', (ne_of_lt h h').elim⟩
| eq a b h := ⟨λ _, h, λ _, rfl⟩
| gt a b h := ⟨λ h, by injection h, λ h', (ne_of_gt h h').elim⟩

theorem compares.eq_gt [preorder α] :
  ∀ {o} {a b : α}, compares o a b → (o = gt ↔ a > b)
| lt a b h := ⟨λ h, by injection h, λ h', (lt_asymm h h').elim⟩
| eq a b h := ⟨λ h, by injection h, λ h', (ne_of_gt h' h).elim⟩
| gt a b h := ⟨λ _, h, λ _, rfl⟩

theorem compares.inj [preorder α] {o₁} :
  ∀ {o₂} {a b : α}, compares o₁ a b → compares o₂ a b → o₁ = o₂
| lt a b h₁ h₂ := h₁.eq_lt.2 h₂
| eq a b h₁ h₂ := h₁.eq_eq.2 h₂
| gt a b h₁ h₂ := h₁.eq_gt.2 h₂

theorem compares_of_strict_mono {β} [linear_order α] [preorder β]
  (f : α → β) (H : ∀ a b, a < b → f a < f b) {a b} : ∀ {o}, compares o (f a) (f b) ↔ compares o a b
| lt := lt_iff_lt_of_strict_mono f H
| eq := ⟨λ h, injective_of_strict_mono _ H h, congr_arg _⟩
| gt := lt_iff_lt_of_strict_mono f H

end ordering