/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.metric_space.gluing
import topology.metric_space.hausdorff_distance
import topology.continuous_function.bounded

/-!
# The Gromov-Hausdorff distance is realized

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

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

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

noncomputable theory
open_locale classical topological_space nnreal
universes u v w

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

local attribute [instance] metric_space_sum

namespace Gromov_Hausdorff

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

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

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

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

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

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

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

end definitions --section

section constructions

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

private lemma max_var_bound : dist x y ≤ max_var X Y := calc
  dist x y ≤ diam (univ : set (X ⊕ Y)) :
    dist_le_diam_of_mem bounded_of_compact_space (mem_univ _) (mem_univ _)
  ... = diam (inl '' (univ : set X) ∪ inr '' (univ : set Y)) :
    by apply congr_arg; ext x y z; cases x; simp [mem_univ, mem_range_self]
  ... ≤ diam (inl '' (univ : set X)) + dist (inl (default X)) (inr (default Y)) +
          diam (inr '' (univ : set Y)) :
    diam_union (mem_image_of_mem _ (mem_univ _)) (mem_image_of_mem _ (mem_univ _))
  ... = diam (univ : set X) + (dist (default X) (default X) + 1 + dist (default Y) (default Y)) +
          diam (univ : set Y) :
    by { rw [isometry_on_inl.diam_image, isometry_on_inr.diam_image], refl }
  ... = 1 * diam (univ : set X) + 1 + 1 * diam (univ : set Y) : by simp
  ... ≤ 2 * diam (univ : set X) + 1 + 2 * diam (univ : set Y) :
  begin
    apply_rules [add_le_add, mul_le_mul_of_nonneg_right, diam_nonneg, le_refl],
    norm_num, norm_num
  end

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end constructions --section

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

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

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

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

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

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

local attribute [instance] premetric_optimal_GH_dist pseudo_metric.dist_setoid

/-- A metric space which realizes the optimal coupling between `X` and `Y` -/
@[derive metric_space, nolint has_inhabited_instance]
definition optimal_GH_coupling : Type* :=
pseudo_metric_quot (X ⊕ Y)

/-- Injection of `X` in the optimal coupling between `X` and `Y` -/
def optimal_GH_injl (x : X) : optimal_GH_coupling X Y := ⟦inl x⟧

/-- The injection of `X` in the optimal coupling between `X` and `Y` is an isometry. -/
lemma isometry_optimal_GH_injl : isometry (optimal_GH_injl X Y) :=
begin
  refine isometry_emetric_iff_metric.2 (λx y, _),
  change dist ⟦inl x⟧ ⟦inl y⟧ = dist x y,
  exact candidates_dist_inl (optimal_GH_dist_mem_candidates_b X Y) _ _,
end

/-- Injection of `Y` in the optimal coupling between `X` and `Y` -/
def optimal_GH_injr (y : Y) : optimal_GH_coupling X Y := ⟦inr y⟧

/-- The injection of `Y` in the optimal coupling between `X` and `Y` is an isometry. -/
lemma isometry_optimal_GH_injr : isometry (optimal_GH_injr X Y) :=
begin
  refine isometry_emetric_iff_metric.2 (λx y, _),
  change dist ⟦inr x⟧ ⟦inr y⟧ = dist x y,
  exact candidates_dist_inr (optimal_GH_dist_mem_candidates_b X Y) _ _,
end

/-- The optimal coupling between two compact spaces `X` and `Y` is still a compact space -/
instance compact_space_optimal_GH_coupling : compact_space (optimal_GH_coupling X Y) :=
⟨begin
  have : (univ : set (optimal_GH_coupling X Y)) =
           (optimal_GH_injl X Y '' univ) ∪ (optimal_GH_injr X Y '' univ),
  { refine subset.antisymm (λxc hxc, _) (subset_univ _),
    rcases quotient.exists_rep xc with ⟨x, hx⟩,
    cases x; rw ← hx,
    { have : ⟦inl x⟧ = optimal_GH_injl X Y x := rfl,
      rw this,
      exact mem_union_left _ (mem_image_of_mem _ (mem_univ _)) },
    { have : ⟦inr x⟧ = optimal_GH_injr X Y x := rfl,
      rw this,
      exact mem_union_right _ (mem_image_of_mem _ (mem_univ _)) } },
  rw this,
  exact (compact_univ.image (isometry_optimal_GH_injl X Y).continuous).union
    (compact_univ.image (isometry_optimal_GH_injr X Y).continuous)
end⟩

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

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

end Gromov_Hausdorff


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

/-!
# Isometries of the Complex Plane

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

## References

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

open complex
open_locale complex_conjugate

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

