/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import morphisms.quasi_compact
import topology.quasi_separated

/-!
# Quasi-separated morphisms

A morphism of schemes `f : X ⟶ Y` is quasi-separated if the diagonal morphism `X ⟶ X ×[Y] X` is
quasi-compact.

A scheme is quasi-separated if the intersections of any two affine open sets is quasi-compact.
(`algebraic_geometry.quasi_separated_space_iff_affine`)

We show that a morphism is quasi-separated if the preimage of every affine open is quasi-separated.

We also show that this property is local at the target,
and is stable under compositions and base-changes.

## Main result
- `is_localization_basic_open_of_qcqs` (**Qcqs lemma**):
  If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`.

-/

noncomputable theory

open category_theory category_theory.limits opposite topological_space

universe u

open_locale algebraic_geometry

namespace algebraic_geometry

variables {X Y : Scheme.{u}} (f : X ⟶ Y)

/-- A morphism is `quasi_separated` if diagonal map is quasi-compact. -/
@[mk_iff]
class quasi_separated (f : X ⟶ Y) : Prop :=
(diagonal_quasi_compact : quasi_compact (pullback.diagonal f))

attribute [instance] quasi_separated.diagonal_quasi_compact

/-- The `affine_target_morphism_property` corresponding to `quasi_separated`, asserting that the
domain is a quasi-separated scheme. -/
def quasi_separated.affine_property : affine_target_morphism_property :=
(λ X Y f _, quasi_separated_space X.carrier)

lemma quasi_separated_space_iff_affine (X : Scheme) :
  quasi_separated_space X.carrier ↔ ∀ (U V : X.affine_opens), is_compact (U ∩ V : set X.carrier) :=
begin
  rw quasi_separated_space_iff,
  split,
  { intros H U V, exact H U V U.1.2 U.2.is_compact V.1.2 V.2.is_compact },
  { intros H,
    suffices : ∀ (U : opens X.carrier) (hU : is_compact U.1) (V : opens X.carrier)
      (hV : is_compact V.1), is_compact (U ⊓ V).1,
    { intros U V hU hU' hV hV', exact this ⟨U, hU⟩ hU' ⟨V, hV⟩ hV' },
    intros U hU V hV,
    apply compact_open_induction_on V hV,
    { simp },
    { intros S hS V hV,
      change is_compact (U.1 ∩ (S.1 ∪ V.1)),
      rw set.inter_union_distrib_left,
      apply hV.union,
      clear hV,
      apply compact_open_induction_on U hU,
      { simp },
      { intros S hS W hW,
      change is_compact ((S.1 ∪ W.1) ∩ V.1),
        rw set.union_inter_distrib_right,
        apply hW.union,
        apply H } } }
end

lemma quasi_compact_affine_property_iff_quasi_separated_space {X Y : Scheme} [is_affine Y]
  (f : X ⟶ Y) :
  quasi_compact.affine_property.diagonal f ↔ quasi_separated_space X.carrier :=
begin
  delta affine_target_morphism_property.diagonal,
  rw quasi_separated_space_iff_affine,
  split,
  { intros H U V,
    haveI : is_affine _ := U.2,
    haveI : is_affine _ := V.2,
    let g : pullback (X.of_restrict U.1.open_embedding) (X.of_restrict V.1.open_embedding) ⟶ X :=
      pullback.fst ≫ X.of_restrict _,
    have : is_open_immersion g := infer_instance,
    have e := homeomorph.of_embedding _ this.base_open.to_embedding,
    rw is_open_immersion.range_pullback_to_base_of_left at e,
    erw [subtype.range_coe, subtype.range_coe] at e,
    rw is_compact_iff_compact_space,
    exact @@homeomorph.compact_space _ _ (H _ _) e },
  { introv H h₁ h₂,
    resetI,
    let g : pullback f₁ f₂ ⟶ X := pullback.fst ≫ f₁,
    have : is_open_immersion g := infer_instance,
    have e := homeomorph.of_embedding _ this.base_open.to_embedding,
    rw is_open_immersion.range_pullback_to_base_of_left at e,
    simp_rw is_compact_iff_compact_space at H,
    exact @@homeomorph.compact_space _ _
      (H ⟨⟨_, h₁.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩
        ⟨⟨_, h₂.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩) e.symm },
end

lemma quasi_separated_eq_diagonal_is_quasi_compact :
  @quasi_separated = morphism_property.diagonal @quasi_compact :=
by { ext, exact quasi_separated_iff _ }

lemma quasi_compact_affine_property_diagonal_eq :
  quasi_compact.affine_property.diagonal = quasi_separated.affine_property :=
by { ext, rw quasi_compact_affine_property_iff_quasi_separated_space, refl }

lemma quasi_separated_eq_affine_property_diagonal :
  @quasi_separated =
    target_affine_locally quasi_compact.affine_property.diagonal :=
begin
  rw [quasi_separated_eq_diagonal_is_quasi_compact, quasi_compact_eq_affine_property],
  exact diagonal_target_affine_locally_eq_target_affine_locally
    _ quasi_compact.affine_property_is_local
end

lemma quasi_separated_eq_affine_property :
  @quasi_separated =
    target_affine_locally quasi_separated.affine_property :=
by rw [quasi_separated_eq_affine_property_diagonal, quasi_compact_affine_property_diagonal_eq]

lemma quasi_separated.affine_property_is_local :
  quasi_separated.affine_property.is_local :=
quasi_compact_affine_property_diagonal_eq ▸
quasi_compact.affine_property_is_local.diagonal

@[priority 900]
instance quasi_separated_of_mono {X Y : Scheme} (f : X ⟶ Y) [mono f] : quasi_separated f :=
⟨infer_instance⟩

lemma quasi_separated_stable_under_composition :
  morphism_property.stable_under_composition @quasi_separated :=
quasi_separated_eq_diagonal_is_quasi_compact.symm ▸
  quasi_compact_stable_under_composition.diagonal
    quasi_compact_respects_iso
    quasi_compact_stable_under_base_change

lemma quasi_separated_stable_under_base_change :
  morphism_property.stable_under_base_change @quasi_separated :=
quasi_separated_eq_diagonal_is_quasi_compact.symm ▸
  quasi_compact_stable_under_base_change.diagonal
    quasi_compact_respects_iso

instance quasi_separated_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
  [quasi_separated f] [quasi_separated g] : quasi_separated (f ≫ g) :=
quasi_separated_stable_under_composition f g infer_instance infer_instance

lemma quasi_separated_respects_iso : morphism_property.respects_iso @quasi_separated :=
quasi_separated_eq_diagonal_is_quasi_compact.symm ▸
  quasi_compact_respects_iso.diagonal

lemma quasi_separated.affine_open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
  tfae [quasi_separated f,
    ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)],
      ∀ (i : 𝒰.J), quasi_separated_space (pullback f (𝒰.map i)).carrier,
    ∀ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J),
      quasi_separated_space (pullback f (𝒰.map i)).carrier,
    ∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g],
      quasi_separated_space (pullback f g).carrier,
    ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)]
      (𝒰' : Π (i : 𝒰.J), Scheme.open_cover.{u} (pullback f (𝒰.map i)))
      [∀ i j, is_affine ((𝒰' i).obj j)], by exactI ∀ (i : 𝒰.J) (j k : (𝒰' i).J),
        compact_space (pullback ((𝒰' i).map j) ((𝒰' i).map k)).carrier] :=
begin
  have := quasi_compact.affine_property_is_local.diagonal_affine_open_cover_tfae f,
  simp_rw [← quasi_compact_eq_affine_property,
    ← quasi_separated_eq_diagonal_is_quasi_compact,
    quasi_compact_affine_property_diagonal_eq] at this,
  exact this
end

lemma quasi_separated.is_local_at_target :
  property_is_local_at_target @quasi_separated :=
quasi_separated_eq_affine_property_diagonal.symm ▸
  quasi_compact.affine_property_is_local.diagonal.target_affine_locally_is_local

lemma quasi_separated.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
  tfae [quasi_separated f,
    ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J),
      quasi_separated (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J),
      quasi_separated (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (U : opens Y.carrier), quasi_separated (f ∣_ U),
    ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g],
      quasi_separated (pullback.snd : pullback f g ⟶ _),
    ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤),
      ∀ i, quasi_separated (f ∣_ (U i))] :=
quasi_separated.is_local_at_target.open_cover_tfae f

lemma quasi_separated_over_affine_iff {X Y : Scheme} (f : X ⟶ Y) [is_affine Y] :
  quasi_separated f ↔ quasi_separated_space X.carrier :=
by rw [quasi_separated_eq_affine_property,
  quasi_separated.affine_property_is_local.affine_target_iff f,
  quasi_separated.affine_property]

lemma quasi_separated_space_iff_quasi_separated (X : Scheme) :
  quasi_separated_space X.carrier ↔ quasi_separated (terminal.from X) :=
(quasi_separated_over_affine_iff _).symm

lemma quasi_separated.affine_open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y)
  [∀ i, is_affine (𝒰.obj i)] (f : X ⟶ Y) :
  quasi_separated f ↔ ∀ i, quasi_separated_space (pullback f (𝒰.map i)).carrier :=
begin
  rw [quasi_separated_eq_affine_property,
    quasi_separated.affine_property_is_local.affine_open_cover_iff f 𝒰],
  refl,
end

lemma quasi_separated.open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y)
  (f : X ⟶ Y) :
  quasi_separated f ↔ ∀ i, quasi_separated (pullback.snd : pullback f (𝒰.map i) ⟶ _) :=
quasi_separated.is_local_at_target.open_cover_iff f 𝒰

instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [quasi_separated g] :
  quasi_separated (pullback.fst : pullback f g ⟶ X) :=
quasi_separated_stable_under_base_change.fst f g infer_instance

instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [quasi_separated f] :
  quasi_separated (pullback.snd : pullback f g ⟶ Y) :=
quasi_separated_stable_under_base_change.snd f g infer_instance

instance {X Y Z: Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) [quasi_separated f] [quasi_separated g] :
  quasi_separated (f ≫ g) :=
quasi_separated_stable_under_composition f g infer_instance infer_instance

lemma quasi_separated_space_of_quasi_separated {X Y : Scheme} (f : X ⟶ Y)
  [hY : quasi_separated_space Y.carrier] [quasi_separated f] : quasi_separated_space X.carrier :=
begin
  rw quasi_separated_space_iff_quasi_separated at hY ⊢,
  have : f ≫ terminal.from Y = terminal.from X := terminal_is_terminal.hom_ext _ _,
  rw ← this,
  resetI, apply_instance
end

instance quasi_separated_space_of_is_affine (X : Scheme) [is_affine X] :
  quasi_separated_space X.carrier :=
begin
  constructor,
  intros U V hU hU' hV hV',
  obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hU', hU⟩,
  obtain ⟨s', hs', e'⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hV', hV⟩,
  rw [e, e', set.Union₂_inter],
  simp_rw [set.inter_Union₂],
  apply hs.is_compact_bUnion,
  { intros i hi,
    apply hs'.is_compact_bUnion,
    intros i' hi',
    change is_compact (X.basic_open i ⊓ X.basic_open i').1,
    rw ← Scheme.basic_open_mul,
    exact ((top_is_affine_open _).basic_open_is_affine _).is_compact }
end

lemma is_affine_open.is_quasi_separated {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) :
  is_quasi_separated (U : set X.carrier)  :=
begin
  rw is_quasi_separated_iff_quasi_separated_space,
  exacts [@@algebraic_geometry.quasi_separated_space_of_is_affine _ hU, U.prop],
end

lemma quasi_separated_of_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
  [H : quasi_separated (f ≫ g)] : quasi_separated f :=
begin
  rw (quasi_separated.affine_open_cover_tfae f).out 0 1,
  rw (quasi_separated.affine_open_cover_tfae (f ≫ g)).out 0 2 at H,
  use (Z.affine_cover.pullback_cover g).bind (λ x, Scheme.affine_cover _),
  split, { intro i, dsimp, apply_instance },
  rintro ⟨i, j⟩, dsimp at *,
  specialize H _ i,
  refine @@quasi_separated_space_of_quasi_separated _ H _,
  { exact pullback.map _ _ _ _ (𝟙 _) _ _ (by simp) (category.comp_id _) ≫
      (pullback_right_pullback_fst_iso g (Z.affine_cover.map i) f).hom },
  { apply algebraic_geometry.quasi_separated_of_mono }
end

lemma exists_eq_pow_mul_of_is_affine_open (X : Scheme) (U : opens X.carrier) (hU : is_affine_open U)
  (f : X.presheaf.obj (op U)) (x : X.presheaf.obj (op $ X.basic_open f)) :
  ∃ (n : ℕ) (y : X.presheaf.obj (op U)),
    y |_ X.basic_open f = (f |_ X.basic_open f) ^ n * x :=
begin
  have := (is_localization_basic_open hU f).2,
  obtain ⟨⟨y, _, n, rfl⟩, d⟩ := this x,
  use [n, y],
  delta Top.presheaf.restrict_open Top.presheaf.restrict,
  simpa [mul_comm x] using d.symm,
end

lemma exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux (X : Scheme)
  (S : X.affine_opens) (U₁ U₂ : opens X.carrier)
  {n₁ n₂ : ℕ} {y₁ : X.presheaf.obj (op U₁)}
  {y₂ : X.presheaf.obj (op U₂)} {f : X.presheaf.obj (op $ U₁ ⊔ U₂)}
  {x : X.presheaf.obj (op $ X.basic_open f)}
  (h₁ : S.1 ≤ U₁) (h₂ : S.1 ≤ U₂)
  (e₁ : X.presheaf.map (hom_of_le $ X.basic_open_le
    (X.presheaf.map (hom_of_le le_sup_left).op f) : _ ⟶ U₁).op y₁ =
      X.presheaf.map (hom_of_le (by { erw X.basic_open_res, exact inf_le_left })).op
        (X.presheaf.map (hom_of_le le_sup_left).op f) ^ n₁ *
      (X.presheaf.map (hom_of_le (by { erw X.basic_open_res, exact inf_le_right })).op) x)
  (e₂ : X.presheaf.map (hom_of_le $ X.basic_open_le
    (X.presheaf.map (hom_of_le le_sup_right).op f) : _ ⟶ U₂).op y₂ =
      X.presheaf.map (hom_of_le (by { rw X.basic_open_res, exact inf_le_left })).op
        (X.presheaf.map (hom_of_le le_sup_right).op f) ^ n₂ *
      (X.presheaf.map (hom_of_le (by { rw X.basic_open_res, exact inf_le_right })).op) x) :
  ∃ n : ℕ, X.presheaf.map (hom_of_le $ h₁).op
    ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (n + n₂) * y₁) =
    X.presheaf.map (hom_of_le $ h₂).op
      ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (n + n₁) * y₂) :=
begin
  have := (is_localization_basic_open S.2
    (X.presheaf.map (hom_of_le $ le_trans h₁ le_sup_left).op f)),
  obtain ⟨⟨_, n, rfl⟩, e⟩ :=
    (@is_localization.eq_iff_exists _ _ _ _ _ _ this (X.presheaf.map (hom_of_le $ h₁).op
      ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ n₂ * y₁))
    (X.presheaf.map (hom_of_le $ h₂).op
      ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ n₁ * y₂))).mp _,
  swap,
  { simp only [map_pow, ring_hom.algebra_map_to_algebra, map_mul, ← comp_apply,
      ← functor.map_comp, ← op_comp, hom_of_le_comp],
    have h₃ := obj.algebra._proof_1 (X.presheaf.map (hom_of_le $ h₁.trans le_sup_left).op f),
    transitivity
      X.presheaf.map (hom_of_le $ h₃.trans $ h₁.trans le_sup_left).op f ^ (n₂ + n₁) *
      X.presheaf.map (hom_of_le $ (X.basic_open_res f _).trans_le inf_le_right).op x,
    { rw [pow_add, mul_assoc], congr' 1,
      convert congr_arg (X.presheaf.map (hom_of_le _).op) e₁,
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { rw [X.basic_open_res, X.basic_open_res], rintros x ⟨H₁, H₂⟩, exact ⟨h₁ H₁, H₂⟩ } },
    { rw [add_comm, pow_add, mul_assoc], congr' 1,
      convert congr_arg (X.presheaf.map (hom_of_le _).op) e₂.symm,
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr },
      { rw [RingedSpace.basic_open_res, X.basic_open_res],
        rintros x ⟨H₁, H₂⟩, exact ⟨h₂ H₁, H₂⟩ } } },
  use n,
  conv_lhs at e { rw mul_comm },
  conv_rhs at e { rw mul_comm },
  simp only [pow_add, map_pow, map_mul, ← comp_apply, ← mul_assoc,
    ← functor.map_comp, subtype.coe_mk] at e ⊢,
  convert e
end

lemma exists_eq_pow_mul_of_is_compact_of_is_quasi_separated (X : Scheme)
  (U : opens X.carrier) (hU : is_compact U.1) (hU' : is_quasi_separated U.1)
  (f : X.presheaf.obj (op U)) (x : X.presheaf.obj (op $ X.basic_open f)) :
  ∃ (n : ℕ) (y : X.presheaf.obj (op U)), y |_ X.basic_open f = (f |_ X.basic_open f) ^ n * x :=
begin
  delta Top.presheaf.restrict_open Top.presheaf.restrict,
  revert hU' f x,
  apply compact_open_induction_on U hU,
  { intros hU' f x,
    use [0, f],
    refine @@subsingleton.elim (CommRing.subsingleton_of_is_terminal
      (X.sheaf.is_terminal_of_eq_empty _)) _ _,
    erw eq_bot_iff,
    exact X.basic_open_le f },
  { -- Given `f : 𝒪(S ∪ U), x : 𝒪(X_f)`, we need to show that `f ^ n * x` is the restriction of
    -- some `y : 𝒪(S ∪ U)` for some `n : ℕ`.
    intros S hS U hU hSU f x,
    -- We know that such `y₁, n₁` exists on `S` by the induction hypothesis.
    obtain ⟨n₁, y₁, hy₁⟩ := hU (hSU.of_subset $ set.subset_union_left _ _)
      (X.presheaf.map (hom_of_le le_sup_left).op f) (X.presheaf.map (hom_of_le _).op x),
    swap, { rw X.basic_open_res, exact inf_le_right },
    -- We know that such `y₂, n₂` exists on `U` since `U` is affine.
    obtain ⟨n₂, y₂, hy₂⟩ := exists_eq_pow_mul_of_is_affine_open X _ U.2
      (X.presheaf.map (hom_of_le le_sup_right).op f) (X.presheaf.map (hom_of_le _).op x),
    delta Top.presheaf.restrict_open Top.presheaf.restrict at hy₂,
    swap, { rw X.basic_open_res, exact inf_le_right },
    -- Since `S ∪ U` is quasi-separated, `S ∩ U` can be covered by finite affine opens.
    obtain ⟨s, hs', hs⟩ := (is_compact_open_iff_eq_finset_affine_union _).mp
      ⟨hSU _ _ (set.subset_union_left _ _) S.2 hS
        (set.subset_union_right _ _) U.1.2 U.2.is_compact, (S ⊓ U.1).2⟩,
    haveI := hs'.to_subtype,
    casesI nonempty_fintype s,
    replace hs : S ⊓ U.1 = supr (λ i : s, (i : opens X.carrier)) := by { ext1, simpa using hs },
    have hs₁ : ∀ i : s, i.1.1 ≤ S,
    { intro i, change (i : opens X.carrier) ≤ S,
      refine le_trans _ inf_le_left, use U.1, erw hs, exact le_supr _ _ },
    have hs₂ : ∀ i : s, i.1.1 ≤ U.1,
    { intro i, change (i : opens X.carrier) ≤ U,
      refine le_trans _ inf_le_right, use S, erw hs, exact le_supr _ _ },
    -- On each affine open in the intersection, we have `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`
    -- for some `n` since `f ^ n₂ * y₁ = f ^ (n₁ + n₂) * x = f ^ n₁ * y₂` on `X_f`.
    have : ∀ i : s, ∃ n : ℕ,
      X.presheaf.map (hom_of_le $ hs₁ i).op
        ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (n + n₂) * y₁) =
      X.presheaf.map (hom_of_le $ hs₂ i).op
        ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (n + n₁) * y₂),
    { intro i,
      exact exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux X i.1 S U (hs₁ i) (hs₂ i)
        hy₁ hy₂ },
    choose n hn using this,
    -- We can thus choose a big enough `n` such that `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`
    -- on `S ∩ U`.
    have : X.presheaf.map (hom_of_le $ inf_le_left).op
      ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (finset.univ.sup n + n₂) * y₁) =
        X.presheaf.map (hom_of_le $ inf_le_right).op
          ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (finset.univ.sup n + n₁) * y₂),
    { fapply X.sheaf.eq_of_locally_eq' (λ i : s, i.1.1),
      { refine λ i, hom_of_le _, erw hs, exact le_supr _ _ },
      { exact le_of_eq hs },
      { intro i,
        replace hn := congr_arg (λ x, X.presheaf.map (hom_of_le
          (le_trans (hs₁ i) le_sup_left)).op f ^ (finset.univ.sup n - n i) * x) (hn i),
        dsimp only at hn,
        delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [← map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, ← mul_assoc]
          at hn ⊢,
        erw [← map_mul, ← map_mul] at hn,
        rw [← pow_add, ← pow_add, ← add_assoc, ← add_assoc, tsub_add_cancel_of_le] at hn,
        convert hn,
        exact finset.le_sup (finset.mem_univ _) } },
    use finset.univ.sup n + n₁ + n₂,
    -- By the sheaf condition, since `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`, it can be glued into
    -- the desired section on `S ∪ U`.
    use (X.sheaf.obj_sup_iso_prod_eq_locus S U.1).inv ⟨⟨_ * _, _ * _⟩, this⟩,
    fapply X.sheaf.eq_of_locally_eq₂,
    rotate 5,
    { exact X.basic_open (X.presheaf.map (hom_of_le le_sup_left).op f) },
    { exact X.basic_open (X.presheaf.map (hom_of_le le_sup_right).op f) },
    { refine hom_of_le _, rw X.basic_open_res, exact inf_le_right },
    { refine hom_of_le _, rw X.basic_open_res, exact inf_le_right },
    { rw [X.basic_open_res, X.basic_open_res],
      erw ← inf_sup_right,
      refine le_inf_iff.mpr ⟨X.basic_open_le f, le_of_eq rfl⟩ },
    { convert congr_arg (X.presheaf.map (hom_of_le _).op)
        (X.sheaf.obj_sup_iso_prod_eq_locus_inv_fst S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1,
      swap 3,
      { rw X.basic_open_res, exact inf_le_left },
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _),
          ← functor.map_comp, ← op_comp],
        congr },
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc,
          pow_add], erw hy₁, congr' 1, rw [← mul_assoc, ← mul_assoc], congr' 1,
        rw [mul_comm, ← comp_apply, ← functor.map_comp], congr } },
    { convert congr_arg (X.presheaf.map (hom_of_le _).op)
        (X.sheaf.obj_sup_iso_prod_eq_locus_inv_snd S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1,
      swap 3,
      { rw X.basic_open_res, exact inf_le_left },
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _),
          ← functor.map_comp, ← op_comp],
        congr },
      { delta Scheme.sheaf SheafedSpace.sheaf,
        simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc,
          pow_add], erw hy₂, rw [← comp_apply, ← functor.map_comp], congr } } }
end

/-- If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`.
This is known as the **Qcqs lemma** in [R. Vakil, *The rising sea*][RisingSea]. -/
lemma is_localization_basic_open_of_qcqs {X : Scheme} {U : opens X.carrier}
  (hU : is_compact U.1) (hU' : is_quasi_separated U.1)
  (f : X.presheaf.obj (op U)) :
  is_localization.away f (X.presheaf.obj (op $ X.basic_open f)) :=
begin
  constructor,
  { rintro ⟨_, n, rfl⟩, simp only [map_pow, subtype.coe_mk, ring_hom.algebra_map_to_algebra],
    apply is_unit.pow, exact RingedSpace.is_unit_res_basic_open _ f },
  { intro z,
    obtain ⟨n, y, e⟩ := exists_eq_pow_mul_of_is_compact_of_is_quasi_separated X U hU hU' f z,
    refine ⟨⟨y, _, n, rfl⟩, _⟩,
    simpa only [map_pow, subtype.coe_mk, ring_hom.algebra_map_to_algebra, mul_comm z]
      using e.symm },
  { intros x y,
    rw [← sub_eq_zero, ← map_sub, ring_hom.algebra_map_to_algebra],
    simp_rw [← @sub_eq_zero _ _ (x * _) (y * _), ← sub_mul],
    generalize : x - y = z,
    split,
    { intro H,
      obtain ⟨n, e⟩ := exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_compact X hU _ _ H,
      refine ⟨⟨_, n, rfl⟩, _⟩,
      simpa [mul_comm z] using e },
    { rintro ⟨⟨_, n, rfl⟩, e : z * f ^ n = 0⟩,
      rw [← ((RingedSpace.is_unit_res_basic_open _ f).pow n).mul_left_inj, zero_mul, ← map_pow,
        ← map_mul, e, map_zero] } }
end

end algebraic_geometry


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.fintype.basic
import set_theory.cardinal.cofinality
import set_theory.game.basic
import set_theory.game.birthday

/-!
# Short games

A combinatorial game is `short` [Conway, ch.9][conway2001] if it has only finitely many positions.
In particular, this means there is a finite set of moves at every point.

We prove that the order relations `≤` and `<`, and the equivalence relation `≈`, are decidable on
short games, although unfortunately in practice `dec_trivial` doesn't seem to be able to
prove anything using these instances.
-/
universes u

open_locale pgame

namespace pgame

/-- A short game is a game with a finite set of moves at every turn. -/
inductive short : pgame.{u} → Type (u+1)
| mk : Π {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}}
         (sL : ∀ i : α, short (L i)) (sR : ∀ j : β, short (R j))
         [fintype α] [fintype β],
       short ⟨α, β, L, R⟩

