import .size .induction_size algebra.big_operators.order finsum.fin_api .embed
----------------------------------------------------------------
open_locale classical
open_locale big_operators
noncomputable theory

universes u v w

open set

section extrema
variables {α: Type*} [fintype α]

def is_lb (P : set α → Prop) (X : set α) : Prop := ∀ Y, P Y → X ⊆ Y
def is_ub (P : set α → Prop) (X : set α) : Prop := ∀ Y, P Y → Y ⊆ X

def down_closed (P : set α → Prop) : Prop := ∀ X Y, X ⊆ Y → P Y → P X
def up_closed (P : set α → Prop) : Prop := ∀ X Y, X ⊆ Y → P X → P Y

def is_minimal (P : set α → Prop) (X : set α) : Prop := P X ∧ ∀ Y, (Y ⊂ X → ¬ P Y)
def is_maximal (P : set α → Prop) (X : set α) : Prop := P X ∧ ∀ Y, (X ⊂ Y → ¬ P Y)

lemma max_iff_compl_min (P : set α → Prop) (X : set α) :
  is_maximal P X ↔ is_minimal (λ Z, P Zᶜ) Xᶜ :=
begin
  refine ⟨λ h, ⟨by {rw ←compl_compl X at h, exact h.1},λ Y hY, _⟩,
          λ h, ⟨by {rw ←compl_compl X, exact h.1},λ Y hY, _⟩⟩,
  exact h.2 _ (ssubset_compl_comm.mpr hY), rw ←compl_compl Y,
  exact h.2 _ (compl_ssubset_compl_iff.mpr hY),
end

lemma down_closed_iff_negation_up_closed (P : set α → Prop) :
  down_closed P ↔ up_closed (λ X, ¬P X) :=
by {unfold down_closed up_closed, simp_rw not_imp_not}

lemma contains_min {P : set α → Prop} {X : set α} :
  P X → ∃ Y, Y ⊆ X ∧ is_minimal P Y :=
minimal_example P

lemma max_contains {P : set α → Prop} {X : set α} :
  P X → ∃ Y, X ⊆ Y ∧ is_maximal P Y :=
maximal_example P

-- Union/Intersection-closed collections of sets

def union_closed (P : set α → Prop) : Prop := P ∅ ∧ ∀ X Y, P X → P Y → P (X ∪ Y)
def inter_closed (P : set α → Prop) : Prop := P univ ∧ ∀ X Y, P X → P Y → P (X ∩ Y)

lemma union_closed_iff_compl_inter_closed (P : set α → Prop) :
  union_closed P ↔ inter_closed (λ X, P Xᶜ) :=
begin
  refine ⟨λ h, ⟨by {rw compl_univ, exact h.1},λ X Y hX hY, _⟩,
          λ h,⟨by {rw ←compl_univ, exact h.1},λ X Y hX hY,_⟩ ⟩,
  rw compl_inter, exact h.2 _ _ hX hY,
  rw [←compl_compl (X ∪ Y), compl_union],
  rw ←compl_compl X at hX,
  rw ←compl_compl Y at hY,
  exact h.2 _ _ hX hY,
end

lemma inter_closed_exists_min (P : set α → Prop) :
  inter_closed P → ∃ X, is_minimal P X :=
λ h, by {cases (contains_min h.1) with Y, use Y, exact h_1.2}

lemma inter_closed_min_unique (P : set α → Prop) :
  inter_closed P → ∀ X₁ X₂, is_minimal P X₁ → is_minimal P X₂ → X₁ = X₂ :=
by {intros hP _ _ h₁ h₂, replace hP := hP.2 _ _ h₁.1 h₂.1, by_contra a,
    cases ssubset_inter a, exact (h₁.2 _ h) hP, exact (h₂.2 _ h) hP}

lemma inter_closed_min_iff_in_and_lb {P : set α → Prop} (hP : inter_closed P) (X : set α) :
  is_minimal P X ↔ P X ∧ is_lb P X :=
  begin
    refine ⟨λ h, ⟨h.1, λ Z pZ,_⟩, λ h,⟨h.1, λ Y hY hPY, _⟩⟩,
    by_contra a, rw subset_iff_union_eq_left at a, refine  h.2 _ _ (hP.2 _ _ pZ h.1),
    rw [←subset_iff_union_eq_left, subset_iff_inter_eq_left, inter_comm] at a,
    exact ssubset_of_subset_ne (inter_subset_right _ _) a,
    exact ssubset_not_supset hY (h.2 _ hPY),
  end

lemma union_closed_exists_max (P : set α → Prop) :
  union_closed P → ∃ X, is_maximal P X :=
  λ h, by {cases (max_contains h.1) with Y, use Y, exact h_1.2}

lemma union_closed_max_unique (P : set α → Prop) :
  union_closed P → ∀ X₁ X₂, is_maximal P X₁ → is_maximal P X₂ → X₁ = X₂ :=
  begin
    rw [union_closed_iff_compl_inter_closed],
    simp_rw [max_iff_compl_min],
    refine λ h X₁ X₂ h₁ h₂,_ ,
    rw [←compl_compl X₁, ←compl_compl X₂, inter_closed_min_unique _ h _ _ h₁ h₂],
  end

lemma union_closed_max_iff_in_and_ub {P : set α → Prop} (hP : union_closed P) (X : set α) :
  is_maximal P X ↔ P X ∧ is_ub P X :=
  begin
    refine ⟨λ h, ⟨h.1, λ Z pZ,_⟩, λ h,⟨h.1, λ Y hY hPY, _⟩⟩,
    by_contra a, rw subset_iff_union_eq_left at a, refine  h.2 _ _ (hP.2 _ _ pZ h.1),
    exact ssubset_of_subset_ne (subset_union_right _ _) (ne.symm a),
    exact ssubset_not_supset hY (h.2 _ hPY),
  end

def min_of_inter_closed {P : set α → Prop} (h : inter_closed P) : set α :=
  classical.some (inter_closed_exists_min P h)

def max_of_union_closed {P : set α → Prop} (h : union_closed P) : set α :=
  classical.some (union_closed_exists_max P h)

lemma min_of_inter_closed_in {P : set α → Prop} (h : inter_closed P) :
  P (min_of_inter_closed h) :=
  (classical.some_spec (inter_closed_exists_min P h)).1

lemma min_of_inter_closed_is_lb {P : set α → Prop} (h : inter_closed P) :
  is_lb P (min_of_inter_closed h) :=
  begin
    intros X hX, rcases contains_min hX with ⟨Y, ⟨hY₁, hY₂⟩⟩,
    rwa inter_closed_min_unique P h _ _  hY₂
      ((classical.some_spec (inter_closed_exists_min P h))) at hY₁,
  end

/-lemma min_of_inter_closed_is_min {P : set α → Prop} (h : inter_closed P) :
  is_minimal P (min_of_inter_closed h) :=
  (classical.some_spec (inter_closed_exists_min P h))-/

lemma is_min_of_inter_closed {P : set α → Prop} (h : inter_closed P) {X : set α} :
  P X → is_lb P X → X = min_of_inter_closed h :=
begin
  intros hX hlb,
  refine inter_closed_min_unique P h X (min_of_inter_closed h) ⟨hX,λ Y hY hPY, _⟩ ⟨_,λ Y hY hPY,_⟩,
  exact ssubset_not_supset hY (hlb Y hPY),
  exact min_of_inter_closed_in h,
  refine ssubset_not_supset (subset.lt_of_le_of_lt (hlb _ hPY) hY ) _,
  exact (min_of_inter_closed_is_lb h) _ hX,
end

lemma is_min_of_inter_closed_iff {P : set α → Prop} (hic : inter_closed P) (X : set α) :
  X = min_of_inter_closed hic ↔ P X ∧ is_lb P X :=
begin
  refine ⟨λ h, _, λ h, is_min_of_inter_closed hic h.1 h.2 ⟩ ,
  rw h, exact ⟨min_of_inter_closed_in hic, min_of_inter_closed_is_lb hic⟩,
end

lemma max_of_union_closed_in {P : set α → Prop} (h : union_closed P) :
  P (max_of_union_closed h) :=
  (classical.some_spec (union_closed_exists_max P h)).1

lemma max_of_union_closed_is_ub {P : set α → Prop} (h : union_closed P) :
  is_ub P (max_of_union_closed h) :=
begin
  intros X hX, rcases max_contains hX with ⟨Y, ⟨hY₁, hY₂⟩⟩,
  rwa union_closed_max_unique
    P h _ _  hY₂ ((classical.some_spec (union_closed_exists_max P h))) at hY₁
end

lemma is_max_of_union_closed {P : set α → Prop} (h : union_closed P) {X : set α} :
  P X → is_ub P X → X = max_of_union_closed h :=
begin
  intros hX hub,
  refine union_closed_max_unique P h X (max_of_union_closed h) ⟨hX,λ Y hY hPY, _⟩ ⟨_,λ Y hY hPY,_⟩,
  exact ssubset_not_supset hY (hub Y hPY),
  exact max_of_union_closed_in h,
  refine ssubset_not_supset (subset.lt_of_lt_of_le hY (hub _ hPY)) _,
  exact (max_of_union_closed_is_ub h) _ hX,
end

lemma is_max_of_union_closed_iff {P : set α → Prop} (huc : union_closed P) (X : set α) :
  X = max_of_union_closed huc ↔ P X ∧ is_ub P X :=
begin
  refine ⟨λ h, _, λ h, is_max_of_union_closed huc h.1 h.2 ⟩ ,
  rw h, exact ⟨max_of_union_closed_in huc, max_of_union_closed_is_ub huc⟩,
end

--- Unions/Intersections of collections
lemma lb_union_closed (P : set α → Prop) :
  union_closed (λ X, is_lb P X) :=
  ⟨λ Z hZ, empty_subset Z, λ X Y hX hY, λ Z hZ, union_subset (hX Z hZ) (hY Z hZ)⟩

lemma ub_inter_closed (P : set α → Prop) :
  inter_closed (λ X, is_ub P X) :=
  ⟨λ Z hZ, subset_univ Z, λ X Y hX hY, λ Z hZ, subset_inter (hX Z hZ) (hY Z hZ)⟩

def inter_all (P : set α → Prop) : set α := max_of_union_closed (lb_union_closed P)

def union_all (P : set α → Prop) : set α := min_of_inter_closed (ub_inter_closed P)

lemma subset_inter_all_iff (P : set α → Prop) (X : set α) :
  X ⊆ inter_all P ↔ is_lb P X :=
  begin
    refine ⟨λ h, λ Y hY, _ , λ h, max_of_union_closed_is_ub (lb_union_closed P) _ h ⟩,
    exact subset.trans h (max_of_union_closed_in (lb_union_closed P) Y hY),
  end

lemma union_all_subset_iff (P : set α → Prop) (X : set α) :
  union_all P ⊆ X ↔ is_ub P X :=
  begin
    refine ⟨λ h, λ Y hY, _ , λ h, min_of_inter_closed_is_lb (ub_inter_closed P) _ h ⟩,
    exact subset.trans (min_of_inter_closed_in (ub_inter_closed P) Y hY) h,
  end

lemma union_all_ub (P : set α → Prop) :
  is_ub P (union_all P) :=
  (union_all_subset_iff P _).mp (subset_refl _ )

end extrema
section size

variables {α : Type*} [fintype α]

