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

import linear_algebra.dimension
import ring_theory.principal_ideal_domain
import ring_theory.finiteness

/-! # Free modules over PID

A free `R`-module `M` is a module with a basis over `R`,
equivalently it is an `R`-module linearly equivalent to `ι →₀ R` for some `ι`.

This file proves a submodule of a free `R`-module of finite rank is also
a free `R`-module of finite rank, if `R` is a principal ideal domain (PID),
i.e. we have instances `[is_domain R] [is_principal_ideal_ring R]`.
We express "free `R`-module of finite rank" as a module `M` which has a basis
`b : ι → R`, where `ι` is a `fintype`.
We call the cardinality of `ι` the rank of `M` in this file;
it would be equal to `finrank R M` if `R` is a field and `M` is a vector space.

## Main results

In this section, `M` is a free and finitely generated `R`-module, and
`N` is a submodule of `M`.

 - `submodule.induction_on_rank`: if `P` holds for `⊥ : submodule R M` and if
  `P N` follows from `P N'` for all `N'` that are of lower rank, then `P` holds
   on all submodules

 - `submodule.exists_basis_of_pid`: if `R` is a PID, then `N : submodule R M` is
   free and finitely generated. This is the first part of the structure theorem
   for modules.

- `submodule.smith_normal_form`: if `R` is a PID, then `M` has a basis
  `bM` and `N` has a basis `bN` such that `bN i = a i • bM i`.
  Equivalently, a linear map `f : M →ₗ M` with `range f = N` can be written as
  a matrix in Smith normal form, a diagonal matrix with the coefficients `a i`
  along the diagonal.

## Tags

free module, finitely generated module, rank, structure theorem

-/

open_locale big_operators

universes u v

section ring

variables {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M]
variables {ι : Type*} (b : basis ι R M)

open submodule.is_principal submodule

lemma eq_bot_of_generator_maximal_map_eq_zero (b : basis ι R M) {N : submodule R M}
  {ϕ : M →ₗ[R] R} (hϕ : ∀ (ψ : M →ₗ[R] R), N.map ϕ ≤ N.map ψ → N.map ψ = N.map ϕ)
  [(N.map ϕ).is_principal] (hgen : generator (N.map ϕ) = 0) : N = ⊥ :=
begin
  rw submodule.eq_bot_iff,
  intros x hx,
  refine b.ext_elem (λ i, _),
  rw (eq_bot_iff_generator_eq_zero _).mpr hgen at hϕ,
  rw [linear_equiv.map_zero, finsupp.zero_apply],
  exact (submodule.eq_bot_iff _).mp (hϕ ((finsupp.lapply i) ∘ₗ ↑b.repr) bot_le) _ ⟨x, hx, rfl⟩
end

lemma eq_bot_of_generator_maximal_submodule_image_eq_zero {N O : submodule R M} (b : basis ι R O)
  (hNO : N ≤ O)
  {ϕ : O →ₗ[R] R} (hϕ : ∀ (ψ : O →ₗ[R] R), ϕ.submodule_image N ≤ ψ.submodule_image N →
    ψ.submodule_image N = ϕ.submodule_image N)
  [(ϕ.submodule_image N).is_principal] (hgen : generator (ϕ.submodule_image N) = 0) :
  N = ⊥ :=
begin
  rw submodule.eq_bot_iff,
  intros x hx,
  refine congr_arg coe (show (⟨x, hNO hx⟩ : O) = 0, from b.ext_elem (λ i, _)),
  rw (eq_bot_iff_generator_eq_zero _).mpr hgen at hϕ,
  rw [linear_equiv.map_zero, finsupp.zero_apply],
  refine (submodule.eq_bot_iff _).mp (hϕ ((finsupp.lapply i) ∘ₗ ↑b.repr) bot_le) _ _,
  exact (linear_map.mem_submodule_image_of_le hNO).mpr ⟨x, hx, rfl⟩
end

end ring

section is_domain

variables {ι : Type*} {R : Type*} [comm_ring R] [is_domain R]
variables {M : Type*} [add_comm_group M] [module R M] {b : ι → M}

open submodule.is_principal set submodule

lemma dvd_generator_iff {I : ideal R} [I.is_principal] {x : R} (hx : x ∈ I) :
  x ∣ generator I ↔ I = ideal.span {x} :=
begin
  conv_rhs { rw [← span_singleton_generator I] },
  erw [ideal.span_singleton_eq_span_singleton, ← dvd_dvd_iff_associated, ← mem_iff_generator_dvd],
  exact ⟨λ h, ⟨hx, h⟩, λ h, h.2⟩
end

end is_domain

section principal_ideal_domain

open submodule.is_principal set submodule

variables {ι : Type*} {R : Type*} [comm_ring R] [is_domain R] [is_principal_ideal_ring R]
variables {M : Type*} [add_comm_group M] [module R M] {b : ι → M}

open submodule.is_principal

lemma generator_maximal_submodule_image_dvd {N O : submodule R M} (hNO : N ≤ O)
  {ϕ : O →ₗ[R] R} (hϕ : ∀ (ψ : O →ₗ[R] R), ϕ.submodule_image N ≤ ψ.submodule_image N →
    ψ.submodule_image N = ϕ.submodule_image N)
  [(ϕ.submodule_image N).is_principal]
  (y : M) (yN : y ∈ N) (ϕy_eq : ϕ ⟨y, hNO yN⟩ = generator (ϕ.submodule_image N))
  (ψ : O →ₗ[R] R) : generator (ϕ.submodule_image N) ∣ ψ ⟨y, hNO yN⟩ :=
begin
  let a : R := generator (ϕ.submodule_image N),
  let d : R := is_principal.generator (submodule.span R {a, ψ ⟨y, hNO yN⟩}),
  have d_dvd_left : d ∣ a := (mem_iff_generator_dvd _).mp
    (subset_span (mem_insert _ _)),
  have d_dvd_right : d ∣ ψ ⟨y, hNO yN⟩ := (mem_iff_generator_dvd _).mp
    (subset_span (mem_insert_of_mem _ (mem_singleton _))),
  refine dvd_trans _ d_dvd_right,
  rw [dvd_generator_iff, ideal.span,
      ← span_singleton_generator (submodule.span R {a, ψ ⟨y, hNO yN⟩})],
  obtain ⟨r₁, r₂, d_eq⟩ : ∃ r₁ r₂ : R, d = r₁ * a + r₂ * ψ ⟨y, hNO yN⟩,
  { obtain ⟨r₁, r₂', hr₂', hr₁⟩ := mem_span_insert.mp (is_principal.generator_mem
      (submodule.span R {a, ψ ⟨y, hNO yN⟩})),
    obtain ⟨r₂, rfl⟩ := mem_span_singleton.mp hr₂',
    exact ⟨r₁, r₂, hr₁⟩ },
  let ψ' : O →ₗ[R] R := r₁ • ϕ + r₂ • ψ,
  have : span R {d} ≤ ψ'.submodule_image N,
  { rw [span_le, singleton_subset_iff, set_like.mem_coe, linear_map.mem_submodule_image_of_le hNO],
    refine ⟨y, yN, _⟩,
    change r₁ * ϕ ⟨y, hNO yN⟩ + r₂ * ψ ⟨y, hNO yN⟩ = d,
    rw [d_eq, ϕy_eq] },
  refine le_antisymm (this.trans (le_of_eq _))
    (ideal.span_singleton_le_span_singleton.mpr d_dvd_left),
  rw span_singleton_generator,
  refine hϕ ψ' (le_trans _ this),
  rw [← span_singleton_generator (ϕ.submodule_image N)],
  exact ideal.span_singleton_le_span_singleton.mpr d_dvd_left,
  { exact subset_span (mem_insert _ _) }
end

/-- The induction hypothesis of `submodule.basis_of_pid` and `submodule.smith_normal_form`.

Basically, it says: let `N ≤ M` be a pair of submodules, then we can find a pair of
submodules `N' ≤ M'` of strictly smaller rank, whose basis we can extend to get a basis
of `N` and `M`. Moreover, if the basis for `M'` is up to scalars a basis for `N'`,
then the basis we find for `M` is up to scalars a basis for `N`.