instance subsingleton_short : Π (x : pgame), subsingleton (short x)
| (mk xl xr xL xR) :=
⟨λ a b, begin
  cases a, cases b,
  congr,
  { funext,
    apply @subsingleton.elim _ (subsingleton_short (xL x)) },
  { funext,
    apply @subsingleton.elim _ (subsingleton_short (xR x)) },
end⟩
using_well_founded { dec_tac := pgame_wf_tac }

/-- A synonym for `short.mk` that specifies the pgame in an implicit argument. -/
def short.mk' {x : pgame} [fintype x.left_moves] [fintype x.right_moves]
  (sL : ∀ i : x.left_moves, short (x.move_left i))
  (sR : ∀ j : x.right_moves, short (x.move_right j)) :
  short x :=
by unfreezingI { cases x, dsimp at * }; exact short.mk sL sR

attribute [class] short

/--
Extracting the `fintype` instance for the indexing type for Left's moves in a short game.
This is an unindexed typeclass, so it can't be made a global instance.
-/
def fintype_left {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}} [S : short ⟨α, β, L, R⟩] :
  fintype α :=
by { casesI S with _ _ _ _ _ _ F _, exact F }
local attribute [instance] fintype_left
instance fintype_left_moves (x : pgame) [S : short x] : fintype (x.left_moves) :=
by { casesI x, dsimp, apply_instance }
/--
Extracting the `fintype` instance for the indexing type for Right's moves in a short game.
This is an unindexed typeclass, so it can't be made a global instance.
-/
def fintype_right {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}} [S : short ⟨α, β, L, R⟩] :
  fintype β :=