lemma size_sUnion_of_common_inter {I : set α} {S : set (set α)}
(hne : S.nonempty) (h : ∀ X X' ∈ S, X ≠ X' → X ∩ X' = I) :
  size (⋃₀ S) = size I + ∑ᶠ X in S, (size X - size I) :=
begin
  revert S,
  refine induction_set_size_insert _ (by simp) (λ S X₀ hX₀ IH, _),
  rcases (eq_empty_or_nonempty S) with (rfl | hS), simp,
  rintros - h,
  rw [sUnion_insert, size_union, IH hS (λ X X' hX hX' hXX', _) ], swap,
  { apply h, repeat {rw mem_insert_iff, right, assumption,}, assumption  },
  rw fin.finsum_in_insert _ hX₀,
  suffices hI : X₀ ∩ ⋃₀S = I, { rw hI, ring, },
  have hI' : ∀ X' ∈ S, X₀ ∩ X' = I,
  { intros X' hX', apply h, simp, rwa mem_insert_iff, exact or.inr hX', rintro rfl, exact hX₀ hX'},
  apply subset.antisymm, swap,
  { obtain ⟨X', hX'⟩ := nonempty_def.mp hS,
    rw ← hI' _ hX',
    apply inter_subset_inter_right,
    intros x hx,
    rw mem_sUnion,
    exact ⟨X', hX', hx⟩},
  intros x hx,
  simp only [exists_prop, mem_inter_eq, mem_set_of_eq] at hx,
  obtain ⟨X₁, hX₁, hxX₁⟩ := hx.2,
  rw [← hI' X₁ hX₁, mem_inter_iff],
  exact ⟨hx.1, hxX₁⟩,
end

lemma size_sUnion_of_common_inter' {I : set α} {S : set (set α)}
(hne : S.nonempty) (h : ∀ X X' ∈ S, X ≠ X' → X ∩ X' = I) :
  size (⋃₀ S) =  ∑ᶠ X in S, size X - (size S - 1) * (size I)  :=
begin
  rw [size_sUnion_of_common_inter hne h],
  have hsub : ∑ᶠ (X : set α) in S, (size X - size I)
            = ∑ᶠ (X : set α) in S, size X - ∑ᶠ (X : set α) in S, size I,
  { apply fin.finsum_in_sub_distrib, } ,
  rw [hsub, int.finsum_in_const_eq_mul_size],
  ring,
end

lemma size_disjoint_sUnion {S : set (set α)}
(hdj : pairwise_disjoint S) :
  size (⋃₀ S) =  ∑ᶠ X in S, size X :=
begin
  rcases S.eq_empty_or_nonempty with (rfl | hS), simp,
  have hX : ∀ X X' ∈ S, X ≠ X' → X ∩ X' = ∅,
  { simp_rw ← disjoint_iff_inter_eq_empty,
    exact λ X X' hX hX' hXX', hdj X hX X' hX' hXX'},
  rw size_sUnion_of_common_inter' hS hX, simp,
end

end size


import algebra.field
import gtm106.weierstrass_equation.basic
import gtm106.weierstrass_equation.point
import gtm106.weierstrass_equation.linear_change_of_variable.basic
import gtm106.weierstrass_equation.linear_change_of_variable.change_curve
import gtm106.weierstrass_equation.linear_change_of_variable.change_point
import tactic

-- ================
-- Isomorphism class of Weierstrass equations under linear change of variable
-- ================

namespace weierstrass_equation

def is_isom' {K : Type*} [field K]
(E E' : weierstrass_equation K) := ∃ C : linear_change_of_variable K,
(C.change_curve E) = E'

lemma is_isom'.refl {K : Type*} [field K]
(E : weierstrass_equation K) : E.is_isom' E :=
begin
  use linear_change_of_variable.identity K,
  exact linear_change_of_variable.change_curve.id E,
end

lemma is_isom'.symm {K : Type*} [field K]
(E E' : weierstrass_equation K) (h : E.is_isom' E') : E'.is_isom' E :=
begin
  rcases h with ⟨ C, h ⟩,
  use C.inverse,
  rw [← h, ← linear_change_of_variable.change_curve.comp],
  simp,
end

lemma is_isom'.trans {K : Type*} [field K]
(E E' E'' : weierstrass_equation K) (h : E.is_isom' E') (h' : E'.is_isom' E'')
: E.is_isom' E'' :=
begin
  rcases h with ⟨ C, h ⟩,
  rcases h' with ⟨ C', h' ⟩,
  use C'.composite C,
  rw [linear_change_of_variable.change_curve.comp, h, h'],
end

lemma is_isom'.is_equivalence (K : Type*) [h : field K]
: equivalence (@is_isom' K h) :=
mk_equivalence (@is_isom' K h)
(@is_isom'.refl K h)
(@is_isom'.symm K h)
(@is_isom'.trans K h)

instance isom_class'.setoid (K : Type*) [h : field K]
: setoid (weierstrass_equation K) :=
setoid.mk (@is_isom' K h)
(is_isom'.is_equivalence K)

/--
Isomorphism class of Weierstrass equations under linear change of variable
-/
def isom_class' (K : Type*) [field K] : Type* :=
quotient (isom_class'.setoid K)

def isom_class'.j {K : Type*} [field K]
(E : isom_class' K) := quotient.lift (@j K _) (by {
  rintros E E' ⟨ C, h ⟩,
  rw [← h, C.j],
}) E

def isom_class'.non_singular' {K : Type*} [field K]
(E : isom_class' K) := quotient.lift (@non_singular' K _) (by {
  rintros E E' ⟨ C, h ⟩,
  rw [← h, C.preserve_non_singular'],
}) E

def isom_class'.has_node' {K : Type*} [field K]
(E : isom_class' K) := quotient.lift (@has_node' K _) (by {
  rintros E E' ⟨ C, h ⟩,
  rw [← h, C.preserve_has_node'],
}) E

def isom_class'.has_cusp' {K : Type*} [field K]
(E : isom_class' K) := quotient.lift (@has_cusp' K _) (by {
  rintros E E' ⟨ C, h ⟩,
  rw [← h, C.preserve_has_cusp'],
}) E

def isom_class'.non_singular {K : Type*} [field K]
(E : isom_class' K) := quotient.lift (@non_singular K _) (by {
  rintros E E' ⟨ C, h ⟩,
  rw [← h, C.preserve_non_singular],
}) E

def isom_class'.has_node {K : Type*} [field K]
(E : isom_class' K) := quotient.lift (@has_node K _) (by {
  rintros E E' ⟨ C, h ⟩,
  rw [← h, C.preserve_has_node],
}) E

def isom_class'.has_cusp {K : Type*} [field K]
(E : isom_class' K) := quotient.lift (@has_cusp K _) (by {
  rintros E E' ⟨ C, h ⟩,
  rw [← h, C.preserve_has_cusp],
}) E

end weierstrass_equation


import reals
import regular_sequence
import lim_zero

-- for mathlib
lemma max_eq(a b: ℚ): max a b = (a + b + abs (a - b)) / 2 :=
begin
  by_cases h: a ≤ b,
  {
    have: 0 ≥ a-b,
    {
      linarith,
    },
    rw [abs_of_nonpos this],
    ring_nf,
    simpa,
  },
  {
    push_neg at h,
    have: 0 < a-b,
    {
      linarith,
    },
    rw [abs_of_pos this],
    ring_nf,
    rw max_comm,
    simp only [max_eq_right_iff],
    exact le_of_lt h,
  }
end

def regular_sequence.max(a b: regular_sequence): regular_sequence :=
{ val := λ n, max (a n) (b n),
  property :=
  begin
    intros n m n_pos m_pos,
    simp,
    repeat {rw max_eq},
    calc |(a n + b n + |a n - b n|) / 2 - (a m + b m + |a m - b m|) / 2|
      = |((a n - a m) + (b n - b m) + |a n - b n| - |a m - b m|)/2 | : by ring_nf
     ... ≤ (n)⁻¹ + (m)⁻¹ : by sorry
  end }

@[simp]
lemma regular_sequence.max_val(a b: regular_sequence) (n : ℕ):
  (regular_sequence.max a b) n = max (a n) (b n) :=
  sorry

open regular_sequence

def reals.max: real → real → real :=
  quotient.lift₂ (λ x y, ⟦regular_sequence.max x y⟧)
    begin
      intros a₁ a₂ b₁ b₂ h₁ h₂,
      rw quotient.eq,

      rw regular_sequence.equivalent_iff at *,
      intros n hn,
      use 37,
      intros m hm,
      simp only [fn_apply, sub_apply, max_val, subtype.val_eq_coe],
      repeat {rw max_eq,},

      have : |a₁ m - a₂ m| ≤ |a₁ m - b₁ m| + |a₂ m - b₂ m| + |b₁ m - b₂ m|,
      {
        sorry
      },
      calc |(a₁ m + a₂ m + |a₁ m - a₂ m|) / 2 - (b₁ m + b₂ m + |b₁ m - b₂ m|) / 2|
        =  |((a₁ m - b₁ m) + (a₂ m - b₂ m) + (|a₁ m - a₂ m| - |b₁ m - b₂ m|)) / 2 | : by ring_nf
        ... = (|(a₁ m - b₁ m) + (a₂ m - b₂ m) + |a₁ m - a₂ m| - |b₁ m - b₂ m| |) / 2 : by sorry
        ... ≤ (|a₁ m - b₁ m| + |(a₂ m - b₂ m) + |a₁ m - a₂ m| - |b₁ m - b₂ m| |) / 2 : by sorry
        ... ≤ (|a₁ m - b₁ m| + |a₂ m - b₂ m| + | |a₁ m - a₂ m| - |b₁ m - b₂ m| |) / 2 : by sorry
        ... ≤ (|a₁ m - b₁ m| + |a₂ m - b₂ m| + | |a₁ m - b₁ m| + |a₂ m - b₂ m| + |b₁ m - b₂ m| - |b₁ m - b₂ m| |) / 2 : by sorry
        ... = (|a₁ m - b₁ m| + |a₂ m - b₂ m| + | |a₁ m - b₁ m| + |a₂ m - b₂ m| |) / 2 : by sorry
        ... = (|a₁ m - b₁ m| + |a₂ m - b₂ m| + |a₁ m - b₁ m| + |a₂ m - b₂ m|) / 2 : by sorry
        ... = |a₁ m - b₁ m| + |a₂ m - b₂ m| : by ring_nf
        ... ≤ (2*n: ℚ)⁻¹ + (2*n: ℚ)⁻¹ : by sorry
        ... = (n: ℚ)⁻¹ : by
        begin
          ring_nf,
          rw mul_inv₀,
          rw ← mul_assoc,
          simp only [one_mul, mul_inv_cancel, ne.def, not_false_iff, bit0_eq_zero, one_ne_zero],
         end,
    end


import tactic.abel
variables {α : Type*} {a b : α}

example [add_comm_monoid α] : a + (b + a) = a + a + b := by abel
example [add_comm_group α] : (a + b) - ((b + a) + a) = -a := by abel
example [add_comm_group α] (x : α) : x - 0 = x := by abel
example [add_comm_monoid α] (x : α) : (3 : ℕ) • a = a + (2 : ℕ) • a := by abel
example [add_comm_group α] : (3 : ℤ) • a = a + (2 : ℤ) • a := by abel
example [add_comm_group α] (a b : α) : a-2•b = a -2•b := by abel
example [add_comm_group α] (a : α) : 0 + a = a := by abel1
example [add_comm_group α] (n : ℕ) (a : α) : n • a = n • a := by abel1
example [add_comm_group α] (n : ℕ) (a : α) : 0 + n • a = n • a := by abel1

-- `abel!` should see through terms that are definitionally equal,
def id' (x : α) := x
example [add_comm_group α] : a + b - b - id' a = 0 :=
begin
  success_if_fail { abel; done },
  abel!
end


import number_theory.padics.padic_integers

--OUTPUT 1
theorem padic_units_lemma [s : comm_ring α] (p : ℕ) (h : p.prime) (x : α) :
    ((x.norm_of_padic_int p) ≠ 1) ↔ (p | x) :=
begin
    -- The contrapositive must hold, that is $\Vert x\Vert = 1$ must imply that $p$ does not divide $x$
    unfold padic_int_norm, unfold padic_int.norm_prim,
    rw mul_one, rw pow_one, rw neg_eq_zero, rw zero_ne_one,
    rw ne.def, rw int.coe_nat_dvd,
    exact (p.min_fac_dvd_iff.mpr h).symm,
end

--OUTPUT 2
theorem p_adic_units (p : ℕ) (x : ℤ) : coprime p x → x ∈ units (ℤ_[p]) :=
begin
  -- Prove by contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  assume h1 : ¬ x ∈ units (ℤ_[p]),
  have h2 : ¬ x.norm_val = 1, from by auto [h1, units_iff_norm_eq_one],
  have h3 : x.norm_val < 1, from begin
    unfold norm_val,
    have h31 : ∀ (n : ℕ), (↑(p^n)*x) = 0, from by auto [set.mem_range],
    have h32 : ∀ (n : ℕ), (↑(p^n)*x) < p^n, from by auto [pow_pos (dec_trivial), lt_iff_one_lt_iff, pow_pos'],
    have h33 : x ≠ 0, from by auto [pow_pos (dec_trivial), lt_add_one],
    have h34 : ∃ (n : ℕ), ((↑(p^n)*x) < p^n) ∧ (↑(p^n)*x) ≠ 0, from by auto [h32, h33],
    have h35 : ∀ (n : ℕ), ((↑(p^n)*x) < p^n) ∧ (↑(p^n)*x) ≠ 0, from by auto [nat.find_min h34],
    have h36 : ∀ (n : ℕ), (((↑(p^n) : ℤ) * x) < (p^n : ℤ)) ∧ ((↑(p^n) * x) ≠ 0), from by auto [h35],
    show x.norm_val < 1, from by auto [nat.find_min h35, exists_unique.unique, exists_unique.exists, lt_one_iff, le_norm] using [set.range, set.mem_range],
  end,
  have h4 : p ∣ x, from by auto [not_coprime_iff_dvd],
  show ¬ coprime p x, from by auto [h4],
end

--OUTPUT 3
theorem p_adic_units {x : ℕ} (hp : prime x) : ∀ y, coprime x y → is_unit (zmodp x y) :=
begin
    intros y hy,
    -- Proving the contrapositive, that is, if $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
    have h1 : ¬ (∃ m : ℤ, m*(↑y : ℤ) = 1) ↔ ∀ n : ℕ, n*(↑y : ℤ) ≠ 1, by auto,
    have h2 : ¬ (∃ m : ℤ, m*(↑y : ℤ) = 1) ↔ ∀ n : ℕ, (↑n : ℤ)*(↑y : ℤ) ≠ 1, by auto,
    have h3 : ¬ (∃ m : ℤ, m*(↑y : ℤ) = 1) ↔ ∀ n : ℕ, n*y ≠ 1 [MOD x], by auto,
    have h4 : ¬ (∃ m : ℤ, m*(↑y : ℤ) = 1) ↔ ¬ (∃ m : ℤ, m*(↑y : ℤ) = 1), by auto,
    have h5 : ¬ (∃ m : ℤ, m*(↑y : ℤ) = 1) ↔ ¬ ((zmodp x y) ∈ units (zmodp x y)), by auto,
    have h6 : ∀ n : ℕ, n*y ≠ 1 [MOD x] ↔ ¬ (y ∈ units (zmodp x y)), from by auto using [nat.find_spec],
    -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \ne 1$.
    have h7 : ∀ n : ℕ, n*y ≠ 1 [MOD x] ↔ ∀ n : ℕ, n*(↑y : ℤ) ≠ 1, by auto,
    have h8 : ∀ n : ℕ, n*(↑y : ℤ) ≠ 1 ↔ ∀ n : ℕ, n*y ≠ 1 [MOD x], by auto,
    have h9 : ∀ n : ℕ, n*(↑y : ℤ) ≠ 1 ↔ ¬ (zmodp x y)*↑n = 1, by auto,
    have h10 : ∀ n : ℕ, n*(↑y : ℤ) ≠ 1 ↔ ¬ (zmodp x y)*(↑n : ℤ) = 1, by auto,
    have h11 : ∀ n : ℕ, n*(↑y : ℤ) ≠ 1 ↔ ¬ (↑n : ℤ)*(zmodp x y) = 1, by auto,
    have h12 : ¬ (∃ m : ℤ, m*(↑y : ℤ) = 1) ↔ ∀ n : ℕ, n*(↑y : ℤ) ≠ 1, by auto using [exists_not_forall],
    -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
    have h13 : ∀ n : ℕ, n*(↑y : ℤ) ≠ 1 ↔ ∀ n : ℕ, n*y ≠ 1 [MOD x], by auto,
    have h14 : ∀ n : ℕ, n*y ≠ 1 [MOD x] → ¬ (y ∈ units (zmodp x y)), from by auto using [nat.find_spec],
    have h15 : ∀ n : ℕ, n*y ≠ 1 [MOD x] → ¬ (y ∈ units (zmodp x y)), from by auto using [nat.find_spec],
    have h16 : ∀ n : ℕ, n*y ≠ 1 [MOD x] ↔ ∀ n : ℕ, n*(↑y : ℤ) ≠ 1, by auto,
    have h17 : ∀ n : ℕ, n*(↑y : ℤ) ≠ 1 → ∀ n : ℕ, n*y ≠ 1 [MOD x], from by auto,
    have h18 : ¬ (y ∈ units (zmodp x y)) ↔ ∀ n : ℕ, n*(↑y : ℤ) ≠ 1, from by auto,
    have h19 : ¬ (y ∈ units (zmodp x y)) ↔ ∀ n : ℕ, n*(↑y : ℤ) ≠ 1, from by auto,
    have h20 : ¬ (y ∈ units (zmodp x y)) ↔ ¬ (zmodp x y) ∈ units (zmodp x y), from by auto,

    have h21 : ¬ (∀ n : ℕ, n*y ≠ 1 [MOD x]), from by simp [h19] {contextual := tt},
    have h22 : (∃ n : ℕ, n*y = 1 [MOD x]), from by auto using [nat.find_spec],
    have h23 : (∃ n : ℕ, n*y = 1 [MOD x]), from by auto using [nat.find_spec],
    have h24 : (∃ n : ℕ, n*y = 1 [MOD x]), from by auto using [nat.find_spec],
    -- But this must imply that $p | x$.
    have h25 : (∃ n : ℕ, n*y = 1 [MOD x]) ↔ (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]), from by auto,
    have h26 : (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]) ↔ (1 [MOD x] ∈ units ℤ), from by auto,
    have h27 : (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]) ↔ (1 [MOD x] ∈ units ℤ), from by auto,
    have h28 : (1 [MOD x] ∈ units ℤ) ↔ 1 ∈ units ℤ, from by auto,
    have h29 : (1 [MOD x] ∈ units ℤ) ↔ (1 : ℤ) ∈ units ℤ, from by auto,
    have h30 : (1 [MOD x] ∈ units ℤ) ↔ (1 : ℤ) ∈ units ℤ, from by auto,
    have h31 : (1 [MOD x] ∈ units ℤ) ↔ 1 ∈ units ℤ, from by auto,
    have h32 : (1 [MOD x] ∈ units ℤ) ↔ ((1 : ℤ) : ℤ/x) ∈ units ℤ/x, from by auto,

    have h33 : (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]) ↔ (1 ∈ units ℤ), from by auto,
    have h34 : (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]) ↔ (1 ∈ units ℤ), from by auto,
    have h35 : (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]) ↔ (1 = 1 [MOD x]), from by auto,
    have h36 : (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]) ↔ (1 = 1 [MOD x]), from by auto,
    have h37 : (∃ n : ℕ, ↑n = 1 [MOD x] ∧ n*y = 1 [MOD x]) ↔ (1 = 1 [MOD x]), from by auto,
    have h38 : (∃ n : ℕ, ↑n = 1 [MOD x]
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem p_adic_units (p : ℕ) (h : prime p) (x : ℕ) (h2 : nat.coprime x p) : ((x : ℤ) : ℚ_p) = 1 :=
begin
-- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$.
have h1 : (1 : ℚ_p) = norm_euc_int p h x, from by auto [norm_euc_int] using [mul_one, one_mul],
have h3 : ¬(norm_euc_int p h x = 1), from by auto [nat.coprime.not_dvd_one],
have h4 : norm_euc_int p h x < 1, from by auto [norm_euc_int, h3, dec_trivial],
have h5 : ∃ a : ℤ, x = p * a, from by auto [norm_euc_int, h4, one_mul],
-- But this must imply that $p | x$.
have h6 : p ∣ x, from by auto [mul_comm] using [norm_euc_int, one_mul, h4, h5],
show ((x : ℤ) : ℚ_p) = 1, from by auto [not_coprime, h6, h2],
end

--OUTPUT 5
theorem padic_units (p : ℕ) (h : prime p) (x : ℕ) (hx : gcd x p = 1) : unit (padic_int.mk p x) :=
begin
  -- Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  have h1 : ¬ (unit (padic_int.mk p x)) ↔ gcd x p ≠ 1, by auto [padic_int.mem_units_iff_norm_one, nat.gcd_eq_one_iff_prime_of_prime h],

  -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, ...
  have h2 : unit (padic_int.mk p x) ↔ (padic_int.norm (padic_int.mk p x) = 1), by exact padic_int.mem_units_iff_norm_one,

  -- ...thus $\Vert x \Vert \neq 1$.
  have h3 : ¬ (padic_int.norm (padic_int.mk p x) = 1) ↔ ¬ unit (padic_int.mk p x), by exact h2,

  -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
  have h4 : ¬ (padic_int.norm (padic_int.mk p x) = 1) ↔ (padic_int.norm (padic_int.mk p x) < 1), by exact ne_of_gt_padic_norm_one,
  have h5 : ¬ (padic_int.norm (padic_int.mk p x) = 1) ↔ padic_int.norm (padic_int.mk p x) < 1, by exact h4,

  -- But this must imply that $p | x$.
  have h6 : padic_int.norm (padic_int.mk p x) < 1 ↔ p ∣ x, by exact padic_int.norm_eq_zero_iff_dvd_p h,

  -- This completes our proof.
  have h7 : ¬ unit (padic_int.mk p x) ↔ p ∣ x, by auto [h1, h3, h5, h6],
  show unit (padic_int.mk p x), by auto [h7, nat.dvd_of_gcd_eq_one_left hx, hx]
end

--OUTPUT 6
theorem p_adic_units {p : ℕ} (hp : prime p) : ∀ x: ℕ, x.coprime p → x ∈ units (padic_int p) :=
begin
  assume x : ℕ,
  assume h : x.coprime p,
  show x ∈ units (padic_int p),
    by_contra hc,
    have : x.val_min_eq 0,
      begin
        have : x.val_min_eq 1,
          apply padic_mul.val_min_eq_of_unit x (units.mk0 x hc),
        rw padic_int.val_min_one at this,
        rw  ← this,
        show 0 ≤ 1,
          apply le_of_lt,
          apply padic_int.lt_iff_val_min_lt_self.mp,
          apply hc,
      end,
    apply nat.one_ne_zero,
    apply nat.prime.not_dvd_one hp,
    apply dvd_of_eq_padic_nat,
    rw padic_nat.val_zero_iff_not_coprime_of_prime_nat hp,
    show ¬x.coprime p,
      from hc,
    show x.val_min = 0,
      from this,
    show (x : ℤ) = 0,
      from congr_arg subtype.val this,
end

--OUTPUT 7
theorem gcd_p_unit {p : ℕ} (h : prime p) (x : ℤ) (hx : gcd x p = 1) : is_unit (p_adic_int.norm x) :=
begin
  assume (hj : ¬is_unit (p_adic_int.norm x)),
  have h0 : p_adic_int.norm x < 1, by auto [hj, p_adic_int.norm_eq_one],
  have hp : p ∣ x, by auto [h0, p_adic_int.dvd_norm_iff],
  have hn : ¬gcd x p = 1, by auto [hp, h],
  show false, from hn hx,
end

--OUTPUT 8
theorem p_adic_units (p x : ℕ) : prime p → coprime x p → ∃! y : ℤ_[p], y * x = 1 :=
begin
assume (hp : prime p) (hx : coprime x p),
begin
  by_contra h1,
  by_contra h2,
  have h3 : x ∣ p, from by auto [not_coprime_iff, h2, mul_eq_zero],
  have h4 : p ∣ x, from by auto [dvd_iff_mod_eq_zero, h3],
  have h5 : ¬coprime x p, from by auto [h4, coprime_comm],
  contradiction,
end

--OUTPUT 9
theorem p_adic_units (p : ℕ) (x : ℕ) : coprime p x → is_unit (p_adic_int.int p x) :=
begin
  assume : coprime p x,
  have h1 : p_adic_int.int p x ≠ 0, from by auto [p_adic_int.int_ne_zero],
  have h2 : p_adic_int.int p x ≠ 1, from by auto [p_adic_int.norm_eq_one_eq, p_adic_int.int_non_unit, ne.symm, not_lt],
  have h3 : p_adic_int.int p x ≠ -1, from by auto [p_adic_int.norm_eq_one_eq, p_adic_int.int_non_unit, ne.symm, not_lt],
  show is_unit (p_adic_int.int p x), by auto [p_adic_int.int_non_unit, this, h1, h2, h3, not_lt]
end

--OUTPUT 10
theorem p_adic_units (p : ℕ) (prime p) (hp : p > 1) (x : ℕ) (hx : coprime p x) : is_unit x :=
(a : ℕ) (ha : x * a = 1) ↔ (∀ m : ℕ, hp.dvd (x ^ m)) :=
begin
  apply classical.em,
  show a) ↔ b), from iff.intro,
  show a) → b), from begin
    show a) → ∀ m : ℕ, ∃ n : ℕ, p ∣ (x ^ m * n), from
    begin
      assume ha : a)
      sorry
    end,
    sorry
  end,
  show b) → a), from
  begin
    show b) → ∃ a : ℕ, x * a = 1, from
    begin
      show b) → ∃ a : ℕ, x * a = 1, from
      begin
        assume hb : b),
        show ∃ a : ℕ, x * a = 1, from -- ∀ m : ℕ, ∃ n : ℕ, p ∣ (x ^ m * n), from
        begin
          show
          ∃ a : ℕ, x * a = 1, from
          begin
            sorry,
          end,
        end,
      end,
    end,
  end,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


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

