/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Simon Hudon, Scott Morrison
-/
import control.bifunctor
import logic.equiv.basic

/-!
# Functor and bifunctors can be applied to `equiv`s.

We define
```lean
def functor.map_equiv (f : Type u → Type v) [functor f] [is_lawful_functor f] :
  α ≃ β → f α ≃ f β
```
and
```lean
def bifunctor.map_equiv (F : Type u → Type v → Type w) [bifunctor F] [is_lawful_bifunctor F] :
  α ≃ β → α' ≃ β' → F α α' ≃ F β β'
```
-/

universes u v w

variables {α β : Type u}
open equiv

namespace functor

variables (f : Type u → Type v) [functor f] [is_lawful_functor f]

/-- Apply a functor to an `equiv`. -/
def map_equiv (h : α ≃ β) : f α ≃ f β :=
{ to_fun    := map h,
  inv_fun   := map h.symm,
  left_inv  := λ x, by simp [map_map],
  right_inv := λ x, by simp [map_map] }

@[simp]
lemma map_equiv_apply (h : α ≃ β) (x : f α) :
  (map_equiv f h : f α ≃ f β) x = map h x := rfl

@[simp]
lemma map_equiv_symm_apply (h : α ≃ β) (y : f β) :
  (map_equiv f h : f α ≃ f β).symm y = map h.symm y := rfl

@[simp]
lemma map_equiv_refl : map_equiv f (equiv.refl α) = equiv.refl (f α) :=
begin
  ext x,
  simp only [map_equiv_apply, refl_apply],
  exact is_lawful_functor.id_map x,
end

end functor

namespace bifunctor

variables {α' β' : Type v} (F : Type u → Type v → Type w) [bifunctor F] [is_lawful_bifunctor F]

/-- Apply a bifunctor to a pair of `equiv`s. -/
def map_equiv (h : α ≃ β) (h' : α' ≃ β') : F α α' ≃ F β β' :=
{ to_fun    := bimap h h',
  inv_fun   := bimap h.symm h'.symm,
  left_inv  := λ x, by simp [bimap_bimap, id_bimap],
  right_inv := λ x, by simp [bimap_bimap, id_bimap] }

@[simp]
lemma map_equiv_apply (h : α ≃ β) (h' : α' ≃ β') (x : F α α') :
  (map_equiv F h h' : F α α' ≃ F β β') x = bimap h h' x := rfl

@[simp]
lemma map_equiv_symm_apply (h : α ≃ β) (h' : α' ≃ β') (y : F β β') :
  (map_equiv F h h' : F α α' ≃ F β β').symm y = bimap h.symm h'.symm y := rfl

@[simp]
lemma map_equiv_refl_refl : map_equiv F (equiv.refl α) (equiv.refl α') = equiv.refl (F α α') :=
begin
  ext x,
  simp [id_bimap]
end

end bifunctor


-- This library contains proofs of basic facts in the representation theory of groups.
-- The definition of a representation is given outside of any namespace. The namespaces are:
-- monoid_module, fixed_points, monoid_representation, group_representation.
-- Author: Ben McDonnell
-- TODO: 1) Repitition of theory between group_representation and monoid_representation
--       2) Most lemmas in group_representation.map are in fact lemmas about linear_maps and are
--            (probably) already written elsewhere.
--       3) Each step in the proof of Schur's lemma is a useful general fact. E.g. ker f = top implies f = 0
--       4) New representations from old

import algebra.module
import group_theory.group_action
import group_theory.subgroup
import group_theory.submonoid
import linear_algebra.basic

/-- A monoid module is a G-representation M, over the ring of integers -/
class monoid_module (G M : Type) [monoid G] [add_comm_group M]
  extends mul_action G M :=
(smul_add : ∀ (g : G) (m₁ m₂ : M), g • (m₁ + m₂) = g • m₁ + g • m₂)

attribute [simp] monoid_module.smul_add

/-- A monoid representation is a G-representation M over an arbitrary ring R -/
class monoid_representation (G R M : Type) [monoid G] [ring R] [add_comm_group M] [module R M]
  extends monoid_module G M :=
(smul_comm : ∀ (g : G) (r : R) (m : M), g • (r • m) = r • (g • m))

/-- group_represention restricts the defintion of monoid representation to only allow G a group -/
class group_representation (G R M : Type) [group G] [ring R] [add_comm_group M] [module R M]
  extends monoid_representation G R M

----------------------------
namespace monoid_module
variables (G : Type) {M N : Type} [monoid G] [add_comm_group M] [monoid_module G M]
variables [add_comm_group N] [monoid_module G N]

variable (M)
/-- G acts on 0 trivially -/
lemma smul_zero_ : ∀ (g : G), g • (0 : M) = (0 : M) := λ g,
begin
  have : g • (0 : M) + g • 0 = g • 0 := by rw [← monoid_module.smul_add, add_zero],
  simp * at *,
end

/-- Any instance of a monoid module will create an instance of a distrib_mul_action -/
instance : distrib_mul_action G M :=
{ smul := λ g m, g • m,
  one_smul := mul_action.one_smul G,
  mul_smul := mul_action.mul_smul,
  smul_add := monoid_module.smul_add,
  smul_zero := smul_zero_ G M}

variable {M}

/-- A homomorphism of monoid_modules respects additivity and smul -/
structure map :=
(to_fun : M → N)
(add : ∀ (x y : M), to_fun (x + y) = to_fun x + to_fun y)
(smul : ∀ (g : G) (x : M), to_fun(g • x) = g • to_fun x)

/-- Given a map to_fun, we need to prove additivity and smul to show it is a monoid_module map -/
class is_map (to_fun : M → N) :=
(add : ∀ (x y : M), to_fun (x + y) = to_fun x + to_fun y)
(smul : ∀ (g : G) (x : M), to_fun(g • x) = g • to_fun x)
end monoid_module

----------------------------
namespace fixed_points
open mul_action
variables {G M : Type} [monoid G] [add_comm_group M] [monoid_module G M]

lemma add_mem (x y : M) (hx : x ∈ fixed_points G M) (hy : y ∈ fixed_points G M) :
  x + y ∈ fixed_points G M :=
begin
  intro g,
  simp only [mem_stabilizer_iff, monoid_module.smul_add, mem_fixed_points] at *,
  rw [hx g, hy g],
end

end fixed_points

----------------------------
namespace monoid_representation
variables (G R M : Type)
variables [monoid G] [ring R] [add_comm_group M] [module R M] [monoid_representation G R M]

/-- Given a group G, ring R and R-module M, we can always define the trivial representation on M,
  such that G acts by the identity -/
def trivial : monoid_representation G R M :=
{ smul := λ (g : G) (m : M), m,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl,
  smul_add := λ _ _ _, rfl,
  smul_comm := λ _ _ _, rfl}

variable {G}
/-- The structure map of (g : G) is the endomorphism of M given by the smul action of g -/
def structure_map (g : G) : M →ₗ[R] M :=
{ to_fun := λ m, g • m,
  add := λ x y, monoid_module.smul_add g x y,
  smul := λ r x, monoid_representation.smul_comm g r x }

@[simp] lemma structure_map_mul (g₁ g₂ : G) :
  structure_map R M (g₁ * g₂) = structure_map R M g₁ * structure_map R M g₂ :=
begin
  apply linear_map.ext,
  intro x,
  -- show (g₁ * g₂) • x = g₁ • g₂ • x,
  apply mul_action.mul_smul,
end
variables {R} {M}

variable (G)
/-- A submodule is a subrepresentation if it is stable under the G action -/
class is_subrepresentation (N : submodule R M) : Prop :=
(closed : ∀ (g : G) (n : M), n ∈ N → g • n ∈ N)

variable {G}
/-- Any representation is a subrepresentation of itself -/
instance : is_subrepresentation G (⊤ : submodule R M) :=
{closed := λ g m hm, by simp,}

/-- Every representation has {0} as a subrepresentation -/
lemma zero_is_subrepresentation : is_subrepresentation G (⊥ : submodule R M) :=
{ closed := λ g n h, begin simp at *, rw h, exact smul_zero g, end }

/-- A subrepresentation is in a representation in its own right -/
instance subrepresentation.to_representation (N : submodule R M) [is_subrepresentation G N] :
  monoid_representation G R N := sorry