by { casesI S with _ _ _ _ _ _ _ F, exact F }
local attribute [instance] fintype_right
instance fintype_right_moves (x : pgame) [S : short x] : fintype (x.right_moves) :=
by { casesI x, dsimp, apply_instance }

instance move_left_short (x : pgame) [S : short x] (i : x.left_moves) : short (x.move_left i) :=
by { casesI S with _ _ _ _ L _ _ _, apply L }
/--
Extracting the `short` instance for a move by Left.
This would be a dangerous instance potentially introducing new metavariables
in typeclass search, so we only make it an instance locally.
-/
def move_left_short' {xl xr} (xL xR) [S : short (mk xl xr xL xR)] (i : xl) : short (xL i) :=
by { casesI S with _ _ _ _ L _ _ _, apply L }
local attribute [instance] move_left_short'
instance move_right_short (x : pgame) [S : short x] (j : x.right_moves) : short (x.move_right j) :=
by { casesI S with _ _ _ _ _ R _ _, apply R }
/--
Extracting the `short` instance for a move by Right.
This would be a dangerous instance potentially introducing new metavariables
in typeclass search, so we only make it an instance locally.
-/
def move_right_short' {xl xr} (xL xR) [S : short (mk xl xr xL xR)] (j : xr) : short (xR j) :=
by { casesI S with _ _ _ _ _ R _ _, apply R }
local attribute [instance] move_right_short'