local attribute [instance, priority 0] prop_decidable

-- Right Angles

def R (a b c : point) : Prop := eqd a c a (S b c)

theorem R.symm {a b c : point} : R a b c → R c b a :=
begin
intro h,
have h1 := seven13 b a (S b c),
simp at h1,
unfold R at h,
exact (eqd.trans h h1).flip
end

theorem eight3 {a b c a' : point} : R a b c → a ≠ b → col b a a' → R a' b c :=
begin
intros h h1 h2,
unfold R at *,
exact four17 h1.symm h2 (seven5 b c).2 h
end

theorem R.flip {a b c : point} : R a b c → R a b (S b c) :=
begin
intro h,
unfold R at *,
simpa using h.symm
end

@[simp] theorem eight4 (a b : point) : R a a b := (seven5 a b).2

@[simp] theorem eight5a (a b : point) : R a b b := (eight4 b a).symm

theorem eight6 {a b c a' : point} : R a b c → R a' b c → B a c a' → b = c :=
begin
intros h h1 h2,
unfold R at *,
generalize h3 : S b c = c',
rw h3 at *,
have : c = c',
  exact four19 h2 h h1.flip,
rw ←this at *,
exact (seven10.1 h3)
end

theorem eight7 {a b c : point} : R a b c → R a c b → b = c :=
begin
intros h h1,
have h_1 : eqd a c a (S b c),
  unfold R at h,
  exact h,
have h_2 : eqd a b a (S c b),
  unfold R at h1,
  exact h1,
have h2 := seven5 b c,
generalize h3 : S b c = c',
rw h3 at *,
generalize h4 : S c a = a',
by_contradiction h5,
have h6 : col c b c',
  left,
  exact h2.1,
have h7 := eight3 h1.symm h5 h6,
unfold R at h7,
rw h4 at h7,
have h8 := seven5 c a,
rw h4 at h8,
have h9 := h8.2,
have h10 : R a' b c,
  unfold R,
  rw h3,
  exact eqd.trans h9.symm.flip (eqd.trans h_1 h7.flip),
exact h5 (eight6 h h10 h8.1)
end

theorem eight8 {a b : point} : R a b a → a = b :=
begin
intro h,
exact eight7 (eight5a b a).symm h
end

theorem eight9 {a b c : point} : R a b c → col a b c → a = b ∨ c = b :=
begin
intros h h1,
cases em (a = b),
  simp *,
right,
have h2 := eight3 h h_1 (four11 h1).2.1,
exact eight8 h2
end

theorem eight10 {a b c a' b' c' : point} : R a b c → cong a b c a' b' c' → R a' b' c' :=
begin
intros h h1,
cases em (b = c),
  rw h_1 at *,
  have h2 : b' = c',
    exact id_eqd h1.2.1.symm,
  rw h2,
  exact eight5a a' c',
unfold R at *,
generalize h2 : S b c = d,
generalize h3 : S b' c' = d',
have h4 := seven5 b c,
have h5 := seven5 b' c',
rw h2 at *,
rw h3 at *,
have h6 : afs c b d a c' b' d' a',
  repeat {split},
    exact h4.1,
    exact h5.1,
    exact h1.2.1.flip,
    exact eqd.trans h4.2.symm (eqd.trans h1.2.1 h5.2),
    exact h1.2.2.flip,
  exact h1.1.flip,
have h7 := afive_seg h6 (ne.symm h_1),
exact eqd.trans h1.2.2.symm (eqd.trans h h7.flip)
end

def xperp (x : point) (A A' : set point) : Prop := line A ∧ line A' ∧ x ∈ A ∧ x ∈ A' ∧
∀ {u v}, u ∈ A → v ∈ A' → R u x v

def perp (A A' : set point) : Prop := ∃ x, xperp x A A'

notation A ` ⊥ ` B  := perp A B

theorem xperp.symm {x : point} {A A' : set point} : xperp x A A' → xperp x A' A :=
begin
intro h,
unfold xperp at *,
split,
  exact h.2.1,
split,
  exact h.1,
split,
  exact h.2.2.2.1,
split,
  exact h.2.2.1,
intros u v hu hv,
exact (h.2.2.2.2 hv hu).symm
end

theorem perp.symm {A A' : set point} : perp A A' → perp A' A :=
begin
intro h,
cases h with x hx,
constructor,
exact hx.symm
end

theorem eight14a {A A' : set point} : perp A A' → A ≠ A' :=
begin
intros h h1,
subst A',
rcases h with ⟨x, h1, h2, h3, h4, h5⟩,
cases six22 h1 h3 with y hy,
rw hy.2 at h5,
exact hy.1.symm (eight8 (h5 (six17b x y) (six17b x y)))
end

theorem eight14b {x : point} {A A' : set point} : xperp x A A' → A ≠ A' :=
λ h, eight14a ⟨x, h⟩

theorem eight14c {x : point} {A A' : set point} : xperp x A A' ↔ perp A A' ∧ is x A A' :=
begin
split,
  intro h,
  split,
  constructor,
    exact h,
  have h1 : perp A A',
    constructor,
      exact h,
  unfold xperp at h,
  unfold is,
  split,
    exact h.1,
  split,
    exact h.2.1,
  split,
    exact eight14a h1,
  split,
    exact h.2.2.1,
  exact h.2.2.2.1,
intro h,
cases h with h h1,
cases h with y hy,
unfold is at h1,
suffices : x = y,
  rwa ←this at hy,
by_contradiction,
suffices : A = A',
  exact h1.2.2.1 this,
apply six21 a h1.1 h1.2.1 h1.2.2.2.1 h1.2.2.2.2,
  unfold xperp at hy,
  exact hy.2.2.1,
exact hy.2.2.2.1
end

theorem eight14d {x y : point} {A A' : set point} : xperp x A A' → xperp y A A' → x = y :=
begin
intros hx hy,
by_contradiction,
have h : perp A A',
  constructor,
    exact hx,
have h1 := eight14a h,
suffices : A = A',
  exact h1 this,
unfold xperp at *,
exact six21 a hx.1 hx.2.1 hx.2.2.1 hx.2.2.2.1 hy.2.2.1 hy.2.2.2.1
end

theorem eight14e {A A' : set point} : perp A A' → line A ∧ line A' :=
begin
intro h,
cases h with x hx,
split,
  exact hx.1,
exact hx.2.1
end

theorem eight14f {a b c : point} {A : set point} : perp (l a b) A → col a b c → a ≠ c → perp (l a c) A :=
begin
intros h h1 h2,
suffices : l a b = l a c,
  rwa ←this,
exact six18 (eight14e h).1 h2 (six17a a b) h1
end

theorem eight13 {x : point} {A A' : set point} : xperp x A A' ↔ line A ∧ line A' ∧ x ∈ A ∧ x ∈ A' ∧
∃ u v, u ∈ A ∧ v ∈ A' ∧ u ≠ x ∧ v ≠ x ∧ R u x v :=
begin
split,
  intro h,
  split,
    exact h.1,
  split,
    exact h.2.1,
  split,
    exact h.2.2.1,
  split,
    exact h.2.2.2.1,
  unfold xperp at h,
  cases six22 h.1 h.2.2.1 with u hu,
  cases six22 h.2.1 h.2.2.2.1 with v hv,
  existsi u,
  existsi v,
  have h1 : u ∈ A,
    rw hu.2,
    simp,
  have h2 : v ∈ A',
    rw hv.2,
    simp,
  split,
    exact h1,
  split,
    exact h2,
  split,
    exact hu.1.symm,
  split,
    exact hv.1.symm,
  exact h.2.2.2.2 h1 h2,
intro h,
unfold xperp,
split,
  exact h.1,
split,
  exact h.2.1,
split,
  exact h.2.2.1,
split,
  exact h.2.2.2.1,
intros a b ha hb,
cases h.2.2.2.2 with u hu,
cases hu with v hv,
have h1 : R a x v,
  apply eight3 hv.2.2.2.2 hv.2.2.1,
  have h_1 : A = l x u,
    exact six18 h.1 hv.2.2.1.symm h.2.2.1 hv.1,
  rw h_1 at ha,
  exact ha,
apply R.symm,
apply eight3 h1.symm hv.2.2.2.1,
have h_2 : A' = l x v,
  exact six18 h.2.1 hv.2.2.2.1.symm h.2.2.2.1 hv.2.1,
rw h_2 at hb,
exact hb
end

theorem perp_of_R {a b c : point} : a ≠ b → c ≠ b → R a b c → perp (l a b) (l c (S b c)) :=
λ h h1 h2, ⟨b, eight13.2 ⟨six14 h, six14 (seven12b h1).symm, six17b a b,
or.inr (or.inl (seven5 b c).1.symm), a, c, six17a a b, six17a c (S b c), h, h1, h2⟩⟩

theorem xperp_of_R {a b c : point} : a ≠ b → c ≠ b → R a b c → xperp b (l a b) (l c b) :=
λ h h1 h2, eight13.2 ⟨six14 h, six14 h1, six17b a b,
six17b c b, a, c, six17a a b, six17a c b, h, h1, h2⟩

theorem eight15 {x : point} {A B : set point} : perp A B → x ∈ A → x ∈ B → xperp x A B :=
begin
intros h h1 h2,
cases h with y hy,
suffices : x = y,
  subst x,
  exact hy,
by_contradiction h_1,
apply eight14b hy,
apply six21 h_1,
  exact hy.1,
  exact hy.2.1,
  exact h1,
  exact h2,
  exact hy.2.2.1,
exact hy.2.2.2.1
end

theorem eight16 {a b c u x : point} : col a b x → col a b u → u ≠ x →
(c ≠ x ∧ perp (l a b) (l c x) ↔ ¬col a b c ∧ R c x u) :=
begin
intros h1 h2 h3,
split,
  intro h4,
  have h5 : xperp x (l a b) (l c x),
    exact eight15 h4.2 h1 (six17b c x),
  split,
    intro h_1,
    apply eight14b h5,
    exact six18 h5.1 h4.1 h_1 h1,
  apply R.symm,
  exact h5.2.2.2.2 h2 (six17a c x),
intro h4,
cases h4 with h4 h5,
have h_1 : c ≠ x,
  intro h_1,
  rw h_1 at h4,
  exact h4 h1,
split,
  exact h_1,
existsi x,
apply eight13.2,
split,
  exact six14 (six26 h4).1,
split,
  exact six14 h_1,
split,
  exact h1,
split,
  simp,
existsi u,
existsi c,
split,
  exact h2,
split,
  exact (six17a c x),
split,
  exact h3,
split,
  exact h_1,
exact h5.symm
end

theorem eight18 {a b c : point} : ¬col a b c → ∃! x, col a b x ∧ perp (l a b) (l c x) :=
begin
intros h,
cases seg_cons a a c b with y hy,
cases seven25 hy.2.symm with p hp,
have h1: R a p y,
  unfold R,
  suffices : S p y = c,
    rw this,
    exact hy.2,
  exact (seven6 hp.symm).symm,
cases seg_cons y y p a with z hz,
cases seg_cons y y a p with q hq,
generalize hq' : S z q = q',
cases seg_cons y y c q' with c' hc',
have h2 : afs a y z q q y p a,
  focus {repeat {split}},
    exact hz.1,
    exact hq.1.symm,
    exact hq.2.symm.flip,
    exact hz.2,
    exact two5 (eqd.refl a q),
  exact hq.2,
have h3 : a ≠ y,
  intro h_1,
  rw h_1 at *,
  have : y = c,
    exact id_eqd hy.2.symm,
  exact (six26 h).2.2 this,
have h4 := afive_seg h2 h3,
have h5 : cong a p y q z y,
  split,
    exact h4.symm.flip,
  split,
    exact hz.2.symm.flip,
  exact hq.2.symm.flip,
have h6 := (eight10 h1 h5).symm,
have h7 : eqd y q y q',
  unfold R at h6,
  rwa hq' at h6,
cases seven25 hc'.2 with x hx,
existsi x,
have h8 : R y x c,
  unfold R,
  suffices : S x c = c',
    rw this,
    exact hc'.2.symm,
  exact (seven6 hx.symm).symm,
have h9 : c ≠ y,
  intro h_1,
  rw ←h_1 at hy,
  apply h,
  right, right,
  exact hy.1.symm,
have h10 : y ≠ p,
  intro h_1,
  rw ←h_1 at hp,
  unfold M at hp,
  apply h9,
  exact id_eqd hp.2.flip,
have h11 : hourglass q q' y c c' z x,
  have h_1 := seven5 z q,
  rw hq' at h_1,
  focus {repeat {split}},
    exact (three7a hp.1 hq.1 h10.symm).symm,
    exact hc'.1,
    exact h7,
    exact hc'.2.symm,
    exact h_1.1,
    exact h_1.2,
    exact hx.1.symm,
  exact hx.2.symm,
have h12 := seven22 h11,
have h13 : y ≠ z,
  intro h_1,
  rw ←h_1 at hz,
  exact h10 (id_eqd hz.2.symm),
have h14 : a ≠ y,
  intro h_1,
  rw ←h_1 at hy,
  apply (six26 h).2.2,
  exact id_eqd hy.2.symm,
have h15 : l y z = l a b,
  apply six18 (six14 h13) (six26 h).1,
    right, right,
    exact hz.1,
  right, right,
  exact three7a hy.1 hz.1 h14,
have h16 : c ≠ x,
  intro h_1,
  rw h_1 at *,
  apply h,
  have h_2 : x ∈ l a b,
    rw ←h15,
  right, right,
  exact h12.symm,
  exact h_2,
have h17 : q ≠ z,
  intro h_1,
  rw h_1 at *,
  have h_2 : B z y c,
    exact three7b hq.1.symm hp.1.symm h10,
  apply h,
  suffices : c ∈ l a b,
    exact this,
  rw ←h15,
  right, right,
  exact h_2.symm,
have h18 : xperp x (l y z) (l c x),
  apply eight13.2,
  split,
    exact six14 h13,
  split,
    exact (six14 h16),
  split,
    right, right,
    exact h12.symm,
  split,
    simp,
  existsi y,
  existsi c,
  simp,
  split,
    intro h_1,
    rw h_1 at *,
    have h_1 : q ∈ l c x,
      left,
      exact three7a hp.1 hq.1 h10.symm,
    have h_2 : q' ∈ l c x,
      suffices : c' ≠ x,
        cases five2 this hx.1 hc'.1.symm,
          right, right,
          exact h_2.symm,
        right, left,
        exact h_2,
      intro h_2,
      rw h_2 at *,
      apply h9,
      exact id_eqd hx.2.symm.flip,
    have h_3 := seven5 z q,
    rw hq' at h_3,
    have h_4 : q ≠ q',
      intro h_4,
      rw ←h_4 at *,
      apply h17,
      exact seven3.1 h_3,
    have h_5 : l c x = l q q',
      exact six18 (six14 h9) h_4 h_1 h_2,
    have h_6 : z ∈ l c x,
      rw h_5,
      right, left,
      exact h_3.1.symm,
    have h_7 := (four11 h_6).2.2.1,
    have h_8 : c ∈ l a b,
      rw ←h15,
      exact h_7,
    exact h h_8,
  split,
    exact h16,
  exact h8,
rw h15 at h18,
have h19 : x ∈ l y z,
  right, right,
  exact h12.symm,
split,
  split,
    rw h15 at h19,
    exact h19,
  constructor,
    exact h18,
intros x' hx',
have h20 : c ≠ x',
  intro h_1,
  apply h,
  rw ←h_1 at hx',
  exact hx'.1,
have h21 : xperp x' (l a b) (l c x'),
  exact eight15 hx'.2 hx'.1 (six17b c x'),
have h22 : R c x x',
  apply (h18.symm).2.2.2.2,
    simp,
  exact hx'.1,
have h23 : R c x' x,
  apply (h21.symm).2.2.2.2,
    simp,
  rw ←h15,
  exact h19,
exact eight7 h23 h22
end

theorem eight17 {a : point} {A : set point} : line A → a ∉ A → ∃! x, xperp x A (l a x) :=
begin
intros h h1,
rcases h with ⟨p, q, hq, h2⟩,
subst h2,
have h3 : ¬col p q a,
  intro h_1,
  exact h1 h_1,
cases eight18 h3 with x hx,
refine ⟨x, eight15 hx.1.2 hx.1.1 (six17b a x), _⟩,
intros y hy,
exact hx.2 y ⟨hy.2.2.1, y, hy⟩
end

theorem eight19 {p q r : point} (a : point) : R p q r ↔ R (S a p) (S a q) (S a r) :=
begin
unfold R,
split,
  intro h,
  suffices : (S (S a q) (S a r)) = (S a (S q r)),
    rw this,
    exact (seven16 a).1 h,
  have h1 := seven5 (S a q) (S a r),
  suffices : M (S a r) (S a q) (S a (S q r)),
    exact seven4 h1 this,
  apply (seven14 a).1,
  exact seven5 q r,
intro h,
suffices : S a ((S (S a q) (S a r))) = S q r,
  rw ←this,
  apply (seven16 a).2,
  simp,
  exact h,
suffices : S a (S a (S (S a q) (S a r))) = (S a (S q r)),
  exact seven9 this,
simp,
have h1 := seven5 (S a q) (S a r),
suffices : M (S a r) (S a q) (S a (S q r)),
  exact seven4 h1 this,
apply (seven14 a).1,
exact seven5 q r
end

theorem eight20 {a b c p : point} : R a b c → M (S a c) p (S b c) → R b a p ∧ (b ≠ c → a ≠ p) :=
begin
intros h h1,
have h2 := seven5 b c,
have h3 := seven5 a b,
have h4 := seven5 a c,
have h5 := seven5 a (S b c),
have h6 := seven5 a p,
have h7 : R (S a b) b c,
  cases em (a = b),
    rw h_1 at *,
    simp,
    apply eight3 h h_1,
  left,
  exact h3.1,
have h8 := (eight19 a).1 h7,
unfold R at h7,
have h9 := (seven16 a).1 h7,
simp at *,
have h10 : ifs (S a c) p (S b c) b (S a (S b c)) (S a p) c b,
  focus {repeat {split}},
    exact h1.1,
    have h_1 := (seven15 a).1 h1.1,
    simp at h_1,
    exact h_1.symm,
    apply two5,
    have h_2 := seven13 a (S a c) (S b c),
    simp at h_2,
    exact h_2,
    apply eqd.trans h1.2.symm,
    have h_3 := seven13 a p (S a c),
    simp at h_3,
    exact h_3,
    exact h9.flip,
  exact h2.2.symm.flip,
have h11 := four2 h10,
split,
  unfold R,
  exact h11.flip,
intros hbc hap,
apply hbc,
have h12 := seven7 a c,
rw hap at *,
have h13 := seven5 p (S p c),
simp at h13,
have h14 := seven4 h13 h1,
rw ←h14 at h2,
exact (seven3.1 h2).symm
end

theorem eight21 {a b : point} (hab : a ≠ b) (c : point) : ∃ p t, perp (l a b) (l p a) ∧ col a b t ∧ B c t p :=
begin
cases em (col a b c) with habc h,
  cases six25 hab with c' h,
  cases eight18 h with x hx,
  have h1 : c' ≠ x,
    intro h_1,
    rw h_1 at *,
    exact h hx.1.1,
  have h2 : xperp x (l a b) (l c' x),
    exact eight15 hx.1.2 hx.1.1 (six17b c' x),
  unfold xperp at h2,
  have h3 := h2.2.2.2.2 (six17a a b) (six17a c' x),
  unfold R at h3,
  have h4 := seven5 a c',
  cases seven25 (eqd.trans h4.2.symm h3) with p hp,
  have h5 := eight20 (h2.2.2.2.2 (six17a a b) (six17a c' x)) hp,
  have h6 := h5.2 h1.symm,
  existsi p,
  existsi c,
  cases em (x = a),
    rw h_1 at hx,
    rw h_1 at hp,
    have h_2 : S a c' = p,
      exact seven3.1 hp,
    rw h_2 at h4,
    have h_3 : col c' a p,
      left,
      exact h4.1,
    have h_4 : l c' a = l p a,
      apply six18 (six14 (six26 h).2.2.symm) h6.symm h_3 (six17b c' a),
    have h_5 := hx.1,
    rw h_4 at h_5,
    split,
      exact h_5.2,
    split,
      exact habc,
    exact three3 c p,
  split,
    existsi a,
    apply eight13.2,
    split,
      exact six14 (six26 h).1,
    split,
      exact six14 h6.symm,
    split,
      simp,
    split,
      simp,
    existsi x,
    existsi p,
    split,
      exact hx.1.1,
    simp,
    split,
      exact h_1,
    split,
      exact h6.symm,
    exact h5.1,
  split,
    exact habc,
  exact three3 c p,
cases eight18 h with x hx,
have h1 : c ≠ x,
  intro h_1,
  rw h_1 at *,
  exact h hx.1.1,
have h2 : xperp x (l a b) (l c x),
  exact eight15 hx.1.2 hx.1.1 (six17b c x),
unfold xperp at h2,
have h3 := h2.2.2.2.2 (six17a a b) (six17a c x),
unfold R at h3,
have h4 := seven5 a c,
cases seven25 (eqd.trans h4.2.symm h3) with p hp,
have h5 := eight20 (h2.2.2.2.2 (six17a a b) (six17a c x)) hp,
have h6 := h5.2 h1.symm,
cases three17 (seven5 x c).1.symm h4.1.symm hp.1.symm with t ht,
cases em (x = a),
  rw h_1 at ht,
  existsi p,
  existsi a,
  have h_2 : t = a,
    exact (bet_same ht.2).symm,
  rw h_2 at *,
  rw h_1 at hx,
  have h_3 := hx.1,
  have h_4 : l c a = l p a,
    apply six18 (six14 (six26 h).2.2.symm) h6.symm,
      left,
      exact ht.1.symm,
    simp,
  rw h_4 at h_3,
  split,
    exact h_3.2,
  split,
    exact h_3.1,
  exact ht.1.symm,
existsi p,
existsi t,
have h7 : col a b t,
  have h_2 : col a x t,
    right, left,
    exact ht.2,
  exact five4 (ne.symm h_1) (four11 hx.1.1).1 h_2,
split,
  existsi a,
  apply eight13.2,
  split,
    exact six14 (six26 h).1,
  split,
    exact six14 h6.symm,
  split,
    simp,
  split,
    simp,
  existsi x,
  existsi p,
  split,
    exact hx.1.1,
  split,
    simp,
  split,
    exact h_1,
  split,
    exact h6.symm,
  exact h5.1,
split,
  exact h7,
exact ht.1.symm
end

lemma eight23 {a b p q t t' r : point} (hp : ((l a b) ⊥ l p a) ∧ col a b t' ∧ B a t' p)
(ht : ((l b a) ⊥ l q b) ∧ col b a t ∧ B p t q) (hr : B b r q ∧ eqd a p b r): ∃ x, M a x b ∧ M p x r :=
begin
have h : a ≠ b,
  exact six13 (eight14e hp.1).1,
cases pasch ht.2.2 hr.1 with x hx,
have h1 : col a b x,
  have h_1 : col b t x,
    right, left,
    exact hx.1,
  cases em (b = t),
    rw ←h_2 at *,
    have h_3 : x = b,
      exact (bet_same hx.1).symm,
    rw h_3,
    left,
    exact three1 a b,
  exact (four11 (five4 h_2 (four11 ht.2.1).1 h_1)).2.1,
have h2 : xperp a (l a b) (l p a),
  exact eight15 hp.1 (four11 (four12 a b)).1 (six17b p a),
have h3 : xperp b (l b a) (l q b),
  exact eight15 ht.1 (four11 (four12 b a)).1 (six17b q b),
have h4 := h2.2.2.2.2 (six17b a b) (six17a p a),
have h5 := h3.2.2.2.2 (six17b b a) (six17a q b),
have h6 : R a b r,
  have : col b q r,
    right, left,
    exact hr.1.symm,
  exact (eight3 h5.symm (six13 h3.2.1) this).symm,
have h7 : ¬col a p b,
  intro h_1,
  cases eight9 h4 (four11 h_1).2.2.2.1,
    exact h h_2.symm,
  exact (six13 h2.2.1) h_2,
have h8 : ¬col a b r,
  intro h_1,
  cases eight9 h6 h_1,
    exact h h_2,
  rw h_2 at *,
  exact (six13 h2.2.1).symm (id_eqd hr.2),
suffices : eqd b p a r,
  have h_1 : p ≠ r,
    intro h_1,
    rw h_1 at hx,
    have h_2 : r = x,
      exact bet_same hx.2,
    rw h_2 at h8,
    exact h8 h1,
  constructor,
  apply seven21 h7 h_1 hr.2 this.flip (four11 h1).1,
  left,
  exact hx.2.symm,
have h9 : x ≠ a,
  intro h_1,
  rw h_1 at *,
  have h_2 : col a p r,
    right, right,
    exact hx.2,
  have h_3 : R r a b,
    exact eight3 h4.symm (six13 h2.2.1) h_2,
  apply h,
  exact eight7 h_3 h6.symm,
have h10 := seven5 a p,
cases seg_cons x x r (S a p) with r' hr',
cases seven25 hr'.2 with m hm,
have h11 := seven5 m r,
have h12 := seven4 h11 hm.symm,
have h13 : R x m r,
  unfold R,
  rw ←h12 at hr',
  exact hr'.2.symm,
have h14 : R x a p,
  exact eight3 h4 (ne.symm h) h1,
have h15 : ¬col x p (S a p),
  intro h_1,
  have h_2 : col p a (S a p),
    left,
    exact (seven5 a p).1,
  have h_3 : p ≠ (S a p),
    intro h_3,
    exact (six13 h2.2.1) (seven10.1 h_3.symm).symm,
  have h_4 : col p a x,
    exact five4 h_3 (four11 h_2).1 (four11 h_1).2.2.1,
  cases eight9 h14.symm h_4,
    exact (six13 h2.2.1) h_5,
  exact h9 h_5,
have h16 : hourglass p (S a p) x r r' a m,
  focus {repeat {split}},
    exact hx.2.symm,
    exact hr'.1,
    unfold R at h14,
    exact h14,
    exact hr'.2.symm,
    exact h10.1,
    exact h10.2,
    rw ←h12,
    exact h11.1,
    rw ←h12,
  exact h11.2,
have h17 := seven22 h16,
have h18 : r ≠ m,
  intro h_1,
  rw ←h_1 at h17,
  have h_2 : col a x r,
    left,
    exact h17,
  apply h8,
  exact five4 h9.symm (four11 h1).1 h_2,
have h19 : x ≠ m,
  intro h_1,
  have h_2 : col r x p,
    left,
    exact hx.2,
  have h_3 : x ≠ r',
    intro h_3,
    rw [←h_1, ←h_3] at h12,
    rw ←h_1 at h18,
    apply h18,
    exact seven9 (eq.trans h12 (seven11 x).symm),
  have h_4 : col r x (S a p),
    have h_4 : col x r' (S a p),
      right, right,
      exact hr'.1,
    have h_5 : col x r' r,
      rw h_1,
      right, right,
      exact hm.1.symm,
    exact (four11 (five4 h_3 h_5 h_4)).2.1,
  have h_5 : x ≠ r,
    intro h_5,
    rw h_5 at h_1,
    exact h18 h_1,
  apply h15,
  exact five4 h_5 (four11 h_2).2.1 (four11 h_4).2.1,
have h20 : col a b m,
  have h_1 : col a x m,
    left,
    exact h17,
  exact five4 h9.symm (four11 h1).1 h_1,
have h21 : xperp b (l a b) (l r b),
  apply eight13.2,
  split,
    exact six14 h,
  split,
    exact six14 (six26 h8).2.1.symm,
  split,
    simp,
  split,
    simp,
  existsi a,
  existsi r,
  simp,
  split,
    exact h,
  split,
    exact (six26 h8).2.1.symm,
  exact h6,
have h22 : xperp m (l a b) (l r m),
  apply eight13.2,
  split,
    exact six14 h,
  split,
    exact six14 h18,
  split,
    exact h20,
  split,
    simp,
  existsi x,
  existsi r,
  split,
    exact h1,
  simp,
  split,
    exact h19,
  split,
    exact h18,
  exact h13,
have h23 : perp (l a b) (l r b),
  constructor,
  exact h21,
have h24 : perp (l a b) (l r m),
  constructor,
  exact h22,
have h25 : m = b,
  apply unique_of_exists_unique (eight18 h8),
    split,
      exact h20,
    exact h24,
  split,
    left,
    exact three1 a b,
  exact h23,
subst m,
have h26 : ifs (S a p) a p r r b r' (S a p),
  focus {repeat {split}},
    exact h10.1.symm,
    exact hm.1.symm,
    apply two4,
    apply two11 h10.1 hm.1.symm,
      exact hr.2.flip,
      exact eqd.trans h10.2.symm (eqd.trans hr.2 hm.2.symm),
    exact eqd.trans hr.2 hm.2.symm,
    exact two4 (eqd.refl r (S a p)),
  apply two5,
  apply two11 hx.2.symm hr'.1,
    unfold R at h14,
    exact h14.flip,
  exact hr'.2.symm,
have h27 := four2 h26,
unfold R at h4,
exact eqd.trans h4 h27.symm
end

theorem eight22 (a b : point) : ∃! x, M a x b :=
begin
cases em (a = b),
  rw h,
  existsi b,
  split,
    apply seven3.2,
    refl,
  intros y hy,
  exact (seven3.1 hy).symm,
apply exists_unique_of_exists_of_unique,
  cases eight21 h a with p hp,
  cases eight21 (ne.symm h) p with q hq,
  cases hp with t' hp,
  cases hq with t ht,
  cases five10 a p b q,
    cases h_1 with r hr,
    cases eight23 hp ht hr with x hx,
    constructor,
    exact hx.1,
  suffices : ∃ x, M b x a,
    cases this with x hx,
    constructor,
    exact hx.symm,
  cases h_1 with r hr,
  have : ∃ x, M b x a ∧ M q x r,
    apply eight23,
        split,
          exact ht.1,
        split,
          exact (four11 (four12 b a)).1,
        exact three3 b q,
      split,
        exact hp.1,
      split,
        exact (four11 ht.2.1).2.1,
      exact ht.2.2.symm,
    exact hr,
  cases this with x hx,
  constructor,
  exact hx.1,
intros x y hx hy,
exact seven17 hx hy
end

theorem eight24 {a b p q r t : point} : perp (l p a) (l a b) → perp (l q b) (l a b) →
col a b t → B p t q → B b r q → eqd a p b r → ∃ x, M a x b ∧ M p x r :=
begin
intros g3 g4 g5 g6 g7 g8,
have g9 := (four11 (four12 a b)).1,
have g10 := three3 a p,
have g11 := six17 a b,
rw g11 at g4,
have hp : ((l a b) ⊥ l p a) ∧ col a b a ∧ B a a p,
  exact ⟨g3.symm, ⟨g9, g10⟩⟩,
have ht : ((l b a) ⊥ l q b) ∧ col b a t ∧ B p t q,
  exact ⟨g4.symm, ⟨(four11 g5).2.1, g6⟩⟩,
have hr : B b r q ∧ eqd a p b r,
  exact ⟨g7, g8⟩,
exact eight23 hp ht hr
end

theorem eight25 {a b : point} : a ≠ b → ∃ c, R a b c ∧ c ≠ b :=
begin
intro h,
rcases eight21 h.symm a with ⟨c, p, h1⟩,
refine ⟨c, (eight15 h1.1 (six17a b a) (six17b c b)).2.2.2.2 (six17b b a) (six17a c b), _⟩,
exact six13 (eight14e h1.1).2
end

end Euclidean_plane


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

! This file was ported from Lean 3 source module category_theory.adjunction.evaluation
! leanprover-community/mathlib commit f47581155c818e6361af4e4fda60d27d020c226b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Shapes.Products
import Mathbin.CategoryTheory.Functor.EpiMono

/-!

# Adjunctions involving evaluation

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We show that evaluation of functors have adjoints, given the existence of (co)products.

-/

namespace CategoryTheory

open CategoryTheory.Limits

universe v₁ v₂ u₁ u₂

variable {C : Type u₁} [Category.{v₁} C] (D : Type u₂) [Category.{v₂} D]

noncomputable section

section

variable [∀ a b : C, HasCoproductsOfShape (a ⟶ b) D]

#print CategoryTheory.evaluationLeftAdjoint /-
/-- The left adjoint of evaluation. -/
@[simps]
def evaluationLeftAdjoint (c : C) : D ⥤ C ⥤ D
    where
  obj d :=
    { obj := fun t => ∐ fun i : c ⟶ t => d
      map := fun u v f => Sigma.desc fun g => (Sigma.ι fun _ => d) <| g ≫ f
      map_id' := by
        intros ; ext ⟨j⟩; simp only [cofan.mk_ι_app, colimit.ι_desc, category.comp_id]
        congr 1; rw [category.comp_id]
      map_comp' := by
        intros ; ext; simp only [cofan.mk_ι_app, colimit.ι_desc_assoc, colimit.ι_desc]
        congr 1; rw [category.assoc] }
  map d₁ d₂ f :=
    { app := fun e => Sigma.desc fun h => f ≫ Sigma.ι (fun _ => d₂) h
      naturality' := by
        intros
        ext
        dsimp
        simp }
  map_id' := by
    intros
    ext (x⟨j⟩)
    dsimp
    simp
  map_comp' := by
    intros
    ext
    dsimp
    simp
#align category_theory.evaluation_left_adjoint CategoryTheory.evaluationLeftAdjoint
-/

/- warning: category_theory.evaluation_adjunction_right -> CategoryTheory.evaluationAdjunctionRight is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasCoproductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.Adjunction.{u2, max u3 u2, u4, max u1 u2 u3 u4} D _inst_2 (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.evaluationLeftAdjoint.{u1, u2, u3, u4} C _inst_1 D _inst_2 (CategoryTheory.evaluationAdjunctionRight._proof_1.{u3, u4, u1, u2} C _inst_1 D _inst_2 _inst_3) c) (CategoryTheory.Functor.obj.{u1, max (max u1 u2 u3 u4) u2, u3, max (max u3 u2) u2 (max u1 u2 u3 u4) u4} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2) c)
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasCoproductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.Adjunction.{u2, max u2 u3, u4, max (max (max u4 u2) u3) u1} D _inst_2 (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.evaluationLeftAdjoint.{u1, u2, u3, u4} C _inst_1 D _inst_2 (fun (a : C) (b : C) => _inst_3 a b) c) (Prefunctor.obj.{succ u1, max (max (max (succ u4) (succ u2)) (succ u1)) (succ u3), u3, max (max (max u4 u2) u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u1, max (max (max u4 u2) u3) u1, u3, max (max (max u4 u2) u3) u1} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2)) c)
Case conversion may be inaccurate. Consider using '#align category_theory.evaluation_adjunction_right CategoryTheory.evaluationAdjunctionRightₓ'. -/
/-- The adjunction showing that evaluation is a right adjoint. -/
@[simps unit_app counit_app_app]
def evaluationAdjunctionRight (c : C) : evaluationLeftAdjoint D c ⊣ (evaluation _ _).obj c :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun d F =>
        { toFun := fun f => Sigma.ι (fun _ => d) (𝟙 _) ≫ f.app c
          invFun := fun f =>
            { app := fun e => Sigma.desc fun h => f ≫ F.map h
              naturality' := by
                intros
                ext
                dsimp
                simp }
          left_inv := by
            intro f
            ext (x⟨g⟩)
            dsimp
            simp only [colimit.ι_desc, limits.cofan.mk_ι_app, category.assoc, ← f.naturality,
              evaluation_left_adjoint_obj_map, colimit.ι_desc_assoc, cofan.mk_ι_app]
            congr 2
            rw [category.id_comp]
          right_inv := fun f => by
            dsimp
            simp }
      homEquiv_naturality_left_symm := by
        intros
        ext
        dsimp
        simp
      homEquiv_naturality_right := by
        intros
        dsimp
        simp }
#align category_theory.evaluation_adjunction_right CategoryTheory.evaluationAdjunctionRight

/- warning: category_theory.evaluation_is_right_adjoint -> CategoryTheory.evaluationIsRightAdjoint is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasCoproductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.IsRightAdjoint.{u2, max u3 u2, u4, max u1 u2 u3 u4} D _inst_2 (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.obj.{u1, max (max u1 u2 u3 u4) u2, u3, max (max u3 u2) u2 (max u1 u2 u3 u4) u4} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2) c)
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasCoproductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.IsRightAdjoint.{u2, max u2 u3, u4, max (max (max u4 u2) u1) u3} D _inst_2 (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) (Prefunctor.obj.{succ u1, max (max (max (succ u4) (succ u2)) (succ u1)) (succ u3), u3, max (max (max u4 u2) u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u1, max (max (max u4 u2) u3) u1, u3, max (max (max u4 u2) u3) u1} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2)) c)
Case conversion may be inaccurate. Consider using '#align category_theory.evaluation_is_right_adjoint CategoryTheory.evaluationIsRightAdjointₓ'. -/
instance evaluationIsRightAdjoint (c : C) : IsRightAdjoint ((evaluation _ D).obj c) :=
  ⟨_, evaluationAdjunctionRight _ _⟩
#align category_theory.evaluation_is_right_adjoint CategoryTheory.evaluationIsRightAdjoint

/- warning: category_theory.nat_trans.mono_iff_mono_app -> CategoryTheory.NatTrans.mono_iff_mono_app is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasCoproductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} {G : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (η : Quiver.Hom.{succ (max u3 u2), max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max u3 u2, max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max u3 u2, max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2))) F G), Iff (CategoryTheory.Mono.{max u3 u2, max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) F G η) (forall (c : C), CategoryTheory.Mono.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F c) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 G c) (CategoryTheory.NatTrans.app.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G η c))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasCoproductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} {G : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (η : Quiver.Hom.{max (succ u3) (succ u2), max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max u3 u2, max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max u3 u2, max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2))) F G), Iff (CategoryTheory.Mono.{max u3 u2, max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) F G η) (forall (c : C), CategoryTheory.Mono.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) c) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 G) c) (CategoryTheory.NatTrans.app.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G η c))
Case conversion may be inaccurate. Consider using '#align category_theory.nat_trans.mono_iff_mono_app CategoryTheory.NatTrans.mono_iff_mono_appₓ'. -/
theorem NatTrans.mono_iff_mono_app {F G : C ⥤ D} (η : F ⟶ G) : Mono η ↔ ∀ c, Mono (η.app c) :=
  by
  constructor
  · intro h c
    exact (inferInstance : mono (((evaluation _ _).obj c).map η))
  · intro _
    apply nat_trans.mono_of_mono_app
#align category_theory.nat_trans.mono_iff_mono_app CategoryTheory.NatTrans.mono_iff_mono_app

end

section

variable [∀ a b : C, HasProductsOfShape (a ⟶ b) D]

#print CategoryTheory.evaluationRightAdjoint /-
/-- The right adjoint of evaluation. -/
@[simps]
def evaluationRightAdjoint (c : C) : D ⥤ C ⥤ D
    where
  obj d :=
    { obj := fun t => ∏ fun i : t ⟶ c => d
      map := fun u v f => Pi.lift fun g => Pi.π _ <| f ≫ g
      map_id' := by
        intros ; ext ⟨j⟩; dsimp
        simp only [limit.lift_π, category.id_comp, fan.mk_π_app]
        congr ; simp
      map_comp' := by
        intros ; ext ⟨j⟩; dsimp
        simp only [limit.lift_π, fan.mk_π_app, category.assoc]
        congr 1; simp }
  map d₁ d₂ f :=
    { app := fun t => Pi.lift fun g => Pi.π _ g ≫ f
      naturality' := by
        intros
        ext
        dsimp
        simp }
  map_id' := by
    intros
    ext (x⟨j⟩)
    dsimp
    simp
  map_comp' := by
    intros
    ext
    dsimp
    simp
#align category_theory.evaluation_right_adjoint CategoryTheory.evaluationRightAdjoint
-/

/- warning: category_theory.evaluation_adjunction_left -> CategoryTheory.evaluationAdjunctionLeft is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasProductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.Adjunction.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2 (CategoryTheory.Functor.obj.{u1, max (max u1 u2 u3 u4) u2, u3, max (max u3 u2) u2 (max u1 u2 u3 u4) u4} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2) c) (CategoryTheory.evaluationRightAdjoint.{u1, u2, u3, u4} C _inst_1 D _inst_2 (CategoryTheory.evaluationAdjunctionLeft._proof_1.{u3, u4, u1, u2} C _inst_1 D _inst_2 _inst_3) c)
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasProductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.Adjunction.{max u2 u3, u2, max (max (max u4 u2) u1) u3, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2 (Prefunctor.obj.{succ u1, max (max (max (succ u4) (succ u2)) (succ u1)) (succ u3), u3, max (max (max u4 u2) u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u1, max (max (max u4 u2) u3) u1, u3, max (max (max u4 u2) u3) u1} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2)) c) (CategoryTheory.evaluationRightAdjoint.{u1, u2, u3, u4} C _inst_1 D _inst_2 (fun (a : C) (b : C) => _inst_3 a b) c)
Case conversion may be inaccurate. Consider using '#align category_theory.evaluation_adjunction_left CategoryTheory.evaluationAdjunctionLeftₓ'. -/
/-- The adjunction showing that evaluation is a left adjoint. -/
@[simps unit_app_app counit_app]
def evaluationAdjunctionLeft (c : C) : (evaluation _ _).obj c ⊣ evaluationRightAdjoint D c :=
  Adjunction.mkOfHomEquiv
    { homEquiv := fun F d =>
        { toFun := fun f =>
            { app := fun t => Pi.lift fun g => F.map g ≫ f
              naturality' := by
                intros
                ext
                dsimp
                simp }
          invFun := fun f => f.app _ ≫ Pi.π _ (𝟙 _)
          left_inv := fun f => by
            dsimp
            simp
          right_inv := by
            intro f
            ext (x⟨g⟩)
            dsimp
            simp only [limit.lift_π, evaluation_right_adjoint_obj_map, nat_trans.naturality_assoc,
              fan.mk_π_app]
            congr
            rw [category.comp_id] }
      homEquiv_naturality_left_symm := by
        intros
        dsimp
        simp
      homEquiv_naturality_right := by
        intros
        ext
        dsimp
        simp }
#align category_theory.evaluation_adjunction_left CategoryTheory.evaluationAdjunctionLeft

/- warning: category_theory.evaluation_is_left_adjoint -> CategoryTheory.evaluationIsLeftAdjoint is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasProductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.IsLeftAdjoint.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2 (CategoryTheory.Functor.obj.{u1, max (max u1 u2 u3 u4) u2, u3, max (max u3 u2) u2 (max u1 u2 u3 u4) u4} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max u1 u2 u3 u4, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2) c)
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasProductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] (c : C), CategoryTheory.IsLeftAdjoint.{max u2 u3, u2, max (max (max u4 u2) u1) u3, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2 (Prefunctor.obj.{succ u1, max (max (max (succ u4) (succ u2)) (succ u1)) (succ u3), u3, max (max (max u4 u2) u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max (max (max u4 u2) u3) u1, max (max (max u4 u2) u3) u1} (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u1, max (max (max u4 u2) u3) u1, u3, max (max (max u4 u2) u3) u1} C _inst_1 (CategoryTheory.Functor.{max u3 u2, u2, max (max (max u4 u3) u2) u1, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.Functor.category.{max u3 u2, u2, max (max (max u3 u4) u1) u2, u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) D _inst_2) (CategoryTheory.evaluation.{u1, u2, u3, u4} C _inst_1 D _inst_2)) c)
Case conversion may be inaccurate. Consider using '#align category_theory.evaluation_is_left_adjoint CategoryTheory.evaluationIsLeftAdjointₓ'. -/
instance evaluationIsLeftAdjoint (c : C) : IsLeftAdjoint ((evaluation _ D).obj c) :=
  ⟨_, evaluationAdjunctionLeft _ _⟩
#align category_theory.evaluation_is_left_adjoint CategoryTheory.evaluationIsLeftAdjoint

/- warning: category_theory.nat_trans.epi_iff_epi_app -> CategoryTheory.NatTrans.epi_iff_epi_app is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasProductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} {G : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (η : Quiver.Hom.{succ (max u3 u2), max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max u3 u2, max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max u3 u2, max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2))) F G), Iff (CategoryTheory.Epi.{max u3 u2, max u1 u2 u3 u4} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) F G η) (forall (c : C), CategoryTheory.Epi.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F c) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 G c) (CategoryTheory.NatTrans.app.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G η c))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (D : Type.{u4}) [_inst_2 : CategoryTheory.Category.{u2, u4} D] [_inst_3 : forall (a : C) (b : C), CategoryTheory.Limits.HasProductsOfShape.{u1, u4, u2} (Quiver.Hom.{succ u1, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) a b) D _inst_2] {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} {G : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} (η : Quiver.Hom.{max (succ u3) (succ u2), max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{max u3 u2, max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Category.toCategoryStruct.{max u3 u2, max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2))) F G), Iff (CategoryTheory.Epi.{max u3 u2, max (max (max u3 u4) u1) u2} (CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) (CategoryTheory.Functor.category.{u1, u2, u3, u4} C _inst_1 D _inst_2) F G η) (forall (c : C), CategoryTheory.Epi.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) c) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 G) c) (CategoryTheory.NatTrans.app.{u1, u2, u3, u4} C _inst_1 D _inst_2 F G η c))
Case conversion may be inaccurate. Consider using '#align category_theory.nat_trans.epi_iff_epi_app CategoryTheory.NatTrans.epi_iff_epi_appₓ'. -/
theorem NatTrans.epi_iff_epi_app {F G : C ⥤ D} (η : F ⟶ G) : Epi η ↔ ∀ c, Epi (η.app c) :=
  by
  constructor
  · intro h c
    exact (inferInstance : epi (((evaluation _ _).obj c).map η))
  · intros
    apply nat_trans.epi_of_epi_app
