import pseudo_normed_group.profinitely_filtered
import prop_92.extension_profinite
import normed_group.normed_with_aut

import analysis.normed.group.hom_completion

import locally_constant.analysis

import tactic.ring_exp

import for_mathlib.nnreal

/-!
This file builds a concrete version of Proposition 9.2, with almost no category.
The exception is that `SemiNormedGroup` is used because this is expected in
`normed_with_aut` (we could easily get rid of this but this is very mild category theory hell).
There are two independent parts. The first one is all about locally constant maps from
compact spaces to seminormed groups. The next one forgets about locally constant functions
and does abstract normed space stuff.
-/

noncomputable theory

section
open finset
open_locale big_operators

-- Why can't I find this in mathlib?!?
lemma partial_sum_geom {r : ℝ} (hr : 0 ≤ r) (hr' : r < 1) (n : ℕ) : (∑ k in range n, r^k) = (1 - r^n)/(1 - r) :=
begin
  refine (eq_div_iff (sub_ne_zero.mpr hr'.ne')).mpr _,
  induction n with n ih,
  { simp },
  { rw [sum_range_succ, add_mul, ih],
    ring_exp }
end

-- Why can't I find this in mathlib?!?
lemma partial_sum_geom_le {r : ℝ} (hr : 0 ≤ r) (hr' : r < 1) (n : ℕ) : (∑ k in range n, r^k) ≤ 1/(1 - r) :=
begin
  rw partial_sum_geom hr hr',
  exact div_le_div zero_le_one (sub_le_self _ (pow_nonneg hr n)) (sub_pos.mpr hr') rfl.le,
end

lemma norm_sum_le_of_le_geom {α : Type*} [seminormed_add_comm_group α] {r C : ℝ} (hC : 0 ≤ C)
  (hr₀ : 0 ≤ r) (hr₁ : r < 1) {f : ℕ → α} (h : ∀ n, ∥f n∥ ≤ C*r^n) {n : ℕ} :
  ∥∑ k in range n, f k∥ ≤ C/(1-r) :=
begin
calc
  ∥∑ k in range n, f k∥ ≤ ∑ k in range n, ∥f k∥ : norm_sum_le _ _
    ... ≤ ∑ k in range n, C*r^k : sum_le_sum (λ k hk, h k)
  ... = C*(∑ k in range n, r^k) : by rw mul_sum
  ... ≤ C*(1/(1-r)) :  mul_le_mul_of_nonneg_left (partial_sum_geom_le hr₀ hr₁ n) hC
  ... = C/(1-r) : mul_one_div C (1 - r)
end

end

open set

@[simp]
lemma real.supr_zero (ι : Type*) : (⨆ i : ι, (0 : ℝ)) = 0 :=
begin
  rw supr,
  casesI is_empty_or_nonempty ι,
  { rw [set.range_eq_empty, real.Sup_empty] },
  { rw [set.range_const, cSup_singleton] },
end

-- Move me
lemma real.Sup_eq {s : set ℝ} (hs : s.nonempty) (hs' : ∃ x, ∀ y ∈ s, y ≤ x) {x : ℝ} :
  Sup s = x ↔ ∀ y, x ≤ y ↔ (∀ z ∈ s, z ≤ y) :=
begin
  classical,
  rw real.Sup_def,
  rw dif_pos,
  { let x₀ := classical.some (real.exists_is_lub s hs hs'),
    change x₀ = x ↔ _,
    have H : ∀ y, x₀ ≤ y ↔ ∀ z ∈ s, z ≤ y,
    { intros y,
      exact is_lub_le_iff (classical.some_spec (real.exists_is_lub s hs hs')) },
    split,
    { dsimp [x₀],
      rintro rfl,
      exact H },
    { intro h,
      replace H : ∀ y, x₀ ≤ y ↔ x ≤ y,
      { intro y,
        rw [h, H] },
      apply le_antisymm,
      { exact (H _).mpr (le_refl _) },
      { exact (H _).mp (le_refl _) } } },
  { exact ⟨hs, hs'⟩ }
end

-- Move me
lemma is_lub_iff {α : Type*} [preorder α] {s : set α} {x : α} :
  is_lub s x ↔ ∀ y, x ≤ y ↔ ∀ z ∈ s, z ≤ y :=
begin
  split,
  { rintros ⟨h₁, h₂⟩ y,
    exact ⟨λ hxy z z_in, (h₁ z_in).trans hxy, λ h, h₂ h⟩ },
  { intro H,
    exact ⟨λ y y_in, (H x).mp (le_refl x) y y_in, λ z hz, by rwa H⟩ }
end

-- Move me
lemma real.Sup_eq' {s : set ℝ} (hs : s.nonempty) (hs' : ∃ x, ∀ y ∈ s, y ≤ x) {x : ℝ} :
  Sup s = x ↔ (∀ y ∈ s, y ≤ x) ∧ ∀ z, (∀ y ∈ s, y ≤ z) → x ≤ z :=
begin
  rw real.Sup_eq hs hs',
  change _ ↔ is_lub _ _,
  rw is_lub_iff
end

lemma real.supr_comp {α β : Type*} (f : β → α) (g : α → ℝ) :
  (⨆ b, g (f b)) = Sup (g '' range f) :=
begin
  change Sup _ = _,
  congr,
  ext x,
  simp,
end

instance seminormed_add_comm_group.inhabited (G : Type*) [seminormed_add_comm_group G] : inhabited G := ⟨0⟩

section general_completion_stuff
open filter uniform_space
open_locale topological_space

-- Now we want an abstract machine where we can plug the sequence g from the previous section.

variables {M₁ : Type*} [seminormed_add_comm_group M₁] {M₂ : Type*} [seminormed_add_comm_group M₂]
          (f : normed_add_group_hom M₁ M₂)

-- PR very close to the definition of cauchy_seq
lemma cauchy_seq.map {β : Type*} [semilattice_sup β]
  {α : Type*} [uniform_space α] {γ : Type*} [uniform_space γ]
  {u : β → α} {f : α → γ} (hu : cauchy_seq u) (hf : uniform_continuous f) :
  cauchy_seq (f ∘ u) :=
begin
  change cauchy _,
  rw ← map_map,
  exact cauchy.map hu hf
end

-- actually not used here, but should go somewhere
lemma normed_add_group_hom.coe_range : (f.range : set M₂) = set.range f :=
by { erw add_monoid_hom.coe_range, refl }

open normed_add_comm_group

lemma bar {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε)
  (h : ∀ m₂ : M₂, ∃ g : ℕ → M₁, cauchy_seq g ∧ tendsto (f ∘ g) at_top (𝓝 m₂) ∧ ∀ n, ∥g n∥ ≤ C*∥m₂∥) :
  ∀ hatm₂ : completion M₂, ∃ m₁, f.completion m₁ = hatm₂ ∧ ∥m₁∥ ≤ (C+ε)*∥hatm₂∥ :=
begin
  intro hatm₂,
  refine controlled_closure_range_of_complete normed_add_comm_group.norm_to_compl hC hε _ _
    (normed_add_comm_group.dense_range_to_compl _),
  intro m₂,
  rcases h m₂ with ⟨g, cauchy_g, lim_g, bound_g⟩,
  have : cauchy_seq (to_compl ∘ g),
    from cauchy_g.map to_compl.uniform_continuous,
  rcases cauchy_seq_tendsto_of_complete this with ⟨y, hy⟩,
  refine ⟨y, _, _⟩,
  { have lim : tendsto ((f.completion.comp to_compl) ∘ g) at_top (𝓝 (f.completion y)),
      from (f.completion.continuous.tendsto _).comp hy,
    rw f.completion_to_compl at lim,
    have : tendsto ((to_compl ∘ f) ∘ g) at_top (𝓝 (to_compl m₂)) :=
      (to_compl.continuous.tendsto _).comp lim_g,
    exact tendsto_nhds_unique lim this },
  { refine le_of_tendsto' (tendsto_norm.comp hy) (_ : ∀ n, ∥to_compl (g n)∥ ≤ C * ∥m₂∥),
    intro n,
    rw normed_add_comm_group.norm_to_compl,
    apply bound_g }
end

end general_completion_stuff

section locally_constant_stuff
open topological_space normed_with_aut set
open_locale nnreal big_operators

local attribute [instance] locally_constant.seminormed_add_comm_group

/- Comment below indicate how this will be applied to Prop 9.2 -/
variables
  /- this will be M_{≤ r'c}^a -/
  {X : Type*} [topological_space X] [compact_space X]
  /- this will be M_{≤ c}^a -/
  {Y : Type*} [topological_space Y] [compact_space Y] [t2_space Y] [totally_disconnected_space Y]
  /- This will be inclusion -/
  {e : X → Y} (he : embedding e)
  /- This is used only for premilinary lemma not need the T action on V -/
  {G : Type*} [seminormed_add_comm_group G]

@[simp]
lemma locally_constant.norm_of_is_empty [is_empty X] (f : locally_constant X G) : ∥f∥ = 0 :=
by rw [locally_constant.norm_def, supr, range_eq_empty, real.Sup_empty]

@[simp]
lemma embedding.locally_constant_extend_of_empty (hX : ¬ nonempty X) (f : locally_constant X G) :
 he.locally_constant_extend f = 0 :=
begin
  ext y, dsimp [embedding.locally_constant_extend, embedding.extend],
  rw dif_neg,
  { refl },
  { intro h, exact hX h.2 }
end

@[simp]
lemma locally_constant.map_zero {Z : Type*} (g : G → Z) :
  (0 : locally_constant X G).map g = locally_constant.const X (g 0) :=
begin
  ext x,
  simp only [function.comp_app, locally_constant.map_apply, locally_constant.zero_apply],
  refl,
end

@[simp]
lemma locally_constant.norm_const [h : nonempty X] (g : G) : ∥locally_constant.const X g∥ = ∥g∥ :=
by simp only [locally_constant.norm_def, locally_constant.const, csupr_const,
    function.const_apply, locally_constant.coe_mk]

@[simp]
lemma locally_constant.norm_zero : ∥(0 : locally_constant X G)∥ = 0 :=
by simp only [locally_constant.norm_def, norm_zero, real.supr_zero, locally_constant.zero_apply]

@[simp]
lemma locally_constant.norm_const_zero : ∥locally_constant.const X (0 : G)∥ = 0 :=
locally_constant.norm_zero

-- Should go in mathlib topology/algebra/ordered, next to is_compast.exists_Sup_image_eq
lemma continuous.exists_forall_le_of_compact {X : Type*} [topological_space X] [compact_space X] [nonempty X]
{β : Type*} [conditionally_complete_linear_order β] [topological_space β] [order_topology β] {f : X → β}
(hf : continuous f) : ∃ x, Sup (range f) = f x :=
by simpa using compact_univ.exists_Sup_image_eq univ_nonempty hf.continuous_on

lemma locally_constant.exists_norm_eq [nonempty X] (f : locally_constant X G) : ∃ x, ∥f∥ = ∥f x∥ :=
(continuous_norm.comp f.continuous).exists_forall_le_of_compact

lemma locally_constant.norm_eq_iff (f : locally_constant X G) {x : X} :
  ∥f∥ = ∥f x∥ ↔ ∀ x', ∥f x'∥ ≤ ∥f x∥ :=
begin
  have fin_range : (range (λ (x : X), ∥f x∥)).finite,
  { rw range_comp,
    apply finite.image,
    exact f.range_finite },
  have bound : ∃ b, ∀ y ∈ range (λ (x : X), ∥f x∥), y ≤ b,
    from exists_upper_bound_image _ _ fin_range,
  rw [locally_constant.norm_def],
  split,
  { intros h x',
    rw ← h,
    exact le_cSup bound (mem_range_self _) } ,
  { intro h,
    erw real.Sup_eq _ bound,
    { intro y,
      rw forall_range_iff,
      split,
      { intros h' x',
        exact (h x').trans h' },
      { exact λ i, i x } },
    { exact ⟨∥f x∥, mem_range_self _⟩ } }
end

lemma locally_constant.norm_eq_iff' (f : locally_constant X G) {x : X} :
  ∥f∥ = ∥f x∥ ↔ ∀ g ∈ range f, ∥g∥ ≤ ∥f x∥ :=
by rw [forall_range_iff, locally_constant.norm_eq_iff]

lemma locally_constant.norm_comap_le {α : Type*} [topological_space α] [compact_space α]
  (f : locally_constant X G) {g : α → X} (h : continuous g) : ∥f.comap g∥ ≤ ∥f∥ :=
locally_constant.comap_hom_norm_noninc g h f

lemma locally_constant.comap_map {W X Y Z : Type*} [topological_space W] [topological_space X] [topological_space Y]
  (f : locally_constant X Y) (g : W → X) (h : Y → Z) (hg : continuous g) : (f.comap g).map h = (f.map h).comap g :=
by { ext, simp [hg] }

lemma locally_constant.map_comp' {W X Y Z : Type*} [topological_space W]
  (f : locally_constant W X) (g : X → Y) (h : Y → Z) : (f.map g).map h = f.map (h ∘ g) :=
rfl

lemma embedding.norm_extend (f : locally_constant X G) : ∥he.locally_constant_extend f∥ = ∥f∥ :=
begin
  casesI is_empty_or_nonempty X,
  { rw [f.norm_of_is_empty],
    dsimp [embedding.locally_constant_extend, embedding.extend],
    have hX : ¬ nonempty X, { rwa not_nonempty_iff },
    suffices : (⨆ (y : Y), ∥(0 : G)∥) = 0, { simpa only [hX, dif_neg, not_false_iff, and_false] },
    simp only [norm_zero, real.supr_zero] },
  { change (⨆ y : Y, _) = (⨆ x : X, _),
    rw [real.supr_comp, real.supr_comp, he.range_locally_constant_extend f] },
end

variables
  (φ : X → Y) -- this will be φ is T⁻¹ : M_{≤ r'c}^a → M_{≤ c}^a
  {r : ℝ≥0} {V : SemiNormedGroup} [normed_with_aut r V] -- this is indeed V!

include r

lemma locally_constant.norm_map_aut (g : locally_constant Y V) : ∥g.map T.hom∥ = r*∥g∥ :=
begin
  casesI is_empty_or_nonempty Y,
  { simp only [mul_zero, locally_constant.norm_of_is_empty] },
  { cases g.exists_norm_eq with y hy,
    erw [hy, ← norm_T, locally_constant.norm_eq_iff],
    intro y',
    erw [norm_T, norm_T],
    cases (eq_zero_or_pos : r = 0 ∨ 0 < r) with hr hr,
    { simp only [hr, nnreal.coe_zero, zero_mul] },
    { simp only [hr, ←hy, g.norm_apply_le, mul_le_mul_left, nnreal.coe_pos] } },
end

@[simp]
lemma normed_with_aut.T_inv_T_hom : (T.inv : V → V) ∘ T.hom = id :=
begin
  ext,
  simp,
end

open locally_constant
variables {φ} (hφ : continuous φ)

include hφ

noncomputable
def embedding.h (f : locally_constant X V) : ℕ → locally_constant Y V
| 0     := map_hom T.hom (he.locally_constant_extend f)
| (i+1) := map_hom T.hom (he.locally_constant_extend $ (comap_hom φ hφ $ embedding.h i))

variables (f : locally_constant X V)

lemma norm_h (i : ℕ) : ∥he.h hφ f i∥ ≤ r^(i+1)*∥f∥ :=
begin
  induction i with i ih ; dsimp [embedding.h],
  { rw [locally_constant.norm_map_aut, he.norm_extend, zero_add, pow_one] },
  { rw [locally_constant.norm_map_aut, he.norm_extend, pow_succ, mul_assoc],
    exact mul_le_mul_of_nonneg_left (((he.h hφ f i).norm_comap_le hφ).trans ih) r.coe_nonneg },
end

open finset

def embedding.g (f : locally_constant X V) (N : ℕ) : locally_constant Y V :=
∑ i in range (N + 1), he.h hφ f i

/-- T⁻¹ g_N e - g_N φ = f - h_N φ-/
lemma one (hφ : continuous φ) (N : ℕ) :
  map_hom T.inv (comap_hom e he.continuous (he.g hφ f N)) - (comap_hom φ hφ (he.g hφ f N)) =
  f - comap_hom φ hφ (he.h hφ f N) :=
begin
  induction N with N ih,
  { dsimp [embedding.g],
    simp only [embedding.h, finset.sum_singleton, sub_left_inj],
    ext x,
    simp [he.continuous, he.locally_constant_extend_extends] },
  { set c_φ : normed_add_group_hom (locally_constant Y V) (locally_constant X V) := comap_hom φ hφ,
    set c_e : normed_add_group_hom (locally_constant Y V) (locally_constant X V) := comap_hom e he.continuous,
    set m_T : normed_add_group_hom (locally_constant X V) (locally_constant X V) := map_hom T.inv,
    set G := he.g hφ f,
    set H := he.h hφ f,
    change m_T _ - _ = _,
    rw sub_eq_iff_eq_add at ih,
    dsimp [embedding.g, embedding.h],
    change m_T (c_e ∑ i in range (N.succ + 1), H i) -
      c_φ ∑ i in range (N.succ + 1), H i = _,
    erw [finset.sum_range_succ, map_add, map_add, map_add, ih],
    change f - c_φ (H N) + c_φ (G N) + m_T (c_e (H N.succ)) - (c_φ (G N) + c_φ (H N.succ)) =  f - comap φ (H N.succ),
    dsimp [H, embedding.h],
    rw [← (he.locally_constant_extend $ comap φ $ H N).comap_map  e T.hom he.continuous,
        he.comap_locally_constant_extend, locally_constant.map_comp', normed_with_aut.T_inv_T_hom],
    simp [H],
    abel },
end

open filter
open_locale topological_space

variables [fact ((r : ℝ) < 1)]

lemma limit : tendsto (λ N, map_hom T.inv (comap_hom e he.continuous (he.g hφ f N)) - (comap_hom φ hφ (he.g hφ f N))) at_top (𝓝 f) :=
begin
  simp_rw one,
  rw show 𝓝 f = 𝓝 (f - 0), by simp,
  refine tendsto_const_nhds.sub _,
  apply squeeze_zero_norm,
  intro n,
  apply ((he.h hφ f n).norm_comap_le hφ).trans (norm_h he hφ _ _),
  rw ← zero_mul (∥f∥),
  apply tendsto.mul_const,
  rw tendsto_add_at_top_iff_nat,
  exact tendsto_pow_at_top_nhds_0_of_lt_1 r.coe_nonneg (fact.out _)
end

lemma cauchy_seq_g : cauchy_seq (he.g hφ f) :=
begin
  apply cauchy_seq_of_le_geometric r (r^2*∥f∥) (fact.out _),
  intro n,
  dsimp [embedding.g],
  rw [dist_eq_norm, sum_range_succ _ (n+1), sub_add_eq_sub_sub, sub_self, zero_sub, norm_neg],
  convert norm_h he hφ f (n+1) using 1,
  ring_exp
end

lemma norm_g_le (N : ℕ) : ∥he.g hφ f N∥ ≤ r/(1 - r) * ∥f∥ :=
begin
  have : ∀ (n : ℕ), ∥he.h hφ f n∥ ≤ r * ∥f∥ * r ^ n,
  { intro n,
    convert norm_h he hφ f n using 1,
    ring_exp },
  convert norm_sum_le_of_le_geom (mul_nonneg r.coe_nonneg $ norm_nonneg f) r.coe_nonneg (fact.out _) this using 1,
  exact div_mul_eq_mul_div _ _ _,
end

open uniform_space

lemma concrete_92 [fact (0 < r)] (f : completion (locally_constant X V)) {ε : ℝ} (hε : 0 < ε) :
  ∃ g : completion (locally_constant Y V),
    ((map_hom T.inv).comp (comap_hom e he.continuous) - comap_hom φ hφ).completion g = f ∧
    ∥g∥ ≤ (r/(1-r) + ε)*∥f∥ :=
begin
  have : (0 : ℝ) < r / (1 - r),
  { have : 0 < r := fact.out _,
    apply div_pos,
    { exact_mod_cast this },
    { exact sub_pos.mpr (fact.out _) } },
  apply bar _ this hε,
  intro m₂,
  exact ⟨he.g hφ m₂, cauchy_seq_g he hφ m₂, limit he hφ m₂, norm_g_le he hφ m₂⟩
end

end locally_constant_stuff


/- Généralisation du théorème démontré dans pointwise_convergence.lean à n'importe quelle topologie engendrée.
Le cas de la topologie produit est redemontré comme un exemple à la fin du fichier. -/

import tactic
import data.set.finite

import topological_spaces
import neighbourhoods
import topological_spaces2

open set

open_locale classical

open topological_space

class open_generators (X : Type) :=
  (s : set (set X))

instance generated_topological_space {X : Type} [G : open_generators X] : topological_space X :=
  generate_from X G.s

lemma seq_lim_generated_iff {X : Type} [G : open_generators X] (u : ℕ → X) (l : X)  :
seq_lim u l ↔ ∀ g ∈ G.s, l ∈ g → ∃ (N : ℕ), ∀ n ≥ N, u n ∈ g :=
begin
  split,
  { intro hyp,
    intros g hgG hlg,
    cases hyp g (generated_filter.generator g ⟨_, hlg⟩) with N hN,
    use N,
    intros n hn,
    exact hN n hn,
    apply generated_open.generator,
    exact hgG, },
  { intro hyp,
    have clef : ∀ U, (generated_open X G.s) U → l ∈ U → ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → u n ∈ U,
    { intros U hU hlU,
      { induction hU with g hg a b ha1 hb1 ha2 hb2 C hC1 hC2,
        { cases hyp g hg hlU with N hN,
          use N, intros n hn,
          exact hN n hn, },
        { cases ha2 hlU.1 with N1 hN1,
          cases hb2 hlU.2 with N2 hN2,
          use (max N1 N2),
          intros n hn,
          have hn1 :=
          calc n ≥ max N1 N2 : hn
             ... ≥ N1        : by linarith [le_max_left N1 N2],
          have hn2 :=
          calc n ≥ max N1 N2 : hn
             ... ≥ N2        : by linarith [le_max_right N1 N2],
          exact ⟨hN1 n hn1, hN2 n hn2⟩, },
        { simp at hC2,
          rcases hlU with ⟨ c, hc, hlc⟩,
          cases hC2 c hc hlc with N hN,
          use N, intros n hn,
          use [c, hc, hN n hn], },
        { simp, }, }, },
    intros v hv,
    rcases (is_neighbourhood_iff l).1 hv with ⟨U, hU, hlU, hUv⟩,
    cases clef U hU hlU with N hN,
    use N, intros n hn,
    exact hUv (hN n hn), },
end

-- Convergence simple :
def pointwise_lim {X Y : Type} [topological_space Y] (f : ℕ → (X → Y)) (F : X → Y) : Prop :=
∀ (x : X), seq_lim (λ n, f n x) (F x)

-- Topologie produit sur X → Y :
instance fnct.open_generators (X Y : Type) [topological_space Y] : open_generators (X → Y) :=
  { s := {U | ∃ (x : X) (Ux : set Y) (hUx : is_open Ux), U = {f : X → Y | f x ∈ Ux}} }

example {X Y : Type} [topological_space Y] (f : ℕ → (X → Y)) (F : X → Y) :
pointwise_lim f F ↔ seq_lim f F :=
begin
  rw seq_lim_generated_iff,
  split,
  { intro hyp,
    intros g hg hFg,
    rcases hg with ⟨x, Ux, hUx, hg⟩,
    have hUx2 : Ux ∈ neighbourhoods (F x),
    { rw hg at hFg,
      exact generated_filter.generator Ux ⟨hUx, hFg⟩, },
    cases hyp x Ux hUx2 with N hN,
    use N, intros n hn,
    rw hg,
    exact hN n hn, },
  { intro hyp,
    intros x Vx hVx,
    rcases (is_neighbourhood_iff (F x)).1 hVx with ⟨Ux, hUx, hlUx, hUxVx⟩,
    cases hyp {g : X → Y | g x ∈ Ux} (by use [x, Ux, hUx]) hlUx with N hN,
    use N, intros n hn,
    exact hUxVx (hN n hn), },
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.basic
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Projection to a subspace

In this file we define
* `linear_proj_of_is_compl (p q : submodule R E) (h : is_compl p q)`: the projection of a module `E`
  to a submodule `p` along its complement `q`; it is the unique linear map `f : E → p` such that
  `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`.
* `is_compl_equiv_proj p`: equivalence between submodules `q` such that `is_compl p q` and
  projections `f : E → p`, `∀ x ∈ p, f x = x`.

We also provide some lemmas justifying correctness of our definitions.

## Tags

projection, complement subspace
-/

namespace linear_map

theorem ker_id_sub_eq_of_proj {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E] [module R E]
    {p : submodule R E} {f : linear_map R E ↥p} (hf : ∀ (x : ↥p), coe_fn f ↑x = x) :
    ker (id - comp (submodule.subtype p) f) = p :=
  sorry

theorem range_eq_of_proj {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E] [module R E]
    {p : submodule R E} {f : linear_map R E ↥p} (hf : ∀ (x : ↥p), coe_fn f ↑x = x) : range f = ⊤ :=
  iff.mpr range_eq_top fun (x : ↥p) => Exists.intro (↑x) (hf x)

theorem is_compl_of_proj {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E] [module R E]
    {p : submodule R E} {f : linear_map R E ↥p} (hf : ∀ (x : ↥p), coe_fn f ↑x = x) :
    is_compl p (ker f) :=
  sorry

end linear_map

namespace submodule

/-- If `q` is a complement of `p`, then `M/p ≃ q`. -/
def quotient_equiv_of_is_compl {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E]
    [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q) :
    linear_equiv R (quotient p) ↥q :=
  linear_equiv.symm
    (linear_equiv.of_bijective (linear_map.comp (mkq p) (submodule.subtype q)) sorry sorry)

@[simp] theorem quotient_equiv_of_is_compl_symm_apply {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    (x : ↥q) : coe_fn (linear_equiv.symm (quotient_equiv_of_is_compl p q h)) x = quotient.mk ↑x :=
  rfl

@[simp] theorem quotient_equiv_of_is_compl_apply_mk_coe {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    (x : ↥q) : coe_fn (quotient_equiv_of_is_compl p q h) (quotient.mk ↑x) = x :=
  linear_equiv.apply_symm_apply (quotient_equiv_of_is_compl p q h) x

@[simp] theorem mk_quotient_equiv_of_is_compl_apply {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    (x : quotient p) : quotient.mk ↑(coe_fn (quotient_equiv_of_is_compl p q h) x) = x :=
  linear_equiv.symm_apply_apply (quotient_equiv_of_is_compl p q h) x

/-- If `q` is a complement of `p`, then `p × q` is isomorphic to `E`. It is the unique
linear map `f : E → p` such that `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`. -/
def prod_equiv_of_is_compl {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E] [module R E]
    (p : submodule R E) (q : submodule R E) (h : is_compl p q) : linear_equiv R (↥p × ↥q) E :=
  linear_equiv.of_bijective (linear_map.coprod (submodule.subtype p) (submodule.subtype q)) sorry
    sorry

@[simp] theorem coe_prod_equiv_of_is_compl {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E]
    [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q) :
    ↑(prod_equiv_of_is_compl p q h) =
        linear_map.coprod (submodule.subtype p) (submodule.subtype q) :=
  rfl

@[simp] theorem coe_prod_equiv_of_is_compl' {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    (x : ↥p × ↥q) : coe_fn (prod_equiv_of_is_compl p q h) x = ↑(prod.fst x) + ↑(prod.snd x) :=
  rfl

@[simp] theorem prod_equiv_of_is_compl_symm_apply_left {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    (x : ↥p) : coe_fn (linear_equiv.symm (prod_equiv_of_is_compl p q h)) ↑x = (x, 0) :=
  sorry

@[simp] theorem prod_equiv_of_is_compl_symm_apply_right {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    (x : ↥q) : coe_fn (linear_equiv.symm (prod_equiv_of_is_compl p q h)) ↑x = (0, x) :=
  sorry

@[simp] theorem prod_equiv_of_is_compl_symm_apply_fst_eq_zero {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    {x : E} : prod.fst (coe_fn (linear_equiv.symm (prod_equiv_of_is_compl p q h)) x) = 0 ↔ x ∈ q :=
  sorry

@[simp] theorem prod_equiv_of_is_compl_symm_apply_snd_eq_zero {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E) (q : submodule R E) (h : is_compl p q)
    {x : E} : prod.snd (coe_fn (linear_equiv.symm (prod_equiv_of_is_compl p q h)) x) = 0 ↔ x ∈ p :=
  sorry

/-- Projection to a submodule along its complement. -/
def linear_proj_of_is_compl {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E] [module R E]
    (p : submodule R E) (q : submodule R E) (h : is_compl p q) : linear_map R E ↥p :=
  linear_map.comp (linear_map.fst R ↥p ↥q) ↑(linear_equiv.symm (prod_equiv_of_is_compl p q h))

@[simp] theorem linear_proj_of_is_compl_apply_left {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q)
    (x : ↥p) : coe_fn (linear_proj_of_is_compl p q h) ↑x = x :=
  sorry

@[simp] theorem linear_proj_of_is_compl_range {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q) :
    linear_map.range (linear_proj_of_is_compl p q h) = ⊤ :=
  linear_map.range_eq_of_proj (linear_proj_of_is_compl_apply_left h)

@[simp] theorem linear_proj_of_is_compl_apply_eq_zero_iff {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q)
    {x : E} : coe_fn (linear_proj_of_is_compl p q h) x = 0 ↔ x ∈ q :=
  sorry

theorem linear_proj_of_is_compl_apply_right' {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q)
    (x : E) (hx : x ∈ q) : coe_fn (linear_proj_of_is_compl p q h) x = 0 :=
  iff.mpr (linear_proj_of_is_compl_apply_eq_zero_iff h) hx

@[simp] theorem linear_proj_of_is_compl_apply_right {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q)
    (x : ↥q) : coe_fn (linear_proj_of_is_compl p q h) ↑x = 0 :=
  linear_proj_of_is_compl_apply_right' h (↑x) (subtype.property x)

@[simp] theorem linear_proj_of_is_compl_ker {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q) :
    linear_map.ker (linear_proj_of_is_compl p q h) = q :=
  ext fun (x : E) => iff.trans linear_map.mem_ker (linear_proj_of_is_compl_apply_eq_zero_iff h)

theorem linear_proj_of_is_compl_comp_subtype {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q) :
    linear_map.comp (linear_proj_of_is_compl p q h) (submodule.subtype p) = linear_map.id :=
  linear_map.ext (linear_proj_of_is_compl_apply_left h)

theorem linear_proj_of_is_compl_idempotent {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E]
    [module R E] {p : submodule R E} {q : submodule R E} (h : is_compl p q) (x : E) :
    coe_fn (linear_proj_of_is_compl p q h) ↑(coe_fn (linear_proj_of_is_compl p q h) x) =
        coe_fn (linear_proj_of_is_compl p q h) x :=
  linear_proj_of_is_compl_apply_left h (coe_fn (linear_proj_of_is_compl p q h) x)

end submodule

namespace linear_map

@[simp] theorem linear_proj_of_is_compl_of_proj {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {p : submodule R E} (f : linear_map R E ↥p)
    (hf : ∀ (x : ↥p), coe_fn f ↑x = x) :
    submodule.linear_proj_of_is_compl p (ker f) (is_compl_of_proj hf) = f :=
  sorry

/-- If `f : E →ₗ[R] F` and `g : E →ₗ[R] G` are two surjective linear maps and
their kernels are complement of each other, then `x ↦ (f x, g x)` defines
a linear equivalence `E ≃ₗ[R] F × G`. -/
def equiv_prod_of_surjective_of_is_compl {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E]
    [module R E] {F : Type u_3} [add_comm_group F] [module R F] {G : Type u_4} [add_comm_group G]
    [module R G] (f : linear_map R E F) (g : linear_map R E G) (hf : range f = ⊤) (hg : range g = ⊤)
    (hfg : is_compl (ker f) (ker g)) : linear_equiv R E (F × G) :=
  linear_equiv.of_bijective (prod f g) sorry sorry

@[simp] theorem coe_equiv_prod_of_surjective_of_is_compl {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {F : Type u_3} [add_comm_group F] [module R F] {G : Type u_4}
    [add_comm_group G] [module R G] {f : linear_map R E F} {g : linear_map R E G} (hf : range f = ⊤)
    (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) :
    ↑(equiv_prod_of_surjective_of_is_compl f g hf hg hfg) = prod f g :=
  rfl

@[simp] theorem equiv_prod_of_surjective_of_is_compl_apply {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] {F : Type u_3} [add_comm_group F] [module R F] {G : Type u_4}
    [add_comm_group G] [module R G] {f : linear_map R E F} {g : linear_map R E G} (hf : range f = ⊤)
    (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) (x : E) :
    coe_fn (equiv_prod_of_surjective_of_is_compl f g hf hg hfg) x = (coe_fn f x, coe_fn g x) :=
  rfl

end linear_map

namespace submodule

/-- Equivalence between submodules `q` such that `is_compl p q` and linear maps `f : E →ₗ[R] p`
such that `∀ x : p, f x = x`. -/
def is_compl_equiv_proj {R : Type u_1} [ring R] {E : Type u_2} [add_comm_group E] [module R E]
    (p : submodule R E) :
    (Subtype fun (q : submodule R E) => is_compl p q) ≃
        Subtype fun (f : linear_map R E ↥p) => ∀ (x : ↥p), coe_fn f ↑x = x :=
  equiv.mk
    (fun (q : Subtype fun (q : submodule R E) => is_compl p q) =>
      { val := linear_proj_of_is_compl p ↑q sorry, property := sorry })
    (fun (f : Subtype fun (f : linear_map R E ↥p) => ∀ (x : ↥p), coe_fn f ↑x = x) =>
      { val := linear_map.ker ↑f, property := sorry })
    sorry sorry

@[simp] theorem coe_is_compl_equiv_proj_apply {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E)
    (q : Subtype fun (q : submodule R E) => is_compl p q) :
    ↑(coe_fn (is_compl_equiv_proj p) q) = linear_proj_of_is_compl p (↑q) (subtype.property q) :=
  rfl

@[simp] theorem coe_is_compl_equiv_proj_symm_apply {R : Type u_1} [ring R] {E : Type u_2}
    [add_comm_group E] [module R E] (p : submodule R E)
    (f : Subtype fun (f : linear_map R E ↥p) => ∀ (x : ↥p), coe_fn f ↑x = x) :
    ↑(coe_fn (equiv.symm (is_compl_equiv_proj p)) f) = linear_map.ker ↑f :=
  rfl

end Mathlib


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.linear
import category_theory.limits.shapes.biproducts
import linear_algebra.matrix.invariant_basis_number

/-!
# Hom orthogonal families.

A family of objects in a category with zero morphisms is "hom orthogonal" if the only
morphism between distinct objects is the zero morphism.

We show that in any category with zero morphisms and finite biproducts,
a morphism between biproducts drawn from a hom orthogonal family `s : ι → C`
can be decomposed into a block diagonal matrix with entries in the endomorphism rings of the `s i`.

When the category is preadditive, this decomposition is an additive equivalence,
and intertwines composition and matrix multiplication.
When the category is `R`-linear, the decomposition is an `R`-linear equivalence.

If every object in the hom orthogonal family has an endomorphism ring with invariant basis number
(e.g. if each object in the family is simple, so its endomorphism ring is a division ring,
or otherwise if each endomorphism ring is commutative),
then decompositions of an object as a biproduct of the family have uniquely defined multiplicities.
We state this as:
```
lemma hom_orthogonal.equiv_of_iso (o : hom_orthogonal s) {f : α → ι} {g : β → ι}
  (i : ⨁ (λ a, s (f a)) ≅ ⨁ (λ b, s (g b))) : ∃ e : α ≃ β, ∀ a, g (e a) = f a
```

This is preliminary to defining semisimple categories.
-/

open_locale classical matrix

open category_theory.limits

universes v u

namespace category_theory

variables {C : Type u} [category.{v} C]

/-- A family of objects is "hom orthogonal" if
there is at most one morphism between distinct objects.

(In a category with zero morphisms, that must be the zero morphism.) -/
def hom_orthogonal {ι : Type*} (s : ι → C) : Prop :=
∀ i j, i ≠ j → subsingleton (s i ⟶ s j)

namespace hom_orthogonal

variables {ι : Type*} {s : ι → C}

lemma eq_zero [has_zero_morphisms C] (o : hom_orthogonal s)
  {i j : ι} (w : i ≠ j) (f : s i ⟶ s j) : f = 0 :=
by { haveI := o i j w, apply subsingleton.elim, }

section
variables [has_zero_morphisms C] [has_finite_biproducts C]

/-- Morphisms between two direct sums over a hom orthogonal family `s : ι → C`
are equivalent to block diagonal matrices,
with blocks indexed by `ι`,
and matrix entries in `i`-th block living in the endomorphisms of `s i`. -/
@[simps] noncomputable
def matrix_decomposition
  (o : hom_orthogonal s) {α β : Type*} [fintype α] [fintype β] {f : α → ι} {g : β → ι} :
  (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃
    Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) :=
{ to_fun := λ z i j k,
    eq_to_hom (by { rcases k with ⟨k, ⟨⟩⟩, simp, }) ≫
      biproduct.components z k j ≫ eq_to_hom (by { rcases j with ⟨j, ⟨⟩⟩, simp, }),
  inv_fun := λ z, biproduct.matrix (λ j k, if h : f j = g k then
      z (f j) ⟨k, by simp [h]⟩ ⟨j, by simp⟩ ≫ eq_to_hom (by simp [h])
    else
      0),
  left_inv := λ z, begin
    ext j k,
    simp only [category.assoc, biproduct.lift_π, biproduct.ι_matrix],
    split_ifs,
    { simp, refl, },
    { symmetry, apply o.eq_zero h, },
  end,
  right_inv := λ z, begin
    ext i ⟨j, w⟩ ⟨k, ⟨⟩⟩,
    simp only [set.mem_preimage, set.mem_singleton_iff],
    simp [w.symm], refl,
  end, }

end

section
variables [preadditive C] [has_finite_biproducts C]

/-- `hom_orthogonal.matrix_decomposition` as an additive equivalence. -/
@[simps] noncomputable
def matrix_decomposition_add_equiv
  (o : hom_orthogonal s) {α β : Type*} [fintype α] [fintype β] {f : α → ι} {g : β → ι} :
  (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃+
    Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) :=
{ map_add' := λ w z, by { ext, dsimp [biproduct.components], simp, },
  ..o.matrix_decomposition, }.

@[simp]
lemma matrix_decomposition_id
  (o : hom_orthogonal s) {α : Type*} [fintype α] {f : α → ι} (i : ι) :
  o.matrix_decomposition (𝟙 (⨁ (λ a, s (f a)))) i = 1 :=
begin
  ext ⟨b, ⟨⟩⟩ ⟨a⟩,
  simp only [set.mem_preimage, set.mem_singleton_iff] at j_property,
  simp only [category.comp_id, category.id_comp, category.assoc, End.one_def, eq_to_hom_refl,
    matrix.one_apply, hom_orthogonal.matrix_decomposition_apply, biproduct.components],
  split_ifs with h,
  { cases h, simp, },
  { convert comp_zero,
    simpa using biproduct.ι_π_ne _ (ne.symm h), },
end

lemma matrix_decomposition_comp
  (o : hom_orthogonal s)
  {α β γ : Type*} [fintype α] [fintype β] [fintype γ] {f : α → ι} {g : β → ι} {h : γ → ι}
  (z : (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b)))) (w : (⨁ (λ b, s (g b)) ⟶ ⨁ (λ c, s (h c))))
  (i : ι) :
  o.matrix_decomposition (z ≫ w) i = o.matrix_decomposition w i ⬝ o.matrix_decomposition z i :=
begin
  ext ⟨c, ⟨⟩⟩ ⟨a⟩,
  simp only [set.mem_preimage, set.mem_singleton_iff] at j_property,
  simp only [matrix.mul_apply, limits.biproduct.components,
    hom_orthogonal.matrix_decomposition_apply,
    category.comp_id, category.id_comp, category.assoc, End.mul_def,
    eq_to_hom_refl, eq_to_hom_trans_assoc, finset.sum_congr],
  conv_lhs { rw [←category.id_comp w, ←biproduct.total], },
  simp only [preadditive.sum_comp, preadditive.comp_sum],
  apply finset.sum_congr_set,
  { intros, simp, refl, },
  { intros b nm,
    simp only [set.mem_preimage, set.mem_singleton_iff] at nm,
    simp only [category.assoc],
    convert comp_zero,
    convert comp_zero,
    convert comp_zero,
    convert comp_zero,
    apply o.eq_zero nm, },
end

section
variables {R : Type*} [semiring R] [linear R C]

/-- `hom_orthogonal.matrix_decomposition` as an `R`-linear equivalence. -/
@[simps] noncomputable
def matrix_decomposition_linear_equiv
(o : hom_orthogonal s)
  {α β : Type*} [fintype α] [fintype β] {f : α → ι} {g : β → ι} :
  (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃ₗ[R]
    Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) :=
{ map_smul' := λ w z, by { ext, dsimp [biproduct.components], simp, },
  ..o.matrix_decomposition_add_equiv, }

end

/-!
The hypothesis that `End (s i)` has invariant basis number is automatically satisfied
if `s i` is simple (as then `End (s i)` is a division ring).
-/
variables [∀ i, invariant_basis_number (End (s i))]

/--
Given a hom orthogonal family `s : ι → C`
for which each `End (s i)` is a ring with invariant basis number (e.g. if each `s i` is simple),
if two direct sums over `s` are isomorphic, then they have the same multiplicities.
-/
lemma equiv_of_iso (o : hom_orthogonal s)
  {α β : Type*} [fintype α] [fintype β] {f : α → ι} {g : β → ι}
  (i : ⨁ (λ a, s (f a)) ≅ ⨁ (λ b, s (g b))) :
  ∃ e : α ≃ β, ∀ a, g (e a) = f a :=
begin
  refine ⟨equiv.of_preimage_equiv _, λ a, equiv.of_preimage_equiv_map _ _⟩,
  intro c,
  apply nonempty.some,
  apply cardinal.eq.1,
  simp only [cardinal.mk_fintype, nat.cast_inj],
  exact matrix.square_of_invertible
    (o.matrix_decomposition i.inv c) (o.matrix_decomposition i.hom c)
    (by { rw ←o.matrix_decomposition_comp, simp, })
    (by { rw ←o.matrix_decomposition_comp, simp, })
end

end

end hom_orthogonal

end category_theory


import tactic
/-
 WWW
WABCW
WDEFW
WGHIW
 WWW

and secret room J

-- start in room A
-- have to find the secret and get to room J
-- W is a temp wall room which we never go into.

Can people write computer programs in Lean which solve
levels like this?

Can people write computer programs in Python which design
levels like this?

The below is Lean 3 code.
Can stuff like this be made to work in Lean 4? I have
Lean 4 working on my laptop, it's usable, but you have
to learn the emacs interface. Is there any way to make
this easier for people wanting to transition from VS Code?
-/

/-- Solver docs : Terms of type `maze` are rooms in the game. -/
inductive maze : Type
| A /- start -/
| B | C | D | E | F | G | H | I -- other rooms
| J -- exit room
| W /- temp wall term for when a player hits a wall-/

@[derive has_reflect]
inductive direction : Type
| north | east | south | west

namespace maze

/-
ABC
DEF
GHI
-/

/-- This is basically the map of the maze -/
def go (d : direction) (m : maze) : maze :=
direction.rec_on d
  (maze.rec_on m W W W A B C D E F J W)
  (maze.rec_on m B C W E F W H I W J W)
  (maze.rec_on m D E F G H I W W W J W)
  (maze.rec_on m W A B W D E W J H J W)

/-- The predicate of being able to escape from the maze -/
inductive can_escape : maze → Prop
| exit : can_escape J
| go : ∀ d x, can_escape (go d x) → can_escape x

end maze

open maze direction

open tactic

meta def go (d : direction) : tactic unit :=
`[apply can_escape.go %%d, unfold maze.go,
fail_if_success { guard_target can_escape W } <|> fail "You hit a wall!" ]

meta def tactic.interactive.n := `[go north]
meta def tactic.interactive.s := `[go south]
meta def tactic.interactive.e := `[go east]
meta def tactic.interactive.w := `[go west]

open tactic

meta def out : tactic unit :=
`[apply can_escape.exit <|> fail "you are not at the exit level J"]

-- theorem solve : can_escape A :=
-- begin
--   s,
--   sorry,
-- end

-- I have no solver
-- meta def xyzzy : tactic unit := sorry
-- --`[ {e,n,e,e,out} <|> {n,e,e,out} <|> {e,e,out} <|> {e,out} <|> {out} ]


import Euclid.tarski_4
open classical set
namespace Euclidean_plane
variables {point : Type} [Euclidean_plane point]

local attribute [instance] prop_decidable

-- Line Reflections

noncomputable def mid (a b : point) : point := classical.some (eight22 a b)

theorem ten1 (a b : point) : M a (mid a b) b := (classical.some_spec (eight22 a b)).1

@[simp] theorem mid.refl (a : point) : mid a a = a := (seven3.1 $ ten1 a a).symm

theorem mid.symm (a b : point) : mid a b = mid b a := seven17 (ten1 a b) (ten1 b a).symm

@[simp] theorem mid_to_Sa (a b : point) : S (mid a b) a = b := (seven6 $ ten1 a b).symm

@[simp] theorem mid_to_Sb (a b : point) : S (mid a b) b = a := mid.symm b a ▸ mid_to_Sa b a

@[simp] theorem mid_of_S (a b : point) : mid b (S a b) = a := seven17 (ten1 b (S a b)) (seven5 a b)

theorem mid.neq {a b : point} : a ≠ b → mid a b ≠ a := --λ h h1, h ((seven11 a) ▸ h1 ▸ mid_to_Sa a b)
begin
intros h h1,
apply h,
suffices : eqd (mid a b) a (mid a b) b,
  rw h1 at this,
  exact id_eqd this.symm,
exact (ten1 a b).2
end

theorem ten2 {p : point} {A : set point} (h : line A) (h_1 : p ∉ A) : ∃! q, mid p q ∈ A ∧ perp A (l p q) :=
begin
rcases h with ⟨a, b, h₁, h₂⟩,
rw h₂ at *,
cases eight18 (six14 h₁) h_1 with x hx,
apply exists_unique.intro (S x p),
  split,
    rw seven17 (ten1 p (S x p)) (seven5 x p),
    exact hx.1.1,
  apply (eight14f hx.1.2.symm (or.inl (seven5 x p).1) _).symm,
  intro h_2,
  have h1 : p = x := seven10.1 h_2.symm,
  subst x,
  exact h_1 hx.1.1,
intros y hy,
have h1 : p ≠ y,
  intro h_2,
  rw [←h_2, mid.refl p] at hy,
  exact h_1 hy.1,
have h2 := ten1 p y,
have h3 : mid p y = x,
  apply hx.2,
  refine ⟨hy.1,_⟩,
  suffices : l p y = l p (mid p y),
    rw ←this,
    exact hy.2,
  apply six18 (six14 h1),
      intro h_2,
      rw ←h_2 at h2,
      exact h1 (id_eqd h2.2.symm),
    simp,
  right, left,
  exact h2.1.symm,
rw h3 at *,
exact unique_of_exists_unique (seven4 x p) h2 (seven5 x p)
end

noncomputable def Sl {A : set point} (h : line A) (a : point) : point := if h1 : a ∉ A then classical.some (ten2 h h1) else a

theorem ten3a {A : set point} (h : line A) {a : point} (h1 : a ∉ A) : mid a (Sl h a) ∈ A ∧ perp A (l a (Sl h a)) :=
begin
unfold Sl,
rw dif_pos h1,
exact (classical.some_spec (ten2 h h1)).1
end

theorem ten3b {A : set point} (h : line A) {a : point} (h1 : a ∈ A) : Sl h a = a :=
begin
unfold Sl,
have h2 : ¬a ∉ A,
  intro h_1,
  contradiction,
rw dif_neg h2
end

theorem Sl.symm {a b : point} (h : line (l a b)) (p : point) : Sl h p = Sl h.symm p :=
begin
cases em (p ∈ l a b),
  rw ten3b h h_1,
  suffices : p ∈ l b a,
    rw ten3b h.symm this,
  simpa [six17 a b] using h_1,
apply unique_of_exists_unique (ten2 h h_1),
  exact ten3a h h_1,
have h_2 : p ∉ l b a,
  rwa six17,
have h2 := ten3a h.symm h_2,
rwa six17 a b
end

theorem ten3c {A : set point} (h : line A) {a : point} : a ∉ A → Sl h a ∉ A :=
begin
intro h1,
have h2 := ten3a h h1,
cases em (a = Sl h a),
  rwa ←h_1,
intro h3,
apply h1,
have h4 := ten1 a (Sl h a),
suffices : A = l (Sl h a) (mid a (Sl h a)),
  rw this,
  left,
  exact h4.1.symm,
apply six18 h,
    intro h_2,
    apply h_1,
    rw ←h_2 at h4,
    exact id_eqd h4.2.flip,
  exact h3,
exact h2.1
end

theorem ten3d {A : set point} (h : line A) (a : point) : Sl h a = S (mid a (Sl h a)) a :=
begin
exact (mid_to_Sa _ _).symm
end

theorem ten3e {A : set point} (h : line A) (a : point) : mid a (Sl h a) ∈ A :=
begin
cases em (a ∈ A),
  rw ten3b h h_1,
  simpa,
exact (ten3a h h_1).1
end

@[simp] theorem ten5 {A : set point} (h : line A) (a : point) : Sl h (Sl h a) = a :=
begin
cases em (a ∈ A),
  have h1 := ten3b h h_1,
  rwa h1,
have h1 := ten3a h h_1,
have h2 : Sl h a ∉ A,
  exact ten3c h h_1,
rw [mid.symm, six17] at h1,
apply unique_of_exists_unique (ten2 h h2),
  exact ten3a h h2,
exact h1
end

theorem ten4 {A : set point} {h : line A} {p q : point} : Sl h p = q ↔ Sl h q = p :=
begin
split;
{intro h1,
rw ←h1,
simp}
end

theorem ten6 {A : set point} (h : line A) (p : point) : ∃! q, Sl h q = p :=
begin
apply exists_unique.intro,
  exact ten5 h p,
intros y hy,
exact (ten4.1 hy).symm
end

theorem ten7 {A : set point} {h : line A} {p q : point} : Sl h p = Sl h q → p = q :=
begin
intro h1,
rw ←(ten4.1 h1),
simp
end

theorem ten8 {A : set point} (h : line A) {a : point} : Sl h a = a ↔ a ∈ A :=
begin
split,
  intro h1,
  by_contradiction h_1,
  apply h_1,
  have h2 := ten3a h h_1,
  rw h1 at *,
  simp at h2,
  exact h2.1,
intro h1,
exact ten3b h h1
end

theorem ten9 {A : set point} (h : line A) {a : point} : a ∉ A → perp A (l a (mid a (Sl h a))) :=
begin
intro h1,
have h2 := ten3a h h1,
suffices : l a (Sl h a) = l a (mid a (Sl h a)),
  rw ←this,
  exact h2.2,
have h3 : a ≠ Sl h a,
  intro h_1,
  apply h1,
  exact (ten8 h).1 h_1.symm,
have h4 := ten1 a (Sl h a),
apply six18 (six14 h3),
    intro h_1,
    apply h3,
    rw ←h_1 at h4,
    exact id_eqd h4.2.symm,
  simp,
right, left,
exact h4.1.symm
end

theorem ten10 {A : set point} (h : line A) (p q : point) : eqd p q (Sl h p) (Sl h q) :=
begin
rw [ten3d h p, ten3d h q],
generalize h1 : mid p (Sl h p) = x,
generalize h2 : mid q (Sl h q) = y,
generalize h3 : mid x y = z,
have h4 := mid_to_Sa x y,
rw h3 at h4,
have h5 := seven5 x p,
have h6 := (seven14 z).1 h5,
rw h4 at h6,
have h7 := seven6 h6,
have h8 : eqd q (S z p) (S y q) (S z (S x p)),
  rw h7,
  apply seven13,
have h9 : R z x p,
  cases em (p ∈ A),
    rw (ten3b h h_1) at h1,
    simp at h1,
    subst p,
    simp,
  have h_2 : xperp x A (l p x),
    rw ←h1,
    exact eight15 (ten9 h h_1) (ten3e h p) (six17b p (mid p (Sl h p))),
  apply h_2.2.2.2.2,
    apply six27 h,
      exact ten3e h p,
      exact ten3e h q,
    rw [h1, h2, ←h3],
    exact (ten1 x y).1,
  simp,
have h10 : R z y q,
  cases em (q ∈ A),
    rw (ten3b h h_1) at h2,
    simp at h2,
    subst q,
    simp,
  have h_2 : xperp y A (l q y),
    rw ←h2,
    exact eight15 (ten9 h h_1) (ten3e h q) (six17b q (mid q (Sl h q))),
  apply h_2.2.2.2.2,
    apply six27 h,
      exact ten3e h q,
      exact ten3e h p,
    rw [h2, h1, ←h3],
    exact (ten1 x y).1.symm,
  simp,
unfold R at *,
have h11 : afs (S z p) z p q (S z (S x p)) z (S x p) (S y q),
  repeat {split},
    exact (seven5 z p).1.symm,
    exact (seven5 z (S x p)).1.symm,
    suffices : eqd (S z p) (S z z) (S z (S x p)) (S z z),
      simp at this,
      exact this,
    exact (seven16 z).1 h9.flip,
    exact h9,
    exact h8.flip,
  exact h10,
cases em (S z p = z),
  have h12 : p = z,
    exact seven9 (eq.trans h_1 (seven11 z).symm),
  have h13 : (S x p) = z,
    rw ←h12 at *,
    exact id_eqd h9.symm.flip,
  exact h13.symm ▸ h12.symm ▸ h10,
exact afive_seg h11 h_1
end

theorem ten11a {A : set point} (h : line A) {a b c : point} : B a b c ↔ B (Sl h a) (Sl h b) (Sl h c) :=
begin
split,
  intro h1,
  apply four6 h1,
  repeat {split};
  exact ten10 h _ _,
intro h1,
rw ←ten5 h a,
rw ←ten5 h b,
rw ←ten5 h c,
apply four6 h1,
repeat {split};
exact ten10 h _ _
end

theorem ten11b {A : set point} (h : line A) {a b c d : point} : eqd a b c d ↔ eqd (Sl h a) (Sl h b) (Sl h c) (Sl h d) :=
begin
split,
  intro h1,
  exact (ten10 h a b).symm.trans (h1.trans (ten10 h c d)),
intro h1,
have h2 := (ten10 h (Sl h a) (Sl h b)).symm.trans (h1.trans (ten10 h (Sl h c) (Sl h d))),
simpa using h2
end

theorem ten12a {a b p : point} (h : line (l a b)) : R a b p → b = mid p (Sl h p) :=
begin
intro h1,
cases em (p ∈ l a b),
    cases eight9 h1 h_1,
    subst b,
    exfalso,
    exact six13a a h,
  subst p,
  suffices : Sl h b = b,
    rw this,
    simp,
  apply ten3b h (six17b a b),
suffices : S b p = Sl h p,
  rw ←this,
  exact (mid_of_S b p).symm,
apply eq.symm,
apply unique_of_exists_unique (ten2 h h_1),
  exact ten3a h h_1,
split,
  rw mid_of_S,
  simp,
have h3 : p ≠ b,
  intro h_2,
    apply h_1,
    subst p,
    simp,
suffices : l p (S b p) = l p b,
  rw this,
  suffices : xperp b (l a b) (l p b),
    constructor,
    exact this,
  apply eight13.2,
  split,
    exact h,
  split,
    exact six14 h3,
  split,
    simp,
  split,
    simp,
  existsi [a, p],
  split,
    simp,
  split,
    simp,
  split,
    exact six13 h,
  split,
    exact h3,
  exact h1,
apply six18 _ h3,
    simp,
  right, left,
  exact (seven5 b p).1.symm,
apply six14,
intro h_2,
apply h3,
exact (seven10.1 h_2.symm)
end

theorem ten12b {a b c : point} (h : line (l a b)) : R a b c → c = (Sl h (S b c)) :=
begin
intro h1,
have h2 : b = mid c (Sl h c),
  exact ten12a h h1,
suffices : S b c = Sl h c,
  rw this,
  simp,
suffices : S (mid c (Sl h c)) c = Sl h c,
  rwa ←h2 at this,
exact mid_to_Sa c (Sl h c)
end

theorem ten12c {a b c a' : point} : R a b c → R a' b c → eqd a b a' b → eqd a c a' c :=
begin
intros h h1 h2,
generalize h3 : mid a a' = z,
have h4 : R b z a,
  unfold R,
  rw ←h3,
  rw mid_to_Sa,
  exact h2.flip,
cases em (b = c),
  subst b,
  exact h2,
cases em (b = z),
  subst z,
  have h5 := six14 (ne.symm h_1),
  have h6 : a' = Sl h5 a,
    suffices : a = S b a',
      rw this,
      exact ten12b h5 h1.symm,
    rw [h_2, mid.symm],
    exact (mid_to_Sa a' a).symm,
  have h7 : c = Sl h5 c,
    suffices : c ∈ l c b,
      exact (ten3b h5 this).symm,
    simp,
  rw h6,
  simpa [h7.symm] using (ten10 h5 a c),
have h5 := six14  h_2,
have h6 : a = (Sl h5 a'),
  rw [(mid_to_Sa a a').symm, h3],
  exact ten12b h5 h4,
have h7 : b = Sl h5 b,
  suffices : b ∈ l b z,
      exact (ten3b h5 this).symm,
    simp,
have h8 : eqd a c a (S b c),
  unfold R at h,
  exact h,
cases em (a = a'),
  subst a',
  exact eqd.refl a c,
have h9 : R z b c,
  unfold R,
  apply four17 h_3,
      rw ←h3,
      right, left,
      exact (ten1 a a').1.symm,
    exact h8,
  unfold R at h1,
  exact h1,
have h10 : (S b c) = Sl h5 c,
  rw Sl.symm,
  rw ten4.1,
  apply eq.symm,
  exact ten12b _ h9,
apply h8.trans,
apply eqd.symm,
rw [h6, h10],
exact ten10 h5 a' c
end

theorem ten12 {a b c a' b' c' : point} : R a b c → R a' b' c' → eqd a b a' b' → eqd b c b' c' → eqd a c a' c' :=
begin
intros h h1 h2 h3,
generalize h4 : mid b b' = x,
have h5 : b = S x b',
  rw [←h4, mid.symm],
  apply eq.symm,
  exact mid_to_Sa b' b,
have h6 : cong a' b' c' (S x a') b (S x c'),
  rw h5,
  exact seven16a x,
have h7 : R (S x a') b (S x c'),
  exact eight10 h1 h6,
apply eqd.trans _ h6.2.2.symm,
generalize h8 : mid c (S x c') = y,
have h9 : R b y c,
  unfold R,
  rw ←h8,
  rw mid_to_Sa,
  exact h3.trans h6.2.1,
cases em (b = y),
  subst y,
  have h10 : (S b (S x c')) = c,
    rw [h_1, mid.symm],
    exact mid_to_Sa (S x c') c,
  have h11 : cong (S x a') b (S x c') (S b (S x a')) b c,
    rw ←h10,
    suffices : cong (S x a') b (S x c') (S b (S x a')) (S b b) (S b (S x c')),
      simpa [this],
    exact seven16a b,
  apply eqd.trans _ h11.2.2.symm,
  apply ten12c h,
    exact eight10 h7 h11,
  exact h2.trans (h6.1.trans h11.1),
have h10 := six14 h_1,
have h11 : c = Sl h10 (S x c'),
  rw [←mid_to_Sa c (S x c'), h8],
  exact ten12b h10 h9,
have h12 : b = Sl h10 b,
  suffices : b ∈ l b y,
    exact (ten3b h10 this).symm,
  simp,
have h13 : cong (S x a') b (S x c') (Sl h10 (S x a')) (Sl h10 b) (Sl h10 (S x c')),
  repeat {split};
  exact ten10 h10 _ _,
rw [←h11, ←h12] at h13,
apply eqd.trans _ h13.2.2.symm,
exact ten12c h (eight10 h7 h13) (h2.trans (h6.1.trans h13.1))
end

theorem ten14 {A : set point} (h : line A) {a : point} : a ∉ A → Bl a A (Sl h a) :=
begin
intro h1,
split,
  exact h,
split,
  exact h1,
split,
  exact ten3c h h1,
constructor,
split,
  exact (ten3a h h1).1,
exact (ten1 a (Sl h a)).1
end

theorem ten15 {A : set point} (h : line A) {a q : point} : a ∈ A → q ∉ A → ∃ p, perp A (l p a) ∧ side A p q :=
begin
intros h1 h2,
cases six22 h h1 with b hb,
cases nine10 h h2 with c hc,
rcases eight21 hb.1 c with ⟨p, t, ht⟩,
existsi p,
split,
  rw hb.2,
  exact ht.1,
existsi c,
split,
  split,
    exact h,
  split,
    intro h_1,
    apply eight14a ht.1,
    apply six18,
          rwa hb.2 at h,
        exact six13 (eight14e ht.1).2,
      rwa hb.2 at h_1,
    simp,
  split,
    exact hc.2.2.1,
  existsi t,
  split,
    rw hb.2,
    exact ht.2.1,
  exact ht.2.2.symm,
exact hc
end

theorem ten16 {a b c p a' b' : point} : ¬col a b c → ¬col a' b' p → eqd a b a' b' → ∃! c', cong a b c a' b' c' ∧ side (l a' b') c' p :=
begin
intros h h1 h2,
apply exists_unique_of_exists_of_unique,
  cases eight18 (six14 (six26 h).1) h with x hx,
  cases four14 hx.1.1 h2 with x' hx',
  have h3 : col a' b' x',
    exact four13 hx.1.1 hx',
  cases ten15 (six14 (six26 h1).1) h3 h1 with q hq,
  have h4 : x ≠ c,
    intro h_1,
    subst x,
    exact h hx.1.1,
  cases six11 (six13 (eight14e hq.1).2) h4 with c' hc',
  constructor,
  have h5 : cong a b c a' b' c',
    split,
      exact h2,
    have h5 : xperp x (l a b) (l c x),
      exact eight15 hx.1.2 hx.1.1 (six17b c x),
    have h6 : xperp x' (l a' b') (l c' x'),
      suffices : perp (l a' b') (l c' x'),
        exact eight15 this h3 (six17b c' x'),
      suffices : l q x' = l c' x',
        rw this at hq,
        exact hq.1,
      apply six18 (eight14e hq.1).2,
          intro h_1,
          apply h4,
          subst c',
          exact id_eqd hc'.1.2.symm,
        exact (four11 (six4.1 hc'.1.1).1).2.2.2.2,
      simp,
    split,
      have h7 : R b x c,
        simp [h5.2.2.2.2],
      have h8 : R b' x' c',
        simp [h6.2.2.2.2],
      exact ten12 h7 h8 hx'.2.1 hc'.1.2.symm,
    have h7 : R a x c,
        simp [h5.2.2.2.2],
    have h8 : R a' x' c',
      simp [h6.2.2.2.2],
    exact ten12 h7 h8 hx'.2.2 hc'.1.2.symm,
  split,
    exact h5,
  apply side.trans _ hq.2,
  apply nine12 (six14 (six26 h1).1) h3 hc'.1.1,
  intro h_1,
  exact h (four13 h_1 h5.symm),
intros c' c'' hc' hc'',
have h3 := hc'.1.symm.trans hc''.1,
have h4 := hc'.2.trans hc''.2.symm,
have h5 := six14 (six26 h1).1,
generalize h6 : Sl h5 c'' = c₁,
have h7 : Bl c'' (l a' b') c₁,
  rw ←h6,
  exact ten14 h5 (nine11 h4).2.2,
have h8 : Bl c' (l a' b') c₁,
  exact (nine8 h7).2 h4.symm,
cases h8.2.2.2 with t ht,
have h9 : cong a' b' c' a' b' c₁,
  apply h3.trans,
  have h_1 : a' = Sl h5 a',
    apply (ten3b h5 _).symm,
    simp,
  have h_2 : b' = Sl h5 b',
    apply (ten3b h5 _).symm,
    simp,
  have h_3 : cong a' b' c'' (Sl h5 a') (Sl h5 b') c₁,
    rw ←h6,
    repeat {split};
    exact ten10 h5 _ _,
  simpa [h_2.symm, h_1.symm] using h_3,
have h10 : c₁ = S t c',
  suffices : M c' t c₁,
    exact unique_of_exists_unique (seven4 t c') this (seven5 t c'),
  split,
    exact ht.2,
  exact four17 (six26 h1).1 ht.1 h9.2.2 h9.2.1,
suffices : Sl h5 c' = c₁,
  exact ten7 (this.trans h6.symm),
apply unique_of_exists_unique (ten2 h5 h8.2.1),
  exact ten3a h5 h8.2.1,
split,
  rw [h10, mid_of_S],
  exact ht.1,
existsi t,
apply eight13.2,
split,
  exact six14 (six26 h1).1,
split,
  exact six14 (nine2 h8),
split,
  exact ht.1,
split,
  right, left,
  exact ht.2.symm,
cases em (a' = t),
  have h_2 : b' ≠ t,
    intro h_2,
    exact (six26 h1).1 (h_1.trans h_2.symm),
  existsi [b', c'],
  split,
    simp,
  split,
    simp,
  split,
    exact h_2,
  split,
    intro h_3,
    subst h_3,
    exact h8.2.1 ht.1,
  unfold R,
  rw ←h10,
  exact h9.2.1,
existsi [a', c'],
split,
  simp,
split,
  simp,
split,
  exact h_1,
split,
  intro h_1,
  subst t,
  exact h8.2.1 ht.1,
unfold R,
rw ←h10,
exact h9.2.2
end

-- Angles

def eqa (a b c d e f : point) : Prop := a ≠ b ∧ c ≠ b ∧ d ≠ e ∧ f ≠ e ∧ ∃ a' c' d' f',
B b a a' ∧ eqd a a' e d ∧ B b c c' ∧ eqd c c' e f ∧ B e d d' ∧ eqd d d' b a ∧ B e f f' ∧ eqd f f' b c ∧ eqd a' c' d' f'

theorem eleven3a {a b c d e f : point} : eqa a b c d e f → ∃ a' c' d' f', sided b a' a ∧
sided b c' c ∧ sided e d' d ∧ sided e f' f ∧ cong a' b c' d' e f' :=
begin
unfold eqa,
intro h,
rcases h.2.2.2.2 with ⟨a', c', d', f', h1⟩,
existsi [a', c', d', f'],
split,
  exact (six7 h1.1 h.1).symm,
split,
  exact (six7 h1.2.2.1 h.2.1).symm,
split,
  exact (six7 h1.2.2.2.2.1 h.2.2.1).symm,
split,
  exact (six7 h1.2.2.2.2.2.2.1 h.2.2.2.1).symm,
split,
  exact two5 (two11 h1.1.symm h1.2.2.2.2.1 (two4 h1.2.1) (two4 h1.2.2.2.2.2.1.symm)),
split,
  exact two5 (two11 h1.2.2.1 h1.2.2.2.2.2.2.1.symm (two5 h1.2.2.2.2.2.2.2.1.symm) (two5 h1.2.2.2.1)),
exact h1.2.2.2.2.2.2.2.2
end

theorem eleven4a {a b c d e f : point} : (∃ a' c' d' f', sided b a' a ∧ sided b c' c ∧ sided e d' d ∧ sided e f' f ∧ cong a' b c' d' e f') → a ≠ b ∧ c ≠ b ∧ d ≠ e ∧ f ≠ e ∧
∀ {a' c' d' f'}, sided b a' a → sided b c' c → sided e d' d → sided e f' f → eqd b a' e d' → eqd b c' e f' → eqd a' c' d' f' :=
begin
intro h,
rcases h with ⟨a', c', d', f', h1⟩,
repeat {split},
        exact h1.1.2.1,
      exact h1.2.1.2.1,
    exact h1.2.2.1.2.1,
  exact h1.2.2.2.1.2.1,
intros a1 c1 d1 f1 h2 h3 h4 h5 h6 h7,
have h8 : cong b a' a1 e d' d1,
  exact six10 (h1.1.trans h2.symm) (h1.2.2.1.trans h4.symm) h1.2.2.2.2.1.flip h6,
have h9 : eqd a1 c' d1 f',
  suffices : fs b a' a1 c' e d' d1 f',
    exact four16 this h1.1.1.symm,
  repeat {split},
            exact (four11 (six4.1 (h1.1.trans h2.symm)).1).2.1,
          exact h8.1,
        exact h8.2.1,
      exact h8.2.2,
    exact h1.2.2.2.2.2.1,
  exact h1.2.2.2.2.2.2,
suffices : fs b c' c1 a1 e f' f1 d1,
  exact (four16 this h1.2.1.1.symm).flip,
repeat {split},
          exact (four11 (six4.1 (h1.2.1.trans h3.symm)).1).2.1,
        exact h1.2.2.2.2.2.1,
      exact (six10 (h1.2.1.trans h3.symm) (h1.2.2.2.1.trans h5.symm) h1.2.2.2.2.2.1 h7).2.1,
    exact h7,
  exact h6,
exact h9.flip
end

theorem eleven2a {a b c d e f : point} : (a ≠ b ∧ c ≠ b ∧ d ≠ e ∧ f ≠ e ∧
∀ {a' c' d' f'}, sided b a' a → sided b c' c → sided e d' d → sided e f' f → eqd b a' e d' → eqd b c' e f' → eqd a' c' d' f') →
eqa a b c d e f :=
begin
intro h,
unfold eqa,
split,
  exact h.1,
split,
  exact h.2.1,
split,
  exact h.2.2.1,
split,
  exact h.2.2.2.1,
cases seg_cons a e d b with a' ha',
cases seg_cons c e f b with c' hc',
cases seg_cons d b a e with d' hd',
cases seg_cons f b c e with f' hf',
existsi [a', c', d', f'],
repeat {split},
                exact ha'.1,
              exact ha'.2,
            exact hc'.1,
          exact hc'.2,
        exact hd'.1,
      exact hd'.2,
    exact hf'.1,
  exact hf'.2,
apply h.2.2.2.2,
          exact (six7 ha'.1 h.1).symm,
        exact (six7 hc'.1 h.2.1).symm,
      exact (six7 hd'.1 h.2.2.1).symm,
    exact (six7 hf'.1 h.2.2.2.1).symm,
  exact two5 (two11 ha'.1 hd'.1.symm (two5 hd'.2.symm) (two5 ha'.2)),
exact two5 (two11 hc'.1 hf'.1.symm (two5 hf'.2.symm) (two5 hc'.2))
end

theorem eleven3 {a b c d e f : point} : eqa a b c d e f ↔ ∃ a' c' d' f', sided b a' a ∧
sided b c' c ∧ sided e d' d ∧ sided e f' f ∧ cong a' b c' d' e f' :=
⟨λ h, eleven3a h, λ h, eleven2a (eleven4a h)⟩

theorem eleven4 {a b c d e f : point} : eqa a b c d e f ↔ a ≠ b ∧ c ≠ b ∧ d ≠ e ∧ f ≠ e ∧
∀ {a' c' d' f'}, sided b a' a → sided b c' c → sided e d' d → sided e f' f → eqd b a' e d' → eqd b c' e f' → eqd a' c' d' f' :=
⟨λ h, eleven4a (eleven3a h), λ h, eleven2a h⟩

lemma eleven5 {a b c d e f : point} : eqa a b c d e f ↔ ∃ d' f', sided e d' d ∧ sided e f' f ∧ cong a b c d' e f' :=
begin
split,
  intro h,
  cases exists_of_exists_unique (six11 h.2.2.1 h.1.symm) with d' hd,
  cases exists_of_exists_unique (six11 h.2.2.2.1 h.2.1.symm) with f' hf,
  refine ⟨d', f', hd.1, hf.1, _⟩,
  exact ⟨hd.2.symm.flip, hf.2.symm, (eleven4.1 h).2.2.2.2 (six5 h.1) (six5 h.2.1) hd.1 hf.1 hd.2.symm hf.2.symm⟩,
rintros ⟨d', f', h, h1, h2⟩,
apply eleven3.2 ⟨a, c, d', f', _, _, h, h1, h2⟩,
  exact six5 (two7 h2.1.symm h.1),
exact six5 (two7 h2.2.1.symm.flip h1.1)
end

theorem eqa.refl {a b c : point} : a ≠ b → c ≠ b → eqa a b c a b c :=
begin
intros h h1,
rw eleven3,
existsi [a, c, a, c],
simp [six5 h, six5 h1]
end

theorem eqa.symm {a b c d e f : point} : eqa a b c d e f → eqa d e f a b c :=
begin
unfold eqa,
rintros ⟨h, h1, h2, h3, a', c', d', f', h4, h5, h6, h7, h8, h9, h10, h11, h12⟩,
simp [*, -exists_and_distrib_left],
existsi [d', f', a', c'],
simp [*, h12.symm]
end

theorem eqa.trans {a b c d e f p q r : point} : eqa a b c d e f → eqa d e f p q r → eqa a b c p q r :=
begin
intros h g,
have h1 := h,
rw eleven3 at h1,
rcases h1 with ⟨a', c', d', f', h1, h2, h3, h4, h5, h6, h7⟩,
rw eleven4 at g,
cases seg_cons a' p q b with a₁ ha,
cases seg_cons c' r q b with c₁ hc,
cases seg_cons d' p q e with d₁ hd,
cases seg_cons f' r q e with f₁ hf,
cases seg_cons p d' e q with p₁ hp,
cases seg_cons r f' e q with r₁ hr,
have h8 : eqd b a₁ e d₁,
  exact two11 ha.1 hd.1 h5.flip (ha.2.trans hd.2.symm),
have h9 : eqd b c₁ e f₁,
  exact two11 hc.1 hf.1 h6 (hc.2.trans hf.2.symm),
have h10 : eqd e d₁ q p₁,
  exact two5 (two11 hd.1 hp.1.symm hp.2.symm.flip hd.2),
have h11 : eqd e f₁ q r₁,
  exact two5 (two11 hf.1 hr.1.symm hr.2.symm.flip hf.2),
have h12 : sided b a₁ a,
  exact six7a ha.1 h1,
have h13 : sided b c₁ c,
  exact six7a hc.1 h2,
have h14 : sided e d₁ d,
  exact six7a hd.1 h3,
have h15 : sided e f₁ f,
  exact six7a hf.1 h4,
have h16 : sided q p₁ p,
  exact (six7 hp.1 g.2.2.1).symm,
have h17 : sided q r₁ r,
  exact (six7 hr.1 g.2.2.2.1).symm,
have h18 := g.2.2.2.2 h14 h15 h16 h17 h10 h11,
rw eleven3,
existsi [a₁, c₁, p₁, r₁],
simp *,
split,
  exact (h8.trans h10).flip,
split,
  exact h9.trans h11,
apply eqd.trans _ h18,
rw eleven4 at h,
exact h.2.2.2.2 h12 h13 h14 h15 h8 h9
end

theorem eleven6 {a b c : point} : a ≠ b → c ≠ b → eqa a b c c b a :=
begin
intros h h1,
cases seg_cons a c b b with a' ha,
cases seg_cons c a b b with c' hc,
rw eleven3,
existsi [a', c', c', a'],
simp [(six7 ha.1 h).symm, (six7 hc.1 h1).symm],
unfold cong,
have h3 : eqd b a' c' b,
  exact two11 ha.1 hc.1.symm hc.2.symm.flip ha.2,
split,
  exact two4 h3,
split,
  exact two4 h3.symm,
exact two5 (eqd.refl a' c')
end

theorem eleven7 {a b c d e f : point} : eqa a b c d e f → eqa c b a d e f :=
λ h, (eleven6 h.1 h.2.1).symm.trans h

theorem eleven8 {a b c d e f : point} : eqa a b c d e f → eqa a b c f e d :=
λ h, h.trans (eleven6 h.2.2.1 h.2.2.2.1)

theorem eqa.flip {a b c d e f : point} : eqa a b c d e f → eqa c b a f e d :=
λ h, eleven8 (eleven7 h)

theorem eleven9 {a b c a' c' : point} : sided b a' a → sided b c' c → eqa a b c a' b c' :=
begin
intros h h1,
rw eleven3,
existsi [a', c', a', c'],
simp [h, h1, six5 h.1, six5 h1.1]
end

theorem eleven10 {a b c d e f a' c' d' f' : point} : eqa a b c d e f → sided b a' a → sided b c' c →
sided e d' d → sided e f' f → eqa a' b c' d' e f' :=
begin
intros h h1 h2 h3 h4,
exact (eleven9 h1 h2).symm.trans (h.trans (eleven9 h3 h4))
end

theorem eleven11 {a b c d e f : point} : a ≠ b → c ≠ b → cong a b c d e f → eqa a b c d e f :=
λ h h1 h2, eleven3.2 ⟨a, c, d, f, (six5 h), (six5 h1), (six5 (two7 h2.1 h)), (six5 (two7 h2.2.1.flip h1)), h2⟩

theorem eleven12 {a b c : point} (p : point): a ≠ b → c ≠ b → eqa a b c (S p a) (S p b) (S p c) :=
begin
intros h h1,
rw eleven3,
existsi [a, c, (S p a), (S p c)],
simp [six5 h, six5 h1, six5 (seven9a p h), six5 (seven9a p h1), seven16a p]
end

theorem eleven13 {a b c d e f a' d' : point} : eqa a b c d e f → a' ≠ b → B a b a' → d' ≠ e → B d e d' → eqa a' b c d' e f :=
begin
intros h h1 h2 h3 h4,
rw eleven3 at h,
rcases h with ⟨a₁, c₁, d₁, f₁, h⟩,
suffices : eqa (S b a₁) b c (S e d₁) e f,
  apply eleven10 this,
        split,
          exact h1,
        split,
          exact this.1,
        suffices : B a b (S b a₁),
          exact five2 h.1.2.1 h2 this,
        exact (six6 (seven5 b a₁).1.symm h.1).symm,
      exact six5 h.2.1.2.1,
    split,
      exact h3,
    split,
      exact this.2.2.1,
    suffices : B d e (S e d₁),
      exact five2 h.2.2.1.2.1 h4 this,
    exact (six6 (seven5 e d₁).1.symm h.2.2.1).symm,
  exact six5 h.2.2.2.1.2.1,
rw eleven3,
existsi [(S b a₁), c₁, (S e d₁), f₁],
simp [six5 (seven12a h.1.1.symm).symm, h.2.1, six5 (seven12a h.2.2.1.1.symm).symm, h.2.2.2.1],
split,
  exact (seven5 b a₁).2.symm.flip.trans (h.2.2.2.2.1.trans (seven5 e d₁).2.flip),
split,
  exact h.2.2.2.2.2.1,
suffices : afs a₁ b (S b a₁) c₁ d₁ e (S e d₁) f₁,
  exact afive_seg this h.1.1,
repeat {split},
          exact (seven5 b a₁).1,
        exact (seven5 e d₁).1,
      exact h.2.2.2.2.1,
    exact (seven5 b a₁).2.symm.trans (h.2.2.2.2.1.flip.trans (seven5 e d₁).2),
  exact h.2.2.2.2.2.2,
exact h.2.2.2.2.2.1
end

theorem eleven14 {a b c a' c' : point} : a ≠ b → c ≠ b → a' ≠ b → c' ≠ b → B a b a' → B c b c' → eqa a b c a' b c' :=
begin
intros h h1 h2 h3 h4 h5,
apply (eleven12 b h h1).trans,
simp,
suffices : sided b a' (S b a) ∧ sided b c' (S b c),
  exact eleven9 this.1 this.2,
split,
  apply six3.2,
  split,
    exact h2,
  split,
    exact (seven12a h.symm).symm,
  existsi a,
  split,
    exact h,
  split,
    exact h4.symm,
  exact (seven5 b a).1.symm,
apply six3.2,
split,
  exact h3,
split,
  exact (seven12a h1.symm).symm,
existsi c,
split,
  exact h1,
split,
  exact h5.symm,
exact (seven5 b c).1.symm
end

theorem eleven15a {a b c d e p : point} : ¬col a b c → ¬col d e p → ∃ f, eqa a b c d e f ∧ side (l e d) f p :=
begin
intros h h1,
cases exists_of_exists_unique (six11 (six26 h1).1 (six26 h).1.symm) with d' hd,
have h2 : ¬col d' e p,
  intro h_1,
  have h_2 := (six4.1 hd.1).1,
  exact (four10 h1).2.2.1 (five4 hd.1.1.symm (four11 h_1).2.1 (four11 h_2).2.1),
cases ten16 h h2 hd.2.symm.flip with f hf,
dsimp at hf,
existsi f,
split,
  rw eleven3,
  existsi [a, c, d', f],
  simp [six5 (six26 h).1, six5 (six26 h).2.1.symm, hd.1, hf.1.1],
  apply six5,
  intro h_1,
  subst f,
  exact (six26 h).2.1 (id_eqd hf.1.1.2.1),
have h3 : l e d = l d' e,
  exact six18 (six14 (six26 h1).1.symm) hd.1.1 (four11 (six4.1 hd.1).1).2.2.1 (six17a e d),
rw h3,
exact hf.1.2
end

theorem eleven15b {a b c d e p : point} : ¬col a b c → ¬col d e p → ∀ {f1 f2}, eqa a b c d e f1 →
side (l e d) f1 p → eqa a b c d e f2 → side (l e d) f2 p → sided e f1 f2 :=
begin
intros h h1 f1 f2 h2 h3 h4 h5,
cases exists_of_exists_unique (six11 (six26 h1).1 (six26 h).1.symm) with d' hd,
have h6 : ¬col d' e p,
  intro h_1,
  have h_2 := (six4.1 hd.1).1,
  exact (four10 h1).2.2.1 (five4 hd.1.1.symm (four11 h_1).2.1 (four11 h_2).2.1),
cases ten16 h h6 hd.2.symm.flip with f hf,
dsimp at hf,
have h7 : f1 ≠ e,
  intro h_1,
  subst f1,
  exact (nine11 h3).2.1 (six17a e d),
have h8 : f2 ≠ e,
  intro h_1,
  subst f2,
  exact (nine11 h5).2.1 (six17a e d),
cases exists_of_exists_unique (six11 h7 (six26 h).2.1) with f₁ h9,
cases exists_of_exists_unique (six11 h8 (six26 h).2.1) with f₂ h10,
have h11 : cong a b c d' e f₁,
  split,
    exact hf.1.1.1,
  split,
    exact h9.2.symm,
  suffices : eqa a b c d' e f₁,
    apply (eleven4.1 this).2.2.2.2 (six5 (six26 h).1) (six5 (six26 h).2.1.symm) (six5 hd.1.1) (six5 h9.1.1),
      exact hf.1.1.1.flip,
    exact h9.2.symm,
  exact h2.trans (eleven9 hd.1 h9.1),
have h12 : cong a b c d' e f₂,
  split,
    exact hf.1.1.1,
  split,
    exact h10.2.symm,
  suffices : eqa a b c d' e f₂,
    apply (eleven4.1 this).2.2.2.2 (six5 (six26 h).1) (six5 (six26 h).2.1.symm) (six5 hd.1.1) (six5 h10.1.1),
      exact hf.1.1.1.flip,
    exact h10.2.symm,
  exact h4.trans (eleven9 hd.1 h10.1),
have h13 : l e d = l d' e,
  exact six18 (six14 (six26 h1).1.symm) hd.1.1 (four11 (six4.1 hd.1).1).2.2.1 (six17a e d),
have h14 : side (l d' e) f₁ p,
  rw h13 at *,
  exact (nine19a h3.symm (six17b d' e) h9.1.symm).symm,
have h15 : side (l d' e) f₂ p,
  rw h13 at *,
  exact (nine19a h5.symm (six17b d' e) h10.1.symm).symm,
have h16 : f₁ = f,
  apply hf.2,
  split,
    exact h11,
  exact h14,
subst f₁,
have h16 : f₂ = f,
  apply hf.2,
  split,
    exact h12,
  exact h15,
subst f₂,
exact h9.1.symm.trans h10.1
end

theorem eleven15c {a b c x : point} : eqa a b c a b x → side (l a b) c x → sided b c x :=
begin
intros h h1,
have h2 : ¬col a b c,
  exact (nine11 h1).2.1,
apply eleven15b h2 h2 (eqa.refl (six26 h2).1 (six26 h2).2.1.symm) (side.refla (four10 h2).2.1) h,
rwa six17,
exact h1.symm
end

theorem eleven16 {a b c a' b' c' : point} : a ≠ b → c ≠ b → a' ≠ b' → c' ≠ b' → R a b c → R a' b' c' →
eqa a b c a' b' c' :=
begin
intros h h1 h2 h3 h4 h5,
cases exists_of_exists_unique (six11 h2 h.symm) with a₁ ha,
cases exists_of_exists_unique (six11 h3 h1.symm) with c₁ hc,
rw eleven3,
existsi [a, c, a₁, c₁],
simp [six5 h, six5 h1, ha.1, hc.1],
refine ⟨ha.2.symm.flip, hc.2.symm, _⟩,
apply ten12 h4,
    suffices : R a' b' c₁,
      apply eight3 this h2,
      exact (four11 (six4.1 ha.1).1).2.2.1,
    apply R.symm,
    apply eight3 h5.symm h3,
    exact (four11 (six4.1 hc.1).1).2.2.1,
  exact ha.2.symm.flip,
exact hc.2.symm
end

theorem eleven17 {a b c a' b' c' : point} : R a b c → eqa a b c a' b' c' → R a' b' c' :=
begin
intros h h1,
rcases eleven5.1 h1 with ⟨a₁, c₁, ha, hc, h2⟩,
apply eight3 _ ha.1 (four11 (six4.1 ha).1).2.1,
exact (eight3 (eight10 h h2).symm hc.1 (four11 (six4.1 hc).1).2.1).symm
end

theorem eleven18 {a b c d : point} : B c b d → c ≠ b → d ≠ b → a ≠ b → (R a b c ↔ eqa a b c a b d) :=
begin
intros h h1 h2 h3,
split,
  intro h4,
  have h5 : R a b d,
    apply (eight3 h4.symm h1 _).symm,
    right, right,
    exact h.symm,
  exact eleven16 h3 h1 h3 h2 h4 h5,
intro h4,
rw eleven3 at h4,
rcases h4 with ⟨a', c', a₁, d', h4⟩,
have : a₁ = a',
  apply unique_of_exists_unique (six11 h3 h4.2.2.1.1.symm),
    split,
      exact h4.2.2.1,
    exact eqd.refl b a₁,
  split,
    exact h4.1,
  exact h4.2.2.2.2.1.flip,
subst a₁,
have : d' = (S b c'),
  apply unique_of_exists_unique (two12 b b c' c' h4.2.1.1),
    split,
      exact six8 h4.2.1 h4.2.2.2.1 h,
    exact h4.2.2.2.2.2.1.symm,
  split,
    exact (seven5 b c').1,
  exact (seven5 b c').2.symm,
subst d',
have h5 : R a' b c',
  unfold R,
  exact h4.2.2.2.2.2.2,
exact eleven17 h5 (eleven9 h4.1.symm h4.2.1.symm)
end

theorem eleven19 {a b p q : point} : R b a p → R b a q → side (l a b) p q → sided a p q :=
begin
intros h h1 h2,
have h3 : ¬col b a p,
  exact (four10 (nine11 h2).2.1).2.1,
have h4 : ¬col b a q,
  exact (four10 (nine11 h2).2.2).2.1,
apply (eleven15b h3 h3),
      exact eqa.refl (six26 h3).1 (six26 h3).2.1.symm,
    exact side.refl (nine11 h2).1 (nine11 h2).2.1,
  exact eleven16 (six26 h3).1 (six26 h3).2.1.symm (six26 h4).1 (six26 h4).2.1.symm h h1,
exact h2.symm
end

theorem eleven20 {a : point} {A P : set point} : line A → plane P → a ∈ A → A ⊆ P → ∃! B, B ⊆ P ∧ xperp a A B :=
begin
intros h h1 h2 h3,
cases six22 h h2 with b hb,
cases (nine25 h1 (h3 h2) _ hb.1 ).2 with x hx,
  show b ∈ P,
  apply h3,
  rw hb.2,
  simp,
rw hb.2 at *,
have h4 : x ∉ l a b,
  apply nine28 (six14 hb.1),
  rwa hx at h1,
cases ten15 h h2 h4 with c hc,
have h5 : c ∈ P,
  rw hx,
  left,
  exact hc.2,
apply exists_unique.intro (l c a),
  split,
    exact (nine25 h1 h5 (h3 h2) (six13 (eight14e hc.1).2)).1,
  exact eight15 hc.1 (six17a a b) (six17b c a),
intros Y h6,
have h7 : c ∉ l a b,
  intro h_1,
  apply eight14a hc.1,
  exact six18 (six14 hb.1) (six13 (eight14e hc.1).2) h_1 (six17a a b),
have h8 : P = planeof a b c,
  apply nine26 h7 h1 _ _ h5,
    exact h3 (six17a a b),
  exact h3 (six17b a b),
cases (six22 h6.2.2.1 h6.2.2.2.2.1) with y hy,
have h9 : R b a c,
  exact (eight15 hc.1 (six17a a b) (six17b c a)).2.2.2.2 (six17b a b) (six17a c a),
rw h8 at h6,
have h10 : y ∈ Y,
  rw hy.2,
  simp,
have h11 : R b a y,
  exact h6.2.2.2.2.2 (six17b a b) h10,
rw hy.2 at *,
cases (h6.1 h10),
  have h12 : sided a c y,
    exact eleven19 h9 h11 h_1.symm,
  exact six18 (six14 hy.1) (six13 (eight14e hc.1).2) (four11 (six4.1 h12).1).2.2.1 (six17a a y),
cases h_1,
  exfalso,
  apply (eight14b h6.2),
  exact six18 h hy.1 (six17a a b) h_1,
have h12 := six14 hb.1,
have h13 : side (l a b) y (Sl h12 c),
  exact (nine8 h_1.symm).1 (ten14 h12 h7).symm,
have h14 : side (l a b) y (S a c),
  have h_2 : S a c = Sl h12 c,
    have h_3 := ten12b h12.symm h9.flip,
    rw Sl.symm at h_3,
    simpa using h_3,
  rwa h_2,
apply eq.symm,
apply six18 (eight14e hc.1).2 hy.1 (six17b c a) (or.inl $ six6 (seven5 a c).1 (eleven19 h11 h9.flip h14).symm)
end

theorem eleven21a {a b c a' b' c' : point} (h : sided b a c) : eqa a b c a' b' c' ↔ sided b' a' c' :=
begin
split,
  intro h1,
    rcases eleven5.1 h1 with ⟨a₁, c₁, ha, hc, h2⟩,
    suffices : sided b' a₁ c₁,
      exact ha.symm.trans (this.trans hc),
    apply six10a h ⟨h2.1.flip, _, h2.2.1⟩,
    exact (eleven4.1 h1).2.2.2.2 (six5 h1.1) (six5 h1.2.1) ha hc h2.1.flip h2.2.1,
intro h1,
cases exists_of_exists_unique (six11 h1.1 h.1.symm) with a₁ ha,
apply eleven3.2 ⟨a, a, a₁, a₁, _ ⟩,
simp [six5 h.1, h, ha.1, ha.1.trans h1],
exact ⟨ha.2.symm.flip, ha.2.symm, two8 a a₁⟩
end

theorem eleven21b {a b c a' b' c' : point} : B a b c → eqa a b c a' b' c' → B a' b' c' :=
begin
intros h h1,
rcases eleven5.1 h1 with ⟨a₁, c₁, ha, hc, h2⟩,
exact six8 ha.symm hc.symm (four6 h h2)
end

theorem eleven21c {a b c a' b' c' : point} : a ≠ b → c ≠ b → a' ≠ b' → c' ≠ b' → B a b c → B a' b' c' → eqa a b c a' b' c' :=
begin
intros h h1 h2 h3 h4 h5,
cases exists_of_exists_unique (six11 h2 h.symm) with a₁ ha,
cases exists_of_exists_unique (six11 h3 h1.symm) with c₁ hc,
apply eleven3.2 ⟨a, c, a₁, c₁, (six5 h), (six5 h1), ha.1, hc.1, ha.2.symm.flip, hc.2.symm, _⟩,
exact two11 h4 (six8 ha.1 hc.1 h5) ha.2.symm.flip hc.2.symm
end

theorem eleven21d {a b c a' b' c' : point} : col a b c  → eqa a b c a' b' c' → col a' b' c' :=
begin
intros h h1,
cases six1 h,
  exact or.inl (eleven21b h_1 h1),
exact (six4.1 ((eleven21a h_1).1 h1)).1
end

end Euclidean_plane