For `basis_of_pid` we only need the first half and can fix `M = ⊤`,
for `smith_normal_form` we need the full statement,
but must also feed in a basis for `M` using `basis_of_pid` to keep the induction going.
-/
lemma submodule.basis_of_pid_aux [fintype ι] {O : Type*} [add_comm_group O] [module R O]
  (M N : submodule R O) (b'M : basis ι R M) (N_bot : N ≠ ⊥) (N_le_M : N ≤ M) :
  ∃ (y ∈ M) (a : R) (hay : a • y ∈ N) (M' ≤ M) (N' ≤ N) (N'_le_M' : N' ≤ M')
    (y_ortho_M' : ∀ (c : R) (z : O), z ∈ M' → c • y + z = 0 → c = 0)
    (ay_ortho_N' : ∀ (c : R) (z : O), z ∈ N' → c • a • y + z = 0 → c = 0),
  ∀ (n') (bN' : basis (fin n') R N'), ∃ (bN : basis (fin (n' + 1)) R N),
  ∀ (m') (hn'm' : n' ≤ m') (bM' : basis (fin m') R M'),
  ∃ (hnm : (n' + 1) ≤ (m' + 1)) (bM : basis (fin (m' + 1)) R M),
  ∀ (as : fin n' → R) (h : ∀ (i : fin n'), (bN' i : O) = as i • (bM' (fin.cast_le hn'm' i) : O)),
  ∃ (as' : fin (n' + 1) → R),
  ∀ (i : fin (n' + 1)), (bN i : O) = as' i • (bM (fin.cast_le hnm i) : O) :=
begin
  -- Let `ϕ` be a maximal projection of `M` onto `R`, in the sense that there is
  -- no `ψ` whose image of `N` is larger than `ϕ`'s image of `N`.
  have : ∃ ϕ : M →ₗ[R] R, ∀ (ψ : M →ₗ[R] R),
    ϕ.submodule_image N ≤ ψ.submodule_image N → ψ.submodule_image N = ϕ.submodule_image N,
  { obtain ⟨P, P_eq, P_max⟩ := set_has_maximal_iff_noetherian.mpr
        (infer_instance : is_noetherian R R) _
        (show (set.range (λ ψ : M →ₗ[R] R, ψ.submodule_image N)).nonempty,
         from ⟨_, set.mem_range.mpr ⟨0, rfl⟩⟩),
    obtain ⟨ϕ, rfl⟩ := set.mem_range.mp P_eq,
    exact ⟨ϕ, λ ψ hψ, P_max _ ⟨_, rfl⟩ hψ⟩ },
  let ϕ := this.some,
  have ϕ_max := this.some_spec,
  -- Since `ϕ(N)` is a `R`-submodule of the PID `R`,
  -- it is principal and generated by some `a`.
  let a := generator (ϕ.submodule_image N),
  have a_mem : a ∈ ϕ.submodule_image N := generator_mem _,

  -- If `a` is zero, then the submodule is trivial. So let's assume `a ≠ 0`, `N ≠ ⊥`.
  by_cases a_zero : a = 0,
  { have := eq_bot_of_generator_maximal_submodule_image_eq_zero b'M N_le_M ϕ_max a_zero,
    contradiction },

  -- We claim that `ϕ⁻¹ a = y` can be taken as basis element of `N`.
  obtain ⟨y, yN, ϕy_eq⟩ := (linear_map.mem_submodule_image_of_le N_le_M).mp a_mem,
  have ϕy_ne_zero : ϕ ⟨y, N_le_M yN⟩ ≠ 0 := λ h, a_zero (ϕy_eq.symm.trans h),
  -- Write `y` as `a • y'` for some `y'`.
  have hdvd : ∀ i, a ∣ b'M.coord i ⟨y, N_le_M yN⟩ :=
    λ i, generator_maximal_submodule_image_dvd N_le_M ϕ_max y yN ϕy_eq (b'M.coord i),
  choose c hc using hdvd,
  let y' : O := ∑ i, c i • b'M i,
  have y'M : y' ∈ M := M.sum_mem (λ i _, M.smul_mem (c i) (b'M i).2),
  have mk_y' : (⟨y', y'M⟩ : M) = ∑ i, c i • b'M i :=
    subtype.ext (show y' = M.subtype _,
      by { simp only [linear_map.map_sum, linear_map.map_smul], refl }),
  have a_smul_y' : a • y' = y,
  { refine congr_arg coe (show (a • ⟨y', y'M⟩ : M) = ⟨y, N_le_M yN⟩, from _),
    rw [← b'M.sum_repr ⟨y, N_le_M yN⟩, mk_y', finset.smul_sum],
    refine finset.sum_congr rfl (λ i _, _),
    rw [← mul_smul, ← hc], refl },
  -- We found an `y` and an `a`!
  refine ⟨y', y'M, a, a_smul_y'.symm ▸ yN, _⟩,

  have ϕy'_eq : ϕ ⟨y', y'M⟩ = 1 := mul_left_cancel₀ a_zero
  (calc a • ϕ ⟨y', y'M⟩ = ϕ ⟨a • y', _⟩ : (ϕ.map_smul a ⟨y', y'M⟩).symm
                    ... = ϕ ⟨y, N_le_M yN⟩ : by simp only [a_smul_y']
                    ... = a : ϕy_eq
                    ... = a * 1 : (mul_one a).symm),
  have ϕy'_ne_zero : ϕ ⟨y', y'M⟩ ≠ 0 := by simpa only [ϕy'_eq] using one_ne_zero,

  -- `M' := ker (ϕ : M → R)` is smaller than `M` and `N' := ker (ϕ : N → R)` is smaller than `N`.
  let M' : submodule R O := ϕ.ker.map M.subtype,
  let N' : submodule R O := (ϕ.comp (of_le N_le_M)).ker.map N.subtype,
  have M'_le_M : M' ≤ M := M.map_subtype_le ϕ.ker,
  have N'_le_M' : N' ≤ M',
  { intros x hx,
    simp only [mem_map, linear_map.mem_ker] at hx ⊢,
    obtain ⟨⟨x, xN⟩, hx, rfl⟩ := hx,
    exact ⟨⟨x, N_le_M xN⟩, hx, rfl⟩ },
  have N'_le_N : N' ≤ N := N.map_subtype_le (ϕ.comp (of_le N_le_M)).ker,
  -- So fill in those results as well.
  refine ⟨M', M'_le_M, N', N'_le_N, N'_le_M', _⟩,

  -- Note that `y'` is orthogonal to `M'`.
  have y'_ortho_M' : ∀ (c : R) z ∈ M', c • y' + z = 0 → c = 0,
  { intros c x xM' hc,
    obtain ⟨⟨x, xM⟩, hx', rfl⟩ := submodule.mem_map.mp xM',
    rw linear_map.mem_ker at hx',
    have hc' : (c • ⟨y', y'M⟩ + ⟨x, xM⟩ : M) = 0 := subtype.coe_injective hc,
    simpa only [linear_map.map_add, linear_map.map_zero, linear_map.map_smul, smul_eq_mul, add_zero,
                mul_eq_zero, ϕy'_ne_zero, hx', or_false] using congr_arg ϕ hc' },
  -- And `a • y'` is orthogonal to `N'`.
  have ay'_ortho_N' : ∀ (c : R) z ∈ N', c • a • y' + z = 0 → c = 0,
  { intros c z zN' hc,
    refine (mul_eq_zero.mp (y'_ortho_M' (a * c) z (N'_le_M' zN') _)).resolve_left a_zero,
    rw [mul_comm, mul_smul, hc] },

  -- So we can extend a basis for `N'` with `y`
  refine ⟨y'_ortho_M', ay'_ortho_N', λ n' bN', ⟨_, _⟩⟩,
  { refine basis.mk_fin_cons_of_le y yN bN' N'_le_N _ _,
    { intros c z zN' hc,
      refine ay'_ortho_N' c z zN' _,
      rwa ← a_smul_y' at hc },
    { intros z zN,
      obtain ⟨b, hb⟩ : _ ∣ ϕ ⟨z, N_le_M zN⟩ := generator_submodule_image_dvd_of_mem N_le_M ϕ zN,
      refine ⟨-b, submodule.mem_map.mpr ⟨⟨_, N.sub_mem zN (N.smul_mem b yN)⟩, _, _⟩⟩,
      { refine linear_map.mem_ker.mpr (show ϕ (⟨z, N_le_M zN⟩ - b • ⟨y, N_le_M yN⟩) = 0, from _),
        rw [linear_map.map_sub, linear_map.map_smul, hb, ϕy_eq, smul_eq_mul,
            mul_comm, sub_self] },
      { simp only [sub_eq_add_neg, neg_smul], refl } } },
  -- And extend a basis for `M'` with `y'`
  intros m' hn'm' bM',
  refine ⟨nat.succ_le_succ hn'm', _, _⟩,
  { refine basis.mk_fin_cons_of_le y' y'M bM' M'_le_M y'_ortho_M' _,
    intros z zM,
    refine ⟨-ϕ ⟨z, zM⟩, ⟨⟨z, zM⟩ - (ϕ ⟨z, zM⟩) • ⟨y', y'M⟩, linear_map.mem_ker.mpr _, _⟩⟩,
    { rw [linear_map.map_sub, linear_map.map_smul, ϕy'_eq, smul_eq_mul, mul_one, sub_self] },
    { rw [linear_map.map_sub, linear_map.map_smul, sub_eq_add_neg, neg_smul], refl } },

  -- It remains to show the extended bases are compatible with each other.
  intros as h,
  refine ⟨fin.cons a as, _⟩,
  intro i,
  rw [basis.coe_mk_fin_cons_of_le, basis.coe_mk_fin_cons_of_le],
  refine fin.cases _ (λ i, _) i,
  { simp only [fin.cons_zero, fin.cast_le_zero],
    exact a_smul_y'.symm },
  { rw fin.cast_le_succ, simp only [fin.cons_succ, coe_of_le, h i] }
end

/-- A submodule of a free `R`-module of finite rank is also a free `R`-module of finite rank,
if `R` is a principal ideal domain.

This is a `lemma` to make the induction a bit easier. To actually access the basis,
see `submodule.basis_of_pid`.

See also the stronger version `submodule.smith_normal_form`.
-/
lemma submodule.nonempty_basis_of_pid {ι : Type*} [fintype ι]
  (b : basis ι R M) (N : submodule R M) :
  ∃ (n : ℕ), nonempty (basis (fin n) R N) :=
begin
  haveI := classical.dec_eq M,
  refine N.induction_on_rank b _ _,
  intros N ih,
  let b' := (b.reindex (fintype.equiv_fin ι)).map (linear_equiv.of_top _ rfl).symm,
  by_cases N_bot : N = ⊥,
  { subst N_bot, exact ⟨0, ⟨basis.empty _⟩⟩ },
  obtain ⟨y, -, a, hay, M', -, N', N'_le_N, -, -, ay_ortho, h'⟩ :=
    submodule.basis_of_pid_aux ⊤ N b' N_bot le_top,
  obtain ⟨n', ⟨bN'⟩⟩ := ih N' N'_le_N _ hay ay_ortho,
  obtain ⟨bN, hbN⟩ := h' n' bN',
  exact ⟨n' + 1, ⟨bN⟩⟩
end

/-- A submodule of a free `R`-module of finite rank is also a free `R`-module of finite rank,
if `R` is a principal ideal domain.

See also the stronger version `submodule.smith_normal_form`.
-/
noncomputable def submodule.basis_of_pid {ι : Type*} [fintype ι]
  (b : basis ι R M) (N : submodule R M) :
  Σ (n : ℕ), (basis (fin n) R N) :=
⟨_, (N.nonempty_basis_of_pid b).some_spec.some⟩

lemma submodule.basis_of_pid_bot {ι : Type*} [fintype ι] (b : basis ι R M) :
  submodule.basis_of_pid b ⊥ = ⟨0, basis.empty _⟩ :=
begin
  obtain ⟨n, b'⟩ := submodule.basis_of_pid b ⊥,
  let e : fin n ≃ fin 0 := b'.index_equiv (basis.empty _ : basis (fin 0) R (⊥ : submodule R M)),
  have : n = 0 := by simpa using fintype.card_eq.mpr ⟨e⟩,
  subst this,
  exact sigma.eq rfl (basis.eq_of_apply_eq $ fin_zero_elim)
end

/-- A submodule inside a free `R`-submodule of finite rank is also a free `R`-module of finite rank,
if `R` is a principal ideal domain.

See also the stronger version `submodule.smith_normal_form_of_le`.
-/
noncomputable def submodule.basis_of_pid_of_le {ι : Type*} [fintype ι]
  {N O : submodule R M} (hNO : N ≤ O) (b : basis ι R O) :
  Σ (n : ℕ), basis (fin n) R N :=
let ⟨n, bN'⟩ := submodule.basis_of_pid b (N.comap O.subtype)
in ⟨n, bN'.map (submodule.comap_subtype_equiv_of_le hNO)⟩

/-- A submodule inside the span of a linear independent family is a free `R`-module of finite rank,
if `R` is a principal ideal domain. -/
noncomputable def submodule.basis_of_pid_of_le_span
  {ι : Type*} [fintype ι] {b : ι → M} (hb : linear_independent R b)
  {N : submodule R M} (le : N ≤ submodule.span R (set.range b)) :
  Σ (n : ℕ), basis (fin n) R N :=
submodule.basis_of_pid_of_le le (basis.span hb)

variable {M}

/-- A finite type torsion free module over a PID is free. -/
noncomputable def module.free_of_finite_type_torsion_free [fintype ι] {s : ι → M}
  (hs : span R (range s) = ⊤) [no_zero_smul_divisors R M] :
  Σ (n : ℕ), basis (fin n) R M :=
begin
  classical,
  -- We define `N` as the submodule spanned by a maximal linear independent subfamily of `s`
  have := exists_maximal_independent R s,
  let I : set ι := this.some,
  obtain ⟨indepI : linear_independent R (s ∘ coe : I → M),
    hI : ∀ i ∉ I, ∃ a : R, a ≠ 0 ∧ a • s i ∈ span R (s '' I)⟩ := this.some_spec,

  let N := span R (range $ (s ∘ coe : I → M)), -- same as `span R (s '' I)` but more convenient
  let sI : I → N := λ i, ⟨s i.1, subset_span (mem_range_self i)⟩, -- `s` restricted to `I`
  let sI_basis : basis I R N, -- `s` restricted to `I` is a basis of `N`
    from basis.span indepI,
  -- Our first goal is to build `A ≠ 0` such that `A • M ⊆ N`
  have exists_a : ∀ i : ι, ∃ a : R, a ≠ 0 ∧ a • s i ∈ N,
  { intro i,
    by_cases hi : i ∈ I,
    { use [1, zero_ne_one.symm],
      rw one_smul,
      exact subset_span (mem_range_self (⟨i, hi⟩ : I)) },
    { simpa [image_eq_range s I] using hI i hi } },
  choose a ha ha' using exists_a,
  let A := ∏ i, a i,
  have hA : A ≠ 0,
  { rw finset.prod_ne_zero_iff,
    simpa using ha },
  -- `M ≃ A • M` because `M` is torsion free and `A ≠ 0`
  let φ : M →ₗ[R] M := linear_map.lsmul R M A,
  have : φ.ker = ⊥,
    from linear_map.ker_lsmul hA,
  let ψ : M ≃ₗ[R] φ.range := linear_equiv.of_injective φ (linear_map.ker_eq_bot.mp this),
  have : φ.range ≤ N, -- as announced, `A • M ⊆ N`
  { suffices : ∀ i, φ (s i) ∈ N,
    { rw [linear_map.range_eq_map, ← hs, φ.map_span_le],
      rintros _ ⟨i, rfl⟩, apply this },
    intro i,
    calc (∏ j, a j) • s i = (∏ j in {i}ᶜ, a j) • a i • s i :
                                                 by rw [fintype.prod_eq_prod_compl_mul i, mul_smul]
                      ... ∈ N  : N.smul_mem _ (ha' i) },
  -- Since a submodule of a free `R`-module is free, we get that `A • M` is free
  obtain ⟨n, b : basis (fin n) R φ.range⟩ := submodule.basis_of_pid_of_le this sI_basis,
  -- hence `M` is free.
  exact ⟨n, b.map ψ.symm⟩
end

/-- A finite type torsion free module over a PID is free. -/
noncomputable def module.free_of_finite_type_torsion_free' [module.finite R M]
  [no_zero_smul_divisors R M] :
  Σ (n : ℕ), basis (fin n) R M :=
module.free_of_finite_type_torsion_free module.finite.exists_fin.some_spec.some_spec

section smith_normal

/-- A Smith normal form basis for a submodule `N` of a module `M` consists of
bases for `M` and `N` such that the inclusion map `N → M` can be written as a
(rectangular) matrix with `a` along the diagonal: in Smith normal form. -/
@[nolint has_inhabited_instance]
structure basis.smith_normal_form (N : submodule R M) (ι : Type*) (n : ℕ) :=
(bM : basis ι R M)
(bN : basis (fin n) R N)
(f : fin n ↪ ι)
(a : fin n → R)
(snf : ∀ i, (bN i : M) = a i • bM (f i))

/-- If `M` is finite free over a PID `R`, then any submodule `N` is free
and we can find a basis for `M` and `N` such that the inclusion map is a diagonal matrix
in Smith normal form.

See `submodule.smith_normal_form_of_le` for a version of this theorem that returns
a `basis.smith_normal_form`.

This is a strengthening of `submodule.basis_of_pid_of_le`.
-/
theorem submodule.exists_smith_normal_form_of_le [fintype ι]
  (b : basis ι R M) (N O : submodule R M) (N_le_O : N ≤ O) :
  ∃ (n o : ℕ) (hno : n ≤ o) (bO : basis (fin o) R O) (bN : basis (fin n) R N) (a : fin n → R),
    ∀ i, (bN i : M) = a i • bO (fin.cast_le hno i) :=
begin
  revert N,
  refine induction_on_rank b _ _ O,
  intros M ih N N_le_M,
  obtain ⟨m, b'M⟩ := M.basis_of_pid b,
  by_cases N_bot : N = ⊥,
  { subst N_bot,
    exact ⟨0, m, nat.zero_le _, b'M, basis.empty _, fin_zero_elim, fin_zero_elim⟩ },

  obtain ⟨y, hy, a, hay, M', M'_le_M, N', N'_le_N, N'_le_M', y_ortho, ay_ortho, h⟩ :=
    submodule.basis_of_pid_aux M N b'M N_bot N_le_M,
  obtain ⟨n', m', hn'm', bM', bN', as', has'⟩ := ih M' M'_le_M y hy y_ortho N' N'_le_M',
  obtain ⟨bN, h'⟩ := h n' bN',
  obtain ⟨hmn, bM, h''⟩ := h' m' hn'm' bM',
  obtain ⟨as, has⟩ := h'' as' has',
  exact ⟨_, _, hmn, bM, bN, as, has⟩
end

/-- If `M` is finite free over a PID `R`, then any submodule `N` is free
and we can find a basis for `M` and `N` such that the inclusion map is a diagonal matrix
in Smith normal form.

See `submodule.exists_smith_normal_form_of_le` for a version of this theorem that doesn't
need to map `N` into a submodule of `O`.

This is a strengthening of `submodule.basis_of_pid_of_le`.
-/
noncomputable def submodule.smith_normal_form_of_le [fintype ι]
  (b : basis ι R M) (N O : submodule R M) (N_le_O : N ≤ O) :
  Σ (o n : ℕ), basis.smith_normal_form (N.comap O.subtype) (fin o) n :=
begin
  choose n o hno bO bN a snf using N.exists_smith_normal_form_of_le b O N_le_O,
  refine ⟨o, n, bO, bN.map (comap_subtype_equiv_of_le N_le_O).symm, (fin.cast_le hno).to_embedding,
          a, λ i, _⟩,
  ext,
  simp only [snf, basis.map_apply, submodule.comap_subtype_equiv_of_le_symm_apply_coe_coe,
      submodule.coe_smul_of_tower, rel_embedding.coe_fn_to_embedding]
end

/-- If `M` is finite free over a PID `R`, then any submodule `N` is free
and we can find a basis for `M` and `N` such that the inclusion map is a diagonal matrix
in Smith normal form.

This is a strengthening of `submodule.basis_of_pid`.

See also `ideal.smith_normal_form`, which moreover proves that the dimension of
an ideal is the same as the dimension of the whole ring.
-/
noncomputable def submodule.smith_normal_form [fintype ι] (b : basis ι R M) (N : submodule R M) :
  Σ (n : ℕ), basis.smith_normal_form N ι n :=
let ⟨m, n, bM, bN, f, a, snf⟩ := N.smith_normal_form_of_le b ⊤ le_top,
    bM' := bM.map (linear_equiv.of_top _ rfl),
    e := bM'.index_equiv b in
⟨n, bM'.reindex e, bN.map (comap_subtype_equiv_of_le le_top), f.trans e.to_embedding, a,
 λ i, by simp only [snf, basis.map_apply, linear_equiv.of_top_apply, submodule.coe_smul_of_tower,
                    submodule.comap_subtype_equiv_of_le_apply_coe, coe_coe, basis.reindex_apply,
                    equiv.to_embedding_apply, function.embedding.trans_apply,
                    equiv.symm_apply_apply]⟩

/-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
find a basis for `S` and `I` such that the inclusion map is a square diagonal
matrix.

See `ideal.exists_smith_normal_form` for a version of this theorem that doesn't
need to map `I` into a submodule of `R`.

This is a strengthening of `submodule.basis_of_pid`.
-/
noncomputable def ideal.smith_normal_form
  [fintype ι] {S : Type*} [comm_ring S] [is_domain S] [algebra R S]
  (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) :
  basis.smith_normal_form (I.restrict_scalars R) ι (fintype.card ι) :=
let ⟨n, bS, bI, f, a, snf⟩ := (I.restrict_scalars R).smith_normal_form b in
have eq : _ := ideal.rank_eq bS hI (bI.map ((restrict_scalars_equiv R S S I).restrict_scalars _)),
let e : fin n ≃ fin (fintype.card ι) := fintype.equiv_of_card_eq (by rw [eq, fintype.card_fin]) in
⟨bS, bI.reindex e, e.symm.to_embedding.trans f, a ∘ e.symm, λ i,
  by simp only [snf, basis.coe_reindex, function.embedding.trans_apply, equiv.to_embedding_apply]⟩

/-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
find a basis for `S` and `I` such that the inclusion map is a square diagonal
matrix.

See also `ideal.smith_normal_form` for a version of this theorem that returns
a `basis.smith_normal_form`.
-/
theorem ideal.exists_smith_normal_form
  [fintype ι] {S : Type*} [comm_ring S] [is_domain S] [algebra R S]
  (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) :
  ∃ (b' : basis ι R S) (a : ι → R) (ab' : basis ι R I),
  ∀ i, (ab' i : S) = a i • b' i :=
let ⟨bS, bI, f, a, snf⟩ := I.smith_normal_form b hI,
    e : fin (fintype.card ι) ≃ ι := equiv.of_bijective f
      ((fintype.bijective_iff_injective_and_card f).mpr ⟨f.injective, fintype.card_fin _⟩) in
have fe : ∀ i, f (e.symm i) = i := e.apply_symm_apply,
⟨bS, a ∘ e.symm, (bI.reindex e).map ((restrict_scalars_equiv _ _ _ _).restrict_scalars R), λ i,
  by simp only [snf, fe, basis.map_apply, linear_equiv.restrict_scalars_apply,
    submodule.restrict_scalars_equiv_apply, basis.coe_reindex]⟩

end smith_normal

end principal_ideal_domain

/-- A set of linearly independent vectors in a module `M` over a semiring `S` is also linearly
independent over a subring `R` of `K`. -/
lemma linear_independent.restrict_scalars_algebras {R S M ι : Type*} [comm_semiring R] [semiring S]
  [add_comm_monoid M] [algebra R S] [module R M] [module S M] [is_scalar_tower R S M]
  (hinj : function.injective (algebra_map R S)) {v : ι → M} (li : linear_independent S v) :
  linear_independent R v :=
linear_independent.restrict_scalars (by rwa algebra.algebra_map_eq_smul_one' at hinj) li


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

import data.real.ennreal
import order.filter.countable_Inter
import order.liminf_limsup

/-!
# Order properties of extended non-negative reals

This file compiles filter-related results about `ℝ≥0∞` (see data/real/ennreal.lean).
-/

open filter
open_locale filter ennreal

namespace ennreal
variables {α : Type*} {f : filter α}

lemma eventually_le_limsup [countable_Inter_filter f] (u : α → ℝ≥0∞) :
  ∀ᶠ y in f, u y ≤ f.limsup u :=
begin
  by_cases hx_top : f.limsup u = ⊤,
  { simp_rw hx_top,
    exact eventually_of_forall (λ a, le_top), },
  have h_forall_le : ∀ᶠ y in f, ∀ n : ℕ, u y < f.limsup u + (1:ℝ≥0∞)/n,
  { rw eventually_countable_forall,
    refine λ n, eventually_lt_of_limsup_lt _,
    nth_rewrite 0 ←add_zero (f.limsup u),
    exact (add_lt_add_iff_left hx_top).mpr (by simp), },
  refine h_forall_le.mono (λ y hy, le_of_forall_pos_le_add (λ r hr_pos hx_top, _)),
  have hr_ne_zero : (r : ℝ≥0∞) ≠ 0,
  { rw [ne.def, coe_eq_zero],
    exact (ne_of_lt hr_pos).symm, },
  cases (exists_inv_nat_lt hr_ne_zero) with i hi,
  rw inv_eq_one_div at hi,
  exact (hy i).le.trans (add_le_add_left hi.le (f.limsup u)),
end

lemma limsup_eq_zero_iff [countable_Inter_filter f] {u : α → ℝ≥0∞} :
  f.limsup u = 0 ↔ u =ᶠ[f] 0 :=
begin
  split; intro h,
  { have hu_zero := eventually_le.trans (eventually_le_limsup u)
      (eventually_of_forall (λ _, le_of_eq h)),
    exact hu_zero.mono (λ x hx, le_antisymm hx (zero_le _)), },
  { rw limsup_congr h,
    simp_rw [pi.zero_apply, ←ennreal.bot_eq_zero, limsup_const_bot] },
end

lemma limsup_const_mul_of_ne_top {u : α → ℝ≥0∞} {a : ℝ≥0∞} (ha_top : a ≠ ⊤) :
  f.limsup (λ (x : α), a * (u x)) = a * f.limsup u :=
begin
  by_cases ha_zero : a = 0,
  { simp_rw [ha_zero, zero_mul, ←ennreal.bot_eq_zero],
    exact limsup_const_bot, },
  let g := λ x : ℝ≥0∞, a * x,
  have hg_bij : function.bijective g,
  from function.bijective_iff_has_inverse.mpr ⟨(λ x, a⁻¹ * x),
    ⟨λ x, by simp [←mul_assoc, inv_mul_cancel ha_zero ha_top],
    λ x, by simp [g, ←mul_assoc, mul_inv_cancel ha_zero ha_top]⟩⟩,
  have hg_mono : strict_mono g,
    from monotone.strict_mono_of_injective
      (λ _ _ _, by rwa mul_le_mul_left ha_zero ha_top) hg_bij.1,
  let g_iso := strict_mono.order_iso_of_surjective g hg_mono hg_bij.2,
  refine (order_iso.limsup_apply g_iso _ _ _ _).symm,
  all_goals { by is_bounded_default },
end

lemma limsup_const_mul [countable_Inter_filter f] {u : α → ℝ≥0∞} {a : ℝ≥0∞} :
  f.limsup (λ (x : α), a * (u x)) = a * f.limsup u :=
begin
  by_cases ha_top : a ≠ ⊤,
  { exact limsup_const_mul_of_ne_top ha_top, },
  push_neg at ha_top,
  by_cases hu : u =ᶠ[f] 0,
  { have hau : (λ x, a * (u x)) =ᶠ[f] 0,
    { refine hu.mono (λ x hx, _),
      rw pi.zero_apply at hx,
      simp [hx], },
    simp only [limsup_congr hu, limsup_congr hau, pi.zero_apply, ← bot_eq_zero, limsup_const_bot],
    simp, },
  { simp_rw [ha_top, top_mul],
    have hu_mul : ∃ᶠ (x : α) in f, ⊤ ≤ ite (u x = 0) (0 : ℝ≥0∞) ⊤,
    { rw [eventually_eq, not_eventually] at hu,
      refine hu.mono (λ x hx, _),
      rw pi.zero_apply at hx,
      simp [hx], },
    have h_top_le : f.limsup (λ (x : α), ite (u x = 0) (0 : ℝ≥0∞) ⊤) = ⊤,
      from eq_top_iff.mpr (le_limsup_of_frequently_le hu_mul),
    have hfu : f.limsup u ≠ 0, from mt limsup_eq_zero_iff.1 hu,
    simp only [h_top_le, hfu, if_false], },
end

lemma limsup_add_le [countable_Inter_filter f] (u v : α → ℝ≥0∞) :
  f.limsup (u + v) ≤ f.limsup u + f.limsup v :=
Inf_le ((eventually_le_limsup u).mp ((eventually_le_limsup v).mono
  (λ _ hxg hxf, add_le_add hxf hxg)))

lemma limsup_liminf_le_liminf_limsup {β} [encodable β] {f : filter α} [countable_Inter_filter f]
  {g : filter β} (u : α → β → ℝ≥0∞) :
  f.limsup (λ (a : α), g.liminf (λ (b : β), u a b)) ≤ g.liminf (λ b, f.limsup (λ a, u a b)) :=
begin
  have h1 : ∀ᶠ a in f, ∀ b, u a b ≤ f.limsup (λ a', u a' b),
    by { rw eventually_countable_forall, exact λ b, ennreal.eventually_le_limsup (λ a, u a b), },
  refine Inf_le (h1.mono (λ x hx, filter.liminf_le_liminf (filter.eventually_of_forall hx) _)),
  filter.is_bounded_default,
end

end ennreal


universe u

inductive vector (α : Type u) : nat → Type u
| nil {} : vector 0
| cons   : Π {n}, α → vector n → vector (n+1)

namespace vector
local notation h :: t := cons h t

def append_tail {α : Type*} : Π {n : ℕ}, vector α n → α → vector α (n+1)
| 0		 	nil 		a := a :: nil
| (n+1)	(a::v)	b := a::(append_tail v b)

-- theorem simp_length {α : Type*} : ∀ {n m: ℕ}, vector α (n + 1 + m) = vector α (n + (m + 1))
-- := sorry

def append {α : Type*} : Π {n m : ℕ},  vector α n → vector α m → vector α (n+m)
| 0				0 				nil 			nil				:= nil
| (n+1)		m					(a::v)		u					:=  by repeat {rw nat.add_comm}; exact a::(append v u)
| 0			 	(m+1)			nil				u 				:= by repeat {rw nat.add_comm}; exact u

end vector

inductive aexpr : Type
| const : ℕ → aexpr
| var : ℕ → aexpr
| plus : aexpr → aexpr → aexpr
| times : aexpr → aexpr → aexpr

open aexpr

def sample_aexpr : aexpr :=
plus (times (var 0) (const 7)) (times (const 2) (var 1))

def aeval (v : ℕ → ℕ) : aexpr → ℕ
| (const n)    := n
| (var n)      := v n
| (plus e₁ e₂)  := aeval e₁ + aeval e₂
| (times e₁ e₂) := aeval e₁ * aeval e₂

def sample_val : ℕ → ℕ
| 0 := 5
| 1 := 6
| _ := 0

#eval aeval sample_val sample_aexpr

def simp_const : aexpr → aexpr
| (plus (const n₁) (const n₂))  := const (n₁ + n₂)
| (times (const n₁) (const n₂)) := const (n₁ * n₂)
| e                             := e

def sample_aexpr1 : aexpr :=
plus (times (const 0) (const 7)) (times (const 2) (const 1))

#reduce simp_const (times (const 0) (const 7))
#reduce simp_const (plus (times (const 0) (const 7)) (times (const 2) (const 1)))

def fuse : aexpr → aexpr
| (plus e₁ e₂) 		:= simp_const (plus (simp_const e₁) (simp_const e₂))
| (times  e₁ e₂) 	:= simp_const (times (simp_const e₁) (simp_const e₂))
| e               := simp_const e

#reduce fuse (times (const 0) (const 7))
#reduce fuse (plus (times (const 0) (const 7)) (times (const 2) (const 1)))

theorem simp_const_eq (v : ℕ → ℕ) :
  ∀ e : aexpr, aeval v (simp_const e) = aeval v e
| e := have h: simp_const e = e, by simp [simp_const e],
| (const _) := rfl
| (var _) := rfl
| (plus (const _) (const _))  		:= rfl
| (times (const _) (const _)) 		:= rfl

theorem fuse_eq (v : ℕ → ℕ) :
  ∀ e : aexpr, aeval v (fuse e) = aeval v e :=
sorry


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot
-/

import topology.uniform_space.basic
import tactic.apply_fun

/-!
# Hausdorff properties of uniform spaces. Separation quotient.

This file studies uniform spaces whose underlying topological spaces are separated
(also known as Hausdorff or T₂).
This turns out to be equivalent to asking that the intersection of all entourages
is the diagonal only. This condition actually implies the stronger separation property
that the space is regular (T₃), hence those conditions are equivalent for topologies coming from
a uniform structure.

More generally, the intersection `𝓢 X` of all entourages of `X`, which has type `set (X × X)` is an
equivalence relation on `X`. Points which are equivalent under the relation are basically
undistinguishable from the point of view of the uniform structure. For instance any uniformly
continuous function will send equivalent points to the same value.

The quotient `separation_quotient X` of `X` by `𝓢 X` has a natural uniform structure which is
separated, and satisfies a universal property: every uniformly continuous function
from `X` to a separated uniform space uniquely factors through `separation_quotient X`.
As usual, this allows to turn `separation_quotient` into a functor (but we don't use the
category theory library in this file).

These notions admit relative versions, one can ask that `s : set X` is separated, this
is equivalent to asking that the uniform structure induced on `s` is separated.

## Main definitions

* `separation_relation X : set (X × X)`: the separation relation
* `separated_space X`: a predicate class asserting that `X` is separated
* `is_separated s`: a predicate asserting that `s : set X` is separated
* `separation_quotient X`: the maximal separated quotient of `X`.
* `separation_quotient.lift f`: factors a map `f : X → Y` through the separation quotient of `X`.
* `separation_quotient.map f`: turns a map `f : X → Y` into a map between the separation quotients
  of `X` and `Y`.

## Main results

* `separated_iff_t2`: the equivalence between being separated and being Hausdorff for uniform
  spaces.
* `separation_quotient.uniform_continuous_lift`: factoring a uniformly continuous map through the
  separation quotient gives a uniformly continuous map.
* `separation_quotient.uniform_continuous_map`: maps induced between separation quotients are
  uniformly continuous.

## Notations

Localized in `uniformity`, we have the notation `𝓢 X` for the separation relation
on a uniform space `X`,

## Implementation notes

The separation setoid `separation_setoid` is not declared as a global instance.
It is made a local instance while building the theory of `separation_quotient`.
The factored map `separation_quotient.lift f` is defined without imposing any condition on
`f`, but returns junk if `f` is not uniformly continuous (constant junk hence it is always
uniformly continuous).

-/

open filter topological_space set classical function uniform_space
open_locale classical topological_space uniformity filter
noncomputable theory
set_option eqn_compiler.zeta true

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}
variables [uniform_space α] [uniform_space β] [uniform_space γ]

/-!
### Separated uniform spaces
-/

/-- The separation relation is the intersection of all entourages.
  Two points which are related by the separation relation are "indistinguishable"
  according to the uniform structure. -/
protected def separation_rel (α : Type u) [u : uniform_space α] :=
⋂₀ (𝓤 α).sets

localized "notation `𝓢` := separation_rel" in uniformity

lemma separated_equiv : equivalence (λx y, (x, y) ∈ 𝓢 α) :=
⟨assume x, assume s, refl_mem_uniformity,
  assume x y, assume h (s : set (α×α)) hs,
    have preimage prod.swap s ∈ 𝓤 α,
      from symm_le_uniformity hs,
    h _ this,
  assume x y z (hxy : (x, y) ∈ 𝓢 α) (hyz : (y, z) ∈ 𝓢 α)
      s (hs : s ∈ 𝓤 α),
    let ⟨t, ht, (h_ts : comp_rel t t ⊆ s)⟩ := comp_mem_uniformity_sets hs in
    h_ts $ show (x, z) ∈ comp_rel t t,
      from ⟨y, hxy t ht, hyz t ht⟩⟩

/-- A uniform space is separated if its separation relation is trivial (each point
is related only to itself). -/
class separated_space (α : Type u) [uniform_space α] : Prop := (out : 𝓢 α = id_rel)

theorem separated_space_iff {α : Type u} [uniform_space α] :
  separated_space α ↔ 𝓢 α = id_rel :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem separated_def {α : Type u} [uniform_space α] :
  separated_space α ↔ ∀ x y, (∀ r ∈ 𝓤 α, (x, y) ∈ r) → x = y :=
by simp [separated_space_iff, id_rel_subset.2 separated_equiv.1, subset.antisymm_iff];
   simp [subset_def, separation_rel]

theorem separated_def' {α : Type u} [uniform_space α] :
  separated_space α ↔ ∀ x y, x ≠ y → ∃ r ∈ 𝓤 α, (x, y) ∉ r :=
separated_def.trans $ forall_congr $ λ x, forall_congr $ λ y,
by rw ← not_imp_not; simp [not_forall]

lemma id_rel_sub_separation_relation (α : Type*) [uniform_space α] : id_rel ⊆ 𝓢 α :=
begin
  unfold separation_rel,
  rw id_rel_subset,
  intros x,
  suffices : ∀ t ∈ 𝓤 α, (x, x) ∈ t, by simpa only [refl_mem_uniformity],
  exact λ t, refl_mem_uniformity,
end

lemma separation_rel_comap  {f : α → β}
  (h : ‹uniform_space α› = uniform_space.comap f ‹uniform_space β›) :
  𝓢 α = (prod.map f f) ⁻¹' 𝓢 β :=
begin
  dsimp [separation_rel],
  rw [uniformity_comap h, (filter.comap_has_basis (prod.map f f) (𝓤 β)).sInter_sets,
      ← preimage_bInter, sInter_eq_bInter],
  refl,
end

protected lemma filter.has_basis.separation_rel {ι : Type*} {p : ι → Prop} {s : ι → set (α × α)}
  (h : has_basis (𝓤 α) p s) :
  𝓢 α = ⋂ i ∈ set_of p, s i :=
by { unfold separation_rel, rw h.sInter_sets }

lemma separation_rel_eq_inter_closure : 𝓢 α = ⋂₀ (closure '' (𝓤 α).sets) :=
by simpa [uniformity_has_basis_closure.separation_rel]

lemma is_closed_separation_rel : is_closed (𝓢 α) :=
begin
  rw separation_rel_eq_inter_closure,
  apply is_closed_sInter,
  rintros _ ⟨t, t_in, rfl⟩,
  exact is_closed_closure,
end

lemma separated_iff_t2 : separated_space α ↔ t2_space α :=
begin
  classical,
  split ; intro h,
  { rw [t2_iff_is_closed_diagonal, ← show 𝓢 α = diagonal α, from h.1],
    exact is_closed_separation_rel },
  { rw separated_def',
    intros x y hxy,
    have : 𝓝 x ⊓ 𝓝 y = ⊥,
    { rw t2_iff_nhds at h,
      by_contra H,
      exact hxy (h ⟨H⟩) },
    rcases inf_eq_bot_iff.mp this with ⟨U, U_in, V, V_in, H⟩,
    rcases mem_nhds_iff.mp U_in with ⟨S, S_in, S_sub⟩,
    use [S, S_in],
    change y ∉ ball x S,
    intro y_in,
    have : y ∈ U ∩ V := ⟨S_sub y_in, mem_of_nhds V_in⟩,
    rwa H at this },
end

@[priority 100] -- see Note [lower instance priority]
instance separated_regular [separated_space α] : regular_space α :=
{ t0 := by { haveI := separated_iff_t2.mp ‹_›, exact t1_space.t0_space.t0 },
  regular := λs a hs ha,
    have sᶜ ∈ 𝓝 a,
      from mem_nhds_sets hs.is_open_compl ha,
    have {p : α × α | p.1 = a → p.2 ∈ sᶜ} ∈ 𝓤 α,
      from mem_nhds_uniformity_iff_right.mp this,
    let ⟨d, hd, h⟩ := comp_mem_uniformity_sets this in
    let e := {y:α| (a, y) ∈ d} in
    have hae : a ∈ closure e, from subset_closure $ refl_mem_uniformity hd,
    have set.prod (closure e) (closure e) ⊆ comp_rel d (comp_rel (set.prod e e) d),
    begin
      rw [←closure_prod_eq, closure_eq_inter_uniformity],
      change (⨅d' ∈ 𝓤 α, _) ≤ comp_rel d (comp_rel _ d),
      exact (infi_le_of_le d $ infi_le_of_le hd $ le_refl _)
    end,
    have e_subset : closure e ⊆ sᶜ,
      from assume a' ha',
        let ⟨x, (hx : (a, x) ∈ d), y, ⟨hx₁, hx₂⟩, (hy : (y, _) ∈ d)⟩ := @this ⟨a, a'⟩ ⟨hae, ha'⟩ in
        have (a, a') ∈ comp_rel d d, from ⟨y, hx₂, hy⟩,
        h this rfl,
    have closure e ∈ 𝓝 a, from (𝓝 a).sets_of_superset (mem_nhds_left a hd) subset_closure,
    have 𝓝 a ⊓ 𝓟 (closure e)ᶜ = ⊥,
      from (@inf_eq_bot_iff_le_compl _ _ _ (𝓟 (closure e)ᶜ) (𝓟 (closure e))
        (by simp [principal_univ, union_comm]) (by simp)).mpr (by simp [this]),
    ⟨(closure e)ᶜ, is_closed_closure.is_open_compl, assume x h₁ h₂, @e_subset x h₂ h₁, this⟩,
    ..@t2_space.t1_space _ _ (separated_iff_t2.mp ‹_›) }

/-!
### Separated sets
-/

/-- A set `s` in a uniform space `α` is separated if the separation relation `𝓢 α`
induces the trivial relation on `s`. -/
def is_separated (s : set α) : Prop := ∀ x y ∈ s, (x, y) ∈ 𝓢 α → x = y

lemma is_separated_def (s : set α) : is_separated s ↔ ∀ x y ∈ s, (x, y) ∈ 𝓢 α → x = y :=
iff.rfl

lemma is_separated_def' (s : set α) : is_separated s ↔ (s.prod s) ∩ 𝓢 α ⊆ id_rel :=
begin
  rw is_separated_def,
  split,
  { rintros h ⟨x, y⟩ ⟨⟨x_in, y_in⟩, H⟩,
    simp [h x y x_in y_in H] },
  { intros h x y x_in y_in xy_in,
    rw ← mem_id_rel,
    exact h ⟨mk_mem_prod x_in y_in, xy_in⟩ }
end

lemma univ_separated_iff : is_separated (univ : set α) ↔ separated_space α :=
begin
  simp only [is_separated, mem_univ, true_implies_iff, separated_space_iff],
  split,
  { intro h,
    exact subset.antisymm (λ ⟨x, y⟩ xy_in, h x y xy_in) (id_rel_sub_separation_relation α), },
  { intros h x y xy_in,
    rwa h at xy_in },
end

lemma is_separated_of_separated_space [separated_space α] (s : set α) : is_separated s :=
begin
  rw [is_separated, separated_space.out],
  tauto,
end

lemma is_separated_iff_induced {s : set α} : is_separated s ↔ separated_space s :=
begin
  rw separated_space_iff,
  change _ ↔ 𝓢 {x // x ∈ s} = _,
  rw [separation_rel_comap rfl, is_separated_def'],
  split; intro h,
  { ext ⟨⟨x, x_in⟩, ⟨y, y_in⟩⟩,
    suffices : (x, y) ∈ 𝓢 α ↔ x = y, by simpa only [mem_id_rel],
    refine ⟨λ H, h ⟨mk_mem_prod x_in y_in, H⟩, _⟩,
    rintro rfl,
    exact id_rel_sub_separation_relation α rfl },
  { rintros ⟨x, y⟩ ⟨⟨x_in, y_in⟩, hS⟩,
    have A : (⟨⟨x, x_in⟩, ⟨y, y_in⟩⟩ : ↥s × ↥s) ∈ prod.map (coe : s → α) (coe : s → α) ⁻¹' 𝓢 α,
      from hS,
    simpa using h.subset A }
end

lemma eq_of_uniformity_inf_nhds_of_is_separated {s : set α} (hs : is_separated s) :
  ∀ {x y : α}, x ∈ s → y ∈ s → cluster_pt (x, y) (𝓤 α) → x = y :=
begin
  intros x y x_in y_in H,
  have : ∀ V ∈ 𝓤 α, (x, y) ∈ closure V,
  { intros V V_in,
    rw mem_closure_iff_cluster_pt,
    have : 𝓤 α ≤ 𝓟 V, by rwa le_principal_iff,
    exact H.mono this },
  apply hs x y x_in y_in,
  simpa [separation_rel_eq_inter_closure],
end

lemma eq_of_uniformity_inf_nhds [separated_space α] :
  ∀ {x y : α}, cluster_pt (x, y) (𝓤 α) → x = y :=
begin
  have : is_separated (univ : set α),
  { rw univ_separated_iff,
    assumption },
  introv,
  simpa using eq_of_uniformity_inf_nhds_of_is_separated this,
end

/-!
### Separation quotient
-/
namespace uniform_space

/-- The separation relation of a uniform space seen as a setoid. -/
def separation_setoid (α : Type u) [uniform_space α] : setoid α :=
⟨λx y, (x, y) ∈ 𝓢 α, separated_equiv⟩

local attribute [instance] separation_setoid

instance separation_setoid.uniform_space {α : Type u} [u : uniform_space α] :
  uniform_space (quotient (separation_setoid α)) :=
{ to_topological_space := u.to_topological_space.coinduced (λx, ⟦x⟧),
  uniformity := map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)) u.uniformity,
  refl := le_trans (by simp [quotient.exists_rep]) (filter.map_mono refl_le_uniformity),
  symm := tendsto_map' $
    by simp [prod.swap, (∘)]; exact tendsto_map.comp tendsto_swap_uniformity,
  comp := calc (map (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) u.uniformity).lift' (λs, comp_rel s s) =
          u.uniformity.lift' ((λs, comp_rel s s) ∘ image (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧))) :
      map_lift'_eq2 $ monotone_comp_rel monotone_id monotone_id
    ... ≤ u.uniformity.lift' (image (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) ∘
            (λs:set (α×α), comp_rel s (comp_rel s s))) :
      lift'_mono' $ assume s hs ⟨a, b⟩ ⟨c, ⟨⟨a₁, a₂⟩, ha, a_eq⟩, ⟨⟨b₁, b₂⟩, hb, b_eq⟩⟩,
      begin
        simp at a_eq,
        simp at b_eq,
        have h : ⟦a₂⟧ = ⟦b₁⟧, { rw [a_eq.right, b_eq.left] },
        have h : (a₂, b₁) ∈ 𝓢 α := quotient.exact h,
        simp [function.comp, set.image, comp_rel, and.comm, and.left_comm, and.assoc],
        exact ⟨a₁, a_eq.left, b₂, b_eq.right, a₂, ha, b₁, h s hs, hb⟩
      end
    ... = map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧))
            (u.uniformity.lift' (λs:set (α×α), comp_rel s (comp_rel s s))) :
      by rw [map_lift'_eq];
        exact monotone_comp_rel monotone_id (monotone_comp_rel monotone_id monotone_id)
    ... ≤ map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)) u.uniformity :
      map_mono comp_le_uniformity3,
  is_open_uniformity := assume s,
    have ∀a, ⟦a⟧ ∈ s →
        ({p:α×α | p.1 = a → ⟦p.2⟧ ∈ s} ∈ 𝓤 α ↔
          {p:α×α | p.1 ≈ a → ⟦p.2⟧ ∈ s} ∈ 𝓤 α),
      from assume a ha,
      ⟨assume h,
        let ⟨t, ht, hts⟩ := comp_mem_uniformity_sets h in
        have hts : ∀{a₁ a₂}, (a, a₁) ∈ t → (a₁, a₂) ∈ t → ⟦a₂⟧ ∈ s,
          from assume a₁ a₂ ha₁ ha₂, @hts (a, a₂) ⟨a₁, ha₁, ha₂⟩ rfl,
        have ht' : ∀{a₁ a₂}, a₁ ≈ a₂ → (a₁, a₂) ∈ t,
          from assume a₁ a₂ h, sInter_subset_of_mem ht h,
        u.uniformity.sets_of_superset ht $ assume ⟨a₁, a₂⟩ h₁ h₂, hts (ht' $ setoid.symm h₂) h₁,
        assume h, u.uniformity.sets_of_superset h $ by simp {contextual := tt}⟩,
    begin
      simp [topological_space.coinduced, u.is_open_uniformity, uniformity, forall_quotient_iff],
      exact ⟨λh a ha, (this a ha).mp $ h a ha, λh a ha, (this a ha).mpr $ h a ha⟩
    end }

lemma uniformity_quotient :
  𝓤 (quotient (separation_setoid α)) = (𝓤 α).map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)) :=
rfl

lemma uniform_continuous_quotient_mk :
  uniform_continuous (quotient.mk : α → quotient (separation_setoid α)) :=
le_refl _

lemma uniform_continuous_quotient {f : quotient (separation_setoid α) → β}
  (hf : uniform_continuous (λx, f ⟦x⟧)) : uniform_continuous f :=
hf

lemma uniform_continuous_quotient_lift
  {f : α → β} {h : ∀a b, (a, b) ∈ 𝓢 α → f a = f b}
  (hf : uniform_continuous f) : uniform_continuous (λa, quotient.lift f h a) :=
uniform_continuous_quotient hf

lemma uniform_continuous_quotient_lift₂
  {f : α → β → γ} {h : ∀a c b d, (a, b) ∈ 𝓢 α → (c, d) ∈ 𝓢 β → f a c = f b d}
  (hf : uniform_continuous (λp:α×β, f p.1 p.2)) :
  uniform_continuous (λp:_×_, quotient.lift₂ f h p.1 p.2) :=
begin
  rw [uniform_continuous, uniformity_prod_eq_prod, uniformity_quotient, uniformity_quotient,
    filter.prod_map_map_eq, filter.tendsto_map'_iff, filter.tendsto_map'_iff],
  rwa [uniform_continuous, uniformity_prod_eq_prod, filter.tendsto_map'_iff] at hf
end

lemma comap_quotient_le_uniformity :
  (𝓤 $ quotient $ separation_setoid α).comap (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) ≤ (𝓤 α) :=
assume t' ht',
let ⟨t, ht, tt_t'⟩ := comp_mem_uniformity_sets ht' in
let ⟨s, hs, ss_t⟩ := comp_mem_uniformity_sets ht in
⟨(λp:α×α, (⟦p.1⟧, ⟦p.2⟧)) '' s,
  (𝓤 α).sets_of_superset hs $ assume x hx, ⟨x, hx, rfl⟩,
  assume ⟨a₁, a₂⟩ ⟨⟨b₁, b₂⟩, hb, ab_eq⟩,
  have ⟦b₁⟧ = ⟦a₁⟧ ∧ ⟦b₂⟧ = ⟦a₂⟧, from prod.mk.inj ab_eq,
  have b₁ ≈ a₁ ∧ b₂ ≈ a₂, from and.imp quotient.exact quotient.exact this,
  have ab₁ : (a₁, b₁) ∈ t, from (setoid.symm this.left) t ht,
  have ba₂ : (b₂, a₂) ∈ s, from this.right s hs,
  tt_t' ⟨b₁, show ((a₁, a₂).1, b₁) ∈ t, from ab₁,
    ss_t ⟨b₂, show ((b₁, a₂).1, b₂) ∈ s, from hb, ba₂⟩⟩⟩

lemma comap_quotient_eq_uniformity :
  (𝓤 $ quotient $ separation_setoid α).comap (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) = 𝓤 α :=
le_antisymm comap_quotient_le_uniformity le_comap_map

instance separated_separation : separated_space (quotient (separation_setoid α)) :=
⟨set.ext $ assume ⟨a, b⟩, quotient.induction_on₂ a b $ assume a b,
  ⟨assume h,
    have a ≈ b, from assume s hs,
      have s ∈ (𝓤 $ quotient $ separation_setoid α).comap (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)),
        from comap_quotient_le_uniformity hs,
      let ⟨t, ht, hts⟩ := this in
      hts begin dsimp [preimage], exact h t ht end,
    show ⟦a⟧ = ⟦b⟧, from quotient.sound this,

  assume heq : ⟦a⟧ = ⟦b⟧, assume h hs,
  heq ▸ refl_mem_uniformity hs⟩⟩

lemma separated_of_uniform_continuous {f : α → β} {x y : α}
  (H : uniform_continuous f) (h : x ≈ y) : f x ≈ f y :=
assume _ h', h _ (H h')

lemma eq_of_separated_of_uniform_continuous [separated_space β] {f : α → β} {x y : α}
  (H : uniform_continuous f) (h : x ≈ y) : f x = f y :=
separated_def.1 (by apply_instance) _ _ $ separated_of_uniform_continuous H h

/-- The maximal separated quotient of a uniform space `α`. -/
def separation_quotient (α : Type*) [uniform_space α] := quotient (separation_setoid α)

namespace separation_quotient
instance : uniform_space (separation_quotient α) := by dunfold separation_quotient ; apply_instance
instance : separated_space (separation_quotient α) :=
  by dunfold separation_quotient ; apply_instance
instance [inhabited α] : inhabited (separation_quotient α) :=
by unfold separation_quotient; apply_instance

/-- Factoring functions to a separated space through the separation quotient. -/
def lift [separated_space β] (f : α → β) : (separation_quotient α → β) :=
if h : uniform_continuous f then
  quotient.lift f (λ x y, eq_of_separated_of_uniform_continuous h)
else
  λ x, f (nonempty.some ⟨x.out⟩)

lemma lift_mk [separated_space β] {f : α → β} (h : uniform_continuous f) (a : α) :
  lift f ⟦a⟧ = f a :=
by rw [lift, dif_pos h]; refl

lemma uniform_continuous_lift [separated_space β] (f : α → β) : uniform_continuous (lift f) :=
begin
  by_cases hf : uniform_continuous f,
  { rw [lift, dif_pos hf], exact uniform_continuous_quotient_lift hf },
  { rw [lift, dif_neg hf], exact uniform_continuous_of_const (assume a b, rfl) }
end

/-- The separation quotient functor acting on functions. -/
def map (f : α → β) : separation_quotient α → separation_quotient β :=
lift (quotient.mk ∘ f)

lemma map_mk {f : α → β} (h : uniform_continuous f) (a : α) : map f ⟦a⟧ = ⟦f a⟧ :=
by rw [map, lift_mk (uniform_continuous_quotient_mk.comp h)]

lemma uniform_continuous_map (f : α → β) : uniform_continuous (map f) :=
uniform_continuous_lift (quotient.mk ∘ f)

lemma map_unique {f : α → β} (hf : uniform_continuous f)
  {g : separation_quotient α → separation_quotient β}
  (comm : quotient.mk ∘ f = g ∘ quotient.mk) : map f = g :=
by ext ⟨a⟩;
calc map f ⟦a⟧ = ⟦f a⟧ : map_mk hf a
  ... = g ⟦a⟧ : congr_fun comm a

lemma map_id : map (@id α) = id :=
map_unique uniform_continuous_id rfl

lemma map_comp {f : α → β} {g : β → γ} (hf : uniform_continuous f) (hg : uniform_continuous g) :
  map g ∘ map f = map (g ∘ f) :=
(map_unique (hg.comp hf) $ by simp only [(∘), map_mk, hf, hg]).symm

end separation_quotient

lemma separation_prod {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) ≈ (a₂, b₂) ↔ a₁ ≈ a₂ ∧ b₁ ≈ b₂ :=
begin
  split,
  { assume h,
    exact ⟨separated_of_uniform_continuous uniform_continuous_fst h,
           separated_of_uniform_continuous uniform_continuous_snd h⟩ },
  { rintros ⟨eqv_α, eqv_β⟩ r r_in,
    rw uniformity_prod at r_in,
    rcases r_in with ⟨t_α, ⟨r_α, r_α_in, h_α⟩, t_β, ⟨r_β, r_β_in, h_β⟩, H⟩,

    let p_α := λ(p : (α × β) × (α × β)), (p.1.1, p.2.1),
    let p_β := λ(p : (α × β) × (α × β)), (p.1.2, p.2.2),
    have key_α : p_α ((a₁, b₁), (a₂, b₂)) ∈ r_α, { simp [p_α, eqv_α r_α r_α_in] },
    have key_β : p_β ((a₁, b₁), (a₂, b₂)) ∈ r_β, { simp [p_β, eqv_β r_β r_β_in] },
    exact H ⟨h_α key_α, h_β key_β⟩ },
end

instance separated.prod [separated_space α] [separated_space β] : separated_space (α × β) :=
separated_def.2 $ assume x y H, prod.ext
  (eq_of_separated_of_uniform_continuous uniform_continuous_fst H)
  (eq_of_separated_of_uniform_continuous uniform_continuous_snd H)
end uniform_space


import game.limits.bounded_if_convergent -- hide
import game.limits.Blockus_time -- hide
import game.sets.L01defs -- hide
import game.sup_inf.GLBprop_if_LUBprop -- hide
import data.real.basic -- hide
import tactic.linarith -- hide

namespace xena -- hide

/-
# Chapter 7 : Limits

## Level 4

The following three proofs should prove to be very useful in the level where you prove lim_mul.

This proof is very specific to that proof but the idea should be obvious in a general case.
The proof basically says that if you have a positive real number ε and divide it by
a positive real number, then the quotient is also positive. In this particular example,
the second positive real number is b which is multiplied by two for proving lim_mul.

-/

lemma eps_by_2_div_pos {b ε : ℝ} (hε : 0 < ε) (hb :0 < b) : 0 < ε / (2 * b) :=
begin
    have f1 : 0 < 2 * b, linarith,
    exact div_pos hε f1,

end

end xena -- hide


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_44
  (s t : ℝ)
  (h₀ : s = 9 - 2 * t)
  (h₁ : t = 3 * s + 1) :
  s = 1 ∧ t = 4 :=
begin
  split; linarith,
end


import logic.basic

lemma forall₂_and_distrib {α β : Sort*} {p q : α → β → Prop} :
  (∀ x y, p x y ∧ q x y) ↔ (∀ x y, p x y) ∧ ∀ x y, q x y :=
begin
  split ; intros h,
  split ; intros,
  exact (h x y).1,
  exact (h x y).2,
  intros x y,
   exact ⟨h.1 x y, h.2 x y⟩
end


import data.real.basic

import tactic.suggest

import game.Completeness.level01

noncomputable theory
open_locale classical

/-
# Chapter 6 : Completeness

## Level 5

Prove that b is the supremum of the set (a,b).

-/

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x
def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

example (a b : ℝ) (h : a < b) : is_sup (set.Ioo a b) b :=
begin

    unfold is_sup,
    split,
    intro t,
    intro j,
    rw set.Ioo at j,
    cases j with d hd,
    exact le_of_lt hd,

    intro t,
    intro j,
    apply le_of_not_gt,
    intro k,

    rcases lt_trichotomy a t with han | haz | hap,
    have l : t + b < b + b, linarith, ring at l,
    have l1 : (t + b) /2 < b, linarith,

    have P : t + t < t + b, linarith, ring at l,
    have P1 : t  < (b + t) /2, linarith,
    have s : a < (t + b) / 2, linarith,

    have avgIn : a < (t + b)/2 ∧ (t + b)/2 < b,
    split,
    exact s, exact l1,

    have R : (t + b)/2 ∈ set.Ioo a b,
    split,
    exact s, exact l1,

    unfold upper_bound at j,
    revert j,
    contrapose!, intro q, use (t + b)/2, split,
    exact R, linarith,

    have l : a + a < a + b, linarith, ring at l,
    have l1 : (a + b) /2 < b, linarith,

    have P : a + b < b + b, linarith, ring at P,
    have P1 : a  < (b + a) /2, linarith,
    have s : (a + b) /2 < b, linarith,

      have avgIn : a < (a + b)/2 ∧ (a + b)/2 < b,
      split, linarith,
    exact s,

    have R : (a + b)/2 ∈ set.Ioo a b,
    split,
    rw haz,
    rw haz at s, rw haz at P1, linarith,

    rw haz, rw haz at s, exact s,
    rw haz at R,
    unfold upper_bound at j,
    revert j, rw haz,
    contrapose!, intro q, use (t + b)/2, split,
    exact R, linarith,

    have P : a + b < b + b, linarith, ring at P,
    have P1 : a  < (b + a) /2, linarith,
    have s : (a + b) /2 < b, linarith,

    have t1 : t < (b + a) /2, linarith,
    revert j, unfold upper_bound, contrapose!, intro f,
    use (a+b) /2, split,

    have avgIn : a < (a + b)/2 ∧ (a + b)/2 < b,
      split, linarith,
    exact s,

    have R : (a+b)/2 ∈ set.Ioo a b,
    split, linarith, exact s, exact R,
    linarith,
end


import NBG.SetTheory.Ordinal.Transitive
import NBG.SetTheory.Relation.Order

open Classical

theorem EUpIsRelation (x: Class) :
  isRelation (Restriction E x) := sorry
theorem EUpIsAsymmetric (x: Class) :
  @isAntisymmetric (Restriction E x) ⟨EUpIsRelation x⟩ := sorry
theorem EUpIsTransitive (x: Class) :
  isTransitive (Restriction E x) := sorry
theorem EUpIsOrder (x: Class) : @isOrder (Restriction E x) ⟨EUpIsRelation x⟩ := sorry

theorem OrderEUp (x: Class) : Order (Restriction E x) := sorry

def IsIrreflexiveWellOrderOn (Restriction E x: Class) : Prop := sorry

def isOrdinal (x: Class) [Set x] :=
  isTransitive x
    ∧ (@isIrreflexive (Restriction E x) ⟨EUpIsRelation x⟩)
      ∧ (@isWellOrder (Restriction E x) (OrderEUp x))
class Ordinal (x: Class) [Set x] where
  isOrdinal: isOrdinal x

theorem OrdinalClassExists:
  ∃On: Class, ∀x: Class, ∀_:Set x,
    x ∈ On ↔ isOrdinal x := sorry

noncomputable def On : Class :=
  choose OrdinalClassExists
noncomputable def On_def:
  ∀x: Class, ∀_:Set x,
    x ∈ On ↔ isOrdinal x :=
  choose_spec OrdinalClassExists

theorem On_property_1:
  isTransitive On := sorry
-- theorem On_property_2:
--   IsIrreflexiveWellOrderOn (Restriction E On) On := sorry
theorem On_property_3:
  isTransitive On := sorry
theorem On_property_4:
  ∀x:Class, ((hx: x∈On) → (x ∪ (@Singleton_mk x (Set.mk₁ hx))) ∈ On) := sorry
theorem On_property_5:
  ∀x:Class, ∀_:Set x, (x⊂On → ⋃ x ∈ On) := sorry
theorem On_property_6:
  isProper On := sorry
theorem OmegaIsInOn: ω ⊂ On := sorry
theorem OmegaSubsetOn: ω ∈ On := sorry


import data.set.basic

variable α: Type*
variables A B C: set α

open set

theorem Q_01a: A ⊆ B ∧ B ⊆ C → A ⊆ C :=
λ ⟨hl, hr⟩ a ha, hr (hl ha)

theorem Q_01b₁: B ⊆ A → A ∪ B = A :=
λ h, ext $ λ x,
  ⟨λ hab, or.elim hab (λ ha, ha) (λ hb, h hb),
   or.inl⟩

theorem Q_01c₁: B ⊆ A → B ∪ C ⊆ A ∪ C :=
λ h x hbc, or.elim hbc
  (λ hb, or.inl (h hb))
  (λ hc, or.inr hc)

theorem Q_01c₂: B ⊆ A → B ∩ C ⊆ A ∩ C :=
λ h x ⟨hb, hc⟩, ⟨h hb , hc⟩


theorem add_right_cancel (a t b : mynat) : a + t = b + t → a = b :=
begin
intro h,
induction t with d hd,
repeat {rw add_zero at h},
rwa [h],
repeat {rw add_succ at h},
rw succ_eq_succ_iff at h,
exact hd(h),
end


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import geometry.euclidean.angle.oriented.affine
import geometry.euclidean.angle.unoriented.right_angle

/-!
# Oriented angles in right-angled triangles.

This file proves basic geometrical results about distances and oriented angles in (possibly
degenerate) right-angled triangles in real inner product spaces and Euclidean affine spaces.

-/

noncomputable theory

open_locale euclidean_geometry
open_locale real
open_locale real_inner_product_space

namespace orientation

open finite_dimensional

variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
variables [hd2 : fact (finrank ℝ V = 2)] (o : orientation ℝ V (fin 2))
include hd2 o

/-- An angle in a right-angled triangle expressed using `arccos`. -/
lemma oangle_add_right_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle x (x + y) = real.arccos (‖x‖ / ‖x + y‖) :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs,
      inner_product_geometry.angle_add_eq_arccos_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- An angle in a right-angled triangle expressed using `arccos`. -/
lemma oangle_add_left_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle (x + y) y = real.arccos (‖y‖ / ‖x + y‖) :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).oangle_add_right_eq_arccos_of_oangle_eq_pi_div_two h
end

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
lemma oangle_add_right_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle x (x + y) = real.arcsin (‖y‖ / ‖x + y‖) :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs,
      inner_product_geometry.angle_add_eq_arcsin_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
lemma oangle_add_left_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle (x + y) y = real.arcsin (‖x‖ / ‖x + y‖) :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).oangle_add_right_eq_arcsin_of_oangle_eq_pi_div_two h
end

/-- An angle in a right-angled triangle expressed using `arctan`. -/
lemma oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle x (x + y) = real.arctan (‖y‖ / ‖x‖) :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs,
      inner_product_geometry.angle_add_eq_arctan_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h) (o.left_ne_zero_of_oangle_eq_pi_div_two h)]
end

/-- An angle in a right-angled triangle expressed using `arctan`. -/
lemma oangle_add_left_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle (x + y) y = real.arctan (‖x‖ / ‖y‖) :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two h
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
lemma cos_oangle_add_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.cos (o.oangle x (x + y)) = ‖x‖ / ‖x + y‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      inner_product_geometry.cos_angle_add_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
lemma cos_oangle_add_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.cos (o.oangle (x + y) y) = ‖y‖ / ‖x + y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).cos_oangle_add_right_of_oangle_eq_pi_div_two h
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
lemma sin_oangle_add_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.sin (o.oangle x (x + y)) = ‖y‖ / ‖x + y‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      inner_product_geometry.sin_angle_add_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
lemma sin_oangle_add_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.sin (o.oangle (x + y) y) = ‖x‖ / ‖x + y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).sin_oangle_add_right_of_oangle_eq_pi_div_two h
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
lemma tan_oangle_add_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.tan (o.oangle x (x + y)) = ‖y‖ / ‖x‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      inner_product_geometry.tan_angle_add_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
lemma tan_oangle_add_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.tan (o.oangle (x + y) y) = ‖x‖ / ‖y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).tan_oangle_add_right_of_oangle_eq_pi_div_two h
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
lemma cos_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle x (x + y)) * ‖x + y‖ = ‖x‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      inner_product_geometry.cos_angle_add_mul_norm_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
lemma cos_oangle_add_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle (x + y) y) * ‖x + y‖ = ‖y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).cos_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two h
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
lemma sin_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle x (x + y)) * ‖x + y‖ = ‖y‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      inner_product_geometry.sin_angle_add_mul_norm_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
lemma sin_oangle_add_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle (x + y) y) * ‖x + y‖ = ‖x‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).sin_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two h
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
lemma tan_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle x (x + y)) * ‖x‖ = ‖y‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      inner_product_geometry.tan_angle_add_mul_norm_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
lemma tan_oangle_add_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle (x + y) y) * ‖y‖ = ‖x‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).tan_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two h
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
lemma norm_div_cos_oangle_add_right_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.cos (o.oangle x (x + y)) = ‖x + y‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      inner_product_geometry.norm_div_cos_angle_add_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
lemma norm_div_cos_oangle_add_left_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.cos (o.oangle (x + y) y) = ‖x + y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).norm_div_cos_oangle_add_right_of_oangle_eq_pi_div_two h
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
lemma norm_div_sin_oangle_add_right_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.sin (o.oangle x (x + y)) = ‖x + y‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      inner_product_geometry.norm_div_sin_angle_add_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inr (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
lemma norm_div_sin_oangle_add_left_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.sin (o.oangle (x + y) y) = ‖x + y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  rw add_comm,
  exact (-o).norm_div_sin_oangle_add_right_of_oangle_eq_pi_div_two h
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/
lemma norm_div_tan_oangle_add_right_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.tan (o.oangle x (x + y)) = ‖x‖ :=
begin
  have hs : (o.oangle x (x + y)).sign = 1,
  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      inner_product_geometry.norm_div_tan_angle_add_of_inner_eq_zero
        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inr (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/

/-- An angle in a right-angled triangle expressed using `arccos`, version subtracting vectors. -/
lemma oangle_sub_right_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle y (y - x) = real.arccos (‖y‖ / ‖y - x‖) :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs,
      inner_product_geometry.angle_sub_eq_arccos_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- An angle in a right-angled triangle expressed using `arccos`, version subtracting vectors. -/
lemma oangle_sub_left_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle (x - y) x = real.arccos (‖x‖ / ‖x - y‖) :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).oangle_sub_right_eq_arccos_of_oangle_eq_pi_div_two h
end

/-- An angle in a right-angled triangle expressed using `arcsin`, version subtracting vectors. -/
lemma oangle_sub_right_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle y (y - x) = real.arcsin (‖x‖ / ‖y - x‖) :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs,
      inner_product_geometry.angle_sub_eq_arcsin_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- An angle in a right-angled triangle expressed using `arcsin`, version subtracting vectors. -/
lemma oangle_sub_left_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle (x - y) x = real.arcsin (‖y‖ / ‖x - y‖) :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).oangle_sub_right_eq_arcsin_of_oangle_eq_pi_div_two h
end

/-- An angle in a right-angled triangle expressed using `arctan`, version subtracting vectors. -/
lemma oangle_sub_right_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle y (y - x) = real.arctan (‖x‖ / ‖y‖) :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs,
      inner_product_geometry.angle_sub_eq_arctan_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
        (o.right_ne_zero_of_oangle_eq_pi_div_two h)]
end

/-- An angle in a right-angled triangle expressed using `arctan`, version subtracting vectors. -/
lemma oangle_sub_left_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  o.oangle (x - y) x = real.arctan (‖y‖ / ‖x‖) :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).oangle_sub_right_eq_arctan_of_oangle_eq_pi_div_two h
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma cos_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.cos (o.oangle y (y - x)) = ‖y‖ / ‖y - x‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      inner_product_geometry.cos_angle_sub_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma cos_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.cos (o.oangle (x - y) x) = ‖x‖ / ‖x - y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).cos_oangle_sub_right_of_oangle_eq_pi_div_two h
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma sin_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.sin (o.oangle y (y - x)) = ‖x‖ / ‖y - x‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      inner_product_geometry.sin_angle_sub_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma sin_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.sin (o.oangle (x - y) x) = ‖y‖ / ‖x - y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).sin_oangle_sub_right_of_oangle_eq_pi_div_two h
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma tan_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.tan (o.oangle y (y - x)) = ‖x‖ / ‖y‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      inner_product_geometry.tan_angle_sub_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
lemma tan_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
  real.angle.tan (o.oangle (x - y) x) = ‖y‖ / ‖x‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).tan_oangle_sub_right_of_oangle_eq_pi_div_two h
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side, version subtracting vectors. -/
lemma cos_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle y (y - x)) * ‖y - x‖ = ‖y‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      inner_product_geometry.cos_angle_sub_mul_norm_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side, version subtracting vectors. -/
lemma cos_oangle_sub_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle (x - y) x) * ‖x - y‖ = ‖x‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).cos_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two h
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side, version subtracting vectors. -/
lemma sin_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle y (y - x)) * ‖y - x‖ = ‖x‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      inner_product_geometry.sin_angle_sub_mul_norm_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side, version subtracting vectors. -/
lemma sin_oangle_sub_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle (x - y) x) * ‖x - y‖ = ‖y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).sin_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two h
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side, version subtracting vectors. -/
lemma tan_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle y (y - x)) * ‖y‖ = ‖x‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      inner_product_geometry.tan_angle_sub_mul_norm_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side, version subtracting vectors. -/
lemma tan_oangle_sub_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle (x - y) x) * ‖x‖ = ‖y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).tan_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two h
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse, version subtracting vectors. -/
lemma norm_div_cos_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.cos (o.oangle y (y - x)) = ‖y - x‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      inner_product_geometry.norm_div_cos_angle_sub_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse, version subtracting vectors. -/
lemma norm_div_cos_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.cos (o.oangle (x - y) x) = ‖x - y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).norm_div_cos_oangle_sub_right_of_oangle_eq_pi_div_two h
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse, version subtracting vectors. -/
lemma norm_div_sin_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.sin (o.oangle y (y - x)) = ‖y - x‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      inner_product_geometry.norm_div_sin_angle_sub_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inr (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse, version subtracting vectors. -/
lemma norm_div_sin_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.sin (o.oangle (x - y) x) = ‖x - y‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).norm_div_sin_oangle_sub_right_of_oangle_eq_pi_div_two h
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side, version subtracting vectors. -/
lemma norm_div_tan_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.tan (o.oangle y (y - x)) = ‖y‖ :=
begin
  have hs : (o.oangle y (y - x)).sign = 1,
  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      inner_product_geometry.norm_div_tan_angle_sub_of_inner_eq_zero
        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
        (or.inr (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side, version subtracting vectors. -/
lemma norm_div_tan_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V}
  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.tan (o.oangle (x - y) x) = ‖x‖ :=
begin
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
  exact (-o).norm_div_tan_oangle_sub_right_of_oangle_eq_pi_div_two h
end

/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
of a rotation of another by `π / 2`. -/
lemma oangle_add_right_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
  o.oangle x (x + r • o.rotation (π / 2 : ℝ) x) = real.arctan r :=
begin
  rcases lt_trichotomy r 0 with hr | rfl | hr,
  { have ha : o.oangle x (r • o.rotation (π / 2 : ℝ) x) = -(π / 2 : ℝ),
    { rw [o.oangle_smul_right_of_neg _ _ hr, o.oangle_neg_right h,
          o.oangle_rotation_self_right h, ←sub_eq_zero, add_comm, sub_neg_eq_add,
          ←real.angle.coe_add, ←real.angle.coe_add, add_assoc, add_halves, ←two_mul,
          real.angle.coe_two_pi],
      simpa using h },
    rw [←neg_inj, ←oangle_neg_orientation_eq_neg, neg_neg] at ha,
    rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj, oangle_rev,
        (-o).oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two ha, norm_smul,
        linear_isometry_equiv.norm_map, mul_div_assoc, div_self (norm_ne_zero_iff.2 h), mul_one,
        real.norm_eq_abs, abs_of_neg hr, real.arctan_neg, real.angle.coe_neg, neg_neg] },
  { rw [zero_smul, add_zero, oangle_self, real.arctan_zero, real.angle.coe_zero] },
  { have ha : o.oangle x (r • o.rotation (π / 2 : ℝ) x) = (π / 2 : ℝ),
    { rw [o.oangle_smul_right_of_pos _ _ hr, o.oangle_rotation_self_right h] },
    rw [o.oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two ha, norm_smul,
        linear_isometry_equiv.norm_map, mul_div_assoc, div_self (norm_ne_zero_iff.2 h), mul_one,
        real.norm_eq_abs, abs_of_pos hr] }