include R M -- inclusion somehow solves class resolution
/-- The kernel of a representation consists of all elements of G which act on M trivially -/
def kernel : set G := {g | ∀ (m : M), g • m = m}
omit R M

@[simp] lemma mem_kernel_iff {g : G} :
  g ∈ (@kernel G R M _ _ _ _ _) ↔ ∀ (m : M), g • m = m := iff.rfl

/-- A proof that the kernel is indeed a submonoid of G -/
instance kernel.to_submonoid : is_submonoid (@kernel G R M _ _ _ _ _)  :=
{ one_mem := iff.elim_right mem_kernel_iff (mul_action.one_smul G),
  mul_mem := begin
  intros,
  apply iff.elim_right mem_kernel_iff,
  intro,
  rw mul_action.mul_smul,
  rw mem_kernel_iff at a_1 a_2,
  rw a_2,
  exact a_1 m,
  end }

variables (G) (R) (M)
/-- A representation is irreducible if the only subrepresentaitons are itself and {0} -/
def is_irreducible : Prop := ∀ (L : submodule R M), is_subrepresentation G L → (L = ⊤) ∨ (L = ⊥)
variables {G} {R} {M}

/-- A homomorphism of monoid representations is a linear map which respects the G action -/
class is_map {N : Type} [add_comm_group N] [module R N] [monoid_representation G R N]
  (to_fun : M → N) extends is_linear_map R to_fun :=
(gmul : ∀ (g : G) (m : M), to_fun(g • m) = g • to_fun m)
variable {G}

--set_option pp.all true

include G
/-- A monoid representation of a group G can be upgraded to a group representation -/
instance [group G] : group_representation G R M :=
{ smul := λ g m, g • m,
  one_smul := sorry,
  mul_smul := sorry,
  smul_add := sorry,
  smul_comm := sorry }
omit G

---------------------------- (sub namespace of monoid_representation)
namespace map
-- Introduce a second representation N and a G-map f : M → N
variables {N : Type} [add_comm_group N] [module R N] [monoid_representation G R N]
variables (f : M → N) [is_linear_map R f] [@is_map G R M _ _ _ _ _ N _ _ _ f]

/-- The kernel of a G-homomorphism is the R-submodule of elements which map to zero -/
def kernel : submodule R M :=
{ carrier := {m | f m = 0},
  zero := begin show f 0 = 0, exact @is_linear_map.map_zero R M N _ _ _ _ _ f _inst_9, end,
  add := λ x y hx hy, begin simp * at *, rw @is_linear_map.add R M N _ _ _ _ _ f _ x y, rw [hx, hy],
    exact add_zero 0, end,
  smul := λ r m hm,  begin simp * at *, rw [@is_linear_map.smul R M N _ _ _ _ _ f _ r m, hm],
    exact @distrib_mul_action.smul_zero R N _ _ (semimodule.to_distrib_mul_action R N) r,
  end
}

@[simp] lemma mem_kernel_iff {m : M} : m ∈ (@kernel R M _ _ _ N _ _ f _) ↔ f m = 0 := iff.rfl

/-- If f a = f b, then a-b is in the kernel. -/
lemma equal_image_mem_kernel : ∀ (m₁ m₂ : M), f m₁ = f m₂ → m₁ - m₂ ∈ (@kernel R M _ _ _ N _ _ f _):=
λ m₁ m₂ h, by {
simp,
rw (is_linear_map.add R f m₁ (-m₂)),
replace h := congr_arg (λ x, x + f (-m₂)) h,
dsimp at h,
rw ← (is_linear_map.add R f m₂ (-m₂)) at h,
simp at h,
rw (@is_linear_map.map_zero R M N _ _ _ _ _ f _inst_9) at h,
assumption,
}

/-- The image of a G-homomorphism is the R-submodule of elements which can be written as f m for some m. -/
def image : submodule R N := { carrier := {n | ∃ (m : M), f m = n},
  zero := begin show ∃ (m : M), f m = 0, existsi (0 : M),
    exact @is_linear_map.map_zero R M N _ _ _ _ _ f _inst_9, end,
  add := λ x y hx hy, begin simp * at *, cases hx with m₁ hm₁, cases hy with m₂ hm₂,
    have : f(m₁ + m₂) = x + y := by {rw [@is_linear_map.add R M N _ _ _ _ _ f _ m₁ m₂, hm₁, hm₂]},
    existsi m₁ + m₂,
    exact this, end,
  smul := λ r n hn, begin simp * at *, cases hn with m hn,
    -- Forcing LEAN to recognise the scalar multiplication R M
    have _inst_Mscalar : has_scalar R M := { smul := @has_scalar.smul R M (@mul_action.to_has_scalar R M _
      (@distrib_mul_action.to_mul_action R M _ _ (semimodule.to_distrib_mul_action R M)))},
    -- Forcing LEAN to recognise the scalar multiplication R N
    have _inst_Nscalar : has_scalar R N := { smul := @has_scalar.smul R N (@mul_action.to_has_scalar R N _
      (@distrib_mul_action.to_mul_action R N _ _ (semimodule.to_distrib_mul_action R N)))},
    -- No • notation here to force class resolution
    existsi @has_scalar.smul R M _inst_Mscalar r m,
    have step1 : @has_scalar.smul R N _inst_Nscalar r (f m) = @has_scalar.smul R N _inst_Nscalar r n, by {rw hn,},
    -- Something is going very wrong here
    have goal : f (@has_scalar.smul R M _inst_Mscalar r m) = @has_scalar.smul R N _inst_Nscalar r n, by {
      rw ← step1,
      -- now apply linearmap.smul
      sorry,},
    sorry,
  end
}

@[simp] lemma mem_image_iff {n : N} : n ∈ (@image R M _ _ _ N _ _ f _) ↔ ∃ (m : M), f m = n := iff.rfl

/-- A silly lemma that f m is in the image of f -/
@[simp] lemma image_mem_image :  ∀ (m : M), f m ∈ (@image R M _ _ _ N _ _ f _) := λ m, by {
simp,
existsi m,
reflexivity,
}

/-- The kernel of a map is a sub-representation of the source -/
instance kernel.to_subrepresentation : is_subrepresentation G (@kernel R M _ _ _ N _ _ f _) :=
{ closed := λ g m hm, begin simp * at *,
    rw [@is_map.gmul G R M _ _ _ _ _ N _ _ _ f _ g m, hm, monoid_module.smul_zero_], end}

/-- The image of a map is a sub-representation of the target -/
instance image.to_subrepresentation : is_subrepresentation G (@image R M _ _ _ N _ _ f _) :=
{ closed := λ g n hn, begin simp * at *, cases hn with m hm, existsi g • m,
    rw [@is_map.gmul G R M _ _ _ _ _ N _ _ _ f _ g m, hm], end}

/-- The general version of Schur's lemma, namely that a map f : irrep → irrep is either 0 or an isomorphism -/
lemma of_irreducibles : is_irreducible G R M → is_irreducible G R N → f = (λ m, 0) ∨ function.bijective f :=
begin
intros hM hN,
-- Since M and N are irreducible, both the kernel and image are trivial (i.e. \top or \bot)
have h_kernel : (@kernel R M _ _ _ N _ _ f _) = (⊤ : submodule R M) ∨ (@kernel R M _ _ _ N _ _ f _) = (⊥ : submodule R M):=
  hM (@kernel R M _ _ _ N _ _ f _) (kernel.to_subrepresentation f),
have h_image : (@image R M _ _ _ N _ _ f _) = (⊤ : submodule R N) ∨ (@image R M _ _ _ N _ _ f _) = (⊥ : submodule R N):=
  hN (@image R M _ _ _ N _ _ f _) (image.to_subrepresentation f),