/-- An element of the unit circle defines a `linear_isometry_equiv` from `ℂ` to itself, by
rotation. -/
def rotation : circle →* (ℂ ≃ₗᵢ[ℝ] ℂ) :=
{ to_fun := λ a,
  { norm_map' := λ x, show |a * x| = |x|, by rw [complex.abs_mul, abs_coe_circle, one_mul],
    ..distrib_mul_action.to_linear_equiv ℝ ℂ a },
  map_one' := linear_isometry_equiv.ext $ one_smul _,
  map_mul' := λ _ _, linear_isometry_equiv.ext $ mul_smul _ _ }

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

@[simp] lemma rotation_symm (a : circle) : (rotation a).symm = rotation a⁻¹ :=
linear_isometry_equiv.ext $ λ x, rfl

@[simp] lemma rotation_trans (a b : circle) :
  (rotation a).trans (rotation b) = rotation (b * a) :=
by { ext1, simp }

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

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

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

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

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

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

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

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

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

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

/-- The matrix representation of `rotation a` is equal to the conformal matrix
`![![re a, -im a], ![im a, re a]]`. -/
lemma to_matrix_rotation (a : circle) :
  linear_map.to_matrix basis_one_I basis_one_I (rotation a).to_linear_equiv =
    matrix.plane_conformal_matrix (re a) (im a) (by simp [pow_two, ←norm_sq_apply]) :=
begin
  ext i j,
  simp [linear_map.to_matrix_apply],
  fin_cases i; fin_cases j; simp
end

/-- The determinant of `rotation` (as a linear map) is equal to `1`. -/
@[simp] lemma det_rotation (a : circle) : ((rotation a).to_linear_equiv : ℂ →ₗ[ℝ] ℂ).det = 1 :=
begin
  rw [←linear_map.det_to_matrix basis_one_I, to_matrix_rotation, matrix.det_fin_two],
  simp [←norm_sq_apply]
end

/-- The determinant of `rotation` (as a linear equiv) is equal to `1`. -/
@[simp] lemma linear_equiv_det_rotation (a : circle) : (rotation a).to_linear_equiv.det = 1 :=
by rw [←units.eq_iff, linear_equiv.coe_det, det_rotation, units.coe_one]


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import for_mathlib.dold_kan.equivalence_pseudoabelian
import for_mathlib.dold_kan.normalized

/-!

# The Dold-Kan correspondence

The Dold-Kan correspondence states that for any abelian category `A`, there is
an equivalence between the category of simplicial objects in `A` and the
category of chain complexes in `A` (with degrees indexed by `ℕ` and the
homological convention that the degree is decreased by the differentials).

In this file, we finish the construction of this equivalence by providing
`category_theory.abelian.dold_kan.equivalence` which is of type
`simplicial_object A ≌ chain_complex A ℕ` for any abelian category `A`.
The functor `simplicial_object A ⥤ chain_complex A ℕ` of this equivalence is
definitionally equal to `normalized_Moore_complex A`.

## Overall strategy of the proof of the correspondence

Before starting the implementation of the proof in Lean, the author noticed
that the Dold-Kan equivalence not only applies to abelian categories, but
should also hold generally for any pseudoabelian category `C`
(i.e. a category with instances `[additive_category C]` and
`[is_idempotent_complete C]`): this is
`category_theory.idempotents.dold_kan.equivalence`.

When the alternating face map complex `K[X]` of a simplicial object `X` in an
abelian is studied, it is shown that it decomposes as a direct sum of the
normalized subcomplex and of the degenerate subcomplex. The crucial observation
is that in this decomposition, the projection on the normalized subcomplex can
be defined in each degree using simplicial operators. Then, the definition
of this projection `P_infty : K[X] ⟶ K[X]` can be carried for any
`(X : simplicial_object C)` when `C` is a preadditive category.

The construction of the endomorphism `P_infty` is done in the files
`homotopies.lean`, `faces.lean`, `projections.lean` and `p_infty.lean`.
Eventually, as we would also like to show that the inclusion of the normalized
Moore complex is an homotopy equivalence (cf. file `homotopy_equivalence.lean`),
this projection `P_infty` needs to be homotopic to the identity. In our
construction, we get this for free because `P_infty` is obtained by altering
the identity endomorphism by null homotopic maps. More details about this
aspect of the proof in the file `homotopies.lean`.

When the alternating face map complex `K[X]` is equipped with the idempotent
endomorphism `P_infty`, it becomes an object in `karoubi (chain_complex C ℕ)`
which is the pseudoabelianisation of the category `chain_complex C ℕ`. In `functor_n.lean`,
we obtain this functor `N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)`,
which is formally extended as
`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)`. (Here, some functors
have an index which is the number of occurrences of `karoubi` at the source or the
target.)

In `functor_gamma.lean`, assuming that the category `C` is additive,
we define the functor in the other direction
`Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)` as the formal
extension of a functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C` which is
defined similarly as in *Simplicial Homotopy Theory* by Goerss-Jardine.
In `degeneracies.lean`, we show that `P_infty` vanishes in the image of degeneracy
operators, which is one of the key properties that makes possible to contruct
the isomorphism `N₂Γ₂ : Γ₂ ⋙ N₂ ≅ 𝟭 (karoubi (chain_complex C ℕ))`.

The rest of the proof follows the strategy in the original paper by Dold. We show
that the functor `N₂` reflects isomorphisms in `n_reflects_iso.lean`: this relies on a
decomposition of the identity of `X _[n]` using `P_infty.f n` and degeneracies obtained in
`decomposition.lean`. Then, in `n_comp_gamma.lean`, we construct a natural transformation
`Γ₂N₂_trans : N₂ ⋙ Γ₂ ⟶ 𝟭 (karoubi (simplicial_object C))`. It is shown that it is an
isomorphism using the fact thet `N₂` reflects isomorphisms, and because we can show
that the composition `N₂ ⟶ N₂ ⋙ Γ₂ ⋙ N₂ ⟶ N₂` is the identity (see `identity_N₂`). The fact
that `N₂` is defined as a formal direct factor makes the proof easier because we only
have to compare endomorphisms of an alternating face map complex `K[X]` and we do not
have to worry with inclusions of kernel subobjects.

In `equivalence_additive.lean`, we obtain
the equivalence `equivalence : karoubi (simplicial_object C) ≌ karoubi (chain_complex C ℕ)`.
It is in the namespace `category_theory.preadditive.dold_kan`. The functors in this
equivalence are named `N` and `Γ`: by definition, they are `N₂` and `Γ₂`.

In `equivalence_pseudoabelian.lean`, assuming `C` is idempotent complete,
we obtain `equivalence : simplicial_object C ≌ chain_complex C ℕ`
in the namespace `category_theory.idempotents.dold_kan`. This could be roughly
obtained by composing the previous equivalence with the equivalences
`simplicial_object C ≌ karoubi (simplicial_object C)` and
`karoubi (chain_complex C ℕ) ≌ chain_complex C ℕ`. Instead, we polish this construction
in `compatibility.lean` by ensuring good definitional properties of the equivalence (e.g.
the inverse functor is definitionallly equal to
`Γ₀' : chain_complex C ℕ ⥤ simplicial_object C`) and
showing compatibilities for the unit and counit isomorphisms.

In this file `equivalence.lean`, assuming the category `A` is abelian, we obtain
`equivalence : simplicial_object A ≌ chain_complex A ℕ` in the namespace
`category_theory.abelian.dold_kan`. This is obtained by replacing the functor
`category_theory.idempotents.dold_kan.N` of the equivalence in the pseudoabelian case
with the isomorphic functor `normalized_Moore_complex A` thanks to the isomorphism
obtained in `normalized.lean`.

Finally, we show functoriality properties of the three equivalences above in
`functoriality_additive.lean`, `functoriality_pseudoabelian.lean` and
`functoriality.lean`. More precisely, for example in the case of abelian
categories `A` and `B`, if `F : A ⥤ B` is an additive functor,
we show that the functor `N` for `A` and `B` are compatible with the functors
`simplicial_object A ⥤ simplicial_object B` and
`chain_complex A ℕ ⥤ chain_complex B ℕ` induced by `F`. (Note that this does not
require that `F` is an exact functor!)

## References
* Albrecht Dold, Homology of Symmetric Products and Other Functors of Complexes,
Annals of Mathematics, Second Series, Vol. 68 No. 1 (Jul. 1958), pp. 54-80.
* Paul G. Goerss, John F. Jardine, Simplicial Homotopy Theory, Modern Birkhäuser Classics,
Reprint of the 1999 edition.

-/

noncomputable theory

open category_theory
open category_theory.category
open category_theory.idempotents

variables {A : Type*} [category A] [abelian A]

namespace category_theory

namespace abelian

namespace dold_kan

open algebraic_topology.dold_kan

/-- The functor `N` for the equivalence is `normalized_Moore_complex A` -/
def N : simplicial_object A ⥤ chain_complex A ℕ := algebraic_topology.normalized_Moore_complex A

/-- The functor `Γ` for the equivalence is the same as in the pseudoabelian case. -/
def Γ : chain_complex A ℕ ⥤ simplicial_object A := idempotents.dold_kan.Γ

/-- The equivalence `chain_complex A ℕ ≌ karoubi (chain_complex A ℕ) ` -/
def κequiv' := to_karoubi_equivalence (chain_complex A ℕ)

/-- The comparison isomorphism between `normalized_Moore_complex A` and
the functor `idempotents.dold_kan.N` from the pseudoabelian case -/
@[simps]
def comparison_N : (N : simplicial_object A ⥤ _) ≅ idempotents.dold_kan.N :=
calc N ≅ N ⋙ 𝟭 _ : functor.left_unitor N
... ≅ N ⋙ ((to_karoubi_equivalence _).functor ⋙ (to_karoubi_equivalence _).inverse) :
  iso_whisker_left _ κequiv'.unit_iso
... ≅ (N ⋙ (to_karoubi_equivalence _).functor) ⋙ (to_karoubi_equivalence _).inverse :
  iso.refl _
... ≅ N₁ ⋙ (to_karoubi_equivalence _).inverse : iso_whisker_right
  (N₁_iso_normalized_Moore_complex_comp_to_karoubi A).symm _
... ≅ idempotents.dold_kan.N : by refl

/-- The Dold-Kan equivalence for abelian categories -/
@[simps]
def equivalence : simplicial_object A ≌ chain_complex A ℕ :=
begin
  let F : simplicial_object A ⥤ _ := idempotents.dold_kan.N,
  let hF : is_equivalence F := is_equivalence.of_equivalence idempotents.dold_kan.equivalence,
  letI : is_equivalence (N : simplicial_object A ⥤ _ ) :=
    is_equivalence.of_iso comparison_N.symm hF,
  exact N.as_equivalence,
end

lemma equivalence_functor : (equivalence : simplicial_object A ≌ _).functor = N := rfl
lemma equivalence_inverse : (equivalence : simplicial_object A ≌ _).inverse = Γ := rfl

end dold_kan

end abelian

end category_theory


import data.stream.basic
import tactic

namespace padovan

private def padovan_aux_step : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) := λ t, ⟨t.2.1, t.2.2, t.1 + t.2.1⟩