end

/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
of a rotation of another by `π / 2`. -/
lemma oangle_add_left_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
  o.oangle (x + r • o.rotation (π / 2 : ℝ) x) (r • o.rotation (π / 2 : ℝ) x) = real.arctan r⁻¹ :=
begin
  by_cases hr : r = 0, { simp [hr] },
  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj,
      ←neg_neg ((π / 2 : ℝ) : real.angle), ←rotation_neg_orientation_eq_neg, add_comm],
  have hx : x = r⁻¹ • ((-o).rotation (π / 2 : ℝ) (r • ((-o).rotation (-(π / 2 : ℝ)) x))),
  { simp [hr] },
  nth_rewrite 2 hx,
  refine (-o).oangle_add_right_smul_rotation_pi_div_two _ _,
  simp [hr, h]
end

/-- The tangent of an angle in a right-angled triangle, where one side is a multiple of a
rotation of another by `π / 2`. -/
lemma tan_oangle_add_right_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
  real.angle.tan (o.oangle x (x + r • o.rotation (π / 2 : ℝ) x)) = r :=
by rw [o.oangle_add_right_smul_rotation_pi_div_two h, real.angle.tan_coe, real.tan_arctan]

/-- The tangent of an angle in a right-angled triangle, where one side is a multiple of a
rotation of another by `π / 2`. -/
lemma tan_oangle_add_left_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
  real.angle.tan (o.oangle (x + r • o.rotation (π / 2 : ℝ) x) (r • o.rotation (π / 2 : ℝ) x)) =
    r⁻¹ :=
