variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  iff.intro (
  assume h : p ∧ q,
  show q ∧ p, from ⟨h.right, h.left⟩
  ) (
  assume h : q ∧ p,
  show p ∧ q, from ⟨h.right, h.left⟩
  )
example : p ∨ q ↔ q ∨ p :=
  iff.intro (
    assume h: p ∨ q,
    show q ∨ p, from h.elim or.inr or.inl
  ) (
    λ (h : q ∨ p), h.elim
      (assume hq: q, show p ∨ q, from or.inr hq)
      (assume hp: p, show p ∨ q, from or.inl hp)
  )

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  iff.intro (
    assume h: (p ∧ q) ∧ r,
    show p ∧ (q ∧ r), from ⟨ h.left.left, ⟨h.left.right , h.right⟩ ⟩
  ) (
    assume h: p ∧ (q ∧ r),
    show (p ∧ q) ∧ r, from ⟨⟨h.left, h.right.left⟩ , h.right.right⟩
  )
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  iff.intro (
    assume h: (p ∨ q) ∨ r,
    show p ∨ (q ∨ r), from h.elim
      (λ (hpq: p ∨ q), hpq.elim or.inl (λ hq: q, or.inr (or.inl hq)))
      (λ (hr: r), or.inr (or.inr hr))
  ) (
    assume h: p ∨ (q ∨ r),
    show (p ∨ q) ∨ r, from h.elim
      (assume hp: p, or.inl (or.inl hp))
      (assume hqr: q ∨ r, hqr.elim
        (assume hq: q, or.inl (or.inr hq))
        or.inr
      )
  )

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  iff.intro (
    assume h: p ∧ (q ∨ r),
    h.right.elim
      (assume hq: q, or.inl ⟨h.left, hq⟩)
      (assume hr: r, or.inr ⟨h.left, hr⟩)
  ) (
    assume h: (p ∧ q) ∨ (p ∧ r),
    h.elim
      (assume hpq: p ∧ q, ⟨hpq.left, or.inl hpq.right⟩)
    (assume hpr: p ∧ r, ⟨hpr.left, or.inr hpr.right⟩)
)
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  iff.intro (
    assume h: p ∨ (q ∧ r),
    h.elim
      (assume hp: p, ⟨ or.inl hp, or.inl hp ⟩)
      (assume hqr: q ∧ r, ⟨ or.inr hqr.left, or.inr hqr.right ⟩)
  ) (
    assume h: (p ∨ q) ∧ (p ∨ r),
    h.left.elim
      or.inl
      (assume hq: q, h.right.elim
        or.inl
        (assume hr: r, or.inr ⟨hq, hr⟩ )
      )
  )

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  iff.intro (
    assume hpqr: p → (q → r),
    assume hpq: p ∧ q,
    (hpqr hpq.left) hpq.right
  ) (
    assume hpqr: (p ∧ q) → r,
    assume hp: p,
    assume hq: q,
    hpqr (⟨ hp, hq ⟩)
  )
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  iff.intro (
    assume hpqr: (p ∨ q) → r,
    ⟨
      assume hp: p, show r, from hpqr (or.inl hp),
      assume hq: q, show r, from hpqr (or.inr hq)
    ⟩
  ) (
    assume hpqr: (p → r) ∧ (q → r),
    assume hpq: p ∨ q,
    hpq.elim
      (assume hp: p, hpqr.left hp)
      (assume hq: q, hpqr.right hq)
  )
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  iff.intro (
    assume npq: ¬(p ∨ q), ⟨
      assume p, show false, from npq (or.inl p),
      assume q, show false, from npq (or.inr q),
    ⟩
  ) (
    assume npq: ¬p ∧ ¬q,
    assume hpq: p ∨ q,
    hpq.elim npq.left npq.right
  )
example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  assume hpq: ¬p ∨ ¬q,
  assume pq: p ∧ q,
  hpq.elim
    (assume np: ¬p, np pq.left)
    (assume nq: ¬q, nq pq.right)
example : ¬(p ∧ ¬p) :=
  assume hp: p ∧ ¬p, hp.right hp.left
example : p ∧ ¬q → ¬(p → q) :=
  assume npq: p ∧ ¬q,
  assume hpq: p → q,
  npq.right (hpq npq.left)
example : ¬p → (p → q) :=
  assume np: ¬p,
  assume hp: p,
  absurd hp np
example : (¬p ∨ q) → (p → q) :=
  assume hpq: ¬p ∨ q,
  assume hp: p,
  hpq.elim
    (assume np: ¬p, absurd hp np)
    (assume hq: q, hq)
example : p ∨ false ↔ p :=
  iff.intro (
    assume hpn: p ∨ false,
    hpn.elim id false.elim
  ) (
    or.inl
  )
example : p ∧ false ↔ false :=
  iff.intro and.right false.elim
example : ¬(p ↔ ¬p) :=
  assume pnp: p ↔ ¬p,
  have pf: p → false, from (
    assume hp: p, (pnp.mp hp) hp
  ),
  have hp: p, from pnp.mpr pf,
  pf hp
example : (p → q) → (¬q → ¬p) :=
  assume hpq: p → q,
  assume nq: ¬q,
  assume hp: p,
  nq (hpq hp)

-- these require classical reasoning
example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  assume prs: p → r ∨ s,
  (classical.em r).elim
    (assume hr: r, or.inl (assume hp: p, hr))
    (assume nr: ¬r, or.inr (
      assume hp: p,
      have rs: r ∨ s, from prs hp,
      show s, from (rs.elim (assume hr: r, absurd hr nr) (assume hs, hs))
    ))
example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  assume npq: ¬(p ∧ q),
  (classical.em p).elim (
    assume hp: p,
    have nq: ¬q, from (assume hq: q, npq ⟨hp, hq⟩),
    or.inr nq
  ) (
    or.inl
  )
example : ¬(p → q) → p ∧ ¬q :=
  assume npq: ¬(p → q),
  (classical.em p).elim (
    assume hp: p,
    have nq: ¬q, from (assume hq: q, npq (λ _, hq)),
    and.intro hp nq
  ) (
    assume np: ¬p,
    have pq: p → q, from (assume hp: p, absurd hp np),
    absurd pq npq
  )
example : (p → q) → (¬p ∨ q) :=
  assume hpq: p → q,
  (classical.em p).elim (
    assume hp: p,
    have hq: q, from hpq hp,
    or.inr hq
  ) (
    or.inl
  )
example : (¬q → ¬p) → (p → q) :=
  assume nqp: ¬q → ¬p,
  assume hp: p,
  classical.by_contradiction (
    assume nq: ¬q,
    (nqp nq) hp
  )
example : p ∨ ¬p := classical.em p
example : (((p → q) → p) → p) :=
  assume pqp: (p → q) → p,
  classical.by_contradiction (
    assume np: ¬p,
    have pq: (p → q), from (assume hp: p, absurd hp np),
    have hp: p, from pqp pq,
    np hp
  )