-- First suppose the kernel is M. We will then prove that f is zero.
cases h_kernel,
have : f = (λ m, 0) := by {apply funext, intro m,
  have hm_top : (m : M) ∈ (⊤ : submodule R M) := by simp,
  have hm_kernel : m ∈ kernel f := by {rw h_kernel, assumption},
  simpa,
},
left, assumption,
-- We have just proved that if ker = ⊤ then f = 0.
-- Next we split into cases for the image. Then first show that image=0 means f=0.
cases h_image,
swap,
have : f = (λ m, 0) := by {
  apply funext,
  intro m,
  have fm_mem_im : f m ∈ image f := image_mem_image f m,
  rw h_image at fm_mem_im,
  simp * at *,
},
left, assumption,
-- Now we are in the final case, ker = 0 and the image is everything.
-- We first show that zero kernel implies injective.
have hf_inj : function.injective f := by { show ∀ a₁ a₂, f a₁ = f a₂ → a₁ = a₂,
  intros a b hab,
  have ab_mem : a - b ∈ kernel f := equal_image_mem_kernel f a b hab,
  rw h_kernel at ab_mem,
  simp at ab_mem,
  replace ab_mem := congr_arg (λ x, x + b) ab_mem,
  simp at ab_mem,
  assumption,
},
right,
-- We then show that image everything implies surjective.
have hf_sur : function.surjective f := by {show ∀ n, ∃ m, f m = n, intro m,
  have m_in_top : m ∈ (⊤ : submodule R N) := by simp,
  rw ← h_image at m_in_top,
  simpa,
},
-- Finally, injective + bijective = bijective.
constructor, assumption, assumption,
end
end map -- end of the subnamespace

end monoid_representation

----------------------------
namespace group_representation
variables (G R M : Type)
variables [group G] [ring R] [add_comm_group M] [module R M] [group_representation G R M]

/-- The trivial group representation is the trivial monoid representation structure on G R M, but extended to
a group representation -/
def trivial : group_representation G R M :=
  @monoid_representation.group_representation G R M _ _ _ _ (monoid_representation.trivial G R M) _

variables {R} {M}
/-- A submodule is a subrepresentation if it is stable under the G action -/
class is_subrepresentation (N : submodule R M) : Prop :=
(closed : ∀ (g : G) (n : M), n ∈ N → g • n ∈ N)

variable {G}
/-- Any representation is a subrepresentation of itself -/
instance : is_subrepresentation G (⊤ : submodule R M) :=
{closed := λ g m hm, by simp,}

/-- Every representation has {0} as a subrepresentation -/
lemma zero_is_subrepresentation : is_subrepresentation G (⊥ : submodule R M) :=
{ closed := λ g n h, begin simp at *, rw h, exact smul_zero g, end }

/-- A subrepresentation is in a representation in its own right -/
instance subrepresentation.to_representation (N : submodule R M) [is_subrepresentation G N] :
  group_representation G R N := sorry

/-- The kernel of a representation consists of all elements of G which act on M trivially -/
def kernel : set G := @monoid_representation.kernel G R M _ _ _ _ _

lemma mem_kernel_iff {g : G} :
  g ∈ (@kernel G R M _ _ _ _ _) ↔ ∀ (m : M), g • m = m := iff.rfl

/-- A proof that the kernel is indeed a subgroup of G -/
instance kernel.to_subgroup : is_subgroup (@kernel G R M _ _ _ _ _) :=
{ one_mem := iff.elim_right mem_kernel_iff (mul_action.one_smul G),
  mul_mem := begin
  intros,
  rw mem_kernel_iff,
  intro,
  rw mul_action.mul_smul,
  rw mem_kernel_iff at a_1 a_2,
  rw a_2,
  exact a_1 m,
  end,
  inv_mem := begin
  intros g h,
  rw mem_kernel_iff,
  intro,
  rw mem_kernel_iff at h,
  replace h := h m,
  replace h := congr_arg (λ (x : M), g⁻¹ • x) h,
  dsimp at h,
  rw [← mul_action.mul_smul] at h,
  by simp [h.symm],
  end }

variables (R) (M)
include R M
/-- A proof that m ↦ g⁻¹ m is a left inverse of the structure map -/
lemma structure_map.left_inverse (g : G) : function.left_inverse (λ (m : M), g⁻¹ • m) (λ (m : M), g • m) :=
begin
intro m,
show g⁻¹ • g • m = m,
rw ← mul_action.mul_smul,
simp,
end
/-- A proof that m ↦ g⁻¹ m is a right inverse of the structure map -/
lemma structure_map.right_inverse (g : G) : function.right_inverse (λ (m : M), g⁻¹ • m) (λ (m : M), g • m) :=
begin
intro m,
show g • g⁻¹ • m = m,
rw ← mul_action.mul_smul,
simp,
end
omit R M

variables (G)
def is_irreducible : Prop := ∀ (L : submodule R M), is_subrepresentation G L → (L = ⊤) ∨ (L = ⊥)
variables {G} {R} {M}

/-- A G-homomorphism between representations is an R-linear map which respects the G action -/
class is_map {N : Type} [add_comm_group N] [module R N] [group_representation G R N] (f : M → N )
  extends is_linear_map R f :=
(gmul : ∀ (g : G) (m : M), f (g • m) = g • (f m) )

---------------------------- (sub namespace of group_representation)
namespace map
-- Introduce a second representation N and a G-map f : M → N
variables {N : Type} [add_comm_group N] [module R N] [group_representation G R N]
variables (f : M → N) [is_linear_map R f] [@is_map G R M _ _ _ _ _ N _ _ _ f]

/-- The kernel of a G-homomorphism is the R-submodule of elements which map to zero -/
def kernel : submodule R M :=
{ carrier := {m | f m = 0},
  zero := begin show f 0 = 0, exact @is_linear_map.map_zero R M N _ _ _ _ _ f _inst_9, end,
  add := λ x y hx hy, begin simp * at *, rw @is_linear_map.add R M N _ _ _ _ _ f _ x y, rw [hx, hy],
    exact add_zero 0, end,
  smul := λ r m hm,  begin simp * at *, rw [@is_linear_map.smul R M N _ _ _ _ _ f _ r m, hm],
    exact @distrib_mul_action.smul_zero R N _ _ (semimodule.to_distrib_mul_action R N) r,
  end
}

@[simp] lemma mem_kernel_iff {m : M} : m ∈ (@kernel R M _ _ _ N _ _ f _) ↔ f m = 0 := iff.rfl

/-- If f a = f b, then a-b is in the kernel. -/
lemma equal_image_mem_kernel : ∀ (m₁ m₂ : M), f m₁ = f m₂ → m₁ - m₂ ∈ (@kernel R M _ _ _ N _ _ f _):=
λ m₁ m₂ h, by {
simp,
rw (is_linear_map.add R f m₁ (-m₂)),
replace h := congr_arg (λ x, x + f (-m₂)) h,
dsimp at h,
rw ← (is_linear_map.add R f m₂ (-m₂)) at h,
simp at h,
rw (@is_linear_map.map_zero R M N _ _ _ _ _ f _inst_9) at h,
assumption,
}

/-- The image of a G-homomorphism is the R-submodule of elements which can be written as f m for some m. -/
def image : submodule R N := { carrier := {n | ∃ (m : M), f m = n},
  zero := begin show ∃ (m : M), f m = 0, existsi (0 : M),
    exact @is_linear_map.map_zero R M N _ _ _ _ _ f _inst_9, end,
  add := λ x y hx hy, begin simp * at *, cases hx with m₁ hm₁, cases hy with m₂ hm₂,
    have : f(m₁ + m₂) = x + y := by {rw [@is_linear_map.add R M N _ _ _ _ _ f _ m₁ m₂, hm₁, hm₂]},
    existsi m₁ + m₂,
    exact this, end,
  smul := λ r n hn, begin simp * at *, cases hn with m hn,
    -- Forcing LEAN to recognise the scalar multiplication R M
    have _inst_Mscalar : has_scalar R M := { smul := @has_scalar.smul R M (@mul_action.to_has_scalar R M _
      (@distrib_mul_action.to_mul_action R M _ _ (semimodule.to_distrib_mul_action R M)))},
    -- Forcing LEAN to recognise the scalar multiplication R N
    have _inst_Nscalar : has_scalar R N := { smul := @has_scalar.smul R N (@mul_action.to_has_scalar R N _
      (@distrib_mul_action.to_mul_action R N _ _ (semimodule.to_distrib_mul_action R N)))},
    -- No • notation here to force class resolution
    existsi @has_scalar.smul R M _inst_Mscalar r m,
    have step1 : @has_scalar.smul R N _inst_Nscalar r (f m) = @has_scalar.smul R N _inst_Nscalar r n, by {rw hn,},
    -- Something is going very wrong here
    have goal : f (@has_scalar.smul R M _inst_Mscalar r m) = @has_scalar.smul R N _inst_Nscalar r n, by {
      rw ← step1,
      -- now apply linearmap.smul
      sorry,},
    sorry,
  end
}