by rw [o.oangle_add_left_smul_rotation_pi_div_two h, real.angle.tan_coe, real.tan_arctan]

/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
of a rotation of another by `π / 2`, version subtracting vectors. -/
lemma oangle_sub_right_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
  o.oangle (r • o.rotation (π / 2 : ℝ) x) (r • o.rotation (π / 2 : ℝ) x - x) = real.arctan r⁻¹ :=
begin
  by_cases hr : r = 0, { simp [hr] },
  have hx : -x = r⁻¹ • (o.rotation (π / 2 : ℝ) (r • (o.rotation (π / 2 : ℝ) x))),
  { simp [hr, ←real.angle.coe_add] },
  rw [sub_eq_add_neg, hx, o.oangle_add_right_smul_rotation_pi_div_two],
  simpa [hr] using h
end

/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
of a rotation of another by `π / 2`, version subtracting vectors. -/
lemma oangle_sub_left_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
  o.oangle (x - r • o.rotation (π / 2 : ℝ) x) x = real.arctan r :=
begin
  by_cases hr : r = 0, { simp [hr] },
  have hx : x = r⁻¹ • (o.rotation (π / 2 : ℝ) (-(r • (o.rotation (π / 2 : ℝ) x)))),
  { simp [hr, ←real.angle.coe_add] },
  rw [sub_eq_add_neg, add_comm],
  nth_rewrite 2 hx,
  nth_rewrite 1 hx,
  rw [o.oangle_add_left_smul_rotation_pi_div_two, inv_inv],
  simpa [hr] using h
