import data.real.nnreal
import algebra.hom.group
import algebra.big_operators
import algebra.module.pi
import topology.basic

import hacks_and_tricks.type_pow

/-!

# Pseudo-normed groups

This file contains definitions and basic properties of pseudo-normed (abelian additive) groups.
See for example the comments after the proof of Proposition 9.10 of `analytic.pdf`, although we do
not work in an arbitrary topos.

## Main definitions

`pseudo_normed_group` -- a pseudo-normed abelian additive group

## Implementation issues

Right now we let the M_c be subsets of M. An alternative approach would be to have
them all as types; this is more convenient for some parts of the argument.

-/

noncomputable theory

open_locale nnreal big_operators

local attribute [instance] type_pow

/-- A pseudo-normed group is an abelian group `M`
together with an increasing filtration indexed by `ℝ≥0` of subsets `M_{≤c}`
containing `0` and closed under negation,
and such that if `x₁ ∈ M_{≤c₁}` and `x₂ ∈ M_{c₂}`, then `x₁ + x₂ ∈ M_{≤c₁ + c₂}`.

See also the comments after Proposition 9.10 on p66 in [Analytic].

Implementation details:
* In [Analytic], the filtration is indexed by *positive* real numbers (excluding) `0`,
  whereas this definition includes `0` in the indexing set.
* We do not ask for the filtration to be exhaustive (similar to [Analytic]),
  which is convenient, because it means that `M₁ →+ M₂` is naturally a pseudo-normed group
  if `M₁` and `M₂` are pseudo-normed groups. -/
class pseudo_normed_group (M : Type*) :=
[to_add_comm_group : add_comm_group M]
(filtration [] : ℝ≥0 → set M)
(filtration_mono : ∀ ⦃c₁ c₂⦄, c₁ ≤ c₂ → filtration c₁ ⊆ filtration c₂)
(zero_mem_filtration : ∀ c, (0:M) ∈ filtration c)
(neg_mem_filtration : ∀ ⦃c x⦄, x ∈ filtration c → (-x) ∈ filtration c)
(add_mem_filtration : ∀ ⦃c₁ c₂ x₁ x₂⦄,
  x₁ ∈ filtration c₁ → x₂ ∈ filtration c₂ → x₁ + x₂ ∈ filtration (c₁ + c₂))

/-- The additive commutative group instance underlying a pseudo-normed group. -/
add_decl_doc pseudo_normed_group.to_add_comm_group

open function

-- An alternative attempt at pseudo-normed groups,
-- that we might want to keep/switch to in the future

-- class pseudo_normed_group' (B_ : ℝ≥0 → Type*) (M : out_param Type*) :=
-- [to_add_comm_group : add_comm_group M]
-- [has_zero : Π r, has_zero (B_ r)]
-- [has_neg : Π r, has_neg (B_ r)]
-- (map : ∀ ⦃c₁ c₂⦄, c₁ ≤ c₂ → B_ c₁ → B_ c₂) -- rename
-- (incl : ∀ c, B_ c → M)
-- (incl_injective : ∀ c, injective (incl c))
-- (incl_zero : ∀ c, incl c 0 = 0)
-- (incl_neg : ∀ {c} (f : B_ c), incl c (-f) = - (incl c f))
-- (incl_map : ∀ {c₁ c₂} (h : c₁ ≤ c₂), (incl c₂) ∘ (map h) = (incl c₁))
-- (B_add {c₁ c₂} : B_ c₁ → B_ c₂ → B_ (c₁ + c₂))
-- (incl_add {c₁ c₂} (f : B_ c₁) (g : B_ c₂) : incl _ (B_add f g) = incl _ f + incl _ g)
-- (map_refl {c} : map (le_refl c) = id)
-- (map_trans {c₁ c₂ c₃} (h1 : c₁ ≤ c₂) (h2 : c₂ ≤ c₃) : map (h1.trans h2) = map h2 ∘ map h1)

/-
class topological_pseudo_normed_group' (B_ : ℝ≥0 → Type*) (M : Type*)
  extends pseudo_normed_group' B_ M :=
[is_top_space : Π r, topological_space (B_ r)]
-/

/-
Thought by Johan:
Maybe we want both defintions above, and write a bit of glue to move between them.
Both seem useful for different bits of what we want to do.
-/

attribute [instance] pseudo_normed_group.to_add_comm_group

namespace pseudo_normed_group

variables {M : Type*} [pseudo_normed_group M]

instance (c : ℝ≥0) : has_zero (filtration M c) := ⟨⟨0, zero_mem_filtration _⟩⟩
instance (c : ℝ≥0) : has_neg (filtration M c) := ⟨λ x, ⟨-x, neg_mem_filtration x.2⟩⟩

@[simp] lemma filtration.coe_zero {c : ℝ≥0} : ((0 : filtration M c) : M) = 0 := rfl
@[simp] lemma filtration.coe_neg {c : ℝ≥0} (x : filtration M c) :
  ((-x : filtration M c) : M) = -(x : M) := rfl

/-- Bounded uncurried addition for pseudo-normed groups. -/
def add' {c₁ c₂} (x : (filtration M c₁) × (filtration M c₂)) : filtration M (c₁ + c₂) :=
⟨(x.1 + x.2 : M), add_mem_filtration x.1.2 x.2.2⟩