private def padovan_aux_stream : stream (ℕ × ℕ × ℕ) := stream.iterate padovan_aux_step ⟨1, 1, 1⟩

def padovan (n : ℕ) : ℕ := (padovan_aux_stream n).1

@[simp] lemma padovan_zero : padovan 0 = 1 := rfl
@[simp] lemma padovan_one : padovan 1 = 1 := rfl
@[simp] lemma padovan_two : padovan 2 = 1 := rfl

private lemma padovan_aux_stream_succ {n : ℕ} :
    padovan_aux_stream (n + 1) = padovan_aux_step (padovan_aux_stream n) :=
begin
  change (stream.nth (n + 1) $ stream.iterate padovan_aux_step ⟨1, 1, 1⟩) =
      padovan_aux_step (stream.nth n $ stream.iterate padovan_aux_step ⟨1, 1, 1⟩),
  rw [stream.nth_succ_iterate, stream.map_iterate, stream.nth_map],
end

lemma padovan_succ_succ_succ {n : ℕ} : padovan (n + 3) = padovan n + padovan (n + 1) :=
begin
  simp only [padovan, padovan_aux_stream_succ, padovan_aux_step],
end

lemma padovan_increasing (n m : ℕ): n ≤ m → padovan n ≤ padovan m :=
begin
  intros h,
  sorry
end

lemma padovan_pos (n : ℕ) : 0 < padovan n :=
begin
  induction n with k nk,
  { rw padovan_zero,
    linarith,
  },
  { cases k,
    { rw padovan_one,
      linarith,
    },
    { sorry },
  },
end

end padovan


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import algebra.big_operators.basic
import data.nat.prime
import data.zmod.basic

/-!
# Euler's totient function

This file defines [Euler's totient function](https://en.wikipedia.org/wiki/Euler's_totient_function)
`nat.totient n` which counts the number of naturals less than `n` that are coprime with `n`.
We prove the divisor sum formula, namely that `n` equals `φ` summed over the divisors of `n`. See
`sum_totient`. We also prove two lemmas to help compute totients, namely `totient_mul` and
`totient_prime_pow`.
-/

open finset
open_locale big_operators

namespace nat

/-- Euler's totient function. This counts the number of naturals strictly less than `n` which are
coprime with `n`. -/
def totient (n : ℕ) : ℕ := ((range n).filter (nat.coprime n)).card

localized "notation `φ` := nat.totient" in nat

@[simp] theorem totient_zero : φ 0 = 0 := rfl

@[simp] theorem totient_one : φ 1 = 1 :=
by simp [totient]

lemma totient_eq_card_coprime (n : ℕ) : φ n = ((range n).filter (nat.coprime n)).card := rfl

lemma totient_le (n : ℕ) : φ n ≤ n :=
calc totient n ≤ (range n).card : card_filter_le _ _
           ... = n              : card_range _

lemma totient_lt (n : ℕ) (hn : 1 < n) : φ n < n :=
calc totient n ≤ ((range n).filter (≠ 0)).card :
  begin
    apply card_le_of_subset (monotone_filter_right _ _),
    intros n1 hn1 hn1',
    simpa only [hn1', coprime_zero_right, hn.ne'] using hn1,
  end
... = n - 1 : by simp only [filter_ne' (range n) 0, card_erase_of_mem, n.pred_eq_sub_one,
                card_range, pos_of_gt hn, mem_range]
... < n : nat.sub_lt (pos_of_gt hn) zero_lt_one

lemma totient_pos : ∀ {n : ℕ}, 0 < n → 0 < φ n
| 0 := dec_trivial
| 1 := by simp [totient]
| (n+2) := λ h, card_pos.2 ⟨1, mem_filter.2 ⟨mem_range.2 dec_trivial, coprime_one_right _⟩⟩

open zmod

/-- Note this takes an explicit `fintype (units (zmod n))` argument to avoid trouble with instance
diamonds. -/
@[simp] lemma _root_.zmod.card_units_eq_totient (n : ℕ) [fact (0 < n)] [fintype (units (zmod n))] :
  fintype.card (units (zmod n)) = φ n :=