end

end orientation

namespace euclidean_geometry

open finite_dimensional

variables {V : Type*} {P : Type*}
  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
include hd2

/-- An angle in a right-angled triangle expressed using `arccos`. -/
lemma oangle_right_eq_arccos_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  ∡ p₂ p₃ p₁ = real.arccos (dist p₃ p₂ / dist p₁ p₃) :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs,
      angle_eq_arccos_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- An angle in a right-angled triangle expressed using `arccos`. -/
lemma oangle_left_eq_arccos_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  ∡ p₃ p₁ p₂ = real.arccos (dist p₁ p₂ / dist p₁ p₃) :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm,
      angle_eq_arccos_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h),
      dist_comm p₁ p₃]
end

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
lemma oangle_right_eq_arcsin_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  ∡ p₂ p₃ p₁ = real.arcsin (dist p₁ p₂ / dist p₁ p₃) :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs,
      angle_eq_arcsin_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                             (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
end

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
lemma oangle_left_eq_arcsin_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  ∡ p₃ p₁ p₂ = real.arcsin (dist p₃ p₂ / dist p₁ p₃) :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm,
      angle_eq_arcsin_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                             (or.inr (left_ne_of_oangle_eq_pi_div_two h)),
      dist_comm p₁ p₃]
end

/-- An angle in a right-angled triangle expressed using `arctan`. -/
lemma oangle_right_eq_arctan_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  ∡ p₂ p₃ p₁ = real.arctan (dist p₁ p₂ / dist p₃ p₂) :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs,
      angle_eq_arctan_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                             (right_ne_of_oangle_eq_pi_div_two h)]