@[simp] lemma add'_eq {c₁ c₂ : ℝ≥0} (x : (filtration M c₁) × (filtration M c₂)) :
  (add' x : M) = x.1 + x.2 := rfl

/-- Bounded negation for pseudo-normed groups. -/
def neg' {c} (x : filtration M c) : filtration M c :=
⟨(-x : M), neg_mem_filtration x.2⟩

@[simp] lemma neg'_eq {c : ℝ≥0} (x : filtration M c) :
  (neg' x : M) = -x := rfl

lemma sub_mem_filtration ⦃c₁ c₂ x₁ x₂⦄ (h₁ : x₁ ∈ filtration M c₁) (h₂ : x₂ ∈ filtration M c₂) :
  x₁ - x₂ ∈ filtration M (c₁ + c₂) :=
by { rw [sub_eq_add_neg], exact add_mem_filtration h₁ (neg_mem_filtration h₂) }

lemma neg_mem_filtration_iff (c x) : -x ∈ filtration M c ↔ x ∈ filtration M c :=
⟨λ h, by { rw [← neg_neg x], exact neg_mem_filtration h }, λ h, neg_mem_filtration h⟩

lemma sum_mem_filtration {ι : Type*} (x : ι → M) (c : ι → ℝ≥0) (s : finset ι)
  (h : ∀ i ∈ s, x i ∈ filtration M (c i)) :
  (∑ i in s, x i) ∈ filtration M (∑ i in s, (c i)) :=
begin
  classical,
  revert h, apply finset.induction_on s; clear s,
  { intro, simpa only [finset.sum_empty] using zero_mem_filtration _ },
  { intros i s his IH h,
    rw [finset.sum_insert his, finset.sum_insert his],
    apply add_mem_filtration (h _ _) (IH _),
    { exact finset.mem_insert_self i s },
    { intros j hj, apply h, exact finset.mem_insert_of_mem hj } }
end

lemma nat_smul_mem_filtration (n : ℕ) (m : M) (c : ℝ≥0) (h : m ∈ filtration M c) :
  (n • m) ∈ filtration M (n * c) :=
begin
  induction n with n ih, { simpa only [zero_smul] using zero_mem_filtration _ },
  simp only [nat.succ_eq_add_one, add_smul, one_smul, nat.cast_succ, add_mul, one_mul],
  exact add_mem_filtration ih h,
end

lemma int_smul_mem_filtration (n : ℤ) (m : M) (c : ℝ≥0) (h : m ∈ filtration M c) :
  (n • m) ∈ filtration M (n.nat_abs * c) :=
begin
  by_cases hn : 0 ≤ n,
  { lift n to ℕ using hn,
    simp only [int.nat_abs_of_nat, ← zsmul_eq_smul, coe_nat_zsmul, nsmul_eq_smul],
    exact pseudo_normed_group.nat_smul_mem_filtration n m c h },
  { push_neg at hn, rw ← neg_pos at hn,
    lift -n to ℕ using hn.le with k hk,
    rw [← neg_neg n, int.nat_abs_neg, ← hk, int.nat_abs_of_nat, neg_smul],
    apply neg_mem_filtration,
    simp only [neg_smul, ← zsmul_eq_smul, coe_nat_zsmul, nsmul_eq_smul],
    exact pseudo_normed_group.nat_smul_mem_filtration k m c h }
end

/-- The map from `filtration M₁ c` to `filtration M₂ c` induced by a strict morphism `M₁ → M₂`. -/
@[simps] def level {M₁ M₂ : Type*} [pseudo_normed_group M₁] [pseudo_normed_group M₂]
 (f : M₁ → M₂) (strict :  ∀ ⦃c x⦄, x ∈ filtration M₁ c → f x ∈ filtration M₂ c)
 (c : ℝ≥0) : filtration M₁ c → filtration M₂ c :=
λ x, ⟨f x, strict x.2⟩

section pi

variables

instance pi {ι : Type*} (M : ι → Type*) [Π i, pseudo_normed_group (M i)] :
  pseudo_normed_group (Π i, M i) :=
{ filtration := λ c, { x | ∀ i, x i ∈ filtration (M i) c },
  filtration_mono := λ c₁ c₂ h x hx i, filtration_mono h (hx i),
  zero_mem_filtration := λ c i, zero_mem_filtration _,
  neg_mem_filtration := λ c x h i, neg_mem_filtration (h i),
  add_mem_filtration := λ c₁ c₂ x₁ x₂ h₁ h₂ i, add_mem_filtration (h₁ i) (h₂ i) }

lemma mem_filtration_pi {ι : Type*} (M : ι → Type*) [Π i, pseudo_normed_group (M i)]
  (c : ℝ≥0) (x : Π i, M i) :
  x ∈ filtration (Π i, M i) c ↔ ∀ i, x i ∈ filtration (M i) c := iff.rfl

/-- The equivalence between `(Π i, M i)_c` and `Π i, (M i)_c`. -/
@[simps]
def filtration_pi_equiv {ι : Type*} (M : ι → Type*) [Π i, pseudo_normed_group (M i)] (c : ℝ≥0) :
  filtration (Π i, M i) c ≃ Π i, filtration (M i) c :=
{ to_fun := λ x i, ⟨x.1 i, x.2 i⟩,
  inv_fun := λ x, ⟨λ i, x i, λ i, (x i).2⟩,
  left_inv := by { rintro ⟨x, hx⟩, refl },
  right_inv := by { intro x, ext, refl } }

end pi

section prod

variables (M₁ M₂ : Type*) [pseudo_normed_group M₁] [pseudo_normed_group M₂]

instance prod :
  pseudo_normed_group (M₁ × M₂) :=
{ filtration := λ c, { x | x.1 ∈ filtration M₁ c ∧ x.2 ∈ filtration M₂ c },
  filtration_mono := λ c₁ c₂ h x hx, ⟨filtration_mono h hx.1, filtration_mono h hx.2⟩,
  zero_mem_filtration := λ c, ⟨zero_mem_filtration _, zero_mem_filtration _⟩,
  neg_mem_filtration := λ c x h, ⟨neg_mem_filtration h.1, neg_mem_filtration h.2⟩,
  add_mem_filtration := λ c₁ c₂ x₁ x₂ h₁ h₂,
    ⟨add_mem_filtration h₁.1 h₂.1, add_mem_filtration h₁.2 h₂.2⟩ }

lemma mem_filtration_prod (c : ℝ≥0) (x : M₁ × M₂) :
  x ∈ filtration (M₁ × M₂) c ↔ x.1 ∈ filtration M₁ c ∧ x.2 ∈ filtration M₂ c := iff.rfl

/-- The equivalence between `(M₁ × M₂)_c` and `(M₁)_c × (M₂)_c`. -/
@[simps]
def filtration_prod_equiv (c : ℝ≥0) :
  filtration (M₁ × M₂) c ≃ filtration M₁ c × filtration M₂ c :=
{ to_fun := λ x, (⟨x.1.1,  x.2.1⟩, ⟨x.1.2, x.2.2⟩),
  inv_fun := λ x, ⟨(x.1, x.2), ⟨x.1.2, x.2.2⟩⟩,
  left_inv := by { rintro ⟨⟨x₁, x₂⟩, hx⟩, refl },
  right_inv := by { rintro ⟨x₁, x₂⟩, ext; refl } }

end prod

/-- The natural inclusion `filtration M c₁ → filtration M c₂`,
for a pseudo-normed group `M`, and `c₁ ≤ c₂`. -/
def cast_le {c₁ c₂ : ℝ≥0} [h : fact (c₁ ≤ c₂)] (x : filtration M c₁) :
  filtration M c₂ :=
⟨x, filtration_mono h.out x.2⟩

/-- The natural inclusion `filtration M c₁ → filtration M c₂`,
for a pseudo-normed group `M`, and `c₁ ≤ c₂`. -/
def cast_le' {c₁ c₂ : ℝ≥0} (h : c₁ ≤ c₂) : filtration M c₁ → filtration M c₂ :=
λ x, ⟨x, filtration_mono h x.2⟩

@[simp] lemma cast_le'_eq_cast_le {c₁ c₂ : ℝ≥0} [h : fact (c₁ ≤ c₂)] (x : filtration M c₁) :
  cast_le' h.out x = cast_le x := rfl

@[simp] lemma coe_cast_le {c₁ c₂ : ℝ≥0} [h : fact (c₁ ≤ c₂)] (x : filtration M c₁) :
  ((cast_le x : filtration M c₂) : M) = x := rfl

@[simp] lemma coe_cast_le' {c₁ c₂ : ℝ≥0} (h : c₁ ≤ c₂) (x : filtration M c₁) :
  ((cast_le' h x) : M) = x := rfl

lemma injective_cast_le (c₁ c₂ : ℝ≥0) [fact (c₁ ≤ c₂)] :
  function.injective (cast_le : filtration M c₁ → filtration M c₂) :=
λ x y h, subtype.coe_injective $
by simpa only [coe_cast_le] using congr_arg (coe : filtration M c₂ → M) h

variables (M)

end pseudo_normed_group

open pseudo_normed_group

namespace add_monoid_hom

variables {M M₁ M₂ M₃ : Type*}
variables [pseudo_normed_group M] [pseudo_normed_group M₁]
variables [pseudo_normed_group M₂] [pseudo_normed_group M₃]

instance : pseudo_normed_group (M₁ →+ M₂) :=
{ filtration := λ N, { f | ∀ ⦃c⦄ ⦃x : M₁⦄, x ∈ filtration M₁ c → f x ∈ filtration M₂ (N * c) },
  filtration_mono := λ N₁ N₂ h f hf c x hx, filtration_mono (mul_le_mul_right' h c) (hf hx),
  zero_mem_filtration := λ N c x hx, zero_mem_filtration _,
  neg_mem_filtration := λ N f hf c x hx, neg_mem_filtration $ hf hx,
  add_mem_filtration := λ N₁ N₂ f₁ f₂ hf₁ hf₂ c x hx,
  by { rw add_mul, apply add_mem_filtration (hf₁ hx) (hf₂ hx) },
  .. add_monoid_hom.add_comm_group }

lemma comp_mem_filtration {g f cg cf}
  (hg : g ∈ filtration (M₂ →+ M₃) cg) (hf : f ∈ filtration (M₁ →+ M₂) cf) :
  g.comp f ∈ filtration (M₁ →+ M₃) (cg * cf) :=
λ c x hx, by { rw mul_assoc, exact hg (hf hx) }

@[simp] lemma id_mem_filtration (c : ℝ≥0) (hc : 1 ≤ c) : id M ∈ filtration (M →+ M) c :=
λ c' x hx, by refine filtration_mono _ hx;
calc c' = 1 * c' : by rw one_mul
    ... ≤ c * c' : mul_le_mul_right' hc c'

-- move this, maybe it already exists?
/-- The additive monoid homomorphism into a product of additive monoids,
constructed from a family of monoid homomorphisms into the factors. -/
@[simps {rhs_md:=semireducible, fully_applied:=ff}]
def mk_to_pi {M₁} [add_monoid M₁] {ι : Type*} {M : ι → Type*} [Π i, add_monoid (M i)]
  (f : Π i, M₁ →+ (M i)) :
  M₁ →+ (Π i, M i) :=
{ to_fun := λ v i, f i v,
  map_zero' := by { simp only [map_zero], refl },
  map_add' := by { intros, simp only [map_add], refl } }

lemma mk_to_pi_mem_filtration {ι : Type*} {M : ι → Type*}
  [Π i, pseudo_normed_group (M i)] (f : Π i, M₁ →+ (M i))
  {c} (hfc : ∀ i, f i ∈ filtration (M₁ →+ (M i)) c) :
  mk_to_pi f ∈ filtration (M₁ →+ (Π i, M i)) c :=
λ c' x h i, hfc i h

lemma eval_mem_filtration {ι : Type*} (M : ι → Type*) [Π i, pseudo_normed_group (M i)]
  (i : ι) (c : ℝ≥0) (hc : 1 ≤ c) :
  (pi.eval_add_monoid_hom M i) ∈ filtration ((Π i, M i) →+ M i) c :=
λ c' x hx, by refine filtration_mono _ (hx i);
calc c' = 1 * c' : by rw one_mul
    ... ≤ c * c' : mul_le_mul_right' hc c'

/-- The additive monoid homomorphism out of a finite product of additive monoids,
constructed from a family of monoid homomorphisms out of the factors. -/
def mk_from_pi {ι : Type*} [fintype ι] {M : ι → Type*} {M₂}
  [Π i, add_monoid (M i)] [add_comm_monoid M₂] (f : Π i, (M i) →+ M₂) :
  (Π i, M i) →+ M₂ :=
∑ i, (f i).comp (pi.eval_add_monoid_hom M i)

@[simp] lemma mk_from_pi_apply {ι : Type*} [fintype ι] {M : ι → Type*} [Π i, add_comm_monoid (M i)]
  (f : Π i, M i →+ M₂) (x : Π i, M i) :
  mk_from_pi f x = (∑ i, f i (x i)) :=
begin
  show add_monoid_hom.eval x (mk_from_pi f) = _,
  simp only [mk_from_pi, add_monoid_hom.map_sum],
  refl
end

@[simp] lemma coe_mk_from_pi {ι : Type*} [fintype ι] {M : ι → Type*} [Π i, add_comm_monoid (M i)]
  (f : Π i, M i →+ M₂) :
  ⇑(mk_from_pi f) = ∑ i, (f i ∘ pi.eval_add_monoid_hom M i) :=
by { ext x, rw [@mk_from_pi_apply M₂ _ ι _ M _ f x, fintype.sum_apply], refl }

lemma mk_from_pi_mem_filtration {ι : Type*} [fintype ι] {M : ι → Type*}
  [Π i, pseudo_normed_group (M i)] (f : Π i, (M i) →+ M₂)
  {c : ι → ℝ≥0} (hfc : ∀ i, f i ∈ filtration ((M i) →+ M₂) (c i)) :
  (mk_from_pi f) ∈ filtration ((Π i, M i) →+ M₂) (∑ i, c i) :=
λ c' x h,
begin
  rw [finset.sum_mul, @mk_from_pi_apply M₂ _ ι _ M _ f x],
  refine sum_mem_filtration _ _ _ _,
  rintro i -,
  exact hfc i (h i)
end

lemma const_smul_hom_nat_mem_filtration (n : ℕ) (c : ℝ≥0) (h : ↑n ≤ c) :
  distrib_mul_action.to_add_monoid_hom M n ∈ filtration (M →+ M) c :=
λ c' x hx, by simpa only [distrib_mul_action.to_add_monoid_hom_apply]
  using filtration_mono (mul_le_mul_right' h c') (nat_smul_mem_filtration _ _ _ hx)

lemma const_smul_hom_int_mem_filtration (n : ℤ) (c : ℝ≥0) (h : ↑(n.nat_abs) ≤ c) :
  distrib_mul_action.to_add_monoid_hom M n ∈ filtration (M →+ M) c :=
λ c' x hx, by simpa only [distrib_mul_action.to_add_monoid_hom_apply]
  using filtration_mono (mul_le_mul_right' h c') (int_smul_mem_filtration _ _ _ hx)

end add_monoid_hom

structure strict_pseudo_normed_group_hom (M N : Type*)
  [pseudo_normed_group M] [pseudo_normed_group N] extends M →+ N :=
(strict' : ∀ c x, x ∈ pseudo_normed_group.filtration M c →
  to_fun x ∈ pseudo_normed_group.filtration N c)

namespace strict_pseudo_normed_group_hom

variables {M N : Type*} [pseudo_normed_group M] [pseudo_normed_group N]
  (f g : strict_pseudo_normed_group_hom M N)

instance : has_coe_to_fun (strict_pseudo_normed_group_hom M N)
  (λ _, M → N) := ⟨λ f, f.to_add_monoid_hom⟩

@[simp] lemma coe_mk (f) (h) :
  ⇑(⟨f,h⟩ : strict_pseudo_normed_group_hom M N) = f := rfl

@[simp] lemma mk_to_monoid_hom (f) (h) :
  (⟨f, h⟩ : strict_pseudo_normed_group_hom M N).to_add_monoid_hom = f := rfl

@[simp]
lemma coe_to_add_monoid_hom : ⇑f.to_add_monoid_hom = f := rfl

@[simp]
lemma map_zero : f 0 = 0 := f.to_add_monoid_hom.map_zero

@[simp]
lemma map_add (x y) : f (x + y) = f x + f y := f.to_add_monoid_hom.map_add _ _

@[simp]
lemma map_neg (x) : f (-x) = - f x := f.to_add_monoid_hom.map_neg _

lemma strict ⦃c x⦄ (h : x ∈ filtration M c) : f x ∈ filtration N c :=
  f.strict' _ _ h

@[ext]
lemma ext (h : ∀ x, f x = g x) : f = g :=
by { cases f, cases g, congr, ext, apply h }

def id (M : Type*) [pseudo_normed_group M] : strict_pseudo_normed_group_hom M M :=
{ to_fun := id,
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  strict' := λ _ _ h, h }

def comp {A B C : Type*} [pseudo_normed_group A] [pseudo_normed_group B] [pseudo_normed_group C]
  (f : strict_pseudo_normed_group_hom A B) (g : strict_pseudo_normed_group_hom B C) :
  strict_pseudo_normed_group_hom A C :=
{ to_fun := λ x, g $ f x,
  map_zero' := by simp,
  map_add' := λ _ _, by simp,
  strict' := λ c x h, g.strict $ f.strict h }

@[simp]
lemma id_apply (A : Type*) [pseudo_normed_group A] (a : A) :
  strict_pseudo_normed_group_hom.id A a = a := rfl

@[simp]
lemma comp_apply {A B C : Type*}
  [pseudo_normed_group A] [pseudo_normed_group B] [pseudo_normed_group C]
  (f : strict_pseudo_normed_group_hom A B) (g : strict_pseudo_normed_group_hom B C) (a : A) :
  f.comp g a = g (f a) := rfl

end strict_pseudo_normed_group_hom

-- #lint- only unused_arguments def_lemma doc_blame


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_547
  (x y : ℝ)
  (h₀ : x = 5)
  (h₁ : y = 2) :
  real.sqrt (x^3 - 2^y) = 11 :=
begin
  simp [h₀, h₁],
  norm_num [real.sqrt_eq_cases],
end


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner
-/
prelude
import Init.NotationExtra
import Init.Data.Nat.Linear

namespace Nat

theorem log2_terminates : ∀ n, n ≥ 2 → n / 2 < n
  | 2, _ => by decide
  | 3, _ => by decide
  | n+4, _ => by
    rw [div_eq, if_pos]
    refine succ_lt_succ (Nat.lt_trans ?_ (lt_succ_self _))
    exact log2_terminates (n+2) (by simp_arith)
    simp_arith

/--
Computes `⌊max 0 (log₂ n)⌋`.

`log2 0 = log2 1 = 0`, `log2 2 = 1`, ..., `log2 (2^i) = i`, etc.
-/
@[extern "lean_nat_log2"]
def log2 (n : @& Nat) : Nat :=
  if n ≥ 2 then log2 (n / 2) + 1 else 0
decreasing_by exact log2_terminates _ ‹_›

theorem log2_le_self (n : Nat) : Nat.log2 n ≤ n := by
  unfold Nat.log2; split
  · next h =>
    have := log2_le_self (n / 2)
    exact Nat.lt_of_le_of_lt this (Nat.div_lt_self (Nat.le_of_lt h) (by decide))
  · apply Nat.zero_le
decreasing_by exact Nat.log2_terminates _ ‹_›


import tactic.ring
import tactic.tidy
import group_theory.group_action
import linear_algebra.matrix.special_linear_group
import linear_algebra.determinant
import data.matrix.notation
import group_theory.group_action.basic
import algebra.hom.group_action
import linear_algebra.matrix
import linear_algebra.matrix.general_linear_group
import data.complex.basic
import mod_forms.modular_group.mat_m

--import .matrix_groups

/-  This is an attempt to update the kbb birthday repo, so most is not orginal to me-/
open finset
open matrix

open_locale matrix

section
universe u

variables (n : Type* )  [decidable_eq n] [fintype n] (m : ℤ)

namespace modular_group

 local attribute [-instance] matrix.special_linear_group.has_coe_to_fun
local notation `SL2Z`:=special_linear_group (fin 2) ℤ

variables  {R : Type*} [comm_ring R]

lemma det_m (M: integral_matrices_with_determinant (fin 2) m): (M 0 0 * M 1 1 - M 0 1 * M 1 0)= m :=
begin
 have H:= matrix.det_fin_two M.1,
 simp at *,
 have m2:=M.2,
 rw ← H,
 simp_rw ← m2,
 simp,
end

lemma det_one  (M : SL2Z) : (M 0 0 * M 1 1 - M 0 1 * M 1 0) = 1 :=
begin
apply det_m,
end

lemma det_onne  (M : SL2Z) : (M 0 0 * M 1 1 - M 1 0 * M 0 1) = 1 :=
begin
have:= det_one M,
have h1: M 1 0 * M 0 1 = M 0 1 * M 1 0, by {apply mul_comm},
rw h1,
apply this,
end

@[simp] lemma mat_mul_expl  (A B : matrix (fin 2) (fin 2) R) :
  (A * B) 0 0 =  A 0 0 * B 0 0 + A 0 1 * B 1 0 ∧
  (A * B) 0 1 = A 0 0 * B 0 1 + A 0 1 * B 1 1 ∧
  (A * B) 1 0 = A 1 0 * B 0 0 + A 1 1 * B 1 0 ∧
  (A * B) 1 1  = A 1 0 * B 0 1 + A 1 1  * B 1 1 :=
begin
  split, work_on_goal 2 {split}, work_on_goal 3 {split},
  all_goals {simp only [mul_eq_mul],
  rw  matrix.mul_apply,
  rw finset.sum_fin_eq_sum_range,
  rw finset.sum_range_succ,
  rw finset.sum_range_succ,
  simp [nat.succ_pos', lt_self_iff_false, dite_eq_ite, fin.mk_zero, if_true, finset.sum_empty, not_le,
    finset.range_zero, nat.one_lt_bit0_iff, zero_add, add_right_inj, fin.mk_one, subtype.val_eq_coe,
    ite_eq_left_iff]},
end

lemma SL2_inv_det_expl (A : SL2Z) : det ![![A.1 1 1, -A.1 0 1], ![-A.1 1 0 , A.1 0 0]] = 1 :=
begin
  rw [matrix.det_fin_two, mul_comm],
  simp only [subtype.val_eq_coe, cons_val_zero, cons_val_one, head_cons, mul_neg, neg_mul, neg_neg],
  have := A.2,
  rw matrix.det_fin_two at this,
  convert this,
end

lemma SL2_inv_expl (A : SL2Z) : A⁻¹ = ⟨![![A.1 1 1, -A.1 0 1], ![-A.1 1 0 , A.1 0 0]],
    SL2_inv_det_expl A⟩ :=
begin
  ext,
  have := matrix.adjugate_fin_two A.1,
  simp only [subtype.val_eq_coe] at this,
  simp at *,
  simp_rw [this],
  simp,
end

@[simp] lemma SL2Z_inv_a (A : SL2Z) : (A⁻¹).1 0 0 = A.1 1 1 :=
begin
rw SL2_inv_expl, simp,
end

@[simp] lemma SL2Z_inv_b (A : SL2Z) : (A⁻¹).1 0 1 = -A.1 0 1 :=
begin
rw SL2_inv_expl, simp,
end

@[simp] lemma SL2Z_inv_c (A : SL2Z) : (A⁻¹).1 1 0  = -A.1 1 0 :=
begin
rw SL2_inv_expl, simp,
end

@[simp] lemma SL2Z_inv_d (A : SL2Z) : (A⁻¹).1 1 1 = A.1 0 0 :=
begin
rw SL2_inv_expl, simp,
end

lemma m_a_b (m : ℤ) (hm : m ≠ 0) (A : SL2Z) (M N : integral_matrices_with_determinant (fin 2) m):
 (A • M) = N ↔  N 0 0= A 0 0 * M 0 0 + A 0 1 * M 1 0 ∧
 N 0 1= A 0 0 * M 0 1 + A 0 1 * M 1 1 ∧
 N 1 0= A 1 0 * M 0 0 + A 1 1 * M 1 0 ∧
 N 1 1= A 1 0 * M 0 1 + A 1 1 * M 1 1 :=
begin
split,
intro h,
have:= mat_mul_expl  A M,  rw ← h, simp ,intro h, ext i j, fin_cases i; fin_cases j, simp at *, rw h.1,
simp  at *, rw h.2.1,simp at *, rw h.2.2.1,simp  at *, rw h.2.2.2,
end

@[simp] lemma SLnZ_M_a (A: SL2Z) (M: integral_matrices_with_determinant (fin 2) m) :
 (A • M) 0 0= A 0 0 * M 0 0 + A 0 1 * M 1 0 :=
begin
simp [integral_matrices_with_determinant.SLnZ_M, add_mul, mul_add, mul_assoc],
end

@[simp] lemma SLnZ_M_b (A: SL2Z) (M: integral_matrices_with_determinant (fin 2) m) :
(A • M) 0 1= A 0 0 * M 0 1 + A 0 1 * M 1 1 :=
begin
simp [integral_matrices_with_determinant.SLnZ_M, add_mul, mul_add, mul_assoc],
end

@[simp] lemma SLnZ_M_c (A: SL2Z) (M: integral_matrices_with_determinant (fin 2) m) :
(A • M) 1 0= A 1 0 * M 0 0 + A 1 1 * M 1 0 :=
begin
simp [integral_matrices_with_determinant.SLnZ_M, add_mul, mul_add, mul_assoc],
end

@[simp] lemma SLnZ_M_d (A: SL2Z) (M: integral_matrices_with_determinant (fin 2) m)  :
 (A • M) 1 1= A 1 0 * M 0 1 + A 1 1 * M 1 1 :=
begin
simp [integral_matrices_with_determinant.SLnZ_M, add_mul, mul_add, mul_assoc],
end

def mat_Z_to_R (A : matrix (fin 2) (fin 2) ℤ ) :matrix (fin 2) (fin 2) ℝ :=
![![A 0 0, A 0 1], ![A 1 0 , A 1 1]]

instance Z_to_R: has_coe (matrix (fin 2) (fin 2) ℤ) (matrix (fin 2) (fin 2) ℝ ) :=⟨λ A, mat_Z_to_R A⟩

lemma nonzero_inv (a: ℝ) (h: 0 < a): is_unit (a):=

begin
have h2: a ≠ 0, {simp only [ne.def], by_contradiction h1, rw h1 at h, simp only [lt_self_iff_false] at h, exact h},
rw  is_unit_iff_exists_inv, use a⁻¹, apply mul_inv_cancel h2,
end

@[simp]lemma mat_val (A: SL2Z) (i j : fin 2): (mat_Z_to_R A.1) i j = (A.1 i j : ℝ):=

begin
rw mat_Z_to_R, fin_cases i; fin_cases j, simp only [matrix.cons_val_zero],
simp only [matrix.head_cons, matrix.cons_val_one, matrix.cons_val_zero],
simp only [matrix.head_cons, matrix.cons_val_one, matrix.cons_val_zero],
simp only [matrix.head_cons, matrix.cons_val_one],

end

instance SLZ_to_GLZ: has_coe SL2Z (matrix.special_linear_group (fin 2 ) ℝ):=
⟨λ A, ⟨mat_Z_to_R A.1, by {rw mat_Z_to_R, rw matrix.det_fin_two, have:= matrix.det_fin_two A,
  simp at *,
 norm_cast, exact this.symm,}, ⟩⟩

variable (C : GL_pos (fin 2) ℤ)

@[simp]lemma mat_vals (A: SL2Z) (i j : fin 2): ( A : (GL (fin 2) ℝ)) i j = (A.1 i j : ℝ):=

begin
 simp [mat_val, mat_Z_to_R], fin_cases i; fin_cases j, refl,refl,refl,refl,

end

@[simp] lemma det_coe_sl (A: SL2Z): (A: GL (fin 2) ℝ).val.det= (A.val.det: ℝ):=
begin
have:=A.2, rw this, simp, rw ← coe_coe, rw ← coe_coe, simp,
end

end modular_group

end


-- Copyright (C) 2020 by @ljt12138

import propositional.basics propositional.thms data.list
import propositional.used_formula

namespace prop_logic

lemma consistent_with_smaller_set {α : Type} (Γ Γ' : list (sentence α)) :
  Γ ⊆ Γ' → consistent Γ' → consistent Γ :=
begin
  intros h a contra,
  unfold consistent at a, apply a,
  apply provable_with_stronger_assumption,
  assumption, assumption,
end

lemma consistent_with_append {α : Type} (Γ : list _) (φ : sentence α) :
  consistent (φ :: Γ) → consistent Γ :=
begin
  intros h,
  have ht : Γ ⊆ φ :: Γ := by simp,
  apply consistent_with_smaller_set, assumption, assumption
end

lemma complete_extension {α : Type} {Γ : list (sentence α)}
      (l : list (sentence α)) (a : consistent Γ) :
  ∃ Γ', Γ ⊆ Γ' ∧ (∀ φ, φ ∈ l → φ ∈ Γ' ∨ (~φ) ∈ Γ') ∧ consistent Γ' :=
begin
  induction l with φ l' ih,
  case nil { simp, existsi Γ, split, simp, assumption },
  case cons {
    cases ih with Γ₀ h, simp at *,
    cases (classical.em (Γ₀ ⊢ φ)),
    case inl {
      existsi (list.cons φ Γ₀), split,
      { apply list.subset.trans, exact h.left, by simp },
      split, split,
      { simp },
      { simp, intros, have ht := h.right.left x H, tauto },
      {
        apply appending_provable, exact h.right.right,
        assumption
      }
    },
    case inr {
      existsi (list.cons (φ↣⊥) Γ₀), split,
      { apply list.subset.trans, exact h.left, by simp },
      split, split,
      { simp },
      { simp, intros, have ht := h.right.left x H, tauto },
      { apply appending_unprovable, assumption }
    }
  }
end

end prop_logic


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import linear_algebra.matrix.nondegenerate
import linear_algebra.matrix.nonsingular_inverse
import linear_algebra.matrix.to_lin
import ring_theory.localization

/-!
# Matrices and linear equivalences

This file gives the map `matrix.to_linear_equiv` from matrices with invertible determinant,
to linear equivs.

## Main definitions

 * `matrix.to_linear_equiv`: a matrix with an invertible determinant forms a linear equiv

## Main results

 * `matrix.exists_mul_vec_eq_zero_iff`: `M` maps some `v ≠ 0` to zero iff `det M = 0`

## Tags

matrix, linear_equiv, determinant, inverse

-/

namespace matrix

open linear_map

variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
variables {n : Type*} [fintype n]

section to_linear_equiv'

variables [decidable_eq n]

/-- An invertible matrix yields a linear equivalence from the free module to itself.

See `matrix.to_linear_equiv` for the same map on arbitrary modules.
-/
def to_linear_equiv' (P : matrix n n R) (h : invertible P) : (n → R) ≃ₗ[R] (n → R) :=
{ inv_fun   := (⅟P).to_lin',
  left_inv  := λ v,
    show ((⅟P).to_lin'.comp P.to_lin') v = v,
    by rw [← matrix.to_lin'_mul, P.inv_of_mul_self, matrix.to_lin'_one, linear_map.id_apply],
  right_inv := λ v,
    show (P.to_lin'.comp (⅟P).to_lin') v = v,
    by rw [← matrix.to_lin'_mul, P.mul_inv_of_self, matrix.to_lin'_one, linear_map.id_apply],
  ..P.to_lin' }

@[simp]

@[simp] lemma to_linear_equiv'_symm_apply (P : matrix n n R) (h : invertible P) :
  (↑(P.to_linear_equiv' h).symm : module.End R (n → R)) = P⁻¹.to_lin' :=
show (⅟P).to_lin' = _, from congr_arg _ P.inv_of_eq_nonsing_inv

end to_linear_equiv'

section to_linear_equiv

variables (b : basis n R M)

include b

/-- Given `hA : is_unit A.det` and `b : basis R b`, `A.to_linear_equiv b hA` is
the `linear_equiv` arising from `to_lin b b A`.

See `matrix.to_linear_equiv'` for this result on `n → R`.
-/
@[simps apply]
noncomputable def to_linear_equiv [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  M ≃ₗ[R] M :=
begin
  refine
  { to_fun := to_lin b b A,
    inv_fun := to_lin b b A⁻¹,
    left_inv := λ x, _,
    right_inv := λ x, _,
    .. to_lin b b A };
  rw ← linear_map.comp_apply;
  simp only [← matrix.to_lin_mul b b b,
             matrix.nonsing_inv_mul _ hA, matrix.mul_nonsing_inv _ hA,
             to_lin_one, linear_map.id_apply]
end

lemma ker_to_lin_eq_bot [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  (to_lin b b A).ker = ⊥ :=
ker_eq_bot.mpr (to_linear_equiv b A hA).injective

lemma range_to_lin_eq_top [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  (to_lin b b A).range = ⊤ :=
range_eq_top.mpr (to_linear_equiv b A hA).surjective

end to_linear_equiv

section nondegenerate

open_locale matrix

/-- This holds for all integral domains (see `matrix.exists_mul_vec_eq_zero_iff`),
not just fields, but it's easier to prove it for the field of fractions first. -/
lemma exists_mul_vec_eq_zero_iff_aux {K : Type*} [decidable_eq n] [field K] {M : matrix n n K} :
  (∃ (v ≠ 0), M.mul_vec v = 0) ↔ M.det = 0 :=
begin
  split,
  { rintros ⟨v, hv, mul_eq⟩,
    contrapose! hv,
    exact eq_zero_of_mul_vec_eq_zero hv mul_eq },
  { contrapose!,
    intros h,
    have : function.injective M.to_lin',
    { simpa only [← linear_map.ker_eq_bot, ker_to_lin'_eq_bot_iff, not_imp_not] using h },
    have : M ⬝ linear_map.to_matrix'
      ((linear_equiv.of_injective_endo M.to_lin' this).symm : (n → K) →ₗ[K] (n → K)) = 1,
    { refine matrix.to_lin'.injective (linear_map.ext $ λ v, _),
      rw [matrix.to_lin'_mul, matrix.to_lin'_one, matrix.to_lin'_to_matrix', linear_map.comp_apply],
      exact (linear_equiv.of_injective_endo M.to_lin' this).apply_symm_apply v },
    exact matrix.det_ne_zero_of_right_inverse this }
end

lemma exists_mul_vec_eq_zero_iff' {A : Type*} (K : Type*) [decidable_eq n]
  [comm_ring A] [is_domain A]
  [field K] [algebra A K] [is_fraction_ring A K]
  {M : matrix n n A} :
  (∃ (v ≠ 0), M.mul_vec v = 0) ↔ M.det = 0 :=
begin
  have : (∃ (v ≠ 0), mul_vec ((algebra_map A K).map_matrix M) v = 0) ↔ _ :=
    exists_mul_vec_eq_zero_iff_aux,
  rw [← ring_hom.map_det, is_fraction_ring.to_map_eq_zero_iff] at this,
  refine iff.trans _ this, split; rintro ⟨v, hv, mul_eq⟩,
  { refine ⟨λ i, algebra_map _ _ (v i), mt (λ h, funext $ λ i, _) hv, _⟩,
    { exact is_fraction_ring.to_map_eq_zero_iff.mp (congr_fun h i) },
    { ext i,
      refine (ring_hom.map_mul_vec _ _ _ i).symm.trans _,
      rw [mul_eq, pi.zero_apply, ring_hom.map_zero, pi.zero_apply] } },
  { letI := classical.dec_eq K,
    obtain ⟨⟨b, hb⟩, ba_eq⟩ := is_localization.exist_integer_multiples_of_finset
      (non_zero_divisors A) (finset.univ.image v),
    choose f hf using ba_eq,
    refine ⟨λ i, f _ (finset.mem_image.mpr ⟨i, finset.mem_univ i, rfl⟩),
            mt (λ h, funext $ λ i, _) hv, _⟩,
    { have := congr_arg (algebra_map A K) (congr_fun h i),
      rw [hf, subtype.coe_mk, pi.zero_apply, ring_hom.map_zero, algebra.smul_def,
          mul_eq_zero, is_fraction_ring.to_map_eq_zero_iff] at this,
      exact this.resolve_left (mem_non_zero_divisors_iff_ne_zero.mp hb), },
    { ext i,
      refine is_fraction_ring.injective A K _,
      calc algebra_map A K (M.mul_vec (λ (i : n), f (v i) _) i)
          = ((algebra_map A K).map_matrix M).mul_vec
              (algebra_map _ K b • v) i : _
      ... = 0 : _
      ... = algebra_map A K 0 : (ring_hom.map_zero _).symm,
      { simp_rw [ring_hom.map_mul_vec, mul_vec, dot_product, function.comp_app, hf,
          subtype.coe_mk, ring_hom.map_matrix_apply, pi.smul_apply, smul_eq_mul,
          algebra.smul_def] },
      { rw [mul_vec_smul, mul_eq, pi.smul_apply, pi.zero_apply, smul_zero] } } },
end

lemma exists_mul_vec_eq_zero_iff {A : Type*} [decidable_eq n] [comm_ring A] [is_domain A]
  {M : matrix n n A} :
  (∃ (v ≠ 0), M.mul_vec v = 0) ↔ M.det = 0 :=
exists_mul_vec_eq_zero_iff' (fraction_ring A)

lemma exists_vec_mul_eq_zero_iff {A : Type*} [decidable_eq n] [comm_ring A] [is_domain A]
  {M : matrix n n A} :
  (∃ (v ≠ 0), M.vec_mul v = 0) ↔ M.det = 0 :=
by simpa only [← M.det_transpose, ← mul_vec_transpose] using exists_mul_vec_eq_zero_iff

theorem nondegenerate_iff_det_ne_zero {A : Type*} [decidable_eq n] [comm_ring A] [is_domain A]
  {M : matrix n n A} :
  nondegenerate M ↔ M.det ≠ 0 :=
begin
  refine iff.trans _ (not_iff_not.mpr exists_vec_mul_eq_zero_iff),
  simp only [not_exists],
  split,
  { intros hM v hv hMv,
    obtain ⟨w, hwMv⟩ := hM.exists_not_ortho_of_ne_zero hv,
    simpa only [dot_product_mul_vec, hMv, zero_dot_product] using hwMv },
  { intros h v hv,
    refine not_imp_not.mp (h v) (funext $ λ i, _),
    simpa only [dot_product_mul_vec, dot_product_single, mul_one] using hv (pi.single i 1) }
end

alias nondegenerate_iff_det_ne_zero ↔
  matrix.nondegenerate.det_ne_zero matrix.nondegenerate.of_det_ne_zero

end nondegenerate

end matrix


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

! This file was ported from Lean 3 source module dynamics.fixed_points.basic
! leanprover-community/mathlib commit b86832321b586c6ac23ef8cdef6a7a27e42b13bd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Function
import Mathbin.Logic.Function.Iterate
import Mathbin.GroupTheory.Perm.Basic

/-!
# Fixed points of a self-map

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

In this file we define

* the predicate `is_fixed_pt f x := f x = x`;
* the set `fixed_points f` of fixed points of a self-map `f`.

We also prove some simple lemmas about `is_fixed_pt` and `∘`, `iterate`, and `semiconj`.

## Tags

fixed point
-/

open Equiv

universe u v

variable {α : Type u} {β : Type v} {f fa g : α → α} {x y : α} {fb : β → β} {m n k : ℕ} {e : Perm α}

namespace Function

#print Function.IsFixedPt /-
/-- A point `x` is a fixed point of `f : α → α` if `f x = x`. -/
def IsFixedPt (f : α → α) (x : α) :=
  f x = x
#align function.is_fixed_pt Function.IsFixedPt
-/

#print Function.isFixedPt_id /-
/-- Every point is a fixed point of `id`. -/
theorem isFixedPt_id (x : α) : IsFixedPt id x :=
  (rfl : _)
#align function.is_fixed_pt_id Function.isFixedPt_id
-/

namespace IsFixedPt

instance [h : DecidableEq α] {f : α → α} {x : α} : Decidable (IsFixedPt f x) :=
  h (f x) x

#print Function.IsFixedPt.eq /-
/-- If `x` is a fixed point of `f`, then `f x = x`. This is useful, e.g., for `rw` or `simp`.-/
protected theorem eq (hf : IsFixedPt f x) : f x = x :=
  hf
#align function.is_fixed_pt.eq Function.IsFixedPt.eq
-/

#print Function.IsFixedPt.comp /-
/-- If `x` is a fixed point of `f` and `g`, then it is a fixed point of `f ∘ g`. -/
protected theorem comp (hf : IsFixedPt f x) (hg : IsFixedPt g x) : IsFixedPt (f ∘ g) x :=
  calc
    f (g x) = f x := congr_arg f hg
    _ = x := hf

#align function.is_fixed_pt.comp Function.IsFixedPt.comp
-/

#print Function.IsFixedPt.iterate /-
/-- If `x` is a fixed point of `f`, then it is a fixed point of `f^[n]`. -/
protected theorem iterate (hf : IsFixedPt f x) (n : ℕ) : IsFixedPt (f^[n]) x :=
  iterate_fixed hf n
#align function.is_fixed_pt.iterate Function.IsFixedPt.iterate
-/

#print Function.IsFixedPt.left_of_comp /-
/-- If `x` is a fixed point of `f ∘ g` and `g`, then it is a fixed point of `f`. -/
theorem left_of_comp (hfg : IsFixedPt (f ∘ g) x) (hg : IsFixedPt g x) : IsFixedPt f x :=
  calc
    f x = f (g x) := congr_arg f hg.symm
    _ = x := hfg

#align function.is_fixed_pt.left_of_comp Function.IsFixedPt.left_of_comp
-/

#print Function.IsFixedPt.to_leftInverse /-
/-- If `x` is a fixed point of `f` and `g` is a left inverse of `f`, then `x` is a fixed
point of `g`. -/
theorem to_leftInverse (hf : IsFixedPt f x) (h : LeftInverse g f) : IsFixedPt g x :=
  calc
    g x = g (f x) := congr_arg g hf.symm
    _ = x := h x

#align function.is_fixed_pt.to_left_inverse Function.IsFixedPt.to_leftInverse
-/

#print Function.IsFixedPt.map /-
/-- If `g` (semi)conjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
protected theorem map {x : α} (hx : IsFixedPt fa x) {g : α → β} (h : Semiconj g fa fb) :
    IsFixedPt fb (g x) :=
  calc
    fb (g x) = g (fa x) := (h.Eq x).symm
    _ = g x := congr_arg g hx

#align function.is_fixed_pt.map Function.IsFixedPt.map
-/

#print Function.IsFixedPt.apply /-
protected theorem apply {x : α} (hx : IsFixedPt f x) : IsFixedPt f (f x) := by convert hx
#align function.is_fixed_pt.apply Function.IsFixedPt.apply
-/

#print Function.IsFixedPt.preimage_iterate /-
theorem preimage_iterate {s : Set α} (h : IsFixedPt (Set.preimage f) s) (n : ℕ) :
    IsFixedPt (Set.preimage (f^[n])) s :=
  by
  rw [Set.preimage_iterate_eq]
  exact h.iterate n
#align function.is_fixed_pt.preimage_iterate Function.IsFixedPt.preimage_iterate
-/

#print Function.IsFixedPt.equiv_symm /-
protected theorem equiv_symm (h : IsFixedPt e x) : IsFixedPt e.symm x :=
  h.to_leftInverse e.leftInverse_symm
#align function.is_fixed_pt.equiv_symm Function.IsFixedPt.equiv_symm
-/

#print Function.IsFixedPt.perm_inv /-
protected theorem perm_inv (h : IsFixedPt e x) : IsFixedPt (⇑e⁻¹) x :=
  h.equiv_symm
#align function.is_fixed_pt.perm_inv Function.IsFixedPt.perm_inv
-/

#print Function.IsFixedPt.perm_pow /-
protected theorem perm_pow (h : IsFixedPt e x) (n : ℕ) : IsFixedPt (⇑(e ^ n)) x :=
  by
  rw [Equiv.Perm.coe_pow]
  exact h.iterate _
#align function.is_fixed_pt.perm_pow Function.IsFixedPt.perm_pow
-/

#print Function.IsFixedPt.perm_zpow /-
protected theorem perm_zpow (h : IsFixedPt e x) : ∀ n : ℤ, IsFixedPt (⇑(e ^ n)) x
  | Int.ofNat n => h.perm_pow _
  | Int.negSucc n => (h.perm_pow <| n + 1).perm_inv
#align function.is_fixed_pt.perm_zpow Function.IsFixedPt.perm_zpow
-/

end IsFixedPt

#print Function.Injective.isFixedPt_apply_iff /-
@[simp]
theorem Injective.isFixedPt_apply_iff (hf : Injective f) {x : α} :
    IsFixedPt f (f x) ↔ IsFixedPt f x :=
  ⟨fun h => hf h.Eq, IsFixedPt.apply⟩
#align function.injective.is_fixed_pt_apply_iff Function.Injective.isFixedPt_apply_iff
-/

#print Function.fixedPoints /-
/-- The set of fixed points of a map `f : α → α`. -/
def fixedPoints (f : α → α) : Set α :=
  { x : α | IsFixedPt f x }
#align function.fixed_points Function.fixedPoints
-/

#print Function.fixedPoints.decidable /-
instance fixedPoints.decidable [DecidableEq α] (f : α → α) (x : α) :
    Decidable (x ∈ fixedPoints f) :=
  IsFixedPt.decidable
#align function.fixed_points.decidable Function.fixedPoints.decidable
-/

#print Function.mem_fixedPoints /-
@[simp]
theorem mem_fixedPoints : x ∈ fixedPoints f ↔ IsFixedPt f x :=
  Iff.rfl
#align function.mem_fixed_points Function.mem_fixedPoints
-/

#print Function.mem_fixedPoints_iff /-
theorem mem_fixedPoints_iff {α : Type _} {f : α → α} {x : α} : x ∈ fixedPoints f ↔ f x = x := by rfl
#align function.mem_fixed_points_iff Function.mem_fixedPoints_iff
-/

#print Function.fixedPoints_id /-
@[simp]
theorem fixedPoints_id : fixedPoints (@id α) = Set.univ :=
  Set.ext fun _ => by simpa using is_fixed_pt_id _
#align function.fixed_points_id Function.fixedPoints_id
-/

#print Function.fixedPoints_subset_range /-
theorem fixedPoints_subset_range : fixedPoints f ⊆ Set.range f := fun x hx => ⟨x, hx⟩
#align function.fixed_points_subset_range Function.fixedPoints_subset_range
-/

#print Function.Semiconj.mapsTo_fixedPoints /-
/-- If `g` semiconjugates `fa` to `fb`, then it sends fixed points of `fa` to fixed points
of `fb`. -/
theorem Semiconj.mapsTo_fixedPoints {g : α → β} (h : Semiconj g fa fb) :
    Set.MapsTo g (fixedPoints fa) (fixedPoints fb) := fun x hx => hx.map h
#align function.semiconj.maps_to_fixed_pts Function.Semiconj.mapsTo_fixedPoints
-/

#print Function.invOn_fixedPoints_comp /-
/-- Any two maps `f : α → β` and `g : β → α` are inverse of each other on the sets of fixed points
of `f ∘ g` and `g ∘ f`, respectively. -/
theorem invOn_fixedPoints_comp (f : α → β) (g : β → α) :
    Set.InvOn f g (fixedPoints <| f ∘ g) (fixedPoints <| g ∘ f) :=
  ⟨fun x => id, fun x => id⟩
#align function.inv_on_fixed_pts_comp Function.invOn_fixedPoints_comp
-/

#print Function.mapsTo_fixedPoints_comp /-
/-- Any map `f` sends fixed points of `g ∘ f` to fixed points of `f ∘ g`. -/
theorem mapsTo_fixedPoints_comp (f : α → β) (g : β → α) :
    Set.MapsTo f (fixedPoints <| g ∘ f) (fixedPoints <| f ∘ g) := fun x hx => hx.map fun x => rfl
#align function.maps_to_fixed_pts_comp Function.mapsTo_fixedPoints_comp
-/

#print Function.bijOn_fixedPoints_comp /-
/-- Given two maps `f : α → β` and `g : β → α`, `g` is a bijective map between the fixed points
of `f ∘ g` and the fixed points of `g ∘ f`. The inverse map is `f`, see `inv_on_fixed_pts_comp`. -/
theorem bijOn_fixedPoints_comp (f : α → β) (g : β → α) :
    Set.BijOn g (fixedPoints <| f ∘ g) (fixedPoints <| g ∘ f) :=
  (invOn_fixedPoints_comp f g).BijOn (mapsTo_fixedPoints_comp g f) (mapsTo_fixedPoints_comp f g)
#align function.bij_on_fixed_pts_comp Function.bijOn_fixedPoints_comp
-/

#print Function.Commute.invOn_fixedPoints_comp /-
/-- If self-maps `f` and `g` commute, then they are inverse of each other on the set of fixed points
of `f ∘ g`. This is a particular case of `function.inv_on_fixed_pts_comp`. -/
theorem Commute.invOn_fixedPoints_comp (h : Commute f g) :
    Set.InvOn f g (fixedPoints <| f ∘ g) (fixedPoints <| f ∘ g) := by
  simpa only [h.comp_eq] using inv_on_fixed_pts_comp f g
#align function.commute.inv_on_fixed_pts_comp Function.Commute.invOn_fixedPoints_comp
-/

#print Function.Commute.left_bijOn_fixedPoints_comp /-
/-- If self-maps `f` and `g` commute, then `f` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
theorem Commute.left_bijOn_fixedPoints_comp (h : Commute f g) :
    Set.BijOn f (fixedPoints <| f ∘ g) (fixedPoints <| f ∘ g) := by
  simpa only [h.comp_eq] using bij_on_fixed_pts_comp g f
#align function.commute.left_bij_on_fixed_pts_comp Function.Commute.left_bijOn_fixedPoints_comp
-/

#print Function.Commute.right_bijOn_fixedPoints_comp /-
/-- If self-maps `f` and `g` commute, then `g` is bijective on the set of fixed points of `f ∘ g`.
This is a particular case of `function.bij_on_fixed_pts_comp`. -/
theorem Commute.right_bijOn_fixedPoints_comp (h : Commute f g) :
    Set.BijOn g (fixedPoints <| f ∘ g) (fixedPoints <| f ∘ g) := by
  simpa only [h.comp_eq] using bij_on_fixed_pts_comp f g
#align function.commute.right_bij_on_fixed_pts_comp Function.Commute.right_bijOn_fixedPoints_comp
-/

end Function


/-
Copyright (c) 2022 André Hernandez-Espiet. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : André Hernandez-Espiet
-/

import data.set.finite
import tactic.linarith

/-!
# Synthetic Geometry, Euclid's Elements Book I using Avigad Axioms
In this file we ...

## Main definitions
* `incidence_geometry` : class containing axioms...

## Main results
* `pythagorean_theorem` : The Pythagorean theorem
## Tags
synthetic geometry, Euclid elements
-/

universes u1 u2 u3 u4 u5 u6
class incidence_geometry :=
(point : Type u1)
(line : Type u2)
(circle : Type u3)
(length_type : Type u4)
(angle_type : Type u5)
(area_type : Type u6)
[len_ins : linear_ordered_comm_ring length_type]
[angle_ins : linear_ordered_comm_ring angle_type]
[area_ins : linear_ordered_comm_ring area_type]
(online : point → line → Prop)
(B : point → point → point → Prop) -- Betweenness
(sameside : point → point → line → Prop)
(center_circle : point → circle → Prop)
(in_circle : point → circle → Prop)
(on_circle : point → circle → Prop)
(lines_inter : line → line → Prop)
(line_circle_inter : line → circle → Prop)
(circles_inter : circle → circle → Prop)
(length : point → point → length_type)
(angle : point → point → point → angle_type)
(rightangle : angle_type)
(area : point → point → point → area_type)

(more_pts : ∀ (S : set point), S.finite → ∃ (a : point), a ∉ S)
(pt_B_of_ne : ∀ {b c : point}, b ≠ c → ∃ (a : point), B b a c)
(pt_extension_of_ne : ∀ {b c : point}, b ≠ c → ∃ (a : point), B b c a)
(diffside_of_not_online : ∀ {L : line}, ∀ {a : point}, ¬online a L →
  ∃ (b : point), ¬online b L ∧ ¬sameside a b L)
(line_of_pts : ∀ (a b : point), ∃ (L : line), online a L ∧ online b L)
(circle_of_ne : ∀ {a b : point}, a ≠ b → ∃ (α : circle), center_circle a α ∧ on_circle b α)
(pt_of_lines_inter : ∀ {L M : line}, lines_inter L M → ∃ (a : point), online a L ∧ online a M)
(pts_of_line_circle_inter : ∀ {L : line}, ∀ {α : circle}, line_circle_inter L α →
  ∃ (a b : point), a ≠ b ∧ online a L ∧ online b L ∧ on_circle a α ∧ on_circle b α)
(pt_oncircle_of_inside_outside : ∀ {b c : point}, ∀ {α : circle}, ¬on_circle c α → in_circle b α →
  ¬in_circle c α → ∃ (a : point), B b a c ∧ on_circle a α)
(pt_oncircle_of_inside_ne : ∀ {a b : point}, ∀ {α : circle}, a ≠ b → in_circle b α →
  ∃ (c : point), B a b c ∧ on_circle c α)
(pts_of_circles_inter : ∀ {α β : circle}, circles_inter α β →
  ∃ (a b : point), a ≠ b ∧ on_circle a α ∧ on_circle a β ∧ on_circle b α ∧ on_circle b β)
(pt_sameside_of_circles_inter : ∀ {b c d : point}, ∀ {L : line}, ∀ {α β : circle},
  online c L → online d L → ¬online b L → center_circle c α → center_circle d β → circles_inter α β
  → ∃ (a : point), sameside a b L ∧ on_circle a α ∧ on_circle a β)
(line_unique_of_pts : ∀ {a b : point}, ∀ {L M : line}, a ≠ b → online a L → online b L →
  online a M → online b M → L = M)
(center_circle_unique : ∀ {a b : point}, ∀ {α : circle}, center_circle a α → center_circle b α →
  a = b)
(inside_circle_of_center : ∀ {a : point}, ∀ {α : circle}, center_circle a α → in_circle a α)
(not_oncircle_of_inside : ∀ {a : point}, ∀ {α : circle}, in_circle a α → ¬on_circle a α)
(B_symm : ∀ {a b c : point}, B a b c → B c b a)
(ne_12_of_B : ∀ {a b c : point}, B a b c → a ≠ b)
(ne_13_of_B : ∀ {a b c : point}, B a b c → a ≠ c)
(ne_23_of_B : ∀ {a b c : point}, B a b c → b ≠ c)
(not_B_of_B : ∀ {a b c : point}, B a b c → ¬B b a c)
(online_3_of_B : ∀ {a b c : point}, ∀ {L : line}, B a b c → online a L → online b L → online c L)
(online_2_of_B : ∀ {a b c : point}, ∀ {L : line}, B a b c → online a L → online c L → online b L)
(B124_of_B134_B123 : ∀ {a b c d : point}, B a b c → B a d b → B a d c)
(B124_of_B123_B234 : ∀ {a b c d : point}, B a b c → B b c d → B a b d)
(B_of_three_online_ne : ∀ {a b c : point}, ∀ {L : line}, a ≠ b → a ≠ c → b ≠ c → online a L →
  online b L → online c L → B a b c ∨ B b a c ∨ B a c b)
(not_B324_of_B123_B124 : ∀ {a b c d : point}, B a b c → B a b d → ¬B c b d)
(sameside_rfl_of_not_online : ∀ {a : point}, ∀ {L : line}, ¬online a L → sameside a a L)
(sameside_symm : ∀ {a b : point}, ∀ {L : line}, sameside a b L → sameside b a L)
(not_online_of_sameside : ∀ {a b : point}, ∀ {L : line}, sameside a b L → ¬online a L)
(sameside_trans : ∀ {a b c : point}, ∀ {L : line}, sameside a b L → sameside a c L → sameside b c L)
(sameside_or_of_diffside : ∀ {a b c : point}, ∀ {L : line}, ¬online a L → ¬online b L →
  ¬online c L → ¬sameside a b L → sameside a c L ∨ sameside b c L)
(sameside12_of_B123_sameside13 : ∀ {a b c : point}, ∀ {L : line}, B a b c → sameside a c L →
  sameside a b L)
(sameside23_of_B123_online1_not_online2 : ∀ {a b c : point}, ∀ {L : line}, online a L →
  ¬online b L → B a b c → sameside b c L)
(not_sameside13_of_B123_online2 : ∀ {a b c : point}, ∀ {L : line}, online b L → B a b c →
  ¬sameside a c L)
(B_of_online_inter : ∀ {a b c : point}, ∀ {L M : line}, a ≠ b → b ≠ c → a ≠ c → L ≠ M →
  online a M → online b M → online c M → online b L → ¬sameside a c L → B a b c)
(not_sameside_of_sameside_sameside : ∀ {a b c d : point}, ∀ {L M N : line}, online a L →
  online a M → online a N → online b L → online c M → online d N → sameside c d L →
  sameside b c N → ¬sameside b d M)
(sameside_of_sameside_not_sameside : ∀ {a b c d : point}, ∀ {L M N : line}, a ≠ b → online a L →
  online a M → online a N → online b L → online c M → online d N → ¬online d M → sameside c d L →
  ¬sameside b d M → sameside b c N)
(B_of_line_circle_inter : ∀ {a b c : point}, ∀ {L : line}, ∀ {α : circle}, b ≠ c →
  online a L → online b L → online c L → on_circle b α → on_circle c α → in_circle a α → B b a c)
(not_sameside_of_circle_inter : ∀ {a b c d : point}, ∀ {L : line}, ∀ {α β : circle}, c ≠ d →
  α ≠ β → online a L → online b L → center_circle a α → center_circle b β → on_circle c α →
  on_circle c β → on_circle d α → on_circle d β → circles_inter α β → ¬sameside c d L)
(lines_inter_of_not_sameside : ∀ {a b : point}, ∀ {L M : line}, online a M → online b M →
  ¬sameside a b L → lines_inter L M)
(line_circle_inter_of_not_sameside : ∀ {a b : point}, ∀ {L : line}, ∀ {α : circle}, ¬sameside a b L
  → on_circle a α ∨ in_circle a α → on_circle b α ∨ in_circle b α → line_circle_inter L α)
(line_circle_inter_of_inside_online : ∀ {a : point}, ∀ {L : line}, ∀ {α : circle}, online a L →
  in_circle a α → line_circle_inter L α)
(circles_inter_of_inside_oncircle : ∀ {a b : point}, ∀ {α β : circle}, on_circle b α →
  on_circle a β → in_circle a α → in_circle b β → circles_inter α β)
(length_eq_zero_iff : ∀ {a b : point}, length a b = 0 ↔ a = b)
(length_symm : ∀ (a b : point), length a b = length b a)
(angle_symm : ∀ (a b c : point), angle a b c = angle c b a)
(angle_nonneg : ∀ (a b c : point), 0 ≤ angle a b c)
(length_nonneg : ∀ (a b : point), 0 ≤ length a b)
(degenerate_area : ∀ (a b : point), area a a b = 0)
(area_invariant : ∀ (a b c : point), area a b c = area c a b ∧ area a b c = area a c b)
(area_eq_of_SSS : ∀ {a b c a1 b1 c1 : point}, length a b = length a1 b1 →
  length b c = length b1 c1 → length c a = length c1 a1 → area a b c = area a1 b1 c1)
(length_sum_of_B : ∀ {a b c : point}, B a b c → length a b + length b c = length a c)
(oncircle_iff_length_eq : ∀ {a b c : point}, ∀ {α : circle}, center_circle a α → on_circle b α →
  (length a b = length a c ↔ on_circle c α))
(incircle_iff_length_lt : ∀ {a b c : point}, ∀ {α : circle}, center_circle a α → on_circle b α →
  (length a c < length a b ↔ in_circle c α))
(angle_zero_iff_online : ∀ {a b c : point}, ∀ {L : line}, a ≠ b → a ≠ c → online a L → online b L →
  (online c L ∧ ¬B b a c ↔ angle b a c = 0))
(angle_add_iff_sameside : ∀ {a b c d : point}, ∀ {L M : line}, a ≠ b → a ≠ c → L ≠ M → online a L →
  online b L → online a M → online c M → ¬online d M → ¬online d L →
  (angle b a c = angle b a d + angle d a c ↔ sameside b d M ∧ sameside c d L))
(angle_eq_iff_rightangle : ∀ {a b c d : point}, ∀ {L : line}, online a L → online b L →
  ¬online d L → B a c b → (angle a c d = angle d c b ↔ angle a c d = rightangle))
(angle_extension : ∀ {a b c a1 b1 c1 : point}, ∀ {L M : line}, b ≠ a → b1 ≠ a → c ≠ a → c1 ≠ a →
  online a L → online b L → online b1 L → online a M → online c M → online c1 M → ¬B b a b1 →
  ¬B c a c1 → angle b a c = angle b1 a1 c1)
(unparallel_postulate : ∀ {a b c d : point}, ∀ {L M N : line}, b ≠ c → online a L → online b L →
  online b M → online c M → online c N → online d N →  sameside a d M →
  angle a b c + angle b c d < 2 * rightangle →
  ∃ (e : point), online e L ∧ online e N ∧ sameside e a M)
(area_zero_iff_online : ∀ {a b c : point}, ∀ {L : line}, a ≠ b → online a L → online b L →
  (area a b c = 0 ↔ online c L))
(area_add_iff_B : ∀ {a b c d : point}, ∀ {L : line}, a ≠ b → b ≠ c → c ≠ a → online a L →
  online b L → online c L → ¬online d L → (B a c b ↔ area a c d + area d c b = area a d b))
(SAS_iff_SSS : ∀ {a b c d e f : point}, length a b = length d e → length a c = length d f →
  (angle b a c = angle e d f ↔ length b c = length e f)) --Euclid Prop 4, 8

open incidence_geometry

variables [i : incidence_geometry] {a b c d e f g h j k l : i.point} {L M N O P Q : i.line}
  {α β : i.circle} {la : length_type}

attribute [instance] incidence_geometry.len_ins
attribute [instance] incidence_geometry.angle_ins
attribute [instance] incidence_geometry.area_ins

include i

-------------------------------------------------- Definitions -------------------------------------
def diffside (a b : point) (L : line) := ¬online a L ∧ ¬online b L ∧ ¬sameside a b L
--3/28/23
def out_circle (a : point) (α : circle) := ¬on_circle a α ∧ ¬in_circle a α

def colinear (a b c : point) := ∃ L : line, online a L ∧ online b L ∧ online c L

def triangle (a b c : point) := ¬colinear a b c

def eq_tri (a b c : point) := triangle a b c ∧ length a b = length a c ∧ length b a = length b c
  ∧ length c a = length c b
-------------------------------------------------- API ---------------------------------------------
theorem online_of_line (L : line) : ∃ (a : point), online a L :=
  by rcases more_pts ∅ set.finite_empty with ⟨a, -⟩; exact classical.by_cases
  (λ aL, by use a; exact aL) (λ aL, by rcases diffside_of_not_online aL with ⟨b, -, abL⟩;
  rcases line_of_pts a b with ⟨M, aM, bM⟩; rcases pt_of_lines_inter
  (lines_inter_of_not_sameside aM bM abL) with ⟨c, cL, -⟩; exact ⟨c, cL⟩)

theorem online_ne_of_line (L : line) : ∃ (a b : point), a ≠ b ∧ online a L ∧ online b L :=
  by rcases online_of_line L with ⟨a, aL⟩; rcases more_pts {a} (set.finite_singleton a) with ⟨b, hb⟩;
  rcases circle_of_ne (by refine ne_of_mem_of_not_mem (set.mem_singleton a) hb) with ⟨α, acen, -⟩;
  rcases pts_of_line_circle_inter (line_circle_inter_of_inside_online aL
  (inside_circle_of_center acen)) with ⟨c, d, cd, cL, dL, -, -⟩; exact ⟨c, d, cd, cL, dL⟩

lemma len_pos_of_nq (ab : a ≠ b) : 0 < length a b :=
  (ne.symm (not_imp_not.mpr length_eq_zero_iff.mp ab)).le_iff_lt.mp (length_nonneg a b)

theorem ne_of_ne_len (ab : a ≠ b) (ab_cd : length a b = length c d) : c ≠ d :=
  λ ac, by linarith[length_eq_zero_iff.mpr ac, len_pos_of_nq ab]

theorem ne_of_ne_len' (cd : c ≠ d) (ab_cd : length a b = length c d) : a ≠ b := --3/28/23
  ne_of_ne_len cd (ab_cd.symm)

theorem length_sum_perm_of_B (Babc : B a b c) : 0 < length a b ∧ 0 < length b a ∧ 0 < length b c
  ∧ 0 < length c b ∧ 0 < length a c ∧ 0 < length c a ∧ length a b + length b c = length a c ∧
  length b a + length b c = length a c ∧ length b a + length c b = length a c ∧
  length b a + length b c = length c a ∧ length b a + length c b = length c a ∧
  length a b + length c b = length a c ∧ length a b + length b c = length c a ∧
  length a b + length c b = length c a :=
⟨len_pos_of_nq (ne_12_of_B Babc), by linarith[length_symm a b,
  len_pos_of_nq (ne_12_of_B Babc)], len_pos_of_nq (ne_23_of_B Babc), by linarith[length_symm b c,
  len_pos_of_nq (ne_23_of_B Babc)], len_pos_of_nq (ne_13_of_B Babc), by linarith[length_symm a c,
  len_pos_of_nq (ne_13_of_B Babc)], by repeat {split}; repeat {linarith[length_sum_of_B Babc,
  length_symm a b, length_symm a c, length_symm b c]}⟩

theorem length_perm_of_3pts (a b c : point) : length a b = length b a ∧ length a c = length c a ∧
  length b c = length c b := ⟨length_symm a b, length_symm a c, length_symm b c⟩

theorem not_online_of_line (L : line) : ∃ (a : point), ¬online a L :=
  by rcases online_ne_of_line L with ⟨b, c, bc, bL, cL⟩; rcases circle_of_ne bc with ⟨α, bα, cα⟩;
  rcases circle_of_ne bc.symm with ⟨β, cβ, bβ⟩; rcases pts_of_circles_inter
  (circles_inter_of_inside_oncircle cα bβ (inside_circle_of_center bα) (inside_circle_of_center
  cβ)) with ⟨a, -, -, aα, aβ, -, -⟩; have bc_ba := (oncircle_iff_length_eq bα cα).mpr aα;
  have cb_ca := (oncircle_iff_length_eq cβ bβ).mpr aβ; exact ⟨a, λ aL, ((by push_neg; repeat
  {split}; repeat {exact (λ Bet, by linarith[length_sum_perm_of_B Bet])}) : ¬ (B b c a ∨ B c b a ∨
  B b a c)) (B_of_three_online_ne bc (ne_of_ne_len bc bc_ba)(ne_of_ne_len bc.symm cb_ca) bL cL aL)⟩

theorem online_of_circles_inter (aα : center_circle a α) (bβ : center_circle b β)
  (αβ : circles_inter α β) : ∃ (c : point) (L : line), online a L ∧ online b L ∧ on_circle c α ∧
  on_circle c β ∧ ¬online c L :=
by rcases line_of_pts a b with ⟨L, aL, bL⟩; rcases not_online_of_line L with ⟨d, dL⟩;
  rcases pt_sameside_of_circles_inter aL bL dL aα bβ αβ with ⟨c, cdL, cα, cβ⟩;
  exact ⟨c, L, aL, bL, cα, cβ, not_online_of_sameside cdL⟩

theorem not_sameside_symm (abL : ¬sameside a b L) : ¬sameside b a L := λ baL,
  abL (sameside_symm baL)

lemma diffside_symm (abL : diffside a b L) : diffside b a L :=
  ⟨abL.2.1, abL.1, (not_sameside_symm abL.2.2)⟩

theorem diffside_of_sameside_diffside (abL : sameside a b L) (acL : diffside a c L) :
  diffside b c L :=
by by_contra; unfold diffside at h; push_neg at h; exact acL.2.2
  (sameside_trans (sameside_symm abL) (h (not_online_of_sameside (sameside_symm abL)) acL.2.1))

theorem diffside_of_circles_inter (aα : center_circle a α) (bβ : center_circle b β)
  (αβ : circles_inter α β) : ∃ (c d : point) (L : line), online a L ∧ online b L ∧ on_circle c α ∧
  on_circle c β ∧ on_circle d α ∧ on_circle d β ∧ diffside c d L :=
by rcases online_of_circles_inter aα bβ αβ with ⟨c, L, aL, bL, cα, cβ, cL⟩;
  rcases diffside_of_not_online cL with ⟨e, eL, ceL⟩; rcases pt_sameside_of_circles_inter aL bL eL
  aα bβ αβ with ⟨d, deL, dα, dβ⟩; exact ⟨c, d, L, aL, bL, cα, cβ, dα, dβ, diffside_symm
  (diffside_of_sameside_diffside (sameside_symm deL) ⟨eL, cL, not_sameside_symm ceL⟩)⟩

theorem online_of_3_2_online (ab : a ≠ b) (aL : online a L) (bL : online b L) (cL : online c L)
  (aM : online a M) (bM : online b M) : online c M := by rwa line_unique_of_pts ab aL bL aM bM at cL

theorem triangle_of_ne_online (ab : a ≠ b) (aL : online a L) (bL : online b L) (cL : ¬online c L) :
  triangle a b c :=
λ col, by rcases col with ⟨M, aM, bM, cM⟩; exact cL (online_of_3_2_online ab aM bM cM aL bL)

theorem eq_tri_of_length_online (ab : a ≠ b) (aL : online a L) (bL : online b L) (cL : ¬online c L)
  (ab_ac : length a b = length a c) (bc_ba : length b c = length b a) : eq_tri a b c :=
⟨triangle_of_ne_online ab aL bL cL, by repeat {split}; linarith[length_perm_of_3pts a b c]⟩
--3/23/23
theorem B_circ_of_ne (ab : a ≠ b) (bc : b ≠ c) : ∃ (d : point) (α : circle), B a b d ∧
  center_circle b α ∧ on_circle c α ∧ on_circle d α :=
by rcases circle_of_ne bc with ⟨α, bα, cα⟩; rcases pt_oncircle_of_inside_ne ab
  (inside_circle_of_center bα) with ⟨d, Babd, dα⟩; exact ⟨d, α, Babd, bα, cα, dα⟩

theorem online_of_eq (ab : a = b) (aL : online a L) : online b L := by rwa ab at aL

theorem online_of_eq' (ab : a = b) (bL : online b L) : online a L := by rwa ab.symm at bL

theorem ne_23_of_tri (tri: triangle a b c) : b ≠ c :=
  λ bc, by rcases line_of_pts a b with ⟨L, aL, bL⟩; exact tri ⟨L, aL, bL, online_of_eq bc bL⟩

theorem ne_32_of_tri (tri : triangle a b c) : c ≠ b := λ cb, (ne_23_of_tri tri) cb.symm

theorem ne_13_of_tri (tri : triangle a b c) : a ≠ c :=
  λ ac, by rcases line_of_pts a b with ⟨L, aL, bL⟩; exact tri ⟨L, aL, bL, online_of_eq ac aL⟩

theorem ne_31_of_tri (tri : triangle a b c) : c ≠ a := λ ca, (ne_13_of_tri tri) ca.symm

theorem incirc_of_lt (aα : center_circle a α) (bα : on_circle b α)
  (ac_ab : length a c < length a b) : in_circle c α := (incircle_iff_length_lt aα bα).mp ac_ab

theorem B_circ_out_of_B (ab : a ≠ b) (Bacd : B a c d) (ab_ac : length a b = length a c) :
  ∃ (e : point) (α : circle), B a b e ∧ center_circle a α ∧ on_circle d α ∧ on_circle e α :=
by rcases circle_of_ne (ne_13_of_B Bacd) with ⟨α, aα, dα⟩; rcases pt_oncircle_of_inside_ne ab
  (incirc_of_lt aα dα (by linarith[length_sum_perm_of_B Bacd] : length a b < length a d)) with
  ⟨e, Babe, eα⟩; exact ⟨e, α, Babe, aα, dα, eα⟩

theorem length_eq_of_oncircle (aα : center_circle a α) (bα : on_circle b α) (cα : on_circle c α) :
   length a b = length a c := (oncircle_iff_length_eq aα bα).mpr cα
--3/28/23
theorem oncircle_of_oncircle_length (aα : center_circle a α) (bα : on_circle b α)
  (ab_ac : length a b ≠ length a c) : ¬on_circle c α := λ cα, ab_ac (length_eq_of_oncircle aα bα cα)
--3/28/23
theorem incircle_of_oncircle_length (aα : center_circle a α) (bα : on_circle b α)
  (ab_ac : length a b ≤ length a c) : ¬in_circle c α :=
λ c_in_α, by linarith[(incircle_iff_length_lt aα bα).mpr c_in_α]

theorem length_eq_of_B_B (Bdbe: B d b e) (Bdaf : B d a f) (da_db : length d a = length d b)
  (de_df : length d e = length d f):
length a f = length b e := by linarith[length_sum_perm_of_B Bdbe, length_sum_perm_of_B Bdaf]

theorem B_oncircle_of_inside_outside (a_in_α : in_circle a α) (b_out_α : out_circle b α) :
  ∃ (c : point), B a c b ∧ on_circle c α :=
pt_oncircle_of_inside_outside b_out_α.1 a_in_α b_out_α.2
--3/28/23
theorem out_circle_of_lt (aα : center_circle a α) (bα : on_circle b α)
  (ab_lt_ac : length a b < length a c) : out_circle c α :=
⟨oncircle_of_oncircle_length aα bα (by linarith), incircle_of_oncircle_length aα bα (by linarith)⟩
--------------------------------------------Euclid--------------------------------------------------
              /-- Euclid I.1, construction of two equilateral triangles -/
theorem iseqtri_iseqtri_diffside_of_ne (ab : a ≠ b) : ∃ (c d : point), ∃ (L : line), online a L ∧
  online b L ∧ diffside c d L ∧ eq_tri a b c ∧ eq_tri a b d :=
begin
  rcases circle_of_ne ab with ⟨α, aα, bα⟩,
  rcases circle_of_ne (ne.symm ab) with ⟨β, bβ, aβ⟩,
  rcases diffside_of_circles_inter aα bβ  (circles_inter_of_inside_oncircle bα aβ
    (inside_circle_of_center aα) (inside_circle_of_center bβ)) with
    ⟨c, d, L, aL, bL, cα, cβ, dα, dβ, cdL⟩,
  have ab_ac := (oncircle_iff_length_eq aα bα).mpr cα,
  have bc_ba := (oncircle_iff_length_eq bβ cβ).mpr aβ,
  have ab_ad := (oncircle_iff_length_eq aα bα).mpr dα,
  have bd_ba := (oncircle_iff_length_eq bβ dβ).mpr aβ,
  exact ⟨c, d, L, aL, bL, cdL, eq_tri_of_length_online ab aL bL cdL.1 ab_ac bc_ba,
    eq_tri_of_length_online ab aL bL cdL.2.1 ab_ad bd_ba⟩,
end

theorem iseqtri_iseqtri_diffside_of_ne' (ab : a ≠ b) : ∃ (c d : point), ∃ (L : line), online a L ∧
  online b L ∧ diffside c d L ∧ eq_tri a b c ∧ eq_tri a b d :=
begin
  rcases circle_of_ne ab with ⟨α, aα, bα⟩,
  rcases circle_of_ne (ne.symm ab) with ⟨β, bβ, aβ⟩,
  rcases diffside_of_circles_inter aα bβ  (circles_inter_of_inside_oncircle bα aβ
    (inside_circle_of_center aα) (inside_circle_of_center bβ)) with
    ⟨c, d, L, aL, bL, cα, cβ, dα, dβ, cdL⟩,
  --use [c, d, L],
  refine ⟨c, d, L, aL, bL, cdL, _⟩,
  split,
  {
    exact eq_tri_of_length_online ab aL bL cdL.1 ((oncircle_iff_length_eq aα bα).mpr cα)
      ((oncircle_iff_length_eq bβ cβ).mpr aβ),
  },
  have ab_ac := (oncircle_iff_length_eq aα bα).mpr cα,
  have bc_ba := (oncircle_iff_length_eq bβ cβ).mpr aβ,
  have ab_ad := (oncircle_iff_length_eq aα bα).mpr dα,
  have bd_ba := (oncircle_iff_length_eq bβ dβ).mpr aβ,
  exact ⟨c, d, L, aL, bL, cdL, eq_tri_of_length_online ab aL bL cdL.1 ab_ac bc_ba,
    eq_tri_of_length_online ab aL bL cdL.2.1 ab_ad bd_ba⟩,
end
--3/23/23
              /-- Euclid I.1, construction of a single equilateral triangle -/
theorem iseqtri_of_ne (ab : a ≠ b) : ∃ (c : point), eq_tri a b c :=
  by rcases iseqtri_iseqtri_diffside_of_ne ab with ⟨c, -, -, -, -, -, eqtri, -⟩; exact ⟨c, eqtri⟩
                          /-- Euclid I.2, collapsing compass -/
theorem length_eq_of_ne (a : point) (bc : b ≠ c) : ∃ (f : point), length a f = length b c :=
begin
  by_cases ab : a = b, rw ab; exact ⟨c, rfl⟩, --degenerate case
  rcases iseqtri_of_ne ab with ⟨d, eqtri⟩,
  rcases B_circ_of_ne (ne_32_of_tri eqtri.1) bc with ⟨e, α, Bdbe, bα, cα, eα⟩,
  rcases B_circ_out_of_B (ne_31_of_tri eqtri.1) Bdbe eqtri.2.2.2 with ⟨f, β, Bdaf, dβ, eβ, fβ⟩,
  have be_bc := (length_eq_of_oncircle bα cα eα).symm,
  have de_df := length_eq_of_oncircle dβ eβ fβ,
  have af_be := length_eq_of_B_B Bdbe Bdaf eqtri.2.2.2 de_df,
  exact ⟨f, af_be.trans be_bc⟩, --calc block?
end

theorem length_eq_of_ne' (a : point) (bc : b ≠ c) : ∃ (f : point), length a f = length b c :=
begin
  by_cases ab : a = b, rw ab; exact ⟨c, rfl⟩, --degenerate case
  rcases iseqtri_of_ne ab with ⟨d, eqtri⟩,
  rcases B_circ_of_ne (ne_32_of_tri eqtri.1) bc with ⟨e, α, Bdbe, bα, cα, eα⟩,
  rcases B_circ_out_of_B (ne_31_of_tri eqtri.1) Bdbe eqtri.2.2.2 with ⟨f, β, Bdaf, dβ, eβ, fβ⟩,
  have de_df := length_eq_of_oncircle dβ eβ fβ,
  use f,
  calc length a f = length b e : length_eq_of_B_B Bdbe Bdaf eqtri.2.2.2 de_df
  ... = length b c : (length_eq_of_oncircle bα cα eα).symm,
end
                          /-- Euclid I.2, generalization -/
theorem length_eq_B_of_ne (ab : a ≠ b) (bc : b ≠ c) :
  ∃ (d : point), B a b d ∧ length b c = length b d :=
by rcases B_circ_of_ne ab bc with ⟨d, α, Babd, bα, cα, dα⟩;
  exact ⟨d, Babd, length_eq_of_oncircle bα cα dα⟩
                          /-- Euclid I.2, generalization -/
theorem length_eq_B_of_ne_four (ab : a ≠ b) (cd : c ≠ d) :
  ∃ (f : point), B a b f ∧ length c d = length b f :=
begin
  rcases length_eq_of_ne b cd with ⟨e, be_cd⟩,
  rcases length_eq_B_of_ne ab (ne_of_ne_len' cd be_cd) with ⟨f, Babf, be_bf⟩,
  exact ⟨f, Babf, by linarith⟩,
end
                /-- Euclid I.3, Moving a smaller segment on top of a larger one -/
theorem B_length_eq_of_ne_lt (cd : c ≠ d) (cd_lt_ab : length c d < length a b) :
  ∃ (f : point), B a f b ∧ length a f = length c d :=
begin
  rcases length_eq_of_ne a cd with ⟨e, ae_cd⟩,
  rcases circle_of_ne (ne_of_ne_len' cd ae_cd) with ⟨α, aα, eα⟩, --combine into one line?
  rcases B_oncircle_of_inside_outside (inside_circle_of_center aα)
    (out_circle_of_lt aα eα (by rwa ← ae_cd at cd_lt_ab)) with ⟨f, Bafb, fα⟩,
  have ae_af := length_eq_of_oncircle aα eα fα,
  exact ⟨f, Bafb, by linarith⟩,
end


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/

import set_theory.ordinal.arithmetic

/-!
# Natural operations on ordinals

The goal of this file is to define natural addition and multiplication on ordinals, also known as
the Hessenberg sum and product, and provide a basic API. The natural addition of two ordinals
`a ♯ b` is recursively defined as the least ordinal greater than `a' ♯ b` and `a ♯ b'` for `a' < a`
and `b' < b`. The natural multiplication `a ⨳ b` is likewise recursively defined as the least
ordinal such that `a ⨳ b ♯ a' ⨳ b'` is greater than `a' ⨳ b ♯ a ⨳ b'` for any `a' < a` and
`b' < b`.

These operations form a rich algebraic structure: they're commutative, associative, preserve order,
have the usual `0` and `1` from ordinals, and distribute over one another.

Moreover, these operations are the addition and multiplication of ordinals when viewed as
combinatorial `game`s. This makes them particularly useful for game theory.

Finally, both operations admit simple, intuitive descriptions in terms of the Cantor normal form.
The natural addition of two ordinals corresponds to adding their Cantor normal forms as if they were
polynomials in `ω`. Likewise, their natural multiplication corresponds to multiplying the Cantor
normal forms as polynomials.

# Implementation notes

Given the rich algebraic structure of these two operations, we choose to create a type synonym
`nat_ordinal`, where we provide the appropriate instances. However, to avoid casting back and forth
between both types, we attempt to prove and state most results on `ordinal`.

# Todo

- Define natural multiplication and provide a basic API.
- Prove the characterizations of natural addition and multiplication in terms of the Cantor normal
  form.
-/

universes u v

open function order

noncomputable theory

/-- A type synonym for ordinals with natural addition and multiplication. -/
@[derive [has_zero, inhabited, has_one, linear_order, succ_order, has_well_founded]]
def nat_ordinal : Type* := ordinal

/-- The identity function between `ordinal` and `nat_ordinal`. -/
@[pattern] def ordinal.to_nat_ordinal : ordinal ≃o nat_ordinal := order_iso.refl _

/-- The identity function between `nat_ordinal` and `ordinal`. -/
@[pattern] def nat_ordinal.to_ordinal : nat_ordinal ≃o ordinal := order_iso.refl _

open ordinal

namespace nat_ordinal

variables {a b c : nat_ordinal.{u}}

@[simp] theorem to_ordinal_symm_eq : nat_ordinal.to_ordinal.symm = ordinal.to_nat_ordinal := rfl
@[simp] theorem to_ordinal_to_nat_ordinal (a : nat_ordinal) : a.to_ordinal.to_nat_ordinal = a := rfl

theorem lt_wf : @well_founded nat_ordinal (<) := ordinal.lt_wf
instance : is_well_order nat_ordinal (<) := ordinal.has_lt.lt.is_well_order

@[simp] theorem to_ordinal_zero : to_ordinal 0 = 0 := rfl
@[simp] theorem to_ordinal_one : to_ordinal 1 = 1 := rfl

@[simp] theorem to_ordinal_eq_zero (a) : to_ordinal a = 0 ↔ a = 0 := iff.rfl
@[simp] theorem to_ordinal_eq_one (a) : to_ordinal a = 1 ↔ a = 1 := iff.rfl

@[simp] theorem to_ordinal_max : (max a b).to_ordinal = max a.to_ordinal b.to_ordinal := rfl
@[simp] theorem to_ordinal_min : (min a b).to_ordinal = min a.to_ordinal b.to_ordinal := rfl

theorem succ_def (a : nat_ordinal) : succ a = (a.to_ordinal + 1).to_nat_ordinal := rfl

/-- A recursor for `nat_ordinal`. Use as `induction x using nat_ordinal.rec`. -/
protected def rec {β : nat_ordinal → Sort*} (h : Π a, β (to_nat_ordinal a)) : Π a, β a :=
λ a, h a.to_ordinal

/-- `ordinal.induction` but for `nat_ordinal`. -/
theorem induction {p : nat_ordinal → Prop} : ∀ i (h : ∀ j, (∀ k, k < j → p k) → p j), p i :=
ordinal.induction

end nat_ordinal

namespace ordinal

variables {a b c : ordinal.{u}}

@[simp] theorem to_nat_ordinal_symm_eq : to_nat_ordinal.symm = nat_ordinal.to_ordinal := rfl
@[simp] theorem to_nat_ordinal_to_ordinal (a : ordinal) : a.to_nat_ordinal.to_ordinal = a := rfl

@[simp] theorem to_nat_ordinal_zero : to_nat_ordinal 0 = 0 := rfl
@[simp] theorem to_nat_ordinal_one : to_nat_ordinal 1 = 1 := rfl

@[simp] theorem to_nat_ordinal_eq_zero (a) : to_nat_ordinal a = 0 ↔ a = 0 := iff.rfl
@[simp] theorem to_nat_ordinal_eq_one (a) : to_nat_ordinal a = 1 ↔ a = 1 := iff.rfl

@[simp] theorem to_nat_ordinal_max :
  to_nat_ordinal (max a b) = max a.to_nat_ordinal b.to_nat_ordinal := rfl
@[simp] theorem to_nat_ordinal_min :
  (linear_order.min a b).to_nat_ordinal = linear_order.min a.to_nat_ordinal b.to_nat_ordinal := rfl

/-- Natural addition on ordinals `a ♯ b`, also known as the Hessenberg sum, is recursively defined
as the least ordinal greater than `a' ♯ b` and `a ♯ b'` for all `a' < a` and `b' < b`. In contrast
to normal ordinal addition, it is commutative.

Natural addition can equivalently be characterized as the ordinal resulting from adding up
corresponding coefficients in the Cantor normal forms of `a` and `b`. -/
noncomputable def nadd : ordinal → ordinal → ordinal
| a b := max
  (blsub.{u u} a $ λ a' h, nadd a' b)
  (blsub.{u u} b $ λ b' h, nadd a b')
using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }

localized "infix ` ♯ `:65 := ordinal.nadd" in natural_ops

theorem nadd_def (a b : ordinal) : a ♯ b = max
  (blsub.{u u} a $ λ a' h, a' ♯ b)
  (blsub.{u u} b $ λ b' h, a ♯ b') :=
by rw nadd

theorem lt_nadd_iff : a < b ♯ c ↔ (∃ b' < b, a ≤ b' ♯ c) ∨ ∃ c' < c, a ≤ b ♯ c' :=
by { rw nadd_def, simp [lt_blsub_iff] }

theorem nadd_le_iff : b ♯ c ≤ a ↔ (∀ b' < b, b' ♯ c < a) ∧ ∀ c' < c, b ♯ c' < a :=
by { rw nadd_def, simp [blsub_le_iff] }

theorem nadd_lt_nadd_left (h : b < c) (a) : a ♯ b < a ♯ c :=
lt_nadd_iff.2 (or.inr ⟨b, h, le_rfl⟩)

theorem nadd_lt_nadd_right (h : b < c) (a) : b ♯ a < c ♯ a :=
lt_nadd_iff.2 (or.inl ⟨b, h, le_rfl⟩)

theorem nadd_le_nadd_left (h : b ≤ c) (a) : a ♯ b ≤ a ♯ c :=
begin
  rcases lt_or_eq_of_le h with h | rfl,
  { exact (nadd_lt_nadd_left h a).le },
  { exact le_rfl }
end

theorem nadd_le_nadd_right (h : b ≤ c) (a) : b ♯ a ≤ c ♯ a :=
begin
  rcases lt_or_eq_of_le h with h | rfl,
  { exact (nadd_lt_nadd_right h a).le },
  { exact le_rfl }
end

variables (a b)

theorem nadd_comm : ∀ a b, a ♯ b = b ♯ a
| a b := begin
  rw [nadd_def, nadd_def, max_comm],
  congr; ext c hc;
  apply nadd_comm
end
using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }

theorem nadd_assoc : ∀ a b c, a ♯ b ♯ c = a ♯ (b ♯ c)
| a b c := begin
  rw [nadd_def a (b ♯ c), nadd_def, blsub_nadd_of_mono, blsub_nadd_of_mono, max_assoc],
  { congr; ext d hd;
    apply nadd_assoc },
  { exact λ i j _ _ h, nadd_le_nadd_left h a },
  { exact λ i j _ _ h, nadd_le_nadd_right h c }
end
using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }

@[simp] theorem nadd_zero : a ♯ 0 = a :=
begin
  induction a using ordinal.induction with a IH,
  rw [nadd_def, blsub_zero, max_zero_right],
  convert blsub_id a,
  ext b hb,
  exact IH _ hb
end

@[simp] theorem zero_nadd : 0 ♯ a = a :=
by rw [nadd_comm, nadd_zero]

@[simp] theorem nadd_one : a ♯ 1 = succ a :=
begin
  induction a using ordinal.induction with a IH,
  rw [nadd_def, blsub_one, nadd_zero, max_eq_right_iff, blsub_le_iff],
  intros i hi,
  rwa [IH i hi, succ_lt_succ_iff]
end

@[simp] theorem one_nadd : 1 ♯ a = succ a :=
by rw [nadd_comm, nadd_one]

theorem nadd_succ : a ♯ succ b = succ (a ♯ b) :=
by rw [←nadd_one (a ♯ b), nadd_assoc, nadd_one]

theorem succ_nadd : succ a ♯ b = succ (a ♯ b) :=
by rw [←one_nadd (a ♯ b), ←nadd_assoc, one_nadd]

@[simp] theorem nadd_nat (n : ℕ) : a ♯ n = a + n :=
begin
  induction n with n hn,
  { simp },
  { rw [nat.cast_succ, add_one_eq_succ, nadd_succ, add_succ, hn] }
end

@[simp] theorem nat_nadd (n : ℕ) : ↑n ♯ a = a + n :=
by rw [nadd_comm, nadd_nat]

theorem add_le_nadd : a + b ≤ a ♯ b :=
begin
  apply b.limit_rec_on,
  { simp },
  { intros c h,
    rwa [add_succ, nadd_succ, succ_le_succ_iff] },
  { intros c hc H,
    rw [←is_normal.blsub_eq.{u u} (add_is_normal a) hc, blsub_le_iff],
    exact λ i hi, (H i hi).trans_lt (nadd_lt_nadd_left hi a) }
end

end ordinal

open ordinal

namespace nat_ordinal

instance : has_add nat_ordinal := ⟨nadd⟩

instance add_covariant_class_lt :
  covariant_class nat_ordinal.{u} nat_ordinal.{u} (+) (<) :=
⟨λ a b c h, nadd_lt_nadd_left h a⟩

instance add_covariant_class_le :
  covariant_class nat_ordinal.{u} nat_ordinal.{u} (+) (≤) :=
⟨λ a b c h, nadd_le_nadd_left h a⟩

instance add_contravariant_class_le :
  contravariant_class nat_ordinal.{u} nat_ordinal.{u} (+) (≤) :=
⟨λ a b c h, by { by_contra' h', exact h.not_lt (add_lt_add_left h' a) }⟩

instance : ordered_cancel_add_comm_monoid nat_ordinal :=
{ add := (+),
  add_assoc := nadd_assoc,
  add_left_cancel := λ a b c, add_left_cancel'',
  add_le_add_left := λ a b, add_le_add_left,
  le_of_add_le_add_left := λ a b c, le_of_add_le_add_left,
  zero := 0,
  zero_add := zero_nadd,
  add_zero := nadd_zero,
  add_comm := nadd_comm,
  ..nat_ordinal.linear_order }

instance : add_monoid_with_one nat_ordinal := add_monoid_with_one.unary

@[simp] theorem add_one_eq_succ : ∀ a : nat_ordinal, a + 1 = succ a := nadd_one

@[simp] theorem to_ordinal_cast_nat (n : ℕ) : to_ordinal n = n :=
begin
  induction n with n hn,
  { refl },
  { change nadd (to_ordinal n) 1 = n + 1,
    rw hn,
    apply nadd_one }
end

end nat_ordinal

open nat_ordinal

open_locale natural_ops

namespace ordinal

@[simp] theorem to_nat_ordinal_cast_nat (n : ℕ) : to_nat_ordinal n = n :=
by { rw ←to_ordinal_cast_nat n, refl }

theorem lt_of_nadd_lt_nadd_left : ∀ {a b c}, a ♯ b < a ♯ c → b < c :=
@lt_of_add_lt_add_left nat_ordinal _ _ _
theorem lt_of_nadd_lt_nadd_right : ∀ {a b c}, b ♯ a < c ♯ a → b < c :=
@_root_.lt_of_add_lt_add_right nat_ordinal _ _ _
theorem le_of_nadd_le_nadd_left : ∀ {a b c}, a ♯ b ≤ a ♯ c → b ≤ c :=
@le_of_add_le_add_left nat_ordinal _ _ _
theorem le_of_nadd_le_nadd_right : ∀ {a b c}, b ♯ a ≤ c ♯ a → b ≤ c :=
@le_of_add_le_add_right nat_ordinal _ _ _

theorem nadd_lt_nadd_iff_left : ∀ a {b c}, a ♯ b < a ♯ c ↔ b < c :=
@add_lt_add_iff_left nat_ordinal _ _ _ _
theorem nadd_lt_nadd_iff_right : ∀ a {b c}, b ♯ a < c ♯ a ↔ b < c :=
@add_lt_add_iff_right nat_ordinal _ _ _ _
theorem nadd_le_nadd_iff_left : ∀ a {b c}, a ♯ b ≤ a ♯ c ↔ b ≤ c :=
@add_le_add_iff_left nat_ordinal _ _ _ _
theorem nadd_le_nadd_iff_right : ∀ a {b c}, b ♯ a ≤ c ♯ a ↔ b ≤ c :=
@_root_.add_le_add_iff_right nat_ordinal _ _ _ _

theorem nadd_left_cancel : ∀ {a b c}, a ♯ b = a ♯ c → b = c :=
@_root_.add_left_cancel nat_ordinal _
theorem nadd_right_cancel : ∀ {a b c}, a ♯ b = c ♯ b → a = c :=
@_root_.add_right_cancel nat_ordinal _
theorem nadd_left_cancel_iff : ∀ {a b c}, a ♯ b = a ♯ c ↔ b = c :=
@add_left_cancel_iff nat_ordinal _
theorem nadd_right_cancel_iff : ∀ {a b c}, b ♯ a = c ♯ a ↔ b = c :=
@add_right_cancel_iff nat_ordinal _

end ordinal


-- Pruebas de esVacia xs = esVacia (conc xs xs)
-- ============================================

import data.list.basic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys : list α)

-- ----------------------------------------------------
-- Nota. Se usará la función conc y sus propiedades
-- estudiadas anteriormente.
-- ----------------------------------------------------

def conc : list α → list α → list α
| []        ys := ys
| (x :: xs) ys := x :: (conc xs ys)

@[simp]
lemma conc_nil :
  conc ([] : list α) ys = ys :=
rfl

@[simp]
lemma conc_cons :
  conc (x :: xs) ys = x :: (conc xs ys) :=
rfl

-- ----------------------------------------------------
-- Ejercicio 1. Definir la función
--    esVacia : list α → bool
-- tal que (esVacia xs) se verifica si xs es la lista
-- vacía. Por ejemplo,
--    esVacia []  = tt
--    esVacia [1] = ff
-- ----------------------------------------------------

def esVacia : list α → bool
| [] := tt
| _  := ff

-- #eval esVacia ([] : list ℕ)
-- #eval esVacia [1,5]

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar los siguientes lemas
-- + esVacia_nil :
--      esVacia ([] : list α) = tt :=
-- + esVacia_cons :
--      esVacia (x :: xs) = ff :=
-- ----------------------------------------------------

@[simp]
lemma esVacia_nil :
  esVacia ([] : list α) = tt :=
rfl

@[simp]
lemma esVacia_cons :
  esVacia (x :: xs) = ff :=
rfl

-- ----------------------------------------------------
-- Ejercicio 3 (p. 39) . Demostrar que
--    esVacia xs = esVacia (conc xs xs)
-- ----------------------------------------------------

-- 1ª demostración
example : esVacia xs = esVacia (conc xs xs) :=
begin
  cases xs with a as,
  { rw conc_nil, },
  { rw conc_cons,
    rw esVacia_cons,
    rw esVacia_cons, },
end

-- 2ª demostración
example : esVacia xs = esVacia (conc xs xs) :=
begin
  cases xs with a as,
  { simp, },
  { simp, },
end

-- 3ª demostración
example : esVacia xs = esVacia (conc xs xs) :=
by cases xs ; simp

-- 4ª demostración
example : esVacia xs = esVacia (conc xs xs) :=
list.cases_on xs
  (show esVacia ([] : list α) = esVacia (conc [] []),
     from congr_arg esVacia (conc_nil []))
  (assume a as,
   show esVacia (a :: as) = esVacia (conc (a :: as) (a :: as)),
     from calc
       esVacia (a :: as)
           = ff                                 : by rw esVacia_cons
       ... = esVacia (a :: conc as (a :: as))   : by rw esVacia_cons
       ... = esVacia (conc (a :: as) (a :: as)) : by rw conc_cons)

-- 5ª demostración
example : esVacia xs = esVacia (conc xs xs) :=
list.cases_on xs
  (by simp)
  (by simp)

-- 6ª demostración
lemma esVacia_conc_1
  : ∀ xs : list α, esVacia xs = esVacia (conc xs xs)
| []        := by calc
    esVacia [] = esVacia (conc [] []) : by rw conc_nil
| (a :: as) := by calc
    esVacia (a :: as)
        = ff                                 : by rw esVacia_cons
    ... = esVacia (a :: conc as (a :: as))   : by rw esVacia_cons
    ... = esVacia (conc (a :: as) (a :: as)) : by rw conc_cons

-- 7ª demostración
lemma esVacia_conc_2
  : ∀ xs : list α, esVacia xs = esVacia (conc xs xs)
| []        := by simp
| (a :: as) := by simp

-- Comentarios sobre la función is_nil.
-- + Es equivalente a la función esVacia.
-- + Para usarla hay que importar la librería
--   data.list.basic y abrir el espacio de nombre
--   list escribiendo al principio del fichero
--      import data.list.basic
--      open list
-- + Se puede evaluar. Por ejemplo,
--      #eval is_nil ([] : list ℕ)
--      #eval is_nil [1]
-- + Se puede demostrar. Por ejemplo,
example : is_nil xs = is_nil (xs ++ xs) :=
by cases xs ; finish


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

! This file was ported from Lean 3 source module linear_algebra.clifford_algebra.conjugation
! leanprover-community/mathlib commit 34020e531ebc4e8aac6d449d9eecbcd1508ea8d0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.CliffordAlgebra.Grading
import Mathbin.Algebra.Module.Opposites

/-!
# Conjugations

This file defines the grade reversal and grade involution functions on multivectors, `reverse` and
`involute`.
Together, these operations compose to form the "Clifford conjugate", hence the name of this file.

https://en.wikipedia.org/wiki/Clifford_algebra#Antiautomorphisms

## Main definitions

* `clifford_algebra.involute`: the grade involution, negating each basis vector
* `clifford_algebra.reverse`: the grade reversion, reversing the order of a product of vectors

## Main statements

* `clifford_algebra.involute_involutive`
* `clifford_algebra.reverse_involutive`
* `clifford_algebra.reverse_involute_commute`
* `clifford_algebra.involute_mem_even_odd_iff`
* `clifford_algebra.reverse_mem_even_odd_iff`

-/

variable {R : Type _} [CommRing R]

variable {M : Type _} [AddCommGroup M] [Module R M]

variable {Q : QuadraticForm R M}

namespace CliffordAlgebra

section Involute

/-- Grade involution, inverting the sign of each basis vector. -/
def involute : CliffordAlgebra Q →ₐ[R] CliffordAlgebra Q :=
  CliffordAlgebra.lift Q ⟨-ι Q, fun m => by simp⟩
#align clifford_algebra.involute CliffordAlgebra.involute

@[simp]
theorem involute_ι (m : M) : involute (ι Q m) = -ι Q m :=
  lift_ι_apply _ _ m
#align clifford_algebra.involute_ι CliffordAlgebra.involute_ι

@[simp]
theorem involute_comp_involute : involute.comp involute = AlgHom.id R (CliffordAlgebra Q) :=
  by
  ext
  simp
#align clifford_algebra.involute_comp_involute CliffordAlgebra.involute_comp_involute

theorem involute_involutive : Function.Involutive (involute : _ → CliffordAlgebra Q) :=
  AlgHom.congr_fun involute_comp_involute
#align clifford_algebra.involute_involutive CliffordAlgebra.involute_involutive

@[simp]
theorem involute_involute : ∀ a : CliffordAlgebra Q, involute (involute a) = a :=
  involute_involutive
#align clifford_algebra.involute_involute CliffordAlgebra.involute_involute

/-- `clifford_algebra.involute` as an `alg_equiv`. -/
@[simps]
def involuteEquiv : CliffordAlgebra Q ≃ₐ[R] CliffordAlgebra Q :=
  AlgEquiv.ofAlgHom involute involute (AlgHom.ext <| involute_involute)
    (AlgHom.ext <| involute_involute)
#align clifford_algebra.involute_equiv CliffordAlgebra.involuteEquiv

end Involute

section Reverse

open MulOpposite

/-- Grade reversion, inverting the multiplication order of basis vectors.
Also called *transpose* in some literature. -/
def reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q :=
  (opLinearEquiv R).symm.toLinearMap.comp
    (CliffordAlgebra.lift Q
        ⟨(MulOpposite.opLinearEquiv R).toLinearMap.comp (ι Q), fun m =>
          unop_injective <| by simp⟩).toLinearMap
#align clifford_algebra.reverse CliffordAlgebra.reverse

@[simp]
theorem reverse_ι (m : M) : reverse (ι Q m) = ι Q m := by simp [reverse]
#align clifford_algebra.reverse_ι CliffordAlgebra.reverse_ι

@[simp]
theorem reverse.commutes (r : R) :
    reverse (algebraMap R (CliffordAlgebra Q) r) = algebraMap R _ r := by simp [reverse]
#align clifford_algebra.reverse.commutes CliffordAlgebra.reverse.commutes

@[simp]
theorem reverse.map_one : reverse (1 : CliffordAlgebra Q) = 1 := by
  convert reverse.commutes (1 : R) <;> simp
#align clifford_algebra.reverse.map_one CliffordAlgebra.reverse.map_one

@[simp]
theorem reverse.map_mul (a b : CliffordAlgebra Q) : reverse (a * b) = reverse b * reverse a := by
  simp [reverse]
#align clifford_algebra.reverse.map_mul CliffordAlgebra.reverse.map_mul

@[simp]
theorem reverse_comp_reverse : reverse.comp reverse = (LinearMap.id : _ →ₗ[R] CliffordAlgebra Q) :=
  by
  ext m
  simp only [LinearMap.id_apply, LinearMap.comp_apply]
  induction m using CliffordAlgebra.induction
  -- simp can close these goals, but is slow
  case h_grade0 => rw [reverse.commutes, reverse.commutes]
  case h_grade1 => rw [reverse_ι, reverse_ι]
  case h_mul a b ha hb => rw [reverse.map_mul, reverse.map_mul, ha, hb]
  case h_add a b ha hb => rw [reverse.map_add, reverse.map_add, ha, hb]
#align clifford_algebra.reverse_comp_reverse CliffordAlgebra.reverse_comp_reverse

@[simp]
theorem reverse_involutive : Function.Involutive (reverse : _ → CliffordAlgebra Q) :=
  LinearMap.congr_fun reverse_comp_reverse
#align clifford_algebra.reverse_involutive CliffordAlgebra.reverse_involutive

@[simp]
theorem reverse_reverse : ∀ a : CliffordAlgebra Q, reverse (reverse a) = a :=
  reverse_involutive
#align clifford_algebra.reverse_reverse CliffordAlgebra.reverse_reverse

/-- `clifford_algebra.reverse` as a `linear_equiv`. -/
@[simps]
def reverseEquiv : CliffordAlgebra Q ≃ₗ[R] CliffordAlgebra Q :=
  LinearEquiv.ofInvolutive reverse reverse_involutive
#align clifford_algebra.reverse_equiv CliffordAlgebra.reverseEquiv

theorem reverse_comp_involute :
    reverse.comp involute.toLinearMap =
      (involute.toLinearMap.comp reverse : _ →ₗ[R] CliffordAlgebra Q) :=
  by
  ext
  simp only [LinearMap.comp_apply, AlgHom.toLinearMap_apply]
  induction x using CliffordAlgebra.induction
  case h_grade0 => simp
  case h_grade1 => simp
  case h_mul a b ha hb => simp only [ha, hb, reverse.map_mul, AlgHom.map_mul]
  case h_add a b ha hb => simp only [ha, hb, reverse.map_add, AlgHom.map_add]
#align clifford_algebra.reverse_comp_involute CliffordAlgebra.reverse_comp_involute

/-- `clifford_algebra.reverse` and `clifford_algebra.inverse` commute. Note that the composition
is sometimes referred to as the "clifford conjugate". -/
theorem reverse_involute_commute : Function.Commute (reverse : _ → CliffordAlgebra Q) involute :=
  LinearMap.congr_fun reverse_comp_involute
#align clifford_algebra.reverse_involute_commute CliffordAlgebra.reverse_involute_commute

theorem reverse_involute : ∀ a : CliffordAlgebra Q, reverse (involute a) = involute (reverse a) :=
  reverse_involute_commute
#align clifford_algebra.reverse_involute CliffordAlgebra.reverse_involute

end Reverse

/-!
### Statements about conjugations of products of lists
-/

section List

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Taking the reverse of the product a list of $n$ vectors lifted via `ι` is equivalent to
taking the product of the reverse of that list. -/
theorem reverse_prod_map_ι : ∀ l : List M, reverse (l.map <| ι Q).Prod = (l.map <| ι Q).reverse.Prod
  | [] => by simp
  | x::xs => by simp [reverse_prod_map_ι xs]
#align clifford_algebra.reverse_prod_map_ι CliffordAlgebra.reverse_prod_map_ι

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Taking the involute of the product a list of $n$ vectors lifted via `ι` is equivalent to
premultiplying by ${-1}^n$. -/
theorem involute_prod_map_ι :
    ∀ l : List M, involute (l.map <| ι Q).Prod = (-1 : R) ^ l.length • (l.map <| ι Q).Prod
  | [] => by simp
  | x::xs => by simp [pow_add, involute_prod_map_ι xs]
#align clifford_algebra.involute_prod_map_ι CliffordAlgebra.involute_prod_map_ι

end List

/-!
### Statements about `submodule.map` and `submodule.comap`
-/

section Submodule

variable (Q)

section Involute

theorem submodule_map_involute_eq_comap (p : Submodule R (CliffordAlgebra Q)) :
    p.map (involute : CliffordAlgebra Q →ₐ[R] CliffordAlgebra Q).toLinearMap =
      p.comap (involute : CliffordAlgebra Q →ₐ[R] CliffordAlgebra Q).toLinearMap :=
  Submodule.map_equiv_eq_comap_symm involuteEquiv.toLinearEquiv _
#align clifford_algebra.submodule_map_involute_eq_comap CliffordAlgebra.submodule_map_involute_eq_comap

@[simp]
theorem ι_range_map_involute :
    (ι Q).range.map (involute : CliffordAlgebra Q →ₐ[R] CliffordAlgebra Q).toLinearMap =
      (ι Q).range :=
  (ι_range_map_lift _ _).trans (LinearMap.range_neg _)
#align clifford_algebra.ι_range_map_involute CliffordAlgebra.ι_range_map_involute

@[simp]
theorem ι_range_comap_involute :
    (ι Q).range.comap (involute : CliffordAlgebra Q →ₐ[R] CliffordAlgebra Q).toLinearMap =
      (ι Q).range :=
  by rw [← submodule_map_involute_eq_comap, ι_range_map_involute]
#align clifford_algebra.ι_range_comap_involute CliffordAlgebra.ι_range_comap_involute

@[simp]
theorem evenOdd_map_involute (n : ZMod 2) :
    (evenOdd Q n).map (involute : CliffordAlgebra Q →ₐ[R] CliffordAlgebra Q).toLinearMap =
      evenOdd Q n :=
  by simp_rw [even_odd, Submodule.map_supᵢ, Submodule.map_pow, ι_range_map_involute]
#align clifford_algebra.even_odd_map_involute CliffordAlgebra.evenOdd_map_involute

@[simp]
theorem evenOdd_comap_involute (n : ZMod 2) :
    (evenOdd Q n).comap (involute : CliffordAlgebra Q →ₐ[R] CliffordAlgebra Q).toLinearMap =
      evenOdd Q n :=
  by rw [← submodule_map_involute_eq_comap, even_odd_map_involute]
#align clifford_algebra.even_odd_comap_involute CliffordAlgebra.evenOdd_comap_involute

end Involute

section Reverse

theorem submodule_map_reverse_eq_comap (p : Submodule R (CliffordAlgebra Q)) :
    p.map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) =
      p.comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) :=
  Submodule.map_equiv_eq_comap_symm (reverseEquiv : _ ≃ₗ[R] _) _
#align clifford_algebra.submodule_map_reverse_eq_comap CliffordAlgebra.submodule_map_reverse_eq_comap

@[simp]
theorem ι_range_map_reverse :
    (ι Q).range.map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) = (ι Q).range :=
  by
  rw [reverse, Submodule.map_comp, ι_range_map_lift, LinearMap.range_comp, ← Submodule.map_comp]
  exact Submodule.map_id _
#align clifford_algebra.ι_range_map_reverse CliffordAlgebra.ι_range_map_reverse

@[simp]
theorem ι_range_comap_reverse :
    (ι Q).range.comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) = (ι Q).range := by
  rw [← submodule_map_reverse_eq_comap, ι_range_map_reverse]
#align clifford_algebra.ι_range_comap_reverse CliffordAlgebra.ι_range_comap_reverse

/-- Like `submodule.map_mul`, but with the multiplication reversed. -/
theorem submodule_map_mul_reverse (p q : Submodule R (CliffordAlgebra Q)) :
    (p * q).map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) =
      q.map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) *
        p.map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) :=
  by
  simp_rw [reverse, Submodule.map_comp, LinearEquiv.toLinearMap_eq_coe, Submodule.map_mul,
    Submodule.map_unop_mul]
#align clifford_algebra.submodule_map_mul_reverse CliffordAlgebra.submodule_map_mul_reverse

theorem submodule_comap_mul_reverse (p q : Submodule R (CliffordAlgebra Q)) :
    (p * q).comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) =
      q.comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) *
        p.comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) :=
  by simp_rw [← submodule_map_reverse_eq_comap, submodule_map_mul_reverse]
#align clifford_algebra.submodule_comap_mul_reverse CliffordAlgebra.submodule_comap_mul_reverse

/-- Like `submodule.map_pow` -/
theorem submodule_map_pow_reverse (p : Submodule R (CliffordAlgebra Q)) (n : ℕ) :
    (p ^ n).map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) =
      p.map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) ^ n :=
  by
  simp_rw [reverse, Submodule.map_comp, LinearEquiv.toLinearMap_eq_coe, Submodule.map_pow,
    Submodule.map_unop_pow]
#align clifford_algebra.submodule_map_pow_reverse CliffordAlgebra.submodule_map_pow_reverse

theorem submodule_comap_pow_reverse (p : Submodule R (CliffordAlgebra Q)) (n : ℕ) :
    (p ^ n).comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) =
      p.comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) ^ n :=
  by simp_rw [← submodule_map_reverse_eq_comap, submodule_map_pow_reverse]
#align clifford_algebra.submodule_comap_pow_reverse CliffordAlgebra.submodule_comap_pow_reverse

@[simp]
theorem evenOdd_map_reverse (n : ZMod 2) :
    (evenOdd Q n).map (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) = evenOdd Q n := by
  simp_rw [even_odd, Submodule.map_supᵢ, submodule_map_pow_reverse, ι_range_map_reverse]
#align clifford_algebra.even_odd_map_reverse CliffordAlgebra.evenOdd_map_reverse

@[simp]
theorem evenOdd_comap_reverse (n : ZMod 2) :
    (evenOdd Q n).comap (reverse : CliffordAlgebra Q →ₗ[R] CliffordAlgebra Q) = evenOdd Q n := by
  rw [← submodule_map_reverse_eq_comap, even_odd_map_reverse]
#align clifford_algebra.even_odd_comap_reverse CliffordAlgebra.evenOdd_comap_reverse

end Reverse

@[simp]
theorem involute_mem_evenOdd_iff {x : CliffordAlgebra Q} {n : ZMod 2} :
    involute x ∈ evenOdd Q n ↔ x ∈ evenOdd Q n :=
  SetLike.ext_iff.mp (evenOdd_comap_involute Q n) x
#align clifford_algebra.involute_mem_even_odd_iff CliffordAlgebra.involute_mem_evenOdd_iff

@[simp]
theorem reverse_mem_evenOdd_iff {x : CliffordAlgebra Q} {n : ZMod 2} :
    reverse x ∈ evenOdd Q n ↔ x ∈ evenOdd Q n :=
  SetLike.ext_iff.mp (evenOdd_comap_reverse Q n) x
#align clifford_algebra.reverse_mem_even_odd_iff CliffordAlgebra.reverse_mem_evenOdd_iff

end Submodule

/-!
### Related properties of the even and odd submodules

TODO: show that these are `iff`s when `invertible (2 : R)`.
-/

theorem involute_eq_of_mem_even {x : CliffordAlgebra Q} (h : x ∈ evenOdd Q 0) : involute x = x :=
  by
  refine' even_induction Q (AlgHom.commutes _) _ _ x h
  · rintro x y hx hy ihx ihy
    rw [map_add, ihx, ihy]
  · intro m₁ m₂ x hx ihx
    rw [map_mul, map_mul, involute_ι, involute_ι, ihx, neg_mul_neg]
#align clifford_algebra.involute_eq_of_mem_even CliffordAlgebra.involute_eq_of_mem_even

theorem involute_eq_of_mem_odd {x : CliffordAlgebra Q} (h : x ∈ evenOdd Q 1) : involute x = -x :=
  by
  refine' odd_induction Q involute_ι _ _ x h
  · rintro x y hx hy ihx ihy
    rw [map_add, ihx, ihy, neg_add]
  · intro m₁ m₂ x hx ihx
    rw [map_mul, map_mul, involute_ι, involute_ι, ihx, neg_mul_neg, mul_neg]
#align clifford_algebra.involute_eq_of_mem_odd CliffordAlgebra.involute_eq_of_mem_odd

end CliffordAlgebra