calc fintype.card (units (zmod n)) = fintype.card {x : zmod n // x.val.coprime n} :
  fintype.card_congr zmod.units_equiv_coprime
... = φ n :
begin
  apply finset.card_congr (λ (a : {x : zmod n // x.val.coprime n}) _, a.1.val),
  { intro a, simp [(a : zmod n).val_lt, a.prop.symm] {contextual := tt} },
  { intros _ _ _ _ h, rw subtype.ext_iff_val, apply val_injective, exact h, },
  { intros b hb,
    rw [finset.mem_filter, finset.mem_range] at hb,
    refine ⟨⟨b, _⟩, finset.mem_univ _, _⟩,
    { let u := unit_of_coprime b hb.2.symm,
      exact val_coe_unit_coprime u },
    { show zmod.val (b : zmod n) = b,
      rw [val_nat_cast, nat.mod_eq_of_lt hb.1], } }
end

lemma totient_mul {m n : ℕ} (h : m.coprime n) : φ (m * n) = φ m * φ n :=
if hmn0 : m * n = 0
  then by cases nat.mul_eq_zero.1 hmn0 with h h;
    simp only [totient_zero, mul_zero, zero_mul, h]
  else
  begin
    haveI : fact (0 < (m * n)) := ⟨nat.pos_of_ne_zero hmn0⟩,
    haveI : fact (0 < m) := ⟨nat.pos_of_ne_zero $ left_ne_zero_of_mul hmn0⟩,
    haveI : fact (0 < n) := ⟨nat.pos_of_ne_zero $ right_ne_zero_of_mul hmn0⟩,
    rw [← zmod.card_units_eq_totient, ← zmod.card_units_eq_totient,
      ← zmod.card_units_eq_totient, fintype.card_congr
      (units.map_equiv (zmod.chinese_remainder h).to_mul_equiv).to_equiv,
      fintype.card_congr (@mul_equiv.prod_units (zmod m) (zmod n) _ _).to_equiv,
      fintype.card_prod]
  end

/-- When `p` is prime, then the totient of `p ^ (n + 1)` is `p ^ n * (p - 1)` -/
lemma totient_prime_pow_succ {p : ℕ} (hp : p.prime) (n : ℕ) :
  φ (p ^ (n + 1)) = p ^ n * (p - 1) :=
calc φ (p ^ (n + 1))
    = ((range (p ^ (n + 1))).filter (coprime (p ^ (n + 1)))).card :
  totient_eq_card_coprime _
... = (range (p ^ (n + 1)) \ ((range (p ^ n)).image (* p))).card :
  congr_arg card begin
    rw [sdiff_eq_filter],
    apply filter_congr,
    simp only [mem_range, mem_filter, coprime_pow_left_iff n.succ_pos,
      mem_image, not_exists, hp.coprime_iff_not_dvd],
    intros a ha,
    split,
    { rintros hap b _ rfl,
      exact hap (dvd_mul_left _ _) },
    { rintros h ⟨b, rfl⟩,
      rw [pow_succ] at ha,
      exact h b (lt_of_mul_lt_mul_left ha (zero_le _)) (mul_comm _ _) }
  end
... = _ :
have h1 : set.inj_on (* p) (range (p ^ n)),
  from λ x _ y _, (nat.mul_left_inj hp.pos).1,
have h2 : (range (p ^ n)).image (* p) ⊆ range (p ^ (n + 1)),
  from λ a, begin
    simp only [mem_image, mem_range, exists_imp_distrib],
    rintros b h rfl,
    rw [pow_succ'],
    exact (mul_lt_mul_right hp.pos).2 h
  end,
begin
  rw [card_sdiff h2, card_image_of_inj_on h1, card_range,
    card_range, ← one_mul (p ^ n), pow_succ, ← tsub_mul,
    one_mul, mul_comm]
end

/-- When `p` is prime, then the totient of `p ^ ` is `p ^ (n - 1) * (p - 1)` -/
lemma totient_prime_pow {p : ℕ} (hp : p.prime) {n : ℕ} (hn : 0 < n) :
  φ (p ^ n) = p ^ (n - 1) * (p - 1) :=
by rcases exists_eq_succ_of_ne_zero (pos_iff_ne_zero.1 hn) with ⟨m, rfl⟩;
  exact totient_prime_pow_succ hp _

lemma totient_prime {p : ℕ} (hp : p.prime) : φ p = p - 1 :=
by rw [← pow_one p, totient_prime_pow hp]; simp

lemma totient_eq_iff_prime {p : ℕ} (hp : 0 < p) : p.totient = p - 1 ↔ p.prime :=
begin
  refine ⟨λ h, _, totient_prime⟩,
  replace hp : 1 < p,
  { apply lt_of_le_of_ne,
    { rwa succ_le_iff },
    { rintro rfl,
      rw [totient_one, tsub_self] at h,
      exact one_ne_zero h } },
  rw [totient_eq_card_coprime, range_eq_Ico, ←Ico_insert_succ_left hp.le, finset.filter_insert,
    if_neg (tactic.norm_num.nat_coprime_helper_zero_right p hp), ←nat.card_Ico 1 p] at h,
  refine p.prime_of_coprime hp (λ n hn hnz, finset.filter_card_eq h n $ finset.mem_Ico.mpr ⟨_, hn⟩),
  rwa [succ_le_iff, pos_iff_ne_zero],
end

lemma card_units_zmod_lt_sub_one {p : ℕ} (hp : 1 < p) [fintype (units (zmod p))] :
  fintype.card (units (zmod p)) ≤ p - 1 :=
begin
  haveI : fact (0 < p) := ⟨zero_lt_one.trans hp⟩,
  rw zmod.card_units_eq_totient p,
  exact nat.le_pred_of_lt (nat.totient_lt p hp),
end

lemma prime_iff_card_units (p : ℕ) [fintype (units (zmod p))] :
  p.prime ↔ fintype.card (units (zmod p)) = p - 1 :=
begin
  by_cases hp : p = 0,
  { substI hp,
    simp only [zmod, not_prime_zero, false_iff, zero_tsub],
    -- the substI created an non-defeq but subsingleton instance diamond; resolve it
    suffices : fintype.card (units ℤ) ≠ 0, { convert this },
    simp },
  haveI : fact (0 < p) := ⟨nat.pos_of_ne_zero hp⟩,
  rw [zmod.card_units_eq_totient, nat.totient_eq_iff_prime (fact.out (0 < p))],
end

@[simp] lemma totient_two : φ 2 = 1 :=
(totient_prime prime_two).trans (by norm_num)

end nat


-- BOTH:
import data.real.basic

/- TEXT:
.. _negation:

Negation
--------

The symbol ``¬`` is meant to express negation,
so ``¬ x < y`` says that ``x`` is not less than ``y``,
``¬ x = y`` (or, equivalently, ``x ≠ y``) says that
``x`` is not equal to ``y``,
and ``¬ ∃ z, x < z ∧ z < y`` says that there does not exist a ``z``
strictly between ``x`` and ``y``.
In Lean, the notation ``¬ A`` abbreviates ``A → false``,
which you can think of as saying that ``A`` implies a contradiction.
Practically speaking, this means that you already know something
about how to work with negations:
you can prove ``¬ A`` by introducing a hypothesis ``h : A``
and proving ``false``,
and if you have ``h : ¬ A`` and ``h' : A``,
then applying ``h`` to ``h'`` yields ``false``.

To illustrate, consider the irreflexivity principle ``lt_irrefl``
for a strict order,
which says that we have ``¬ a < a`` for every ``a``.
The asymmetry principle ``lt_asymm`` says that we have
``a < b → ¬ b < a``. Let's show that ``lt_asymm`` follows
from ``lt_irrefl``.
TEXT. -/
-- BOTH:
section
variables a b : ℝ

-- EXAMPLES:
-- QUOTE:
example (h : a < b) : ¬ b < a :=
begin
  intro h',
  have : a < a,
    from lt_trans h h',
  apply lt_irrefl a this
end
-- QUOTE.

/- TEXT:
.. index:: this, have, tactics ; have, from, tactics ; from

This example introduces a couple of new tricks.
First, when you use ``have`` without providing
a label,
Lean uses the name ``this``,
providing a convenient way to refer back to it.
Also, the ``from`` tactic is syntactic sugar for ``exact``,
providing a nice way to justify a ``have`` with an explicit
proof term.
But what you should really be paying attention to in this
proof is the result of the ``intro`` tactic,
which leaves a goal of ``false``,
and the fact that we eventually prove ``false``
by applying ``lt_irrefl`` to a proof of ``a < a``.

Here is another example, which uses the
predicate ``fn_has_ub`` defined in the last section,
which says that a function has an upper bound.
TEXT. -/
-- BOTH:
def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_lb (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x

def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a
def fn_has_lb (f : ℝ → ℝ) := ∃ a, fn_lb f a

variable f : ℝ → ℝ

-- EXAMPLES:
-- QUOTE:
example (h : ∀ a, ∃ x, f x > a) : ¬ fn_has_ub f :=
begin
  intros fnub,
  cases fnub with a fnuba,
  cases h a with x hx,
  have : f x ≤ a,
    from fnuba x,
  linarith
end
-- QUOTE.

/- TEXT:
See if you can prove these in a similar way:
TEXT. -/
-- QUOTE:
example (h : ∀ a, ∃ x, f x < a) : ¬ fn_has_lb f :=
sorry

example : ¬ fn_has_ub (λ x, x) :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : ∀ a, ∃ x, f x < a) : ¬ fn_has_lb f :=
begin
  rintros ⟨a, ha⟩,
  rcases h a with ⟨x, hx⟩,
  have := ha x,
  linarith
end

example : ¬ fn_has_ub (λ x, x) :=
begin
  rintros ⟨a, ha⟩,
  have : a + 1 ≤ a := ha (a + 1),
  linarith
end

/- TEXT:
Mathlib offers a number of useful theorems for relating orders
and negations:
TEXT. -/
-- QUOTE:
#check (not_le_of_gt : a > b → ¬ a ≤ b)
#check (not_lt_of_ge : a ≥ b → ¬ a < b)
#check (lt_of_not_ge : ¬ a ≥ b → a < b)
#check (le_of_not_gt : ¬ a > b → a ≤ b)
-- QUOTE.

/- TEXT:
Recall the predicate ``monotone f``,
which says that ``f`` is nondecreasing.
Use some of the theorems just enumerated to prove the following:
TEXT. -/
-- QUOTE:
example (h : monotone f) (h' : f a < f b) : a < b :=
sorry

example (h : a ≤ b) (h' : f b < f a) : ¬ monotone f :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : monotone f) (h' : f a < f b) : a < b :=
begin
  apply lt_of_not_ge,
  intro h'',
  apply absurd h',
  apply not_lt_of_ge (h h'')
end

example (h : a ≤ b) (h' : f b < f a) : ¬ monotone f :=
begin
  intro h'',
  apply absurd h',
  apply not_lt_of_ge,
  apply h'' h
end

/- TEXT:
Remember that it is often convenient to use ``linarith``
when a goal follows from linear equations and
inequalities that in the context.

We can show that the first example in the last snippet
cannot be proved if we replace ``<`` by ``≤``.
Notice that we can prove the negation of a universally
quantified statement by giving a counterexample.
Complete the proof.
TEXT. -/
-- QUOTE:
example :
  ¬ ∀ {f : ℝ → ℝ}, monotone f → ∀ {a b}, f a ≤ f b → a ≤ b :=
begin
  intro h,
  let f := λ x : ℝ, (0 : ℝ),
  have monof : monotone f,
  { sorry },
  have h' : f 1 ≤ f 0,
    from le_refl _,
  sorry
end
-- QUOTE.

-- SOLUTIONS:
example :
  ¬ ∀ {f : ℝ → ℝ}, monotone f → ∀ {a b}, f a ≤ f b → a ≤ b :=
begin
  intro h,
  let f := λ x : ℝ, (0 : ℝ),
  have monof : monotone f,
  { intros a b leab,
    refl },
  have h' : f 1 ≤ f 0,
    from le_refl _,
  have : (1 : ℝ) ≤ 0 := h monof h',
  linarith
end

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

This example introduces the ``let`` tactic,
which adds a *local definition* to the context.
If you put the cursor after the ``let`` command,
in the goal window you will see that the definition
``f : ℝ → ℝ := λ (x : ℝ), 0`` has been added to the context.
Lean will unfold the definition of ``f`` when it has to.
In particular, when we prove ``f 1 ≤ f 0`` with ``le_refl``,
Lean reduces ``f 1`` and ``f 0`` to ``0``.

Use ``le_of_not_gt`` to prove the following:
TEXT. -/
-- QUOTE:
example (x : ℝ) (h : ∀ ε > 0, x < ε) : x ≤ 0 :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (x : ℝ) (h : ∀ ε > 0, x < ε) : x ≤ 0 :=
begin
  apply le_of_not_gt,
  intro h',
  linarith [h _ h']
end

-- BOTH:
end

/- TEXT:
Implicit in many of the proofs we have just done
is the fact that if ``P`` is any property,
saying that there is nothing with property ``P``
is the same as saying that everything fails to have
property ``P``,
and saying that not everything has property ``P``
is equivalent to saying that something fails to have property ``P``.
In other words, all four of the following implications
are valid (but one of them cannot be proved with what we explained so
far):
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {α : Type*} (P : α → Prop) (Q : Prop)

-- EXAMPLES:
example (h : ¬ ∃ x, P x) : ∀ x, ¬ P x :=
sorry

example (h : ∀ x, ¬ P x) : ¬ ∃ x, P x :=
sorry

example (h : ¬ ∀ x, P x) : ∃ x, ¬ P x :=
sorry

example (h : ∃ x, ¬ P x) : ¬ ∀ x, P x :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : ¬ ∃ x, P x) : ∀ x, ¬ P x :=
begin
  intros x Px,
  apply h,
  use [x, Px]
end

example (h : ∀ x, ¬ P x) : ¬ ∃ x, P x :=
begin
  rintros ⟨x, Px⟩,
  exact h x Px
end

example (h : ∃ x, ¬ P x) : ¬ ∀ x, P x :=
begin
  intro h',
  rcases h with ⟨x, nPx⟩,
  apply nPx,
  apply h'
end

/- TEXT:
The first, second, and fourth are straightforward to
prove using the methods you have already seen.
We encourage you to try it.
The third is more difficult, however,
because it concludes that an object exists
from the fact that its nonexistence is contradictory.
This is an instance of *classical* mathematical reasoning,
and, in general, you have to declare your intention
of using such reasoning by adding the command
``open_locale classical`` to your file.
With that command, we can use proof by contradiction
to prove the third implication as follows.
TEXT. -/
-- QUOTE:
open_locale classical

example (h : ¬ ∀ x, P x) : ∃ x, ¬ P x :=
begin
  by_contradiction h',
  apply h,
  intro x,
  show P x,
  by_contradiction h'',
  exact h' ⟨x, h''⟩
end
-- QUOTE.

/- TEXT:
.. index:: by_contradiction, by_contra, tactics ; by_contra and by_contradiction,

Make sure you understand how this works.
The ``by_contradiction`` tactic (also abbreviated to ``by_contra``)
allows us to prove a goal ``Q`` by assuming ``¬ Q``
and deriving a contradiction.
In fact, it is equivalent to using the
equivalence ``not_not : ¬ ¬ Q ↔ Q``.
Confirm that you can prove the forward direction
of this equivalence using ``by_contradiction``,
while the reverse direction follows from the
ordinary rules for negation.
TEXT. -/
-- QUOTE:
example (h : ¬ ¬ Q) : Q :=
sorry

example (h : Q) : ¬ ¬ Q :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : ¬ ¬ Q) : Q :=
begin
  by_contradiction h',
  exact h h'
end

example (h : Q) : ¬ ¬ Q :=
begin
  intro h',
  exact h' h
end

-- BOTH:
end

/- TEXT:
Use proof by contradiction to establish the following,
which is the converse of one of the implications we proved above.
(Hint: use ``intro`` first.)
TEXT. -/
-- BOTH:
open_locale classical
section
variable (f : ℝ → ℝ)

-- EXAMPLES:
-- QUOTE:
example (h : ¬ fn_has_ub f) : ∀ a, ∃ x, f x > a :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : ¬ fn_has_ub f) : ∀ a, ∃ x, f x > a :=
begin
  intro a,
  by_contradiction h',
  apply h,
  use a,
  intro x,
  apply le_of_not_gt,
  intro h'',
  apply h',
  use [x, h'']
end

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

It is often tedious to work with compound statements with
a negation in front,
and it is a common mathematical pattern to replace such
statements with equivalent forms in which the negation
has been pushed inward.
To facilitate this, mathlib offers a ``push_neg`` tactic,
which restates the goal in this way.
The command ``push_neg at h`` restates the hypothesis ``h``.
TEXT. -/
-- QUOTE:
example (h : ¬ ∀ a, ∃ x, f x > a) : fn_has_ub f :=
begin
  push_neg at h,
  exact h
end

example (h : ¬ fn_has_ub f) : ∀ a, ∃ x, f x > a :=
begin
  simp only [fn_has_ub, fn_ub] at h,
  push_neg at h,
  exact h
end
-- QUOTE.

/- TEXT:
In the second example, we use Lean's simplifier to
expand the definitions of ``fn_has_ub`` and ``fn_ub``.
(We need to use ``simp`` rather than ``rw``
to expand ``fn_ub``,
because it appears in the scope of a quantifier.)
You can verify that in the examples above
with ``¬ ∃ x, P x`` and ``¬ ∀ x, P x``,
the ``push_neg`` tactic does the expected thing.
Without even knowing how to use the conjunction
symbol,
you should be able to use ``push_neg``
to prove the following:
TEXT. -/
-- QUOTE:
example (h : ¬ monotone f) : ∃ x y, x ≤ y ∧ f y < f x :=
sorry
-- QUOTE.

-- SOLUTIONS:
example (h : ¬ monotone f) : ∃ x y, x ≤ y ∧ f y < f x :=
begin
  rw [monotone] at h,
  push_neg at h,
  exact h
end

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

Mathlib also has a tactic, ``contrapose``,
which transforms a goal ``A → B`` to ``¬ B → ¬ A``.
Similarly, given a goal of proving ``B`` from
hypothesis ``h : A``,
``contrapose h`` leaves you with a goal of proving
``¬ A`` from hypothesis ``¬ B``.
Using ``contrapose!`` instead of ``contrapose``
applies ``push_neg`` to the goal and the relevant
hypothesis as well.
TEXT. -/
-- QUOTE:
example (h : ¬ fn_has_ub f) : ∀ a, ∃ x, f x > a :=
begin
  contrapose! h,
  exact h
end

example (x : ℝ) (h : ∀ ε > 0, x ≤ ε) : x ≤ 0 :=
begin
  contrapose! h,
  use x / 2,
  split; linarith
end
-- QUOTE.

-- BOTH:
end

/- TEXT:
We have not yet explained the ``split`` command
or the use of the semicolon after it,
but we will do that in the next section.

.. TODO: make sure we explain split and the semicolon
   in the next section

We close this section with
the principle of *ex falso*,
which says that anything follows from a contradiction.
In Lean, this is represented by ``false.elim``,
which establishes ``false → P`` for any proposition ``P``.
This may seem like a strange principle,
but it comes up fairly often.
We often prove a theorem by splitting on cases,
and sometimes we can show that one of
the cases is contradictory.
In that case, we need to assert that the contradiction
establishes the goal so we can move on to the next one.
(We will see instances of reasoning by cases in
:numref:`disjunction`.)

.. index:: exfalso, contradiction, absurd, tactics ; exfalso, tactics ; contradiction

Lean provides a number of ways of closing
a goal once a contradiction has been reached.
TEXT. -/
section
variable a : ℕ

-- QUOTE:
example (h : 0 < 0) : a > 37 :=
begin
  exfalso,
  apply lt_irrefl 0 h
end

example (h : 0 < 0) : a > 37 :=
absurd h (lt_irrefl 0)

example (h : 0 < 0) : a > 37 :=
begin
  have h' : ¬ 0 < 0,
    from lt_irrefl 0,
  contradiction
end
-- QUOTE.

end

/- TEXT:
The ``exfalso`` tactic replaces the current goal with
the goal of proving ``false``.
Given ``h : P`` and ``h' : ¬ P``,
the term ``absurd h h'`` establishes any proposition.
Finally, the ``contradiction`` tactic tries to close a goal
by finding a contradiction in the hypotheses,
such as a pair of the form ``h : P`` and ``h' : ¬ P``.
Of course, in this example, ``linarith`` also works.
TEXT. -/


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.trigonometric.basic
import topology.algebra.order.proj_Icc

/-!
# Inverse trigonometric functions.

See also `analysis.special_functions.trigonometric.arctan` for the inverse tan function.
(This is delayed as it is easier to set up after developing complex trigonometric functions.)

Basic inequalities on trigonometric functions.
-/

noncomputable theory
open_locale classical topological_space filter
open set filter

open_locale real

namespace real

/-- Inverse of the `sin` function, returns values in the range `-π / 2 ≤ arcsin x ≤ π / 2`.
It defaults to `-π / 2` on `(-∞, -1)` and to `π / 2` to `(1, ∞)`. -/
@[pp_nodot] noncomputable def arcsin : ℝ → ℝ :=
coe ∘ Icc_extend (neg_le_self zero_le_one) sin_order_iso.symm

lemma arcsin_mem_Icc (x : ℝ) : arcsin x ∈ Icc (-(π / 2)) (π / 2) := subtype.coe_prop _

@[simp] lemma range_arcsin : range arcsin = Icc (-(π / 2)) (π / 2) :=
by { rw [arcsin, range_comp coe], simp [Icc] }

lemma arcsin_le_pi_div_two (x : ℝ) : arcsin x ≤ π / 2 := (arcsin_mem_Icc x).2

lemma neg_pi_div_two_le_arcsin (x : ℝ) : -(π / 2) ≤ arcsin x := (arcsin_mem_Icc x).1

lemma arcsin_proj_Icc (x : ℝ) :
  arcsin (proj_Icc (-1) 1 (neg_le_self $ @zero_le_one ℝ _) x) = arcsin x :=
by rw [arcsin, function.comp_app, Icc_extend_coe, function.comp_app, Icc_extend]

lemma sin_arcsin' {x : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) : sin (arcsin x) = x :=
by simpa [arcsin, Icc_extend_of_mem _ _ hx, -order_iso.apply_symm_apply]
  using subtype.ext_iff.1 (sin_order_iso.apply_symm_apply ⟨x, hx⟩)

lemma sin_arcsin {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : sin (arcsin x) = x :=
sin_arcsin' ⟨hx₁, hx₂⟩

lemma arcsin_sin' {x : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) : arcsin (sin x) = x :=
inj_on_sin (arcsin_mem_Icc _) hx $ by rw [sin_arcsin (neg_one_le_sin _) (sin_le_one _)]

lemma arcsin_sin {x : ℝ} (hx₁ : -(π / 2) ≤ x) (hx₂ : x ≤ π / 2) : arcsin (sin x) = x :=
arcsin_sin' ⟨hx₁, hx₂⟩

lemma strict_mono_on_arcsin : strict_mono_on arcsin (Icc (-1) 1) :=
(subtype.strict_mono_coe _).comp_strict_mono_on $
  sin_order_iso.symm.strict_mono.strict_mono_on_Icc_extend _

lemma monotone_arcsin : monotone arcsin :=
(subtype.mono_coe _).comp $ sin_order_iso.symm.monotone.Icc_extend _

lemma inj_on_arcsin : inj_on arcsin (Icc (-1) 1) := strict_mono_on_arcsin.inj_on

lemma arcsin_inj {x y : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) (hy₁ : -1 ≤ y) (hy₂ : y ≤ 1) :
  arcsin x = arcsin y ↔ x = y :=
inj_on_arcsin.eq_iff ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩

@[continuity]
lemma continuous_arcsin : continuous arcsin :=
continuous_subtype_coe.comp sin_order_iso.symm.continuous.Icc_extend'

lemma continuous_at_arcsin {x : ℝ} : continuous_at arcsin x :=
continuous_arcsin.continuous_at

lemma arcsin_eq_of_sin_eq {x y : ℝ} (h₁ : sin x = y) (h₂ : x ∈ Icc (-(π / 2)) (π / 2)) :
  arcsin y = x :=
begin
  subst y,
  exact inj_on_sin (arcsin_mem_Icc _) h₂ (sin_arcsin' (sin_mem_Icc x))
end

@[simp] lemma arcsin_zero : arcsin 0 = 0 :=
arcsin_eq_of_sin_eq sin_zero ⟨neg_nonpos.2 pi_div_two_pos.le, pi_div_two_pos.le⟩

@[simp] lemma arcsin_one : arcsin 1 = π / 2 :=
arcsin_eq_of_sin_eq sin_pi_div_two $ right_mem_Icc.2 (neg_le_self pi_div_two_pos.le)

lemma arcsin_of_one_le {x : ℝ} (hx : 1 ≤ x) : arcsin x = π / 2 :=
by rw [← arcsin_proj_Icc, proj_Icc_of_right_le _ hx, subtype.coe_mk, arcsin_one]

lemma arcsin_neg_one : arcsin (-1) = -(π / 2) :=
arcsin_eq_of_sin_eq (by rw [sin_neg, sin_pi_div_two]) $
  left_mem_Icc.2 (neg_le_self pi_div_two_pos.le)

lemma arcsin_of_le_neg_one {x : ℝ} (hx : x ≤ -1) : arcsin x = -(π / 2) :=
by rw [← arcsin_proj_Icc, proj_Icc_of_le_left _ hx, subtype.coe_mk, arcsin_neg_one]

@[simp] lemma arcsin_neg (x : ℝ) : arcsin (-x) = -arcsin x :=
begin
  cases le_total x (-1) with hx₁ hx₁,
  { rw [arcsin_of_le_neg_one hx₁, neg_neg, arcsin_of_one_le (le_neg.2 hx₁)] },
  cases le_total 1 x with hx₂ hx₂,
  { rw [arcsin_of_one_le hx₂, arcsin_of_le_neg_one (neg_le_neg hx₂)] },
  refine arcsin_eq_of_sin_eq _ _,
  { rw [sin_neg, sin_arcsin hx₁ hx₂] },
  { exact ⟨neg_le_neg (arcsin_le_pi_div_two _), neg_le.2 (neg_pi_div_two_le_arcsin _)⟩ }
end

lemma arcsin_le_iff_le_sin {x y : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) (hy : y ∈ Icc (-(π / 2)) (π / 2)) :
  arcsin x ≤ y ↔ x ≤ sin y :=
by rw [← arcsin_sin' hy, strict_mono_on_arcsin.le_iff_le hx (sin_mem_Icc _), arcsin_sin' hy]

lemma arcsin_le_iff_le_sin' {x y : ℝ} (hy : y ∈ Ico (-(π / 2)) (π / 2)) :
  arcsin x ≤ y ↔ x ≤ sin y :=
begin
  cases le_total x (-1) with hx₁ hx₁,
  { simp [arcsin_of_le_neg_one hx₁, hy.1, hx₁.trans (neg_one_le_sin _)] },
  cases lt_or_le 1 x with hx₂ hx₂,
  { simp [arcsin_of_one_le hx₂.le, hy.2.not_le, (sin_le_one y).trans_lt hx₂] },
  exact arcsin_le_iff_le_sin ⟨hx₁, hx₂⟩ (mem_Icc_of_Ico hy)
end

lemma le_arcsin_iff_sin_le {x y : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) (hy : y ∈ Icc (-1 : ℝ) 1) :
  x ≤ arcsin y ↔ sin x ≤ y :=
by rw [← neg_le_neg_iff, ← arcsin_neg,
  arcsin_le_iff_le_sin ⟨neg_le_neg hy.2, neg_le.2 hy.1⟩ ⟨neg_le_neg hx.2, neg_le.2 hx.1⟩,
  sin_neg, neg_le_neg_iff]

lemma le_arcsin_iff_sin_le' {x y : ℝ} (hx : x ∈ Ioc (-(π / 2)) (π / 2)) :
  x ≤ arcsin y ↔ sin x ≤ y :=
by rw [← neg_le_neg_iff, ← arcsin_neg, arcsin_le_iff_le_sin' ⟨neg_le_neg hx.2, neg_lt.2 hx.1⟩,
  sin_neg, neg_le_neg_iff]

lemma arcsin_lt_iff_lt_sin {x y : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) (hy : y ∈ Icc (-(π / 2)) (π / 2)) :
  arcsin x < y ↔ x < sin y :=
not_le.symm.trans $ (not_congr $ le_arcsin_iff_sin_le hy hx).trans not_le

lemma arcsin_lt_iff_lt_sin' {x y : ℝ} (hy : y ∈ Ioc (-(π / 2)) (π / 2)) :
  arcsin x < y ↔ x < sin y :=
not_le.symm.trans $ (not_congr $ le_arcsin_iff_sin_le' hy).trans not_le

lemma lt_arcsin_iff_sin_lt {x y : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) (hy : y ∈ Icc (-1 : ℝ) 1) :
  x < arcsin y ↔ sin x < y :=
not_le.symm.trans $ (not_congr $ arcsin_le_iff_le_sin hy hx).trans not_le

lemma lt_arcsin_iff_sin_lt' {x y : ℝ} (hx : x ∈ Ico (-(π / 2)) (π / 2)) :
  x < arcsin y ↔ sin x < y :=
not_le.symm.trans $ (not_congr $ arcsin_le_iff_le_sin' hx).trans not_le

lemma arcsin_eq_iff_eq_sin {x y : ℝ} (hy : y ∈ Ioo (-(π / 2)) (π / 2)) :
  arcsin x = y ↔ x = sin y :=
by simp only [le_antisymm_iff, arcsin_le_iff_le_sin' (mem_Ico_of_Ioo hy),
  le_arcsin_iff_sin_le' (mem_Ioc_of_Ioo hy)]

@[simp] lemma arcsin_nonneg {x : ℝ} : 0 ≤ arcsin x ↔ 0 ≤ x :=
(le_arcsin_iff_sin_le' ⟨neg_lt_zero.2 pi_div_two_pos, pi_div_two_pos.le⟩).trans $ by rw [sin_zero]

@[simp] lemma arcsin_nonpos {x : ℝ} : arcsin x ≤ 0 ↔ x ≤ 0 :=
neg_nonneg.symm.trans $ arcsin_neg x ▸ arcsin_nonneg.trans neg_nonneg

@[simp] lemma arcsin_eq_zero_iff {x : ℝ} : arcsin x = 0 ↔ x = 0 :=
by simp [le_antisymm_iff]

@[simp] lemma zero_eq_arcsin_iff {x} : 0 = arcsin x ↔ x = 0 :=
eq_comm.trans arcsin_eq_zero_iff

@[simp] lemma arcsin_pos {x : ℝ} : 0 < arcsin x ↔ 0 < x :=
lt_iff_lt_of_le_iff_le arcsin_nonpos

@[simp] lemma arcsin_lt_zero {x : ℝ} : arcsin x < 0 ↔ x < 0 :=
lt_iff_lt_of_le_iff_le arcsin_nonneg

@[simp] lemma arcsin_lt_pi_div_two {x : ℝ} : arcsin x < π / 2 ↔ x < 1 :=
(arcsin_lt_iff_lt_sin' (right_mem_Ioc.2 $ neg_lt_self pi_div_two_pos)).trans $
  by rw sin_pi_div_two

@[simp] lemma neg_pi_div_two_lt_arcsin {x : ℝ} : -(π / 2) < arcsin x ↔ -1 < x :=
(lt_arcsin_iff_sin_lt' $ left_mem_Ico.2 $ neg_lt_self pi_div_two_pos).trans $
  by rw [sin_neg, sin_pi_div_two]

@[simp] lemma arcsin_eq_pi_div_two {x : ℝ} : arcsin x = π / 2 ↔ 1 ≤ x :=
⟨λ h, not_lt.1 $ λ h', (arcsin_lt_pi_div_two.2 h').ne h, arcsin_of_one_le⟩

@[simp] lemma pi_div_two_eq_arcsin {x} : π / 2 = arcsin x ↔ 1 ≤ x :=
eq_comm.trans arcsin_eq_pi_div_two

@[simp] lemma pi_div_two_le_arcsin {x} : π / 2 ≤ arcsin x ↔ 1 ≤ x :=
(arcsin_le_pi_div_two x).le_iff_eq.trans pi_div_two_eq_arcsin

@[simp] lemma arcsin_eq_neg_pi_div_two {x : ℝ} : arcsin x = -(π / 2) ↔ x ≤ -1 :=
⟨λ h, not_lt.1 $ λ h', (neg_pi_div_two_lt_arcsin.2 h').ne' h, arcsin_of_le_neg_one⟩

@[simp] lemma neg_pi_div_two_eq_arcsin {x} : -(π / 2) = arcsin x ↔ x ≤ -1 :=
eq_comm.trans arcsin_eq_neg_pi_div_two

@[simp] lemma arcsin_le_neg_pi_div_two {x} : arcsin x ≤ -(π / 2) ↔ x ≤ -1 :=
(neg_pi_div_two_le_arcsin x).le_iff_eq.trans arcsin_eq_neg_pi_div_two

@[simp]

lemma maps_to_sin_Ioo : maps_to sin (Ioo (-(π / 2)) (π / 2)) (Ioo (-1) 1) :=
λ x h, by rwa [mem_Ioo, ← arcsin_lt_pi_div_two, ← neg_pi_div_two_lt_arcsin,
  arcsin_sin h.1.le h.2.le]

/-- `real.sin` as a `local_homeomorph` between `(-π / 2, π / 2)` and `(-1, 1)`. -/
@[simp] def sin_local_homeomorph : local_homeomorph ℝ ℝ :=
{ to_fun := sin,
  inv_fun := arcsin,
  source := Ioo (-(π / 2)) (π / 2),
  target := Ioo (-1) 1,
  map_source' := maps_to_sin_Ioo,
  map_target' := λ y hy, ⟨neg_pi_div_two_lt_arcsin.2 hy.1, arcsin_lt_pi_div_two.2 hy.2⟩,
  left_inv' := λ x hx, arcsin_sin hx.1.le hx.2.le,
  right_inv' := λ y hy, sin_arcsin hy.1.le hy.2.le,
  open_source := is_open_Ioo,
  open_target := is_open_Ioo,
  continuous_to_fun := continuous_sin.continuous_on,
  continuous_inv_fun := continuous_arcsin.continuous_on }

lemma cos_arcsin_nonneg (x : ℝ) : 0 ≤ cos (arcsin x) :=
cos_nonneg_of_mem_Icc ⟨neg_pi_div_two_le_arcsin _, arcsin_le_pi_div_two _⟩

lemma cos_arcsin {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : cos (arcsin x) = sqrt (1 - x ^ 2) :=
have sin (arcsin x) ^ 2 + cos (arcsin x) ^ 2 = 1 := sin_sq_add_cos_sq (arcsin x),
begin
  rw [← eq_sub_iff_add_eq', ← sqrt_inj (sq_nonneg _) (sub_nonneg.2 (sin_sq_le_one (arcsin x))),
    sq, sqrt_mul_self (cos_arcsin_nonneg _)] at this,
  rw [this, sin_arcsin hx₁ hx₂],
end

/-- Inverse of the `cos` function, returns values in the range `0 ≤ arccos x` and `arccos x ≤ π`.
  If the argument is not between `-1` and `1` it defaults to `π / 2` -/
@[pp_nodot] noncomputable def arccos (x : ℝ) : ℝ :=
π / 2 - arcsin x

lemma arccos_eq_pi_div_two_sub_arcsin (x : ℝ) : arccos x = π / 2 - arcsin x := rfl

lemma arcsin_eq_pi_div_two_sub_arccos (x : ℝ) : arcsin x = π / 2 - arccos x :=
by simp [arccos]

lemma arccos_le_pi (x : ℝ) : arccos x ≤ π :=
by unfold arccos; linarith [neg_pi_div_two_le_arcsin x]

lemma arccos_nonneg (x : ℝ) : 0 ≤ arccos x :=
by unfold arccos; linarith [arcsin_le_pi_div_two x]

lemma cos_arccos {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : cos (arccos x) = x :=
by rw [arccos, cos_pi_div_two_sub, sin_arcsin hx₁ hx₂]

lemma arccos_cos {x : ℝ} (hx₁ : 0 ≤ x) (hx₂ : x ≤ π) : arccos (cos x) = x :=
by rw [arccos, ← sin_pi_div_two_sub, arcsin_sin]; simp [sub_eq_add_neg]; linarith

lemma strict_anti_on_arccos : strict_anti_on arccos (Icc (-1) 1) :=
λ x hx y hy h, sub_lt_sub_left (strict_mono_on_arcsin hx hy h) _

lemma arccos_inj_on : inj_on arccos (Icc (-1) 1) := strict_anti_on_arccos.inj_on

lemma arccos_inj {x y : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) (hy₁ : -1 ≤ y) (hy₂ : y ≤ 1) :
  arccos x = arccos y ↔ x = y :=
arccos_inj_on.eq_iff ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩

@[simp] lemma arccos_zero : arccos 0 = π / 2 := by simp [arccos]

@[simp] lemma arccos_one : arccos 1 = 0 := by simp [arccos]

@[simp] lemma arccos_neg_one : arccos (-1) = π := by simp [arccos, add_halves]

@[simp] lemma arccos_eq_zero {x} : arccos x = 0 ↔ 1 ≤ x :=
by simp [arccos, sub_eq_zero]

@[simp] lemma arccos_eq_pi_div_two {x} : arccos x = π / 2 ↔ x = 0 :=
by simp [arccos]

@[simp] lemma arccos_eq_pi {x} : arccos x = π ↔ x ≤ -1 :=
by rw [arccos, sub_eq_iff_eq_add, ← sub_eq_iff_eq_add', div_two_sub_self, neg_pi_div_two_eq_arcsin]

lemma arccos_neg (x : ℝ) : arccos (-x) = π - arccos x :=
by rw [← add_halves π, arccos, arcsin_neg, arccos, add_sub_assoc, sub_sub_self, sub_neg_eq_add]

lemma sin_arccos {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : sin (arccos x) = sqrt (1 - x ^ 2) :=
by rw [arccos_eq_pi_div_two_sub_arcsin, sin_pi_div_two_sub, cos_arcsin hx₁ hx₂]

@[simp] lemma arccos_le_pi_div_two {x} : arccos x ≤ π / 2 ↔ 0 ≤ x := by simp [arccos]

@[simp] lemma arccos_le_pi_div_four {x} : arccos x ≤ π / 4 ↔ sqrt 2 / 2 ≤ x :=
by { rw [arccos, ← pi_div_four_le_arcsin], split; { intro, linarith } }

@[continuity]
lemma continuous_arccos : continuous arccos := continuous_const.sub continuous_arcsin

end real