end

/-- An angle in a right-angled triangle expressed using `arctan`. -/
lemma oangle_left_eq_arctan_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  ∡ p₃ p₁ p₂ = real.arctan (dist p₃ p₂ / dist p₁ p₂) :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm,
      angle_eq_arctan_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                             (left_ne_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
lemma cos_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.cos (∡ p₂ p₃ p₁) = dist p₃ p₂ / dist p₁ p₃ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      cos_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
lemma cos_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.cos (∡ p₃ p₁ p₂) = dist p₁ p₂ / dist p₁ p₃ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.cos_coe,
      cos_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h),
      dist_comm p₁ p₃]
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
lemma sin_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.sin (∡ p₂ p₃ p₁) = dist p₁ p₂ / dist p₁ p₃ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      sin_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                       (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
end

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
lemma sin_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.sin (∡ p₃ p₁ p₂) = dist p₃ p₂ / dist p₁ p₃ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.sin_coe,
      sin_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                       (or.inr (left_ne_of_oangle_eq_pi_div_two h)),
      dist_comm p₁ p₃]
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
lemma tan_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.tan (∡ p₂ p₃ p₁) = dist p₁ p₂ / dist p₃ p₂ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      tan_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
lemma tan_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.tan (∡ p₃ p₁ p₂) = dist p₃ p₂ / dist p₁ p₂ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.tan_coe,
      tan_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