theorem short_birthday : ∀ (x : pgame.{u}) [short x], x.birthday < ordinal.omega
| ⟨xl, xr, xL, xR⟩ hs :=
begin
  haveI := hs,
  unfreezingI { rcases hs with ⟨_, _, _, _, sL, sR, hl, hr⟩ },
  rw [birthday, max_lt_iff],
  split, all_goals
  { rw ←cardinal.ord_aleph_0,
    refine cardinal.lsub_lt_ord_of_is_regular.{u u} cardinal.is_regular_aleph_0
      (cardinal.lt_aleph_0_of_fintype _) (λ i, _),
    rw cardinal.ord_aleph_0,
    apply short_birthday _ },
  { exact move_left_short' xL xR i },
  { exact move_right_short' xL xR i }
end

/-- This leads to infinite loops if made into an instance. -/
def short.of_is_empty {l r xL xR} [is_empty l] [is_empty r] : short (mk l r xL xR) :=
short.mk is_empty_elim is_empty_elim

instance short_0 : short 0 :=
short.of_is_empty

instance short_1 : short 1 :=
short.mk (λ i, begin cases i, apply_instance, end) (λ j, by cases j)

/-- Evidence that every `pgame` in a list is `short`. -/
inductive list_short : list pgame.{u} → Type (u+1)
| nil : list_short []
| cons : Π (hd : pgame.{u}) [short hd] (tl : list pgame.{u}) [list_short tl], list_short (hd :: tl)

attribute [class] list_short
attribute [instance] list_short.nil list_short.cons

instance list_short_nth_le : Π (L : list pgame.{u}) [list_short L] (i : fin (list.length L)),
  short (list.nth_le L i i.is_lt)
| [] _ n := begin exfalso, rcases n with ⟨_, ⟨⟩⟩, end
| (hd :: tl) (@list_short.cons _ S _ _) ⟨0, _⟩ := S
| (hd :: tl) (@list_short.cons _ _ _ S) ⟨n+1, h⟩ :=
  @list_short_nth_le tl S ⟨n, (add_lt_add_iff_right 1).mp h⟩

instance short_of_lists : Π (L R : list pgame) [list_short L] [list_short R],
  short (pgame.of_lists L R)
| L R _ _ := by { resetI, apply short.mk,
  { intros, apply_instance },
  { intros, apply pgame.list_short_nth_le /- where does the subtype.val come from? -/ } }

/-- If `x` is a short game, and `y` is a relabelling of `x`, then `y` is also short. -/
def short_of_relabelling : Π {x y : pgame.{u}} (R : relabelling x y) (S : short x), short y
| x y ⟨L, R, rL, rR⟩ S :=
begin
  resetI,
  haveI := fintype.of_equiv _ L,
  haveI := fintype.of_equiv _ R,
  exact short.mk'
    (λ i, by { rw ←(L.right_inv i), apply short_of_relabelling (rL (L.symm i)) infer_instance, })
    (λ j, short_of_relabelling (rR j) infer_instance)
end

instance short_neg : Π (x : pgame.{u}) [short x], short (-x)
| (mk xl xr xL xR) _ :=
by { resetI, exact short.mk (λ i, short_neg _) (λ i, short_neg _) }
using_well_founded { dec_tac := pgame_wf_tac }

instance short_add : Π (x y : pgame.{u}) [short x] [short y], short (x + y)
| (mk xl xr xL xR) (mk yl yr yL yR) _ _ :=
begin
  resetI,
  apply short.mk, all_goals
  { rintro ⟨i⟩,
    { apply short_add },
    { change short (mk xl xr xL xR + _), apply short_add } }
end
using_well_founded { dec_tac := pgame_wf_tac }

instance short_nat : Π n : ℕ, short n
| 0 := pgame.short_0
| (n+1) := @pgame.short_add _ _ (short_nat n) pgame.short_1

instance short_bit0 (x : pgame.{u}) [short x] : short (bit0 x) :=
by { dsimp [bit0], apply_instance }
instance short_bit1 (x : pgame.{u}) [short x] : short (bit1 x) :=
by { dsimp [bit1], apply_instance }

/--
Auxiliary construction of decidability instances.
We build `decidable (x ≤ y)` and `decidable (x ⧏ y)` in a simultaneous induction.
Instances for the two projections separately are provided below.
-/
def le_lf_decidable : Π (x y : pgame.{u}) [short x] [short y],
  decidable (x ≤ y) × decidable (x ⧏ y)
| (mk xl xr xL xR) (mk yl yr yL yR) shortx shorty :=
begin
  resetI,
  split,
  { refine @decidable_of_iff' _ _ mk_le_mk (id _),
    apply @and.decidable _ _ _ _,
    { apply @fintype.decidable_forall_fintype xl _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).2; apply_instance, },
    { apply @fintype.decidable_forall_fintype yr _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).2; apply_instance, }, },
  { refine @decidable_of_iff' _ _ mk_lf_mk (id _),
    apply @or.decidable _ _ _ _,
    { apply @fintype.decidable_exists_fintype yl _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).1; apply_instance, },
    { apply @fintype.decidable_exists_fintype xr _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).1; apply_instance, }, },
end
using_well_founded { dec_tac := pgame_wf_tac }

instance le_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≤ y) :=
(le_lf_decidable x y).1

instance lf_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ⧏ y) :=
(le_lf_decidable x y).2

instance lt_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x < y) :=
and.decidable

instance equiv_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≈ y) :=
and.decidable

example : short 0 := by apply_instance
example : short 1 := by apply_instance
example : short 2 := by apply_instance
example : short (-2) := by apply_instance

example : short (of_lists [0] [1]) := by apply_instance
example : short (of_lists [-2, -1] [1]) := by apply_instance

example : short (0 + 0) := by apply_instance

example : decidable ((1 : pgame) ≤ 1) := by apply_instance

-- No longer works since definitional reduction of well-founded definitions has been restricted.
-- example : (0 : pgame) ≤ 0 := dec_trivial
-- example : (1 : pgame) ≤ 1 := dec_trivial

end pgame


import data.set.basic
import .extensionality

universe u

namespace extensionality
instance set_ext_lemmas (T : Type*) :
  (boolalg_ext_lemmas (set T) T) :=
{
  simpl_eq := by tidy,
  simpl_lt := by tidy,
  ext_bot := by tidy,
  ext_sdiff := by tidy,
  ext_le := by tidy,
  ext_meet := by tidy,
  ext_join := by tidy,
}

instance set_ext_lemmas_compl (T : Type*) :
  (boolalg_ext_lemmas_compl (set T) T) :=
{
  ext_compl := by tidy,
}

instance set_ext_lemmas_top (T : Type*) :
  (boolalg_ext_lemmas_top (set T) T) :=
{
  ext_top := by tidy,
}
end extensionality

namespace cleanup
lemma set_union_sup (T : Type*) (A B : set T) : (A ∪ B) = (A ⊔ B) := by refl
lemma set_inter_inf (T : Type*) (A B : set T) : (A ∩ B) = (A ⊓ B) := by refl
lemma set_subset_le (T : Type*) (A B : set T) : (A ⊆ B) = (A ≤ B) := by refl
lemma set_subset_lt (T : Type*) (A B : set T) : (A ⊂ B) = (A < B) := by refl
lemma set_univ_top (T : Type*) : (set.univ : set T) = ⊤ := by refl
lemma set_empt_bot (T : Type*) : (∅ : set T) = ⊥ := by refl

