import geometry.tarski_5
open classical set
namespace Euclidean_plane
variables {point : Type} [Euclidean_plane point]

local attribute [instance, priority 0] prop_decidable

theorem eleven22a {a b c p a' b' c' p' : point} : Bl a (l b p) c → Bl a' (l b' p') c' → eqa a b p a' b' p' →
eqa p b c p' b' c' → eqa a b c a' b'  c' :=
begin
intros h h1 h2 h3,
cases h.2.2.2 with d h4,
cases exists_of_exists_unique (six11 h2.2.2.1 h2.1.symm) with a₁ ha,
suffices : ∃ d₁, col b' p' d₁ ∧ (B p' b' d₁ ↔ B p b d) ∧ eqd b' d₁ b d,
  cases this with d₁ hd,
  cases seg_cons d₁ d c a₁ with c₁ hc,
  have h5 : eqd a d a₁ d₁,
    by_cases h_1 : d = b,
      subst d,
      have h_1 : b' = d₁,
        exact id_eqd hd.2.2,
      subst d₁,
      exact ha.2.symm.flip,
    have h_2 : d₁ ≠ b',
      intro h_2,
      subst d₁,
      exact h_1 (id_eqd hd.2.2.symm.flip),
    suffices : eqa a b d a' b' d₁,
      rw eleven4 at this,
      apply this.2.2.2.2 (six5 h2.1) (six5 h_1) ha.1 (six5 h_2) ha.2.symm hd.2.2.symm,
    by_cases h_3 : B p b d,
      exact (eleven13 h2.flip h_1 h_3 h_2 (hd.2.1.2 h_3)).flip,
    have h4 := six4.2 ⟨(four11 h4.1).2.1, h_3⟩,
    have h5 : ¬B p' b' d₁,
      intro h_4,
      exact h_3 (hd.2.1.1 h_4),
    have h6 := six4.2 ⟨(four11 hd.1).2.1, h5⟩,
    exact eleven10 h2 (six5 h2.1) h4.symm (six5 ha.1.2.1) h6.symm,
  have h6 : eqd b c b' c₁,
    apply (afive_seg ⟨h4.2, hc.1, h5, hc.2.symm, ha.2.symm.flip, hd.2.2.symm.flip⟩ _).flip,
    intro h_1,
    subst d,
    exact h.2.1 h4.1,
  have h7 : eqa a b c a₁ b' c₁,
    apply eleven3.2 ⟨a, c, a₁, c₁, six5 h2.1, six5 h3.2.1, six5 ha.1.1, _⟩,
    split,
      apply six5 (two7 h6.flip h3.2.1),
    refine ⟨ha.2.symm.flip, h6, _⟩,
    exact two11 h4.2 hc.1 h5 hc.2.symm,
  apply eleven10 h7 (six5 h2.1) (six5 h3.2.1) ha.1.symm,
  have h8 : eqa p b c p' b' c₁,
    by_cases h_1 : d = b,
      subst d,
      have h_1 : b' = d₁,
        exact id_eqd hd.2.2,
      subst d₁,
      apply (eleven13 _ h3.2.1 h4.2 (two7 hc.2.symm.flip h3.2.1) hc.1).flip,
      exact eleven10 h2 (six5 h2.1) (six5 h2.2.1) ha.1 (six5 h3.2.2.1),
     have h_2 : d₁ ≠ b',
      intro h_2,
      subst d₁,
      exact h_1 (id_eqd hd.2.2.symm.flip),
    suffices : eqa d b c d₁ b' c₁,
      by_cases h_3 : B p b d,
        exact (eleven13 this h2.2.1 h_3.symm h2.2.2.2.1 (hd.2.1.2 h_3).symm),
      have h8 := six4.2 ⟨(four11 h4.1).2.1, h_3⟩,
      have h9 : ¬B p' b' d₁,
        intro h_4,
        exact h_3 (hd.2.1.1 h_4),
      have h10 := six4.2 ⟨(four11 hd.1).2.1, h9⟩,
      exact eleven10 this h8 (six5 this.2.1) h10 (six5 this.2.2.2.1),
    apply eleven3.2 ⟨d, c, d₁, c₁, six5 h_1, six5 h3.2.1, six5 h_2, (six5 h7.2.2.2.1), _⟩,
    exact ⟨hd.2.2.symm.flip, h6, hc.2.symm⟩,
  have h9 : a₁ ∉ l b' p',
      intro h_1,
      apply h1.2.1,
      exact six20 h1.1 (six17a b' p') h_1 ha.1.1.symm (four11 (six4.1 ha.1).1).2.1,
  have h10 : c₁ ∉ l b' p',
    intro h_1,
    apply h9,
    apply six20 h1.1 h_1 hd.1 _ (or.inl hc.1.symm),
    apply two7 hc.2.symm.flip,
    intro h_2,
    subst d,
    exact h.2.2.1 h4.1,
  have h11 : side (l b' p') c' c₁,
    refine ⟨a₁, (nine5 h1 (six17a b' p') ha.1.symm).symm, _⟩,
    split,
      exact h1.1,
    refine ⟨h10, h9, _⟩,
    exact ⟨d₁, hd.1, hc.1.symm⟩,
  rw six17 at h,
  rw six17 at h10,
  rw six17 at h11,
  apply eleven15b h.2.2.1 h10 h3 h11 h8,
  rw six17 b' p' at *,
  exact side.refl h1.1 h10,
by_cases h_1 : B p b d,
  simp [h_1],
  cases seg_cons b' b d p' with d₁ hd,
  exact ⟨d₁, or.inr (or.inr hd.1.symm), hd.1, hd.2⟩,
simp [h_1],
have h5 : sided b p d,
  exact six4.2 ⟨(four11 h4.1).2.1, h_1⟩,
cases exists_of_exists_unique (six11 h3.2.2.1 h5.2.1.symm) with d₁ hd,
exact ⟨d₁, (four11 (six4.1 hd.1).1).2.2.1, (six4.1 hd.1.symm).2, hd.2⟩
end

theorem eleven22b {a b c p a' b' c' p' : point} : side (l b p) a c → side (l b' p') a' c' → eqa a b p a' b' p' →
eqa p b c p' b' c' → eqa a b c a' b'  c' :=
begin
intros h h1 h2 h3,
apply eleven13 _ h2.1 (seven5 b a).1.symm h2.2.2.1 (seven5 b' a').1.symm,
have h4 : Bl a (l b p) (S b a),
  refine ⟨(nine11 h).1, (nine11 h).2.1, _, b, (six17a b p), (seven5 b a).1⟩,
  intro h_1,
  exact (nine11 h).2.1 ((seven24 (nine11 h).1 (six17a b p)).2 h_1),
have h5 : Bl a' (l b' p') (S b' a'),
  refine ⟨(nine11 h1).1, (nine11 h1).2.1, _, b', (six17a b' p'), (seven5 b' a').1⟩,
  intro h_1,
  exact (nine11 h1).2.1 ((seven24 (nine11 h1).1 (six17a b' p')).2 h_1),
apply (eleven22a _ _ (eleven13 h2 (seven12a h2.1) ((seven5 b a).1) (seven12a h2.2.2.1) (seven5 b' a').1) h3),
  exact ((nine8 h4).2 h).symm,
exact ((nine8 h5).2 h1).symm
end

def I (p a b c : point) : Prop := a ≠ b ∧ c ≠ b ∧ p ≠ b ∧ (B a b c ∨ ∃ x, B a x c ∧ sided b x p)

theorem eleven23a {a b c p : point} : I p a b c → B a b c ∨ ∃ q, a ≠ b ∧ c ≠ b ∧ q ≠ b ∧ B a q c ∧ sided b q p :=
begin
intro h,
cases h.2.2.2,
  exact or.inl h_1,
cases h_1 with q hq,
exact or.inr ⟨q, h.1, h.2.1, hq.2.1, hq.1, hq.2⟩
end

theorem eleven23b {p a b c : point} : ¬B a b c → I p a b c → a ≠ b ∧ c ≠ b ∧ p ≠ b ∧ ∃ x, B a x c ∧ sided b x p :=
begin
intros h h1,
unfold I at h1,
simpa [h] using h1
end

theorem I.symm {p a b c : point} : I p a b c → I p c b a :=
begin
intro h,
refine ⟨h.2.1, h.1, h.2.2.1, _⟩,
cases h.2.2.2,
  exact or.inl h_1.symm,
right,
cases h_1 with x hx,
exact ⟨x, hx.1.symm, hx.2⟩
end