@[simp] lemma mem_image_iff {n : N} : n ∈ (@image R M _ _ _ N _ _ f _) ↔ ∃ (m : M), f m = n := iff.rfl

/-- A silly lemma that f m is in the image of f -/
@[simp] lemma image_mem_image :  ∀ (m : M), f m ∈ (@image R M _ _ _ N _ _ f _) := λ m, by {
simp,
existsi m,
reflexivity,
}

/-- The kernel of a map is a sub-representation of the source -/
instance kernel.to_subrepresentation : is_subrepresentation G (@kernel R M _ _ _ N _ _ f _) :=
{ closed := λ g m hm, begin simp * at *,
    rw [@is_map.gmul G R M _ _ _ _ _ N _ _ _ f _ g m, hm, monoid_module.smul_zero_], end}

/-- The image of a map is a sub-representation of the target -/
instance image.to_subrepresentation : is_subrepresentation G (@image R M _ _ _ N _ _ f _) :=
{ closed := λ g n hn, begin simp * at *, cases hn with m hm, existsi g • m,
    rw [@is_map.gmul G R M _ _ _ _ _ N _ _ _ f _ g m, hm], end}

/-- The general version of Schur's lemma, namely that a map f : irrep → irrep is either 0 or an isomorphism -/
lemma of_irreducibles : is_irreducible G R M → is_irreducible G R N → f = (λ m, 0) ∨ function.bijective f :=
begin
intros hM hN,
-- Since M and N are irreducible, both the kernel and image are trivial (i.e. \top or \bot)
have h_kernel : (@kernel R M _ _ _ N _ _ f _) = (⊤ : submodule R M) ∨ (@kernel R M _ _ _ N _ _ f _) = (⊥ : submodule R M):=
  hM (@kernel R M _ _ _ N _ _ f _) (kernel.to_subrepresentation f),
have h_image : (@image R M _ _ _ N _ _ f _) = (⊤ : submodule R N) ∨ (@image R M _ _ _ N _ _ f _) = (⊥ : submodule R N):=
  hN (@image R M _ _ _ N _ _ f _) (image.to_subrepresentation f),
-- First suppose the kernel is M. We will then prove that f is zero.
cases h_kernel,
have : f = (λ m, 0) := by {apply funext, intro m,
  have hm_top : (m : M) ∈ (⊤ : submodule R M) := by simp,
  have hm_kernel : m ∈ kernel f := by {rw h_kernel, assumption},
  simpa,
},
left, assumption,
-- We have just proved that if ker = ⊤ then f = 0.
-- Next we split into cases for the image. Then first show that image=0 means f=0.
cases h_image,
swap,
have : f = (λ m, 0) := by {
  apply funext,
  intro m,
  have fm_mem_im : f m ∈ image f := image_mem_image f m,
  rw h_image at fm_mem_im,
  simp * at *,
},
left, assumption,
-- Now we are in the final case, ker = 0 and the image is everything.
-- We first show that zero kernel implies injective.
have hf_inj : function.injective f := by { show ∀ a₁ a₂, f a₁ = f a₂ → a₁ = a₂,
  intros a b hab,
  have ab_mem : a - b ∈ kernel f := equal_image_mem_kernel f a b hab,
  rw h_kernel at ab_mem,
  simp at ab_mem,
  replace ab_mem := congr_arg (λ x, x + b) ab_mem,
  simp at ab_mem,
  assumption,
},
right,
-- We then show that image everything implies surjective.
have hf_sur : function.surjective f := by {show ∀ n, ∃ m, f m = n, intro m,
  have m_in_top : m ∈ (⊤ : submodule R N) := by simp,
  rw ← h_image at m_in_top,
  simpa,
},
-- Finally, injective + bijective = bijective.
constructor, assumption, assumption,
end
end map -- end of the subnamespace

----------------- Show that the structure map defines a group homomorphism ---------
-- -- A representation is a group hom from G to GL_R(M). This map will be called the structure map.
-- def structure_map (g : G) : M ≃ₗ[R] M :=
-- { to_fun := λ m, g • m,
--   add := monoid_module.gmul_add g,
--   smul := monoid_representation.gmul_comm g,
--   inv_fun := λ m, g⁻¹ • m,
--   left_inv := λ m, by { dsimp, rw [← mul_action.mul_gmul, mul_left_inv, mul_action.one_gmul] },
--   right_inv := λ m, by { dsimp, rw [← mul_action.mul_gmul, mul_right_inv, mul_action.one_gmul] } }

-- variables {R}{M} -- Forget the explicit R and M

-- -- this should go to another file
-- lemma linear_equiv.ext (f g : M ≃ₗ[R] M) (H : (f : M → M) = (g : M → M)) : f = g :=
-- begin
--   cases f, cases g,
--   congr,
--   { exact H },
--   { funext m,
--     change f_to_fun = g_to_fun at H,
--     dsimp [function.left_inverse, function.right_inverse] at *,
--     rw H at f_left_inv,
--     have : function.surjective g_to_fun :=
--     begin
--       apply function.surjective_of_has_right_inverse,
--       delta function.has_right_inverse,
--       use g_inv_fun,
--       exact g_right_inv
--     end,
--     rcases this m with ⟨m, rfl⟩,
--     simp *, }
-- end