#align category_theory.nat_trans.epi_iff_epi_app CategoryTheory.NatTrans.epi_iff_epi_app

end

end CategoryTheory


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module set_theory.game.domineering
! leanprover-community/mathlib commit b134b2f5cf6dd25d4bbfd3c498b6e36c11a17225
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.SetTheory.Game.State

/-!
# Domineering as a combinatorial game.

We define the game of Domineering, played on a chessboard of arbitrary shape
(possibly even disconnected).
Left moves by placing a domino vertically, while Right moves by placing a domino horizontally.

This is only a fragment of a full development;
in order to successfully analyse positions we would need some more theorems.
Most importantly, we need a general statement that allows us to discard irrelevant moves.
Specifically to domineering, we need the fact that
disjoint parts of the chessboard give sums of games.
-/

namespace Pgame

namespace Domineering

open Function

/-- The equivalence `(x, y) ↦ (x, y+1)`. -/
@[simps]
def shiftUp : ℤ × ℤ ≃ ℤ × ℤ :=
  (Equiv.refl ℤ).prodCongr (Equiv.addRight (1 : ℤ))
#align pgame.domineering.shift_up Pgame.Domineering.shiftUp

/-- The equivalence `(x, y) ↦ (x+1, y)`. -/
@[simps]
def shiftRight : ℤ × ℤ ≃ ℤ × ℤ :=
  (Equiv.addRight (1 : ℤ)).prodCongr (Equiv.refl ℤ)