meta def set_cleanup : tactic unit :=
  `[simp only [cleanup.set_union_sup, cleanup.set_inter_inf, cleanup.set_subset_le,
      cleanup.set_subset_lt, cleanup.set_univ_top, cleanup.set_empt_bot] at *]
end cleanup


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

local attribute [instance] 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,
  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.symm).symm ((seven5 b a).1) (seven12a h2.2.2.1.symm).symm (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
rintros 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
rintros ⟨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,
  rintros ⟨p, hp, h⟩,
  by_cases h_1 : B d e f,
    refine ⟨S b a, ⟨h.1, (seven12a h.1.symm).symm, h.2.1, or.inl (seven5 b a).1⟩, _⟩,
    exact eleven21c h.1 (seven12a h.1.symm).symm 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⟩,
rintros ⟨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
rintros ⟨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.symm) (four10 h5).2.1) h3.symm,
apply nine12 (six14 ht.1.symm) (six17b e d)((six7 (three6b hr.1 ht.2.2.2.1) (six26 h5).2.2.symm).symm),
intro h_3,
exact h5 (eleven21d (four11 h_3).2.1 (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⟩,
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
rintros 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
rintros ⟨h, h1⟩ h2 h3,
refine ⟨eleven30 h h2 h3, _⟩,
intro h_1,
exact h1 (h2.trans (h_1.trans 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,
  rintros ⟨⟨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),
rintros ⟨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 acute (a b c : point) : Prop := ∃ x y z, R x y z ∧ ang_lt a b c x y z

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

theorem acute.symm {a b c : point} : acute a b c → acute c b a :=
begin
rintros ⟨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 eleven40a {a b c : point} : sided b a c → 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

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

theorem tri_of_obtuse {a b c : point} : obtuse a b c → a ≠ b ∧ c ≠ b :=
λ ⟨x, y, z, h⟩, ⟨(eleven38a.1 h.2).2.2.1, (eleven38a.1 h.2).2.2.2.1⟩

theorem obtuse.symm {a b c : point} : obtuse a b c → obtuse c b a :=
begin
rintros ⟨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 eleven40b {a b c : point} : a ≠ b → c ≠ b → B a b c → 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

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

theorem lt_right_of_acute {a b c p q r : point} : acute a b c → right p q r → ang_lt a b c p q r :=
begin
rintros ⟨x, y, z, h⟩ h1,
apply eleven37 h.2 (eqa.refl (eleven38a.1 h.2).1 (eleven38a.1 h.2).2.1),
exact 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
end

theorem gt_right_of_obtuse {a b c p q r : point} : obtuse a b c → right p q r → ang_lt p q r a b c :=
begin
rintros ⟨x, y, z, h⟩ h1,
apply eleven37 h.2 _ (eqa.refl (eleven38a.1 h.2).2.2.1 (eleven38a.1 h.2).2.2.2.1),
exact eleven16 (eleven38a.1 h.2).1 (eleven38a.1 h.2).2.1 h1.1 h1.2.1 h.1 h1.2.2
end

theorem lt_obtuse_of_acute {a b c d e f : point} : acute a b c → obtuse d e f → ang_lt a b c d e f :=
begin
rintros ⟨x, y, z, h⟩ h1,
suffices : right x y z,
  exact h.2.trans (gt_right_of_obtuse h1 this),
exact ⟨(eleven38a.1 h.2).2.2.1, (eleven38a.1 h.2).2.2.2.1, h.1⟩
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 a c) 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 (four10 (nine11 h7).2.1).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,
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 eleven42 {a b c d: point} : B a b d → (d ≠ b ∧ acute a b c ↔ a ≠ b ∧ obtuse d b c) :=
begin
intros h,
split,
  rintros ⟨h1, h2⟩,
  rcases h2 with ⟨x, y, z, h2, ⟨h3, h4⟩⟩,
  have h5 : ang_le (S y x) y z d b c,
    exact eleven36a h1 (seven12a (eleven33 h3).2.2.1.symm).symm h (seven5 y x).1 h3,
  refine ⟨(eleven33 h3).1, S y x, y, z, h2.symm.flip.symm, ⟨h5, _⟩⟩,
  intro h_1,
  exact h4 (eleven13 h_1.symm (eleven33 h3).1 h.symm (eleven33 h3).2.2.1 (seven5 y x).1.symm),
rintros ⟨h1, h2⟩,
rcases h2 with ⟨x, y, z, h2, ⟨h3, h4⟩⟩,
have h5 : ang_le a b c (S y x) y z,
  exact eleven36a (seven12a (eleven33 h3).1.symm).symm h1 (seven5 y x).1 h.symm h3,
refine ⟨(eleven33 h3).2.2.1, S y x, y, z, h2.symm.flip.symm, ⟨h5, _⟩⟩,
intro h_1,
exact h4 (eleven13 h_1.symm (eleven33 h3).1 (seven5 y x).1.symm (eleven33 h3).2.2.1 h)
end

theorem eleven43 {a b c : point} : ¬col a b c → (R b a c ∨ obtuse b a c) → acute a b c ∧ acute a c b :=
begin
intros h h1,
have h2 := eleven41 h (seven5 a b).1 (seven12a (six26 h).1).symm,
cases h1,
  refine ⟨⟨c, a, (S a b), h1.symm.flip, _⟩, c, a, (S a b), h1.symm.flip, _⟩,
    exact h2.2,
  exact h2.1,
suffices : 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 ((eleven42 (seven5 a b).1.symm).2 ⟨(seven12a (six26 h).1).symm, h1⟩).2.symm
end

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 d e f : point} : a ≠ b → c ≠ b → (acute a b c ∨ right a b c ∨ 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 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 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

def isoc (a b c : point) : Prop := ¬col a b c ∧ eqd b a b c

def equil (a b c : point) : Prop := tri a b c ∧ eqd a b b c ∧ eqd a b a c

theorem eleven45a {a b c : point} : acute a b c → ¬right a b c ∧ ¬obtuse a b c :=
λ h, ⟨λ h1, (lt_right_of_acute h h1).2 (eqa.refl (tri_of_acute h).1 (tri_of_acute h).2),
λ h1, (lt_obtuse_of_acute h h1).2 (eqa.refl (tri_of_acute h).1 (tri_of_acute h).2)⟩

theorem eleven45b {a b c : point} : right a b c → ¬acute a b c ∧ ¬obtuse a b c :=
λ h, ⟨λ h1, (lt_right_of_acute h1 h).2 (eqa.refl h.1 h.2.1),
λ h1, (gt_right_of_obtuse h1 h).2 (eqa.refl h.1 h.2.1)⟩

theorem eleven45c {a b c : point} : obtuse a b c → ¬acute a b c ∧ ¬right a b c :=
λ h, ⟨λ h1, (lt_obtuse_of_acute h1 h).2 (eqa.refl (tri_of_obtuse h).1 (tri_of_obtuse h).2),
λ h1, (gt_right_of_obtuse h h1).2 (eqa.refl (tri_of_obtuse h).1 (tri_of_obtuse h).2)⟩

theorem eleven46 {a b c : point} : ¬col a b c → (R b a c ∨ obtuse b a c) → distlt a b b c ∧ distlt a c b c :=
begin
intros h h1,
split,
  apply five14 ((eleven44b (four10 h).2.1).2 _) (two5 (eqd.refl b a)) (eqd.refl b c),
  cases h1,
    exact lt_right_of_acute (eleven43 h (or.inl h1)).2.symm ⟨(six26 h).1.symm, (six26 h).2.2.symm, h1⟩,
  exact lt_obtuse_of_acute (eleven43 h (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_right_of_acute (eleven43 h (or.inl h1)).1.symm ⟨(six26 h).2.2.symm, (six26 h).1.symm, h1.symm⟩,
exact lt_obtuse_of_acute (eleven43 h (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 : ¬col a b c,
  intro h_1,
  exact (eight14b h1) (six18 h1.2.1 (six13 h1.1) h_1 h1.2.2.2.1).symm,
have h3 := eleven43 (four10 h2).2.2.2.1 (or.inl h),
have h4 : x ≠ a,
  intro h_1,
  subst x,
  exact (eleven45a h3.1).1 ⟨(six26 h2).2.2.symm, (six26 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 ⟨(six26 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 (six26 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 (six26 h2).1).symm).1 this).symm,
    exact h6.trans (five6 this (eqd.refl a x) (two5 (eqd.refl a b))),
  apply distle.trans _ (eleven46 (four10 h2).2.2.2.1 (or.inl h)).1.1,
  suffices : ¬col x c a,
    exact five6 (eleven46 this (or.inl (h1.2.2.2.2 (six17a c x) (six17a a b)))).2.1 (two5 (eqd.refl x a)) (eqd.refl c a),
  intro h_1,
  exact h4 (eight14d h1 (eight15 ⟨x, h1⟩ (four11 h_1).2.1 (six17a a b))),
apply (this h.symm _ (four10 h2).2.1 h3.symm h5 h4).symm,
rwa six17 b a
end

theorem eleven48 {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 eleven49 {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 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 (four10 h5).2.1),
apply (nine12 (six14 h1.2.2.1) (six17b b' a') hx.1.symm (four10 h5).2.1).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 (eleven48 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 (eleven48 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 (eleven49 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 (eleven48 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


/-
Copyright (c) 2023 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.defs.independence
import computational_monads.constructions.uniform_select
import computational_monads.constructions.product
import computational_monads.support.prod
import computational_monads.asymptotics.polynomial_time

/-!
# Symmetric-Key Encryption Schemes

This file defines symmetric key encryption schemes as well as their security properties.
-/

open oracle_spec oracle_comp
open_locale classical big_operators

/-- A symmetric-key encryption algorithm is a set of functions `gen`, `encrypt`, and `decrypt`.
The types `M`, `K`, and `C` are the types of the messages, keys, and ciphertexts respectively.
We assume that the `keygen` has a random selection oracle, and the other two are deterministic. -/
structure symm_enc_alg (M K C : Type) :=
(keygen : unit → oracle_comp uniform_selecting K)
(encrypt : M × K → C)
(decrypt : C × K → M)
-- (keygen_poly_time : poly_time_oracle_comp keygen)
-- (encrypt_poly_time : poly_time encrypt)
-- (decrypt_poly_time : poly_time decrypt)
(complete : ∀ (m : M), ∀ k ∈ (keygen ()).support,
  decrypt (encrypt (m, k), k) = m)

namespace symm_enc_alg

variables {M K C : Type}

/-- Alias the plain text type of the algorithm for convenience-/
@[inline, reducible] def M (se_alg : symm_enc_alg M K C) : Type := M

/-- Alias the key type of the algorithm for convenience-/
@[inline, reducible] def K (se_alg : symm_enc_alg M K C) : Type := K

/-- Alias the cipher text type of the algorithm for convenience-/
@[inline, reducible] def C (se_alg : symm_enc_alg M K C) : Type := C

-- /-- Encrypt a message and key pair, preserving the message -/
-- @[inline, reducible] def m_encrypt (se_alg : symm_enc_alg M K C) : M × K → M × C :=
-- λ x, (x.1, se_alg.encrypt x)

variables (se_alg : symm_enc_alg M K C)

/-- Write completeness in terms of the encryption and decryption functions being inverses. -/
lemma right_inverse_encrypt_decrypt : ∀ k ∈ (se_alg.keygen ()).support,
  function.right_inverse (λ m, se_alg.encrypt (m, k)) (λ c, se_alg.decrypt (c, k)) :=
λ k hk m, se_alg.complete m k hk

lemma encrypt_injective (k : K) (hk : k ∈ (se_alg.keygen ()).support) :
  (λ m, se_alg.encrypt (m, k) : M → C).injective :=
function.right_inverse.injective (se_alg.right_inverse_encrypt_decrypt k hk)

lemma decrypt_surjective (k : K) (hk : k ∈ (se_alg.keygen ()).support) :
  (λ m, se_alg.decrypt (m, k) : C → M).surjective :=
function.right_inverse.surjective (se_alg.right_inverse_encrypt_decrypt k hk)

/-- Due to completeness there must be at least as many ciphertexts as plaintexts. -/
theorem card_message_le_card_ciphertext [fintype M] [fintype C] :
  fintype.card M ≤ fintype.card C :=
let ⟨k, hk⟩ := (se_alg.keygen ()).support_nonempty in -- keygen has at least one possible output
  fintype.card_le_of_injective _ (se_alg.encrypt_injective k hk)

section mgen_and_encrypt

/-- Computation that given a message distribution `m_dist`, will draw a message `m` from the
distribution, generate a key `k` using `keygen`, and calculate the resulting ciphertext `c`.
The computation returns both the chosen message and the resulting ciphertext. -/
@[inline, reducible] def mgen_and_encrypt (m_dist : oracle_comp uniform_selecting M) :
  oracle_comp uniform_selecting (M × C) := do {
    m ← m_dist,
    k ← se_alg.keygen (),
    return (m, se_alg.encrypt (m, k))
  }

variable (m_dist : oracle_comp uniform_selecting M)

/-- Possible outputs of `mgen_and_encrypt` as a union over possible messages and keys. -/
lemma support_mgen_and_encrypt' : (se_alg.mgen_and_encrypt m_dist).support =
  ⋃ m ∈ m_dist.support, ⋃ k ∈ (se_alg.keygen ()).support, {(m, se_alg.encrypt (m, k))} :=
by simp only [support_bind, support_return]

/-- Possible outputs of `mgen_and_encrypt` as a union over messages of the image of keys. -/
@[simp] lemma support_mgen_and_encrypt : (se_alg.mgen_and_encrypt m_dist).support =
  ⋃ m ∈ m_dist.support, (λ k, (m, se_alg.encrypt (m, k))) '' (se_alg.keygen ()).support :=
by simp only [support_bind, support_bind_return]

/-- `(m, c)` is a possible output of `mgen_and_encrypt` iff `m` is a possible output of `m_dist`
and there exists a key in the output of `keygen` that encrypts `m` to `c`. -/
lemma mem_support_mgen_and_encrypt_iff (m : M) (c : C) :
  (m, c) ∈ (se_alg.mgen_and_encrypt m_dist).support ↔
    m ∈ m_dist.support ∧ ∃ k ∈ (se_alg.keygen ()).support, se_alg.encrypt (m, k) = c :=
by simp_rw [support_bind, support_return, set.mem_Union, set.mem_singleton_iff,
  prod.eq_iff_fst_eq_snd_eq, exists_and_distrib_left, exists_prop, exists_eq_left', @eq_comm _ c]

/-- Given an output `(m, c)` of `mgen_and_encrypt`, there exists a key `k` in `keygen`'s support
such that `k` encrypts `m` to `c`. -/
lemma exists_key_of_mem_support_mgen_and_encrypt (m : M) (c : C)
  (h : (m, c) ∈ (se_alg.mgen_and_encrypt m_dist).support) :
    ∃ k ∈ (se_alg.keygen ()).support, se_alg.encrypt (m, k) = c :=
((se_alg.mem_support_mgen_and_encrypt_iff m_dist m c).1 h).2

/-- The distribution associated to `mgen_and_encrypt` is the same as that associated to
running `m_dist` and `keygen` independently, and mapping according to the `encrypt` function. -/
lemma eval_dist_mgen_and_encrypt : ⁅se_alg.mgen_and_encrypt m_dist⁆ =
  ⁅(λ x, (prod.fst x, se_alg.encrypt x)) <$> (m_dist ×ₘ se_alg.keygen ())⁆ :=
by rw [eval_dist_map_product']

/-- The probability of getting a particular output `(m, c)` from `mgen_and_encrypt` is the sum over
possible keys that encrypt `m` to `c` of the probability of getting that key,
weighted by the probability of getting `m` from the message distribution. -/
lemma eval_dist_mgen_and_encrypt_apply (m : M) (c : C) :
  ⁅= (m, c) | se_alg.mgen_and_encrypt m_dist⁆ =
    ∑' (k : K), if c = se_alg.encrypt (m, k)
      then ⁅= m | m_dist⁆ * ⁅= k | se_alg.keygen ()⁆ else 0 :=
by rw [eval_dist_mgen_and_encrypt, eval_dist_map_fst_product_apply]

/-- The message portion of the output of `mgen_and_encrypt` follows the message distribution. -/
lemma eval_dist_fst_map_mgen_and_encrypt :
  ⁅prod.fst <$> se_alg.mgen_and_encrypt m_dist⁆ = ⁅m_dist⁆ :=
by simp only [pmf.map_comp, eval_dist_map, eval_dist_bind, eval_dist_bind_return,
  pmf.map_bind, prod.fst_comp_mk, pmf.map_const, pmf.bind_pure]

end mgen_and_encrypt

section perfect_secrecy

/-- A symmetric encryption algorithm has perfect secrecy if the probability of any particular
ciphertext is the same, regardless of the plaintext. We express this as the fact that for any
distribution of messages `message_dist`, and fixed message `m` and ciphertext `c`,
the probability of getting `c` from encrypting a message drawn from `message_dist`
is the same as the probability of getting `c` from encrypting the fixed `m`. -/
def perfect_secrecy (se_alg : symm_enc_alg M K C) : Prop :=
∀ (m_dist : oracle_comp uniform_selecting M) (m : M) (c : C),
  (se_alg.mgen_and_encrypt m_dist).indep_event (prod.fst ⁻¹' {m}) (prod.snd ⁻¹' {c})

/-- Restate perfect secrecy in terms of explicit probabilities instead of indepent events.
A symmetric encryption algorithm has perfect secrecy iff the probability of getting a given
message-ciphertext after generating a key and encrypting is the probability of drawing the message
times the probability of getting that ciphertext from any message, for any message distribution. -/
theorem perfect_secrecy_iff : se_alg.perfect_secrecy ↔ ∀ (m_dist : oracle_comp uniform_selecting M)
  (m : M) (c : C), ⁅= (m, c) | se_alg.mgen_and_encrypt m_dist⁆ =
    ⁅= m | m_dist⁆ * ⁅= c | prod.snd <$> se_alg.mgen_and_encrypt m_dist⁆ :=
begin
  refine forall_congr (λ m_dist, (forall_congr (λ m, forall_congr (λ c, _)))),
  have this : prod.fst ⁻¹' {m} ∩ prod.snd ⁻¹' {c} = ({(m, c)} : set (M × C)),
  by {ext x, simp only [prod.eq_iff_fst_eq_snd_eq, set.mem_inter_iff,
    set.mem_preimage, set.mem_singleton_iff]},
  simp only [indep_event_iff, ← prob_event_map, prob_event_singleton_eq_eval_dist,
    eval_dist_fst_map_mgen_and_encrypt, this],
end

section equal_card

variables [fintype M] [fintype K] [fintype C]
  (hmk : fintype.card M = fintype.card K) (hkc : fintype.card K = fintype.card C)
include hmk hkc

/-- If all spaces have the same size we can get bijectivity of encrypt not just injectivity. -/
lemma encrypt_bijective_of_equal_card (k : K) (hk : k ∈ (se_alg.keygen ()).support) :
  (λ m, se_alg.encrypt (m, k) : M → C).bijective :=
(fintype.bijective_iff_injective_and_card _).2
  ⟨se_alg.encrypt_injective k hk, hmk.trans hkc⟩

/-- If all spaces have the same size we can get bijectivity of decrypt not just surjectivity. -/
lemma decrypt_bijective_of_equal_card (k : K) (hk : k ∈ (se_alg.keygen ()).support) :
  (λ c, se_alg.decrypt (c, k) : C → M).bijective :=
(fintype.bijective_iff_surjective_and_card _).2
  ⟨se_alg.decrypt_surjective k hk, symm $ hmk.trans hkc⟩

/-- If all spaces are the same size then encryption and decryption are also left inverses. -/
lemma left_inverse_encrypt_decrypt : ∀ k ∈ (se_alg.keygen ()).support,
  function.left_inverse (λ m, se_alg.encrypt (m, k)) (λ c, se_alg.decrypt (c, k)) :=
λ k hk c, (se_alg.decrypt_bijective_of_equal_card hmk hkc k hk).1 (se_alg.complete _ _ hk)

/-- Reverse version of completeness, i.e. encrypting a decryption gives the initial value. -/
lemma complete' (c : C) (k : K) (hk : k ∈ (se_alg.keygen ()).support) :
  se_alg.encrypt (se_alg.decrypt (c, k), k) = c :=
se_alg.left_inverse_encrypt_decrypt hmk hkc k hk c

section perfect_secrecy

/-- Given perfect secrecy and matching cardinatlities, every message-ciphertext pair must
give rise to a key that encrypts that message to that ciphertext. -/
theorem exists_unique_key_of_perfect_secrecy (h : se_alg.perfect_secrecy) (m : M) (c : C) :
  ∃! (k : K), k ∈ (se_alg.keygen ()).support ∧ se_alg.encrypt (m, k) = c :=
begin
  -- We first show regular existence, and then extend to uniqueness after.
  have hmc : ∀ m c, ∃ k, k ∈ (se_alg.keygen ()).support ∧ se_alg.encrypt (m, k) = c,
  { clear m c, intros m c,
    haveI : nonempty M := ⟨m⟩,
    -- If the message and ciphertext have non-zero probability, there must be an encryption key.
    suffices : 0 < ⁅= (m, c) | se_alg.mgen_and_encrypt ($ᵗ M)⁆,
    from let ⟨k, hk, hk'⟩ := se_alg.exists_key_of_mem_support_mgen_and_encrypt
      ($ᵗ M) m c ((eval_dist_pos_iff _ _).1 this) in ⟨k, hk, hk'⟩,
    -- It suffices to show that such a key exists for *some* message, rather than exactly `m`.
    suffices : ∃ m' k, k ∈ (se_alg.keygen ()).support ∧ se_alg.encrypt (m', k) = c,
    by simpa only [(se_alg.perfect_secrecy_iff.1 h) ($ᵗ M) m c, ennreal.mul_pos_iff, true_and,
      eval_dist_pos_iff, mem_support_uniform_select_fintype, mem_support_map_snd_iff,
      mem_support_mgen_and_encrypt_iff, mem_support_uniform_select_fintype M, exists_prop],
    -- We can choose an arbitrary key, and then take the message to be the decrypted ciphertext.
    obtain ⟨k, hk⟩ := (se_alg.keygen ()).support_nonempty,
    exact ⟨se_alg.decrypt (c, k), k, hk, se_alg.left_inverse_encrypt_decrypt hmk hkc k hk c⟩ },
  -- Due to the cardinalities this further implies `encrypt` is bijective on the set of keys.
  have : (λ k, se_alg.encrypt (m, k)).bijective := (fintype.bijective_iff_surjective_and_card _).2
    ⟨λ c, let ⟨k, _, hk⟩ := hmc m c in ⟨k, hk⟩, hkc⟩,
  exact exists_unique_of_exists_of_unique (hmc m c) (λ k k' h h', this.1 (h.2.trans h'.2.symm)),
end

/-- Given perfect secrecy and matching cardinatlities, the keygen function must include
all possible keys in its set of possible outputs. -/
lemma support_keygen_of_perfect_secrecy (h : se_alg.perfect_secrecy) :
  (se_alg.keygen ()).support = set.univ :=
begin
  -- If the support is as large as the entire space `K`, it must be the whole space `K`.
  suffices : fintype.card K ≤ (se_alg.keygen ()).support.to_finset.card,
  from set.to_finset_eq_univ.1 (finset.eq_univ_of_card _ $ antisymm (finset.card_le_univ _) this),
  -- Need to handle the case of `M` being an empty type seperately.
  by_cases hM : nonempty M,
  { refine hM.elim (λ m, _),
    calc fintype.card K = fintype.card C : hkc
      ... ≤ ((λ k, se_alg.encrypt (m, k)) '' (se_alg.keygen ()).support).to_finset.card :
        finset.card_le_of_subset (λ c hc, set.mem_to_finset.2 ((set.mem_image _ _ _).2 $
          exists_of_exists_unique (se_alg.exists_unique_key_of_perfect_secrecy hmk hkc h m c)))
      ... ≤ (se_alg.keygen ()).support.to_finset.card :
        by simpa only [set.to_finset_image] using finset.card_image_le },
  { simpa only [← hmk, @fintype.card_eq_zero M _ (not_nonempty_iff.1 hM)] using zero_le' }
end

/-- Given perfect secrecy and matching cardinality, all keys are possible outputs of `keygen`. -/
lemma mem_support_keygen (h : se_alg.perfect_secrecy) (k : K) : k ∈ (se_alg.keygen ()).support :=
(se_alg.support_keygen_of_perfect_secrecy hmk hkc h).symm ▸ set.mem_univ k

/-- If all spaces have the same size we can get bijectivity of encrypt not just injectivity,
where encryption is viewed as a function on keys with a fixed message. -/
lemma encrypt_key_bijective_of_perfect_secrecy (h : se_alg.perfect_secrecy) (m : M) :
  (λ k, se_alg.encrypt (m, k) : K → C).bijective :=
(function.bijective_iff_exists_unique _).2 $
  λ c, let ⟨k, hk, h'⟩ := se_alg.exists_unique_key_of_perfect_secrecy hmk hkc h m c
    in ⟨k, hk.2, λ k' hk', h' k' ⟨se_alg.mem_support_keygen hmk hkc h k', hk'⟩⟩

/-- If all spaces have the same size we can get bijectivity of encrypt not just injectivity,
where decryption is viewed as a function on keys with a fixed ciphertext. -/
lemma decrypt_key_bijective_of_perfect_secrecy (h : se_alg.perfect_secrecy) (c : C) :
  (λ k, se_alg.decrypt (c, k) : K → M).bijective :=
(function.bijective_iff_exists_unique _).2
  (λ m, let ⟨k, hk, h'⟩ := se_alg.exists_unique_key_of_perfect_secrecy hmk hkc h m c
    in ⟨k, hk.2 ▸ se_alg.complete m k hk.1, λ k' hk', h' k' ⟨se_alg.mem_support_keygen
      hmk hkc h k', hk' ▸ se_alg.complete' hmk hkc c k' (se_alg.mem_support_keygen hmk hkc h k')⟩⟩)

/-- encrypting and decrypting a message gives the original iff the same key is used. -/
lemma decrypt_encrypt_eq_iff_of_perfect_secrecy (h : se_alg.perfect_secrecy) (m : M) (k k' : K) :
  se_alg.decrypt (se_alg.encrypt (m, k), k') = m ↔ k = k' :=
have hk : k ∈ (se_alg.keygen ()).support := (se_alg.mem_support_keygen hmk hkc h k),
have hk' : k' ∈ (se_alg.keygen ()).support := (se_alg.mem_support_keygen hmk hkc h k'),
⟨λ h', (se_alg.encrypt_key_bijective_of_perfect_secrecy hmk hkc h m).1
  ((se_alg.decrypt_bijective_of_equal_card hmk hkc k' hk').1
  (h'.trans (se_alg.complete m k' hk').symm)), λ h', h' ▸ se_alg.complete m k hk⟩

/-- decrypting and encrypting a ciphertext gives the original iff the same key is used. -/
lemma encrypt_decrypt_eq_iff_of_perfect_secrecy (h : se_alg.perfect_secrecy) (c : C) (k k' : K) :
  se_alg.encrypt (se_alg.decrypt (c, k), k') = c ↔ k = k' :=
have hk : k ∈ (se_alg.keygen ()).support := (se_alg.mem_support_keygen hmk hkc h k),
have hk' : k' ∈ (se_alg.keygen ()).support := (se_alg.mem_support_keygen hmk hkc h k'),
⟨λ h', (se_alg.decrypt_key_bijective_of_perfect_secrecy hmk hkc h c).1
  ((se_alg.encrypt_bijective_of_equal_card hmk hkc k' hk').1
  (h'.trans (se_alg.complete' hmk hkc c k' hk').symm)), λ h', h' ▸ se_alg.complete' hmk hkc c k hk⟩

lemma eval_dist_ciphertext_eq_eval_dist_key_of_perfect_secrecy
  (h : se_alg.perfect_secrecy) (m_dist : oracle_comp uniform_selecting M)
  (k : K) (c : C) (h' : se_alg.decrypt (c, k) ∈ m_dist.support) :
  ⁅= c | prod.snd <$> se_alg.mgen_and_encrypt m_dist⁆ = ⁅= k | se_alg.keygen ()⁆ :=
begin
  -- Multiply by the probability of getting the decryption, in order to use perfect secrecy
  let m := se_alg.decrypt (c, k),
  suffices : ⁅= m | m_dist⁆ * ⁅= k | se_alg.keygen ()⁆ =
    ⁅= m | m_dist⁆ * ⁅= c | prod.snd <$> se_alg.mgen_and_encrypt m_dist⁆,
  from ((ennreal.mul_eq_mul_left (eval_dist_ne_zero h')
    (pmf.apply_ne_top _ _)).1 this).symm,
  -- Extend the encryption function to include a side message, preserving injectivity.
  let f : M × K → M × C := λ x, (x.1, se_alg.encrypt (x.1, x.2)),
  have hf : f (m, k) = (m, c) := prod.eq_iff_fst_eq_snd_eq.2
    ⟨rfl, se_alg.complete' hmk hkc c k $ se_alg.mem_support_keygen hmk hkc h k⟩,
  have hf' : f.injective,
  { simp only [function.injective, prod.eq_iff_fst_eq_snd_eq] at ⊢,
    exact λ x y hxy, ⟨hxy.1, (se_alg.encrypt_key_bijective_of_perfect_secrecy
      hmk hkc h x.1).1 $ hxy.2.trans (hxy.1 ▸ rfl)⟩ },
  -- Using the above function we can move from keys to ciphertexts, then apply perfect secrecy.
  calc ⁅= m | m_dist⁆ * ⁅= k | se_alg.keygen ()⁆ = ⁅= (m, k) | m_dist ×ₘ se_alg.keygen ()⁆ :
      symm (eval_dist_product_apply _ _ _)
    ... = ⁅= f (m, k) | f <$> (m_dist ×ₘ se_alg.keygen ())⁆ :
      (eval_dist_map_apply_of_injective _ f (m, k) hf').symm
    ... = ⁅= (m, c) | se_alg.mgen_and_encrypt m_dist⁆ :
      by simp_rw [hf, product, eval_dist_map, eval_dist_bind,
        pmf.map_bind, eval_dist_return, pmf.map_pure]
    ... = ⁅= m | m_dist⁆ * ⁅= c | prod.snd <$> se_alg.mgen_and_encrypt m_dist⁆ :
      (se_alg.perfect_secrecy_iff.1 h) m_dist m c
end

/-- Assuming that the message, key, and ciphertext spaces all have the same size,
any system with perfect secrecy must generate keys uniformly at random. -/
theorem eval_dist_keygen_eq_uniform_of_perfect_secrecy [nonempty M] [nonempty C]
  (h : se_alg.perfect_secrecy) (k : K) : ⁅= k | se_alg.keygen ()⁆ = (fintype.card K)⁻¹ :=
calc ⁅= k | se_alg.keygen ()⁆ = 1 * ⁅= k | se_alg.keygen ()⁆ : (one_mul _).symm
  -- Introduce a copy of `fintype.card C` by multiplying by its inverse.
  ... = ((fintype.card C)⁻¹ * (fintype.card C)) * ⁅= k | se_alg.keygen ()⁆ :
    congr_arg (λ x, x * ⁅= k | se_alg.keygen ()⁆) ((ennreal.inv_mul_cancel (nat.cast_ne_zero.2
      fintype.card_ne_zero) $ by simp only [ne.def, ennreal.nat_ne_top, not_false_iff]).symm)
  -- Multiplication by `fintype.card C` is equivalent to summing over `C` itself.
  ... = (fintype.card C)⁻¹ * (∑' (c : C), ⁅= k | se_alg.keygen ()⁆) :
    by simp only [tsum_fintype, finset.sum_const, fintype.card, ←mul_assoc, nsmul_eq_mul]
  -- For any `c : C`, the probability of getting `c` is equal to getting `k` (by above).
  ... = (fintype.card C)⁻¹ * (∑' (c : C), ⁅= c | prod.snd <$> se_alg.mgen_and_encrypt ($ᵗ M)⁆) :
    congr_arg (λ x, (fintype.card C)⁻¹ * x) (tsum_congr $ λ c, symm $
      se_alg.eval_dist_ciphertext_eq_eval_dist_key_of_perfect_secrecy hmk hkc h _ k c
        (mem_support_uniform_select_fintype _ _))
  -- The sum over all `c : C` of the probability of getting that value is just `1`.
  ... = (fintype.card C)⁻¹ : by rw [pmf.tsum_coe, mul_one]
  ... = (fintype.card K)⁻¹ : by rw hkc

/-- Given that all spaces have the same cardinality, perfect secrecy holds iff:
1. `keygen` chooses keys uniformly at random.
2. for every message `m` and ciphertext `c`, there is a unique key encrypting `m` to `c`.
In particular this will be used to show perfect secrecy of the one-time pad.-/
theorem perfect_secrecy_iff_of_equal_card [nonempty M] [nonempty C] :
  se_alg.perfect_secrecy ↔ (∀ k, ⁅= k | se_alg.keygen ()⁆ = (fintype.card K)⁻¹) ∧
    (∀ m c, ∃! k, k ∈ (se_alg.keygen ()).support ∧ se_alg.encrypt (m, k) = c) :=
begin
  split,
  { exact λ h, ⟨se_alg.eval_dist_keygen_eq_uniform_of_perfect_secrecy hmk hkc h,
      λ m c, se_alg.exists_unique_key_of_perfect_secrecy hmk hkc h m c⟩ },
  { rw [perfect_secrecy_iff],
    rintros ⟨h_keygen, h_encrypt⟩ m_dist m c,
    obtain ⟨k, ⟨⟨_, hc⟩, hk⟩⟩ := h_encrypt m c,
    have : ∀ m', ⁅= (m', c) | se_alg.mgen_and_encrypt m_dist⁆ =
      ⁅= m' | m_dist⁆ * ⁅= k | se_alg.keygen ()⁆ :=
    begin
      refine λ m', (se_alg.eval_dist_mgen_and_encrypt_apply _ _ _).trans _,
      obtain ⟨k', hks, hke⟩ := h_encrypt m' c,
      refine trans (tsum_eq_single k' $ λ k'' hk'', _) _,
      { by_cases hks' : k'' ∈ (se_alg.keygen ()).support,
        { exact ite_eq_right_iff.2 (λ hkkd, false.elim (hk'' $ hke k'' ⟨hks', hkkd.symm⟩)) },
        { simp_rw [(eval_dist_eq_zero_iff _ _).2 hks', mul_zero, if_t_t] } },
      { simp_rw [hks.2, eq_self_iff_true, if_true, h_keygen] },
    end,
    calc ⁅= (m, c) | se_alg.mgen_and_encrypt m_dist⁆ =
      ⁅= m | m_dist⁆ * ⁅= k | se_alg.keygen ()⁆ : this m
      ... = ⁅= m | m_dist⁆ * ∑' m', ⁅= m' | m_dist⁆ * ⁅= k | se_alg.keygen ()⁆ :
        by rw [ennreal.tsum_mul_right, ⁅m_dist⁆.tsum_coe, one_mul]
      ... = ⁅= m | m_dist⁆ * ∑' m', ⁅= (m', c) | se_alg.mgen_and_encrypt m_dist⁆ :
        congr_arg (λ x, _ * x) (tsum_congr $ λ m', (this m').symm)
      ... = ⁅= m | m_dist⁆ * ⁅= c | prod.snd <$> se_alg.mgen_and_encrypt m_dist⁆ :
        begin
          simp_rw [eval_dist_map_apply_eq_tsum, ennreal.tsum_prod', ← hc],
          exact congr_arg (λ x, _ * x) (tsum_congr (λ m', symm $ trans
            (tsum_eq_single (se_alg.encrypt (m, k)) $ λ c hc, if_neg hc.symm) (if_pos rfl))),
        end
  }
end

end perfect_secrecy

end equal_card

end perfect_secrecy

end symm_enc_alg


mutual
inductive Foo
 | somefoo : Foo
 | bar : Bar → Foo

inductive Bar
 | somebar : Bar
 | foobar : Foo → Bar → Bar
end

mutual
  private def Foo.toString : Foo → String
    | Foo.somefoo => "foo"
    | Foo.bar b => Bar.toString b

  def _root_.Bar.toString : Bar → String
    | Bar.somebar => "bar"
    | Bar.foobar f b => Foo.toString f ++ Bar.toString b
end

namespace Ex2
mutual
inductive Foo
 | somefoo : Foo
 | bar : Bar → Foo → Foo

inductive Bar
 | somebar : Bar
 | foobar : Foo → Bar → Bar
end

mutual
  private def Foo.toString : Foo → String
    | Foo.somefoo => go 2 ++ toString.go 2 ++ Foo.toString.go 2
    | Foo.bar b f => Foo.toString f ++ Bar.toString b
  where
    go (x : Nat) := s!"foo {x}"

  private def _root_.Ex2.Bar.toString : Bar → String
    | Bar.somebar => "bar"
    | Bar.foobar f b => Foo.toString f ++ Bar.toString b
end
end Ex2

def Nat.fact : Nat → Nat
  | 0 => 1
  | n+1 => (n+1) * Nat.fact n

example : Nat.fact 3 = 6 := rfl

namespace Boo
  def fact : Nat → Nat
  | 0 => 2
  | n+1 => (n+1) * Boo.fact n

  example : Boo.fact 3 = 12 := rfl
end Boo