-- instance : group (M ≃ₗ[R] M) :=
-- { mul := λ f g, g.trans f,
--   mul_assoc := by { intros f g h, cases f, cases g, cases h, dsimp [linear_equiv.trans], congr' 1 },
--   one := linear_equiv.refl _,
--   one_mul := by { intro f, cases f, dsimp [linear_equiv.trans], congr' 1 },
--   mul_one := by { intro f, cases f, dsimp [linear_equiv.trans, linear_equiv.refl, (*)], congr' 1 },
--   inv := linear_equiv.symm,
--   mul_left_inv := by { intro f, cases f, dsimp [linear_equiv.trans, (*)], sorry } }

-- @[simp] lemma linear_equiv.mul_apply (f g : M ≃ₗ[R] M) (m : M) : (f * g) m = f (g m) := rfl

-- @[simp] lemma structure_map_mul (g₁ g₂ : G) :
--   structure_map R M (g₁ * g₂) = structure_map R M g₁ * structure_map R M g₂ :=
-- begin
--   apply linear_equiv.ext,
--   funext m,
--   show (g₁ * g₂) • m = g₁ • (g₂ • m),
--   rw mul_action.mul_smul
-- end

-- instance structure_map_is_group_hom : is_group_hom (structure_map R M : G → (M ≃ₗ[R] M)) :=
-- { map_mul := λ g₁ g₂, by simp }

-- @[simp] lemma structure_map_one : structure_map R M (1 : G) = 1 := is_group_hom.map_one _
-- @[simp] lemma structure_map_inv (g : G) :
--   structure_map R M (g⁻¹ : G) = (structure_map R M g)⁻¹ :=
-- is_group_hom.map_inv _ _

end group_representation


import algebra.group.units
import data.equiv.basic

import for_mathlib.with_zero

set_option old_structure_cmd true

/-- A type `α` is a “group with zero” if it is a monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`.

Examples include fields and the ordered monoids that are the
target of valuations in general valuation theory.

Currently division rings are not an example,
because they don't have the requirement 0⁻¹ = 0.-/
class group_with_zero (α : Type*)
  extends monoid α, has_inv α, zero_ne_one_class α, mul_zero_class α :=
[has_decidable_eq : decidable_eq α]
(inv_zero : (0 : α)⁻¹ = 0)
(mul_inv_cancel : ∀ a:α, a ≠ 0 → a * a⁻¹ = 1)

attribute [instance] group_with_zero.has_decidable_eq

section group_with_zero
variables {α : Type*} [group_with_zero α]

@[simp] lemma inv_zero' : (0 : α)⁻¹ = 0 := group_with_zero.inv_zero α

@[simp] lemma mul_inv_cancel' (a : α) (h : a ≠ 0) : a * a⁻¹ = 1 :=
group_with_zero.mul_inv_cancel a h

@[simp] lemma mul_inv_cancel_assoc_left (a b : α) (h : b ≠ 0) :
  (a * b) * b⁻¹ = a :=
calc (a * b) * b⁻¹ = a * (b * b⁻¹) : mul_assoc _ _ _
               ... = a             : by simp [h]

@[simp] lemma mul_inv_cancel_assoc_right (a b : α) (h : a ≠ 0) :
  a * (a⁻¹ * b) = b :=
calc a * (a⁻¹ * b) = (a * a⁻¹) * b : (mul_assoc _ _ _).symm
               ... = b             : by simp [h]

lemma inv_ne_zero' (a : α) (h : a ≠ 0) : a⁻¹ ≠ 0 :=
assume a_eq_0, by simpa [a_eq_0] using mul_inv_cancel' a h

@[simp] lemma inv_mul_cancel' (a : α) (h : a ≠ 0) : a⁻¹ * a = 1 :=
calc a⁻¹ * a = (a⁻¹ * a) * a⁻¹ * a⁻¹⁻¹ : by simp [inv_ne_zero' _ h]
         ... = a⁻¹ * a⁻¹⁻¹             : by simp [h]
         ... = 1                       : by simp [inv_ne_zero' _ h]

@[simp] lemma inv_mul_cancel_assoc_left (a b : α) (h : b ≠ 0) :
  (a * b⁻¹) * b = a :=
calc (a * b⁻¹) * b = a * (b⁻¹ * b) : mul_assoc _ _ _
               ... = a             : by simp [h]

@[simp] lemma inv_mul_cancel_assoc_right (a b : α) (h : a ≠ 0) :
  a⁻¹ * (a * b) = b :=
calc a⁻¹ * (a * b) = (a⁻¹ * a) * b : (mul_assoc _ _ _).symm
               ... = b             : by simp [h]

@[simp] lemma inv_inv'' (a : α) : a⁻¹⁻¹ = a :=
if h : a = 0 then by simp [h] else
calc a⁻¹⁻¹ = a * (a⁻¹ * a⁻¹⁻¹) : by simp [h]
       ... = a                 : by simp [inv_ne_zero' _ h]

lemma ne_zero_of_mul_right_eq_one' (a b : α) (h : a * b = 1) : a ≠ 0 :=
assume a_eq_0, zero_ne_one (by simpa [a_eq_0] using h : (0:α) = 1)

lemma ne_zero_of_mul_left_eq_one' (a b : α) (h : a * b = 1) : b ≠ 0 :=
assume b_eq_0, zero_ne_one (by simpa [b_eq_0] using h : (0:α) = 1)

lemma eq_inv_of_mul_right_eq_one' (a b : α) (h : a * b = 1) :
  b = a⁻¹ :=
calc b = a⁻¹ * (a * b) :
        (inv_mul_cancel_assoc_right _ _ $ ne_zero_of_mul_right_eq_one' a b h).symm
   ... = a⁻¹ : by simp [h]

lemma eq_inv_of_mul_left_eq_one' (a b : α) (h : a * b = 1) :
  a = b⁻¹ :=
calc a = (a * b) * b⁻¹ : (mul_inv_cancel_assoc_left _ _ (ne_zero_of_mul_left_eq_one' a b h)).symm
   ... = b⁻¹ : by simp [h]

@[simp] lemma inv_one' : (1 : α)⁻¹ = 1 :=
eq.symm $ eq_inv_of_mul_right_eq_one' _ _ (mul_one 1)

lemma inv_inj'' {Γ₀ : Type*} [group_with_zero Γ₀] {g h : Γ₀} :
  g⁻¹ = h⁻¹ ↔ g = h :=
begin
  split,
  { intro H,
    by_cases Hg : g = 0,
    { by_cases Hh : h = 0, { rw [Hg, Hh] },
      have := congr_arg ((*) h) H, rw mul_inv_cancel' _ Hh at this,
      replace := eq_inv_of_mul_left_eq_one' _ _ this,
      rw [this, inv_inv''] },
    { have := congr_arg ((*) g) H, rw mul_inv_cancel' _ Hg at this,
      replace := eq_inv_of_mul_left_eq_one' _ _ this.symm,
      rw [this, inv_inv''] } },
  { exact congr_arg _ }
end

end group_with_zero

namespace group_with_zero
variables {α : Type*} [group_with_zero α]

/-- Every nonzero element is a unit.-/
def mk₀ (a : α) (h : a ≠ 0) : units α :=
{ val := a,
  inv := a⁻¹,
  val_inv := mul_inv_cancel' a h,
  inv_val := inv_mul_cancel' a h }

@[simp] lemma coe_mk₀ (a : α) (h : ¬ a = 0) : (mk₀ a h : α) = a := rfl

@[simp] lemma coe_unit_mul_inv (a : units α) : (a : α) * a⁻¹ = 1 :=
mul_inv_cancel' _ $ ne_zero_of_mul_right_eq_one' _ (a⁻¹ : units α) $ by simp

@[simp] lemma coe_unit_inv_mul (a : units α) : (a⁻¹ : α) * a = 1 :=
inv_mul_cancel' _ $ ne_zero_of_mul_right_eq_one' _ (a⁻¹ : units α) $ by simp

@[simp] lemma coe_inv_unit (a : units α) : ((a⁻¹ : units α) : α) = a⁻¹ :=
eq_inv_of_mul_right_eq_one' _ _ $ by simp

@[simp] lemma unit_ne_zero (a : units α) : (a : α) ≠ 0 :=
assume a_eq_0, zero_ne_one α $
calc 0 = (a : α) * a⁻¹ : by simp [a_eq_0]
   ... = 1 : by simp

lemma mul_eq_zero (a b : α) (h : a * b = 0) : a = 0 ∨ b = 0 :=
begin
  contrapose! h,
  exact unit_ne_zero ((mk₀ a h.1) * (mk₀ b h.2))
end

instance : no_zero_divisors α :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := mul_eq_zero,
  .. (‹_› : group_with_zero α) }

@[simp] lemma mul_eq_zero_iff {a b : α} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
⟨mul_eq_zero a b, by rintro (H|H); simp [H]⟩

lemma mul_left_cancel {x : α} (hx : x ≠ 0) {y z : α} (h : x * y = x * z) : y = z :=
calc y = x⁻¹ * (x * y) : by rw inv_mul_cancel_assoc_right _ _ hx
   ... = x⁻¹ * (x * z) : by rw h
   ... = z             : by rw inv_mul_cancel_assoc_right _ _ hx

lemma mul_right_cancel {x : α} (hx : x ≠ 0) {y z : α} (h : y * x = z * x) : y = z :=
calc y = (y * x) * x⁻¹ : by rw mul_inv_cancel_assoc_left _ _ hx
   ... = (z * x) * x⁻¹ : by rw h
   ... = z             : by rw mul_inv_cancel_assoc_left _ _ hx

lemma mul_inv_eq_of_eq_mul {x : α} (hx : x ≠ 0) {y z : α} (h : y = z * x) : y * x⁻¹ = z :=
h.symm ▸ (mul_inv_cancel_assoc_left z x hx)

lemma eq_mul_inv_of_mul_eq {x : α} (hx : x ≠ 0) {y z : α} (h : z * x = y) : z = y * x⁻¹ :=
eq.symm $ mul_inv_eq_of_eq_mul hx h.symm

lemma mul_inv_rev (x y : α) : (x * y)⁻¹ = y⁻¹ * x⁻¹ :=
begin
  by_cases hx : x = 0, { simp [hx] },
  by_cases hy : y = 0, { simp [hy] },
  symmetry, apply eq_inv_of_mul_left_eq_one', simp [_root_.mul_assoc, hx, hy],
end

lemma pow_eq_zero (x : α) (n : ℕ) (h : x^n = 0) : x = 0 :=
begin
  induction n with n ih, { rw pow_zero at h, exfalso, exact one_ne_zero h },
  by_cases hx : x = 0, { exact hx },
  apply ih,
  replace h := congr_arg ((*) x⁻¹) h,
  rwa [pow_succ, mul_zero, inv_mul_cancel_assoc_right _ _ hx] at h,
end

/--Adjoining a zero element to the units of a group with zero
is naturally equivalent to the group with zero.-/
noncomputable def with_zero_units_equiv : with_zero (units α) ≃ α :=
equiv.symm $ @equiv.of_bijective α (with_zero (units α))
(λ a, if h : a = 0 then 0 else group_with_zero.mk₀ a h)
begin
  split,
  { intros a b, dsimp,
    split_ifs; simp [with_zero.coe_inj, units.ext_iff, *], },
  { intros a, with_zero_cases a,
    { exact ⟨0, dif_pos rfl⟩ },
    { refine ⟨a, _⟩, rw [dif_neg (group_with_zero.unit_ne_zero a)],
      simp [with_zero.coe_inj, units.ext_iff, *] } }
end

theorem inv_comm_of_comm {a b : α} (H : a * b = b * a) : a⁻¹ * b = b * a⁻¹ :=
begin
  have : a⁻¹ * (b * a) * a⁻¹ = a⁻¹ * (a * b) * a⁻¹ :=
    congr_arg (λ x:α, a⁻¹ * x * a⁻¹) H.symm,
  by_cases h : a = 0, { rw [h, inv_zero', zero_mul, mul_zero] },
  rwa [inv_mul_cancel_assoc_right _ _ h, mul_assoc, mul_inv_cancel_assoc_left _ _ h] at this,
end

section nat_pow

@[simp] theorem inv_pow (a : α) (n : ℕ) : (a⁻¹)^n = (a^n)⁻¹ :=
by induction n with n ih; [exact inv_one'.symm,
  rw [pow_succ', pow_succ, ih, mul_inv_rev]]

-- This should be done for [no_zero_divisors] .. doesn't work, we don't have pow for them.
lemma eq_zero_of_pow_eq_zero {a : α} {n : ℕ} (h : a^n = 0) : a = 0 :=
begin
  induction n with n ih,
  { exfalso, rw pow_zero at h, exact one_ne_zero h },
  rw [pow_succ, mul_eq_zero_iff] at h,
  cases h; solve_by_elim
end

-- This should be done for [no_zero_divisors] .. except nope, see above
lemma pow_ne_zero {a : α} {n : ℕ} (h : a ≠ 0) : a^n ≠ 0 :=
assume H, h $ eq_zero_of_pow_eq_zero H

theorem pow_sub (a : α) {m n : ℕ} (ha : a ≠ 0) (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ :=
have h1 : m - n + n = m, from nat.sub_add_cancel h,
have h2 : a^(m - n) * a^n = a^m, by rw [←pow_add, h1],
eq_mul_inv_of_mul_eq (pow_ne_zero ha) h2

theorem pow_inv_comm (a : α) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
by rw inv_pow; exact inv_comm_of_comm (pow_mul_comm _ _ _)

end nat_pow

section int_pow
open int

/--
The power operation in a group with zero.
This extends `monoid.pow` to negative integers
with the definition `a^(-n) = (a^n)⁻¹`.
-/
def gpow (a : α) : ℤ → α
| (of_nat n) := a^n
| -[1+n]     := (a^(nat.succ n))⁻¹

@[priority 10] instance : has_pow α ℤ := ⟨gpow⟩

@[simp] theorem gpow_coe_nat (a : α) (n : ℕ) : a ^ (n:ℤ) = a ^ n := rfl

@[simp] theorem gpow_of_nat (a : α) (n : ℕ) : a ^ of_nat n = a ^ n := rfl

@[simp] theorem gpow_neg_succ (a : α) (n : ℕ) : a ^ -[1+n] = (a ^ n.succ)⁻¹ := rfl

local attribute [ematch] le_of_lt
open nat

@[simp] theorem gpow_zero (a : α) : a ^ (0:ℤ) = 1 := rfl

@[simp] theorem gpow_one (a : α) : a ^ (1:ℤ) = a := mul_one _

@[simp] theorem one_gpow : ∀ (n : ℤ), (1 : α) ^ n = 1
| (n : ℕ) := one_pow _
| -[1+ n] := show _⁻¹=(1:α), by rw [_root_.one_pow, inv_one']

@[simp] theorem gpow_neg (a : α) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := rfl
| 0       := inv_one'.symm
| -[1+ n] := (inv_inv'' _).symm

theorem gpow_neg_one (x : α) : x ^ (-1:ℤ) = x⁻¹ := congr_arg has_inv.inv $ pow_one x

theorem inv_gpow (a : α) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := inv_pow a n
| -[1+ n] := congr_arg has_inv.inv $ inv_pow a (n+1)

private lemma gpow_add_aux (a : α) (h : a ≠ 0) (m n : nat) :
  a ^ ((of_nat m) + -[1+n]) = a ^ of_nat m * a ^ -[1+n] :=
or.elim (nat.lt_or_ge m (nat.succ n))
 (assume h1 : m < succ n,
  have h2 : m ≤ n, from le_of_lt_succ h1,
  suffices a ^ -[1+ n-m] = a ^ of_nat m * a ^ -[1+n],
    by rwa [of_nat_add_neg_succ_of_nat_of_lt h1],
  show (a ^ nat.succ (n - m))⁻¹ = a ^ of_nat m * a ^ -[1+n],
  by rw [← succ_sub h2, pow_sub _ h (le_of_lt h1), mul_inv_rev, inv_inv'']; refl)
 (assume : m ≥ succ n,
  suffices a ^ (of_nat (m - succ n)) = (a ^ (of_nat m)) * (a ^ -[1+ n]),
    by rw [of_nat_add_neg_succ_of_nat_of_ge]; assumption,
  suffices a ^ (m - succ n) = a ^ m * (a ^ n.succ)⁻¹, from this,
  by rw pow_sub; assumption)

theorem gpow_add (a : α) (h : a ≠ 0) : ∀ (i j : ℤ), a ^ (i + j) = a ^ i * a ^ j
| (of_nat m) (of_nat n) := pow_add _ _ _
| (of_nat m) -[1+n]     := gpow_add_aux _ h _ _
| -[1+m]     (of_nat n) := by rw [add_comm, gpow_add_aux _ h,
  gpow_neg_succ, gpow_of_nat, ← inv_pow, ← pow_inv_comm]
| -[1+m]     -[1+n]     :=
  suffices (a ^ (m + succ (succ n)))⁻¹ = (a ^ m.succ)⁻¹ * (a ^ n.succ)⁻¹, from this,
  by rw [← succ_add_eq_succ_add, add_comm, _root_.pow_add, mul_inv_rev]

theorem gpow_add_one (a : α) (h : a ≠ 0) (i : ℤ) : a ^ (i + 1) = a ^ i * a :=
by rw [gpow_add _ h, gpow_one]

theorem gpow_one_add (a : α) (h : a ≠ 0) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
by rw [gpow_add _ h, gpow_one]

theorem gpow_mul_comm (a : α) (h : a ≠ 0) (i j : ℤ) : a ^ i * a ^ j = a ^ j * a ^ i :=
by rw [← gpow_add _ h, ← gpow_add _ h, add_comm]

theorem gpow_mul (a : α) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n
| (m : ℕ) (n : ℕ) := pow_mul _ _ _
| (m : ℕ) -[1+ n] := (gpow_neg _ (m * succ n)).trans $
  show (a ^ (m * succ n))⁻¹ = _, by rw pow_mul; refl
| -[1+ m] (n : ℕ) := (gpow_neg _ (succ m * n)).trans $
  show (a ^ (m.succ * n))⁻¹ = _, by rw [pow_mul, ← inv_pow]; refl
| -[1+ m] -[1+ n] := (pow_mul a (succ m) (succ n)).trans $
  show _ = (_⁻¹^_)⁻¹, by rw [inv_pow, inv_inv'']

theorem gpow_mul' (a : α) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
by rw [mul_comm, gpow_mul]

end int_pow

end group_with_zero

/-- A type `α` is a commutative “group with zero”
if it is a commutative monoid with zero element (distinct from `1`)
such that every nonzero element is invertible.
The type is required to come with an “inverse” function, and the inverse of `0` must be `0`. -/
class comm_group_with_zero (α : Type*) extends comm_monoid α, group_with_zero α.

/- TODO(jmc): Refactor the algebraic hierarchy so that
division rings and discrete fields extend group_with_zero (resp. comm_group_with_zero).

Once that is done, unify group_with_zero.mk₀ with units.mk0. -/

/--Every field is a comm_group_with_zero.-/
instance discrete_field.to_comm_group_with_zero {α : Type*} [discrete_field α] :
  comm_group_with_zero α :=
{ zero_mul := _,
  mul_zero := _,
  .. ‹discrete_field α› }


import linear_algebra.finite_dimensional
import ring_theory.algebraic
import data.zmod.basic
import data.real.basic
import tactic

/-!
```
  ____
 / ___|_ __ ___  _   _ _ __  ___
| |  _| '__/ _ \| | | | '_ \/ __|
| |_| | | | (_) | |_| | |_) \__ \_
 \____|_|  \___/ \__,_| .__/|___( )
                      |_|       |/

             _ __  (_)  _ __     __ _   ___
            | '__| | | | '_ \   / _` | / __|
            | |    | | | | | | | (_| | \__ \  _
            |_|    |_| |_| |_|  \__, | |___/ ( )
                                |___/        |/

                                         _      __   _          _       _
                      __ _   _ __     __| |    / _| (_)   ___  | |   __| |  ___
                     / _` | | '_ \   / _` |   | |_  | |  / _ \ | |  / _` | / __|
                    | (_| | | | | | | (_| |   |  _| | | |  __/ | | | (_| | \__ \
                     \__,_| |_| |_|  \__,_|   |_|   |_|  \___| |_|  \__,_| |___/

```
-/

/-! ## Reminder on updating the exercises

These instructions are now available at:
https://leanprover-community.github.io/lftcm2020/exercises.html

To get a new copy of the exercises,
run the following commands in your terminal:

```
leanproject get lftcm2020
cp -r lftcm2020/src/exercises_sources/ lftcm2020/src/my_exercises
code lftcm2020
```

To update your exercise files, run the following commands:

```
cd /path/to/lftcm2020
git pull
leanproject get-mathlib-cache
```

Don’t forget to copy the updated files to `src/my_exercises`.

-/

/-! ## What do we have?

Too much to cover in detail in 10 minutes.

Take a look at the “General algebra” section on
https://leanprover-community.github.io/mathlib-overview.html

All the basic concepts are there:
`group`, `ring`, `field`, `module`, etc...

Also versions that are compatible with an ordering, like `ordered_ring`

And versions that express compatibility with a topology: `topological_group`

Finally constructions, like `polynomial R`, or `mv_polynomial σ R`,
or `monoid_algebra K G`, or `ℤ_[p]`, or `zmod n`, or `localization R S`.
-/

/-! ## Morphisms

* `X → Y`   -- ordinary function
* `X →+ Y`  -- function respects `0` and `+`
* `X →* Y`  -- function respects `1` and `*`
* `X →+* Y` -- function respects `0`, `1`, `+`, `*` (surprise!)

-/

section

-- let R and S be rings
variables {R S : Type*} [ring R] [ring S]

-- let f be a ring homomorphism; now given an term of type R, construct
-- a term of type S.
example (f : R →+* S) (a : R) : S := f a

/-
This heavily relies on the “coercion to function”
that we have seen a couple of times this week.
-/
end

/-! ## Where are these things in the library?

`algebra/`         for basic definitions and properties; “algebraic hierarchy”

`group_theory/`  ⎫
`ring_theory/`   ⎬ “advanced” and “specialised” material
`field_theory/`  |
`number_theory`  ⎭

`data/`            definitions and examples

To give an idea:

* `algebra/ordered_ring.lean`

* `ring_theory/noetherian.lean`

* `field_theory/chevalley_warning.lean`

* `data/nat/*.lean`, `data/real/*.lean`, `number_theory/padics/*.lean`

-/

/-! ## How to find things (search tools)

* `library_search` -- it often helps to carve out
                      the exact lemma statement that you are looking for

* online documentation: https://leanprover-community.github.io/mathlib_docs/
  new search bar under construction

* Old-skool: `grep`

* Search in VS Code:

  - `Ctrl - Shift - F`
    -- don't forget to change settings, to search everywhere
    -- click the three dots (`…`) below the search bar
    -- disable the blue cogwheel

  - `Ctrl - P`        -- search for filenames
  - `Ctrl - P`, `#`   -- search for lemmas and definitions

-/

/-! ## How to find things (autocomplete)

Mathlib follows pretty strict naming conventions:

```
/-- The binomial theorem-/
theorem add_pow [comm_semiring α] (x y : α) (n : ℕ) :
  (x + y) ^ n = ∑ m in range (n + 1), x ^ m * y ^ (n - m) * choose n m :=
(commute.all x y).add_pow n
```

After a while, you get the hang of this,
and you can start guessing names.

-/

open_locale big_operators -- nice notation ∑, ∏
open finset -- `finset.range n` is the finite set `{0,1,..., n-1}`

-- Demonstrate autocompletion
example (f : ℕ → ℝ) (n : ℕ) :
  57 + ∑ i in range (n+1), f i = 57 + f n + ∑ i in range n, f i :=
begin
  sorry
end

/-! ## How to find things (jump to definition)

Another good strategy for finding useful results about `X`,
is to “jump to the definition” and scroll through the next 3 screens of lemmas.
If you are looking for a basic fact about `X`, you will usually find it there.

-/

-- demonstrate “jump to definition”
#check polynomial.coeff

/-! ## Exercise 1
We will warm up with a well-known result:
“Subgroups of abelian groups are normal.”

Hints for proving this result:
  * Notice that `normal` is a structure,
    which you can see by going to the definition.
    The `constructor` tactic will help you to get started.
-/

namespace add_subgroup
variables {A : Type*} [add_comm_group A]

lemma normal_of_add_comm_group (H : add_subgroup A) : normal H :=
begin
  sorry
end

end add_subgroup

/-! ## Exercise 2
The following exercise will show the classical fact:
“Finite field extensions are algebraic.”

Hints for proving this result:
  * Look up the definition of `finite_dimensional`.
  * Search the library for useful lemmas about `is_algebraic` and `is_integral`.
  * You can have a look at `is_noetherian.iff_fg`.
-/

namespace algebra
variables {K L : Type*} [field K] [field L] [algebra K L] [finite_dimensional K L]

lemma is_algebraic_of_finite_dimensional : is_algebraic K L :=
begin
  sorry
end

end algebra

/-! ## Exercise 3
In this exercise we will define the Frobenius morphism.
-/

section
variables (p : ℕ) [fact p.prime]
variables (K : Type*) [field K] [char_p K p]

/-! ### Subchallenge -/
lemma add_pow_char' (x y : K) : (x + y) ^ p = x ^ p + y ^ p :=
begin
  -- Hint: `add_pow_char` already exists.
  -- You can use it if you don't want to spend time on this.

  /- Hints if you do want to attempt this:
  * `finset.sum_range_succ`
  * `finset.sum_eq_single`
  * `nat.prime.ne_zero`
  * `char_p.cast_eq_zero_iff`
  * `nat.prime.dvd_choose_self`
  * `fact.out p.prime` obtains the primality of `p` from the typeclass assumption `[fact p.prime]`
  -/
  sorry
end

def frobenius_hom : K →+* K :=
{ to_fun := λ x, x^p,
  map_zero' :=
  begin
    -- Hint: `zero_pow`, search for lemmas near `nat.prime`
    sorry
  end,
  map_one' :=
  begin
    sorry
  end,
  map_mul' :=
  begin
    sorry
  end,
  map_add' :=
  begin
    -- Hint: `add_pow_char` -- can you prove that one yourself?
    sorry
  end }

end

/-! ## Exercise 4 [challenging]
The next exercise asks to show that a monic polynomial `f ∈ ℤ[X]` is irreducible
if it is irreducible modulo a prime `p`.
This fact is also not in mathlib.

Hint: prove the helper lemma that is stated first.

Follow-up question:
Can you generalise `irreducible_of_irreducible_mod_prime`?
-/

namespace polynomial
variables {R S : Type*} [semiring R] [comm_ring S] [is_domain S] (φ : R →+* S)

/-
Useful library lemmas (in no particular order):

- `degree_eq_zero_of_is_unit`
- `eq_C_of_degree_eq_zero`
- `is_unit.map'`
- `leading_coeff_C`
- `degree_map_eq_of_leading_coeff_ne_zero`
- `ring_hom.is_unit_map`
- `is_unit.ne_zero`
-/

lemma is_unit_of_is_unit_leading_coeff_of_is_unit_map'
  (f : polynomial R) (hf : is_unit (leading_coeff f)) (H : is_unit (map φ f)) :
  is_unit f :=
begin
  sorry
end

/-
Useful library lemmas (in no particular order):

- `ring_hom.is_unit_map`
- `is_unit_of_mul_is_unit_left` (also `_right`)
- `leading_coeff_mul`
- `is_unit_of_is_unit_leading_coeff_of_is_unit_map` (the helper lemma we just proved)
- `is_unit_one`
- `coe_map_ring_hom`
-/

lemma irreducible_of_irreducible_mod_prime (f : polynomial ℤ) (p : ℕ) [fact p.prime]
  (h_mon : monic f) (h_irr : irreducible (map (int.cast_ring_hom (zmod p)) f)) :
  irreducible f :=
begin
  sorry
end

end polynomial

-- SCROLL DOWN FOR THE BONUS EXERCISE

section
/-! ## Bonus exercise (wicked hard) -/

noncomputable theory       -- because `polynomial` is noncomputable (implementation detail)
open polynomial            -- we want to write `X`, instead of `polynomial.X`

/-
First we make some definitions
Scroll to the end for the actual exercise
-/

def partial_ramanujan_tau_polynomial (n : ℕ) : polynomial ℤ :=
X * ∏ k in finset.Ico 1 n, (1 - X^k)^24

def ramanujan_tau (n : ℕ) : ℤ :=
coeff (partial_ramanujan_tau_polynomial n) n

-- Some nice suggestive notation
prefix `τ`:300 := ramanujan_tau

/-
Some lemmas to warm up
Hint: unfold definitions, `simp`
-/

example : τ 0 = 0 :=
begin
  sorry
end

example : τ 1 = 1 :=
begin
  sorry
end

-- This one is nontrivial
-- Use `have : subresult,` or state helper lemmas and prove them first!

example : τ 2 = -24 :=
begin
  -- Really, we ought to have a tactic that makes this easy
  delta ramanujan_tau partial_ramanujan_tau_polynomial,
  rw [mul_comm, coeff_mul_X],
  suffices : ((1 - X) ^ 24 : polynomial ℤ).coeff 1 = -(24 : ℕ), by simpa,
  generalize : (24 : ℕ) = n,
  sorry
end

/-
The actual exercise. Good luck (-;
-/

theorem deligne (p : ℕ) (hp : p.prime) : (abs (τ p) : ℝ) ≤ 2 * p^(11/2) :=
begin
  sorry
end

end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Simon Hudon, Scott Morrison
-/
import control.bifunctor
import logic.equiv.basic

/-!
# Functor and bifunctors can be applied to `equiv`s.

We define
```lean
def functor.map_equiv (f : Type u → Type v) [functor f] [is_lawful_functor f] :
  α ≃ β → f α ≃ f β
```
and
```lean
def bifunctor.map_equiv (F : Type u → Type v → Type w) [bifunctor F] [is_lawful_bifunctor F] :
  α ≃ β → α' ≃ β' → F α α' ≃ F β β'
```
-/

universes u v w

variables {α β : Type u}
open equiv

namespace functor

variables (f : Type u → Type v) [functor f] [is_lawful_functor f]

/-- Apply a functor to an `equiv`. -/
def map_equiv (h : α ≃ β) : f α ≃ f β :=
{ to_fun    := map h,
  inv_fun   := map h.symm,
  left_inv  := λ x, by simp [map_map],
  right_inv := λ x, by simp [map_map] }

@[simp]
lemma map_equiv_apply (h : α ≃ β) (x : f α) :
  (map_equiv f h : f α ≃ f β) x = map h x := rfl

@[simp]
lemma map_equiv_symm_apply (h : α ≃ β) (y : f β) :
  (map_equiv f h : f α ≃ f β).symm y = map h.symm y := rfl

@[simp]

end functor

namespace bifunctor

variables {α' β' : Type v} (F : Type u → Type v → Type w) [bifunctor F] [is_lawful_bifunctor F]

/-- Apply a bifunctor to a pair of `equiv`s. -/
def map_equiv (h : α ≃ β) (h' : α' ≃ β') : F α α' ≃ F β β' :=
{ to_fun    := bimap h h',
  inv_fun   := bimap h.symm h'.symm,
  left_inv  := λ x, by simp [bimap_bimap, id_bimap],
  right_inv := λ x, by simp [bimap_bimap, id_bimap] }

@[simp]
lemma map_equiv_apply (h : α ≃ β) (h' : α' ≃ β') (x : F α α') :
  (map_equiv F h h' : F α α' ≃ F β β') x = bimap h h' x := rfl

@[simp]
lemma map_equiv_symm_apply (h : α ≃ β) (h' : α' ≃ β') (y : F β β') :
  (map_equiv F h h' : F α α' ≃ F β β').symm y = bimap h.symm h'.symm y := rfl

@[simp]
lemma map_equiv_refl_refl : map_equiv F (equiv.refl α) (equiv.refl α') = equiv.refl (F α α') :=
begin
  ext x,
  simp [id_bimap]
end

end bifunctor


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

local attribute [instance, priority 0] prop_decidable

-- Line Reflections

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

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

theorem M_to_mid {a b m : point} : M a m b → mid a b = m := seven17 (ten1 a b)

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

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

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

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

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

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

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

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

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

theorem unique_of_Sl {p q : point} {A : set point} (h : line A) : p ∉ A → mid p q ∈ A → perp A (l p q) → q = Sl A p :=
λ h1 h2 h3, unique_of_exists_unique (ten2 A h1) ⟨h2, h3⟩ (ten3a h h1)

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

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

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

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

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

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

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

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

theorem ten7a {A : set point} (h : line A) {p q : point} : p ≠ q → Sl A p ≠ Sl A q :=
λ h1 h2, h1 (ten7 h2)

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

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

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

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

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

theorem ten11c {A : set point} (h : line A) (a b c : point) : cong a b c (Sl A a) (Sl A b) (Sl A c) :=
by repeat {split}; exact ten10 h _ _

theorem ten11d {A : set point} (h : line A) {a b c : point} : R a b c ↔ R (Sl A a) (Sl A b) (Sl A c) :=
⟨λ h1, eight10 h1 (ten11c h a b c), λ h1, eight10 h1 (ten11c h a b c).symm⟩

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

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

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

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

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

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

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

theorem ten17 {a b : point} {A : set point} (h : line A) : S (Sl A a) (Sl A b) = Sl A (S a b) :=
(seven6 ⟨(ten11a h).1 (seven5 a b).1, (ten11b h).1 (seven5 a b).2⟩).symm

theorem ten18 {a b p : point} {A : set point} : xperp b A (l a b) → p ∈ A → xperp (S p b) A (l (S p a) (S p b)) :=
begin
intros h h1,
by_cases h_1 : p = b,
  subst p,
  rw seven11,
  suffices : l a b = l (S b a) b,
    rwa ←this,
  exact six18 h.2.1 (seven12a (six13 h.2.1)) (or.inl (seven5 b a).1) (six17b a b),
apply eight13.2 ⟨h.1, six14 (seven9a p (six13 h.2.1)), ((seven24 h.1 h1).1 h.2.2.1), six17b _ _,
p, S p a, h1, six17a _ _, (seven12a (ne.symm h_1)).symm, (seven9a p (six13 h.2.1)), _⟩,
simpa using ((eight19 p).1 (h.2.2.2.2 h1 (six17a a b)))
end

-- Angles

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

theorem eleven12a {a b c : point} {A : set point} (h : line A) : a ≠ b → c ≠ b → eqa a b c (Sl A a) (Sl A b) (Sl A c) :=
begin
intros h1 h2,
rw eleven3,
existsi [a, c, (Sl A a), (Sl A c)],
simp [six5 h1, six5 h2, six5 (ten7a h h1), six5 (ten7a h h2), ten11c h a b c]
end

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end Euclidean_plane