lemma cos_oangle_right_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.cos (∡ p₂ p₃ p₁) * dist p₁ p₃ = dist p₃ p₂ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      cos_angle_mul_dist_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
lemma cos_oangle_left_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.cos (∡ p₃ p₁ p₂) * dist p₁ p₃ = dist p₁ p₂ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.cos_coe, dist_comm p₁ p₃,
      cos_angle_mul_dist_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
lemma sin_oangle_right_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.sin (∡ p₂ p₃ p₁) * dist p₁ p₃ = dist p₁ p₂ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      sin_angle_mul_dist_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
lemma sin_oangle_left_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.sin (∡ p₃ p₁ p₂) * dist p₁ p₃ = dist p₃ p₂ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.sin_coe, dist_comm p₁ p₃,
      sin_angle_mul_dist_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
lemma tan_oangle_right_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.tan (∡ p₂ p₃ p₁) * dist p₃ p₂ = dist p₁ p₂ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      tan_angle_mul_dist_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inr (right_ne_of_oangle_eq_pi_div_two h))]
end

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
lemma tan_oangle_left_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  real.angle.tan (∡ p₃ p₁ p₂) * dist p₁ p₂ = dist p₃ p₂ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.tan_coe,
      tan_angle_mul_dist_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inr (left_ne_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
lemma dist_div_cos_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  dist p₃ p₂ / real.angle.cos (∡ p₂ p₃ p₁) = dist p₁ p₃ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
      dist_div_cos_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inr (right_ne_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
lemma dist_div_cos_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  dist p₁ p₂ / real.angle.cos (∡ p₃ p₁ p₂) = dist p₁ p₃ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.cos_coe, dist_comm p₁ p₃,
      dist_div_cos_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inr (left_ne_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
lemma dist_div_sin_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  dist p₁ p₂ / real.angle.sin (∡ p₂ p₃ p₁) = dist p₁ p₃ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
      dist_div_sin_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
lemma dist_div_sin_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  dist p₃ p₂ / real.angle.sin (∡ p₃ p₁ p₂) = dist p₁ p₃ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.sin_coe, dist_comm p₁ p₃,
      dist_div_sin_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inl (right_ne_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/
lemma dist_div_tan_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  dist p₁ p₂ / real.angle.tan (∡ p₂ p₃ p₁) = dist p₃ p₂ :=
begin
  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
      dist_div_tan_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
end

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/
lemma dist_div_tan_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
  dist p₃ p₂ / real.angle.tan (∡ p₃ p₁ p₂) = dist p₁ p₂ :=
begin
  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.tan_coe,
      dist_div_tan_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
                                                (or.inl (right_ne_of_oangle_eq_pi_div_two h))]
end

end euclidean_geometry