#align pgame.domineering.shift_right Pgame.Domineering.shiftRight

/-- A Domineering board is an arbitrary finite subset of `ℤ × ℤ`. -/
def Board :=
  Finset (ℤ × ℤ)deriving Inhabited
#align pgame.domineering.board Pgame.Domineering.Board

attribute [local reducible] board

/-- Left can play anywhere that a square and the square below it are open. -/
def left (b : Board) : Finset (ℤ × ℤ) :=
  b ∩ b.map shiftUp
#align pgame.domineering.left Pgame.Domineering.left

/-- Right can play anywhere that a square and the square to the left are open. -/
def right (b : Board) : Finset (ℤ × ℤ) :=
  b ∩ b.map shiftRight
#align pgame.domineering.right Pgame.Domineering.right

theorem mem_left {b : Board} (x : ℤ × ℤ) : x ∈ left b ↔ x ∈ b ∧ (x.1, x.2 - 1) ∈ b :=
  Finset.mem_inter.trans (and_congr Iff.rfl Finset.mem_map_equiv)
#align pgame.domineering.mem_left Pgame.Domineering.mem_left

theorem mem_right {b : Board} (x : ℤ × ℤ) : x ∈ right b ↔ x ∈ b ∧ (x.1 - 1, x.2) ∈ b :=
  Finset.mem_inter.trans (and_congr Iff.rfl Finset.mem_map_equiv)