import tactic
import data.real.basic
/-
- nom des variables dans la def de limite !
- variables muettes = variables globales : bof
- calcul avec abs : abs (l'-l) /2 >0 ??
(x ≠ 0 → |x| >0)
- ne pas ajouter l'inégalité au contexte si elle y est déjà !
- 'dsimp only at h' effectue les beta-réduction : (λ x, f x) 37 = f 37
- max : def et propriétés
- utiliser specialize ??

-/

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object
import compute

-- dEAduction definitions
-- import set_definitions
import real_definitions

definition limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | u n - l | < ε

section definitions

lemma definition.limit
{u : ℕ → ℝ} {l : ℝ} :
(limit u l) ↔
∀ ε > 0, ∃ N, ∀ n ≥ N, | u n - l | < ε
:=
/- dEAduction
PrettyName
  Limite d'une suite
ImplicitUse
  True
-/
begin
  -- hypo_analysis,
  refl
end

end definitions

section tests

lemma exercise.test_for_all_ineq
(u : ℕ → ℝ) (l : ℝ) :
(limit u l) ↔
∀ ε > 0, ∃ N, ∀ n ≥ N, | u n - l | ≤ ε
:=
/- dEAduction
AutoTest
    iff 0 success=Equivalence_séparée_en_deux_implications,
    implies success=Propriété_H1_ajoutée_au_contexte,
    forall success=Objet_ε_ajouté_au_contexte,
    @P1 definition.limit success=Définition_appliquée_à_H1,
    @O3 @P1 forall success=Propriété_H3_ajoutée_au_contexte,
    @P3 exists success=Nouvel_objet_n_vérifiant_la_propriété_H4,
    @O4 exists success=Il_reste_à_démontrer_que_n_convient,
    forall success=Objet_n'_ajouté_au_contexte,
    @O5 @P3 forall success=Propriété_H6_ajoutée_au_contexte,
    assumption success=But_en_cours_atteint,
    implies success=Propriété_H7_ajoutée_au_contexte,
    forall success=Objet_ε_ajouté_au_contexte,
    @P1 forall epsilon/2 success=La_nouvelle_propriété_sera_ajoutée_quand_l'inégalité_aura_été_vérifiée,
    assumption success=But_en_cours_atteint,
    @P4 exists success=Nouvel_objet_n_vérifiant_la_propriété_H11,
    @O4 exists success=Il_reste_à_démontrer_que_n_convient,
    forall success=Objet_n'_ajouté_au_contexte,
    @O5 @P4 forall success=Propriété_H13_ajoutée_au_contexte,
    assumption success=La_preuve_est_terminée_!
-/
begin
  split,
  intro H1,
  intro ε, intro H2,
  rw limit at H1,
  have H3 := H1 ε H2,
  cases H3 with n H4,
  use n,
  intro n', intro H5,
  have H6 := H4 n' H5,
  -- solve1 {linarith},
  todo,
  todo,
end

end tests


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.group.fundamental_domain
import measure_theory.integral.interval_integral
import topology.algebra.order.floor

/-!
# Integrals of periodic functions

In this file we prove that `∫ x in t..t + T, f x = ∫ x in s..s + T, f x` for any (not necessarily
measurable) function periodic function with period `T`.
-/

open set function measure_theory measure_theory.measure topological_space
open_locale measure_theory

lemma is_add_fundamental_domain_Ioc {T : ℝ} (hT : 0 < T) (t : ℝ) (μ : measure ℝ . volume_tac) :
  is_add_fundamental_domain (add_subgroup.zmultiples T) (Ioc t (t + T)) μ :=
begin
  refine is_add_fundamental_domain.mk' measurable_set_Ioc.null_measurable_set (λ x, _),
  have : bijective (cod_restrict (λ n : ℤ, n • T) (add_subgroup.zmultiples T) _),
    from (equiv.of_injective (λ n : ℤ, n • T) (zsmul_strict_mono_left hT).injective).bijective,
  refine this.exists_unique_iff.2 _,
  simpa only [add_comm x] using exists_unique_add_zsmul_mem_Ioc hT x t
end

variables {E : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]

namespace function

namespace periodic

open interval_integral

variables {f : ℝ → E} {T : ℝ}

/-- An auxiliary lemma for a more general `function.periodic.interval_integral_add_eq`. -/
lemma interval_integral_add_eq_of_pos (hf : periodic f T)
  (hT : 0 < T) (t s : ℝ) : ∫ x in t..t + T, f x = ∫ x in s..s + T, f x :=
begin
  haveI : encodable (add_subgroup.zmultiples T) := (countable_range _).to_encodable,
  simp only [integral_of_le, hT.le, le_add_iff_nonneg_right],
  haveI : vadd_invariant_measure (add_subgroup.zmultiples T) ℝ volume :=
    ⟨λ c s hs, measure_preimage_add _ _ _⟩,
  exact (is_add_fundamental_domain_Ioc hT t).set_integral_eq
    (is_add_fundamental_domain_Ioc hT s) hf.map_vadd_zmultiples
end

/-- If `f` is a periodic function with period `T`, then its integral over `[t, t + T]` does not
depend on `t`. -/
lemma interval_integral_add_eq (hf : periodic f T)
  (t s : ℝ) : ∫ x in t..t + T, f x = ∫ x in s..s + T, f x :=
begin
  rcases lt_trichotomy 0 T with (hT|rfl|hT),
  { exact hf.interval_integral_add_eq_of_pos hT t s },
  { simp },
  { rw [← neg_inj, ← integral_symm, ← integral_symm],
    simpa only [← sub_eq_add_neg, add_sub_cancel]
      using (hf.neg.interval_integral_add_eq_of_pos (neg_pos.2 hT) (t + T) (s + T)) }
end

/-- If `f` is an integrable periodic function with period `T`, then its integral over `[t, s + T]`
is the sum of its integrals over the intervals `[t, s]` and `[t, t + T]`. -/
lemma interval_integral_add_eq_add (hf : periodic f T) (t s : ℝ)
  (h_int : ∀ t₁ t₂, interval_integrable f measure_space.volume t₁ t₂) :
  ∫ x in t..s+T, f x = (∫ x in t..s, f x) + ∫ x in t..t + T, f x :=
by rw [hf.interval_integral_add_eq t s, integral_add_adjacent_intervals (h_int t s) (h_int s _)]

/-- If `f` is an integrable periodic function with period `T`, and `n` is an integer, then its
integral over `[t, t + n • T]` is `n` times its integral over `[t, t + T]`. -/
lemma interval_integral_add_zsmul_eq (hf : periodic f T) (n : ℤ) (t : ℝ)
  (h_int : ∀ t₁ t₂, interval_integrable f measure_space.volume t₁ t₂) :
  ∫ x in t..t + n • T, f x = n • ∫ x in t..t + T, f x :=
begin
  -- Reduce to the case `b = 0`
  suffices : ∫ x in 0..n • T, f x = n • ∫ x in 0..T, f x,
  { simp only [hf.interval_integral_add_eq t 0, (hf.zsmul n).interval_integral_add_eq t 0, zero_add,
      this], },
  -- First prove it for natural numbers
  have : ∀ (m : ℕ), ∫ x in 0..m • T, f x = m • ∫ x in 0..T, f x,
  { intros,
    induction m with m ih,
    { simp, },
    { simp only [succ_nsmul', hf.interval_integral_add_eq_add 0 (m • T) h_int, ih, zero_add], }, },
  -- Then prove it for all integers
  cases n with n n,
  { simp [← this n], },
  { conv_rhs { rw zsmul_neg_succ_of_nat, },
    have h₀ : (int.neg_succ_of_nat n) • T + (n + 1) • T = 0, { simp, linarith, },
    rw [integral_symm, ← (hf.nsmul (n+1)).funext, neg_inj],
    simp_rw [integral_comp_add_right, h₀, zero_add, this (n+1),
      add_comm T, hf.interval_integral_add_eq ((n+1) • T) 0, zero_add], },
end

section real_valued

open filter

variables {g : ℝ → ℝ}
variables (hg : periodic g T) (h_int : ∀ t₁ t₂, interval_integrable g measure_space.volume t₁ t₂)
include hg h_int

/-- If `g : ℝ → ℝ` is periodic with period `T > 0`, then for any `t : ℝ`, the function
`t ↦ ∫ x in 0..t, g x` is bounded below by `t ↦ X + ⌊t/T⌋ • Y` for appropriate constants `X` and
`Y`. -/
lemma Inf_add_zsmul_le_integral_of_pos (hT : 0 < T) (t : ℝ) :
  Inf ((λ t, ∫ x in 0..t, g x) '' (Icc 0 T)) + ⌊t/T⌋ • (∫ x in 0..T, g x) ≤ ∫ x in 0..t, g x :=
begin
  let ε := int.fract (t/T) * T,
  conv_rhs { rw [← int.fract_div_mul_self_add_zsmul_eq T t (by linarith),
    ← integral_add_adjacent_intervals (h_int 0 ε) (h_int _ _)] },
  rw [hg.interval_integral_add_zsmul_eq ⌊t/T⌋ ε h_int, hg.interval_integral_add_eq ε 0, zero_add,
    add_le_add_iff_right],
  exact (continuous_primitive h_int 0).continuous_on.Inf_image_Icc_le
    (mem_Icc_of_Ico (int.fract_div_mul_self_mem_Ico T t hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0`, then for any `t : ℝ`, the function
`t ↦ ∫ x in 0..t, g x` is bounded above by `t ↦ X + ⌊t/T⌋ • Y` for appropriate constants `X` and
`Y`. -/
lemma integral_le_Sup_add_zsmul_of_pos (hT : 0 < T) (t : ℝ) :
  ∫ x in 0..t, g x ≤ Sup ((λ t, ∫ x in 0..t, g x) '' (Icc 0 T)) + ⌊t/T⌋ • (∫ x in 0..T, g x) :=
begin
  let ε := int.fract (t/T) * T,
  conv_lhs { rw [← int.fract_div_mul_self_add_zsmul_eq T t (by linarith),
    ← integral_add_adjacent_intervals (h_int 0 ε) (h_int _ _)] },
  rw [hg.interval_integral_add_zsmul_eq ⌊t/T⌋ ε h_int, hg.interval_integral_add_eq ε 0, zero_add,
    add_le_add_iff_right],
  exact (continuous_primitive h_int 0).continuous_on.le_Sup_image_Icc
    (mem_Icc_of_Ico (int.fract_div_mul_self_mem_Ico T t hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `0 < ∫ x in 0..T, g x`, then
`t ↦ ∫ x in 0..t, g x` tends to `∞` as `t` tends to `∞`. -/
lemma tendsto_at_top_interval_integral_of_pos (h₀ : 0 < ∫ x in 0..T, g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_top at_top :=
begin
  apply tendsto_at_top_mono (hg.Inf_add_zsmul_le_integral_of_pos h_int hT),
  apply at_top.tendsto_at_top_add_const_left (Inf $ (λ t, ∫ x in 0..t, g x) '' (Icc 0 T)),
  apply tendsto.at_top_zsmul_const h₀,
  exact tendsto_floor_at_top.comp (tendsto_id.at_top_mul_const (inv_pos.mpr hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `0 < ∫ x in 0..T, g x`, then
`t ↦ ∫ x in 0..t, g x` tends to `-∞` as `t` tends to `-∞`. -/
lemma tendsto_at_bot_interval_integral_of_pos (h₀ : 0 < ∫ x in 0..T, g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_bot at_bot :=
begin
  apply tendsto_at_bot_mono (hg.integral_le_Sup_add_zsmul_of_pos h_int hT),
  apply at_bot.tendsto_at_bot_add_const_left (Sup $ (λ t, ∫ x in 0..t, g x) '' (Icc 0 T)),
  apply tendsto.at_bot_zsmul_const h₀,
  exact tendsto_floor_at_bot.comp (tendsto_id.at_bot_mul_const (inv_pos.mpr hT)),
end

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `∀ x, 0 < g x`, then `t ↦ ∫ x in 0..t, g x`
tends to `∞` as `t` tends to `∞`. -/
lemma tendsto_at_top_interval_integral_of_pos' (h₀ : ∀ x, 0 < g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_top at_top :=
hg.tendsto_at_top_interval_integral_of_pos h_int (interval_integral_pos_of_pos (h_int 0 T) h₀ hT) hT

/-- If `g : ℝ → ℝ` is periodic with period `T > 0` and `∀ x, 0 < g x`, then `t ↦ ∫ x in 0..t, g x`
tends to `-∞` as `t` tends to `-∞`. -/
lemma tendsto_at_bot_interval_integral_of_pos' (h₀ : ∀ x, 0 < g x) (hT : 0 < T) :
  tendsto (λ t, ∫ x in 0..t, g x) at_bot at_bot :=
hg.tendsto_at_bot_interval_integral_of_pos h_int (interval_integral_pos_of_pos (h_int 0 T) h₀ hT) hT

end real_valued

end periodic

end function


import ring_theory.algebra

universes u v w u₁ v₁

namespace algebra

variables {R : Type u} {S : Type v} {A : Type w}
variables [comm_ring R] [comm_ring S] [ring A] [algebra R A]

lemma mul_sub_algebra_map_commutes (x : A) (r : R) :
  x * (x - algebra_map R A r) = (x - algebra_map R A r) * x :=
by rw [mul_sub, ←commutes, sub_mul]

lemma mul_sub_algebra_map_pow_commutes (x : A) (r : R) (n : ℕ) :
  x * (x - algebra_map R A r) ^ n = (x - algebra_map R A r) ^ n * x :=
begin
  induction n with n ih,
  { simp },
  { rw [pow_succ, ←mul_assoc, mul_sub_algebra_map_commutes,
      mul_assoc, ih, ←mul_assoc], }
end

end algebra

-- Put below endomorphism algebra
lemma module.endomorphism_algebra_map_apply (R : Type u) (M : Type v)
  [comm_ring R] [add_comm_group M] [module R M] (a : R) :
  (algebra_map R (M →ₗ[R] M)) a = a • linear_map.id := rfl

lemma module.endomorphism_algebra_map_apply2 (R : Type u) (M : Type v)
  [comm_ring R] [add_comm_group M] [module R M] (a : R) (m : M) :
  (algebra_map R (M →ₗ[R] M)) a m = a • m := rfl


/-
Copyright (c) 2022 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 algebra.ring.add_aut
! leanprover-community/mathlib commit a437a2499163d85d670479f69f625f461cc5fef9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.GroupAction.Group
import Mathlib.Algebra.Module.Basic

/-!
# Multiplication on the left/right as additive automorphisms

In this file we define `AddAut.mulLeft` and `AddAut.mulRight`.

See also `AddMonoidHom.mulLeft`, `AddMonoidHom.mulRight`, `AddMonoid.End.mulLeft`, and
`AddMonoid.End.mulRight` for multiplication by `R` as an endomorphism instead of multiplication by
`Rˣ` as an automorphism.
-/

namespace AddAut

variable {R : Type _} [Semiring R]

/-- Left multiplication by a unit of a semiring as an additive automorphism. -/
@[simps! (config := { simpRhs := true })]
def mulLeft : Rˣ →* AddAut R :=
  DistribMulAction.toAddAut _ _
#align add_aut.mul_left AddAut.mulLeft
#align add_aut.mul_left_apply_apply AddAut.mulLeft_apply_apply
#align add_aut.mul_left_apply_symm_apply AddAut.mulLeft_apply_symm_apply

/-- Right multiplication by a unit of a semiring as an additive automorphism. -/
def mulRight (u : Rˣ) : AddAut R :=
  DistribMulAction.toAddAut Rᵐᵒᵖˣ R (Units.opEquiv.symm <| MulOpposite.op u)
#align add_aut.mul_right AddAut.mulRight

@[simp]
theorem mulRight_apply (u : Rˣ) (x : R) : mulRight u x = x * u :=
  rfl
#align add_aut.mul_right_apply AddAut.mulRight_apply

@[simp]
theorem mulRight_symm_apply (u : Rˣ) (x : R) : (mulRight u).symm x = x * u⁻¹ :=
  rfl
#align add_aut.mul_right_symm_apply AddAut.mulRight_symm_apply

end AddAut


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Chris Hughes, Michael Howes
-/
import algebra.group.semiconj
import algebra.group_with_zero.basic
import algebra.hom.aut
import algebra.hom.group

/-!
# Conjugacy of group elements

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

See also `mul_aut.conj` and `quandle.conj`.
-/

universes u v
variables {α : Type u} {β : Type v}

section monoid

variables [monoid α] [monoid β]

/-- We say that `a` is conjugate to `b` if for some unit `c` we have `c * a * c⁻¹ = b`. -/
def is_conj (a b : α) := ∃ c : αˣ, semiconj_by ↑c a b

@[refl] lemma is_conj.refl (a : α) : is_conj a a :=
⟨1, semiconj_by.one_left a⟩

@[symm] lemma is_conj.symm {a b : α} : is_conj a b → is_conj b a
| ⟨c, hc⟩ := ⟨c⁻¹, hc.units_inv_symm_left⟩

lemma is_conj_comm {g h : α} : is_conj g h ↔ is_conj h g :=
⟨is_conj.symm, is_conj.symm⟩

@[trans] lemma is_conj.trans {a b c : α} : is_conj a b → is_conj b c → is_conj a c
| ⟨c₁, hc₁⟩ ⟨c₂, hc₂⟩ := ⟨c₂ * c₁, hc₂.mul_left hc₁⟩

@[simp] lemma is_conj_iff_eq {α : Type*} [comm_monoid α] {a b : α} : is_conj a b ↔ a = b :=
⟨λ ⟨c, hc⟩, begin
  rw [semiconj_by, mul_comm, ← units.mul_inv_eq_iff_eq_mul, mul_assoc, c.mul_inv, mul_one] at hc,
  exact hc,
end, λ h, by rw h⟩

protected lemma monoid_hom.map_is_conj (f : α →* β) {a b : α} : is_conj a b → is_conj (f a) (f b)
| ⟨c, hc⟩ := ⟨units.map f c, by rw [units.coe_map, semiconj_by, ← f.map_mul, hc.eq, f.map_mul]⟩

end monoid

section cancel_monoid

variables [cancel_monoid α]
-- These lemmas hold for `right_cancel_monoid` with the current proofs, but for the sake of
-- not duplicating code (these lemmas also hold for `left_cancel_monoids`) we leave these
-- not generalised.

@[simp] lemma is_conj_one_right {a : α} : is_conj 1 a  ↔ a = 1 :=
⟨λ ⟨c, hc⟩, mul_right_cancel (hc.symm.trans ((mul_one _).trans (one_mul _).symm)), λ h, by rw [h]⟩

@[simp] lemma is_conj_one_left {a : α} : is_conj a 1 ↔ a = 1 :=
calc is_conj a 1 ↔ is_conj 1 a : ⟨is_conj.symm, is_conj.symm⟩
... ↔ a = 1 : is_conj_one_right

end cancel_monoid

section group

variables [group α]

@[simp] lemma is_conj_iff {a b : α} :
  is_conj a b ↔ ∃ c : α, c * a * c⁻¹ = b :=
⟨λ ⟨c, hc⟩, ⟨c, mul_inv_eq_iff_eq_mul.2 hc⟩, λ ⟨c, hc⟩,
  ⟨⟨c, c⁻¹, mul_inv_self c, inv_mul_self c⟩, mul_inv_eq_iff_eq_mul.1 hc⟩⟩

@[simp] lemma conj_inv {a b : α} : (b * a * b⁻¹)⁻¹ = b * a⁻¹ * b⁻¹ :=
((mul_aut.conj b).map_inv a).symm

@[simp] lemma conj_mul {a b c : α} : (b * a * b⁻¹) * (b * c * b⁻¹) = b * (a * c) * b⁻¹ :=
((mul_aut.conj b).map_mul a c).symm

@[simp] lemma conj_pow {i : ℕ} {a b : α} : (a * b * a⁻¹) ^ i = a * (b ^ i) * a⁻¹ :=
begin
  induction i with i hi,
  { simp },
  { simp [pow_succ, hi] }
end

@[simp] lemma conj_zpow {i : ℤ} {a b : α} : (a * b * a⁻¹) ^ i = a * (b ^ i) * a⁻¹ :=
begin
  induction i,
  { simp },
  { simp [zpow_neg_succ_of_nat, conj_pow] }
end

lemma conj_injective {x : α} : function.injective (λ (g : α), x * g * x⁻¹) :=
(mul_aut.conj x).injective

end group

@[simp] lemma is_conj_iff₀ [group_with_zero α] {a b : α} :
  is_conj a b ↔ ∃ c : α, c ≠ 0 ∧ c * a * c⁻¹ = b :=
⟨λ ⟨c, hc⟩, ⟨c, begin
    rw [← units.coe_inv, units.mul_inv_eq_iff_eq_mul],
    exact ⟨c.ne_zero, hc⟩,
  end⟩, λ ⟨c, c0, hc⟩,
  ⟨units.mk0 c c0, begin
    rw [semiconj_by, ← units.mul_inv_eq_iff_eq_mul, units.coe_inv, units.coe_mk0],
    exact hc
  end⟩⟩

namespace is_conj
/- This small quotient API is largely copied from the API of `associates`;
where possible, try to keep them in sync -/

/-- The setoid of the relation `is_conj` iff there is a unit `u` such that `u * x = y * u` -/
protected def setoid (α : Type*) [monoid α] : setoid α :=
{ r := is_conj, iseqv := ⟨is_conj.refl, λa b, is_conj.symm, λa b c, is_conj.trans⟩ }

end is_conj

local attribute [instance, priority 100] is_conj.setoid

/-- The quotient type of conjugacy classes of a group. -/
def conj_classes (α : Type*) [monoid α] : Type* :=
quotient (is_conj.setoid α)

namespace conj_classes

section monoid
variables [monoid α] [monoid β]

/-- The canonical quotient map from a monoid `α` into the `conj_classes` of `α` -/
protected def mk {α : Type*} [monoid α] (a : α) : conj_classes α :=
⟦a⟧

instance : inhabited (conj_classes α) := ⟨⟦1⟧⟩

theorem mk_eq_mk_iff_is_conj {a b : α} :
  conj_classes.mk a = conj_classes.mk b ↔ is_conj a b :=
iff.intro quotient.exact quot.sound

theorem quotient_mk_eq_mk (a : α) : ⟦ a ⟧ = conj_classes.mk a := rfl

theorem quot_mk_eq_mk (a : α) : quot.mk setoid.r a = conj_classes.mk a := rfl

theorem forall_is_conj {p : conj_classes α → Prop} :
  (∀a, p a) ↔ (∀a, p (conj_classes.mk a)) :=
iff.intro
  (assume h a, h _)
  (assume h a, quotient.induction_on a h)

theorem mk_surjective : function.surjective (@conj_classes.mk α _) :=
forall_is_conj.2 (λ a, ⟨a, rfl⟩)

instance : has_one (conj_classes α) := ⟨⟦ 1 ⟧⟩

theorem one_eq_mk_one : (1 : conj_classes α) = conj_classes.mk 1 := rfl

lemma exists_rep (a : conj_classes α) : ∃ a0 : α, conj_classes.mk a0 = a :=
quot.exists_rep a

/-- A `monoid_hom` maps conjugacy classes of one group to conjugacy classes of another. -/
def map (f : α →* β) : conj_classes α → conj_classes β :=
quotient.lift (conj_classes.mk ∘ f) (λ a b ab, mk_eq_mk_iff_is_conj.2 (f.map_is_conj ab))

lemma map_surjective {f : α →* β} (hf : function.surjective f) :
  function.surjective (conj_classes.map f) :=
begin
  intros b,
  obtain ⟨b, rfl⟩ := conj_classes.mk_surjective b,
  obtain ⟨a, rfl⟩ := hf b,
  exact ⟨conj_classes.mk a, rfl⟩,
end

/--
Certain instances trigger further searches when they are considered as candidate instances;
these instances should be assigned a priority lower than the default of 1000 (for example, 900).

The conditions for this rule are as follows:
 * a class `C` has instances `instT : C T` and `instT' : C T'`
 * types `T` and `T'` are both specializations of another type `S`
 * the parameters supplied to `S` to produce `T` are not (fully) determined by `instT`,
   instead they have to be found by instance search
If those conditions hold, the instance `instT` should be assigned lower priority.

For example, suppose the search for an instance of `decidable_eq (multiset α)` tries the
candidate instance `con.quotient.decidable_eq (c : con M) : decidable_eq c.quotient`.
Since `multiset` and `con.quotient` are both quotient types, unification will check
that the relations `list.perm` and `c.to_setoid.r` unify. However, `c.to_setoid` depends on
a `has_mul M` instance, so this unification triggers a search for `has_mul (list α)`;
this will traverse all subclasses of `has_mul` before failing.
On the other hand, the search for an instance of `decidable_eq (con.quotient c)` for `c : con M`
can quickly reject the candidate instance `multiset.has_decidable_eq` because the type of
`list.perm : list ?m_1 → list ?m_1 → Prop` does not unify with `M → M → Prop`.
Therefore, we should assign `con.quotient.decidable_eq` a lower priority because it fails slowly.
(In terms of the rules above, `C := decidable_eq`, `T := con.quotient`,
`instT := con.quotient.decidable_eq`, `T' := multiset`, `instT' := multiset.has_decidable_eq`,
and `S := quot`.)

If the type involved is a free variable (rather than an instantiation of some type `S`),
the instance priority should be even lower, see Note [lower instance priority].
-/
library_note "slow-failing instance priority"

@[priority 900] -- see Note [slow-failing instance priority]
instance [decidable_rel (is_conj : α → α → Prop)] : decidable_eq (conj_classes α) :=
quotient.decidable_eq

end monoid

section comm_monoid
variable [comm_monoid α]

lemma mk_injective : function.injective (@conj_classes.mk α _) :=
λ _ _, (mk_eq_mk_iff_is_conj.trans is_conj_iff_eq).1

lemma mk_bijective : function.bijective (@conj_classes.mk α _) :=
⟨mk_injective, mk_surjective⟩

/-- The bijection between a `comm_group` and its `conj_classes`. -/
def mk_equiv : α ≃ conj_classes α :=
⟨conj_classes.mk, quotient.lift id (λ (a : α) b, is_conj_iff_eq.1), quotient.lift_mk _ _,
  begin
    rw [function.right_inverse, function.left_inverse, forall_is_conj],
    intro x,
    rw [← quotient_mk_eq_mk, ← quotient_mk_eq_mk, quotient.lift_mk, id.def],
  end⟩

end comm_monoid
end conj_classes

section monoid

variables [monoid α]

/-- Given an element `a`, `conjugates a` is the set of conjugates. -/
def conjugates_of (a : α) : set α := {b | is_conj a b}

lemma mem_conjugates_of_self {a : α} : a ∈ conjugates_of a := is_conj.refl _

lemma is_conj.conjugates_of_eq {a b : α} (ab : is_conj a b) :
  conjugates_of a = conjugates_of b :=
set.ext (λ g, ⟨λ ag, (ab.symm).trans ag, λ bg, ab.trans bg⟩)

lemma is_conj_iff_conjugates_of_eq {a b : α} :
  is_conj a b ↔ conjugates_of a = conjugates_of b :=
⟨is_conj.conjugates_of_eq, λ h, begin
  have ha := mem_conjugates_of_self,
  rwa ← h at ha,
end⟩

end monoid

namespace conj_classes

variables [monoid α]

local attribute [instance] is_conj.setoid

/-- Given a conjugacy class `a`, `carrier a` is the set it represents. -/
def carrier : conj_classes α → set α :=
quotient.lift conjugates_of (λ (a : α) b ab, is_conj.conjugates_of_eq ab)

lemma mem_carrier_mk {a : α} : a ∈ carrier (conj_classes.mk a) := is_conj.refl _

lemma mem_carrier_iff_mk_eq {a : α} {b : conj_classes α} :
  a ∈ carrier b ↔ conj_classes.mk a = b :=
begin
  revert b,
  rw forall_is_conj,
  intro b,
  rw [carrier, eq_comm, mk_eq_mk_iff_is_conj, ← quotient_mk_eq_mk, quotient.lift_mk],
  refl,
end

lemma carrier_eq_preimage_mk {a : conj_classes α} :
  a.carrier = conj_classes.mk ⁻¹' {a} :=
set.ext (λ x, mem_carrier_iff_mk_eq)

end conj_classes

assert_not_exists multiset


-- Pruebas_de_que_la_funcion_espejo_de_los_arboles_binarios_es_involutiva.lean
-- Pruebas de que la función espejo de los árboles binarios es involutiva
-- José A. Alonso Jiménez
-- Sevilla, 12 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- El árbol correspondiente a
--        3
--       / \
--      2   4
--     / \
--    1   5
-- se puede representar por el término
--    nodo 3 (nodo 2 (hoja 1) (hoja 5)) (hoja 4)
-- usado el tipo de dato arbol definido por
--    inductive arbol (α : Type) : Type
--    | hoja : α → arbol
--    | nodo : α → arbol → arbol → arbol
--
-- La imagen especular del árbol anterior es
--      3
--     / \
--    4   2
--       / \
--      5   1
-- cuyo término es
--    nodo 3 (hoja 4) (nodo 2 (hoja 5) (hoja 1))
--
-- La definición de la función que calcula la imagen especular es
--    def espejo : arbol α → arbol α
--    | (hoja x)     := hoja x
--    | (nodo x i d) := nodo x (espejo d) (espejo i)
--
-- Demostrar que la función espejo es involutiva; es decir,
--    espejo (espejo a) = a
-- ---------------------------------------------------------------------

import tactic

variable  {α : Type}

inductive arbol (α : Type) : Type
| hoja : α → arbol
| nodo : α → arbol → arbol → arbol

namespace arbol

variables (a i d : arbol α)
variable  (x : α)

def espejo : arbol α → arbol α
| (hoja x)     := hoja x
| (nodo x i d) := nodo x (espejo d) (espejo i)

@[simp]
lemma espejo_1 :
  espejo (hoja x) = hoja x :=
espejo.equations._eqn_1 x

@[simp]
lemma espejo_2 :
  espejo (nodo x i d) = nodo x (espejo d) (espejo i) :=
espejo.equations._eqn_2 x i d

-- 1ª demostración
example :
  espejo (espejo a) = a :=
begin
  induction a with x x i d Hi Hd,
  { rw espejo_1,
    rw espejo_1, },
  { rw espejo_2,
    rw espejo_2,
    rw Hi,
    rw Hd, },
end

-- 2ª demostración
example :
  espejo (espejo a) = a :=
begin
  induction a with x x i d Hi Hd,
  { calc espejo (espejo (hoja x))
         = espejo (hoja x)
             : congr_arg espejo (espejo_1 x)
     ... = hoja x
             : espejo_1 x, },
  { calc espejo (espejo (nodo x i d))
         = espejo (nodo x (espejo d) (espejo i))
             : congr_arg espejo (espejo_2 i d x)
     ... = nodo x (espejo (espejo i)) (espejo (espejo d))
             : espejo_2 (espejo d) (espejo i) x
     ... = nodo x i (espejo (espejo d))
             : congr_arg2 (nodo x) Hi rfl
     ... = nodo x i d
             : congr_arg2 (nodo x) rfl Hd, },
end

-- 3ª demostración
example :
  espejo (espejo a) = a :=
begin
  induction a with x x i d Hi Hd,
  { calc espejo (espejo (hoja x))
         = espejo (hoja x)
             : congr_arg espejo (espejo_1 x)
     ... = hoja x
             : by rw espejo_1, },
  { calc espejo (espejo (nodo x i d))
         = espejo (nodo x (espejo d) (espejo i))
             : congr_arg espejo (espejo_2 i d x)
     ... = nodo x (espejo (espejo i)) (espejo (espejo d))
             : by rw espejo_2
     ... = nodo x i (espejo (espejo d))
             : by rw Hi
     ... = nodo x i d
             : by rw Hd, },
end

-- 4ª demostración
example :
  espejo (espejo a) = a :=
begin
  induction a with x x i d Hi Hd,
  { calc espejo (espejo (hoja x))
         = espejo (hoja x)
             : by simp
     ... = hoja x
             : by simp },
  { calc espejo (espejo (nodo x i d))
         = espejo (nodo x (espejo d) (espejo i))
             : by simp
     ... = nodo x (espejo (espejo i)) (espejo (espejo d))
             : by simp
     ... = nodo x i (espejo (espejo d))
             : by simp [Hi]
     ... = nodo x i d
             : by simp [Hd], },
end

-- 5ª demostración
example :
  espejo (espejo a) = a :=
begin
  induction a with _ x i d Hi Hd,
  { simp, },
  { simp [Hi, Hd], },
end

-- 6ª demostración
example :
  espejo (espejo a) = a :=
by induction a ; simp [*]

-- 7ª demostración
example :
  espejo (espejo a) = a :=
arbol.rec_on a
  ( assume x,
    calc espejo (espejo (hoja x))
         = espejo (hoja x)
             : congr_arg espejo (espejo_1 x)
     ... = hoja x
             : espejo_1 x)
  ( assume x i d,
    assume Hi : espejo (espejo i) = i,
    assume Hd : espejo (espejo d) = d,
    calc espejo (espejo (nodo x i d))
         = espejo (nodo x (espejo d) (espejo i))
             : congr_arg espejo (espejo_2 i d x)
     ... = nodo x (espejo (espejo i)) (espejo (espejo d))
             : by rw espejo_2
     ... = nodo x i (espejo (espejo d))
             : by rw Hi
     ... = nodo x i d
             : by rw Hd )

-- 8ª demostración
example :
  espejo (espejo a) = a :=
arbol.rec_on a
  (λ x, by simp )
  (λ x i d Hi Hd, by simp [Hi,Hd])

-- 9ª demostración
lemma espejo_espejo :
  ∀ a : arbol α, espejo (espejo a) = a
| (hoja x)     := by simp
| (nodo x i d) := by simp [espejo_espejo i, espejo_espejo d]

end arbol


/-
Copyright (c) 2021 Tianchen Zhao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tianchen Zhao
-/
import incidence.basic

/-!
# Order on incidence geometry and segments

This file formalises betweenness based on `incidence_geometry`, defines line segments
and proves some important lemmas such as Pasch's.

## Main definitions

* `incidence_order_geometry` is a class extended by `incidence_geometry` and defines
  a ternary relation `between` satisfying some axioms.

* `seg`, with notation `-ₛ`, is the unique segment determined by the given two points.

## References

* See [Geometry: Euclid and Beyond]

-/

open_locale classical

/--An incidence order geometry is an incidence geometry with betweenness, a ternary relation
for `pts`. `between a b c` means `b` is between `a` and `c`, restricted by some axioms :
B1 : If a point is between the other two, they are col.
B2 : We can extend two distinct points.
B3 : Given 3 distinct points, exactly one of them is between the other two.
B4 : Pasch's axiom. `a`, `b`, `c` are noncol and for a line `l` not containing any of them,
     if `l` contains a points between `a` and `b`, it contains a points either between `a` and
     `c` or between `b` and `c`.
-/
class incidence_order_geometry extends incidence_geometry :=
(between : pts → pts → pts → Prop)
(B1 : ∀ {a b c : pts}, between a b c → between c b a
                        ∧ (a ≠ b) ∧ (a ≠ c) ∧ (b ≠ c) ∧ col a b c)
(B2 : ∀ {a b : pts}, a ≠ b → ∃ c : pts, between a b c)
(B3 : (∀ {a b c : pts}, ∀ {l : set pts}, l ∈ lines → a ∈ l ∧ b ∈ l ∧ c ∈ l →
(a ≠ b → a ≠ c → b ≠ c → between a b c ∨ between a c b ∨ between b a c)) ∧
∀ a b c : pts, ¬(between a b c ∧ between b a c)
∧ ¬(between a b c ∧ between a c b) ∧ ¬(between b a c ∧ between a c b))
(B4 : ∀ {a b c : pts} (l ∈ lines),
      (noncol a b c) → a ∉ l → b ∉ l → c ∉ l
      → (∃ d : pts, between a d b ∧ d ∈ l) →
      (∃ p : pts, p ∈ l ∧ (between a p c ∨ between b p c))
      ∧ ∀ p q : pts, p ∈ l → q ∈ l → ¬(between a p c ∧ between b q c))

variable [B : incidence_order_geometry]

open incidence_geometry incidence_order_geometry

include B

lemma between_symm (a b c : pts) :
between a b c ↔ between c b a := iff.intro (λ h, (B1 h).1) (λ h, (B1 h).1)

lemma between_neq {a b c : pts} (h : between a b c) :
(a ≠ b) ∧ (a ≠ c) ∧ (b ≠ c) := ⟨(B1 h).2.1, (B1 h).2.2.1, (B1 h).2.2.2.1⟩

lemma between_col {a b c : pts}
(h : between a b c) : col a b c := (B1 h).2.2.2.2

lemma between_extend {a b : pts} (h : a ≠ b) :
∃ c : pts, between a b c := B2 h

lemma between_tri {a b c : pts} (habc : col a b c) (hab : a ≠ b) (hac : a ≠ c)
(hbc : b ≠ c) : between a b c ∨ between a c b ∨ between b a c :=
by { rcases habc with ⟨l, hl, habc⟩, exact B3.1 hl habc hab hac hbc }

lemma between_contra {a b c : pts} :
  ¬(between a b c ∧ between b a c)
∧ ¬(between a b c ∧ between a c b)
∧ ¬(between b a c ∧ between a c b) := B3.2 a b c

/--A type whose inside is a set containing two points and points between them. -/
structure seg := (inside : set pts)
(in_eq : ∃ a b : pts, inside = {x : pts | between a x b} ∪ {a, b})

/--A seg is proper if its inside is not a singleton.
Equivalently, `a` and `b` are distinct. -/
def seg_proper (s : seg) : Prop :=
∀ x : pts, s.inside ≠ {x}

/--Explicitly stating `a` and `b` defines a seg. -/
def two_pt_seg (a b : pts) : seg := ⟨{x : pts | between a x b} ∪ {a, b}, ⟨a, b, rfl⟩⟩

notation a`-ₛ`b := two_pt_seg a b

lemma pt_left_in_seg (a b : B.pts) : a ∈ (a-ₛb).inside :=
by { unfold two_pt_seg, simp }

lemma pt_right_in_seg (a b : B.pts) : b ∈ (a-ₛb).inside :=
by { unfold two_pt_seg, simp }

lemma seg_symm (a b : pts) : (a-ₛb) = (b-ₛa) :=
by {unfold two_pt_seg, simp, ext, simp, rw between_symm, tauto}

lemma seg_singleton (a : pts) : (a-ₛa).inside = {a} :=
begin
  unfold two_pt_seg, ext1, simp,
  intro haxa, exact absurd rfl (between_neq haxa).2.1
end

lemma seg_proper_iff_neq {a b : pts} :
seg_proper (a-ₛb) ↔ a ≠ b :=
begin
  split; intro h,
  { by_contra hab, push_neg at hab,
    rw hab at h, exact h b (seg_singleton b) },
  { intros x hf,
    have := pt_left_in_seg a b, rw hf at this,
    simp at this, rw this at h,
    have := pt_right_in_seg a b, rw hf at this,
    simp at this, rw this at h,
    exact h rfl }
end

lemma seg_in_line (a b : pts) : (a-ₛb).inside ⊆ (a-ₗb) :=
begin
  have hal : a ∈ (a-ₗb), from pt_left_in_line a b,
  have hbl : b ∈ (a-ₗb), from pt_right_in_line a b,
  by_cases hab : a = b,
    rw hab, rw hab at hbl, rw seg_singleton, simp, exact hbl,
  unfold two_pt_seg,
  apply set.union_subset,
  intros c hc, simp at hc,
  exact col_in13 (between_col hc) hab,
  intros x hx, simp at hx, cases hx with hx hx; rw hx,
  exact hal, exact hbl
end

lemma seg_two_pt (s : seg) : ∃ a b : pts, s = (a-ₛb) :=
begin
  induction s with inside in_eq,
  rcases in_eq with ⟨a, b, h⟩, use [a, b],
  unfold two_pt_seg, simp only, exact h
end

lemma seg_in_neq {a b x : pts} (hxa : x ≠ a) (hxb : x ≠ b) (hx : x ∈ (a-ₛb).inside) :
between a x b :=
begin
  rcases hx with hx | hf | hf,
  exact hx, exact absurd hf hxa, exact absurd hf hxb
end

/--This is in fact just a rephrase of B4. -/
theorem pasch {a b c : pts} (habc : noncol a b c) {l : set pts} (hl : l ∈ lines)
(hal : a ∉ l) (hbl : b ∉ l) (hcl : c ∉ l) (hlab : l ♥ (a-ₛb).inside) :
((l ♥ (a-ₛc).inside) ∨ (l ♥ (b-ₛc).inside)) ∧ ¬((l ♥ (a-ₛc).inside) ∧ (l ♥ (b-ₛc).inside)) :=
begin
  rcases hlab with ⟨d, hdl, hadb⟩,
  have hda : d ≠ a,
    intro hf, rw hf at hdl, exact hal hdl,
  have hdb : d ≠ b,
    intro hf, rw hf at hdl, exact hbl hdl,
  replace hadb := seg_in_neq hda hdb hadb,
  rcases (B4 l hl habc hal hbl hcl ⟨d, hadb, hdl⟩) with ⟨⟨p, hpl, h₁⟩, h₂⟩,
  split,
  { cases h₁,
    left, exact ⟨p, hpl, by {left, exact h₁}⟩,
    right, exact ⟨p, hpl, by {left, exact h₁}⟩ },
  { rintros ⟨⟨p, hpl, hapc⟩, ⟨q, hql, hbqc⟩⟩,
    have : ∀ x : pts, x ∈ l → x ≠ a ∧ x ≠ b ∧ x ≠ c,
      intros x hxl,
      refine ⟨_, _, _⟩; intro hf; rw hf at hxl,
      exact hal hxl, exact hbl hxl, exact hcl hxl,
    replace hapc := seg_in_neq (this p hpl).1 (this p hpl).2.2 hapc,
    replace hbqc := seg_in_neq (this q hql).2.1 (this q hql).2.2 hbqc,
    exact (h₂ p q hpl hql) ⟨hapc, hbqc⟩ }
end

lemma two_pt_between {a b : pts} (hab : a ≠ b) : ∃ c : pts, between a c b :=
begin
  cases noncol_exist hab with c habc,
  have hac := (noncol_neq habc).2.1,
  cases between_extend hac with d hacd,
  have had := (between_neq hacd).2.1,
  have hcd := (between_neq hacd).2.2,
  have hbd : b ≠ d,
    intro hf, rw hf at habc,
    exact (noncol23 habc) (between_col hacd),
  cases between_extend hbd with e hbde,
  have hbe := (between_neq hbde).2.1,
  have hde := (between_neq hbde).2.2,
  have hadb := col_noncol (between_col hacd) (noncol23 habc) had,
  have hce : c ≠ e,
    intro hf, rw ←hf at hbde,
    apply col_noncol (col12 (between_col hacd)) (noncol132 habc) hcd,
    exact col13 (between_col hbde),
  have hbea := col_noncol (between_col hbde) (noncol13 hadb) hbe,
  have heda := col_noncol (col132 (between_col hbde)) (noncol12 hbea) hde.symm,
  have hace := col_noncol (col23 (between_col hacd)) (noncol13 heda) hac,
  have hdce := col_noncol (col132 (between_col hacd)) (noncol123 heda) hcd.symm,
  have hebc := col_noncol (col13 (between_col hbde)) (noncol132 hdce) hbe.symm,
  have : ((c-ₗe)♥(a-ₛd).inside), from ⟨c, pt_left_in_line c e, by {left, exact hacd}⟩,
  cases (pasch hadb (line_in_lines hce) (noncol_in23 hace) (noncol_in23 hdce)
    (noncol_in31 hebc) this).1,
  { cases h with x hx,
    rcases hx.2 with haxb | hf | hf,
    exact ⟨x, haxb⟩,
    rw hf at hx, exact absurd hx.1 (noncol_in23 hace),
    simp at hf, rw hf at hx, exact absurd hx.1 (noncol_in31 hebc) },
  { cases h with x hx,
    have : x = e,
      apply two_line_one_pt (line_in_lines hce) (line_in_lines hbd.symm) _ hx.1
        ((seg_in_line d b) hx.2) (pt_right_in_line c e) (col_in21 (between_col hbde) hbd.symm),
      intro hf, apply noncol_in31 hebc, rw hf, exact pt_right_in_line d b,
    rw this at hx, rcases hx.2 with hf | hf | hf,
    { rw between_symm at hbde, exfalso,
      apply between_contra.1 ⟨hf, hbde⟩ },
    exact absurd hf.symm hde,
    exact absurd hf hbe.symm }
end


-- Proves infinitude of primes using group theory.

import data.nat.basic
import data.nat.prime
import data.zmod.basic
import field_theory.finite.basic  -- order_of_dvd_card_sub_one
import group_theory.order_of_element  -- order_of_eq_prime
import order.monotone.basic

-- Two important properties:
#check @zmod.order_of_dvd_card_sub_one
#check @order_of_eq_prime

def mersenne (n : ℕ) := 2 ^ n - 1  -- number_theory.lucas_lehmer

lemma order_eq_of_two_ne_one {p q : ℕ} [hp : fact (nat.prime p)] :
  (2 : zmod q) ≠ 1 → (2 : zmod q)^p = 1 → order_of (2 : zmod q) = p :=
begin
  intro h_ne,
  intro h,
  apply order_of_eq_prime h h_ne,
end

-- 2 ≠ 1 in F_q for q ≥ 2.
-- Useful for order_of_eq_prime.
lemma zmod_two_ne_one {q : ℕ} : 2 ≤ q → (2 : zmod q) ≠ 1 :=
begin
  intro hq,
  simp,
  have h_mod := @zmod.eq_iff_modeq_nat q 2 1,
  simp at h_mod,  -- Need to simp before rw (lifts constants to zmod q).
  rw h_mod,
  have hq := has_le.le.eq_or_lt hq,
  cases hq with hq hq,
    rw ← hq, dec_trivial,
  intro h,
  have h := nat.modeq.eq_of_lt_of_lt h hq _,
    -- 2 ≡ 0 [MOD q] with q = 2
    simp at h, exact h,
  -- 2 ≡ 2 [MOD q] with q > 2
  apply lt_trans _ hq,  -- 1 < 2 < q
  dec_trivial,
end

-- 2 ≠ 0 in F_q for q > 2.
-- Useful for zmod.order_of_dvd_card_sub_one.
lemma zmod_two_ne_zero {q : ℕ} : 2 < q → (2 : zmod q) ≠ 0 :=
begin
  intro h2,
  have h_mod := @zmod.eq_iff_modeq_nat q 2 0,
  simp at h_mod,  -- Need to simplify before rewrite (apply the casts).
  simp,
  rw h_mod,
  rw nat.modeq_zero_iff_dvd,
  intro h,
  have h := nat.le_of_dvd (dec_trivial) h,
  apply has_lt.lt.not_le h2 h,
end

-- 2 ^ q = 1 if q ∣ mersenne p.
-- Useful for order_of_eq_prime.
lemma zmod_two_pow_eq_one_of_mersenne {p q : ℕ} :
  q ∣ mersenne p → (2 : zmod q)^p = 1 :=
begin
  rw mersenne,
  intro h_dvd,
  rw ← nat.modeq_zero_iff_dvd at h_dvd,
  rw ← zmod.eq_iff_modeq_nat at h_dvd,
  simp at h_dvd,
  rw sub_eq_zero at h_dvd,
  exact h_dvd,
end

lemma two_pow_even {n : ℕ} : 0 < n → 2 ∣ 2 ^ n :=
begin
  cases n, simp,
  simp [pow_succ],
end

lemma mersenne_odd {n : ℕ} : 0 < n → ¬ 2 ∣ mersenne n :=
begin
  rw mersenne,
  cases n,
    simp,
  simp,
  rw pow_succ,
  have h : ∀ (k : ℕ), 1 ≤ k → (2 * k - 1) % 2 = 1 := _,
    apply h,
    apply nat.one_le_two_pow,
  intro k,
  cases k, simp,
  intro h, clear h,
  rw nat.mul_succ,
  simp,
  rw mul_comm,
  rw nat.mul_add_mod,
  simp,
end

lemma lt_of_dvd_sub_one {p q : ℕ} : 2 < q → p ∣ q - 1 → p < q :=
begin
  cases q, simp,  -- Consider (q.succ) - 1 = q.
  simp,
  intro hq,
  intro h_dvd,
  apply nat.lt_succ_of_le,
  apply nat.le_of_dvd _ h_dvd,
  have hq := nat.le_of_lt_succ hq,
  apply lt_of_le_of_lt' hq,
  dec_trivial,
end

-- For p prime, any prime factor q of (mersenne p) satisfies p < q.
theorem lt_of_dvd_mersenne {p q : ℕ} [hp : fact p.prime] [hq : fact q.prime] :
  q ∣ mersenne p → p < q :=
begin
  intro h_mersenne,
  have hq' : 2 < q := _,  -- 2 < q since q prime, q ∣ mersenne p, (mersenne p) is odd.
    -- Use (fact q.prime).
    have h_dvd : order_of (2 : zmod q) ∣ q - 1 := zmod.order_of_dvd_card_sub_one _,
      -- Use (fact p.prime).
      have h_eq : order_of (2 : zmod q) = p := order_of_eq_prime _ _,
          -- Show p < q since p ∣ (q - 1).
          rw h_eq at h_dvd,
          apply lt_of_dvd_sub_one hq' h_dvd,
        apply zmod_two_pow_eq_one_of_mersenne h_mersenne,
      apply zmod_two_ne_one (le_of_lt hq'),
    apply zmod_two_ne_zero hq',
  have h2 := nat.prime.two_le hq.out,
  rw le_iff_eq_or_lt at h2,
  cases h2,
    exfalso,
    revert h_mersenne,
    rw ← h2,
    apply mersenne_odd,
    apply lt_trans nat.zero_lt_one (nat.prime.one_lt hp.out),
  exact h2,
end

lemma two_lt_two_pow {n : ℕ} : 1 < n → 2 < 2^n :=
begin
  cases n, simp,
  cases n, simp,
  simp,
  rw pow_succ,
  simp,
  apply nat.one_lt_two_pow,
  simp,
end

lemma one_lt_mersenne {n : ℕ} : 1 < n → 1 < mersenne n :=
begin
  cases n, simp,
  cases n, simp,
  intro h, clear h,
  rw mersenne,
  apply nat.lt_of_succ_lt_succ,
  rw ← nat.add_one,
  rw ← nat.add_one,
  rw nat.sub_add_cancel _,
    apply two_lt_two_pow, simp,
  apply le_of_lt,
  apply nat.one_lt_two_pow,
  simp,
end

-- Prove that make_prime n generates a new prime number for any n.
theorem infinite_primes (p : ℕ) :
  nat.prime p → ∃ (q : ℕ), nat.prime q ∧ p < q :=
begin
  intro hp,
  apply exists.intro (mersenne p).min_fac,
  have hq := @nat.min_fac_prime (mersenne p) _,
    apply and.intro hq,
    apply @lt_of_dvd_mersenne p (mersenne p).min_fac (fact.mk hp) (fact.mk hq),
    apply nat.min_fac_dvd,
  have h := one_lt_mersenne (nat.prime.one_lt hp),
  intro h', rw h' at h, simp at h, exact h,
end

-- Just for fun, try out the mapping from ℕ to primes.
def make_prime : ℕ → ℕ
| 0 := 2
| (n+1) := (mersenne (make_prime n)).min_fac

#eval make_prime 3  -- 127
-- make_prime 4 requires (2^127 - 1).min_fac

lemma one_lt_make_prime (n : ℕ) : 1 < make_prime n :=
begin
  induction n with k hk,
    rw make_prime, simp,
  rw make_prime,
  apply nat.prime.one_lt,
  apply nat.min_fac_prime,
  have h := one_lt_mersenne hk,
  intro h',
  rw h' at h, simp at h, contradiction,
end

lemma make_prime_is_prime (n : ℕ) : (make_prime n).prime :=
begin
  cases n, rw make_prime, apply nat.prime_two,
  rw make_prime,
  apply nat.min_fac_prime,
  have h := one_lt_mersenne (one_lt_make_prime n),
  intro h',
  rw h' at h, simp at h, contradiction,
end

lemma make_prime_lt_make_prime_succ (k : ℕ) : make_prime k < make_prime k.succ :=
begin
  have hp := make_prime_is_prime k,
  have hq := make_prime_is_prime k.succ,
  apply @lt_of_dvd_mersenne (make_prime k) (make_prime k.succ) (fact.mk hp) (fact.mk hq),
  rw make_prime,
  apply nat.min_fac_dvd,
end

lemma make_prime_strict_mono {k n : ℕ} : k < n → make_prime k < make_prime n :=
  by apply strict_mono_nat_of_lt_succ make_prime_lt_make_prime_succ

-- Prove that make_prime n generates a new prime number for any n.
theorem infinite_primes' (n : ℕ) :
  nat.prime (make_prime n) ∧ ∀ (k : ℕ), k < n → make_prime k < make_prime n :=
begin
  apply and.intro (make_prime_is_prime _),
  intro k,
  exact make_prime_strict_mono,
end


import mod_forms.Eisenstein_Series.Eisen_is_holo
import data.complex.exponential
import analysis.complex.upper_half_plane.basic
import mod_forms.Riemann_zeta_fin
import analysis.calculus.iterated_deriv
import analysis.calculus.series

noncomputable theory

open modular_form Eisenstein_series upper_half_plane topological_space set measure_theory
interval_integral metric filter function complex
open_locale interval real nnreal ennreal topology big_operators nat

def Eisenstein_series (k : ℤ) := if h : 3 ≤ k then (Eisenstein_series_is_modular_form k h) else 0

local notation `G[` k `]` :=  (Eisenstein_series k)

def Eisenstein_4 := 60 • G[4]

def Eisenstein_6 := 140 • G[6]

local notation `E₄` := Eisenstein_4

local notation `E₆` := Eisenstein_6

def discriminant_form : modular_form ⊤ 12 := (E₄).mul ((E₄).mul E₄) - 27 • ((E₆).mul E₆)

open_locale direct_sum big_operators

local notation `ℍ` := upper_half_plane

example  : comm_ring (⨁ (n : ℤ),  modular_form ⊤ n) := by apply_instance

variable (v :(⨁ (n : ℕ),  modular_form ⊤ n))

def E4:= direct_sum.of _ 4 Eisenstein_4

def E6:= direct_sum.of _ 6 Eisenstein_6

lemma gmul_eq_mul {a b : ℤ} (f : modular_form ⊤ a) (g : modular_form ⊤ b) :
  graded_monoid.ghas_mul.mul f g = f.mul g :=
begin
refl,
end

def Delta := E4^3-27*E6^2

lemma eqvs_of_defs : direct_sum.of _ 12 discriminant_form = Delta :=
begin
  rw Delta,
  rw E4,
  rw E6,
  rw discriminant_form,
  simp only [map_sub, map_nsmul, nsmul_eq_mul, nat.cast_bit1, nat.cast_bit0, algebra_map.coe_one],
  congr,
  rw pow_three,
  simp_rw direct_sum.of_mul_of,
  simp_rw gmul_eq_mul,
  congr,
  rw pow_two,
  simp_rw direct_sum.of_mul_of,
  simp_rw gmul_eq_mul,
  congr,
end


import field_theory.finite.galois_field
import ring_theory.dedekind_domain.adic_valuation
import ring_theory.dedekind_domain.integral_closure

import ring_theory.valuation.tfae

noncomputable theory

lemma power_series.coeff_zero_eq_eval {K : Type*} [semiring K] (f : power_series K) :
  (power_series.coeff K 0) f = f 0 :=
by simp only [power_series.coeff, mv_power_series.coeff, linear_map.coe_proj,
  function.eval_apply, finsupp.single_zero]

instance power_series.is_principal_ideal_ring (K : Type*) [field K] :
  is_principal_ideal_ring (power_series K) :=
begin
  rw is_principal_ideal_ring_iff,
  intros I,
  by_cases hI : I = ⊥,
  { rw hI,
    exact bot_is_principal, },
  { have hI': ∃ n : ℕ, I = ideal.span{power_series.X^n},
    { -- n is the minimum order of the elements in I (TODO: finish proof)
      sorry },
    obtain ⟨n, hn⟩ := hI',
    rw hn,
    use [power_series.X^n, rfl] }
end

instance power_series.is_noetherian_ring (K : Type*) [field K]:
  is_noetherian_ring (power_series K) :=
principal_ideal_ring.is_noetherian_ring

lemma power_series.maximal_ideal_eq_span_X {K : Type*} [field K] :
  local_ring.maximal_ideal (power_series K) = ideal.span {power_series.X} :=
begin
  have hX : (ideal.span {(power_series.X : power_series K)}).is_maximal,
  { rw ideal.is_maximal_iff,
    split,
    { rw ideal.mem_span_singleton,
      exact prime.not_dvd_one power_series.X_prime, },
    intros I f hI hfX hfI,
    rw [ideal.mem_span_singleton, power_series.X_dvd_iff] at hfX,
    have hfI0 : power_series.C K (f 0) ∈ I,
    { have : power_series.C K (f 0) = f - (f - power_series.C K (f 0)),
      { rw sub_sub_cancel, },
      rw this,
      apply ideal.sub_mem I hfI,
      apply hI,
      rw [ideal.mem_span_singleton, power_series.X_dvd_iff, map_sub, power_series.constant_coeff_C,
        ← power_series.coeff_zero_eq_constant_coeff_apply, power_series.coeff_zero_eq_eval,
        sub_eq_zero] },
    rw ← ideal.eq_top_iff_one,
    apply ideal.eq_top_of_is_unit_mem I hfI0 (is_unit.map (power_series.C K) (ne.is_unit hfX)) },
  rw local_ring.eq_maximal_ideal hX,
end

lemma power_series.maximal_ideal_is_principal (K : Type*) [field K] :
  submodule.is_principal (local_ring.maximal_ideal (power_series K)) :=
begin
  rw [power_series.maximal_ideal_eq_span_X, submodule.is_principal_iff],
  exact ⟨power_series.X, rfl⟩,
end

lemma power_series.not_is_field (R : Type*) [comm_ring R] [nontrivial R] :
  ¬ is_field (power_series R) :=
begin
  nontriviality R,
  rw ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top,
  use ideal.span {power_series.X},
  split,
  { rw [bot_lt_iff_ne_bot, ne.def, ideal.span_singleton_eq_bot],
    exact power_series.X_ne_zero, },
  { rw [lt_top_iff_ne_top, ne.def, ideal.eq_top_iff_one, ideal.mem_span_singleton,
      power_series.X_dvd_iff, power_series.constant_coeff_one],
    exact one_ne_zero },
end

-- really slow (tfae?)
noncomputable! instance power_series.discrete_valuation_ring (K : Type*) [field K] :
  discrete_valuation_ring (power_series K) :=
begin
  rw list.tfae.out (discrete_valuation_ring.tfae (power_series K)
    (power_series.not_is_field K)) 0 4,
  exact power_series.maximal_ideal_is_principal K,
end

noncomputable! instance power_series.is_dedekind_domain (K : Type*) [field K] :
  is_dedekind_domain (power_series K) := infer_instance