/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import topology.continuous_function.compact
import analysis.normed_space.units
import algebra.algebra.spectrum

/-!
# Units of continuous functions

This file concerns itself with `C(X, M)ˣ` and `C(X, Mˣ)` when `X` is a topological space
and `M` has some monoid structure compatible with its topology.
-/

variables {X M R 𝕜 : Type*} [topological_space X]

namespace continuous_map

section monoid

variables [monoid M] [topological_space M] [has_continuous_mul M]

/-- Equivalence between continuous maps into the units of a monoid with continuous multiplication
and the units of the monoid of continuous maps. -/
@[to_additive "Equivalence between continuous maps into the additive units of an additive monoid
with continuous addition and the additive units of the additive monoid of continuous maps.", simps]
def units_lift : C(X, Mˣ) ≃ C(X, M)ˣ :=
{ to_fun := λ f,
  { val := ⟨λ x, f x, units.continuous_coe.comp f.continuous⟩,
    inv := ⟨λ x, ↑(f x)⁻¹, units.continuous_coe.comp (continuous_inv.comp f.continuous)⟩,
    val_inv := ext $ λ x, units.mul_inv _,
    inv_val := ext $ λ x, units.inv_mul _ },
  inv_fun := λ f,
  { to_fun := λ x, ⟨f x, f⁻¹ x, continuous_map.congr_fun f.mul_inv x,
                                continuous_map.congr_fun f.inv_mul x⟩,
    continuous_to_fun := continuous_induced_rng $ continuous.prod_mk (f : C(X, M)).continuous
      $ mul_opposite.continuous_op.comp (↑f⁻¹ : C(X, M)).continuous },
  left_inv := λ f, by { ext, refl },
  right_inv := λ f, by { ext, refl } }

end monoid

section normed_ring

variables [normed_ring R] [complete_space R]

lemma _root_.normed_ring.is_unit_unit_continuous {f : C(X, R)} (h : ∀ x, is_unit (f x)) :
  continuous (λ x, (h x).unit) :=
begin
  refine continuous_induced_rng (continuous.prod_mk f.continuous
    (mul_opposite.continuous_op.comp (continuous_iff_continuous_at.mpr (λ x, _)))),
  have := normed_ring.inverse_continuous_at (h x).unit,
  simp only [←ring.inverse_unit, is_unit.unit_spec, ←function.comp_apply] at this ⊢,
  exact this.comp (f.continuous_at x),
end

/-- Construct a continuous map into the group of units of a normed ring from a function into the
normed ring and a proof that every element of the range is a unit. -/
@[simps]
noncomputable def units_of_forall_is_unit {f : C(X, R)} (h : ∀ x, is_unit (f x)) : C(X, Rˣ) :=
{ to_fun := λ x, (h x).unit,
  continuous_to_fun :=  normed_ring.is_unit_unit_continuous h }

instance : can_lift C(X, R) C(X, Rˣ) :=
{ coe := λ f, ⟨λ x, f x, units.continuous_coe.comp f.continuous⟩,
  cond := λ f, ∀ x, is_unit (f x),
  prf := λ f h, ⟨units_of_forall_is_unit h, by { ext, refl }⟩ }

lemma is_unit_iff_forall_is_unit (f : C(X, R)) :
  is_unit f ↔ ∀ x, is_unit (f x) :=
iff.intro (λ h, λ x, ⟨units_lift.symm h.unit x, rfl⟩)
  (λ h, ⟨(units_of_forall_is_unit h).units_lift, by { ext, refl }⟩)

end normed_ring

section normed_field

variables [normed_field 𝕜] [complete_space 𝕜]

lemma is_unit_iff_forall_ne_zero (f : C(X, 𝕜)) :
  is_unit f ↔ ∀ x, f x ≠ 0 :=
by simp_rw [f.is_unit_iff_forall_is_unit, is_unit_iff_ne_zero]

lemma spectrum_eq_range (f : C(X, 𝕜)) :
  spectrum 𝕜 f = set.range f :=
begin
  ext,
  simp only [spectrum.mem_iff, is_unit_iff_forall_ne_zero, not_forall, coe_sub,
    pi.sub_apply, algebra_map_apply, algebra.id.smul_eq_mul, mul_one, not_not, set.mem_range,
    sub_eq_zero, @eq_comm _ x _]
end

end normed_field

end continuous_map


import tactic
import analysis.inner_product_space.basic
import data.set
import data.real.basic
variables {V : Type*} [inner_product_space ℝ V] [finite_dimensional ℝ V] (T : V →ₗ[ℝ] V ) (h_non_triv_space : ∃ (v : V), v ≠ 0)

def S : set ℝ := {x : ℝ | ∃ (y : V), (y ≠ 0) ∧ (λ (x : V) , ∥T x∥/∥x∥) y = x}
def S2 : set ℝ := {x : ℝ | ∃ (y : V), (λ (x : V) , ⟪T x, T x⟫_ℝ/⟪x, x⟫_ℝ) y = x}

example : ∀ (v : V), ⟪v, v⟫_ℝ = ∥v∥^2 :=
begin
  intro v,
  rw real_inner_self_eq_norm_mul_norm,
  ring,
end

lemma S2_map_nonneg : ∀(x : V), x ≠ 0 → 0 ≤ ⟪T x, T x⟫_ℝ / ⟪x, x⟫_ℝ:=
begin
  intro x,
  intro h,
  have h2: 0 ≤ ⟪T x, T x⟫_ℝ,
  exact real_inner_self_nonneg,
  have h3 : 0 < ⟪x,x⟫_ℝ,
    have h4: 0 ≠ ⟪x,x⟫_ℝ,
      by_contra h3,
      rw eq_comm at h3,
      rw inner_self_eq_zero at h3,
      apply h, exact h3,
    rw ne_iff_lt_or_gt at h4,
    cases h4,
      exact h4,
      exfalso,
      change ⟪x,x⟫_ℝ < 0 at h4,
      rw ←not_le at h4,
      apply h4,
      exact real_inner_self_nonneg,
  rw le_div_iff,
  rw zero_mul, exact h2,
  exact h3,
end

lemma S_map_nonneg: ∀(x : V), x ≠ 0 → 0 ≤ ∥T x∥/∥x∥:=
begin
  intro x,
  intro h,
  rw norm_eq_sqrt_real_inner,
  rw norm_eq_sqrt_real_inner,
  rw ←real.sqrt_div,
  rw ←real.sqrt_zero,
  apply real.sqrt_le_sqrt,
  apply S2_map_nonneg,
  exact h,
  exact real_inner_self_nonneg,
end

lemma V_nonempty : nonempty V :=
begin
  exact has_zero.nonempty,
end

lemma max_squared {h: is_lub (S2 T) (Sup (S2 T))} (h_non_triv_space : ∃ (v : V), v ≠ 0): is_lub (S T) (real.sqrt (Sup (S2 T))) :=
begin
  cases h with hup hleast,
  have hup2: real.sqrt (Sup (S2 T)) ∈ upper_bounds (S T),
  {
    change ∀⦃a : ℝ⦄, a ∈ (S T) → a ≤  real.sqrt (Sup (S2 T)),
    intro a,
    intro h2,
    change ∃(y : V), (y ≠ 0) ∧ ∥T y∥/∥y∥  = a at h2,
    cases h2,
    cases h2_h with h2_h_nz h2_h,
    rw norm_eq_sqrt_real_inner at h2_h,
    rw norm_eq_sqrt_real_inner at h2_h,
    rw ←real.sqrt_div at h2_h,
    {
      rw ←h2_h,
      rw real.sqrt_le_sqrt_iff,
      apply le_cSup,
      use Sup (S2 T), exact hup,
      use h2_w,
      apply le_cSup_of_le,
      use Sup (S2 T), exact hup,
      use h2_w,
      apply S2_map_nonneg, exact h2_h_nz,
    },{
      exact real_inner_self_nonneg,
    }
  },
  split,
    exact hup2,
  change ∀ ⦃a : ℝ⦄, a ∈ upper_bounds (S T) → real.sqrt (Sup (S2 T)) ≤ a,
  intro a,
  intro h,
  change ∀⦃b : ℝ⦄, b ∈ (S T) → b ≤  a at h,
  by_contra h2,
  rw not_le at h2,
  let b := a^2,
  have h3: b < Sup (S2 T),
  rw ←real.sqrt_lt_sqrt_iff,
  rw real.sqrt_sq,
  exact h2,
  cases h_non_triv_space with vnz hv,
  have h4 := S_map_nonneg,
  specialize h4 T,
  specialize h4 vnz,
  have h5 : 0 ≤ ∥T vnz∥ / ∥vnz∥,
  apply h4, exact hv,
  have h6 : ∥T vnz∥ / ∥vnz∥ ≤ a,
  have h7 :  ∥T vnz∥ / ∥vnz∥ ∈ (S T),
  use vnz, split, exact hv, refl,
  apply h, exact h7, linarith [h5,h6],
  exact _inst_2,
  exact sq_nonneg a,

end

example (a : ℝ): 0 ≤ a^2 :=
begin
  exact sq_nonneg a,
end


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Heather Macbeth

! This file was ported from Lean 3 source module analysis.inner_product_space.orientation
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.GramSchmidtOrtho
import Mathbin.LinearAlgebra.Orientation

/-!
# Orientations of real inner product spaces.

This file provides definitions and proves lemmas about orientations of real inner product spaces.

## Main definitions

* `orthonormal_basis.adjust_to_orientation` takes an orthonormal basis and an orientation, and
  returns an orthonormal basis with that orientation: either the original orthonormal basis, or one
  constructed by negating a single (arbitrary) basis vector.
* `orientation.fin_orthonormal_basis` is an orthonormal basis, indexed by `fin n`, with the given
  orientation.
* `orientation.volume_form` is a nonvanishing top-dimensional alternating form on an oriented real
  inner product space, uniquely defined by compatibility with the orientation and inner product
  structure.

## Main theorems

* `orientation.volume_form_apply_le` states that the result of applying the volume form to a set of
  `n` vectors, where `n` is the dimension the inner product space, is bounded by the product of the
  lengths of the vectors.
* `orientation.abs_volume_form_apply_of_pairwise_orthogonal` states that the result of applying the
  volume form to a set of `n` orthogonal vectors, where `n` is the dimension the inner product
  space, is equal up to sign to the product of the lengths of the vectors.

-/

noncomputable section

variable {E : Type _} [NormedAddCommGroup E] [InnerProductSpace ℝ E]

open FiniteDimensional

open BigOperators RealInnerProductSpace

namespace OrthonormalBasis

variable {ι : Type _} [Fintype ι] [DecidableEq ι] [ne : Nonempty ι] (e f : OrthonormalBasis ι ℝ E)
  (x : Orientation ℝ E ι)

/-- The change-of-basis matrix between two orthonormal bases with the same orientation has
determinant 1. -/
theorem det_to_matrix_orthonormalBasis_of_same_orientation
    (h : e.toBasis.Orientation = f.toBasis.Orientation) : e.toBasis.det f = 1 :=
  by
  apply (e.det_to_matrix_orthonormal_basis_real f).resolve_right
  have : 0 < e.to_basis.det f :=
    by
    rw [e.to_basis.orientation_eq_iff_det_pos] at h
    simpa using h
  linarith
#align orthonormal_basis.det_to_matrix_orthonormal_basis_of_same_orientation OrthonormalBasis.det_to_matrix_orthonormalBasis_of_same_orientation

/-- The change-of-basis matrix between two orthonormal bases with the opposite orientations has
determinant -1. -/
theorem det_to_matrix_orthonormalBasis_of_opposite_orientation
    (h : e.toBasis.Orientation ≠ f.toBasis.Orientation) : e.toBasis.det f = -1 :=
  by
  contrapose! h
  simp [e.to_basis.orientation_eq_iff_det_pos,
    (e.det_to_matrix_orthonormal_basis_real f).resolve_right h]
#align orthonormal_basis.det_to_matrix_orthonormal_basis_of_opposite_orientation OrthonormalBasis.det_to_matrix_orthonormalBasis_of_opposite_orientation

variable {e f}

/-- Two orthonormal bases with the same orientation determine the same "determinant" top-dimensional
form on `E`, and conversely. -/
theorem same_orientation_iff_det_eq_det :
    e.toBasis.det = f.toBasis.det ↔ e.toBasis.Orientation = f.toBasis.Orientation :=
  by
  constructor
  · intro h
    dsimp [Basis.orientation]
    congr
  · intro h
    rw [e.to_basis.det.eq_smul_basis_det f.to_basis]
    simp [e.det_to_matrix_orthonormal_basis_of_same_orientation f h]
#align orthonormal_basis.same_orientation_iff_det_eq_det OrthonormalBasis.same_orientation_iff_det_eq_det

variable (e f)

/-- Two orthonormal bases with opposite orientations determine opposite "determinant"
top-dimensional forms on `E`. -/
theorem det_eq_neg_det_of_opposite_orientation (h : e.toBasis.Orientation ≠ f.toBasis.Orientation) :
    e.toBasis.det = -f.toBasis.det :=
  by
  rw [e.to_basis.det.eq_smul_basis_det f.to_basis]
  simp [e.det_to_matrix_orthonormal_basis_of_opposite_orientation f h]
#align orthonormal_basis.det_eq_neg_det_of_opposite_orientation OrthonormalBasis.det_eq_neg_det_of_opposite_orientation

section AdjustToOrientation

include ne

/-- `orthonormal_basis.adjust_to_orientation`, applied to an orthonormal basis, preserves the
property of orthonormality. -/
theorem orthonormal_adjustToOrientation : Orthonormal ℝ (e.toBasis.adjustToOrientation x) :=
  by
  apply e.orthonormal.orthonormal_of_forall_eq_or_eq_neg
  simpa using e.to_basis.adjust_to_orientation_apply_eq_or_eq_neg x
#align orthonormal_basis.orthonormal_adjust_to_orientation OrthonormalBasis.orthonormal_adjustToOrientation

/-- Given an orthonormal basis and an orientation, return an orthonormal basis giving that
orientation: either the original basis, or one constructed by negating a single (arbitrary) basis
vector. -/
def adjustToOrientation : OrthonormalBasis ι ℝ E :=
  (e.toBasis.adjustToOrientation x).toOrthonormalBasis (e.orthonormal_adjustToOrientation x)
#align orthonormal_basis.adjust_to_orientation OrthonormalBasis.adjustToOrientation

theorem toBasis_adjustToOrientation :
    (e.adjustToOrientation x).toBasis = e.toBasis.adjustToOrientation x :=
  (e.toBasis.adjustToOrientation x).toBasis_toOrthonormalBasis _
#align orthonormal_basis.to_basis_adjust_to_orientation OrthonormalBasis.toBasis_adjustToOrientation

/-- `adjust_to_orientation` gives an orthonormal basis with the required orientation. -/
@[simp]
theorem orientation_adjustToOrientation : (e.adjustToOrientation x).toBasis.Orientation = x :=
  by
  rw [e.to_basis_adjust_to_orientation]
  exact e.to_basis.orientation_adjust_to_orientation x
#align orthonormal_basis.orientation_adjust_to_orientation OrthonormalBasis.orientation_adjustToOrientation

/-- Every basis vector from `adjust_to_orientation` is either that from the original basis or its
negation. -/
theorem adjustToOrientation_apply_eq_or_eq_neg (i : ι) :
    e.adjustToOrientation x i = e i ∨ e.adjustToOrientation x i = -e i := by
  simpa [← e.to_basis_adjust_to_orientation] using
    e.to_basis.adjust_to_orientation_apply_eq_or_eq_neg x i
#align orthonormal_basis.adjust_to_orientation_apply_eq_or_eq_neg OrthonormalBasis.adjustToOrientation_apply_eq_or_eq_neg

theorem det_adjustToOrientation :
    (e.adjustToOrientation x).toBasis.det = e.toBasis.det ∨
      (e.adjustToOrientation x).toBasis.det = -e.toBasis.det :=
  by simpa using e.to_basis.det_adjust_to_orientation x
#align orthonormal_basis.det_adjust_to_orientation OrthonormalBasis.det_adjustToOrientation

theorem abs_det_adjustToOrientation (v : ι → E) :
    |(e.adjustToOrientation x).toBasis.det v| = |e.toBasis.det v| := by
  simp [to_basis_adjust_to_orientation]
#align orthonormal_basis.abs_det_adjust_to_orientation OrthonormalBasis.abs_det_adjustToOrientation

end AdjustToOrientation

end OrthonormalBasis

namespace Orientation

variable {n : ℕ}

open OrthonormalBasis

/-- An orthonormal basis, indexed by `fin n`, with the given orientation. -/
protected def finOrthonormalBasis (hn : 0 < n) (h : finrank ℝ E = n) (x : Orientation ℝ E (Fin n)) :
    OrthonormalBasis (Fin n) ℝ E :=
  by
  haveI := Fin.pos_iff_nonempty.1 hn
  haveI := finite_dimensional_of_finrank (h.symm ▸ hn : 0 < finrank ℝ E)
  exact ((stdOrthonormalBasis _ _).reindex <| finCongr h).adjustToOrientation x
#align orientation.fin_orthonormal_basis Orientation.finOrthonormalBasis

/-- `orientation.fin_orthonormal_basis` gives a basis with the required orientation. -/
@[simp]
theorem finOrthonormalBasis_orientation (hn : 0 < n) (h : finrank ℝ E = n)
    (x : Orientation ℝ E (Fin n)) : (x.finOrthonormalBasis hn h).toBasis.Orientation = x :=
  by
  haveI := Fin.pos_iff_nonempty.1 hn
  haveI := finite_dimensional_of_finrank (h.symm ▸ hn : 0 < finrank ℝ E)
  exact ((stdOrthonormalBasis _ _).reindex <| finCongr h).orientation_adjustToOrientation x
#align orientation.fin_orthonormal_basis_orientation Orientation.finOrthonormalBasis_orientation

section VolumeForm

variable [_i : Fact (finrank ℝ E = n)] (o : Orientation ℝ E (Fin n))

include _i o

/-- The volume form on an oriented real inner product space, a nonvanishing top-dimensional
alternating form uniquely defined by compatibility with the orientation and inner product structure.
-/
irreducible_def volumeForm : AlternatingMap ℝ E ℝ (Fin n) := by
  classical
    cases n
    · let opos : AlternatingMap ℝ E ℝ (Fin 0) := AlternatingMap.constOfIsEmpty ℝ E (1 : ℝ)
      exact o.eq_or_eq_neg_of_is_empty.by_cases (fun _ => opos) fun _ => -opos
    · exact (o.fin_orthonormal_basis n.succ_pos _i.out).toBasis.det
#align orientation.volume_form Orientation.volumeForm

omit _i o

@[simp]
theorem volumeForm_zero_pos [_i : Fact (finrank ℝ E = 0)] :
    Orientation.volumeForm (positiveOrientation : Orientation ℝ E (Fin 0)) =
      AlternatingMap.constLinearEquivOfIsEmpty 1 :=
  by simp [volume_form, Or.by_cases, if_pos]
#align orientation.volume_form_zero_pos Orientation.volumeForm_zero_pos

theorem volumeForm_zero_neg [_i : Fact (finrank ℝ E = 0)] :
    Orientation.volumeForm (-positiveOrientation : Orientation ℝ E (Fin 0)) =
      -AlternatingMap.constLinearEquivOfIsEmpty 1 :=
  by
  dsimp [volume_form, Or.by_cases, positive_orientation]
  apply if_neg
  rw [ray_eq_iff, SameRay.sameRay_comm]
  intro h
  simpa using
    congr_arg alternating_map.const_linear_equiv_of_is_empty.symm (eq_zero_of_sameRay_self_neg h)
#align orientation.volume_form_zero_neg Orientation.volumeForm_zero_neg

include _i o

/-- The volume form on an oriented real inner product space can be evaluated as the determinant with
respect to any orthonormal basis of the space compatible with the orientation. -/
theorem volumeForm_robust (b : OrthonormalBasis (Fin n) ℝ E) (hb : b.toBasis.Orientation = o) :
    o.volumeForm = b.toBasis.det := by
  cases n
  ·
    classical
      have : o = positive_orientation := hb.symm.trans b.to_basis.orientation_is_empty
      simp [volume_form, Or.by_cases, dif_pos this]
  · dsimp [volume_form]
    rw [same_orientation_iff_det_eq_det, hb]
    exact o.fin_orthonormal_basis_orientation _ _
#align orientation.volume_form_robust Orientation.volumeForm_robust

/-- The volume form on an oriented real inner product space can be evaluated as the determinant with
respect to any orthonormal basis of the space compatible with the orientation. -/
theorem volumeForm_robust_neg (b : OrthonormalBasis (Fin n) ℝ E) (hb : b.toBasis.Orientation ≠ o) :
    o.volumeForm = -b.toBasis.det := by
  cases n
  ·
    classical
      have : positive_orientation ≠ o := by rwa [b.to_basis.orientation_is_empty] at hb
      simp [volume_form, Or.by_cases, dif_neg this.symm]
  let e : OrthonormalBasis (Fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (Fact.out _)
  dsimp [volume_form]
  apply e.det_eq_neg_det_of_opposite_orientation b
  convert hb.symm
  exact o.fin_orthonormal_basis_orientation _ _
#align orientation.volume_form_robust_neg Orientation.volumeForm_robust_neg

@[simp]
theorem volumeForm_neg_orientation : (-o).volumeForm = -o.volumeForm :=
  by
  cases n
  · refine' o.eq_or_eq_neg_of_is_empty.elim _ _ <;> rintro rfl <;> simp [volume_form_zero_neg]
  let e : OrthonormalBasis (Fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (Fact.out _)
  have h₁ : e.to_basis.orientation = o := o.fin_orthonormal_basis_orientation _ _
  have h₂ : e.to_basis.orientation ≠ -o := by
    symm
    rw [e.to_basis.orientation_ne_iff_eq_neg, h₁]
  rw [o.volume_form_robust e h₁, (-o).volumeForm_robust_neg e h₂]
#align orientation.volume_form_neg_orientation Orientation.volumeForm_neg_orientation

theorem volumeForm_robust' (b : OrthonormalBasis (Fin n) ℝ E) (v : Fin n → E) :
    |o.volumeForm v| = |b.toBasis.det v| := by
  cases n
  · refine' o.eq_or_eq_neg_of_is_empty.elim _ _ <;> rintro rfl <;> simp
  ·
    rw [o.volume_form_robust (b.adjust_to_orientation o) (b.orientation_adjust_to_orientation o),
      b.abs_det_adjust_to_orientation]
#align orientation.volume_form_robust' Orientation.volumeForm_robust'

/-- Let `v` be an indexed family of `n` vectors in an oriented `n`-dimensional real inner
product space `E`. The output of the volume form of `E` when evaluated on `v` is bounded in absolute
value by the product of the norms of the vectors `v i`. -/
theorem abs_volumeForm_apply_le (v : Fin n → E) : |o.volumeForm v| ≤ ∏ i : Fin n, ‖v i‖ :=
  by
  cases n
  · refine' o.eq_or_eq_neg_of_is_empty.elim _ _ <;> rintro rfl <;> simp
  haveI : FiniteDimensional ℝ E := fact_finite_dimensional_of_finrank_eq_succ n
  have : finrank ℝ E = Fintype.card (Fin n.succ) := by simpa using _i.out
  let b : OrthonormalBasis (Fin n.succ) ℝ E := gramSchmidtOrthonormalBasis this v
  have hb : b.to_basis.det v = ∏ i, ⟪b i, v i⟫ := gramSchmidtOrthonormalBasis_det this v
  rw [o.volume_form_robust' b, hb, Finset.abs_prod]
  apply Finset.prod_le_prod
  · intro i hi
    positivity
  intro i hi
  convert abs_real_inner_le_norm (b i) (v i)
  simp [b.orthonormal.1 i]
#align orientation.abs_volume_form_apply_le Orientation.abs_volumeForm_apply_le

theorem volumeForm_apply_le (v : Fin n → E) : o.volumeForm v ≤ ∏ i : Fin n, ‖v i‖ :=
  (le_abs_self _).trans (o.abs_volumeForm_apply_le v)
#align orientation.volume_form_apply_le Orientation.volumeForm_apply_le

/-- Let `v` be an indexed family of `n` orthogonal vectors in an oriented `n`-dimensional
real inner product space `E`. The output of the volume form of `E` when evaluated on `v` is, up to
sign, the product of the norms of the vectors `v i`. -/
theorem abs_volumeForm_apply_of_pairwise_orthogonal {v : Fin n → E}
    (hv : Pairwise fun i j => ⟪v i, v j⟫ = 0) : |o.volumeForm v| = ∏ i : Fin n, ‖v i‖ :=
  by
  cases n
  · refine' o.eq_or_eq_neg_of_is_empty.elim _ _ <;> rintro rfl <;> simp
  haveI : FiniteDimensional ℝ E := fact_finite_dimensional_of_finrank_eq_succ n
  have hdim : finrank ℝ E = Fintype.card (Fin n.succ) := by simpa using _i.out
  let b : OrthonormalBasis (Fin n.succ) ℝ E := gramSchmidtOrthonormalBasis hdim v
  have hb : b.to_basis.det v = ∏ i, ⟪b i, v i⟫ := gramSchmidtOrthonormalBasis_det hdim v
  rw [o.volume_form_robust' b, hb, Finset.abs_prod]
  by_cases h : ∃ i, v i = 0
  obtain ⟨i, hi⟩ := h
  ·
    rw [Finset.prod_eq_zero (Finset.mem_univ i), Finset.prod_eq_zero (Finset.mem_univ i)] <;>
      simp [hi]
  push_neg  at h
  congr
  ext i
  have hb : b i = ‖v i‖⁻¹ • v i := gramSchmidtOrthonormalBasis_apply_of_orthogonal hdim hv (h i)
  simp only [hb, inner_smul_left, real_inner_self_eq_norm_mul_norm, IsROrC.conj_to_real]
  rw [abs_of_nonneg]
  · have : ‖v i‖ ≠ 0 := by simpa using h i
    field_simp
  · positivity
#align orientation.abs_volume_form_apply_of_pairwise_orthogonal Orientation.abs_volumeForm_apply_of_pairwise_orthogonal

/-- The output of the volume form of an oriented real inner product space `E` when evaluated on an
orthonormal basis is ±1. -/
theorem abs_volumeForm_apply_of_orthonormal (v : OrthonormalBasis (Fin n) ℝ E) :
    |o.volumeForm v| = 1 := by
  simpa [o.volume_form_robust' v v] using congr_arg abs v.to_basis.det_self
#align orientation.abs_volume_form_apply_of_orthonormal Orientation.abs_volumeForm_apply_of_orthonormal

theorem volumeForm_map {F : Type _} [NormedAddCommGroup F] [InnerProductSpace ℝ F]
    [Fact (finrank ℝ F = n)] (φ : E ≃ₗᵢ[ℝ] F) (x : Fin n → F) :
    (Orientation.map (Fin n) φ.toLinearEquiv o).volumeForm x = o.volumeForm (φ.symm ∘ x) :=
  by
  cases n
  · refine' o.eq_or_eq_neg_of_is_empty.elim _ _ <;> rintro rfl <;> simp
  let e : OrthonormalBasis (Fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (Fact.out _)
  have he : e.to_basis.orientation = o :=
    o.fin_orthonormal_basis_orientation n.succ_pos (Fact.out _)
  have heφ : (e.map φ).toBasis.Orientation = Orientation.map (Fin n.succ) φ.to_linear_equiv o :=
    by
    rw [← he]
    exact e.to_basis.orientation_map φ.to_linear_equiv
  rw [(Orientation.map (Fin n.succ) φ.to_linear_equiv o).volumeForm_robust (e.map φ) heφ]
  rw [o.volume_form_robust e he]
  simp
#align orientation.volume_form_map Orientation.volumeForm_map

/-- The volume form is invariant under pullback by a positively-oriented isometric automorphism. -/
theorem volumeForm_comp_linearIsometryEquiv (φ : E ≃ₗᵢ[ℝ] E)
    (hφ : 0 < (φ.toLinearEquiv : E →ₗ[ℝ] E).det) (x : Fin n → E) :
    o.volumeForm (φ ∘ x) = o.volumeForm x :=
  by
  convert o.volume_form_map φ (φ ∘ x)
  · symm
    rwa [← o.map_eq_iff_det_pos φ.to_linear_equiv] at hφ
    rw [_i.out, Fintype.card_fin]
  · ext
    simp
#align orientation.volume_form_comp_linear_isometry_equiv Orientation.volumeForm_comp_linearIsometryEquiv

end VolumeForm

end Orientation


import SciLean.Mechanics
import SciLean.Operators.ODE
import SciLean.Solver
import SciLean.Tactic.LiftLimit
import SciLean.Tactic.FinishImpl
import SciLean.Data.PowType
import SciLean.Core.Extra
import SciLean.Functions

open SciLean

set_option synthInstance.maxSize 2048
set_option synthInstance.maxHeartbeats 500000
set_option maxHeartbeats 500000

def LennardJones (ε minEnergy : ℝ) (radius : ℝ) (x : ℝ^(3:ℕ)) : ℝ :=
  let x' := ∥1/radius * x∥^{-6, ε}
  4 * minEnergy * x' * (x' - 1)
argument x [Fact (ε≠0)]
  isSmooth, diff, hasAdjDiff, adjDiff

def Coloumb (ε strength mass : ℝ) (x : ℝ^(3:ℕ)) : ℝ := - strength * mass * ∥x∥^{-1,ε}
argument x [Fact (ε≠0)]
  isSmooth, diff, hasAdjDiff, adjDiff

example (n : ℕ) (ε : ℝ) [Fact (n≠0)] [Fact (ε≠0)] (C LJ : ℝ) (r m : Idx n → ℝ)
  : (∂† λ (x : (ℝ^(3:ℕ))^n) =>
  ∑ i j, Coloumb ε C (m i * m j) (x[i] - x[j])
         +
         LennardJones ε LJ (r i + r j) (x[i] - x[j]))
   =
   λ x dx' => PowType.intro λ i =>
     ∑ j,   Coloumb.arg_x.adjDiff ε C (m i * m j) (x[i] - x[j]) dx'
          - Coloumb.arg_x.adjDiff ε C (m j * m i) (x[j] - x[i]) dx'
          + (  LennardJones.arg_x.adjDiff ε LJ (r i + r j) (x[i] - x[j]) dx'
             - LennardJones.arg_x.adjDiff ε LJ (r j + r i) (x[j] - x[i]) dx') :=
by
  simp; unfold hold; simp;
  simp [sum_into_lambda]
  simp [← sum_of_add]
  done

def H (n : ℕ) (ε : ℝ) (C LJ : ℝ) (r m : Idx n → ℝ) (x p : (ℝ^(3:ℕ))^n) : ℝ :=
  (∑ i, (1/(2*m i)) * ∥p[i]∥²)
  +
  ∑ i j,   Coloumb ε C (m i * m j) (x[i] - x[j])
         + LennardJones ε LJ (r i + r j) (x[i] - x[j])
argument p [Fact (n≠0)] [Fact (ε≠0)]
  isSmooth, diff, hasAdjDiff, adjDiff
argument x [Fact (n≠0)] [Fact (ε≠0)]
  isSmooth, diff, hasAdjDiff,
  adjDiff by
    simp[H]; unfold hold; simp; unfold hold; simp;
    simp [sum_into_lambda]
    simp [← sum_of_add]


import tactic
import data.int.parity
import data.int.modeq
import data.nat.factorization.basic
import number_theory.legendre_symbol.quadratic_reciprocity

import Mordell.CongruencesMod4

-- this should be PR'ed in Kevin's opinion!
lemma int.modeq_def {a b n : ℤ} : a ≡ b [ZMOD n] ↔ a % n = b % n := iff.rfl

-- as should this
lemma nat.modeq_def {a b n : ℕ} : a ≡ b [MOD n] ↔ a % n = b % n := iff.rfl

lemma int.exists_nat_of_nonneg {z : ℤ} (hz : 0 ≤ z) : ∃ n : ℕ,
  (n : ℤ) = z :=
⟨z.nat_abs, int.nat_abs_of_nonneg hz⟩

theorem modeq_add_fac_self {a t n : ℤ} : a + n * t ≡ a [ZMOD n] :=
int.modeq_add_fac _ int.modeq.rfl

theorem modeq_iff_add_fac {a b n : ℤ} : a ≡ b [ZMOD n] ↔ ∃ t, b = a + n * t :=
begin
  rw int.modeq_iff_dvd,
  exact exists_congr (λ t, sub_eq_iff_eq_add'),
end

lemma prime_factor_congr_3_mod_4 (x a : ℤ) (h : x^2 - a*x + a^2 ≡ 3 [ZMOD 4]) :
  ∃ (p : ℕ), p.prime ∧ (p : ℤ) ∣ (x^2 - a*x + a^2) ∧ p ≡ 3 [MOD 4] :=
begin
  have h2 : 0 ≤ x^2 - a*x + a^2 := by nlinarith,
  obtain ⟨n, hn⟩  := int.exists_nat_of_nonneg h2,
  rw ← hn at h,
  have h3 : n ≡ 3 [MOD 4],
  { rw int.modeq_def at h,
    rw nat.modeq_def,
    assumption_mod_cast },
  obtain ⟨p, hp1, hp2, hp3⟩ := three_modulo_four_prime_factor n h3,
  refine ⟨p, hp1, _, hp3⟩,
  rwa [← hn, int.coe_nat_dvd],
end

lemma cube_minus_one_no_solns_aux (x y n a : ℤ) (hx : n ≡ 3 [ZMOD 4])
  (ha : a ≡ 2 [ZMOD 4]) (hy : n + 1 = a^3): y^2 ≠ x^3 + n :=
begin
  intro heq,
  have oddx: odd x,
  { apply int.odd_iff_not_even.2,
    intro h,
    rw even_iff_two_dvd at h,
    have h3: 0 < 3:= by norm_num,
    rw ← int.pow_dvd_pow_iff h3 at h,
    norm_num at h,
    rw ← int.modeq_zero_iff_dvd at h,
    have h2 := int.modeq.add_right n h,
    rw ← heq at h2,
    norm_num at h2,
    apply int.square_ne_three_mod_four y,
    have h6: (4 : ℤ ) ∣ 8:= by norm_num,
    have h5:= int.modeq.modeq_of_dvd h6 h2,
    unfold int.modeq at h5 ⊢,
    rw h5,
    rw int.modeq at hx,
    exact hx, },
  have h2 : y^2+1=(x+a)*(x^2 - a*x + a^2),
  { rw heq,
    ring_nf,
    rw hy, },
  have h6 : x^2 - a*x + a^2 ≡ 3 [ZMOD 4],
  { rcases oddx with ⟨b,rfl⟩,
    ring_nf,
    symmetry,
    rcases modeq_iff_add_fac.1 ha.symm with ⟨t, rfl⟩,
    have htemp : (4 * b + (-(2 * (2 + 4 * t)) + 4)) * b + ((2 + 4 * t - 1) *
      (2 + 4 * t) + 1) = 3 + 4 * (b^2 - 2*t*b + (4*t^2 + 3*t)),
    { ring },
    rw htemp,
    exact modeq_add_fac_self.symm, },
  obtain ⟨p, hp, hpd, hp4⟩  := prime_factor_congr_3_mod_4 x a h6,
  have h9 : ↑p∣y^2 + 1,
  { rw h2,
    exact dvd_mul_of_dvd_right hpd (x + a), },
  haveI : fact (nat.prime p) := ⟨hp⟩,
  set yp : zmod p := y with hyp0,
  have hyp : yp^2 = -1,
  { rw ← zmod.int_coe_zmod_eq_zero_iff_dvd at h9,
    push_cast at h9,
    linear_combination h9, },
  apply zmod.mod_four_ne_three_of_sq_eq_neg_one hyp,
  rw nat.modeq at hp4,
  norm_num at hp4,
  assumption,
end

theorem cube_minus_one_no_solns : ¬ ∃ x y t : ℤ, y^2 = x^3 + 64*t^3 + 96*t^2 + 48*t + 7 :=
begin
  rintro ⟨x, y, t, h⟩,
  apply cube_minus_one_no_solns_aux x y (64*t^3 + 96*t^2 + 48*t + 7) (4*t+2),
  { rw (show 64*t^3 + 96*t^2 + 48*t + 7 = 3 + 4 * (16*t^3 + 24*t^2 + 12*t + 1), by ring),
    apply modeq_add_fac_self, },
  { rw add_comm,
    apply modeq_add_fac_self, },
  { ring, },
  { linear_combination h, },
end

example : ¬ ∃ x y : ℤ, y^2=x^3-9 :=
begin
  rintro ⟨x, y, h⟩,
  apply cube_minus_one_no_solns,
  use [x,y,-1],
  rw h,
  ring,
end


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons fin.extra

variables {α : Type*} [dlo : decidable_linear_order α]
include dlo
open tup

definition tup.max : Π {n : ℕ}, α ^ (n+1) → α
| 0 xs := xs.head
| (n+1) xs := max xs.head (tup.max xs.tail)

lemma tup.le_max : ∀ {n : ℕ} {xs : α ^ (n+1)} {i : fin (n+1)}, xs[i] ≤ xs.max
| 0 xs ⟨0,_⟩ :=
  le_refl xs.head
| 0 _ ⟨i+1,h⟩ :=
  absurd (nat.lt_of_succ_lt_succ h) (nat.not_lt_zero i)
| (n+1) xs ⟨0,_⟩ :=
  le_max_left xs.head xs.tail.max
| (n+1) xs ⟨i+1,h⟩ :=
  calc
  xs[⟨i+1, h⟩]
      = (xs.tail)[⟨i, nat.lt_of_succ_lt_succ h⟩] : rfl
  ... ≤ xs.tail.max : tup.le_max
  ... ≤ xs.max      : le_max_right xs.head xs.tail.max

lemma tup.max_le : ∀ {n : ℕ} {xs : α ^ (n+1)} {y : α}, (∀ i, xs[i] ≤ y) → xs.max ≤ y
| 0 xs y h := h 0
| (n+1) xs y h :=
  have ∀ i, xs.tail[i] ≤ y, from λ ⟨i,hi⟩, h ⟨i+1, nat.succ_lt_succ hi⟩,
  max_le (h 0) (tup.max_le this)

definition tup.max' : Π {n : ℕ}, n ≠ 0 → α ^ n → α
| 0 h _ := absurd rfl h
| (n+1) _ xs := xs.max

lemma tup.le_max' : ∀ {n : ℕ} {xs : α ^ n} {i : fin n}, xs[i] ≤ tup.max' (fin.ne_zero_of_fin i) xs
| 0 _ i := fin.elim0 i
| (n+1) _ _ := tup.le_max

lemma tup.max'_le : ∀ {n : ℕ} {xs : α ^ n} {y : α} {h : n ≠ 0}, (∀ i, xs[i] ≤ y) → tup.max' h xs ≤ y
| 0 _ _ h := absurd rfl h
| (n+1) xs y _ := tup.max_le

definition tup.min : Π {n : ℕ}, α ^ (n+1) → α
| 0 xs := xs.head
| (n+1) xs := min xs.head (tup.min xs.tail)

lemma tup.min_le : ∀ {n : ℕ} {xs : α ^ (n+1)} {i : fin (n+1)}, xs[i] ≥ xs.min
| 0 xs ⟨0,_⟩ :=
  le_refl xs.head
| 0 _ ⟨i+1,h⟩ :=
  absurd (nat.lt_of_succ_lt_succ h) (nat.not_lt_zero i)
| (n+1) xs ⟨0,_⟩ :=
  min_le_left xs.head xs.tail.min
| (n+1) xs ⟨i+1,h⟩ :=
  calc
  xs[⟨i+1, h⟩]
      = xs.tail[⟨i, nat.lt_of_succ_lt_succ h⟩] : rfl
  ... ≥ xs.tail.min : tup.min_le
  ... ≥ xs.min      : min_le_right xs.head xs.tail.min

lemma tup.le_min : ∀ {n : ℕ} {xs : α ^ (n+1)} {y : α}, (∀ i, y ≤ xs[i]) → y ≤ xs.min
| 0 xs y h := h 0
| (n+1) xs y h :=
  have ∀ i, y ≤ xs.tail[i], from λ ⟨i,hi⟩, h ⟨i+1, nat.succ_lt_succ hi⟩,
  le_min (h 0) (tup.le_min this)

definition tup.min' : Π {n : ℕ}, n ≠ 0 → α ^ n → α
| 0 h _ := absurd rfl h
| (n+1) _ xs := xs.min

lemma tup.min'_le : ∀ {n : ℕ} {xs : α ^ n} {i : fin n}, xs[i] ≥ tup.min' (fin.ne_zero_of_fin i) xs
| 0 _ i := fin.elim0 i
| (n+1) _ _ := tup.min_le

lemma tup.le_min' : ∀ {n : ℕ} {xs : α ^ n} {y : α} {h : n ≠ 0}, (∀ i, y ≤ xs[i]) → y ≤ tup.min' h xs
| 0 _ _ h := absurd rfl h
| (n+1) xs y _ := tup.le_min


import tactic
import data.real.basic
import data.set

noncomputable theory

def dist_refl {X : Type} (d : X → X → ℝ)   := ∀(x y : X), d x y = 0 ↔ x = y
def dist_symm {X : Type} (d : X → X → ℝ)   := ∀(x y : X), d x y = d y x
def dist_triangle {X : Type} (d : X → X → ℝ) := ∀(x y z : X), d x y ≤  d x z + d z y

structure metric_space (X : Type) :=
(d : X → X → ℝ)
(refl     : dist_refl d)
(symm     : dist_symm d)
(triangle : dist_triangle d)

variables {X : Type} (mX : metric_space X)

def dist_real : ℝ → ℝ → ℝ := λ (a b : ℝ), |a - b|

@[simp]lemma dist_real_to_zero : ∀(x : ℝ), dist_real x 0 = |x| :=
begin
  intro x,
  unfold dist_real,
  rw sub_zero x,
end

def mR : metric_space ℝ := {
  d := dist_real,
  refl :=
  begin
  intros x y,
  unfold dist_real,

  simp only [abs_eq_zero],
  exact sub_eq_zero,
  end,

  symm :=
  begin
    intros x y,
    exact abs_sub_comm x y,
  end,

  triangle :=
  begin
    intros x y z,
    exact abs_sub_le x z y,
  end
}

@[simp] lemma mR_dist_is_dist_real : ∀(x y : ℝ), mR.d x y = |x - y| :=
begin
  intros x y,
  refl,
end

@[simp] lemma dist_real_is_abs : ∀(x y : ℝ), dist_real x y = |x - y| :=
begin
  intros x y,
  refl,
end

@[simp]lemma dist_real_metric_to_zero : ∀(x : ℝ), mR.d x 0 = |x| :=
begin
  intro x,
  change mR.d with dist_real,
  unfold dist_real,
  rw sub_zero x,
end

@[simp]lemma dist_self : ∀(x : X), mX.d x x = 0 :=
begin
  intros x,
  rw mX.refl x x,
end

lemma dist_nonneg :
∀(x y : X), mX.d x y  ≥ 0 :=
begin
  intros x y,
  have h1 := mX.triangle x x y,
  have h2 := (mX.refl x x).mpr (by refl),
  rw h2 at h1,
  rw ← mX.symm x y at h1,
  linarith,
end

lemma mR_dist_of_dist : ∀(x y z : X), mR.d (mX.d x y) (mX.d x z) ≤ mX.d z y :=
begin
  simp,
  intros x y z,
  rw abs_le,
  split,
  {
    have := mX.triangle x z y,
    rw mX.symm y z at this,
    linarith,
  },
  {
    have := mX.triangle x y z,
    linarith,
  },
end

@[simp]lemma abs_of_dist (x y : X) : |mX.d x y| = mX.d x y :=
begin
  simp,
  exact dist_nonneg mX x y,
end

def is_cauchy (a : ℕ → X)
:= ∀(ε : ℝ)(hε : ε > 0),∃(N : ℕ),∀(n m : ℕ)(hn: n ≥ N)
(hm: m ≥ N), mX.d (a n) (a m)  < ε

def seq_lim (a : ℕ → X) (L : X) :=
∀(ε : ℝ)(hε : ε > 0),∃(N : ℕ),∀(n : ℕ)(hn: n ≥ N),
mX.d (a n) L < ε

def seq_lim2 (a : ℕ → X) (L : X) :=
seq_lim mR (λ(n : ℕ), mX.d (a n) L) (0:ℝ)

lemma seq_lim_defs (a : ℕ → X) (L : X) :
seq_lim mX a L ↔ seq_lim2 mX a L :=
begin
  split,
  {
    intros h ε hε,
    cases h ε hε with N hN,
    use N,
    intros n hn,
    rw dist_real_metric_to_zero,
    rw abs_of_dist,
    exact hN n hn,
  },
  {
    intros h ε hε,
    cases h ε hε with N hN,
    use N,
    intros n hn,
    specialize hN n hn,
    rw dist_real_metric_to_zero at hN,
    rw abs_of_dist at hN,
    exact hN,
  },
end

lemma lim_unique {f : ℕ → X} {L M : X} : seq_lim mX f L →  seq_lim mX f M → L = M :=
begin
	intros hfL hfM,
	by_cases h : L = M, exact h, exfalso,
	have ε_pos : ((mX.d L M) / 2) > 0,
	{
		apply half_pos,
		have := dist_nonneg mX L M,
		have h1 := mX.refl L M,
		have h2 : ¬(mX.d L M = 0) := (not_congr (iff.symm h1)).mp h,
		exact (ne.symm h2).le_iff_lt.mp this,
	},

	cases hfL ((mX.d L M) / 2) ε_pos with N₁ hN₁,
	cases hfM ((mX.d L M) / 2) ε_pos with N₂ hN₂,

	specialize hN₁ (max N₁ N₂) (le_max_left N₁ N₂),
	specialize hN₂ (max N₁ N₂) (le_max_right N₁ N₂),

	have contra : (mX.d (f (max N₁ N₂)) L) + (mX.d (f (max N₁ N₂)) M) < mX.d L M:=
	by linarith,

	rw mX.symm (f (max N₁ N₂)) L at contra,

	have := lt_of_le_of_lt (mX.triangle L M (f (max N₁ N₂))) contra,
	simp at this,
	exact this,
end

lemma lim_of_mult_const_seq {x : ℕ → ℝ} {L : ℝ}
(hx : seq_lim mR x L) (k : ℝ) : seq_lim mR (λn, k * (x n)) (k*L) :=
begin
  intros ε hε,
  by_cases |k| = 0,
  {
  use 0,
  intros n hn,
  have : k = 0 := abs_eq_zero.mp h,
  rw this,
  change (λ (n : ℕ), 0 * x n) n with 0 * x n,
  rw zero_mul (x n),
  rw zero_mul L,
  have : dist_real 0 0 = |(0:ℝ)-(0:ℝ)| := by refl,
  simp at *,
  exact hε,
},
{
  have hk_pos : |k| > 0 := (ne.symm h).le_iff_lt.mp (abs_nonneg k),
  cases hx (ε/|k|) (div_pos hε hk_pos) with N hN,
  use N,
  intros n hn,
  change |k * (x n) - (k * L)| < ε,
  ring_nf,
  rw abs_mul (x n - L) k,
  rw (lt_div_iff hk_pos).symm,
  exact hN n hn,
},
end

def seq_converges (a : ℕ → X) :=
∃(L : X), seq_lim mX a L

def is_complete : Prop := ∀(x : ℕ → X)(hx : is_cauchy mX x), seq_converges mX x

def seq_equiv (a b: ℕ → X) :=
∀(ε : ℝ)(hε : ε > 0),∃(N : ℕ),∀(n : ℕ)(hn: n ≥ N), mX.d (a n) (b n) < ε

def seq_equiv2
 (a b: ℕ → X) :=
seq_lim mR (λ(n: ℕ), mX.d (a n) (b n)) 0

lemma seq_equiv_defs (a b : ℕ → X): seq_equiv mX a b ↔ seq_equiv2 mX a b :=
begin
  split,
  {
    intros h ε hε,
    cases h ε hε with N hN,
    use N,
    intros n hn,
    simp,
    exact hN n hn,
  },
  {
      intros h ε hε,
    cases h ε hε with N hN,
    use N,
    intros n hn,
    specialize hN n hn,
    simp at *,
    exact hN,
  },
end

lemma seq_equiv_almost_symm (a b: ℕ → X) :
seq_equiv mX a b → seq_equiv mX b a :=
begin
  intros h ε hε,
  cases h ε hε with N hN,
  use N,
  intros n hn,
  have d_symm := mX.symm (b n) (a n),
  rw d_symm,
  exact hN n hn,
end

lemma seq_equiv_symm (a b: ℕ → X) :
seq_equiv mX a b ↔ seq_equiv mX b a :=
⟨seq_equiv_almost_symm mX a b, seq_equiv_almost_symm mX b a⟩

lemma cauchy_of_equiv_to_cauchy (x : ℕ → X) (y : ℕ → X)
(hx : is_cauchy mX x) (hxy: seq_equiv mX x y) : is_cauchy mX y :=
begin
  intros ε hε,
  unfold is_cauchy at hx,
  cases hx (ε/3) (by linarith) with N₁ hN₁,
  cases hxy (ε/3) (by linarith) with N₂ hN₂,
  let N := max N₁ N₂,
  use N,

  intros n m hn hm,

  have hcalc1 := mX.triangle (x n) (y m) (x m),

  have hcalc2 : mX.d (y n) (x n) + mX.d (x n) (x m) + mX.d (x m) (y m) < ε,
  {
    have hn1 : n ≥ N₁ := le_of_max_le_left hn,
    have hn2 : n ≥ N₂ := le_of_max_le_right hn,
    have hm1 : m ≥ N₁ := le_of_max_le_left hm,
    have hm2 : m ≥ N₂ := le_of_max_le_right hm,

    have symm1 := mX.symm (x n) (y n),
    rw ← symm1,

    have dxy1 := hN₂ n hn2,
    have dxy2 := hN₂ m hm2,
    have dxx := hN₁ n m hn1 hm1,
    linarith,
  },

  exact calc mX.d (y n) (y m) ≤ mX.d (y n) (x n) + mX.d (x n) (y m)
  : mX.triangle (y n) (y m) (x n)
  ... ≤ mX.d (y n) (x n) + mX.d (x n) (x m) + mX.d (x m) (y m) : by linarith
  ... < ε : hcalc2,
end

lemma seq_equiv_of_eq_limit (x y : ℕ → X) (L : X)
(hx : seq_lim mX x L) (hy : seq_lim mX y L) : seq_equiv mX x y :=

begin
  intros ε hε,
  cases hx (ε/2) (by linarith) with N₁ hN₁,
  cases hy (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,

  have t1 := hN₁ n (le_of_max_le_left hn),
  have t2 := hN₂ n (le_of_max_le_right hn),
  have t3 : mX.d (x n) L + mX.d (y n) L < ε := by linarith,
  have t4 := mX.triangle (x n) (y n) L,

  rw mX.symm (y n) L at t3,

  calc mX.d (x n) (y n) ≤ mX.d (x n) L + mX.d L (y n) : t4
  ... < ε : t3,
end

theorem seq_squeeze {x y z : ℕ → ℝ} {L : ℝ}
 (hx : seq_lim mR x L) (hz : seq_lim mR z L)
 (hxy : ∀(n : ℕ), x n ≤ y n) (hyz : ∀(n : ℕ), y n ≤ z n) :
 seq_lim mR y L :=
begin
  intros ε hε,

  specialize hx (ε/2) (half_pos hε),
  specialize hz (ε/2) (half_pos hε),

  cases hx with N₁ hN₁,
  cases hz with N₂ hN₂,
  let N := max N₁ N₂,
  use N,

  intros n hn,
  specialize hN₁ n (le_of_max_le_left hn),
  specialize hN₂ n (le_of_max_le_right hn),
  specialize hxy n,
  specialize hyz n,
  simp at *,
  rw abs_lt at *,

  exact ⟨by linarith, by linarith⟩,
end

lemma sum_of_lims_is_lim_of_sum {x y : ℕ → ℝ} {L1 L2 : ℝ}
 (hx : seq_lim mR x L1) (hy : seq_lim mR y L2) :
  seq_lim mR (λ(n : ℕ), (x n) + (y n)) (L1 + L2) :=
begin
  intros ε hε,
  cases hx (ε/2) (by linarith) with N₁ hN₁,
  cases hy (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,

  specialize hN₁ n (le_of_max_le_left hn),
  specialize hN₂ n (le_of_max_le_right hn),

  simp at *,

  calc dist_real (x n + y n) (L1 + L2)  = |(x n + y n) - (L1 + L2)| : by refl
  ... = |(x n - L1) + (y n - L2)| : by ring_nf
  ... ≤ |(x n - L1)| + |(y n - L2)| : abs_add (x n - L1) (y n - L2)
  ... < ε : by linarith,
end

lemma sub_of_lims_is_lim_of_sub {x y : ℕ → ℝ} {L1 L2 : ℝ}
 (hx : seq_lim mR x L1) (hy : seq_lim mR y L2) :
  seq_lim mR (λ(n : ℕ), (x n) - (y n)) (L1 - L2) :=
begin
	have := sum_of_lims_is_lim_of_sum hx (lim_of_mult_const_seq hy (-1)),
	simp at this,
	exact this,
end

lemma eq_lim_of_equiv_seqs {x y : ℕ → X} (hxy : seq_equiv mX x y) {L : X} :
 seq_lim mX x L → seq_lim mX y L
:=
 begin
   intro hx,
   have dyL_nonneg : ∀(n : ℕ), 0 ≤ mX.d (y n) L,
   {
     intro n,
     apply dist_nonneg,
   },

   have dyL_triangle := λ(n : ℕ), mX.triangle (y n) L (x n),

   let seq1 : ℕ → ℝ := λ(n : ℕ), 0,
   let seq2 : ℕ → ℝ := λ(n : ℕ), mX.d (y n) L,
   let seq3 : ℕ → ℝ  := λ(n : ℕ), mX.d (y n) (x n) + mX.d (x n) L,

  have h12 : ∀(n : ℕ), seq1 n ≤ seq2 n := dyL_nonneg,
  have h23 : ∀(n : ℕ), seq2 n ≤ seq3 n := dyL_triangle,

  have hseq1_to_0 : seq_lim mR seq1 0,
  {
    intros ε hε,
    use 1,
    intros n hn,
    simp,
    exact hε,
  },

  have hseq3_to_0 : seq_lim mR seq3 0,
  {
    let temp1 := λ(n : ℕ), mX.d (y n) (x n),
    let temp2 := λ(n : ℕ), mX.d (x n) L,

    have temp1_to_0 : seq_lim mR temp1 0,
    {
      rw seq_equiv_symm at hxy,
      rw seq_equiv_defs at hxy,
      exact hxy,
    },
    have temp2_to_0 : seq_lim mR temp2 0,
    {
      rw seq_lim_defs at hx,
      exact hx,
    },

    have temp0_plus_temp1 :=
    sum_of_lims_is_lim_of_sum temp1_to_0 temp2_to_0,
    have obv : ((0:ℝ) + (0:ℝ)) = (0:ℝ) := add_zero 0,
    rw obv at temp0_plus_temp1,
    exact temp0_plus_temp1,
  },

  have squeeze := seq_squeeze hseq1_to_0 hseq3_to_0 h12 h23,

  have t1 : seq_lim2 mR seq2 0,
  {
    intros ε hε,
    specialize squeeze ε hε,
    cases squeeze with N hN,
    use N,
    intros n hn,
    have t2 : (λ (n : ℕ), dist_real (seq2 n) (seq1 n)) n =
    dist_real (seq2 n) 0 := by refl,
    simp at *,
    specialize hN n hn,
    rw dist_real_to_zero (seq2 n) at *,
    exact hN,
  },

  rw seq_lim_defs,
  unfold seq_lim2 at *,
  assumption,
 end

def is_bound_for_seq (M : ℝ) (x : ℕ → ℝ) : Prop := ∀n:ℕ, |x n| ≤ M
def is_upper_bound_for_seq (M : ℝ) (x : ℕ → ℝ) : Prop := ∀n:ℕ, x n ≤ M
def is_lower_bound_for_seq (M : ℝ) (x : ℕ → ℝ) : Prop := ∀n:ℕ, x n ≥ M

def is_bounded_above_seq (x : ℕ → ℝ) : Prop := ∃M:ℝ, (is_upper_bound_for_seq M x)
def is_bounded_below_seq (x : ℕ → ℝ) : Prop := ∃M:ℝ, (is_lower_bound_for_seq M x)
def is_bounded_seq (x : ℕ → ℝ) : Prop := is_bounded_above_seq x ∧ is_bounded_below_seq x
def is_increasing_seq (x : ℕ → ℝ) : Prop := ∀(n m : ℕ) (hnm : n ≤ m), x n ≤ x m
def is_decreasing_seq (x : ℕ → ℝ) : Prop := ∀(n m : ℕ) (hnm : n ≤ m), x n ≥ x m
def is_monotone_seq (x : ℕ → ℝ) : Prop := is_increasing_seq x ∨ is_decreasing_seq x
def is_extraction (φ: ℕ → ℕ) : Prop := ∀(n m : ℕ) (hnm : n < m), φ n < φ m

lemma extraction_iff (φ: ℕ → ℕ) : is_extraction φ ↔ ∀n, φ n < φ (n + 1) :=
begin
  split,
  {
    intros h n,
    exact h n (n + 1) (lt_add_one n),
  },
  {
    intro h,
    have almost : ∀ (n d : ℕ), φ n < φ (n + d + 1),
    {
      intros n d,
      induction d with d hd,
      {
        simp,
        exact h n,
      },
      {
        specialize h (n + d + 1),
        rw ← nat.add_one,
        have : n + (d + 1) + 1 = n + d + 1 + 1 := by ring,
        rw this,
        linarith,
      },
    },

    intros n m hnm,
    have hd : ∃(d : ℕ), m = n + d + 1 := nat.exists_eq_add_of_lt hnm,
    cases hd with d hd,
    rw hd,
    exact almost n d,
  },
end
lemma extraction_geq_id (φ: ℕ → ℕ) (hφ : is_extraction φ) : ∀n:ℕ, n ≤ φ n :=
begin
  intro n,
  induction n with d hd,
  exact zero_le (φ 0),

  have temp1 := hφ d d.succ (lt_add_one d),
  have temp2 : d < φ d.succ := gt_of_gt_of_ge temp1 hd,
  exact nat.succ_le_iff.mpr temp2,
end

def is_subseq (y x : ℕ → ℝ) : Prop := ∃(φ: ℕ → ℕ) (hφ : is_extraction φ), y = x ∘ φ

theorem monotone_convergence_increasing {x : ℕ → ℝ}
 (hx_increases : is_increasing_seq x)
(hx_bounded_above : is_bounded_above_seq x) : seq_converges mR x :=
begin
  let xSet := {z : ℝ | ∃n:ℕ, x n = z},
  have xSet_nonempty : xSet.nonempty,
  {
    use x 0,
    use 0,
  },

  have xSet_bounded_above : bdd_above xSet,
  {
    cases hx_bounded_above with M hM,
    use M,
    intros a ha,
    cases ha with n hn,
    rw ← hn,
    exact hM n,
  },

  cases (real.exists_is_lub xSet xSet_nonempty xSet_bounded_above) with s hs,

  use s,
  intros ε hε,

  have : ∃(a : ℝ)(ha : a ∈ xSet), a > s-ε,
  {
    by_contradiction,
    push_neg at h,
    have contr : (s-ε) ∈ upper_bounds xSet := h,
    have : s ≤ s-ε := (is_lub_le_iff hs).mpr contr,
    have t : s-ε < s := by linarith,
    linarith,
  },

  cases this with a ha,
  cases ha with ha has,
  cases ha with N hN,
  rw ← hN at has,clear hN a,rename has hN,

  use N,
  intros n hn,

  have calc1 : x n ≤ s,
  {
    have : x n ∈ xSet := by use n,
    exact hs.left this,
  },

  have half_1 := calc x n ≤ s: calc1
  ... < s + ε : by linarith,

  have half_2 := calc s-ε < x N : hN
  ... ≤ x n : hx_increases N n hn,

  have t1 : x n - s < ε  := by linarith,
  have t2 : -ε < x n - s := by linarith,
  simp,
  have almost : -ε < x n - s ∧ x n - s < ε := ⟨t2, t1⟩,
  exact abs_lt.mpr almost,
end

theorem monotone_convergence_decreasing {x : ℕ → ℝ}
 (hx_decreases : is_decreasing_seq x)
(hx_bounded_below : is_bounded_below_seq x) : seq_converges mR x :=
begin
  have hnew_seq_increasing : is_increasing_seq (λn, (-1) * (x n)),
  {
    intros n m hnm,
    have := hx_decreases n m hnm,
    finish,
  },
  have hnew_seq_bdd_above  : is_bounded_above_seq (λn, (-1) * (x n)),
  {
    cases hx_bounded_below with M hM,
    use (-1) * M,
    intro n,
    unfold is_lower_bound_for_seq at hM,
    finish,
  },
  have hnew_seq_converges  := monotone_convergence_increasing
   hnew_seq_increasing hnew_seq_bdd_above,

  cases hnew_seq_converges with L hL,
  have almost := lim_of_mult_const_seq hL (-1),
  use (-L),
  intros ε hε,
  specialize almost ε hε,
  cases almost with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  finish,
end

theorem monotone_convergence {x : ℕ → ℝ} :
is_bounded_seq x → is_monotone_seq x → seq_converges mR x :=
begin
	intros hx_bdd hx_mono,
	cases hx_mono,
	{exact monotone_convergence_increasing hx_mono hx_bdd.1},
	{exact monotone_convergence_decreasing hx_mono hx_bdd.2},
end

lemma bounded_iff (f : ℕ → ℝ) : is_bounded_seq f ↔ ∃ M : ℝ, ∀n : ℕ, |f n| ≤ M :=
begin
	split,
	{
		intro h,
		unfold is_bounded_seq is_bounded_above_seq is_bounded_below_seq at h,
		rcases h with ⟨⟨M1, hM1⟩, ⟨M2, hM2⟩⟩,
		use max M1 (-M2),
		intro n,
		specialize hM1 n,
		specialize hM2 n,
		rw abs_le,
		split,
		{
			suffices : max M1 (-M2) ≥ - f n, exact neg_le.mp this,
			exact le_max_of_le_right (neg_le_neg hM2),
		},
		{exact le_max_of_le_left hM1}
	},
	{
		intro h,
		cases h with M hM,
		split,
		{
			use M,
			intros n,
			exact le_of_abs_le (hM n),
		},
		{
			use -M,
			intros n,
			exact neg_le_of_abs_le (hM n),
		},
	},
end

lemma fin_is_bounded (f : ℕ → ℝ) (N : ℕ) : ∃M : ℝ, ∀n ≤ N, |f n| ≤ M :=
begin
	induction N with N hN,
	{
		use |f 0|,
		intros n hn,
		rw nat.le_zero_iff.mp hn,
	},
	{
		rcases hN with ⟨M, hM⟩,
		use max (|f N.succ|) M,
		intros n hn,
		cases lt_or_eq_of_le hn,
		{
			rw nat.lt_succ_iff at h,
			have := hM n h,
			exact le_max_of_le_right (hM n h),
		},

		rw← h,
		exact le_max_left (|f n|) M,
	}
end

lemma cauchy_seq_of_reals_is_bounded (f : ℕ → ℝ) (hx : is_cauchy mR f) :
is_bounded_seq f :=
begin
  specialize hx 1 zero_lt_one,
  cases hx with N hN,
	rcases fin_is_bounded f N with ⟨M, hM⟩,
	rw bounded_iff f,
	use max M (|f N| + 1),
	intros n,
	by_cases hn : n ≤ N,
	{
		exact le_max_of_le_left (hM n hn),
	},
	{
		have := hN N n (rfl.ge) (le_of_not_ge hn),
		simp at this,
		have almost : |f n| - |f N| ≤ 1,
		calc |f n| - |f N| ≤ |f n - f N| : abs_sub_abs_le_abs_sub (f n) (f N)
		... = |f N - f n| : abs_sub_comm (f n) (f N)
		... ≤  1 : le_of_lt this,
		exact le_max_of_le_right (by linarith),
	}
end

def is_peak_term (n : ℕ) (x : ℕ → ℝ) : Prop := ∀(m : ℕ)(hm: m ≥ n), x m ≤ x n

noncomputable def peak_func {f : ℕ → ℝ}
(h : ∀(n : ℕ), ∃(m : ℕ)(hmn : m > n),(is_peak_term m f)) : ℕ → ℕ
| 0 := classical.some (h 0)
| (b+1) := classical.some (h (peak_func b))

lemma peak_func_is_extraction {f : ℕ → ℝ}
(h : ∀(n : ℕ), ∃(m : ℕ)(hmn : m > n),(is_peak_term m f)):
 is_extraction (peak_func h) :=
 begin
	unfold is_extraction,
	intros n m hnm,
	induction m with d hd generalizing n,
	{
		exfalso,
		exact nat.not_lt_zero n hnm,
	},
	{
		rw nat.succ_eq_add_one,
		have hdsucc : peak_func h d < peak_func h (d+1),
		{
			cases classical.some_spec (h (peak_func h d)) with h1 h2,
			unfold peak_func,
			finish,
		},
		rw nat.lt_succ_iff at hnm,
		rw le_iff_lt_or_eq at hnm,
		cases hnm,
		{
			exact lt_trans (hd n hnm) hdsucc,
		},
		{
			rw hnm,
			exact hdsucc,
		},
	},
end

 lemma peak_func_is_peaks {x : ℕ → ℝ}
(h : ∀(n : ℕ), ∃(m : ℕ)(hmn : m > n),(is_peak_term m x)) :
∀(n : ℕ), is_peak_term (peak_func h n) x :=
begin
	intros n,
	cases n,
	{
		unfold peak_func,
		cases classical.some_spec (h 0) with h1 h2,
		exact h2,
	},
	{
		cases classical.some_spec (h (peak_func h n)) with h1 h2,
		unfold peak_func,
		finish,
	}
end

noncomputable def peak_func2 {f : ℕ → ℝ} {N : ℕ}
(h : ∀(m : ℕ), (∃ (l : ℕ), m > N → l > m ∧ f m < f l)) : ℕ → ℕ
| 0 := classical.some (h (N+1))
| (b+1) := classical.some (h (peak_func2 b))

lemma peak_func2_gt_N {f : ℕ → ℝ} {N : ℕ}
(h : ∀(m : ℕ), (∃ (l : ℕ), m > N → l > m ∧ f m < f l)) : ∀n, peak_func2 h n > N :=
begin
intro n,
induction n with d hd,
{
	have obv0 : peak_func2 h 0 = classical.some (h (N+1)) := rfl,
	have h0 := classical.some_spec (h (N+1)) (lt_add_one N),
	rw obv0,
	linarith,
},
{
		have obv1 : peak_func2 h (d.succ) = classical.some (h (peak_func2 h d)),
		unfold peak_func2,
		finish,

	have h1 := classical.some_spec (h (peak_func2 h d)) hd,
	rw← obv1 at h1,
	linarith,
}
end

lemma peak_func2_is_extraction {f : ℕ → ℝ} {N : ℕ}
(h : ∀(m : ℕ), (∃ (l : ℕ), m > N → l > m ∧ f m < f l)) :
is_extraction (peak_func2 h) :=
begin
	rw extraction_iff,
	intros n,
	induction n with d hd,
	{
		simp,
		have obv0 : peak_func2 h 0 = classical.some (h (N+1)) := rfl,
		change classical.some (h (N+1)) < classical.some (h (peak_func2 h 0)),
		have h0 := classical.some_spec (h (N+1)) (lt_add_one N),
		have h1 := classical.some_spec (h (peak_func2 h 0)),
		rw obv0 at h1,
		specialize h1 (by linarith),
		exact h1.1,
	},
	{
		have obv : peak_func2 h (d.succ + 1) = classical.some (h (peak_func2 h d.succ)) := rfl,
		have h1 := classical.some_spec (h (peak_func2 h d.succ))
		 (peak_func2_gt_N h d.succ),
		rw← obv at h1,
		exact h1.1,
	}
end

 lemma peak_func2_is_increasing {f : ℕ → ℝ} {N : ℕ}
 (h : ∀(m : ℕ), (∃ (l : ℕ), m > N → l > m ∧ f m < f l)) : is_increasing_seq
  (f ∘ (peak_func2 h)) :=
 begin
	intros n m hnm,
	induction m with d hd generalizing n,
	{rw nat.le_zero_iff.mp hnm},
	{
		rw le_iff_lt_or_eq at hnm,
		cases hnm,
		{
			rw nat.lt_succ_iff at hnm,
			have : (f ∘ (peak_func2 h)) d ≤ (f ∘ (peak_func2 h)) d.succ,
			{
				have h1 := classical.some_spec (h (peak_func2 h d)) (peak_func2_gt_N h d),
				simp at *,
				have obv : peak_func2 h d.succ = classical.some (h (peak_func2 h d)),
				{
					unfold peak_func2,
					finish,
				},
				rw← obv at h1,
				exact le_of_lt h1.2,
			},
			specialize hd n hnm,
			exact le_trans hd this,
		},
		{rw hnm}
	}
 end

lemma seq_has_monotone_subseq (x : ℕ → ℝ) : ∃(y : ℕ → ℝ) (hy : is_subseq y x),
is_monotone_seq y :=
begin
  by_cases ∀(n : ℕ), ∃(m : ℕ)(hmn : m > n),(is_peak_term m x),
  {
    let φ := peak_func h,
    use x ∘ φ,
    split,
    {
      use φ,
      exact ⟨peak_func_is_extraction h, rfl⟩,
    },
    {
      right,
      intros n m hnm,
      by_cases h1 : m = n,
      rw h1, exact rfl.ge,
      have := peak_func_is_extraction h n m ((ne.symm h1).le_iff_lt.mp hnm),
      exact peak_func_is_peaks h n (φ m) (le_of_lt this),
    },
  },
  {
    unfold is_peak_term at h,
    push_neg at h,
		cases h with N hN,
		have h : ∀(m : ℕ), (∃ (l : ℕ), m > N → l > m ∧ x m < x l),
		{
			intros m,
			by_cases hm : m > N,
			{
				cases hN m hm with l hl,
				rw ge_iff_le at hl,
				rw le_iff_lt_or_eq at hl, cases hl.1,

				use l,
				intro gbg,
				exact ⟨h, hl.2⟩,

				exfalso,
				rw h at hl,
				linarith,
			},
			{
				use 0,
			},
		},

		use x ∘ (peak_func2 h),
		split,
		{
			use peak_func2 h,
			exact ⟨peak_func2_is_extraction h, rfl⟩,
		},
		{
			exact or.inl (peak_func2_is_increasing h),
		},
  }
end

lemma bdd_of_subseq_of_bdd {x: ℕ → ℝ} (hx : is_bounded_seq x) {y : ℕ → ℝ}
(hy : is_subseq y x) : is_bounded_seq y :=
begin
  split,
  {
    cases hx.left with M hM,
    use M,
    intros n,
    rcases hy with ⟨φ, hφ, hyx⟩,
    rw hyx,
    exact hM (φ n),
  },
  {
    cases hx.right with M hM,
    use M,
    intros n,
    rcases hy with ⟨φ, hφ, hyx⟩,
    rw hyx,
    exact hM (φ n),
  },
end

theorem bolzano_weierstrass {x: ℕ → ℝ} (hx : is_bounded_seq x) :
 ∃(y : ℕ → ℝ) (hy : is_subseq y x), seq_converges mR y :=
begin
	 rcases seq_has_monotone_subseq x with ⟨y, ⟨hy_subseq, hy_monotone⟩⟩,
   have hy_bounded := bdd_of_subseq_of_bdd hx hy_subseq,

   use y,
	 exact ⟨hy_subseq, monotone_convergence hy_bounded hy_monotone⟩,
end

theorem reals_are_complete : is_complete mR :=
begin
  intros x hx,
  have subseq_converges :=
  bolzano_weierstrass (cauchy_seq_of_reals_is_bounded x hx),

  rcases subseq_converges with ⟨y, hy_subseq, y_lim, hy_lim⟩,
  use y_lim,

  intros ε hε,
  cases hx (ε/2) (by linarith) with N₁ hN₁,
  use N₁,
  intros n hn,

  cases hy_lim (ε/2) (by linarith) with N₂ hN₂,
  let N := max N₁ N₂,

  have calc1 : dist_real (y N) y_lim < ε/2,
  {
    exact hN₂ N (le_max_right N₁ N₂),
  },

  have calc2: dist_real (x n) (y N) < ε/2,
  {
    cases hy_subseq with φ hφ,
    cases hφ with hφ hyxφ,
    have hφN : φ N ≥ N₁,
    {
      have := extraction_geq_id φ hφ N,
      exact le_of_max_le_left this,
    },
    have : y N = x (φ N) := (congr_fun hyxφ N).trans rfl,
    rw this,
    exact hN₁ n (φ N) hn hφN,
  },

  calc dist_real (x n) y_lim ≤ dist_real (x n) (y N) + dist_real (y N) y_lim :
  mR.triangle (x n) y_lim (y N)
  ... < ε : by linarith,
end

def seq_diff (x y : ℕ → X) := λ n : ℕ, mX.d (x n) (y n)

lemma cauchy_lim_of_dist {x y : ℕ → X} (hx : is_cauchy mX x)
 (hy : is_cauchy mX y) : seq_converges mR (seq_diff mX x y) :=
 begin
  apply reals_are_complete,
  intros ε hε,
  cases hx (ε/2) (by linarith) with N₁ hN₁,
  cases hy (ε/2) (by linarith) with N₂ hN₂,
  let N := max N₁ N₂,
  use N,
  intros n m hn hm,

  specialize hN₁ n m (le_of_max_le_left hn) (le_of_max_le_left hm),
  specialize hN₂ n m (le_of_max_le_right hn) (le_of_max_le_right hm),

  have calc1 := mR.triangle (mX.d (x n) (y n)) (mX.d (x m) (y m)) (mX.d (x m) (y n)),
  have calc2 := mR_dist_of_dist mX (y n) (x m) (x n),
  rw mR.symm at calc2,
  rw mX.symm (y n) (x m) at calc2,
  rw mX.symm (y n) (x n) at calc2,

  have calc3 := mR_dist_of_dist mX (x m) (y m) (y n),
  rw mR.symm at calc3,

  calc mR.d (mX.d (x n) (y n)) (mX.d (x m) (y m)) ≤
  mR.d (mX.d (x n) (y n)) (mX.d (x m) (y n)) + mR.d (mX.d (x m) (y n)) (mX.d (x m) (y m)):
    calc1
   ... < ε : by linarith,
end

lemma seq_equiv_is_equiv : is_equiv (ℕ → X) (seq_equiv mX) :=
{
  refl := begin
    intros a ε hε,
    use 0,
    intros n hn,
    simp,
    exact hε,
  end,
  symm := begin
    intros a b hab,
    intros ε hε,
    cases hab ε hε with N hN,
    use N,
    intros n hn,
    rw mX.symm,
    exact hN n hn,
  end,
  trans := begin
    intros a b c hab hbc ε hε,

    specialize hab (ε/2) (half_pos hε),
    specialize hbc (ε/2) (half_pos hε),

    cases hab with N₁ hN₁,
    cases hbc with N₂ hN₂,
    use max N₁ N₂,

    intros n hn,

    specialize hN₁ n (le_of_max_le_left hn),
    specialize hN₂ n (le_of_max_le_right hn),

    calc mX.d (a n) (c n) ≤ mX.d (a n) (b n) + mX.d (b n) (c n) : mX.triangle (a n) (c n) (b n)
    ... < ε : by linarith,
  end
}

inductive cauchy_seqs
| cauchy_seq (seq : ℕ → X) : is_cauchy mX seq → cauchy_seqs

def cauchy_seqs.seq : cauchy_seqs mX → (ℕ → X)
| (cauchy_seqs.cauchy_seq x hx) := x

def cauchy_seqs.cauchy (seq : cauchy_seqs mX) : is_cauchy mX (cauchy_seqs.seq mX seq)
:= begin
	cases seq with seq hseq,
	unfold cauchy_seqs.seq,
	exact hseq,
end

def cauchy_seqs.r : cauchy_seqs mX → cauchy_seqs mX → Prop
| (cauchy_seqs.cauchy_seq x h1) (cauchy_seqs.cauchy_seq y h2) :=
seq_equiv mX x y

theorem cauchy_seqs_is_equiv : is_equiv
(cauchy_seqs mX) (cauchy_seqs.r mX) :=
{
	refl :=
	begin
		intro a,
		cases a with a ha,
		have := (seq_equiv_is_equiv mX).refl,
		exact this a,
	end,
	symm :=
	begin
		intros a b hab,
		cases a with a ha,
		cases b with b hb,
		unfold cauchy_seqs.r at *,
		have := (seq_equiv_is_equiv mX).symm,
		exact this a b hab,
	end,
	trans :=
	begin
		intros a b c hab hbc,
		cases a with a ha,
		cases b with b hb,
		cases c with c hc,
		unfold cauchy_seqs.r at *,
		have := (seq_equiv_is_equiv mX).trans,
		exact this a b c hab hbc,
	end,
}

lemma cauchy_seqs_equivalence : equivalence (cauchy_seqs.r mX) :=
begin
	fconstructor,
	exact (cauchy_seqs_is_equiv mX).refl,
	fconstructor,
	exact (cauchy_seqs_is_equiv mX).symm,
	exact (cauchy_seqs_is_equiv mX).trans,
end

instance cauchy_seqs.setoid : setoid (cauchy_seqs mX) :=
@setoid.mk (cauchy_seqs mX) (cauchy_seqs.r mX)
(cauchy_seqs_equivalence mX)

def cauchy_completion := quotient (cauchy_seqs.setoid mX)

open_locale classical

def seq_to_lim (f : ℕ → X) : X :=
if hf : seq_converges mX f then classical.some hf
else f 0

lemma seq_to_lim_is_lim {f : ℕ → X} (hf : seq_converges mX f) :
seq_lim mX f (seq_to_lim mX f) :=
begin
	have : (seq_to_lim mX f) = classical.some hf := dif_pos hf,
	rw this,
	exact classical.some_spec hf,
end

lemma seq_to_lim_sound {f : ℕ → X} {L : X} (hfL : seq_lim mX f L) :
seq_to_lim mX f = L := lim_unique mX (seq_to_lim_is_lim mX ⟨L, hfL⟩) hfL

lemma eq_lim_func_of_equiv_seqs {f g : ℕ → X} (hfg : seq_equiv mX f g)
(hf : seq_converges mX f) :
seq_to_lim mX f = seq_to_lim mX g :=
begin
	have hg_lim := (eq_lim_of_equiv_seqs mX hfg (seq_to_lim_is_lim mX hf)),
	exact lim_unique mX hg_lim (seq_to_lim_is_lim mX ⟨seq_to_lim mX f, hg_lim⟩),
end

lemma lim_nonneg_of_seq_nonneg {x : ℕ → ℝ} {L : ℝ}
(hx : ∀n, 0 ≤ x n) (hxL : seq_lim mR x L)  : 0 ≤ L :=
begin
	by_cases hL : L < 0, swap, exact not_lt.mp hL, exfalso,
	rw← neg_pos at hL,
	specialize hxL (-L) hL,
	cases hxL with N hN,
	specialize hN N (rfl.ge),
	simp at hN,
	rw abs_lt at hN,
	have : x N < 0 := by linarith,
	specialize hx N,
	linarith,
end

lemma le_lim_of_le_seq {x y : ℕ → ℝ} {L M : ℝ} (hxL : seq_lim mR x L) (hyM : seq_lim mR y M)
 (hxy : ∀n, x n ≤ y n) : L ≤ M :=
begin
	suffices h : 0 ≤ M - L, exact sub_nonneg.mp h,
	have hxy' : ∀n, (0 : ℝ) ≤ ((λ n, y n - x n) n) := by finish,
	exact lim_nonneg_of_seq_nonneg hxy' (sub_of_lims_is_lim_of_sub hyM hxL),
end

def comp_dist : cauchy_seqs mX → cauchy_seqs mX → ℝ :=
λx y, seq_to_lim mR
(seq_diff mX (cauchy_seqs.seq mX x) (cauchy_seqs.seq mX y))

lemma comp_dist.symm : ∀ x y, comp_dist mX x y = comp_dist mX y x :=
begin
	intros x y,
	unfold comp_dist,
	apply congr_arg,
	ext,
	exact mX.symm (cauchy_seqs.seq mX x x_1) (cauchy_seqs.seq mX y x_1)
end

lemma comp_dist_converges (x y : cauchy_seqs mX) :
seq_converges mR (seq_diff mX (cauchy_seqs.seq mX x) (cauchy_seqs.seq mX y)) :=
cauchy_lim_of_dist mX (cauchy_seqs.cauchy mX x) (cauchy_seqs.cauchy mX y)

lemma comp_dist_respects_equiv:
∀ (x y a b : cauchy_seqs mX),
    x ≈ a → y ≈ b → comp_dist mX x y = comp_dist mX a b :=
begin
	intros x y a b hxa hyb,

	cases x with x hx,
	cases y with y hy,
	cases a with a ha,
	cases b with b hb,

	suffices hequiv : seq_equiv mR (seq_diff mX x y) (seq_diff mX a b),
	{exact eq_lim_func_of_equiv_seqs mR hequiv (cauchy_lim_of_dist mX hx hy)},

	intros ε hε,

	cases hxa (ε/2) (half_pos hε) with N₁ hN₁,
	cases hyb (ε/2) (half_pos hε) with N₂ hN₂,
	use max N₁ N₂,
	intros n hn,

	specialize hN₁ n (le_of_max_le_left hn),
	specialize hN₂ n (le_of_max_le_right hn),

	unfold seq_diff,

	have h1 := lt_of_le_of_lt (mR_dist_of_dist mX (y n) (a n) (x n)) hN₁,
	have h2 := lt_of_le_of_lt (mR_dist_of_dist mX (a n) (b n) (y n)) hN₂,

	have h : mR.d (mX.d (y n) (a n)) (mX.d (y n) (x n)) +
	mR.d (mX.d (a n) (b n)) (mX.d (a n) (y n)) < ε := by linarith, clear h1 h2,

	rw mX.symm (y n) (a n) at h,
	rw mR.symm (mX.d (a n) (b n)) (mX.d (a n) (y n)) at h,
	rw mX.symm (y n) (x n) at h,
	rw mR.symm (mX.d (a n) (y n)) (mX.d (x n) (y n)) at h,

	exact gt_of_gt_of_ge h
	(mR.triangle (mX.d (x n) (y n)) (mX.d (a n) (b n)) (mX.d (a n) (y n))),
end

def comp_dist_lift :=
quotient.lift₂ (comp_dist mX) (comp_dist_respects_equiv mX)

def metric_comp : metric_space (cauchy_completion mX) :=
{
	d := comp_dist_lift mX,
	refl :=
	begin
		intros x y,
		split,
		{
			intro h,
			cases quotient.exists_rep x with a ha,
			cases quotient.exists_rep y with b hb,

			rw← ha at *,
			rw← hb at *,

			apply quotient.sound,
			have obv : comp_dist_lift mX ⟦a⟧ ⟦b⟧ = comp_dist mX a b := rfl,
			rw obv at h,
			unfold comp_dist at h,

			cases a with a ha_cauchy,
			cases b with b hb_cauchy,

			have := seq_to_lim_is_lim mR (cauchy_lim_of_dist mX ha_cauchy hb_cauchy),
			unfold cauchy_seqs.seq at h,
			rw h at this,
			have abequiv : seq_equiv2 mX a b := this,
			rw← seq_equiv_defs at abequiv,
			exact abequiv,
		},
		{
			intro h,

			cases quotient.exists_rep x with a ha,
			cases quotient.exists_rep y with b hb,

			rw← ha at *,
			rw← hb at *,

			change comp_dist mX a b = 0,
			unfold comp_dist cauchy_seqs.seq,

			cases a with a ha_cauchy,
			cases b with b hb_cauchy,

			suffices hequiv :
			seq_lim mR (seq_diff mX a b) 0,
			{
				unfold cauchy_seqs.seq at *,
				have := seq_to_lim_is_lim mR (cauchy_lim_of_dist mX ha_cauchy hb_cauchy),
				exact lim_unique mR this hequiv,
			},

			have obv : cauchy_seqs.r mX
			 (cauchy_seqs.cauchy_seq a ha_cauchy) (cauchy_seqs.cauchy_seq b hb_cauchy) :=
			quotient.exact h,

			unfold cauchy_seqs.r at obv,
			rw seq_equiv_defs at obv,
			exact obv,
		},
	end,

	symm :=
	begin
		intros x y,
		cases quotient.exists_rep x with a ha,
		cases quotient.exists_rep y with b hb,

		rw← ha at *,
		rw← hb at *,

		exact comp_dist.symm mX a b,
	end,
	triangle :=
	begin
		intros x y z,

		cases quotient.exists_rep x with a ha,
		cases quotient.exists_rep y with b hb,
		cases quotient.exists_rep z with c hc,

		rw← ha at *,
		rw← hb at *,
		rw← hc at *,

		clear ha hb hc,

		change comp_dist mX a b ≤ comp_dist mX a c + comp_dist mX c b,

		cases a with a ha,
		cases b with b hb,
		cases c with c hc,

		unfold comp_dist cauchy_seqs.seq,
		sorry,
	end
}