#align pgame.domineering.mem_right Pgame.Domineering.mem_right

/-- After Left moves, two vertically adjacent squares are removed from the board. -/
def moveLeft (b : Board) (m : ℤ × ℤ) : Board :=
  (b.eraseₓ m).eraseₓ (m.1, m.2 - 1)
#align pgame.domineering.move_left Pgame.Domineering.moveLeft

/-- After Left moves, two horizontally adjacent squares are removed from the board. -/
def moveRight (b : Board) (m : ℤ × ℤ) : Board :=
  (b.eraseₓ m).eraseₓ (m.1 - 1, m.2)
#align pgame.domineering.move_right Pgame.Domineering.moveRight

theorem fst_pred_mem_erase_of_mem_right {b : Board} {m : ℤ × ℤ} (h : m ∈ right b) :
    (m.1 - 1, m.2) ∈ b.eraseₓ m := by
  rw [mem_right] at h
  apply Finset.mem_erase_of_ne_of_mem _ h.2
  exact ne_of_apply_ne Prod.fst (pred_ne_self m.1)
#align pgame.domineering.fst_pred_mem_erase_of_mem_right Pgame.Domineering.fst_pred_mem_erase_of_mem_right

theorem snd_pred_mem_erase_of_mem_left {b : Board} {m : ℤ × ℤ} (h : m ∈ left b) :
    (m.1, m.2 - 1) ∈ b.eraseₓ m := by
  rw [mem_left] at h
  apply Finset.mem_erase_of_ne_of_mem _ h.2
  exact ne_of_apply_ne Prod.snd (pred_ne_self m.2)