theorem eleven25 {p a b c a' c' p' : point} : I p a b c → sided b a' a → sided b c' c → sided b p' p → I p' a' b c' :=
begin
intros h h1 h2 h3,
by_cases h_1 : B a b c,
  exact ⟨h1.1, h2.1, h3.1, or.inl (six8 h1 h2 h_1)⟩,
replace h := eleven23b h_1 h,
cases h.2.2.2 with x hx,
have h4 : ∃ x', B c x' a' ∧ sided b x' x,
  cases h1.2.2,
    cases pasch h_2 hx.1.symm with x' hx',
    refine ⟨x', hx'.1.symm, _⟩,
    apply six7 hx'.2.symm,
    intro h_3,
    subst x',
    exact h_1 (six6 hx'.1.symm h1).symm,
  cases nine6 h_2.symm hx.1.symm with x' hx',
  exact ⟨x', hx'.1.symm, (six7 hx'.2 hx.2.1).symm⟩,
cases h4 with x' hx',
have h5 : ∃ y, B a' y c' ∧ sided b x' y,
  cases h2.2.2,
    cases pasch h_2 hx'.1.symm with y hy,
    refine ⟨y, hy.1.symm, _⟩,
    apply (six7 hy.2.symm _).symm,
    intro h_3,
    subst y,
    exact h_1 (six8 h1.symm h2.symm hy.1.symm),
  cases nine6 h_2.symm hx'.1.symm with y hy,
  exact ⟨y, hy.1.symm, (six7 hy.2 hx'.2.1)⟩,
cases h5 with y hy,
refine ⟨h1.1, h2.1, h3.1, or.inr ⟨y, hy.1,_⟩⟩,
exact hy.2.symm.trans (hx'.2.trans (hx.2.trans h3.symm))
end

theorem eleven26a {a b c : point} : a ≠ b → c ≠ b → I a a b c :=
λ h h1, ⟨h, h1, h, or.inr ⟨a, three3 a c, six5 h⟩⟩

theorem eleven26b {a b c : point} : a ≠ b → c ≠ b → I c a b c :=
λ h h1, ⟨h, h1, h1, or.inr ⟨c, three1 a c, six5 h1⟩⟩

lemma eleven28 {a b c d a' b' c' : point} : cong a b c a' b' c' → col a c d →
∃ d', eqd a d a' d' ∧ eqd b d b' d' ∧ eqd c d c' d' :=
begin
intros h h1,
by_cases h_1 : a = c,
  subst c,
  have h_1 : a' = c',
    exact id_eqd h.2.2.symm,
  subst c',
  by_cases h_1 : col a b d,
    cases four14 h_1 h.1 with d' hd,
    exact ⟨d', hd.2.2, hd.2.1, hd.2.2⟩,
  have h_2 : a' ≠ b',
    intro h_2,
    subst b',
    exact (six26 h_1).1 (id_eqd h.1),
  cases six25 h_2 with p' hp,
  cases exists_of_exists_unique (ten16 h_1 hp h.1) with d' hd,
  exact ⟨d', hd.1.2.2, hd.1.2.1, hd.1.2.2⟩,
cases four14 h1 h.2.2 with d' hd,
exact ⟨d', hd.2.2, (four16 ⟨h1, hd, h.1, h.2.1.flip ⟩ h_1).flip, hd.2.1⟩
end

def ang_le (a b c d e f : point) : Prop := ∃ p, I p d e f ∧ eqa a b c d e p

theorem eleven31a {a b c d e f : point} : sided b a c → d ≠ e → f ≠ e → ang_le a b c d e f :=
λ h h1 h2, ⟨d, ⟨h1, h2, h1, or.inr ⟨d, three3 d f, six5 h1⟩⟩, (eleven21a h).2 (six5 h1)⟩

theorem eleven31b {a b c d e f : point} : a ≠ b → c ≠ b → d ≠ e → f ≠ e → B d e f → ang_le a b c d e f :=
begin
intros h h1 h2 h3 h4,
  by_cases h_1 : col a b c,
  cases six1 h_1,
    exact ⟨f, ⟨h2, h3, h3, or.inl h4⟩, eleven21c h h1 h2 h3 h_2 h4⟩,
  exact eleven31a h_2 h2 h3,
cases exists_of_exists_unique (six11 h h2.symm) with a' ha,
cases six25 h2 with x hx,
suffices : ¬col a' b c,
  cases (exists_of_exists_unique (ten16 this hx ha.2.flip)) with p hp,
  refine ⟨p, ⟨h2, h3, two7 hp.1.2.1.flip h1, or.inl h4⟩, _⟩,
  exact (eleven9 ha.1 (six5 h1)).trans (eleven11 ha.1.1 h1 hp.1),
intro h_2,
exact h_1 (four11 (five4 ha.1.1.symm (four11 h_2).2.1 (four11 (six4.1 ha.1).1).2.1)).2.2.2.1
end

theorem eleven32a {a b c d e f : point} : ¬B a b c → ang_le d e f a b c → ∃ p, B a p c ∧ eqa d e f a b p :=
begin
rintro h ⟨x, h1, h2⟩,
cases (eleven23b h h1).2.2.2 with p hp,
refine ⟨p, hp.1, _⟩,
exact eleven10 h2 (six5 h2.1) (six5 h2.2.1) (six5 h2.2.2.1) hp.2
end

theorem eleven32b {a b c p : point} : a ≠ b → c ≠ b → p ≠ b → B a p c → ang_le a b p a b c :=
begin
intros h h1 h2 h3,
exact ⟨p, ⟨h, h1, h2, or.inr ⟨p, h3, six5 h2⟩⟩, eqa.refl h h2⟩
end

theorem eleven30 {a b c d e f a' b' c' d' e' f' : point} : ang_le a b c d e f → eqa a b c a' b' c' →
eqa d e f d' e' f' → ang_le a' b' c' d' e' f' :=
begin
rintro ⟨p, hp⟩ h1 h2,
rcases eleven5.1 h2 with ⟨d₁, f₁, hd, hf, h⟩,
cases hp.1.2.2.2,
  exact eleven31b h1.2.2.1 h1.2.2.2.1 h2.2.2.1 h2.2.2.2.1 (eleven21b h_1 h2),
cases h_1 with x hx,
cases four5 hx.1 h.2.2 with y hy,
have h3 : eqd e x e' y,
  apply (four2 ⟨hx.1, hy.1, h.2.2, hy.2.2.1, h.1, h.2.1.flip⟩).flip,
suffices : ang_le a b c d₁ e' f₁,
  unfold ang_le at *,
  cases this with r hr,
  refine ⟨r, eleven25 hr.1 hd.symm hf.symm (six5 hr.1.2.2.1), _⟩,
  exact h1.symm.trans (hr.2.trans (eleven9 hd.symm (six5 hr.1.2.2.1))),
refine ⟨y, ⟨hd.1, hf.1, two7 h3.flip hx.2.1, or.inr ⟨y, hy.1, six5 (two7 h3.flip hx.2.1)⟩⟩, _⟩,
apply hp.2.trans ((eleven9 (six5 h2.1) hx.2).trans (eleven11 h2.1 hx.2.1 ⟨h.1, h3, hy.2.1⟩))
end

theorem eleven29 {a b c d e f : point} : ang_le a b c d e f ↔ ∃ q, I c a b q ∧ eqa a b q d e f :=
begin
  split,
  rintro ⟨p, hp, h⟩,
  by_cases h_1 : B d e f,
    refine ⟨S b a, ⟨h.1, (seven12a h.1), h.2.1, or.inl (seven5 b a).1⟩, _⟩,
    exact eleven21c h.1 (seven12a h.1) hp.1 hp.2.1 (seven5 b a).1 h_1,
  unfold I at hp,
  simp [h_1, - ne.def] at hp,
  cases hp.2.2.2 with x hx,
  have h1 : eqa a b c d e x,
    exact eleven10 h (six5 h.1) (six5 h.2.1) (six5 h.2.2.1) hx.2,
  rcases eleven5.1 h1.symm with ⟨a', c', h2, h3, h4⟩,
  cases eleven28 h4 (or.inl hx.1) with q hq,
  existsi q,
  suffices : I c' a' b q ∧ eqa a' b q d e f,
    refine ⟨eleven25 this.1 h2.symm (six5 this.1.2.1).symm h3.symm, _⟩,
    exact eleven10 this.2 h2.symm (six5 this.2.2.1) (six5 this.2.2.2.1) (six5 this.2.2.2.2.1),
  have h5 : B a' c' q,
    exact four6 hx.1 ⟨h4.2.2, hq.2.2, hq.1⟩,
  refine ⟨⟨h2.1, (two7 hq.2.1.flip hp.2.1), h3.1, or.inr ⟨c', h5, six5 h3.1⟩⟩, _⟩,
  have h6 : eqa c' b q x e f,
    exact eleven11 h3.1 (two7 hq.2.1.flip hp.2.1) ⟨h4.2.1.symm.flip, hq.2.1.symm, hq.2.2.symm⟩,
  by_cases h_2 : col d e x,
    have h7 : sided e d x,
      apply six4.2 ⟨h_2, _⟩,
      intro h_3,
      exact h_1 (three6b h_3 hx.1),
    apply eleven10 h6 _ (six5 h6.2.1) h7 (six5 h6.2.2.2.1),
    exact six10a h7 ⟨h4.1.flip, h4.2.2, h4.2.1⟩,
  by_cases h_3 : col x e f,
    have h7 : sided e x f,
      apply six4.2 ⟨h_3, _⟩,
      intro h_4,
      exact h_1 (three5b hx.1 h_4),
    apply eleven10 (eleven11 h2.1 h3.1 h4.symm) (six5 h2.1) _ (six5 h.2.2.1) h7.symm,
    exact six10a h7.symm ⟨hq.2.1, hq.2.2.flip, h4.2.1⟩,
  apply eleven22a _ _ (eleven11 h2.1 h3.1 h4.symm) h6,
    unfold Bl,
    refine ⟨six14 h3.1.symm, _, _, c', six17b b c', h5⟩,
      intro h_4,
      exact h_2 (four13 (four11 h_4).2.2.2.1 h4.symm),
    intro h_4,
    exact h_3 (eleven21d (four11 h_4).2.1 h6),
  refine ⟨six14 hx.2.1.symm, (four10 h_2).2.2.1, (four10 h_3).2.1, x, six17b e x, hx.1⟩,
rintro ⟨q, h, h1⟩,
apply eleven30 _ (eqa.refl h.1 h.2.2.1) h1,
exact ⟨c, h, (eqa.refl h.1 h.2.2.1)⟩
end

theorem eleven33 {a b c d e f : point} : ang_le a b c d e f → a ≠ b ∧ c ≠ b ∧ d ≠ e ∧ f ≠ e :=
λ ⟨p, hp⟩, ⟨hp.2.1, hp.2.2.1, hp.1.1, hp.1.2.1⟩

theorem eleven33a {a b c d e f : point} : ang_le a b c d e f → ang_le c b a d e f :=
λ h, have h1 : _ := eleven33 h, eleven30 h (eleven6 h1.1 h1.2.1) (eqa.refl h1.2.2.1 h1.2.2.2)

theorem eleven33b {a b c d e f : point} : ang_le a b c d e f → ang_le a b c f e d :=
λ h, have h1 : _ := eleven33 h, eleven30 h (eqa.refl h1.1 h1.2.1) (eleven6 h1.2.2.1 h1.2.2.2)

theorem ang_le.refl {a b c : point} : a ≠ b → c ≠ b → ang_le a b c a b c :=
λ h h1, ⟨c, eleven26b h h1, eqa.refl h h1⟩

theorem ang_le.trans {a b c d e f x y z : point} : ang_le a b c d e f → ang_le d e f x y z →
ang_le a b c x y z :=
begin
intros h h1,
rcases h1 with ⟨q, h2, h3⟩,
  cases h2.2.2.2,
  exact eleven31b (eleven33 h).1 (eleven33 h).2.1 h2.1 h2.2.1 h_1,
cases h_1 with r hr,
replace h3 := eleven10 h3 (six5 h3.1) (six5 h3.2.1) (six5 h3.2.2.1) hr.2,
replace h := eleven30 h (eqa.refl (eleven33 h).1 (eleven33 h).2.1) h3,
rcases h with ⟨s, hs, h4⟩,
cases hs.2.2.2,
  exact eleven31b h4.1 h4.2.1 h2.1 h2.2.1 (three6b h hr.1),
cases h with p hp,
refine ⟨p, ⟨h2.1, h2.2.1, hp.2.1, or.inr ⟨p, three6b hp.1 hr.1, six5 hp.2.1⟩⟩, _⟩,
exact eleven10 h4 (six5 h4.1) (six5 h4.2.1) (six5 h4.2.2.1) hp.2
end

theorem ang_le.flip {a b c d e f : point} : ang_le a b c d e f → ang_le c b a f e d :=
λ h, eleven33b (eleven33a h)

theorem eleven34 {a b c d e f : point} : ang_le a b c d e f → ang_le d e f a b c → eqa a b c d e f :=
begin
rintro ⟨p, h, h1⟩ h2,
by_cases h_1 : B d e f,
  apply eleven21c h1.1 h1.2.1 h.1 h.2.1 _ h_1,
  rcases h2 with ⟨q, h2, h3⟩,
  cases eleven23a h2,
    exact h_2,
  cases h_2 with r hr,
  apply three6b (eleven21b h_1 _) hr.2.2.2.1,
  exact eleven10 h3 (six5 h3.1) (six5 h3.2.1) (six5 h3.2.2.1) hr.2.2.2.2,
rcases eleven29.1 h2 with ⟨q, h4, h3⟩,
replace h2 := eleven23a h4,
clear h4,
cases h2,
  exfalso,
  cases (eleven23b h_1 h).2.2.2 with r hr,
  exact h_1 (three6b (six6 (eleven21b h2 (h3.trans h1)) hr.2.symm) hr.1),
cases h2 with t ht,
have h4 : ¬B d e t,
  intro h_2,
  exact h_1 (six6 h_2 ht.2.2.2.2),
cases (eleven23b h4 (eleven25 h (six5 h.1) ht.2.2.2.2 (six5 h.2.2.1))).2.2.2 with r hr,
replace h1 := eleven10 h1 (six5 h1.1) (six5 h1.2.1) (six5 h1.2.2.1) hr.2,
apply eleven10 _ (six5 h3.2.2.1) (six5 h3.2.2.2.1) (six5 h3.1) ht.2.2.2.2.symm,
by_cases h_2 : col a b c,
  cases six1 h_2,
    apply eleven21c h1.1 h1.2.1 ht.1 ht.2.2.2.2.1 h_3,
    exact three6b (eleven21b h_3 h1) hr.1,
  exact (eleven21a h_3).2 (six6a ((eleven21a h_3).1 h3.symm) ht.2.2.2.1),
suffices : sided e r q,
  apply eleven10 h1 (six5 h1.1) (six5 h1.2.1) (six5 h1.2.2.1) _,
  exact (six6a this (three6a hr.1 ht.2.2.2.1)).symm,
have h5 : ¬col d e r,
  intro h_3,
  exact h_2 (eleven21d h_3 h1.symm),
apply eleven15b h_2 h5 h1 (side.refl (six14 ht.1) h5) h3.symm,
apply nine12 (six14 ht.1) (six17a d e) ((six7 (three6b hr.1 ht.2.2.2.1) (six26 h5).2.2.symm).symm),
intro h_3,
exact h5 (eleven21d h_3 (h3.trans h1))
end

theorem eleven35 {a b c d e f : point} : a ≠ b → c ≠ b → d ≠ e → f ≠ e → ang_le a b c d e f ∨ ang_le d e f a b c :=
begin
intros h h1 h2 h3,
by_cases h4 : col a b c,
  cases six1 h4,
    exact or.inr (eleven31b h2 h3 h h1 h_1),
  exact or.inl (eleven31a h_1 h2 h3),
by_cases h5 : col d e f,
  cases six1 h5,
    exact or.inl (eleven31b h h1 h2 h3 h_1),
  exact or.inr (eleven31a h_1 h h1),
rcases eleven15a h5 h4 with ⟨c', h6, hc⟩,
rw six17 at hc,
have h7 : c' ∈ pl (l b c) a,
  suffices : pl (l b a) c = pl (l b c) a,
    exact this ▸ (or.inl hc),
  exact (nine24 (four10 h4).2.1).1,
cases h7,
  cases (nine31 hc h7).2.2.2 with x hx,
  refine or.inr ⟨c', ⟨h, h1, h6.2.2.2.1, or.inr ⟨x, hx.2, _⟩⟩, h6⟩,
  apply (nine19 (six14 h.symm) (six17a b a) (four11 hx.1).2.2.2.2 _).1,
  apply (nine19a hc (six17b b a) (six7 hx.2 _).symm).symm,
  intro h_1,
  subst x,
  exact (nine11 hc).2.1 (four11 hx.1).1,
suffices : ∃ x, col b c x ∧ B c' x a,
  cases this with x hx,
  refine or.inl (eleven29.2 ⟨c', ⟨h, h6.2.2.2.1, h1, or.inr ⟨x, hx.2.symm, _⟩⟩, h6.symm⟩),
  apply (nine19 (six14 h.symm) (six17a b a) (four11 hx.1).2.2.2.2 _).1,
  apply (nine19a hc.symm (six17b b a) (six7 hx.2.symm _).symm).symm,
  intro h_1,
  subst x,
  exact (nine11 hc).2.2 (four11 hx.1).1,
cases h7,
  exact ⟨c', h7, three3 c' a⟩,
exact h7.symm.2.2.2
end

lemma eleven36a {a b c d e f a' d' : point} : a' ≠ b → d' ≠ e → B a b a' → B d e d' →
ang_le a b c d e f → ang_le d' e f a' b c :=
begin
intros h h1 h2 h3 h4,
by_cases h_1 : col a b c,
  cases six1 h_1,
    suffices : B d e f,
      apply eleven31a _ h (eleven33 h4).2.1,
      exact ⟨h1, (eleven33 h4).2.2.2, five2 (eleven33 h4).2.2.1 h3 this⟩,
    exact eleven21b h_2 (eleven34 h4 (eleven31b (eleven33 h4).2.2.1 (eleven33 h4).2.2.2 (eleven33 h4).1 (eleven33 h4).2.1 h_2)),
  apply eleven31b h1 (eleven33 h4).2.2.2 h (eleven33 h4).2.1 _,
  exact six6 h2.symm h_2,
cases eleven29.1 h4 with p hp,
cases hp.1.2.2.2,
  suffices : B d e f,
    apply eleven31a _ h (eleven33 h4).2.1,
    exact ⟨h1, (eleven33 h4).2.2.2, five2 (eleven33 h4).2.2.1 h3 this⟩,
  exact eleven21b h_2 hp.2,
cases h_2 with y hy,
by_cases h_2 : y = p,
  subst y,
  apply eleven30 (ang_le.refl h (eleven33 h4).2.1) _ (eqa.refl h (eleven33 h4).2.1),
  exact eleven13 (eleven10 hp.2 (six5 hp.2.1) hy.2.symm (six5 hp.2.2.2.1) (six5 hp.2.2.2.2.1)) h h2 h1 h3,
refine ⟨p, ⟨h, hp.1.2.2.1, hp.1.2.1, or.inr _⟩, (eleven13 hp.2 h h2 h1 h3).symm⟩,
have h5 : side (l b p) a c,
  apply (nine19a _ (six17a b p) hy.2),
  apply (nine12 (six14 hp.2.2.1.symm) (six17b b p) (six7 hy.1.symm h_2) _).symm,
  intro h_3,
  apply h_1 (six23.2 ⟨l b p, (six14 hp.2.2.1.symm), _, (six17a b p), _⟩),
    rw (six18 (six14 hp.2.2.1.symm) h_2 h_3 (six17b b p)),
    exact or.inr (or.inr hy.1),
  rw (six18 (six14 hp.2.2.1.symm) hy.2.1 h_3 (six17a b p)),
  exact (six4.1 hy.2).1,
have h6 : Bl c (l b p) a',
  apply (nine8 ⟨(nine11 h5).1, (nine11 h5).2.1, _, ⟨b, (six17a b p), h2⟩⟩).2 h5,
  intro h_3,
  apply (nine11 h5).2.1,
  rw (six18 ((nine11 h5).1) h h_3 (six17a b p)),
  exact or.inl h2.symm,
cases h6.2.2.2 with x hx,
refine ⟨x, hx.2.symm, six4.2 ⟨(four11 hx.1).2.2.2.1, _⟩⟩,
intro h_3,
suffices : side (l a b) p c,
  have h6 : side (l a b) p x,
    apply nine19a this (or.inl h2) (six7 hx.2.symm _).symm,
    intro h_4,
    subst x,
    exact h6.2.2.1 (or.inr (or.inr h_3)),
  apply (nine9 _) h6,
  exact ⟨(nine11 h6).1, (nine11 h6).2.1, (nine11 h6).2.2, ⟨b, (six17b a b), h_3.symm⟩⟩,
have h7 : side (l a b) c y,
  exact nine12 (six14 (six26 h_1).1) (six17b a b) hy.2.symm h_1,
apply (nine19a h7 (six17a a b) _).symm,
apply (six7 hy.1 _),
intro h_4,
subst y,
exact (nine11 h7).2.2 (six17a a b)
end

theorem eleven36 {a b c d e f a' d' : point} : a ≠ b → a' ≠ b → d ≠ e → d' ≠ e → B a b a' → B d e d' →
(ang_le a b c d e f ↔ ang_le d' e f a' b c) :=
begin
intros h h1 h2 h3 h4 h5,
split,
  intro h6,
  exact eleven36a h1 h3 h4 h5 h6,
intro h6,
exact eleven36a h2 h h5.symm h4.symm h6
end

def ang_lt (a b c d e f : point) : Prop := ang_le a b c d e f ∧ ¬eqa a b c d e f

theorem ang_lt_or_eq_of_le {a b c d e f : point} : ang_le a b c d e f → (ang_lt a b c d e f ∨ eqa a b c d e f) :=
begin
intro h,
by_cases h1 : eqa a b c d e f,
  exact or.inr h1,
exact or.inl ⟨h, h1⟩,
end

theorem ang_lt.flip {a b c d e f : point} : ang_lt a b c d e f → ang_lt c b a f e d :=
λ h, ⟨h.1.flip, λ h_1, h.2 h_1.flip⟩

theorem eleven32c {a b c d e f : point} : ¬B a b c → ang_lt d e f a b c → ∃ p, p ≠ c ∧ B a p c ∧ eqa d e f a b p :=
begin
rintro h ⟨h1, h2⟩,
cases eleven32a h h1 with p hp,
refine ⟨p, _, hp.1, hp.2⟩,
intro h_1,
subst p,
exact h2 hp.2
end

theorem eleven32d {a b c p : point} : ¬col a b c → p ≠ c → B a p c → ang_lt a b p a b c :=
begin
intros h h1 h2,
refine ⟨eleven32b (six26 h).1 (six26 h).2.1.symm _ h2, _⟩,
  intro h_1,
  subst p,
  exact h (or.inl h2),
intro h_1,
by_cases h_2 : p = a,
  subst p,
  exact h (six4.1 ((eleven21a (six5 (six26 h).1)).1 h_1)).1,
have h3 : sided a c p,
  exact (six7 h2 h_2).symm,
have h4 : side (l a b) c p,
  exact nine12 (six14 (six26 h).1) (six17a a b) (six7 h2 h_2).symm h,
suffices : sided b c p,
  exact (four10 h).2.2.2.1 (five4 h1.symm (or.inl h2.symm) (four11 (six4.1 this).1).1),
exact eleven15c h_1.symm h4
end

theorem eleven37 {a b c d e f a' b' c' d' e' f' : point} : ang_lt a b c d e f → eqa a b c a' b' c' →
eqa d e f d' e' f' → ang_lt a' b' c' d' e' f' :=
begin
rintro ⟨h, h1⟩ h2 h3,
refine ⟨eleven30 h h2 h3, _⟩,
intro h_1,
exact h1 (h2.trans (h_1.trans h3.symm))
end

theorem eleven37a {a b c d e f a' d' : point} : a' ≠ b → d' ≠ e → B a b a' → B d e d' →
ang_lt a b c d e f → ang_lt d' e f a' b c :=
begin
rintro h h1 h2 h3 h4,
refine ⟨eleven36a h h1 h2 h3 h4.1, _⟩,
intro h_1,
exact h4.2 (eleven13 h_1.symm (eleven33 h4.1).1 h2.symm (eleven33 h4.1).2.2.1 h3.symm)
end

theorem eleven38a {a b c d e f : point} : ang_lt a b c d e f ↔ a ≠ b ∧ c ≠ b ∧ d ≠ e ∧ f ≠ e ∧ ¬ang_le d e f a b c :=
begin
split,
  rintro ⟨⟨p, h, h1⟩, h2⟩,
  refine ⟨h1.1, h1.2.1, h1.2.2.1, h.2.1, _⟩,
  intro h3,
  exact h2 (eleven34 ⟨p, h, h1⟩ h3),
rintro ⟨h, h1, h2, h3, h4⟩,
split,
  simpa [h4] using (eleven35 h h1 h2 h3),
intro h_1,
exact h4 (eleven30 (ang_le.refl h h1) h_1 (eqa.refl h h1))
end

theorem ang_lt_or_ge {a b c d e f : point} : a ≠ b → c ≠ b → d ≠ e → f ≠ e → (ang_lt a b c d e f ∨ ang_le d e f a b c) :=
begin
intros h h1 h2 h3,
by_cases h_1 : ang_le d e f a b c,
  exact or.inr h_1,
exact or.inl (eleven38a.2 ⟨h, h1, h2, h3, h_1⟩)
end

theorem eleven38b {a b c d e f : point} : ang_lt a b c d e f → ang_lt d e f a b c → false :=
begin
intros h h1,
suffices : ¬ang_lt d e f a b c,
  exact this h1,
intro h_1,
exact (eleven38a.1 h).2.2.2.2 h_1.1
end

theorem eleven39 {a b c d e f a' d' : point} : a ≠ b → a' ≠ b → d ≠ e → d' ≠ e → B a b a' → B d e d' →
(ang_lt a b c d e f ↔ ang_lt d' e f a' b c) :=
begin
intros h h1 h2 h3 h4 h5,
split,
  intro h6,
  refine ⟨(eleven36 h h1 h2 h3 h4 h5).1 h6.1, _⟩,
  intro h_1,
  exact h6.2 (eleven13 h_1.symm h h4.symm h2 h5.symm),
intro h6,
refine ⟨(eleven36 h h1 h2 h3 h4 h5).2 h6.1, _⟩,
intro h_1,
exact h6.2 (eleven13 h_1.symm h3 h5 h1 h4)
end

theorem ang_lt.trans {a b c d e f x y z : point} : ang_lt a b c d e f → ang_lt d e f x y z → ang_lt a b c x y z :=
begin
intros h h1,
refine ⟨ang_le.trans h.1 h1.1, _⟩,
intro h_1,
replace h1 := eleven37 h1 (eqa.refl (eleven38a.1 h1).1 (eleven38a.1 h1).2.1) h_1.symm,
exact eleven38b h h1
end

def ang_acute (a b c : point) : Prop := ∃ x y z, R x y z ∧ ang_lt a b c x y z

theorem tri_of_ang_acute {a b c : point} : ang_acute a b c → a ≠ b ∧ c ≠ b :=
λ ⟨x, y, z, h⟩, ⟨(eleven38a.1 h.2).1, (eleven38a.1 h.2).2.1⟩

theorem ang_acute.symm {a b c : point} : ang_acute a b c → ang_acute c b a :=
begin
rintro ⟨x, y, z, h, h1⟩,
refine ⟨x, y, z, h, (eleven37 h1 (eleven6 (eleven38a.1 h1).1 (eleven38a.1 h1).2.1) _)⟩,
exact (eqa.refl (eleven38a.1 h1).2.2.1 (eleven38a.1 h1).2.2.2.1)
end

theorem acute_of_sided {a b c : point} : sided b a c → ang_acute a b c :=
begin
intro h,
cases eight25 h.1 with d hd,
refine ⟨a, b, d, hd.1, eleven31a h h.1 hd.2, _⟩,
intro h1,
cases (eight9 hd.1 (six4.1 ((eleven21a h).1 h1)).1),
  exact h.1 h_1,
exact hd.2 h_1
end

theorem sided_of_acute_col {a b c : point} : ang_acute a b c → col a b c → sided b a c :=
λ ⟨x, y, z, h⟩ h1, have h2 : _ := eleven38a.1 h.2,
(six1 h1).elim (λ h_1, (h2.2.2.2.2 (eleven31b h2.2.2.1 h2.2.2.2.1 h2.1 h2.2.1 h_1)).elim) id

def ang_obtuse (a b c : point) : Prop := ∃ x y z, R x y z ∧ ang_lt x y z a b c

theorem tri_of_ang_obtuse {a b c : point} : ang_obtuse a b c → a ≠ b ∧ c ≠ b ∧ a ≠ c :=
begin
rintro ⟨x, y, z, h⟩,
refine ⟨(eleven38a.1 h.2).2.2.1, (eleven38a.1 h.2).2.2.2.1, _⟩,
intro h_1,
subst c,
have h1 := eleven38a.1 h.2,
exact h1.2.2.2.2 (eleven31a (six5 h1.2.2.1) h1.1 h1.2.1)
end

theorem ang_obtuse.symm {a b c : point} : ang_obtuse a b c → ang_obtuse c b a :=
begin
rintro ⟨x, y, z, h, h1⟩,
refine ⟨x, y, z, h, (eleven37 h1 _ (eleven6 (eleven38a.1 h1).2.2.1 (eleven38a.1 h1).2.2.2.1))⟩,
exact (eqa.refl (eleven38a.1 h1).1 (eleven38a.1 h1).2.1)
end

theorem obtuse_of_B {a b c : point} : a ≠ b → c ≠ b → B a b c → ang_obtuse a b c :=
begin
intros h h1 h2,
cases eight25 h with d hd,
refine ⟨a, b, d, hd.1, eleven31b h hd.2 h h1 h2, _⟩,
intro h3,
cases (eight9 hd.1 (or.inl ((eleven21b h2) h3.symm))),
  exact h h_1,
exact hd.2 h_1
end

theorem B_of_obtuse_col {a b c : point} : ang_obtuse a b c → col a b c → a ≠ b ∧ c ≠ b ∧ B a b c :=
begin
rintro ⟨x, y, z, h⟩ h1,
have h2 := eleven38a.1 h.2,
cases six1 h1,
  exact ⟨h2.2.2.1, h2.2.2.2.1, h_1⟩,
exact (h2.2.2.2.2 (eleven31a h_1 h2.1 h2.2.1)).elim
end

theorem eleven40a {a b c d : point} : a ≠ b → c ≠ b → d ≠ b → B c b d → (ang_acute a b c ↔ ang_obtuse a b d) :=
begin
intros h h1 h2 h3,
split; rintro ⟨x, y, z, h4⟩,
  exact ⟨x, y, S y z, h4.1.flip, (eleven37a h2 (seven12a (eleven33 h4.2.1).2.2.2) h3 (seven5 y z).1 h4.2.flip).flip⟩,
exact ⟨x, y, S y z, h4.1.flip, (eleven37a (seven12a (eleven33 h4.2.1).2.1) h1 (seven5 y z).1 h3.symm h4.2.flip).flip⟩
end

def ang_right (a b c : point) : Prop := a ≠ b ∧ c ≠ b ∧ R a b c

theorem ang_right.symm {a b c : point} : ang_right a b c → ang_right c b a :=
λ h, ⟨h.2.1, h.1, h.2.2.symm⟩

theorem ang_right.flip {a b c : point} : ang_right a b c → ang_right a b (S b c) :=
λ h, ⟨h.1, (seven12a h.2.1), h.2.2.flip⟩

theorem eleven16a {a b c d e f : point} : ang_right a b c → ang_right d e f → eqa a b c d e f :=
λ h h1, eleven16 h.1 h.2.1 h1.1 h1.2.1 h.2.2 h1.2.2

theorem eleven40b {a b c d : point} : a ≠ b → c ≠ b → d ≠ b → B c b d → (ang_right a b c ↔ ang_right a b d) :=
begin
intros h h1 h2 h3,
split; intro h4;
refine ⟨h, _, eleven17 h4.2.2.flip (eleven9 (six5 h) _)⟩; try {assumption},
  exact (six2 h2 (seven12a h1) h1 h3.symm).1 (seven5 b c).1.symm,
exact (six2 h1 (seven12a h2) h2 h3).1 (seven5 b d).1.symm
end

theorem not_col_of_right {a b c : point} : ang_right a b c → ¬col a b c :=
λ h h1, (eight9 h.2.2 h1).elim h.1 h.2.1

theorem ang_acute.trans {a b c d e f : point} : ang_acute a b c → eqa a b c d e f → ang_acute d e f :=
λ ⟨x, y, z, h⟩ h1, ⟨x, y, z, h.1, eleven37 h.2 h1 (eqa.refl (eleven38a.1 h.2).2.2.1 (eleven38a.1 h.2).2.2.2.1)⟩

theorem ang_obtuse.trans {a b c d e f : point} : ang_obtuse a b c → eqa a b c d e f → ang_obtuse d e f :=
λ ⟨x, y, z, h⟩ h1, ⟨x, y, z, h.1, eleven37 h.2 (eqa.refl (eleven38a.1 h.2).1 (eleven38a.1 h.2).2.1) h1⟩

theorem ang_right.trans {a b c d e f : point} : ang_right a b c → eqa a b c d e f → ang_right d e f :=
λ h h1, ⟨h1.2.2.1, h1.2.2.2.1, eleven17 h.2.2 h1⟩

theorem lt_ang_right_of_ang_acute {a b c p q r : point} : ang_acute a b c → ang_right p q r → ang_lt a b c p q r :=
λ ⟨x, y, z, h⟩ h1, eleven37 h.2 (eqa.refl (eleven38a.1 h.2).1 (eleven38a.1 h.2).2.1)
(eleven16 (eleven38a.1 h.2).2.2.1 (eleven38a.1 h.2).2.2.2.1 h1.1 h1.2.1 h.1 h1.2.2)

theorem lt_ang_obtuse_of_ang_right {a b c p q r : point} : ang_right p q r → ang_obtuse a b c → ang_lt p q r a b c :=
λ h ⟨x, y, z, h1⟩, eleven37 h1.2 (eleven16 (eleven38a.1 h1.2).1 (eleven38a.1 h1.2).2.1 h.1 h.2.1 h1.1 h.2.2)
(eqa.refl (eleven38a.1 h1.2).2.2.1 (eleven38a.1 h1.2).2.2.2.1)

theorem lt_ang_obtuse_of_ang_acute {a b c d e f : point} : ang_acute a b c → ang_obtuse d e f → ang_lt a b c d e f :=
λ ⟨x, y, z, h⟩ h1, h.2.trans (lt_ang_obtuse_of_ang_right ⟨(eleven38a.1 h.2).2.2.1, (eleven38a.1 h.2).2.2.2.1, h.1⟩ h1)

theorem ang_total {a b c d e f : point} : a ≠ b → c ≠ b → d ≠ e → f ≠ e →
(ang_lt a b c d e f ∨ eqa a b c d e f ∨ ang_lt d e f a b c) :=
begin
intros h h1 h2 h3,
unfold ang_lt,
cases eleven35 h h1 h2 h3,
  by_cases h_2 : eqa a b c d e f;
  simp [h_1, h_2],
by_cases h_2 : eqa a b c d e f,
  simp [h_2, h_1],
refine or.inr (or.inr ⟨h_1, _⟩),
intro h_3,
exact h_2 h_3.symm
end

theorem right_total {a b c : point} : a ≠ b → c ≠ b → (ang_acute a b c ∨ ang_right a b c ∨ ang_obtuse a b c) :=
begin
intros h h1,
cases eight25 h with t ht,
cases ang_lt_or_ge h h1 h ht.2,
  exact or.inl ⟨a, b, t, ht.1, h_1⟩,
cases ang_lt_or_eq_of_le h_1,
  exact or.inr (or.inr ⟨a, b, t, ht.1, h_2⟩),
exact or.inr (or.inl ⟨h, h1, (eleven17 ht.1 h_2)⟩)
end

lemma eleven41a {a b c d : point} : ¬col a b c → B b a d → d ≠ a → ang_lt a c b c a d :=
begin
intros h h1 h2,
generalize h3 : S (mid a c) b = p,
have h4 : eqa a c b c a p,
  suffices : eqa a c b (S (mid a c) a) (S (mid a c) c) (S (mid a c) b),
    rwa [h3, mid_to_Sa a c, mid.symm a c, mid_to_Sa c a] at this,
  exact eleven12 (mid a c) (six26 h).2.2 (six26 h).2.1,
cases pasch h1.symm (seven5 (mid a c) b).1.symm with x hx,
rw h3 at hx,
have h5 : I p c a d,
  suffices : I p (mid a c) a d,
    apply eleven25 this (six7 (ten1 a c).1 _).symm (six5 this.2.1) (six5 this.2.2.1),
    exact mid.neq (six26 h).2.2,
  have h6 : x ≠ a,
    intro h_1,
    subst x,
    apply h (six23.2 ⟨l d a, six14 h2,(six17b d a), or.inl h1.symm, _⟩),
    exact or.inl (three7b hx.2.symm (ten1 a c).1 (mid.neq (six26 h).2.2).symm),
  refine ⟨mid.neq (six26 h).2.2 , h2, _, or.inr ⟨x, hx.2, (six7 hx.1 h6)⟩⟩,
  exact (six7 hx.1 h6).2.1,
refine ⟨⟨p, h5, h4⟩, _⟩,
intro h_1,
suffices h7 : side (l c a) d p,
  suffices : ¬col d a p,
    have h8 : ¬sided a d p,
      intro h_2,
      exact this (six4.1 h_2).1,
    apply h8 (eleven15b (four10 h).1 (nine11 h7).2.1 h_1 _ h4 h7.symm),
    exact side.trans h7 h7.symm,
  intro h_2,
  apply h (six23.2 ⟨l d a, six14 h2,(six17b d a), or.inl h1.symm, _⟩),
  rw ←mid_to_Sa a c,
  apply (seven24 (six14 h2) _).1 (six17b d a),
  apply six27 (six14 h2) (or.inl h1.symm) h_2,
  rw ←h3,
  exact (seven5 (mid a c) b).1,
rw six17,
refine ⟨b, ⟨six14 (six26 h).2.2, _, (four10 h).1, ⟨a, (six17a a c), h1.symm⟩⟩, ⟨six14 (six26 h).2.2, _⟩⟩,
  intro h_2,
  exact h (six23.2 ⟨l d a, six14 h2,(six17b d a), or.inl h1.symm, (four11 h_2).2.2.2.1⟩),
subst p,
refine ⟨_, (four10 h).1, ⟨(mid a c), or.inr (or.inl (ten1 a c).1.symm), (seven5 (mid a c) b).1.symm⟩⟩,
intro h_2,
exact (four10 h).1 ((seven24 (six14 (six26 h).2.2) (or.inr (or.inl (ten1 a c).1.symm))).2 h_2),
end

theorem eleven41 {a b c d : point} : ¬col a b c → B b a d → d ≠ a → ang_lt a c b c a d ∧ ang_lt a b c c a d :=
begin
intros h h1 h2,
refine ⟨eleven41a h h1 h2, _⟩,
have h3 : eqa c a d b a (S a c),
  apply ((eleven6 h2 (six26 h).2.2.symm).trans _).flip,
  apply eleven14 (six26 h).2.2.symm h2 (seven12a (six26 h).2.2.symm) (six26 h).1.symm _ h1.symm,
  exact (seven5 a c).1,
apply eleven37 _ (eqa.refl (six26 h).1 (six26 h).2.1.symm) h3.symm,
exact eleven41a (four10 h).1 (seven5 a c).1 (seven12a (six26 h).2.2.symm)
end

theorem eleven42a {a b c d e f : point} : ang_lt a b c d e f → ang_lt c b a d e f :=
λ h, ⟨eleven33a h.1, λ h_1, h.2 (eleven7 h_1)⟩

theorem eleven42b {a b c d e f : point} : ang_lt a b c d e f → ang_lt a b c f e d :=
λ h, ⟨eleven33b h.1, λ h_1, h.2 (eleven8 h_1)⟩

theorem eleven43 {a b c : point} : (ang_right b a c ∨ ang_obtuse b a c) → ang_acute a b c ∧ ang_acute a c b :=
begin
intro h1,
by_cases h : col a b c,
  replace h1 : ang_obtuse b a c,
    exact h1.elim (λ h_1, ((not_col_of_right h_1) (four11 h).2.1).elim) id,
  replace h1 := B_of_obtuse_col h1 (four11 h).2.1,
  exact ⟨acute_of_sided (six7 h1.2.2 h1.1.symm), acute_of_sided (six7 h1.2.2.symm h1.2.1.symm)⟩,
have h2 := eleven41 h (seven5 a b).1 (seven12a (six26 h).1.symm),
cases h1,
  exact ⟨⟨c, a, (S a b), h1.2.2.symm.flip, h2.2⟩, c, a, (S a b), h1.2.2.symm.flip, h2.1⟩,
suffices : ang_acute c a (S a b),
  rcases this with ⟨x, y, z, h3, h4⟩,
  refine ⟨⟨x, y, z, h3, h2.2.trans h4⟩, x, y, z, h3, h2.1.trans h4⟩,
exact (eleven40a (six26 h).2.2.symm (seven12a (six26 h).1.symm) (six26 h).1.symm (seven5 a b).1.symm).2 h1.symm
end

lemma eleven44c {a b c : point} : ¬col a b c → eqd a b a c → eqa a c b a b c :=
begin
intros h h1,
suffices : cong a c b a b c,
  exact eleven11 (six26 h).2.2 (six26 h).2.1 this,
exact ⟨h1.symm, two5 (eqd.refl c b), h1⟩
end

theorem eleven44d {a b c : point} : ¬col a b c → distlt a b a c → ang_lt a c b a b c :=
begin
intros h h1,
cases five13.1 h1 with d hd,
have h2 : ¬col d c b,
  intro h_1,
  exact (four10 h).2.2.2.1 (five4 hd.2.2.symm (or.inl hd.1.symm) (four11 h_1).2.1),
have h3 : ang_lt d b c b d a ∧ ang_lt d c b b d a,
  exact eleven41 h2 hd.1.symm (two7 hd.2.1 (six26 h).1),
have h4 : ¬col a b d,
  intro h_1,
  exact h (five4 (two7 hd.2.1 (six26 h).1) (four11 h_1).1 (or.inl hd.1)),
suffices : ang_lt a b d a b c,
  apply ang_lt.trans _ this,
  apply eleven37 h3.2 (eleven9 _ (six5 (six26 h).2.1)) (eqa.trans _ (eleven44c h4 hd.2.1)),
    exact (six7 hd.1.symm hd.2.2).symm,
  exact (eleven6 (six26 h4).2.1 (six26 h4).2.2),
exact eleven32d h hd.2.2 hd.1
end

theorem eleven44a {a b c : point} : ¬col a b c → (eqd a b a c ↔ eqa a c b a b c) :=
begin
intro h,
refine ⟨eleven44c h, _⟩,
intro h1,
cases dist_total a b a c,
  exact ((eleven44d h h_1).2 h1).elim,
cases h_1,
  assumption,
exact ((eleven44d (four10 h).1 h_1).2 h1.symm).elim
end

theorem eleven44b {a b c : point} : ¬col a b c → (distlt a b a c ↔ ang_lt a c b a b c) :=
begin
intro h,
refine ⟨eleven44d h, _⟩,
intro h1,
cases dist_total a b a c,
  assumption,
cases h_1,
  exact (h1.2 (eleven44c h h_1)).elim,
exact (eleven38b h1 (eleven44d (four10 h).1 h_1)).elim
end

theorem eleven45a {a b c : point} : ang_acute a b c → ¬ang_right a b c ∧ ¬ang_obtuse a b c :=
λ h, ⟨λ h1, (lt_ang_right_of_ang_acute h h1).2 (eqa.refl (tri_of_ang_acute h).1 (tri_of_ang_acute h).2),
λ h1, (lt_ang_obtuse_of_ang_acute h h1).2 (eqa.refl (tri_of_ang_acute h).1 (tri_of_ang_acute h).2)⟩

theorem eleven45b {a b c : point} : ang_obtuse a b c → ¬ang_acute a b c ∧ ¬ang_right a b c :=
λ h, ⟨λ h1, (eleven45a h1).2 h, λ h1, (lt_ang_obtuse_of_ang_right h1 h).2
(eqa.refl (tri_of_ang_obtuse h).1 (tri_of_ang_obtuse h).2.1)⟩

theorem eleven45c {a b c : point} : ang_right a b c → ¬ang_acute a b c ∧ ¬ang_obtuse a b c :=
λ h, ⟨λ h1, (eleven45a h1).1 h, λ h1, (eleven45b h1).2 h⟩

theorem eleven46 {a b c : point} : (ang_right b a c ∨ ang_obtuse b a c) → distlt a b b c ∧ distlt a c b c :=
begin
intro h1,
by_cases h : col a b c,
  replace h1 : ang_obtuse b a c,
    exact h1.elim (λ h_1, ((not_col_of_right h_1) (four11 h).2.1).elim) id,
  replace h1 := B_of_obtuse_col h1 (four11 h).2.1,
  split,
    apply five14 _ (eqd_refl b a) (eqd.refl b c),
    exact five13.2 ⟨a, h1.2.2, eqd.refl b a, h1.2.1.symm⟩,
  exact (five13.2 ⟨a, h1.2.2.symm, eqd.refl c a, h1.1.symm⟩).flip,
split,
  apply five14 ((eleven44b (four10 h).2.1).2 _) (two5 (eqd.refl b a)) (eqd.refl b c),
  cases h1,
    exact lt_ang_right_of_ang_acute (eleven43 (or.inl h1)).2.symm h1,
  exact lt_ang_obtuse_of_ang_acute (eleven43 (or.inr h1)).2.symm h1,
apply five14 ((eleven44b (four10 h).2.2.2.1).2 _) (two5 (eqd.refl c a)) (two5 (eqd.refl c b)),
cases h1,
  exact lt_ang_right_of_ang_acute (eleven43 (or.inl h1)).1.symm h1.symm,
exact lt_ang_obtuse_of_ang_acute (eleven43 (or.inr h1)).1.symm h1.symm
end

theorem eleven47 {a b c x : point} : R a c b → xperp x (l c x) (l a b) → B a x b ∧ x ≠ a ∧ x ≠ b :=
begin
intros h h1,
have h2 : tri a b c,
  apply six26,
  intro h_1,
  exact (eight14b h1) (six18 h1.2.1 (six13 h1.1) h_1 h1.2.2.2.1).symm,
have h3 := eleven43 (or.inl ⟨h2.2.2, h2.2.1, h⟩),
have h4 : x ≠ a,
  intro h_1,
  subst x,
  exact (eleven45a h3.1).1 ⟨h2.2.2.symm, h2.1.symm, h1.2.2.2.2 (six17a c a) (six17b a b)⟩,
have h5 : x ≠ b,
  intro h_1,
  subst x,
  exact (eleven45a h3.2).1 ⟨h2.2.1.symm, h4.symm, h1.2.2.2.2 (six17a c b) (six17a a b)⟩,
refine ⟨_, h4, h5⟩,
  wlog h6 : distle b x a x := (five10 b x a x) using a b,
  suffices : distle a x a b,
    cases h1.2.2.2.1,
      exact (six12 (six7 h_1 h2.1.symm).symm).1 this,
    cases h_1,
      exact h_1.symm,
    suffices : distle b x b a,
      exact ((six12 (six7 h_1.symm h2.1).symm).1 this).symm,
    exact h6.trans (five6 this (eqd.refl a x) (two5 (eqd.refl a b))),
  apply distle.trans _ (eleven46 (or.inl ⟨h2.2.2, h2.2.1, h⟩)).1.1,
  exact five6 (eleven46 (or.inl ⟨six13 h1.1, h4.symm, (h1.2.2.2.2 (six17a c x) (six17a a b))⟩)).2.1 (two5 (eqd.refl x a)) (eqd.refl c a),
apply (this h.symm _ ⟨h2.1.symm, h2.2.2, h2.2.1⟩ h3.symm h5 h4).symm,
rwa six17 b a
end

theorem eleven48 {a b c d : point} : ang_acute a b c → d ∈ l b c → d ≠ b → R a d b → sided b c d :=
begin
intros h h1 h2 h3,
by_contradiction h_1,
replace h1 : B c b d,
  simpa [h_1] using six1 (four11 h1).2.1,
replace h := (eleven40a (tri_of_ang_acute h).1 (tri_of_ang_acute h).2 h2 h1).1 h,
exact (eleven45a (eleven43 (or.inr h)).2).1 ⟨h2.symm, (tri_of_ang_obtuse h).2.2, h3.symm⟩
end

theorem eleven49 {a b c d : point} : ang_obtuse a b c → d ∈ l b c → d ≠ b → R a d b → B c b d :=
begin
intros h h1 h2 h3,
by_contradiction h_1,
replace h1 : sided b c d,
  simpa [h_1] using six1 (four11 h1).2.1,
replace h := ang_obtuse.trans h (eleven9 (six5 (tri_of_ang_obtuse h).1) h1.symm),
exact (eleven45a (eleven43 (or.inr h)).2).1 ⟨h2.symm, (tri_of_ang_obtuse h).2.2, h3.symm⟩
end

theorem SAS {a b c a' b' c' : point} : eqa a b c a' b' c' → eqd a b a' b' → eqd c b c' b' →
eqd a c a' c' ∧ (a ≠ c → eqa b a c b' a' c' ∧ eqa b c a b' c' a') :=
begin
intros h h1 h2,
suffices : cong a b c a' b' c',
  refine ⟨this.2.2, λ h1, _⟩,
  refine ⟨eleven11 h.1.symm h1.symm (four4 this).2.1,
  eleven11 h.2.1.symm h1 (four4 this).2.2.1⟩,
exact ⟨h1, h2.flip,
(eleven4.1 h).2.2.2.2 (six5 h.1) (six5 h.2.1) (six5 h.2.2.1) (six5 h.2.2.2.1) h1.flip h2.flip⟩
end

theorem ASA {a b c a' b' c' : point} : ¬col a b c → eqa b a c b' a' c' → eqa a b c a' b' c' →
eqd a b a' b' → eqd a c a' c' ∧ eqd b c b' c' ∧ eqa a c b a' c' b' :=
begin
intros h h1 h2 h3,
cases exists_of_exists_unique (six11 h1.2.2.2.1 h1.2.1.symm) with x hx,
have h4 : cong a b c a' b' x,
  refine ⟨h3, _, hx.2.symm⟩,
  exact (eleven4.1 h1).2.2.2.2 (six5 h1.1) (six5 h1.2.1) (six5 h1.2.2.1) hx.1 h3 hx.2.symm,
suffices : x = c',
  subst x,
  exact ⟨h4.2.2, h4.2.1, eleven11 h1.2.1.symm h2.2.1.symm (four4 h4).1⟩,
have h5 : ¬col a' b' c',
  intro h_1,
  exact h (eleven21d h_1 h2.symm),
suffices : sided b' x c',
  apply six21a (six14 h1.2.2.2.1.symm) (six14 h2.2.2.2.1.symm) _ (four11 (six4.1 hx.1).1).2.2.1
  (four11 (six4.1 this).1).2.2.1 (six17b a' c') (six17b b' c'),
  intro h_1,
  apply h5,
  suffices : b' ∈ l a' c',
    exact (four11 this).1,
  rw h_1,
  exact six17a b' c',
apply eleven15b h h5 (eleven11 h2.1 h2.2.1 h4) _ h2 (side.refla h5),
exact (nine12 (six14 h2.2.2.1) (six17a a' b') hx.1.symm h5).symm
end

theorem AAS {a b c a' b' c' : point} : ¬col a b c → eqa b c a b' c' a' → eqa a b c a' b' c' →
eqd a b a' b' → eqd a c a' c' ∧ eqd b c b' c' ∧ eqa b a c b' a' c' :=
begin
intros h h1 h2 h3,
cases exists_of_exists_unique (six11 h1.2.2.1.symm h1.1) with x hx,
have h4 : cong a b c a' b' x,
  refine ⟨h3, hx.2.symm, _⟩,
  exact (eleven4.1 h2).2.2.2.2 (six5 h2.1) (six5 h2.2.1) (six5 h2.2.2.1) hx.1 h3.flip hx.2.symm,
suffices : x = c',
  subst x,
  exact ⟨h4.2.2, h4.2.1, eleven11 h2.1.symm h1.2.1.symm (four4 h4).2.1⟩,
clear h2 h3,
replace hx := hx.1,
replace h4 := (eleven11 h1.1 h1.2.1 (four4 h4).2.2.1),
wlog h6 := hx.2.2 using x c',
  by_contradiction h_1,
  have h5 : ¬col x c' a',
    intro h_2,
    apply (four10 h).2.2.1 (eleven21d (six23.2 ⟨l x c', six14 h_1, _, six17b x c', h_2⟩) h1.symm),
    exact (four11 (six4.1 hx).1).1,
  apply (eleven41 h5 h6.symm hx.1.symm).2.2,
  apply eleven8 (eqa.trans _ (h1.symm.trans h4)),
  exact eleven9 (six7 h6.symm h_1).symm (six5 h1.2.2.2.1),
exact (this h4 hx.symm h1).symm
end

theorem SSS {a b c d e f : point} : tri a b c → cong a b c d e f →
eqa a b c d e f ∧ eqa b c a e f d ∧ eqa c a b f d e :=
λ h h1, ⟨eleven11 h.1 h.2.1.symm h1, eleven11 h.2.1 h.2.2 (four4 h1).2.2.1,
eleven11 h.2.2.symm h.1.symm (four4 h1).2.2.2.1⟩

theorem SSA {a b c a' b' c' : point} : eqa a b c a' b' c' → eqd a c a' c' → eqd b c b' c' → distle b c a c →
eqd a b a' b' ∧ eqa b a c b' a' c' ∧ eqa b c a b' c' a' :=
begin
intros h h1 h2 h3,
cases exists_of_exists_unique (six11 h.2.2.1 h.1.symm) with x hx,
have h4 : cong a b c x b' c',
  refine ⟨hx.2.symm.flip, h2, _⟩,
  exact (eleven4.1 h).2.2.2.2 (six5 h.1) (six5 h.2.1) hx.1 (six5 h.2.2.2.1) hx.2.symm h2,
have h5 : a ≠ c,
  intro h_1,
  subst c,
  exact h.1.symm (id_eqd (five9 h3 (five11 a b a))),
suffices : x = a',
  subst x,
  exact ⟨h4.1, eleven11 h.1.symm h5.symm (four4 h4).2.1, eleven11 h.2.1.symm h5 (four4 h4).2.2.1⟩,
by_contradiction h_1,
cases hx.1.2.2.symm with h6 h6,
  have h7 : ¬col a b c,
    intro h_2,
    apply dist_le_iff_not_lt.1 h3 (five14 _ h1.symm h2.symm),
    suffices : B b' a' c',
      refine ⟨((five12 (or.inl this)).1 this).2, λ h_3, _⟩,
      apply h.2.2.1 (unique_of_exists_unique (six11 h.2.2.2.1.symm h.2.2.2.1) _ _),
        exact ⟨six7 this.symm (two7 h1 h5), h_3.flip⟩,
      exact ⟨six5 h.2.2.2.1.symm, eqd.refl c' b'⟩,
    apply three5a h6 _,
    cases seven20 _ (h1.symm.flip.trans h4.2.2.flip),
        exact (h_1 h_3.symm).elim,
      exact h_3.1,
    apply (four11 (five4 h.2.2.2.1 (four11 (eleven21d h_2 h)).2.2.2.2 _)).2.1,
    exact (four11 (four13 h_2 h4)).2.2.2.2,
  apply dist_le_iff_not_lt.1 h3 (five14 _ h4.2.2.symm h2.symm),
  apply ((eleven44b _).2 _).flip,
    intro h_2,
    exact h7 (four13 (four11 h_2).2.2.1 h4.symm),
  have h8 : ¬col a' b' c',
    intro h_2,
    exact h7 (eleven21d h_2 h.symm),
  suffices : ang_lt a' b' c' c' a' x,
    apply eleven37 (eleven42a this) (eleven9 (six5 h.2.2.2.1) hx.1) (((eleven44a _).1 (h1.symm.trans h4.2.2).flip).symm.trans _),
      intro h_2,
      exact h8 (five4 (ne.symm h_1) (four11 (or.inl h6)).2.2.1 (four11 h_2).2.2.1),
    exact eleven9 (six5 (two7 h4.2.2 h5).symm) (six7 h6.symm (ne.symm h_1)).symm,
  exact (eleven41 h8 h6 h_1).2,
have h7 : ¬col a b c,
  intro h_2,
  apply dist_le_iff_not_lt.1 h3 (five14 _ h4.2.2.symm h4.2.1.symm),
  suffices : B b' x c',
    refine ⟨((five12 (or.inl this)).1 this).2, λ h_3, _⟩,
    apply hx.1.1 (unique_of_exists_unique (six11 h.2.2.2.1.symm h.2.2.2.1) _ _),
      exact ⟨six7 this.symm (two7 h4.2.2 h5), h_3.flip⟩,
    exact ⟨six5 h.2.2.2.1.symm, eqd.refl c' b'⟩,
  apply three5a h6 _,
  cases seven20 _ (h1.symm.flip.trans h4.2.2.flip),
      exact (h_1 h_3.symm).elim,
    exact h_3.1.symm,
  apply (four11 (five4 h.2.2.2.1 (four11 (eleven21d h_2 h)).2.2.2.2 _)).2.1,
  exact (four11 (four13 h_2 h4)).2.2.2.2,
apply dist_le_iff_not_lt.1 h3 (five14 _ h1.symm h2.symm),
apply ((eleven44b _).2 _).flip,
  intro h_2,
  exact h7 (eleven21d (four11 h_2).2.2.1 h.symm),
have h8 : ¬col x b' c',
  intro h_2,
  exact h7 (four13 h_2 h4.symm),
suffices : ang_lt x b' c' c' x a',
  apply eleven37 (eleven42a this) (eleven9 (six5 h.2.2.2.1) hx.1.symm) (((eleven44a _).1 (h4.2.2.symm.trans h1).flip).symm.trans _),
    intro h_2,
    exact h8 (five4 h_1 (four11 (or.inl h6)).2.2.1 (four11 h_2).2.2.1),
  exact eleven9 (six5 (two7 h1 h5).symm) (six7 h6.symm h_1).symm,
exact (eleven41 h8 h6 (ne.symm h_1)).2
end

theorem eleven53 {a b c d : point} : R a d c → c ≠ d → a ≠ b → a ≠ d → B d a b → ang_lt d b c d a c ∧ distlt a c b c :=
begin
intros h h1 h2 h3 h4,
have h5 : c ∉ l a b,
  intro h_1,
  suffices : col a d c,
    exact (eight9 h this).elim h3 h1,
  suffices : l a b = l a d,
    rwa this at h_1,
  exact six16 h2 h3 (or.inr (or.inr h4)),
have h6 := (eleven41 h5 h4.symm h3.symm).2,
refine ⟨eleven37 (eleven42b h6) (eleven9 (six7 h4.symm h2).symm (six5 (six26 h5).2.1.symm))
(eqa.refl h3.symm (six26 h5).2.2.symm), _⟩,
have h7 : eqd c a c (S d a),
  exact h.symm,
apply five14 _ h7.symm.flip (eqd.refl b c),
apply ((eleven44b _).2 _).flip,
  intro h_1,
  suffices : l a b = l (S d a) b,
    rw this at h5,
    exact h5 (four11 h_1).2.2.1,
  apply six18 (six14 h2) _ (or.inr (or.inr (three7b h4.symm (seven5 d a).1 h3).symm)) (six17b a b),
  intro h_2,
  subst b,
  exact h3 (three4 (seven5 d a).1 h4),
apply eleven37 (eleven42a h6) (eleven9 (six5 (six26 h5).2.1.symm) _) _,
  exact (six7 (three7b h4.symm (seven5 d a).1 h3) h2).symm,
apply eleven10 _ (six5 (six26 h5).2.2.symm) (six7 (seven5 d a).1 h3.symm) (six5 (two7 h7 (six26 h5).2.2.symm))
(six7 (three7b h4.symm (seven5 d a).1 h3).symm (seven12b h3).symm).symm,
apply (eleven44a (four10 _).2.2.2.2).1 h7.symm,
intro h_1,
suffices : l a b = l a (S d a),
  rw this at *,
  exact h5 h_1,
exact six16 h2 (seven12b h3).symm (or.inr (or.inr (three7b h4.symm (seven5 d a).1 h3).symm))
end

end Euclidean_plane


import category_theory.limits.shapes.finite_limits
import category_theory.closed.cartesian
import category_theory.subobject.basic
import category_theory.subobject.lattice
import order.heyting.basic

import colimits
import topos
import presheaf

open category_theory category_theory.category category_theory.limits classifier

universes v u

noncomputable theory

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

variables [topos.{v} C]

/- We now define the arrow for the Heyting structure on the suboject of Ω,
   we could have done it for any object X, but we keep it simple
-/
variables (C)
/-- ⊤ is the classifing arrow of the identity, hence it is truth -/
def top_arrow : ⊤_ C ⟶ Ω C:= classifier_of (𝟙 ⊤_ C)

@[simp] lemma top_arrow_eq_truth : top_arrow C = truth C :=
begin
unfold top_arrow, rw uniquely (𝟙 ⊤_ C), exact truth_classifies_id C
end

/-- Could have been terminal.from ⊥_ C -/
def bot_arrow : ⊤_ C ⟶ Ω C := classifier_of (initial.to (⊤_ C))

/- We define the ∧ arrow Ω ⨯ Ω ⟶ Ω  -/
abbreviation ΩxΩ : C := (Ω C) ⨯ (Ω C)
abbreviation truth_truth : ⊤_ C ⟶ (Ω C) ⨯ (Ω C) := prod.lift (truth C) (truth C)
def and_arrow : ΩxΩ C ⟶ Ω C := classifier_of (truth_truth C)

/- For the implication, we first define ≤, and take its classyfing arrow -/
def leq_arrow := equalizer.ι (limits.prod.fst : ΩxΩ C ⟶ Ω C) (and_arrow C)
instance mono_leq : mono.{v} (leq_arrow C) := equalizer.ι_mono.

def imp_arrow : ΩxΩ C ⟶ Ω C := classifier_of (leq_arrow C)

/- For the or, we need some more work -/
def id_true : Ω C ⟶ ΩxΩ C := prod.lift (𝟙 (Ω C)) (terminal.from (Ω C) ≫ truth C)
def true_id : Ω C ⟶ ΩxΩ C := prod.lift (terminal.from (Ω C) ≫ truth C) (𝟙 (Ω C))
def or_lift : Ω C ⨿ Ω C ⟶ ΩxΩ C := coprod.desc (id_true C) (true_id C)

def or_facto := image.canonical_factorisation (or_lift C)
def or_arrow : ΩxΩ C ⟶ Ω C := classifier_of (or_facto C).m

/- The ¬ is implication to the negation -/
def neg_arrow : Ω C ⟶ Ω C := (prod.lift (𝟙 (Ω C)) (terminal.from (Ω C) ≫ bot_arrow C)) ≫ imp_arrow C

/- The equality -/
-- def δ (Y : C) : Y ⨯ Y ⟶ Ω C := classifier_of (diag Y)

/- Now we interpret inductively any 1st order formula using the above arrow -/
variables {C} {X : C}

/- Now we can write formulas and prove the Heyting structure -/
instance has_bot_X_to_Ω : has_bot (X ⟶ Ω C) :=  { bot := terminal.from X ≫ bot_arrow C}
instance has_top_X_to_Ω : has_top (X ⟶ Ω C) :=  { top := terminal.from X ≫ top_arrow C}
instance has_and_X_to_Ω : has_inf (X ⟶ Ω C) := { inf := λ σ τ, prod.lift σ τ ≫ and_arrow C }
instance has_or_X_to_Ω : has_sup (X ⟶ Ω C) := { sup :=  λ σ τ, prod.lift σ τ ≫ or_arrow C }
instance has_imp_X_to_Ω : has_himp (X ⟶ Ω C) := { himp := λ σ τ, prod.lift σ τ ≫ imp_arrow C}
instance has_neg_X_to_Ω : has_hnot (X ⟶ Ω C) := { hnot := λ σ, σ ≫ neg_arrow C}

lemma simp_top : terminal.from X ≫ truth C = ⊤ := begin
  rw ←top_arrow_eq_truth, refl,
end

/- Now, we define the same structure on the suboject, mathlib already proves it is a lattice -/
namespace heyting_sub

instance has_top_sub : has_top (subobject X) := { top := subobject.mk (𝟙 X) }
instance has_himp_sub : has_himp (subobject X) :=
{ himp := λ u v : subobject X,
          subobject.mk (canonical_incl ((classifier_of u.arrow)⇨(classifier_of v.arrow))) }

-- To prove it has bot, we just need to prove the morphism from initial is mono
instance initial_mono_class_topos : initial_mono_class C :=
initial_mono_class.of_is_initial (initial_is_initial) (λ _ , initial_mono _ (initial_is_initial))

variable (X)
lemma top_sub_iso_id : ↑(⊤ : subobject X) ≅ X := subobject.underlying_iso _
lemma bot_sub_iso_init : ↑(⊥ : subobject X) ≅ ⊥_ C := subobject.underlying_iso _

end heyting_sub

/-! We show that the big squares are pullback using pasting lemmas -/

/- Top
  X ---> 1 ---> 1
  |      |      |
  |      |      |
  X ---> 1 ---> Ω
-/
variables (X)
def pullback_cone_top_left : pullback_cone (terminal.from X) (𝟙 (⊤_ C))  :=
pullback_cone.mk (𝟙 X) (terminal.from X)  (by simp)

lemma is_pullback_top_left : is_limit (pullback_cone_top_left X) :=
begin
  apply pullback_cone.is_limit.mk; intro s; simp
end

def pullback_cone_top_big : pullback_cone (⊤ : X ⟶ Ω C) (truth C)  :=
pullback_cone.mk (𝟙 X) (terminal.from X)  (
begin
  simp,
  rw [←terminal.comp_from (terminal.from X), assoc],
  change terminal.from (⊤_ C) ≫ truth C with lift_truth _,
  rw [←(pb_classifier_condition (𝟙 (⊤_ C))), id_comp],
  refl
end)

lemma is_pullback_top_big : is_limit (pullback_cone_top_big X) :=
begin
  have h := (comp_id (terminal.from X)),
  unfold pullback_cone_top_big,
  conv in (terminal.from X) { rw ← h },
  refine big_square_is_pullback (terminal.from X) (𝟙 (⊤_ C)) (terminal.from X) (top_arrow C) (𝟙 X)
   (𝟙 (⊤_ C)) (truth C) (by simp) (by simp) _ _,
  { rw top_arrow_eq_truth C at *,
    convert @classifying_pullback.is_pb _ _ _ _ _ _ _ _ _ _,
    { exact (is_terminal.from_self terminal_is_terminal).symm },
    { rw top_arrow_eq_truth,
      exact (truth_classifies_id C) } },
  { exact is_pullback_top_left X }
end

/- Bot
  0 ---> 0 ---> 1
  |      |      |
  |      |      |
  X ---> 1 ---> Ω
-/
def pullback_cone_bot_left : pullback_cone (terminal.from X) (terminal.from ⊥_ C) :=
pullback_cone.mk (initial.to X) (𝟙 (⊥_ C)) (by simp)

lemma is_pullback_bot_left : is_limit (pullback_cone_bot_left X) :=
begin
  apply pullback_cone.is_limit.mk _ (λ s, s.snd); simp,
  intro s, rw ← (initial.to_comp s.fst),
  -- in a CCC, the initial is strict, meaning s ≅ ⊥_ whenever we have u : s ⟶ ⊥_
  -- that's how we prove the left square is a pullback
  suffices h : s.snd ≫ initial.to s.X = 𝟙 s.X,
  { rw [←assoc, h], simp },
  { rw [←category_theory.is_iso.hom_inv_id s.snd, cancel_epi s.snd],
   apply is_initial.hom_ext _ _ _ , exact initial_is_initial }
end

def pullback_cone_bot_big : pullback_cone (⊥ : X ⟶ Ω C) (truth C) :=
pullback_cone.mk (initial.to X) (𝟙 (⊥_ C) ≫ terminal.from (⊥_ C)) (by simp)

lemma is_pullback_bot_big : is_limit (pullback_cone_bot_big X) :=
begin
  unfold pullback_cone_bot_big,
  refine big_square_is_pullback (𝟙 (⊥_ C)) (terminal.from (⊥_ C))
        (terminal.from X) (bot_arrow C) (initial.to X)
        (terminal.from ⊥_ C) (truth C) (by simp) (by simp) _ _,
  { apply classifying_pullback.is_pb,
    have g : terminal.from (⊥_ C) = initial.to (⊤_ C) := by simp,
    rw g,  exact (classifies (initial.to (⊤_ C))) },
  { exact (is_pullback_bot_left X) }
end

namespace and_useless
variables {X} (σ τ : X ⟶ Ω C)
-- Well this is not what we want, but I realized that too late, so it's here anyway
/- And
  {σ}x{τ} --->  1 ----> 1
     |          |       |
     |          |       |
    XxX -----> ΩxΩ ---> Ω
-/
open category_theory.limits.prod

lemma map_to_terminal_eq_terminal_from_lift {X Y: C} (f : ⊤_ C ⟶ X) (g : ⊤_ C ⟶ Y) :
  map f g = terminal.from (⊤_ C ⨯ ⊤_ C) ≫ lift f g :=
begin
  rw comp_lift,
  nth_rewrite 0 is_terminal.hom_ext (terminal_is_terminal) (terminal.from (⊤_ C ⨯ ⊤_ C)) fst,
  rw [is_terminal.hom_ext (terminal_is_terminal) (terminal.from (⊤_ C ⨯ ⊤_ C)) snd,
      lift_fst_comp_snd_comp]
end

lemma commutation_big_square :
  map (canonical_incl σ) (canonical_incl τ) ≫ map σ τ =
  terminal.from (s{σ}s ⨯ s{τ}s) ≫ truth_truth C :=
begin
have g := is_terminal.hom_ext terminal_is_terminal (terminal.from _)
          (map (terminal.from s{σ}s) (terminal.from s{τ}s) ≫ terminal.from _),
rw [map_map, canonical_incl_comm σ, canonical_incl_comm τ, ←map_map,
    g, assoc, map_to_terminal_eq_terminal_from_lift]; refl
end

def pullback_cone_and_left : pullback_cone (map σ τ) (truth_truth C) :=
pullback_cone.mk (map (canonical_incl σ) (canonical_incl τ)) (terminal.from _)
                 (commutation_big_square _ _)

variables {σ τ}
def induced_cone_left (s : pullback_cone (map σ τ) (truth_truth C)) :
  pullback_cone σ (truth C) := pullback_cone.mk (s.fst ≫ fst) (terminal.from _)
  (by rw [assoc, ←map_fst _ τ, ←assoc, s.condition, assoc, lift_fst,
          is_terminal.hom_ext terminal_is_terminal (s.snd)])

def induced_cone_right (s : pullback_cone (map σ τ) (truth_truth C)) :
  pullback_cone τ (truth C) := pullback_cone.mk (s.fst ≫ snd) (terminal.from _)
  (by rw [assoc, ←map_snd σ τ, ←assoc, s.condition, assoc, lift_snd,
          is_terminal.hom_ext terminal_is_terminal (s.snd)])

def lift_of_cone {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (s : pullback_cone f g) :
  s.X ⟶ pullback f g := pullback.lift s.fst s.snd s.condition

def induced_lift (s : pullback_cone (map σ τ) (truth_truth C)) : s.X ⟶ s{σ}s ⨯ s{τ}s :=
lift (lift_of_cone (induced_cone_left s)) (lift_of_cone (induced_cone_right s))

variables (σ τ)
lemma is_pullback_and_left : is_limit (pullback_cone_and_left σ τ) :=
begin
  apply pullback_cone.is_limit.mk _ (λ s, induced_lift s); intro s,
  { simp only, erw lift_map, apply hom_ext,
      rw lift_fst, dunfold induced_cone_left lift_of_cone, rw pullback.lift_fst, refl,
      rw lift_snd, dunfold lift_of_cone, rw pullback.lift_fst, refl
  },
  { apply is_terminal.hom_ext (terminal_is_terminal) },
  { intros m hfst hsnd, simp only, clear hsnd,
    apply hom_ext; apply pullback.hom_ext; try { apply is_terminal.hom_ext terminal_is_terminal },
    { have hfst_fst := eq_whisker hfst fst,
      rw [assoc, map_fst, ←assoc] at hfst_fst,
      erw [hfst_fst, lift_fst, pullback.lift_fst], refl },
    { have hfst_snd := eq_whisker hfst snd,
      rw [assoc, map_snd, ←assoc] at hfst_snd,
      erw [hfst_snd, lift_snd, pullback.lift_fst], refl } }
end

def pullback_cone_and_big : pullback_cone (map σ τ ≫ and_arrow C) (truth C) :=
pullback_cone.mk (map (canonical_incl σ) (canonical_incl τ)) (terminal.from _ ≫ terminal.from (⊤_ C))
  (by { rw [←assoc, commutation_big_square σ τ, assoc, assoc],
        unfold and_arrow, rw [classifier.comm ] })

lemma is_pullback_and_big : is_limit (pullback_cone_and_big σ τ) :=
begin
  unfold pullback_cone_and_big,
  refine big_square_is_pullback (terminal.from _) (terminal.from _)
        (map σ τ) (and_arrow C) (map (canonical_incl σ) (canonical_incl τ))
        (truth_truth C) (truth C) (by rw commutation_big_square) (by erw classifier.comm) _ _,
  { apply classifying_pullback.is_pb, unfold and_arrow, apply classifies },
  { exact (is_pullback_and_left σ τ) }
end

end and_useless

/- We show that the internal operators corresponds to the external ones -/
namespace external_iso_internal

-- TOP
variable (X)
lemma top_sub : (⊤ : subobject X) = canonical_sub ⊤ :=
begin
  ext1,
  exact is_limit.cone_point_unique_up_to_iso_hom_comp (is_pullback_top_big X)
                                                      (pullback_is_pullback _ _)
                                                       walking_cospan.left
end

def top : ↑(⊤ : subobject X) ≅ s{ (⊤ : X ⟶ Ω C) }s :=
iso.trans (subobject.iso_of_eq _ _ (top_sub X)) (canonical_sub_iso_canonical ⊤)

def top' : X ≅ s{ (⊤ : X ⟶ Ω C) }s := iso.trans (heyting_sub.top_sub_iso_id X).symm (top X)

-- BOT
lemma bot_sub : (⊥ : subobject X) = canonical_sub ⊥ :=
begin
  ext1,
  exact is_limit.cone_point_unique_up_to_iso_hom_comp (is_pullback_bot_big X)
                                                      (pullback_is_pullback _ _)
                                                       walking_cospan.left
end

def bot : ↑(⊥ : subobject X) ≅ s{ (⊥ : X ⟶ Ω C) }s :=
iso.trans (subobject.iso_of_eq _ _ (bot_sub X)) (canonical_sub_iso_canonical ⊥)

def bot' : ⊥_ C ≅ s{ (⊥ : X ⟶ Ω C) }s := iso.trans (heyting_sub.bot_sub_iso_init X).symm (bot X)

-- AND
variables {X} (σ τ : X ⟶ Ω C)

open category_theory.limits.prod
/-
  {σ ⊓ τ}------>  1 -------> 1
    |             |          |
    |             |          |
    X --(σ, τ)-> ΩxΩ ---∧--> Ω

-/
-- In the above, the big square and right sqaure are pullbacks, so is the left

lemma left_square_commutes : canonical_incl (σ ⊓ τ) ≫ lift σ τ = terminal.from _ ≫ truth_truth C :=
begin
  have comm := canonical_incl_comm (σ ⊓ τ),
  erw ←assoc at comm,
  rw ← (pullback_cone.is_limit.lift' (classifier.is_pb (truth_truth C))
        (canonical_incl (σ ⊓ τ) ≫ lift σ τ) (terminal.from _) comm).prop.left,
  congr, apply is_terminal.hom_ext terminal_is_terminal,
end

lemma left_square_commutes_fst : canonical_incl (σ ⊓ τ) ≫ σ = terminal.from _ ≫ truth C :=
begin
  have g := eq_whisker (left_square_commutes σ τ) fst,
  rwa [assoc, assoc, lift_fst, lift_fst] at g,
end

lemma left_square_commutes_snd : canonical_incl (σ ⊓ τ) ≫ τ = terminal.from _ ≫ truth C :=
begin
  have g := eq_whisker (left_square_commutes σ τ) snd,
  rwa [assoc, assoc, lift_snd, lift_snd] at g,
end

def left_cone_and : pullback_cone (lift σ τ) (truth_truth C) :=
  pullback_cone.mk (canonical_incl (σ ⊓ τ)) (terminal.from s{σ ⊓ τ}s) (left_square_commutes σ τ)

lemma is_pullback_and_left : is_limit (left_cone_and σ τ) :=
begin
  unfold left_cone_and,
  refine left_square_is_pullback (terminal.from _) (terminal.from _)
          (lift σ τ) (and_arrow C) (canonical_incl (σ ⊓ τ))
          (truth_truth C) (truth C) _ _ _ _,
    { erw classifier.comm },
    { apply classifier.is_pb },
    { simp, convert pullback_is_pullback (σ ⊓ τ) (truth C),
     apply is_terminal.hom_ext (terminal_is_terminal) }
end

def left_lift : s{σ ⊓ τ}s ⟶ s{σ}s :=
pullback.lift (canonical_incl (σ ⊓ τ)) (terminal.from _) (left_square_commutes_fst _ _)

def right_lift : s{σ ⊓ τ}s ⟶ s{τ}s :=
pullback.lift (canonical_incl (σ ⊓ τ)) (terminal.from _) (left_square_commutes_snd _ _)

-- A cone of apex s{σ ⊓ τ}s, we will show it is a pullback
-- and thus have our cone isomorphism
def internal_cone : pullback_cone (canonical_incl σ) (canonical_incl τ) :=
pullback_cone.mk (left_lift σ τ) (right_lift σ τ) (by {erw [pullback.lift_fst, pullback.lift_fst]})

@[simp] lemma internal_cone_X : (internal_cone σ τ).X = s{σ ⊓ τ}s := rfl

variables {σ τ}

def external_cone_to_internal_cone (u : pullback_cone (canonical_incl σ) (canonical_incl τ)) :
  pullback_cone (σ ⊓ τ) (truth C) := pullback_cone.mk (u.fst ≫ canonical_incl σ) (terminal.from _)
  (begin
    rw assoc, nth_rewrite 1 ←assoc,
    rw [comp_lift, ←assoc, comp_lift,
        canonical_incl_comm, ←assoc, terminal.comp_from,
        ←assoc, u.condition, assoc, canonical_incl_comm,
        ←assoc, terminal.comp_from, ←comp_lift, assoc],
    erw classifier.comm (truth_truth C),
    rw [←assoc, terminal.comp_from],
   end)

def external_cone_to_internal_cone_fst (u : pullback_cone (canonical_incl σ) (canonical_incl τ)) :
  (external_cone_to_internal_cone u).fst = (u.fst ≫ canonical_incl σ) := rfl

def external_cone_to_internal_cone_snd (u : pullback_cone (canonical_incl σ) (canonical_incl τ)) :
  (external_cone_to_internal_cone u).fst = (u.snd ≫ canonical_incl τ) :=
begin
  rw ←u.condition,
  apply external_cone_to_internal_cone_fst
end

variables (σ τ)

lemma is_limit_internal_cone : is_limit (internal_cone σ τ) :=
begin
  apply pullback_cone.is_limit_aux',
  intro s,
  let l := (pullback_cone.is_limit.lift' (pullback_is_pullback (σ ⊓ τ) (truth C))
            (external_cone_to_internal_cone s).fst (external_cone_to_internal_cone s).snd
            (external_cone_to_internal_cone s).condition),
  use l.val, split,
  dunfold internal_cone,
  { rw ←cancel_mono (canonical_incl σ),
    erw ←external_cone_to_internal_cone_fst,
    refine eq.trans _ l.prop.left,
    rw assoc, congr, apply pullback.lift_fst },
  split,
  { rw ←cancel_mono (canonical_incl τ),
    erw ←external_cone_to_internal_cone_snd,
    refine eq.trans _ l.prop.left,
    rw assoc, congr, apply pullback.lift_fst },
  { intros u fst_comm snd_comm, apply pullback.hom_ext,
    { symmetry, apply eq.trans l.prop.left,
      rw [external_cone_to_internal_cone_fst, ←fst_comm, assoc],
      congr, erw pullback.lift_fst },
    { apply is_terminal.hom_ext (terminal_is_terminal) } }
end

-- The convention was not the same we we have the symmetric verion
lemma and_sub' : (canonical_sub τ) ⊓ (canonical_sub σ) = canonical_sub (σ ⊓ τ) :=
begin
  ext1,
  have g := eq_whisker
    (is_limit.cone_point_unique_up_to_iso_hom_comp
      (pullback_is_pullback (canonical_incl σ) (canonical_incl τ))
      (is_limit_internal_cone σ τ)
      walking_cospan.right)
    (canonical_incl τ),
  erw [assoc, pullback.lift_fst] at g,
  exact g,
end

lemma and_sub : (canonical_sub σ) ⊓ (canonical_sub τ) = canonical_sub (σ ⊓ τ) :=
by rw [←and_sub', inf_comm]

lemma and : ↑ ((canonical_sub σ) ⊓ (canonical_sub τ)) ≅ s{ σ ⊓ τ }s :=
iso.trans (subobject.iso_of_eq _ _ (and_sub σ τ)) (canonical_sub_iso_canonical (σ ⊓ τ))

end external_iso_internal

namespace validity

/- Let σ : X ⟶ Ω, a formulat is valid whenever σ factors trought true,
   i.e σ = truth_X
-/
variable {X}

def is_valid (σ : X ⟶ Ω C) : Prop := σ = lift_truth X

-- Two characterization of validity
lemma valid_iff_section (σ : X ⟶ Ω C) : is_valid σ ↔ (is_split_epi (canonical_incl σ)) :=
begin
  split;  intro h,
  { apply is_split_epi.mk',
    exact {section_ := pullback.lift (𝟙 X) (terminal.from X) (by simpa [h]) } },
  { unfold is_valid,
    rw [←id_comp σ, ←h.exists_split_epi.some.id, assoc,
        canonical_incl_comm, ←assoc, terminal.comp_from] }
end

lemma valid_iff_is_iso (σ : X ⟶ Ω C) : is_valid σ ↔ is_iso (canonical_incl σ) :=
begin
  split; rw valid_iff_section; intro h; resetI,
  { apply is_iso_of_mono_of_is_split_epi (canonical_incl σ) },
  { apply is_split_epi.of_iso (canonical_incl σ), }
end

-- Auxiliary lemma that should be in the subobject lib.
lemma is_iso_of_sub_eq_mk_iso {Y Z : C} {f : Y ⟶ X} [mono f] {g : Z ⟶ X} [is_iso g]
  (eq : subobject.mk f = subobject.mk g) : is_iso f :=
begin
  have f_eq : f = (subobject.iso_of_mk_eq_mk _ _ eq).hom ≫ g := by simp,
  rw f_eq,
  apply is_iso.comp_is_iso,
end

lemma valid_iff_eq_sub_top (σ : X ⟶ Ω C) : is_valid σ ↔ (canonical_sub σ) = (⊤ : subobject X) :=
begin
  split,
  { rw is_valid, intro h, rw h,
    convert (external_iso_internal.top_sub X).symm,
    exact simp_top },
  { rw valid_iff_is_iso,
    exact is_iso_of_sub_eq_mk_iso}
end

end validity


import algebra.ofe.option
import algebra.ofe.prod
import algebra.ofe.sprop
import algebra.camera.resource_algebra

universe u

set_option old_structure_cmd true

class camera (α : Type u) extends ofe α, comm_semigroup α : Type u :=
(validn : α →ₙₑ sprop.{u})
(core : α →ₙₑ option α)
(extend {n : ℕ} {a b₁ b₂ : α} (ha : validn a n) (hb : eq_at n a (b₁ * b₂)) : α × α)
(mul_is_nonexpansive : is_nonexpansive (function.uncurry (*) : α × α → α))
(core_mul_self (a : α) ⦃ca : α⦄ : core a = some ca → ca * a = a)
(core_core (a : α) {ca : α} : core a = some ca → core ca = some ca)
(core_mono_some (a b : α) {ca : α} : core a = some ca → a ≼ b → ∃ cb, core b = some cb)
(core_mono (a b : α) {ca : α} : core a = some ca → a ≼ b → core a ≼ core b)
(validn_mul (a b : α) : validn (a * b) ≤ validn a)
(extend_mul_eq {n : ℕ} {a b₁ b₂ : α} (ha : validn a n) (hb : eq_at n a (b₁ * b₂)) :
  a = (extend ha hb).1 * (extend ha hb).2)
(extend_eq_at_left {n : ℕ} {a b₁ b₂ : α} (ha : validn a n) (hb : eq_at n a (b₁ * b₂)) :
  (extend ha hb).1 =[n] b₁)
(extend_eq_at_right {n : ℕ} {a b₁ b₂ : α} (ha : validn a n) (hb : eq_at n a (b₁ * b₂)) :
  (extend ha hb).2 =[n] b₂)

export camera (core extend)

lemma camera.mul_eq_at {α : Type u} [camera α] {a b c d : α} {n : ℕ} :
  a =[n] b → c =[n] d → a * c =[n] b * d :=
camera.mul_is_nonexpansive.uncurry_apply_eq_at

lemma camera.mul_eq_at_left {α : Type u} [camera α] {a b c : α} {n : ℕ} :
  a =[n] b → a * c =[n] b * c :=
λ h, camera.mul_eq_at h (eq_at_refl _ _)

lemma camera.mul_eq_at_right {α : Type u} [camera α] {a b c : α} {n : ℕ} :
  a =[n] b → c * a =[n] c * b :=
camera.mul_eq_at (eq_at_refl _ _)

@[simp] lemma camera.core_mul_core {α : Type u} [camera α] {a : α} :
  core a * core a = core a :=
begin
  by_cases ∃ ca, core a = some ca,
  swap, { rw ← option.is_some_iff_exists at h, cases core a, refl,
    simpa only [option.is_some_some, coe_sort_tt, not_true] using h, },
  obtain ⟨ca, hca⟩ := h,
  have := camera.core_mul_self ca (camera.core_core a hca),
  rw [hca, some_mul_some, this],
end

def incln {α : Type u} [camera α] (n : ℕ) (a b : α) : Prop :=
∃ c, a * c =[n] b

notation `✓[`:40 n `] ` a:40 := camera.validn a n
notation a ` ≼[`:50 n `] ` b:50 := incln n a b

lemma incln_mono {α : Type u} [camera α] {a b : α} {m n : ℕ} (hmn : m ≤ n) :
  a ≼[n] b → a ≼[m] b :=
by rintro ⟨c, hc⟩; exact ⟨c, eq_at_mono hmn hc⟩

lemma camera.validn_mul_left {α : Type u} [camera α] {n : ℕ} {a b : α} :
  ✓[n] a * b → ✓[n] a := camera.validn_mul a b n

lemma camera.validn_mul_right {α : Type u} [camera α] {n : ℕ} {a b : α} :
  ✓[n] a * b → ✓[n] b := by rw mul_comm; exact camera.validn_mul b a n

lemma camera.validn_of_eq_at {α : Type u} [camera α] {n : ℕ} {a b : α} :
  a =[n] b → ✓[n] a → ✓[n] b :=
begin
  intros hab ha,
  have : camera.validn a =[n] camera.validn b := nonexpansive camera.validn hab,
  rwa this n le_rfl at ha,
end

lemma camera.validn_mono {α : Type u} [camera α] {a : α} {m n : ℕ} (hmn : m ≤ n) :
  ✓[n] a → ✓[m] a :=
(camera.validn a).mono hmn

lemma camera.validn_incln {α : Type u} [camera α] {a b : α} {n : ℕ} (h : a ≼[n] b) :
  ✓[n] b → ✓[n] a :=
begin
  obtain ⟨c, hc⟩ := h,
  intro h,
  exact camera.validn_mul_left (camera.validn_of_eq_at (eq_at_symm hc) h),
end

/-- A way of turning every camera into a resource algebra. -/
instance camera.resource_algebra (α : Type u) [camera α] : resource_algebra α := {
  valid := {a | ∀ n, ✓[n] a},
  core := camera.core,
  core_mul_self := camera.core_mul_self,
  core_core := camera.core_core,
  core_mono_some := camera.core_mono_some,
  core_mono := camera.core_mono,
  valid_mul := λ a b h n, camera.validn_mul a b n (h n),
}

class unital_camera (α : Type u) extends camera α, comm_monoid α, has_abs α :=
(one_valid : ∀ n, ✓[n] (1 : α))
(core_one_eq : camera.core 1 = some (1 : α))
(core_eq_abs (a : α) : camera.core a = some (|a|))

@[simp] lemma one_incl {α : Type u} [unital_camera α] (a : α) : 1 ≼ a :=
⟨a, one_mul a⟩

@[simp, refl] lemma incln_refl {α : Type u} [unital_camera α] (n : ℕ) (a : α) : a ≼[n] a :=
⟨1, by rw mul_one⟩

lemma incln_of_eq_at {α : Type u} [unital_camera α] {n : ℕ} {a b : α} :
  a =[n] b → a ≼[n] b :=
λ h, ⟨1, by rw mul_one; exact h⟩

lemma abs_is_nonexpansive {α : Type u} [unital_camera α] :
  is_nonexpansive (has_abs.abs : α → α) :=
begin
  intros n x y h,
  have : core x =[n] core y := nonexpansive core h,
  simp only [unital_camera.core_eq_abs, option.exists_eq_iff_some_eq, exists_eq_left'] at this,
  exact this,
end

@[simp] lemma unital_camera.core_incl {α : Type u} [unital_camera α] {a b : α} :
  core a ≼ core b ↔ |a| ≼ |b| :=
by rw [unital_camera.core_eq_abs, unital_camera.core_eq_abs, option.some_incl_some]; refl

@[simp] lemma unital_camera.abs_mul_self {α : Type u} [unital_camera α] (a : α) : |a| * a = a :=
camera.core_mul_self a (unital_camera.core_eq_abs a)

@[simp] lemma unital_camera.abs_abs {α : Type u} [unital_camera α] (a : α) : |(|a|)| = |a| :=
begin
  have := camera.core_core a (unital_camera.core_eq_abs a),
  rw unital_camera.core_eq_abs at this,
  exact option.some_injective _ this,
end

@[simp] lemma unital_camera.abs_mono {α : Type u} [unital_camera α] (a b : α)
  (h : a ≼ b) : |a| ≼ |b| :=
unital_camera.core_incl.mp (camera.core_mono a b (unital_camera.core_eq_abs a) h)

structure time_frame {α : Type u} [camera α] (a : α) (n : ℕ) :=
(val : α)
(prop : ✓[n] val * a)

def camera.can_update {α : Type u} [camera α] (a : α) (b : set α) : Prop :=
∀ n, ∀ f : time_frame a n, ∃ f' : time_frame f.val n, f'.val ∈ b

infixr ` ↝ `:30 := camera.can_update

@[ext] structure camera_hom (α β : Type u) [camera α] [camera β] :=
(to_fun : α → β)
(is_nonexpansive' : is_nonexpansive to_fun)
(map_mul' : ∀ a b, to_fun a * to_fun b = to_fun (a * b))
(map_core': ∀ a, camera.core (to_fun a) = option.map to_fun (camera.core a))
(map_valid' : ∀ n (a : α), ✓[n] a → ✓[n] to_fun a)

infixr ` →ₖₕ `:25 := camera_hom

instance camera_hom_fun_like {α β : Type u} [camera α] [camera β] :
  fun_like (α →ₖₕ β) α (λ _, β) := {
  coe := camera_hom.to_fun,
  coe_injective' := begin intros f g h, ext1, exact h, end,
}

instance camera_hom.nonexpansive_fun_class (α β : Type u) [camera α] [camera β] :
  nonexpansive_fun_class (camera_hom α β) α β := {
  is_nonexpansive := camera_hom.is_nonexpansive',
}

instance camera_hom.mul_hom_class (α β : Type u) [camera α] [camera β] :
  mul_hom_class (α →ₖₕ β) α β := {
  coe := camera_hom.to_fun,
  coe_injective' := begin intros f g h, ext1, exact h, end,
  map_mul := λ f x y, (f.map_mul' x y).symm,
}

def camera_hom.id {α : Type u} [cα : camera α] : camera_hom α α := {
  to_fun := id,
  is_nonexpansive' := is_nonexpansive_id,
  map_mul' := by obviously,
  map_core' := by obviously,
  map_valid' := by obviously,
}

def camera_hom.comp {α β γ : Type u} [camera α] [camera β] [camera γ]
  (g : β →ₖₕ γ) (f : α →ₖₕ β) : α →ₖₕ γ := {
  to_fun := g.to_fun ∘ f.to_fun,
  is_nonexpansive' := is_nonexpansive_comp g.to_fun f.to_fun
    g.is_nonexpansive' f.is_nonexpansive',
  map_mul' := by simp only [g.map_mul', f.map_mul', eq_self_iff_true, forall_2_true_iff],
  map_core' := by intro; simp only [g.map_core', f.map_core', option.map_map],
  map_valid' := λ n a h, g.map_valid' _ _ (f.map_valid' _ _ h),
}

lemma camera_hom.map_incln {α β : Type u} [camera α] [camera β] {a b : α} {n : ℕ} {f : α →ₖₕ β} :
  a ≼[n] b → f a ≼[n] f b :=
begin
  rintro ⟨c, hc⟩,
  refine ⟨f c, _⟩,
  rw ← map_mul,
  exact nonexpansive f hc,
end


import classes.context_free.basics.toolbox
import classes.context_sensitive.basics.inclusion

variables {T : Type}

def csg_of_cfg (g : CF_grammar T) : CS_grammar T :=
CS_grammar.mk g.nt g.initial (list.map (λ r : g.nt × (list (symbol T g.nt)),
  csrule.mk [] r.fst [] r.snd) g.rules)

def grammar_of_cfg (g : CF_grammar T) : grammar T :=
grammar.mk g.nt g.initial (list.map (λ r : g.nt × (list (symbol T g.nt)),
  grule.mk [] r.fst [] r.snd) g.rules)

lemma grammar_of_cfg_well_defined (g : CF_grammar T) :
  grammar_of_csg (csg_of_cfg g) = grammar_of_cfg g :=
begin
  unfold grammar_of_cfg,
  delta csg_of_cfg,
  delta grammar_of_csg,
  simp only [list.map_map, eq_self_iff_true, heq_iff_eq, true_and],
  ext1,
  rw [list.nth_map, list.nth_map],
  apply congr_fun,
  ext1,
  cases x,
  {
    refl,
  },
  apply congr_arg option.some,
  simp [list.append_nil],
end

lemma grammar_of_csg_of_cfg :
  grammar_of_csg ∘ csg_of_cfg = @grammar_of_cfg T :=
begin
  ext,
  apply grammar_of_cfg_well_defined,
end

lemma CF_language_eq_CS_language (g : CF_grammar T) :
  CF_language g = CS_language (csg_of_cfg g) :=
begin
  unfold CF_language,
  unfold CS_language,
  ext1 w,
  change
    CF_derives g [symbol.nonterminal g.initial] (list.map symbol.terminal w) =
    CS_derives (csg_of_cfg g) [symbol.nonterminal (csg_of_cfg g).initial] (list.map symbol.terminal w),
  rw eq_iff_iff,
  split,
  {
    have indu :
      ∀ v : list (symbol T g.nt),
        CF_derives g [symbol.nonterminal g.initial] v →
          CS_derives (csg_of_cfg g) [symbol.nonterminal (csg_of_cfg g).initial] v,
    {
      clear w,
      intros v h,
      induction h with x y trash hyp ih,
      {
        apply CS_deri_self,
      },
      apply CS_deri_of_deri_tran,
      {
        exact ih,
      },
      unfold CF_transforms at hyp,
      unfold CS_transforms,
      delta csg_of_cfg,
      dsimp only,
      rcases hyp with ⟨r, rin, u, w, bef, aft⟩,
      use csrule.mk [] r.fst [] r.snd,
      split,
      {
        rw list.mem_map,
        use r,
        split,
        {
          exact rin,
        },
        {
          refl,
        },
      },
      use u,
      use w,
      split;
      {
        dsimp only,
        rw list.append_nil,
        rw list.append_nil,
        assumption,
      },
    },
    exact indu (list.map symbol.terminal w),
  },
  {
    have indu :
      ∀ v : list (symbol T g.nt),
        CS_derives (csg_of_cfg g) [symbol.nonterminal g.initial] v →
          CF_derives g [symbol.nonterminal (csg_of_cfg g).initial] v,
    {
      clear w,
      intros v h,
      induction h with x y trash hyp ih,
      {
        apply CF_deri_self,
      },
      apply CF_deri_of_deri_tran,
      {
        exact ih,
      },
      unfold CS_transforms at hyp,
      unfold CF_transforms,
      delta csg_of_cfg at hyp,
      dsimp only at hyp,
      rcases hyp with ⟨r, rin, u, w, bef, aft⟩,
      use (r.input_nonterminal, r.output_string),
      split,
      {
        finish,
      },
      use u,
      use w,
      have cl_empty : r.context_left = list.nil,
      {
        finish,
      },
      have cr_empty : r.context_right = list.nil,
      {
        finish,
      },
      rw [cl_empty, cr_empty] at *,
      repeat {
        rw list.append_nil at *,
      },
      split;
      assumption,
    },
    exact indu (list.map symbol.terminal w),
  },
end

lemma CF_language_eq_grammar_language (g : CF_grammar T) :
  CF_language g = grammar_language (grammar_of_cfg g) :=
begin
  rw ←grammar_of_cfg_well_defined,
  rw CF_language_eq_CS_language,
  rw CS_language_eq_grammar_language,
end

theorem CF_subclass_CS {L : language T} :
  is_CF L → is_CS L :=
begin
  rintro ⟨g, eq_L⟩,
  use csg_of_cfg g,
  rw ←eq_L,
  rw CF_language_eq_CS_language,
end

theorem CF_subclass_RE {L : language T} :
  is_CF L → is_RE L :=
CS_subclass_RE ∘ CF_subclass_CS


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

! This file was ported from Lean 3 source module deprecated.ring
! leanprover-community/mathlib commit 5a3e819569b0f12cbec59d740a2613018e7b8eec
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Deprecated.Group

/-!
# Unbundled semiring and ring homomorphisms (deprecated)

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines predicates for unbundled semiring and ring homomorphisms. Instead of using
this file, please use `RingHom`, defined in `Algebra.Hom.Ring`, with notation `→+*`, for
morphisms between semirings or rings. For example use `φ : A →+* B` to represent a
ring homomorphism.

## Main Definitions

`IsSemiringHom` (deprecated), `IsRingHom` (deprecated)

## Tags

IsSemiringHom, IsRingHom

-/

universe u v w

variable {α : Type u}

/-- Predicate for semiring homomorphisms (deprecated -- use the bundled `RingHom` version). -/
structure IsSemiringHom {α : Type u} {β : Type v} [Semiring α] [Semiring β] (f : α → β) : Prop where
  /-- The proposition that `f` preserves the additive identity. -/
  map_zero : f 0 = 0
  /-- The proposition that `f` preserves the multiplicative identity. -/
  map_one : f 1 = 1
  /-- The proposition that `f` preserves addition. -/
  map_add : ∀ x y, f (x + y) = f x + f y
  /-- The proposition that `f` preserves multiplication. -/
  map_mul : ∀ x y, f (x * y) = f x * f y
#align is_semiring_hom IsSemiringHom

namespace IsSemiringHom

variable {β : Type v} [Semiring α] [Semiring β]

variable {f : α → β} (hf : IsSemiringHom f) {x y : α}

/-- The identity map is a semiring homomorphism. -/
theorem id : IsSemiringHom (@id α) := by refine' { .. } <;> intros <;> rfl
#align is_semiring_hom.id IsSemiringHom.id

/-- The composition of two semiring homomorphisms is a semiring homomorphism. -/
theorem comp (hf : IsSemiringHom f) {γ} [Semiring γ] {g : β → γ} (hg : IsSemiringHom g) :
    IsSemiringHom (g ∘ f) :=
  { map_zero := by simpa [map_zero hf] using map_zero hg
    map_one := by simpa [map_one hf] using map_one hg
    map_add := fun {x y} => by simp [map_add hf, map_add hg]
    map_mul := fun {x y} => by simp [map_mul hf, map_mul hg] }
#align is_semiring_hom.comp IsSemiringHom.comp

/-- A semiring homomorphism is an additive monoid homomorphism. -/
theorem to_isAddMonoidHom (hf : IsSemiringHom f) : IsAddMonoidHom f :=
  { ‹IsSemiringHom f› with map_add := by apply @‹IsSemiringHom f›.map_add }
#align is_semiring_hom.to_is_add_monoid_hom IsSemiringHom.to_isAddMonoidHom

/-- A semiring homomorphism is a monoid homomorphism. -/
theorem to_isMonoidHom (hf : IsSemiringHom f) : IsMonoidHom f :=
  { ‹IsSemiringHom f› with }
#align is_semiring_hom.to_is_monoid_hom IsSemiringHom.to_isMonoidHom

end IsSemiringHom

/-- Predicate for ring homomorphisms (deprecated -- use the bundled `RingHom` version). -/
structure IsRingHom {α : Type u} {β : Type v} [Ring α] [Ring β] (f : α → β) : Prop where
  /-- The proposition that `f` preserves the multiplicative identity. -/
  map_one : f 1 = 1
  /-- The proposition that `f` preserves multiplication. -/
  map_mul : ∀ x y, f (x * y) = f x * f y
  /-- The proposition that `f` preserves addition. -/
  map_add : ∀ x y, f (x + y) = f x + f y
#align is_ring_hom IsRingHom

namespace IsRingHom

variable {β : Type v} [Ring α] [Ring β]

/-- A map of rings that is a semiring homomorphism is also a ring homomorphism. -/
theorem of_semiring {f : α → β} (H : IsSemiringHom f) : IsRingHom f :=
  { H with }
#align is_ring_hom.of_semiring IsRingHom.of_semiring

variable {f : α → β} (hf : IsRingHom f) {x y : α}

/-- Ring homomorphisms map zero to zero. -/
theorem map_zero (hf : IsRingHom f) : f 0 = 0 :=
  calc
    f 0 = f (0 + 0) - f 0 := by rw [hf.map_add]; simp
    _ = 0 := by simp

#align is_ring_hom.map_zero IsRingHom.map_zero

/-- Ring homomorphisms preserve additive inverses. -/
theorem map_neg (hf : IsRingHom f) : f (-x) = -f x :=
  calc
    f (-x) = f (-x + x) - f x := by rw [hf.map_add]; simp
    _ = -f x := by simp [hf.map_zero]

#align is_ring_hom.map_neg IsRingHom.map_neg

/-- Ring homomorphisms preserve subtraction. -/
theorem map_sub (hf : IsRingHom f) : f (x - y) = f x - f y := by
  simp [sub_eq_add_neg, hf.map_add, hf.map_neg]
#align is_ring_hom.map_sub IsRingHom.map_sub

/-- The identity map is a ring homomorphism. -/
theorem id : IsRingHom (@id α) := by refine' { .. } <;> intros <;> rfl
#align is_ring_hom.id IsRingHom.id

-- see Note [no instance on morphisms]
/-- The composition of two ring homomorphisms is a ring homomorphism. -/
theorem comp (hf : IsRingHom f) {γ} [Ring γ] {g : β → γ} (hg : IsRingHom g) : IsRingHom (g ∘ f) :=
  { map_add := fun x y => by simp [map_add hf]; rw [map_add hg]
    map_mul := fun x y => by simp [map_mul hf]; rw [map_mul hg]
    map_one := by simp [map_one hf]; exact map_one hg }
#align is_ring_hom.comp IsRingHom.comp

/-- A ring homomorphism is also a semiring homomorphism. -/
theorem to_isSemiringHom (hf : IsRingHom f) : IsSemiringHom f :=
  { ‹IsRingHom f› with map_zero := map_zero hf }
#align is_ring_hom.to_is_semiring_hom IsRingHom.to_isSemiringHom

theorem to_isAddGroupHom (hf : IsRingHom f) : IsAddGroupHom f :=
  { map_add := hf.map_add }
#align is_ring_hom.to_is_add_group_hom IsRingHom.to_isAddGroupHom

end IsRingHom

variable {β : Type v} {γ : Type w} {rα : Semiring α} {rβ : Semiring β}

namespace RingHom

section

/-- Interpret `f : α → β` with `IsSemiringHom f` as a ring homomorphism. -/
def of {f : α → β} (hf : IsSemiringHom f) : α →+* β :=
  { MonoidHom.of hf.to_isMonoidHom, AddMonoidHom.of hf.to_isAddMonoidHom with toFun := f }
#align ring_hom.of RingHom.of

@[simp]
theorem coe_of {f : α → β} (hf : IsSemiringHom f) : ⇑(of hf) = f :=
  rfl
#align ring_hom.coe_of RingHom.coe_of

theorem to_isSemiringHom (f : α →+* β) : IsSemiringHom f :=
  { map_zero := f.map_zero
    map_one := f.map_one
    map_add := f.map_add
    map_mul := f.map_mul }
#align ring_hom.to_is_semiring_hom RingHom.to_isSemiringHom

end

theorem to_isRingHom {α γ} [Ring α] [Ring γ] (g : α →+* γ) : IsRingHom g :=
  IsRingHom.of_semiring g.to_isSemiringHom
#align ring_hom.to_is_ring_hom RingHom.to_isRingHom

end RingHom