#align pgame.domineering.snd_pred_mem_erase_of_mem_left Pgame.Domineering.snd_pred_mem_erase_of_mem_left

theorem card_of_mem_left {b : Board} {m : ℤ × ℤ} (h : m ∈ left b) : 2 ≤ Finset.card b :=
  by
  have w₁ : m ∈ b := (Finset.mem_inter.1 h).1
  have w₂ : (m.1, m.2 - 1) ∈ b.erase m := snd_pred_mem_erase_of_mem_left h
  have i₁ := Finset.card_erase_lt_of_mem w₁
  have i₂ := Nat.lt_of_le_of_lt (Nat.zero_le _) (Finset.card_erase_lt_of_mem w₂)
  exact Nat.lt_of_le_of_lt i₂ i₁
#align pgame.domineering.card_of_mem_left Pgame.Domineering.card_of_mem_left

theorem card_of_mem_right {b : Board} {m : ℤ × ℤ} (h : m ∈ right b) : 2 ≤ Finset.card b :=
  by
  have w₁ : m ∈ b := (Finset.mem_inter.1 h).1
  have w₂ := fst_pred_mem_erase_of_mem_right h
  have i₁ := Finset.card_erase_lt_of_mem w₁
  have i₂ := Nat.lt_of_le_of_lt (Nat.zero_le _) (Finset.card_erase_lt_of_mem w₂)
  exact Nat.lt_of_le_of_lt i₂ i₁
#align pgame.domineering.card_of_mem_right Pgame.Domineering.card_of_mem_right

theorem moveLeft_card {b : Board} {m : ℤ × ℤ} (h : m ∈ left b) :
    Finset.card (moveLeft b m) + 2 = Finset.card b :=
  by
  dsimp [move_left]
  rw [Finset.card_erase_of_mem (snd_pred_mem_erase_of_mem_left h)]
  rw [Finset.card_erase_of_mem (Finset.mem_of_mem_inter_left h)]
  exact tsub_add_cancel_of_le (card_of_mem_left h)
#align pgame.domineering.move_left_card Pgame.Domineering.moveLeft_card

theorem moveRight_card {b : Board} {m : ℤ × ℤ} (h : m ∈ right b) :
    Finset.card (moveRight b m) + 2 = Finset.card b :=
  by
  dsimp [move_right]
  rw [Finset.card_erase_of_mem (fst_pred_mem_erase_of_mem_right h)]
  rw [Finset.card_erase_of_mem (Finset.mem_of_mem_inter_left h)]
  exact tsub_add_cancel_of_le (card_of_mem_right h)
#align pgame.domineering.move_right_card Pgame.Domineering.moveRight_card

theorem moveLeft_smaller {b : Board} {m : ℤ × ℤ} (h : m ∈ left b) :
    Finset.card (moveLeft b m) / 2 < Finset.card b / 2 := by simp [← move_left_card h, lt_add_one]
#align pgame.domineering.move_left_smaller Pgame.Domineering.moveLeft_smaller

theorem moveRight_smaller {b : Board} {m : ℤ × ℤ} (h : m ∈ right b) :
    Finset.card (moveRight b m) / 2 < Finset.card b / 2 := by simp [← move_right_card h, lt_add_one]
#align pgame.domineering.move_right_smaller Pgame.Domineering.moveRight_smaller

/-- The instance describing allowed moves on a Domineering board. -/
instance state : State Board where
  turnBound s := s.card / 2
  l s := (left s).image (moveLeft s)
  r s := (right s).image (moveRight s)
  left_bound s t m := by
    simp only [Finset.mem_image, Prod.exists] at m
    rcases m with ⟨_, _, ⟨h, rfl⟩⟩
    exact move_left_smaller h
  right_bound s t m := by
    simp only [Finset.mem_image, Prod.exists] at m
    rcases m with ⟨_, _, ⟨h, rfl⟩⟩
    exact move_right_smaller h
#align pgame.domineering.state Pgame.Domineering.state

end Domineering

/-- Construct a pre-game from a Domineering board. -/
def domineering (b : Domineering.Board) : Pgame :=
  Pgame.ofState b
#align pgame.domineering Pgame.domineering

/-- All games of Domineering are short, because each move removes two squares. -/
instance shortDomineering (b : Domineering.Board) : Short (domineering b) :=
  by
  dsimp [domineering]
  infer_instance
#align pgame.short_domineering Pgame.shortDomineering

/-- The Domineering board with two squares arranged vertically, in which Left has the only move. -/
def domineering.one :=
  domineering [(0, 0), (0, 1)].toFinset
#align pgame.domineering.one Pgame.domineering.one

/-- The `L` shaped Domineering board, in which Left is exactly half a move ahead. -/
def domineering.l :=
  domineering [(0, 2), (0, 1), (0, 0), (1, 0)].toFinset
#align pgame.domineering.L Pgame.domineering.l

instance shortOne : Short domineering.one :=
  by
  dsimp [domineering.one]
  infer_instance
#align pgame.short_one Pgame.shortOne

instance shortL : Short domineering.l :=
  by
  dsimp [domineering.L]
  infer_instance
#align pgame.short_L Pgame.shortL

-- The VM can play small games successfully:
-- #eval to_bool (domineering.one ≈ 1)
-- #eval to_bool (domineering.L + domineering.L ≈ 1)
-- The following no longer works since Lean 3.29, since definitions by well-founded
-- recursion no longer reduce definitionally.
-- We can check that `decidable` instances reduce as expected,
-- and so our implementation of domineering is computable.
-- run_cmd tactic.whnf `(by apply_instance : decidable (domineering.one ≤ 1)) >>= tactic.trace
-- dec_trivial can handle most of the dictionary of small games described in [conway2001]
-- example : domineering.one ≈ 1 := dec_trivial
-- example : domineering.L + domineering.L ≈ 1 := dec_trivial
-- example : domineering.L ≈ pgame.of_lists [0] [1] := dec_trivial
-- example : (domineering ([(0,0), (0,1), (0,2), (0,3)].to_finset) ≈ 2) := dec_trivial
-- example : (domineering ([(0,0), (0,1), (1,0), (1,1)].to_finset) ≈ pgame.of_lists [1] [-1]) :=
--   dec_trivial.
-- The 3x3 grid is doable, but takes a minute...
-- example :
--   (domineering ([(0,0), (0,1), (0,2), (1,0), (1,1), (1,2), (2,0), (2,1), (2,2)].to_finset) ≈
--     pgame.of_lists [1] [-1]) := dec_trivial
-- The 5x5 grid is actually 0, but brute-forcing this is too challenging even for the VM.
-- #eval to_bool (domineering ([
--   (0,0), (0,1), (0,2), (0,3), (0,4),
--   (1,0), (1,1), (1,2), (1,3), (1,4),
--   (2,0), (2,1), (2,2), (2,3), (2,4),
--   (3,0), (3,1), (3,2), (3,3), (3,4),
--   (4,0), (4,1), (4,2), (4,3), (4,4)
--   ].to_finset) ≈ 0)
end Pgame