/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import ring_theory.ideal.operations
import algebra.module.torsion
import algebra.ring.idempotents
import linear_algebra.finite_dimensional
import ring_theory.ideal.local_ring

/-!
# The module `I ⧸ I ^ 2`

In this file, we provide special API support for the module `I ⧸ I ^ 2`. The official
definition is a quotient module of `I`, but the alternative definition as an ideal of `R ⧸ I ^ 2` is
also given, and the two are `R`-equivalent as in `ideal.cotangent_equiv_ideal`.

Additional support is also given to the cotangent space `m ⧸ m ^ 2` of a local ring.

-/

namespace ideal

variables {R S S' : Type*} [comm_ring R] [comm_semiring S] [algebra S R]
variables [comm_semiring S'] [algebra S' R] [algebra S S'] [is_scalar_tower S S' R] (I : ideal R)

/-- `I ⧸ I ^ 2` as a quotient of `I`. -/
@[derive [add_comm_group, module (R ⧸ I)]]
def cotangent : Type* := I ⧸ (I • ⊤ : submodule R I)

instance : inhabited I.cotangent := ⟨0⟩

instance cotangent.module_of_tower : module S I.cotangent :=
submodule.quotient.module' _

instance : is_scalar_tower S S' I.cotangent :=
begin
  delta cotangent,
  constructor,
  intros s s' x,
  rw [← @is_scalar_tower.algebra_map_smul S' R, ← @is_scalar_tower.algebra_map_smul S' R,
    ← smul_assoc, ← is_scalar_tower.to_alg_hom_apply S S' R, map_smul],
  refl
end

instance [is_noetherian R I] : is_noetherian R I.cotangent := by { delta cotangent, apply_instance }

/-- The quotient map from `I` to `I ⧸ I ^ 2`. -/
@[simps apply (lemmas_only)]
def to_cotangent : I →ₗ[R] I.cotangent := submodule.mkq _

lemma map_to_cotangent_ker : I.to_cotangent.ker.map I.subtype = I ^ 2 :=
by simp [ideal.to_cotangent, submodule.map_smul'', pow_two]

lemma to_cotangent_eq {x y : I} : I.to_cotangent x = I.to_cotangent y ↔ (x - y : R) ∈ I ^ 2 :=
begin
  rw [← sub_eq_zero, ← map_sub],
  exact I.mem_to_cotangent_ker
end

lemma to_cotangent_eq_zero (x : I) : I.to_cotangent x = 0 ↔ (x : R) ∈ I ^ 2 :=
I.mem_to_cotangent_ker

lemma to_cotangent_surjective : function.surjective I.to_cotangent :=
submodule.mkq_surjective _

lemma to_cotangent_range : I.to_cotangent.range = ⊤ :=
submodule.range_mkq _

lemma cotangent_subsingleton_iff :
  subsingleton I.cotangent ↔ is_idempotent_elem I :=
begin
  split,
  { introI H,
    refine (pow_two I).symm.trans (le_antisymm (ideal.pow_le_self two_ne_zero) _),
    exact λ x hx, (I.to_cotangent_eq_zero ⟨x, hx⟩).mp (subsingleton.elim _ _) },
  { exact λ e, ⟨λ x y, quotient.induction_on₂' x y $ λ x y,
      I.to_cotangent_eq.mpr $ ((pow_two I).trans e).symm ▸ I.sub_mem x.prop y.prop⟩ }
end

/-- The inclusion map `I ⧸ I ^ 2` to `R ⧸ I ^ 2`. -/
def cotangent_to_quotient_square : I.cotangent →ₗ[R] R ⧸ I ^ 2 :=
submodule.mapq (I • ⊤) (I ^ 2) I.subtype
  (by { rw [← submodule.map_le_iff_le_comap, submodule.map_smul'', submodule.map_top,
    submodule.range_subtype, smul_eq_mul, pow_two], exact rfl.le })

lemma to_quotient_square_comp_to_cotangent : I.cotangent_to_quotient_square.comp I.to_cotangent =
  (I ^ 2).mkq.comp (submodule.subtype I) :=
linear_map.ext $ λ _, rfl

@[simp]
lemma to_cotangent_to_quotient_square (x : I) : I.cotangent_to_quotient_square (I.to_cotangent x) =
  (I ^ 2).mkq x := rfl

/-- `I ⧸ I ^ 2` as an ideal of `R ⧸ I ^ 2`. -/
def cotangent_ideal (I : ideal R) : ideal (R ⧸ I ^ 2) :=
begin
  haveI : @ring_hom_surjective R (R ⧸ I ^ 2) _ _ _ := ⟨ideal.quotient.mk_surjective⟩,
  let rq := (I ^ 2)^.quotient.mk,
  exact submodule.map rq.to_semilinear_map I,
end

lemma cotangent_ideal_square (I : ideal R) : I.cotangent_ideal ^ 2 = ⊥ :=
begin
  rw [eq_bot_iff, pow_two I.cotangent_ideal, ← smul_eq_mul],
  intros x hx,
  apply submodule.smul_induction_on hx,
  { rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩, apply (submodule.quotient.eq _).mpr _,
    rw [sub_zero, pow_two], exact ideal.mul_mem_mul hx hy },
  { intros x y hx hy, exact add_mem hx hy }
end

lemma to_quotient_square_range :
  I.cotangent_to_quotient_square.range = I.cotangent_ideal.restrict_scalars R :=
begin
  transitivity (I.cotangent_to_quotient_square.comp I.to_cotangent).range,
  { rw [linear_map.range_comp, I.to_cotangent_range, submodule.map_top] },
  { rw [to_quotient_square_comp_to_cotangent, linear_map.range_comp, I.range_subtype], ext, refl }
end

/-- The equivalence of the two definitions of `I / I ^ 2`, either as the quotient of `I` or the
ideal of `R / I ^ 2`. -/
noncomputable
def cotangent_equiv_ideal : I.cotangent ≃ₗ[R] I.cotangent_ideal :=
begin
  refine
  { ..(I.cotangent_to_quotient_square.cod_restrict (I.cotangent_ideal.restrict_scalars R)
    (λ x, by { rw ← to_quotient_square_range, exact linear_map.mem_range_self _ _ })),
    ..(equiv.of_bijective _ ⟨_, _⟩) },
  { rintros x y e,
    replace e := congr_arg subtype.val e,
    obtain ⟨x, rfl⟩ := I.to_cotangent_surjective x,
    obtain ⟨y, rfl⟩ := I.to_cotangent_surjective y,
    rw I.to_cotangent_eq,
    dsimp only [to_cotangent_to_quotient_square, submodule.mkq_apply] at e,
    rwa submodule.quotient.eq at e },
  { rintro ⟨_, x, hx, rfl⟩,
    refine ⟨I.to_cotangent ⟨x, hx⟩, subtype.ext rfl⟩ }
end

@[simp, nolint simp_nf]
lemma cotangent_equiv_ideal_apply (x : I.cotangent) :
  ↑(I.cotangent_equiv_ideal x) = I.cotangent_to_quotient_square x := rfl

lemma cotangent_equiv_ideal_symm_apply (x : R) (hx : x ∈ I) :
  I.cotangent_equiv_ideal.symm ⟨(I ^ 2).mkq x, submodule.mem_map_of_mem hx⟩ =
    I.to_cotangent ⟨x, hx⟩ :=
begin
  apply I.cotangent_equiv_ideal.injective,
  rw I.cotangent_equiv_ideal.apply_symm_apply,
  ext,
  refl
end

variables {A B : Type*} [comm_ring A] [comm_ring B] [algebra R A] [algebra R B]

/-- The lift of `f : A →ₐ[R] B` to `A ⧸ J ^ 2 →ₐ[R] B` with `J` being the kernel of `f`. -/
def _root_.alg_hom.ker_square_lift (f : A →ₐ[R] B) : A ⧸ f.to_ring_hom.ker ^ 2 →ₐ[R] B :=
begin
  refine { commutes' := _, ..(ideal.quotient.lift (f.to_ring_hom.ker ^ 2) f.to_ring_hom _) },
  { intros a ha, exact ideal.pow_le_self two_ne_zero ha },
  { intro r, rw [is_scalar_tower.algebra_map_apply R A, ring_hom.to_fun_eq_coe,
      ideal.quotient.algebra_map_eq, ideal.quotient.lift_mk], exact f.map_algebra_map r },
end

lemma _root_.alg_hom.ker_ker_sqare_lift (f : A →ₐ[R] B) :
  f.ker_square_lift.to_ring_hom.ker = f.to_ring_hom.ker.cotangent_ideal :=
begin
  apply le_antisymm,
  { intros x hx, obtain ⟨x, rfl⟩ := ideal.quotient.mk_surjective x, exact ⟨x, hx, rfl⟩ },
  { rintros _ ⟨x, hx, rfl⟩, exact hx }
end

/-- The quotient ring of `I ⧸ I ^ 2` is `R ⧸ I`. -/
def quot_cotangent : ((R ⧸ I ^ 2) ⧸ I.cotangent_ideal) ≃+* R ⧸ I :=
begin
  refine (ideal.quot_equiv_of_eq (ideal.map_eq_submodule_map _ _).symm).trans _,
  refine (double_quot.quot_quot_equiv_quot_sup _ _).trans _,
  exact (ideal.quot_equiv_of_eq (sup_eq_right.mpr $ ideal.pow_le_self two_ne_zero)),
end

end ideal

namespace local_ring

variables (R : Type*) [comm_ring R] [local_ring R]

/-- The `A ⧸ I`-vector space `I ⧸ I ^ 2`. -/
@[reducible] def cotangent_space : Type* := (maximal_ideal R).cotangent

instance : module (residue_field R) (cotangent_space R) :=
ideal.cotangent.module _

instance : is_scalar_tower R (residue_field R) (cotangent_space R) :=
module.is_torsion_by_set.is_scalar_tower _

instance [is_noetherian_ring R] : finite_dimensional (residue_field R) (cotangent_space R) :=
module.finite.of_restrict_scalars_finite R _ _

end local_ring


import data.list
import data.fintype.card

-- not list things but these are needed for this file,
-- hence are kept here (to avoid mutual imports)

structure add_zero_hom (M N : Type*) [has_zero M] [has_zero N] [has_add M] [has_add N] :=
(to_fun : M → N)
(map_zero : to_fun 0 = 0)
(map_add : Π a b : M, to_fun (a + b) = to_fun a + to_fun b)

structure mul_one_hom (M N : Type*) [has_one M] [has_one N] [has_mul M] [has_mul N] :=
(to_fun : M → N)
(map_one : to_fun 1 = 1)
(map_mul : Π a b : M, to_fun (a * b) = to_fun a * to_fun b)

namespace finset

lemma card_filter_fin_lt {n k : ℕ} (hkn : k < n) :
  (finset.filter (λ (j : fin n), ↑j < k) finset.univ).card = k :=
begin
  -- have h := finset.card_range k,
  refine finset.card_eq_of_bijective
    (λ i hik, ⟨ i , lt_trans hik hkn ⟩) _ _ _,
  {
    intros i hi,
    use i.1,
    have h : i.1 < k,
    {
      simp only [true_and, finset.mem_univ, finset.mem_filter] at hi,
      exact hi,
    },
    use h,
    simp,
  },
  {
    intros i hik,
    simp [hik],
  },
  {
    intros i j hi hj,
    exact fin.mk.inj_iff.mp,
  }
end

end finset

-- all the list lemmas

namespace list

variables {α β : Type*}

section sumr
variables [has_zero α] [has_add α] [has_zero β] [has_add β]

@[simp] def sumr : list α → α
| nil := 0
| (cons hd tl) := hd + sumr tl

def add_zero_hom_sumr (f : add_zero_hom α β) : Π (l : list α),
  f.to_fun (sumr l) = sumr (list.map f.to_fun l)
| nil := by simpa using f.map_zero
| (cons hd tl) :=
begin
  simp only [sumr, map, add_zero_hom.map_add],
  rw add_zero_hom_sumr,
end

end sumr

@[simp] lemma sumr_append [add_comm_group β] :
  Π (l1 l2 : list β), sumr (l1 ++ l2) = sumr l1 + sumr l2
| nil l2 := by simp
| (cons hd tl) l2 :=
begin
  simp only [cons_append, sumr],
  rw sumr_append,
  rw add_assoc,
end

-- lemma mapr_sumr
--   [has_zero α] [has_add α] [add_comm_group β] (f : add_zero_hom α β) (as : list α) :
--   f.to_fun as.sumr = (map f.to_fun as).sumr :=
-- begin
--   induction as with a as hind,
--   {
--     simp only [sumr, map],
--     exact f.map_zero,
--   },
--   {
--     simp only [sumr, map],
--     rw f.map_add,
--     rw hind,
--   }
-- end

lemma sumr_eq_sum
  [add_comm_group α] (as : list α) :
  as.sumr = as.sum :=
begin
  induction as with a as hind,
  {simp},
  {
    simp only [sumr, map, sum_cons, add_right_inj],
    exact hind,
  }
end

lemma map_length_of_fn {n : ℕ} (f : fin n → list α) :
  list.map list.length (list.of_fn f)
  = list.of_fn (λ i : fin n, (f i).length) := by simp

/-- if all the lists from fin n → list α are the same length m then
  the whole thing has length n * m
-/
lemma sum_map_length_of_fn_const_length {n l : ℕ} (f : fin n → list α)
  (h_const_length : ∀ i : fin n, (f i).length = l) :
  (list.map list.length (list.of_fn f)).sum = n * l :=
by rw [list.map_of_fn, list.sum_of_fn, funext (λ i, h_const_length i)]; simp

lemma length_join_of_fn_const_length {n l : ℕ} (f : fin n → list α)
  (h_const_length : ∀ i : fin n, (f i).length = l) :
  (list.of_fn f).join.length = n * l :=
by rw [list.length_join, sum_map_length_of_fn_const_length f h_const_length]

@[simp] def index_of' [decidable_eq α] (a : α) (l : list α) : ℕ :=
ite (a ∈ l) (index_of a l) 0

lemma index_of'_lt_length [decidable_eq α] {a : α} {l : list α}
  (h0 : 0 < l.length) :
  index_of' a l < l.length :=
begin
  by_cases h : a ∈ l,
  {simp only [h, if_true, index_of', index_of_lt_length]},
  {simp only [h, if_false, index_of', h0]},
end

lemma index_of'_nth_le [decidable_eq α]
  {a : α} {l : list α} (h : a ∈ l) :
  l.nth_le (index_of' a l) (index_of'_lt_length (length_pos_of_mem h)) = a :=
by simp only [index_of', h, index_of_nth_le, if_true]

lemma nth_le_join_of_fn_const_length_aux
  {n l k i : ℕ} (as : fin n → list α)
  (h_const_length : ∀ i : fin n, (as i).length = l)
  (hkn : k < n) (hil : i < l) :
  i + k * l < (list.of_fn as).join.length :=
begin
  rw list.length_join_of_fn_const_length as h_const_length,
  have h1 : (1 + k) * l ≤ n * l,
  {
    apply mul_le_mul_right' _ l,
    rw [nat.one_add, nat.succ_le_iff],
    exact hkn,
  },
  apply lt_of_lt_of_le _ h1,
  rw [add_mul, one_mul],
  exact add_lt_add_right hil _,
end

lemma nth_le_join_of_fn_const_length {n l k i : ℕ} (as : fin n → list α)
  (h_const_length : ∀ i : fin n, (as i).length = l)
  (hkn : k < n) (hil : i < l) :
  (list.of_fn as).join.nth_le (i + k * l)
    (list.nth_le_join_of_fn_const_length_aux as h_const_length hkn hil)
  =
  (as ⟨ k , hkn ⟩).nth_le i (by simp [hil, h_const_length]) :=
begin
  have hkn' : k < (list.of_fn as).length := by simp [hkn],
  have hil' : i < ((list.of_fn as).nth_le k (by simp [hkn])).length :=
    by simp [hil, h_const_length],
  have hrw : i + k * l = ((list.take k (list.map list.length (list.of_fn as))).sum + i),
  {
    rw nat.add_comm i,
    congr,
    rw list.map_length_of_fn,
    simp only [h_const_length],
    rw list.sum_take_of_fn,
    simp only [nat.cast_id, nsmul_eq_mul, fin.val_eq_coe,
      finset.sum_const, finset.filter_congr_decidable, mul_eq_mul_right_iff],
    left,
    rw finset.card_filter_fin_lt hkn,
  },
  simp only [hrw, list.nth_le_of_fn',
    list.nth_le_join (list.of_fn as) hkn' hil'],
end

end list

-- def list.ith_chunk {α : Type*} {n m : ℕ} (i : fin n)
--   (xs : list α) (hlength : xs.length = n * m) :
--   list α :=
-- list.of_fn (λ k, list.nth_le xs (i.1 * m + k)
--   (by rw hlength; exact dvector.ith_chunk_aux i k))

-- lemma list.ith_chunk_length
--   {α : Type*} {n m : ℕ} (i : fin n) (xs : list α) (hlength : xs.length = n * m)  :
--   (list.ith_chunk i xs hlength).length = m :=
-- by simp only [list.ith_chunk, list.length_of_fn]

-- lemma list.ith_chunk_nth_le
--   {α : Type*} {n m : ℕ} (i : fin n) (xs : list α) (hlength : xs.length = n * m)
--   (l : ℕ) (hl : l < m) :
--   list.nth_le (list.ith_chunk i xs hlength) l (by rw list.ith_chunk_length; exact hl) =
--   xs.nth_le (i.1 * m + l) (by rw hlength; exact dvector.ith_chunk_aux i ⟨ l , hl ⟩) :=
-- by simpa only [list.ith_chunk, list.nth_le_of_fn']


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

Free groups as a quotient over the reduction relation `a * x * x⁻¹ * b = a * b`.

First we introduce the one step reduction relation
  `free_group.red.step`:  w * x * x⁻¹ * v   ~>   w * v
its reflexive transitive closure:
  `free_group.red.trans`
and proof that its join is an equivalence relation.

Then we introduce `free_group α` as a quotient over `free_group.red.step`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.group_theory.subgroup
import Mathlib.PostPort

universes u v u_1 w u_2

namespace Mathlib

namespace free_group

/-- Reduction step: `w * x * x⁻¹ * v ~> w * v` -/
inductive red.step {α : Type u} : List (α × Bool) → List (α × Bool) → Prop where
| bnot :
    ∀ {L₁ L₂ : List (α × Bool)} {x : α} {b : Bool},
      red.step (L₁ ++ (x, b) :: (x, !b) :: L₂) (L₁ ++ L₂)

/-- Reflexive-transitive closure of red.step -/
def red {α : Type u} : List (α × Bool) → List (α × Bool) → Prop := relation.refl_trans_gen sorry

theorem red.refl {α : Type u} {L : List (α × Bool)} : red L L := relation.refl_trans_gen.refl

theorem red.trans {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {L₃ : List (α × Bool)} : red L₁ L₂ → red L₂ L₃ → red L₁ L₃ :=
  relation.refl_trans_gen.trans

namespace red

/-- Predicate asserting that word `w₁` can be reduced to `w₂` in one step, i.e. there are words
`w₃ w₄` and letter `x` such that `w₁ = w₃xx⁻¹w₄` and `w₂ = w₃w₄`  -/
theorem step.length {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} :
    step L₁ L₂ → list.length L₂ + bit0 1 = list.length L₁ :=
  sorry

@[simp] theorem step.bnot_rev {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} {x : α}
    {b : Bool} : step (L₁ ++ (x, !b) :: (x, b) :: L₂) (L₁ ++ L₂) :=
  bool.cases_on b step.bnot step.bnot

@[simp] theorem step.cons_bnot {α : Type u} {L : List (α × Bool)} {x : α} {b : Bool} :
    step ((x, b) :: (x, !b) :: L) L :=
  step.bnot

@[simp] theorem step.cons_bnot_rev {α : Type u} {L : List (α × Bool)} {x : α} {b : Bool} :
    step ((x, !b) :: (x, b) :: L) L :=
  step.bnot_rev

theorem step.append_left {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {L₃ : List (α × Bool)} : step L₂ L₃ → step (L₁ ++ L₂) (L₁ ++ L₃) :=
  sorry

theorem step.cons {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} {x : α × Bool}
    (H : step L₁ L₂) : step (x :: L₁) (x :: L₂) :=
  step.append_left H

theorem step.append_right {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {L₃ : List (α × Bool)} : step L₁ L₂ → step (L₁ ++ L₃) (L₂ ++ L₃) :=
  sorry

theorem not_step_nil {α : Type u} {L : List (α × Bool)} : ¬step [] L := sorry

theorem step.cons_left_iff {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} {a : α}
    {b : Bool} :
    step ((a, b) :: L₁) L₂ ↔
        (∃ (L : List (α × Bool)), step L₁ L ∧ L₂ = (a, b) :: L) ∨ L₁ = (a, !b) :: L₂ :=
  sorry

theorem not_step_singleton {α : Type u} {L : List (α × Bool)} {p : α × Bool} : ¬step [p] L := sorry

theorem step.cons_cons_iff {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {p : α × Bool} : step (p :: L₁) (p :: L₂) ↔ step L₁ L₂ :=
  sorry

theorem step.append_left_iff {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    (L : List (α × Bool)) : step (L ++ L₁) (L ++ L₂) ↔ step L₁ L₂ :=
  sorry

theorem step.diamond {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {L₃ : List (α × Bool)} {L₄ : List (α × Bool)} :
    step L₁ L₃ →
        step L₂ L₄ → L₁ = L₂ → L₃ = L₄ ∨ ∃ (L₅ : List (α × Bool)), step L₃ L₅ ∧ step L₄ L₅ :=
  sorry

theorem step.to_red {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} :
    step L₁ L₂ → red L₁ L₂ :=
  relation.refl_trans_gen.single

/-- Church-Rosser theorem for word reduction: If `w1 w2 w3` are words such that `w1` reduces to `w2`
and `w3` respectively, then there is a word `w4` such that `w2` and `w3` reduce to `w4` respectively. -/
theorem church_rosser {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {L₃ : List (α × Bool)} : red L₁ L₂ → red L₁ L₃ → relation.join red L₂ L₃ :=
  sorry

theorem cons_cons {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} {p : α × Bool} :
    red L₁ L₂ → red (p :: L₁) (p :: L₂) :=
  relation.refl_trans_gen_lift (List.cons p) fun (a b : List (α × Bool)) => step.cons

theorem cons_cons_iff {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} (p : α × Bool) :
    red (p :: L₁) (p :: L₂) ↔ red L₁ L₂ :=
  sorry

theorem append_append_left_iff {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    (L : List (α × Bool)) : red (L ++ L₁) (L ++ L₂) ↔ red L₁ L₂ :=
  sorry

theorem append_append {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {L₃ : List (α × Bool)} {L₄ : List (α × Bool)} (h₁ : red L₁ L₃) (h₂ : red L₂ L₄) :
    red (L₁ ++ L₂) (L₃ ++ L₄) :=
  sorry

theorem to_append_iff {α : Type u} {L : List (α × Bool)} {L₁ : List (α × Bool)}
    {L₂ : List (α × Bool)} :
    red L (L₁ ++ L₂) ↔
        ∃ (L₃ : List (α × Bool)), ∃ (L₄ : List (α × Bool)), L = L₃ ++ L₄ ∧ red L₃ L₁ ∧ red L₄ L₂ :=
  sorry

/-- The empty word `[]` only reduces to itself. -/
theorem nil_iff {α : Type u} {L : List (α × Bool)} : red [] L ↔ L = [] :=
  relation.refl_trans_gen_iff_eq fun (l : List (α × Bool)) => not_step_nil

/-- A letter only reduces to itself. -/
theorem singleton_iff {α : Type u} {L₁ : List (α × Bool)} {x : α × Bool} : red [x] L₁ ↔ L₁ = [x] :=
  relation.refl_trans_gen_iff_eq fun (l : List (α × Bool)) => not_step_singleton

/-- If `x` is a letter and `w` is a word such that `xw` reduces to the empty word, then `w` reduces
to `x⁻¹` -/
theorem cons_nil_iff_singleton {α : Type u} {L : List (α × Bool)} {x : α} {b : Bool} :
    red ((x, b) :: L) [] ↔ red L [(x, !b)] :=
  sorry

theorem red_iff_irreducible {α : Type u} {L : List (α × Bool)} {x1 : α} {b1 : Bool} {x2 : α}
    {b2 : Bool} (h : (x1, b1) ≠ (x2, b2)) :
    red [(x1, !b1), (x2, b2)] L ↔ L = [(x1, !b1), (x2, b2)] :=
  sorry

/-- If `x` and `y` are distinct letters and `w₁ w₂` are words such that `xw₁` reduces to `yw₂`, then
`w₁` reduces to `x⁻¹yw₂`. -/
theorem inv_of_red_of_ne {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} {x1 : α}
    {b1 : Bool} {x2 : α} {b2 : Bool} (H1 : (x1, b1) ≠ (x2, b2))
    (H2 : red ((x1, b1) :: L₁) ((x2, b2) :: L₂)) : red L₁ ((x1, !b1) :: (x2, b2) :: L₂) :=
  sorry

theorem step.sublist {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} (H : step L₁ L₂) :
    L₂ <+ L₁ :=
  sorry

/-- If `w₁ w₂` are words such that `w₁` reduces to `w₂`, then `w₂` is a sublist of `w₁`. -/
theorem sublist {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} : red L₁ L₂ → L₂ <+ L₁ :=
  relation.refl_trans_gen_of_transitive_reflexive (fun (l : List (α × Bool)) => list.sublist.refl l)
    (fun (a b c : List (α × Bool)) (hab : b <+ a) (hbc : c <+ b) => list.sublist.trans hbc hab)
    fun (a b : List (α × Bool)) => step.sublist

theorem sizeof_of_step {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} :
    step L₁ L₂ → list.sizeof L₂ < list.sizeof L₁ :=
  sorry

theorem length {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} (h : red L₁ L₂) :
    ∃ (n : ℕ), list.length L₁ = list.length L₂ + bit0 1 * n :=
  sorry

theorem antisymm {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} (h₁₂ : red L₁ L₂) :
    red L₂ L₁ → L₁ = L₂ :=
  sorry

end red

theorem equivalence_join_red {α : Type u} : equivalence (relation.join red) := sorry

theorem join_red_of_step {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    (h : red.step L₁ L₂) : relation.join red L₁ L₂ :=
  relation.join_of_single relation.reflexive_refl_trans_gen (red.step.to_red h)

theorem eqv_gen_step_iff_join_red {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} :
    eqv_gen red.step L₁ L₂ ↔ relation.join red L₁ L₂ :=
  sorry

end free_group

/-- The free group over a type, i.e. the words formed by the elements of the type and their formal
inverses, quotient by one step reduction. -/
def free_group (α : Type u) := Quot sorry

namespace free_group

/-- The canonical map from `list (α × bool)` to the free group on `α`. -/
def mk {α : Type u} (L : List (α × Bool)) : free_group α := Quot.mk red.step L

@[simp] theorem quot_mk_eq_mk {α : Type u} {L : List (α × Bool)} : Quot.mk red.step L = mk L := rfl

@[simp] theorem quot_lift_mk {α : Type u} {L : List (α × Bool)} (β : Type v)
    (f : List (α × Bool) → β) (H : ∀ (L₁ L₂ : List (α × Bool)), red.step L₁ L₂ → f L₁ = f L₂) :
    Quot.lift f H (mk L) = f L :=
  rfl

@[simp] theorem quot_lift_on_mk {α : Type u} {L : List (α × Bool)} (β : Type v)
    (f : List (α × Bool) → β) (H : ∀ (L₁ L₂ : List (α × Bool)), red.step L₁ L₂ → f L₁ = f L₂) :
    quot.lift_on (mk L) f H = f L :=
  rfl

protected instance has_one {α : Type u} : HasOne (free_group α) := { one := mk [] }

theorem one_eq_mk {α : Type u} : 1 = mk [] := rfl

protected instance inhabited {α : Type u} : Inhabited (free_group α) := { default := 1 }

protected instance has_mul {α : Type u} : Mul (free_group α) :=
  { mul :=
      fun (x y : free_group α) =>
        quot.lift_on x
          (fun (L₁ : List (α × Bool)) =>
            quot.lift_on y (fun (L₂ : List (α × Bool)) => mk (L₁ ++ L₂)) sorry)
          sorry }

@[simp] theorem mul_mk {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} :
    mk L₁ * mk L₂ = mk (L₁ ++ L₂) :=
  rfl

protected instance has_inv {α : Type u} : has_inv (free_group α) :=
  has_inv.mk
    fun (x : free_group α) =>
      quot.lift_on x
        (fun (L : List (α × Bool)) =>
          mk (list.reverse (list.map (fun (x : α × Bool) => (prod.fst x, !prod.snd x)) L)))
        sorry

@[simp] theorem inv_mk {α : Type u} {L : List (α × Bool)} :
    mk L⁻¹ = mk (list.reverse (list.map (fun (x : α × Bool) => (prod.fst x, !prod.snd x)) L)) :=
  rfl

protected instance group {α : Type u} : group (free_group α) :=
  group.mk Mul.mul sorry 1 sorry sorry has_inv.inv
    (div_inv_monoid.div._default Mul.mul sorry 1 sorry sorry has_inv.inv) sorry

/-- `of x` is the canonical injection from the type to the free group over that type by sending each
element to the equivalence class of the letter that is the element. -/
def of {α : Type u} (x : α) : free_group α := mk [(x, tt)]

theorem red.exact {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} :
    mk L₁ = mk L₂ ↔ relation.join red L₁ L₂ :=
  iff.trans { mp := quot.exact red.step, mpr := quot.eqv_gen_sound } eqv_gen_step_iff_join_red

/-- The canonical injection from the type to the free group is an injection. -/
theorem of_injective {α : Type u} : function.injective of := sorry

/-- Given `f : α → β` with `β` a group, the canonical map `list (α × bool) → β` -/
def to_group.aux {α : Type u} {β : Type v} [group β] (f : α → β) : List (α × Bool) → β :=
  fun (L : List (α × Bool)) =>
    list.prod
      (list.map (fun (x : α × Bool) => cond (prod.snd x) (f (prod.fst x)) (f (prod.fst x)⁻¹)) L)

theorem red.step.to_group {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} {β : Type v}
    [group β] {f : α → β} (H : red.step L₁ L₂) : to_group.aux f L₁ = to_group.aux f L₂ :=
  sorry

/-- If `β` is a group, then any function from `α` to `β`
extends uniquely to a group homomorphism from
the free group over `α` to `β`. Note that this is the bare function; the
group homomorphism is `to_group`. -/
def to_group.to_fun {α : Type u} {β : Type v} [group β] (f : α → β) : free_group α → β :=
  Quot.lift (to_group.aux f) sorry

/-- If `β` is a group, then any function from `α` to `β`
extends uniquely to a group homomorphism from
the free group over `α` to `β` -/
def to_group {α : Type u} {β : Type v} [group β] (f : α → β) : free_group α →* β :=
  monoid_hom.mk' sorry sorry

@[simp] theorem to_group.mk {α : Type u} {L : List (α × Bool)} {β : Type v} [group β] {f : α → β} :
    coe_fn (to_group f) (mk L) =
        list.prod
          (list.map (fun (x : α × Bool) => cond (prod.snd x) (f (prod.fst x)) (f (prod.fst x)⁻¹))
            L) :=
  rfl

@[simp] theorem to_group.of {α : Type u} {β : Type v} [group β] {f : α → β} {x : α} :
    coe_fn (to_group f) (of x) = f x :=
  one_mul ((fun (x : α × Bool) => cond (prod.snd x) (f (prod.fst x)) (f (prod.fst x)⁻¹)) (x, tt))

protected instance to_group.is_group_hom {α : Type u} {β : Type v} [group β] {f : α → β} :
    is_group_hom ⇑(to_group f) :=
  is_group_hom.mk

@[simp] theorem to_group.mul {α : Type u} {β : Type v} [group β] {f : α → β} {x : free_group α}
    {y : free_group α} :
    coe_fn (to_group f) (x * y) = coe_fn (to_group f) x * coe_fn (to_group f) y :=
  is_mul_hom.map_mul (⇑(to_group f)) x y

@[simp] theorem to_group.one {α : Type u} {β : Type v} [group β] {f : α → β} :
    coe_fn (to_group f) 1 = 1 :=
  is_group_hom.map_one ⇑(to_group f)

@[simp] theorem to_group.inv {α : Type u} {β : Type v} [group β] {f : α → β} {x : free_group α} :
    coe_fn (to_group f) (x⁻¹) = (coe_fn (to_group f) x⁻¹) :=
  is_group_hom.map_inv (⇑(to_group f)) x

theorem to_group.unique {α : Type u} {β : Type v} [group β] {f : α → β} (g : free_group α →* β)
    (hg : ∀ (x : α), coe_fn g (of x) = f x) {x : free_group α} :
    coe_fn g x = coe_fn (to_group f) x :=
  sorry

/-- Two homomorphisms out of a free group are equal if they are equal on generators.

See note [partially-applied ext lemmas]. -/
theorem ext_hom {α : Type u} {G : Type u_1} [group G] (f : free_group α →* G)
    (g : free_group α →* G) (h : ∀ (a : α), coe_fn f (of a) = coe_fn g (of a)) : f = g :=
  sorry

theorem to_group.of_eq {α : Type u} (x : free_group α) : coe_fn (to_group of) x = x :=
  Eq.symm (to_group.unique (monoid_hom.id (free_group α)) fun (x : α) => rfl)

theorem to_group.range_subset {α : Type u} {β : Type v} [group β] {f : α → β} {s : subgroup β}
    (H : set.range f ⊆ ↑s) : set.range ⇑(to_group f) ⊆ ↑s :=
  sorry

theorem closure_subset {G : Type u_1} [group G] {s : set G} {t : subgroup G} (h : s ⊆ ↑t) :
    subgroup.closure s ≤ t :=
  eq.mpr (id (Eq.trans (propext (subgroup.closure_le t)) (propext (iff_true_intro h)))) trivial

theorem to_group.range_eq_closure {α : Type u} {β : Type v} [group β] {f : α → β} :
    set.range ⇑(to_group f) = ↑(subgroup.closure (set.range f)) :=
  sorry

/-- Given `f : α → β`, the canonical map `list (α × bool) → list (β × bool)`. -/
def map.aux {α : Type u} {β : Type v} (f : α → β) (L : List (α × Bool)) : List (β × Bool) :=
  list.map (fun (x : α × Bool) => (f (prod.fst x), prod.snd x)) L

/-- Any function from `α` to `β` extends uniquely
to a group homomorphism from the free group
over `α` to the free group over `β`. Note that this is the bare function;
for the group homomorphism use `map`. -/
def map.to_fun {α : Type u} {β : Type v} (f : α → β) (x : free_group α) : free_group β :=
  quot.lift_on x (fun (L : List (α × Bool)) => mk (map.aux f L)) sorry

/-- Any function from `α` to `β` extends uniquely
to a group homomorphism from the free group
ver `α` to the free group over `β`. -/
def map {α : Type u} {β : Type v} (f : α → β) : free_group α →* free_group β :=
  monoid_hom.mk' sorry sorry

--by rintros ⟨L₁⟩ ⟨L₂⟩; simp [map, map.aux]

@[simp] theorem map.mk {α : Type u} {L : List (α × Bool)} {β : Type v} {f : α → β} :
    coe_fn (map f) (mk L) = mk (list.map (fun (x : α × Bool) => (f (prod.fst x), prod.snd x)) L) :=
  rfl

@[simp] theorem map.id {α : Type u} {x : free_group α} : coe_fn (map id) x = x := sorry

@[simp] theorem map.id' {α : Type u} {x : free_group α} : coe_fn (map fun (z : α) => z) x = x :=
  map.id

theorem map.comp {α : Type u} {β : Type v} {γ : Type w} {f : α → β} {g : β → γ} {x : free_group α} :
    coe_fn (map g) (coe_fn (map f) x) = coe_fn (map (g ∘ f)) x :=
  sorry

@[simp] theorem map.of {α : Type u} {β : Type v} {f : α → β} {x : α} :
    coe_fn (map f) (of x) = of (f x) :=
  rfl

@[simp] theorem map.mul {α : Type u} {β : Type v} {f : α → β} {x : free_group α}
    {y : free_group α} : coe_fn (map f) (x * y) = coe_fn (map f) x * coe_fn (map f) y :=
  is_mul_hom.map_mul (⇑(map f)) x y

@[simp] theorem map.one {α : Type u} {β : Type v} {f : α → β} : coe_fn (map f) 1 = 1 :=
  is_group_hom.map_one ⇑(map f)

@[simp] theorem map.inv {α : Type u} {β : Type v} {f : α → β} {x : free_group α} :
    coe_fn (map f) (x⁻¹) = (coe_fn (map f) x⁻¹) :=
  is_group_hom.map_inv (⇑(map f)) x

theorem map.unique {α : Type u} {β : Type v} {f : α → β} (g : free_group α → free_group β)
    [is_group_hom g] (hg : ∀ (x : α), g (of x) = of (f x)) {x : free_group α} :
    g x = coe_fn (map f) x :=
  sorry

/-- Equivalent types give rise to equivalent free groups. -/
def free_group_congr {α : Type u_1} {β : Type u_2} (e : α ≃ β) : free_group α ≃ free_group β :=
  equiv.mk ⇑(map ⇑e) ⇑(map ⇑(equiv.symm e)) sorry sorry

theorem map_eq_to_group {α : Type u} {β : Type v} {f : α → β} {x : free_group α} :
    coe_fn (map f) x = coe_fn (to_group (of ∘ f)) x :=
  sorry

/-- If `α` is a group, then any function from `α` to `α`
extends uniquely to a homomorphism from the
free group over `α` to `α`. This is the multiplicative
version of `sum`. -/
def prod {α : Type u} [group α] : free_group α →* α := to_group id

@[simp] theorem prod_mk {α : Type u} {L : List (α × Bool)} [group α] :
    coe_fn prod (mk L) =
        list.prod
          (list.map (fun (x : α × Bool) => cond (prod.snd x) (prod.fst x) (prod.fst x⁻¹)) L) :=
  rfl

@[simp] theorem prod.of {α : Type u} [group α] {x : α} : coe_fn prod (of x) = x := to_group.of

@[simp] theorem prod.mul {α : Type u} [group α] {x : free_group α} {y : free_group α} :
    coe_fn prod (x * y) = coe_fn prod x * coe_fn prod y :=
  to_group.mul

@[simp] theorem prod.one {α : Type u} [group α] : coe_fn prod 1 = 1 := to_group.one

@[simp] theorem prod.inv {α : Type u} [group α] {x : free_group α} :
    coe_fn prod (x⁻¹) = (coe_fn prod x⁻¹) :=
  to_group.inv

theorem prod.unique {α : Type u} [group α] (g : free_group α →* α)
    (hg : ∀ (x : α), coe_fn g (of x) = x) {x : free_group α} : coe_fn g x = coe_fn prod x :=
  to_group.unique g hg

theorem to_group_eq_prod_map {α : Type u} {β : Type v} [group β] {f : α → β} {x : free_group α} :
    coe_fn (to_group f) x = coe_fn prod (coe_fn (map f) x) :=
  sorry

/-- If `α` is a group, then any function from `α` to `α`
extends uniquely to a homomorphism from the
free group over `α` to `α`. This is the additive
version of `prod`. -/
def sum {α : Type u} [add_group α] (x : free_group α) : α := coe_fn prod x

@[simp] theorem sum_mk {α : Type u} {L : List (α × Bool)} [add_group α] :
    sum (mk L) =
        list.sum
          (list.map (fun (x : α × Bool) => cond (prod.snd x) (prod.fst x) (-prod.fst x)) L) :=
  rfl

@[simp] theorem sum.of {α : Type u} [add_group α] {x : α} : sum (of x) = x := prod.of

protected instance sum.is_group_hom {α : Type u} [add_group α] : is_group_hom sum :=
  monoid_hom.is_group_hom prod

@[simp] theorem sum.mul {α : Type u} [add_group α] {x : free_group α} {y : free_group α} :
    sum (x * y) = sum x + sum y :=
  prod.mul

@[simp] theorem sum.one {α : Type u} [add_group α] : sum 1 = 0 := prod.one

@[simp] theorem sum.inv {α : Type u} [add_group α] {x : free_group α} : sum (x⁻¹) = -sum x :=
  prod.inv

/-- The bijection between the free group on the empty type, and a type with one element. -/
def free_group_empty_equiv_unit : free_group empty ≃ Unit :=
  equiv.mk (fun (_x : free_group empty) => Unit.unit) (fun (_x : Unit) => 1) sorry sorry

/-- The bijection between the free group on a singleton, and the integers. -/
def free_group_unit_equiv_int : free_group Unit ≃ ℤ :=
  equiv.mk (fun (x : free_group Unit) => sum (monoid_hom.to_fun (map fun (_x : Unit) => 1) x))
    (fun (x : ℤ) => of Unit.unit ^ x) sorry sorry

protected instance monad : Monad free_group := sorry

protected theorem induction_on {α : Type u} {C : free_group α → Prop} (z : free_group α) (C1 : C 1)
    (Cp : ∀ (x : α), C (pure x)) (Ci : ∀ (x : α), C (pure x) → C (pure x⁻¹))
    (Cm : ∀ (x y : free_group α), C x → C y → C (x * y)) : C z :=
  sorry

@[simp] theorem map_pure {α : Type u} {β : Type u} (f : α → β) (x : α) :
    f <$> pure x = pure (f x) :=
  map.of

@[simp] theorem map_one {α : Type u} {β : Type u} (f : α → β) : f <$> 1 = 1 := map.one

@[simp] theorem map_mul {α : Type u} {β : Type u} (f : α → β) (x : free_group α)
    (y : free_group α) : f <$> (x * y) = f <$> x * f <$> y :=
  map.mul

@[simp] theorem map_inv {α : Type u} {β : Type u} (f : α → β) (x : free_group α) :
    f <$> (x⁻¹) = (f <$> x⁻¹) :=
  map.inv

@[simp] theorem pure_bind {α : Type u} {β : Type u} (f : α → free_group β) (x : α) :
    pure x >>= f = f x :=
  to_group.of

@[simp] theorem one_bind {α : Type u} {β : Type u} (f : α → free_group β) : 1 >>= f = 1 :=
  to_group.one

@[simp] theorem mul_bind {α : Type u} {β : Type u} (f : α → free_group β) (x : free_group α)
    (y : free_group α) : x * y >>= f = (x >>= f) * (y >>= f) :=
  to_group.mul

@[simp] theorem inv_bind {α : Type u} {β : Type u} (f : α → free_group β) (x : free_group α) :
    x⁻¹ >>= f = (x >>= f⁻¹) :=
  to_group.inv

protected instance is_lawful_monad : is_lawful_monad free_group := sorry

/-- The maximal reduction of a word. It is computable
iff `α` has decidable equality. -/
def reduce {α : Type u} [DecidableEq α] (L : List (α × Bool)) : List (α × Bool) :=
  list.rec_on L []
    fun (hd1 : α × Bool) (tl1 ih : List (α × Bool)) =>
      list.cases_on ih [hd1]
        fun (hd2 : α × Bool) (tl2 : List (α × Bool)) =>
          ite (prod.fst hd1 = prod.fst hd2 ∧ prod.snd hd1 = !prod.snd hd2) tl2 (hd1 :: hd2 :: tl2)

@[simp] theorem reduce.cons {α : Type u} {L : List (α × Bool)} [DecidableEq α] (x : α × Bool) :
    reduce (x :: L) =
        list.cases_on (reduce L) [x]
          fun (hd : α × Bool) (tl : List (α × Bool)) =>
            ite (prod.fst x = prod.fst hd ∧ prod.snd x = !prod.snd hd) tl (x :: hd :: tl) :=
  rfl

/-- The first theorem that characterises the function
`reduce`: a word reduces to its maximal reduction. -/
theorem reduce.red {α : Type u} {L : List (α × Bool)} [DecidableEq α] : red L (reduce L) := sorry

theorem reduce.not {α : Type u} [DecidableEq α] {p : Prop} {L₁ : List (α × Bool)}
    {L₂ : List (α × Bool)} {L₃ : List (α × Bool)} {x : α} {b : Bool} :
    reduce L₁ = L₂ ++ (x, b) :: (x, !b) :: L₃ → p :=
  sorry

/-- The second theorem that characterises the
function `reduce`: the maximal reduction of a word
only reduces to itself. -/
theorem reduce.min {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : red (reduce L₁) L₂) : reduce L₁ = L₂ :=
  sorry

/-- `reduce` is idempotent, i.e. the maximal reduction
of the maximal reduction of a word is the maximal
reduction of the word. -/
theorem reduce.idem {α : Type u} {L : List (α × Bool)} [DecidableEq α] :
    reduce (reduce L) = reduce L :=
  Eq.symm (reduce.min reduce.red)

theorem reduce.step.eq {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : red.step L₁ L₂) : reduce L₁ = reduce L₂ :=
  sorry

/-- If a word reduces to another word, then they have
a common maximal reduction. -/
theorem reduce.eq_of_red {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : red L₁ L₂) : reduce L₁ = reduce L₂ :=
  sorry

/-- If two words correspond to the same element in
the free group, then they have a common maximal
reduction. This is the proof that the function that
sends an element of the free group to its maximal
reduction is well-defined. -/
theorem reduce.sound {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : mk L₁ = mk L₂) : reduce L₁ = reduce L₂ :=
  sorry

/-- If two words have a common maximal reduction,
then they correspond to the same element in the free group. -/
theorem reduce.exact {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : reduce L₁ = reduce L₂) : mk L₁ = mk L₂ :=
  iff.mpr red.exact (Exists.intro (reduce L₂) { left := H ▸ reduce.red, right := reduce.red })

/-- A word and its maximal reduction correspond to
the same element of the free group. -/
theorem reduce.self {α : Type u} {L : List (α × Bool)} [DecidableEq α] : mk (reduce L) = mk L :=
  reduce.exact reduce.idem

/-- If words `w₁ w₂` are such that `w₁` reduces to `w₂`,
then `w₂` reduces to the maximal reduction of `w₁`. -/
theorem reduce.rev {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : red L₁ L₂) : red L₂ (reduce L₁) :=
  Eq.symm (reduce.eq_of_red H) ▸ reduce.red

/-- The function that sends an element of the free
group to its maximal reduction. -/
def to_word {α : Type u} [DecidableEq α] : free_group α → List (α × Bool) := Quot.lift reduce sorry

theorem to_word.mk {α : Type u} [DecidableEq α] {x : free_group α} : mk (to_word x) = x :=
  quot.induction_on x fun (L : List (α × Bool)) => reduce.self

theorem to_word.inj {α : Type u} [DecidableEq α] (x : free_group α) (y : free_group α) :
    to_word x = to_word y → x = y :=
  quot.induction_on x
    fun (L₁ : List (α × Bool)) => quot.induction_on y fun (L₂ : List (α × Bool)) => reduce.exact

/-- Constructive Church-Rosser theorem (compare `church_rosser`). -/
def reduce.church_rosser {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)}
    {L₃ : List (α × Bool)} [DecidableEq α] (H12 : red L₁ L₂) (H13 : red L₁ L₃) :
    Subtype fun (L₄ : List (α × Bool)) => red L₂ L₄ ∧ red L₃ L₄ :=
  { val := reduce L₁, property := sorry }

protected instance decidable_eq {α : Type u} [DecidableEq α] : DecidableEq (free_group α) :=
  function.injective.decidable_eq sorry

protected instance red.decidable_rel {α : Type u} [DecidableEq α] : DecidableRel red := sorry

/-- A list containing every word that `w₁` reduces to. -/
def red.enum {α : Type u} [DecidableEq α] (L₁ : List (α × Bool)) : List (List (α × Bool)) :=
  list.filter (fun (L₂ : List (α × Bool)) => red L₁ L₂) (list.sublists L₁)

theorem red.enum.sound {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : L₂ ∈ red.enum L₁) : red L₁ L₂ :=
  list.of_mem_filter H

theorem red.enum.complete {α : Type u} {L₁ : List (α × Bool)} {L₂ : List (α × Bool)} [DecidableEq α]
    (H : red L₁ L₂) : L₂ ∈ red.enum L₁ :=
  list.mem_filter_of_mem (iff.mpr list.mem_sublists (red.sublist H)) H

protected instance subtype.fintype {α : Type u} {L₁ : List (α × Bool)} [DecidableEq α] :
    fintype (Subtype fun (L₂ : List (α × Bool)) => red L₁ L₂) :=
  fintype.subtype (list.to_finset (red.enum L₁)) sorry

end Mathlib


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import data.polynomial.algebra_map
import data.polynomial.inductions
import data.polynomial.splits
import ring_theory.polynomial.vieta
import analysis.normed.field.basic

/-!
# Polynomials and limits

In this file we prove the following lemmas.

* `polynomial.continuous_eval₂: `polynomial.eval₂` defines a continuous function.
* `polynomial.continuous_aeval: `polynomial.aeval` defines a continuous function;
  we also prove convenience lemmas `polynomial.continuous_at_aeval`,
  `polynomial.continuous_within_at_aeval`, `polynomial.continuous_on_aeval`.
* `polynomial.continuous`:  `polynomial.eval` defines a continuous functions;
  we also prove convenience lemmas `polynomial.continuous_at`, `polynomial.continuous_within_at`,
  `polynomial.continuous_on`.
* `polynomial.tendsto_norm_at_top`: `λ x, ‖polynomial.eval (z x) p‖` tends to infinity provided that
  `λ x, ‖z x‖` tends to infinity and `0 < degree p`;
* `polynomial.tendsto_abv_eval₂_at_top`, `polynomial.tendsto_abv_at_top`,
  `polynomial.tendsto_abv_aeval_at_top`: a few versions of the previous statement for
  `is_absolute_value abv` instead of norm.

## Tags

polynomial, continuity
-/

open is_absolute_value filter

namespace polynomial
open_locale polynomial

section topological_semiring

variables {R S : Type*} [semiring R] [topological_space R] [topological_semiring R]
  (p : R[X])

@[continuity]
protected lemma continuous_eval₂ [semiring S] (p : S[X]) (f : S →+* R) :
  continuous (λ x, p.eval₂ f x) :=
begin
  simp only [eval₂_eq_sum, finsupp.sum],
  exact continuous_finset_sum _ (λ c hc, continuous_const.mul (continuous_pow _))
end

@[continuity]
protected lemma continuous : continuous (λ x, p.eval x) :=
p.continuous_eval₂ _

protected lemma continuous_at {a : R} : continuous_at (λ x, p.eval x) a :=
p.continuous.continuous_at

protected lemma continuous_within_at {s a} : continuous_within_at (λ x, p.eval x) s a :=
p.continuous.continuous_within_at

protected lemma continuous_on {s} : continuous_on (λ x, p.eval x) s :=
p.continuous.continuous_on

end topological_semiring

section topological_algebra

variables {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  [topological_space A] [topological_semiring A]
  (p : R[X])

@[continuity]
protected lemma continuous_aeval : continuous (λ x : A, aeval x p) :=
p.continuous_eval₂ _

protected lemma continuous_at_aeval {a : A} : continuous_at (λ x : A, aeval x p) a :=
p.continuous_aeval.continuous_at

protected lemma continuous_within_at_aeval {s a} : continuous_within_at (λ x : A, aeval x p) s a :=
p.continuous_aeval.continuous_within_at

protected lemma continuous_on_aeval {s} : continuous_on (λ x : A, aeval x p) s :=
p.continuous_aeval.continuous_on

end topological_algebra

lemma tendsto_abv_eval₂_at_top {R S k α : Type*} [semiring R] [ring S] [linear_ordered_field k]
  (f : R →+* S) (abv : S → k) [is_absolute_value abv] (p : R[X]) (hd : 0 < degree p)
  (hf : f p.leading_coeff ≠ 0) {l : filter α} {z : α → S} (hz : tendsto (abv ∘ z) l at_top) :
  tendsto (λ x, abv (p.eval₂ f (z x))) l at_top :=
begin
  revert hf, refine degree_pos_induction_on p hd _ _ _; clear hd p,
  { rintros c - hc,
    rw [leading_coeff_mul_X, leading_coeff_C] at hc,
    simpa [abv_mul abv] using hz.const_mul_at_top ((abv_pos abv).2 hc) },
  { intros p hpd ihp hf,
    rw [leading_coeff_mul_X] at hf,
    simpa [abv_mul abv] using  (ihp hf).at_top_mul_at_top hz },
  { intros p a hd ihp hf,
    rw [add_comm, leading_coeff_add_of_degree_lt (degree_C_le.trans_lt hd)] at hf,
    refine tendsto_at_top_of_add_const_right (abv (-f a)) _,
    refine tendsto_at_top_mono (λ _, abv_add abv _ _) _,
    simpa using ihp hf }
end

lemma tendsto_abv_at_top {R k α : Type*} [ring R] [linear_ordered_field k]
  (abv : R → k) [is_absolute_value abv] (p : R[X]) (h : 0 < degree p)
  {l : filter α} {z : α → R} (hz : tendsto (abv ∘ z) l at_top) :
  tendsto (λ x, abv (p.eval (z x))) l at_top :=
tendsto_abv_eval₂_at_top _ _ _ h (mt leading_coeff_eq_zero.1 $ ne_zero_of_degree_gt h) hz

lemma tendsto_abv_aeval_at_top {R A k α : Type*} [comm_semiring R] [ring A] [algebra R A]
  [linear_ordered_field k] (abv : A → k) [is_absolute_value abv] (p : R[X])
  (hd : 0 < degree p) (h₀ : algebra_map R A p.leading_coeff ≠ 0)
  {l : filter α} {z : α → A} (hz : tendsto (abv ∘ z) l at_top) :
  tendsto (λ x, abv (aeval (z x) p)) l at_top :=
tendsto_abv_eval₂_at_top _ abv p hd h₀ hz

variables {α R : Type*} [normed_ring R] [is_absolute_value (norm : R → ℝ)]

lemma tendsto_norm_at_top (p : R[X]) (h : 0 < degree p) {l : filter α} {z : α → R}
  (hz : tendsto (λ x, ‖z x‖) l at_top) :
  tendsto (λ x, ‖p.eval (z x)‖) l at_top :=
p.tendsto_abv_at_top norm h hz

lemma exists_forall_norm_le [proper_space R] (p : R[X]) :
  ∃ x, ∀ y, ‖p.eval x‖ ≤ ‖p.eval y‖ :=
if hp0 : 0 < degree p
then p.continuous.norm.exists_forall_le $ p.tendsto_norm_at_top hp0 tendsto_norm_cocompact_at_top
else ⟨p.coeff 0, by rw [eq_C_of_degree_le_zero (le_of_not_gt hp0)]; simp⟩

section roots

open_locale polynomial nnreal

variables {F K : Type*} [comm_ring F] [normed_field K]

open multiset

lemma eq_one_of_roots_le {p : F[X]} {f : F →+* K} {B : ℝ} (hB : B < 0)
  (h1 : p.monic) (h2 : splits f p) (h3 : ∀ z ∈ (map f p).roots, ‖z‖ ≤ B) :
  p = 1 :=
h1.nat_degree_eq_zero_iff_eq_one.mp begin
  contrapose !hB,
  rw [← h1.nat_degree_map f, nat_degree_eq_card_roots' h2] at hB,
  obtain ⟨z, hz⟩ := card_pos_iff_exists_mem.mp (zero_lt_iff.mpr hB),
  exact le_trans (norm_nonneg _) (h3 z hz),
end

lemma coeff_le_of_roots_le {p : F[X]} {f : F →+* K} {B : ℝ} (i : ℕ)
  (h1 : p.monic) (h2 : splits f p) (h3 : ∀ z ∈ (map f p).roots, ‖z‖ ≤ B) :
  ‖ (map f p).coeff i ‖ ≤ B^(p.nat_degree - i) * p.nat_degree.choose i  :=
begin
  obtain hB | hB := lt_or_le B 0,
  { rw [eq_one_of_roots_le hB h1 h2 h3, polynomial.map_one,
      nat_degree_one, zero_tsub, pow_zero, one_mul, coeff_one],
    split_ifs; norm_num [h] },
  rw ← h1.nat_degree_map f,
  obtain hi | hi := lt_or_le (map f p).nat_degree i,
  { rw [coeff_eq_zero_of_nat_degree_lt hi, norm_zero], positivity },
  rw [coeff_eq_esymm_roots_of_splits ((splits_id_iff_splits f).2 h2) hi,
    (h1.map _).leading_coeff, one_mul, norm_mul, norm_pow, norm_neg, norm_one, one_pow, one_mul],
  apply ((norm_multiset_sum_le _).trans $ sum_le_card_nsmul _ _ $ λ r hr, _).trans,
  { rw [multiset.map_map, card_map, card_powerset_len,
      ←nat_degree_eq_card_roots' h2, nat.choose_symm hi, mul_comm, nsmul_eq_mul] },
  simp_rw multiset.mem_map at hr,
  obtain ⟨_, ⟨s, hs, rfl⟩, rfl⟩ := hr,
  rw mem_powerset_len at hs,
  lift B to ℝ≥0 using hB,
  rw [←coe_nnnorm, ←nnreal.coe_pow, nnreal.coe_le_coe,
    ←nnnorm_hom_apply, ←monoid_hom.coe_coe, monoid_hom.map_multiset_prod],
  refine (prod_le_pow_card _ B $ λ x hx, _).trans_eq (by rw [card_map, hs.2]),
  obtain ⟨z, hz, rfl⟩ := multiset.mem_map.1 hx,
  exact h3 z (mem_of_le hs.1 hz),
end

/-- The coefficients of the monic polynomials of bounded degree with bounded roots are
uniformely bounded. -/
lemma coeff_bdd_of_roots_le {B : ℝ} {d : ℕ} (f : F →+* K) {p : F[X]}
  (h1 : p.monic) (h2 : splits f p) (h3 : p.nat_degree ≤ d) (h4 : ∀ z ∈ (map f p).roots, ‖z‖ ≤ B)
  (i : ℕ) : ‖(map f p).coeff i‖ ≤ (max B 1) ^ d * d.choose (d / 2) :=
begin
  obtain hB | hB := le_or_lt 0 B,
  { apply (coeff_le_of_roots_le i h1 h2 h4).trans,
    calc
    _   ≤ (max B 1) ^ (p.nat_degree - i) * (p.nat_degree.choose i)
      : mul_le_mul_of_nonneg_right (pow_le_pow_of_le_left hB (le_max_left _ _) _) _
    ... ≤ (max B 1) ^ d * (p.nat_degree.choose i)
      : mul_le_mul_of_nonneg_right ((pow_mono (le_max_right _ _)) (le_trans (nat.sub_le _ _) h3)) _
    ... ≤ (max B 1) ^ d * d.choose (d / 2)
      : mul_le_mul_of_nonneg_left (nat.cast_le.mpr ((i.choose_mono h3).trans
        (i.choose_le_middle d))) _,
    all_goals { positivity, }},
  { rw [eq_one_of_roots_le hB h1 h2 h4, polynomial.map_one, coeff_one],
    refine trans _ (one_le_mul_of_one_le_of_one_le (one_le_pow_of_one_le (le_max_right B 1) d) _),
    { split_ifs; norm_num, },
    { exact_mod_cast nat.succ_le_iff.mpr (nat.choose_pos (d.div_le_self 2)), }},
end

end roots

end polynomial


import lib.lib provability

universes u v

open_locale logic_symbol

namespace logic

@[reducible] def Theory (F : Type*) [has_logic_symbol F] := set F

variables {F : Type*} [has_logic_symbol F]

namespace Theory
variables [axiomatic_classical_logic F] (T : Theory F)

def mk (S : set F) : Theory F := S

def consistent : Prop := ¬∃p : F, (T ⊢ p) ∧ (T ⊢ ∼p)

class Consistent (T : Theory F) :=
(consis : consistent T)

lemma consistent_def : consistent T ↔ ¬∃p : F, (T ⊢ p) ∧ (T ⊢ ∼p) := by refl

open axiomatic_classical_logic axiomatic_classical_logic'
variables {T}

lemma consistent_iff_bot : consistent T ↔ ¬T ⊢ ⊥ :=
⟨by { simp[consistent_def], intros h A, have : ¬T ⊢ ∼⊤, from h ⊤ (by simp),
      have : T ⊢ ∼⊤, from of_equiv A (by simp), contradiction },
 by { intros h, simp[consistent_def], intros p hp hnp,
      have : T ⊢ ⊥, from explosion hp hnp,
      exact h this }⟩

lemma not_consistent_iff_bot : ¬consistent T ↔ T ⊢ ⊥ :=
by simp[consistent_iff_bot]

lemma not_consistent_iff : ¬consistent T ↔ ∃p : F, (T ⊢ p) ∧ (T ⊢ ∼p) :=
by simp[consistent_def]

instance : has_le (Theory F) := ⟨λ T U, ∀ ⦃p : F⦄, T ⊢ p → U ⊢ p⟩

@[simp] lemma le_refl (T : Theory F) : T ≤ T := λ p h, h

@[trans] lemma le_trans {T₁ T₂ T₃ : Theory F} :
  T₁ ≤ T₂ → T₂ ≤ T₃ → T₁ ≤ T₃ := λ le₁₂ le₂₃ p b, le₂₃ (le₁₂ b)

class extend (T₀ T : set F) := (le : T₀ ≤ T)

namespace extend

instance extend_refl (T : set F) : extend T T := ⟨λ p h, h⟩

def of_ss {T U : Theory F} (ss : T ⊆ U) : extend T U :=
⟨by intros p h; exact weakening ss h⟩

@[trans] def extend.trans (T₁ T₂ T₃ : set F) [extend T₁ T₂]  [extend T₂ T₃] :
  extend T₁ T₃ := ⟨λ p b, extend.le (extend.le b : T₂ ⊢ p)⟩

lemma by_axiom (T₁ T₂ : set F) [extend T₁ T₂] {p : F} (hp : p ∈ T₁) : T₂ ⊢ p :=
extend.le (axiomatic_classical_logic'.by_axiom hp)

end extend

def th (T : Theory F) : Theory F := {p | T ⊢ p}

end Theory

variables (F)

class semantics (𝓢 : Type*) :=
(models : 𝓢 → F → Prop)

namespace semantics
variables {F} {𝓢 : Type*} [semantics F 𝓢] (S : 𝓢)

instance : has_double_turnstile 𝓢 F := ⟨models⟩

instance : has_double_turnstile 𝓢 (Theory F) := ⟨λ S T, ∀ ⦃p⦄, p ∈ T → S ⊧ p⟩

variables {S}

lemma Models_def {T : Theory F} : S ⊧ T ↔ ∀ p ∈ T, S ⊧ p := by refl

variables (𝓢)

def valid (p : F) : Prop := ∀ S : 𝓢, S ⊧ p

def satisfiable (p : F) : Prop := ∃ S : 𝓢, S ⊧ p

def Valid (T : Theory F) : Prop := ∀ S : 𝓢, S ⊧ T

def Satisfiable (T : Theory F) : Prop := ∃ S : 𝓢, S ⊧ T

def toutology (p : F) : Prop := ∀ ⦃S : 𝓢⦄, S ⊧ p

def consequence (T : Theory F) (p : F) : Prop := ∀ ⦃S : 𝓢⦄, S ⊧ T → S ⊧ p

variables {𝓢} {S} (T U : Theory F)

@[simp] lemma models_empty : S ⊧ (∅ : Theory F) := λ _, by simp

@[simp] lemma models_of_ss {U T : Theory F} (ss : U ⊆ T) : S ⊧ T → S ⊧ U := λ h p hp,
h (ss hp)

@[simp] lemma models_union {T U : Theory F} : S ⊧ T ∪ U ↔ S ⊧ T ∧ S ⊧ U :=
⟨λ h, ⟨λ p hp, h (set.mem_union_left U hp), λ p hp, h (set.mem_union_right T hp)⟩,
  by { rintros ⟨hT, hU⟩ p (hp | hp), { exact hT hp}, { exact hU hp } }⟩

@[simp] lemma models_insert {T : Theory F} {p : F} : S ⊧ insert p T ↔ S ⊧ p ∧ S ⊧ T :=
by simp[Models_def]

@[simp] lemma models_Union {ι} {T : ι → Theory F} : S ⊧ (⋃ n, T n) ↔ ∀ n, S ⊧ T n :=
by simp[Models_def]; refine ⟨λ h i p, h p i, λ h p i, h i p⟩

lemma Satisfiable_of_ss {T U : Theory F} (ss : T ⊆ U) : Satisfiable 𝓢 U → Satisfiable 𝓢 T :=
by rintros ⟨S, hS⟩; refine ⟨S, by { intros p hp,refine hS (ss hp) }⟩

variables (F 𝓢)

class nontrivial :=
(verum : ∀ S : 𝓢, S ⊧ (⊤ : F))
(falsum : ∀ S : 𝓢, ¬S ⊧ (⊥ : F))

attribute [simp] nontrivial.verum nontrivial.falsum

end semantics

variables (F) [axiomatic_classical_logic F]

class sound (𝓢 : Type*) [semantics F 𝓢] :=
(soundness : ∀ {T : Theory F} {p}, T ⊢ p → semantics.consequence 𝓢 T p)

namespace sound
variables {F} {𝓢 : Type*} [semantics F 𝓢] [sound F 𝓢] {S : 𝓢}

theorem consistent_of_Satisfiable [semantics.nontrivial F 𝓢] {T : Theory F} : semantics.Satisfiable 𝓢 T → Theory.consistent T :=
begin
  rintros ⟨S, hS⟩,
  by_contradiction A,
  have : T ⊢ ⊥, from Theory.not_consistent_iff_bot.mp A,
  exact semantics.nontrivial.falsum S (soundness this hS)
end

variables (S)

lemma tautology_of_tautology (p : F) (h : ⬝⊢ p) : S ⊧ p :=
by { have : semantics.consequence 𝓢 ∅ p, from soundness h, exact this (show S ⊧ ∅, by simp) }

end sound

class complete (𝓢 : Type*) [semantics F 𝓢] extends sound F 𝓢  :=
(completeness' : ∀ {T : Theory F} {p}, semantics.consequence 𝓢 T p → T ⊢ p)

namespace complete
variables {F} {𝓢 : Type*} [semantics F 𝓢] [complete F 𝓢] {S : 𝓢}

theorem completeness {T : Theory F} {p} : T ⊢ p ↔ semantics.consequence 𝓢 T p :=
⟨sound.soundness, completeness'⟩

theorem consistent_iff_Satisfiable [semantics.nontrivial F 𝓢] {T : Theory F} : Theory.consistent T ↔ semantics.Satisfiable 𝓢 T :=
⟨by { contrapose, intros h,
  have : semantics.consequence 𝓢 T ⊥, { intros S hS, exfalso, exact h ⟨S, hS⟩ },
  have : T ⊢ ⊥, from completeness.mpr this,
  exact Theory.not_consistent_iff_bot.mpr this }, sound.consistent_of_Satisfiable⟩

end complete

end logic


import tactic

variable X : Type

theorem reflexive_of_symmetric_transitive_and_connected
  (r : X → X → Prop)
  (h_symm : ∀ x y : X, r x y → r y x)
  (h_trans : ∀ x y z : X, r x y → r y z → r x z)
  (h_connected : ∀ x, ∃ y, r x y)
: (∀ x : X, r x x) :=
begin
  sorry,
end


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.lie.basic
import Mathlib.linear_algebra.direct_sum.finsupp
import Mathlib.PostPort

universes w w₁ v u

namespace Mathlib

/-!
# Direct sums of Lie algebras and Lie modules

Direct sums of Lie algebras and Lie modules carry natural algbebra and module structures.

## Tags

lie algebra, lie module, direct sum
-/

namespace direct_sum

/-! The direct sum of Lie modules over a fixed Lie algebra carries a natural Lie module
structure. -/

protected instance lie_ring_module {ι : Type v} {L : Type w₁} {M : ι → Type w} [lie_ring L] [(i : ι) → add_comm_group (M i)] [(i : ι) → lie_ring_module L (M i)] : lie_ring_module L (direct_sum ι fun (i : ι) => M i) :=
  lie_ring_module.mk sorry sorry sorry

@[simp] theorem lie_module_bracket_apply {ι : Type v} {L : Type w₁} {M : ι → Type w} [lie_ring L] [(i : ι) → add_comm_group (M i)] [(i : ι) → lie_ring_module L (M i)] (x : L) (m : direct_sum ι fun (i : ι) => M i) (i : ι) : coe_fn (has_bracket.bracket x m) i = has_bracket.bracket x (coe_fn m i) :=
  dfinsupp.map_range_apply (fun (i : ι) (m' : M i) => has_bracket.bracket x m') (lie_ring_module._proof_1 x) m i

protected instance lie_module {R : Type u} {ι : Type v} [comm_ring R] {L : Type w₁} {M : ι → Type w} [lie_ring L] [lie_algebra R L] [(i : ι) → add_comm_group (M i)] [(i : ι) → module R (M i)] [(i : ι) → lie_ring_module L (M i)] [(i : ι) → lie_module R L (M i)] : lie_module R L (direct_sum ι fun (i : ι) => M i) :=
  lie_module.mk sorry sorry

/-- The inclusion of each component into a direct sum as a morphism of Lie modules. -/
def lie_module_of (R : Type u) (ι : Type v) [comm_ring R] (L : Type w₁) (M : ι → Type w) [lie_ring L] [lie_algebra R L] [(i : ι) → add_comm_group (M i)] [(i : ι) → module R (M i)] [(i : ι) → lie_ring_module L (M i)] [(i : ι) → lie_module R L (M i)] [DecidableEq ι] (j : ι) : lie_module_hom R L (M j) (direct_sum ι fun (i : ι) => M i) :=
  lie_module_hom.mk (linear_map.to_fun (lof R ι M j)) sorry sorry sorry

/-- The projection map onto one component, as a morphism of Lie modules. -/
def lie_module_component (R : Type u) (ι : Type v) [comm_ring R] (L : Type w₁) (M : ι → Type w) [lie_ring L] [lie_algebra R L] [(i : ι) → add_comm_group (M i)] [(i : ι) → module R (M i)] [(i : ι) → lie_ring_module L (M i)] [(i : ι) → lie_module R L (M i)] (j : ι) : lie_module_hom R L (direct_sum ι fun (i : ι) => M i) (M j) :=
  lie_module_hom.mk (linear_map.to_fun (component R ι M j)) sorry sorry sorry

/-! The direct sum of Lie algebras carries a natural Lie algebra structure. -/

protected instance lie_ring {ι : Type v} {L : ι → Type w} [(i : ι) → lie_ring (L i)] : lie_ring (direct_sum ι fun (i : ι) => L i) :=
  lie_ring.mk sorry sorry sorry sorry

@[simp] theorem bracket_apply {ι : Type v} {L : ι → Type w} [(i : ι) → lie_ring (L i)] (x : direct_sum ι fun (i : ι) => L i) (y : direct_sum ι fun (i : ι) => L i) (i : ι) : coe_fn (has_bracket.bracket x y) i = has_bracket.bracket (coe_fn x i) (coe_fn y i) :=
  dfinsupp.zip_with_apply (fun (i : ι) (x y : L i) => has_bracket.bracket x y) lie_ring._proof_7 x y i

protected instance lie_algebra {R : Type u} {ι : Type v} [comm_ring R] {L : ι → Type w} [(i : ι) → lie_ring (L i)] [(i : ι) → lie_algebra R (L i)] : lie_algebra R (direct_sum ι fun (i : ι) => L i) :=
  lie_algebra.mk sorry

/-- The inclusion of each component into the direct sum as morphism of Lie algebras. -/
def lie_algebra_of (R : Type u) (ι : Type v) [comm_ring R] (L : ι → Type w) [(i : ι) → lie_ring (L i)] [(i : ι) → lie_algebra R (L i)] [DecidableEq ι] (j : ι) : lie_algebra.morphism R (L j) (direct_sum ι fun (i : ι) => L i) :=
  lie_algebra.morphism.mk (linear_map.to_fun (lof R ι L j)) sorry sorry sorry

/-- The projection map onto one component, as a morphism of Lie algebras. -/
def lie_algebra_component (R : Type u) (ι : Type v) [comm_ring R] (L : ι → Type w) [(i : ι) → lie_ring (L i)] [(i : ι) → lie_algebra R (L i)] (j : ι) : lie_algebra.morphism R (direct_sum ι fun (i : ι) => L i) (L j) :=
  lie_algebra.morphism.mk (linear_map.to_fun (component R ι L j)) sorry sorry sorry


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Init.SimpLemmas
import Init.Data.Nat.Basic
set_option linter.missingDocs true -- keep it documented
open Decidable List

universe u v w

variable {α : Type u} {β : Type v} {γ : Type w}

namespace List

instance : GetElem (List α) Nat α fun as i => i < as.length where
  getElem as i h := as.get ⟨i, h⟩

@[simp] theorem cons_getElem_zero (a : α) (as : List α) (h : 0 < (a :: as).length) : getElem (a :: as) 0 h = a := by
  rfl

@[simp] theorem cons_getElem_succ (a : α) (as : List α) (i : Nat) (h : i + 1 < (a :: as).length) : getElem (a :: as) (i+1) h = getElem as i (Nat.lt_of_succ_lt_succ h) := by
  rfl

theorem length_add_eq_lengthTRAux (as : List α) (n : Nat) : as.length + n = as.lengthTRAux n := by
  induction as generalizing n with
  | nil  => simp [length, lengthTRAux]
  | cons a as ih =>
    simp [length, lengthTRAux, ← ih, Nat.succ_add]
    rfl

@[csimp] theorem length_eq_lengthTR : @List.length = @List.lengthTR := by
  apply funext; intro α; apply funext; intro as
  simp [lengthTR, ← length_add_eq_lengthTRAux]

@[simp] theorem length_nil : length ([] : List α) = 0 :=
  rfl

/-- Auxiliary for `List.reverse`. `List.reverseAux l r = l.reverse ++ r`, but it is defined directly. -/
def reverseAux : List α → List α → List α
  | [],   r => r
  | a::l, r => reverseAux l (a::r)

/--
`O(|as|)`. Reverse of a list:
* `[1, 2, 3, 4].reverse = [4, 3, 2, 1]`

Note that because of the "functional but in place" optimization implemented by Lean's compiler,
this function works without any allocations provided that the input list is unshared:
it simply walks the linked list and reverses all the node pointers.
-/
def reverse (as : List α) : List α :=
  reverseAux as []

theorem reverseAux_reverseAux_nil (as bs : List α) : reverseAux (reverseAux as bs) [] = reverseAux bs as := by
  induction as generalizing bs with
  | nil => rfl
  | cons a as ih => simp [reverseAux, ih]

theorem reverseAux_reverseAux (as bs cs : List α) : reverseAux (reverseAux as bs) cs = reverseAux bs (reverseAux (reverseAux as []) cs) := by
  induction as generalizing bs cs with
  | nil => rfl
  | cons a as ih => simp [reverseAux, ih (a::bs), ih [a]]

@[simp] theorem reverse_reverse (as : List α) : as.reverse.reverse = as := by
  simp [reverse]; rw [reverseAux_reverseAux_nil]; rfl

/--
`O(|xs|)`: append two lists. `[1, 2, 3] ++ [4, 5] = [1, 2, 3, 4, 5]`.
It takes time proportional to the first list.
-/
protected def append : (xs ys : List α) → List α
  | [],    bs => bs
  | a::as, bs => a :: List.append as bs

/-- Tail-recursive version of `List.append`. -/
def appendTR (as bs : List α) : List α :=
  reverseAux as.reverse bs

@[csimp] theorem append_eq_appendTR : @List.append = @appendTR := by
  apply funext; intro α; apply funext; intro as; apply funext; intro bs
  simp [appendTR, reverse]
  induction as with
  | nil  => rfl
  | cons a as ih =>
    simp [reverseAux, List.append, ih, reverseAux_reverseAux]

instance : Append (List α) := ⟨List.append⟩

@[simp] theorem nil_append (as : List α) : [] ++ as = as := rfl
@[simp] theorem append_nil (as : List α) : as ++ [] = as := by
  induction as with
  | nil => rfl
  | cons a as ih =>
    simp_all [HAppend.hAppend, Append.append, List.append]

@[simp] theorem cons_append (a : α) (as bs : List α) : (a::as) ++ bs = a::(as ++ bs) := rfl

@[simp] theorem append_eq (as bs : List α) : List.append as bs = as ++ bs := rfl

theorem append_assoc (as bs cs : List α) : (as ++ bs) ++ cs = as ++ (bs ++ cs) := by
  induction as with
  | nil => rfl
  | cons a as ih => simp [ih]

theorem append_cons (as : List α) (b : α) (bs : List α) : as ++ b :: bs = as ++ [b] ++ bs := by
  induction as with
  | nil => simp
  | cons a as ih => simp [ih]

instance : EmptyCollection (List α) := ⟨List.nil⟩

/--
`O(|l|)`. `erase l a` removes the first occurrence of `a` from `l`.
* `erase [1, 5, 3, 2, 5] 5 = [1, 3, 2, 5]`
* `erase [1, 5, 3, 2, 5] 6 = [1, 5, 3, 2, 5]`
-/
protected def erase {α} [BEq α] : List α → α → List α
  | [],    _ => []
  | a::as, b => match a == b with
    | true  => as
    | false => a :: List.erase as b

/--
`O(i)`. `eraseIdx l i` removes the `i`'th element of the list `l`.
* `erase [a, b, c, d, e] 0 = [b, c, d, e]`
* `erase [a, b, c, d, e] 1 = [a, c, d, e]`
* `erase [a, b, c, d, e] 5 = [a, b, c, d, e]`
-/
def eraseIdx : List α → Nat → List α
  | [],    _   => []
  | _::as, 0   => as
  | a::as, n+1 => a :: eraseIdx as n

/--
`O(1)`. `isEmpty l` is true if the list is empty.
* `isEmpty [] = true`
* `isEmpty [a] = false`
* `isEmpty [a, b] = false`
-/
def isEmpty : List α → Bool
  | []     => true
  | _ :: _ => false

/--
`O(|l|)`. `map f l` applies `f` to each element of the list.
* `map f [a, b, c] = [f a, f b, f c]`
-/
@[specialize] def map (f : α → β) : List α → List β
  | []    => []
  | a::as => f a :: map f as

/-- Tail-recursive version of `List.map`. -/
@[inline] def mapTR (f : α → β) (as : List α) : List β :=
  loop as []
where
  @[specialize] loop : List α → List β → List β
  | [],    bs => bs.reverse
  | a::as, bs => loop as (f a :: bs)

theorem reverseAux_eq_append (as bs : List α) : reverseAux as bs = reverseAux as [] ++ bs := by
  induction as generalizing bs with
  | nil => simp [reverseAux]
  | cons a as ih =>
    simp [reverseAux]
    rw [ih (a :: bs), ih [a], append_assoc]
    rfl

@[simp] theorem reverse_nil : reverse ([] : List α) = [] :=
  rfl

@[simp] theorem reverse_cons (a : α) (as : List α) : reverse (a :: as) = reverse as ++ [a] := by
  simp [reverse, reverseAux]
  rw [← reverseAux_eq_append]

@[simp] theorem reverse_append (as bs : List α) : (as ++ bs).reverse = bs.reverse ++ as.reverse := by
  induction as generalizing bs with
  | nil => simp
  | cons a as ih => simp [ih]; rw [append_assoc]

theorem mapTR_loop_eq (f : α → β) (as : List α) (bs : List β) :
    mapTR.loop f as bs = bs.reverse ++ map f as := by
  induction as generalizing bs with
  | nil => simp [mapTR.loop, map]
  | cons a as ih =>
    simp [mapTR.loop, map]
    rw [ih (f a :: bs), reverse_cons, append_assoc]
    rfl

@[csimp] theorem map_eq_mapTR : @map = @mapTR :=
  funext fun α => funext fun β => funext fun f => funext fun as => by
    simp [mapTR, mapTR_loop_eq]

/--
`O(|join L|)`. `join L` concatenates all the lists in `L` into one list.
* `join [[a], [], [b, c], [d, e, f]] = [a, b, c, d, e, f]`
-/
def join : List (List α) → List α
  | []      => []
  | a :: as => a ++ join as

/--
`O(|l|)`. `filterMap f l` takes a function `f : α → Option β` and applies it to each element of `l`;
the resulting non-`none` values are collected to form the output list.
```
filterMap
  (fun x => if x > 2 then some (2 * x) else none)
  [1, 2, 5, 2, 7, 7]
= [10, 14, 14]
```
-/
@[specialize] def filterMap (f : α → Option β) : List α → List β
  | []   => []
  | a::as =>
    match f a with
    | none   => filterMap f as
    | some b => b :: filterMap f as

/--
`O(|l|)`. `filter f l` returns the list of elements in `l` for which `f` returns true.
```
filter (· > 2) [1, 2, 5, 2, 7, 7] = [5, 7, 7]
```
-/
def filter (p : α → Bool) : List α → List α
  | [] => []
  | a::as => match p a with
    | true => a :: filter p as
    | false => filter p as

/-- Tail-recursive version of `List.filter`. -/
@[inline] def filterTR (p : α → Bool) (as : List α) : List α :=
  loop as []
where
  @[specialize] loop : List α → List α → List α
  | [],    rs => rs.reverse
  | a::as, rs => match p a with
     | true  => loop as (a::rs)
     | false => loop as rs

theorem filterTR_loop_eq (p : α → Bool) (as bs : List α) :
    filterTR.loop p as bs = bs.reverse ++ filter p as := by
  induction as generalizing bs with
  | nil => simp [filterTR.loop, filter]
  | cons a as ih =>
    simp [filterTR.loop, filter]
    split
    next => rw [ih, reverse_cons, append_assoc]; simp
    next => rw [ih]

@[csimp] theorem filter_eq_filterTR : @filter = @filterTR := by
  apply funext; intro α; apply funext; intro p; apply funext; intro as
  simp [filterTR, filterTR_loop_eq]

/--
`O(|l|)`. `partition p l` calls `p` on each element of `l`, partitioning the list into two lists
`(l_true, l_false)` where `l_true` has the elements where `p` was true
and `l_false` has the elements where `p` is false.
`partition p l = (filter p l, filter (not ∘ p) l)`, but it is slightly more efficient
since it only has to do one pass over the list.
```
partition (· > 2) [1, 2, 5, 2, 7, 7] = ([5, 7, 7], [1, 2, 2])
```
-/
@[inline] def partition (p : α → Bool) (as : List α) : List α × List α :=
  loop as ([], [])
where
  @[specialize] loop : List α → List α × List α → List α × List α
  | [],    (bs, cs) => (bs.reverse, cs.reverse)
  | a::as, (bs, cs) =>
    match p a with
    | true  => loop as (a::bs, cs)
    | false => loop as (bs, a::cs)

/--
`O(|l|)`. `dropWhile p l` removes elements from the list until it finds the first element
for which `p` returns false; this element and everything after it is returned.
```
dropWhile (· < 4) [1, 3, 2, 4, 2, 7, 4] = [4, 2, 7, 4]
```
-/
def dropWhile (p : α → Bool) : List α → List α
  | []   => []
  | a::l => match p a with
    | true  => dropWhile p l
    | false =>  a::l

/--
`O(|l|)`. `find? p l` returns the first element for which `p` returns true,
or `none` if no such element is found.

* `find? (· < 5) [7, 6, 5, 8, 1, 2, 6] = some 1`
* `find? (· < 1) [7, 6, 5, 8, 1, 2, 6] = none`
-/
def find? (p : α → Bool) : List α → Option α
  | []    => none
  | a::as => match p a with
    | true  => some a
    | false => find? p as

/--
`O(|l|)`. `findSome? f l` applies `f` to each element of `l`, and returns the first non-`none` result.

* `findSome? (fun x => if x < 5 then some (10 * x) else none) [7, 6, 5, 8, 1, 2, 6] = some 10`
-/
def findSome? (f : α → Option β) : List α → Option β
  | []    => none
  | a::as => match f a with
    | some b => some b
    | none   => findSome? f as

/--
`O(|l|)`. `replace l a b` replaces the first element in the list equal to `a` with `b`.

* `replace [1, 4, 2, 3, 3, 7] 3 6 = [1, 4, 2, 6, 3, 7]`
* `replace [1, 4, 2, 3, 3, 7] 5 6 = [1, 4, 2, 3, 3, 7]`
-/
def replace [BEq α] : List α → α → α → List α
  | [],    _, _ => []
  | a::as, b, c => match a == b with
    | true  => c::as
    | false => a :: replace as b c

/--
`O(|l|)`. `elem a l` or `l.contains a` is true if there is an element in `l` equal to `a`.

* `elem 3 [1, 4, 2, 3, 3, 7] = true`
* `elem 5 [1, 4, 2, 3, 3, 7] = false`
-/
def elem [BEq α] (a : α) : List α → Bool
  | []    => false
  | b::bs => match a == b with
    | true  => true
    | false => elem a bs

/-- `notElem a l` is `!(elem a l)`. -/
def notElem [BEq α] (a : α) (as : List α) : Bool :=
  !(as.elem a)

@[inherit_doc elem] abbrev contains [BEq α] (as : List α) (a : α) : Bool :=
  elem a as

/--
`a ∈ l` is a predicate which asserts that `a` is in the list `l`.
Unlike `elem`, this uses `=` instead of `==` and is suited for mathematical reasoning.
* `a ∈ [x, y, z] ↔ a = x ∨ a = y ∨ a = z`
-/
inductive Mem (a : α) : List α → Prop
  /-- The head of a list is a member: `a ∈ a :: as`. -/
  | head (as : List α) : Mem a (a::as)
  /-- A member of the tail of a list is a member of the list: `a ∈ l → a ∈ b :: l`. -/
  | tail (b : α) {as : List α} : Mem a as → Mem a (b::as)

instance : Membership α (List α) where
  mem := Mem

theorem mem_of_elem_eq_true [DecidableEq α] {a : α} {as : List α} : elem a as = true → a ∈ as := by
  match as with
  | [] => simp [elem]
  | a'::as =>
    simp [elem]
    split
    next h => intros; simp [BEq.beq] at h; subst h; apply Mem.head
    next _ => intro h; exact Mem.tail _ (mem_of_elem_eq_true h)

theorem elem_eq_true_of_mem [DecidableEq α] {a : α} {as : List α} (h : a ∈ as) : elem a as = true := by
  induction h with
  | head _ => simp [elem]
  | tail _ _ ih => simp [elem]; split; rfl; assumption

instance [DecidableEq α] (a : α) (as : List α) : Decidable (a ∈ as) :=
  decidable_of_decidable_of_iff (Iff.intro mem_of_elem_eq_true elem_eq_true_of_mem)

theorem mem_append_of_mem_left {a : α} {as : List α} (bs : List α) : a ∈ as → a ∈ as ++ bs := by
  intro h
  induction h with
  | head => apply Mem.head
  | tail => apply Mem.tail; assumption

theorem mem_append_of_mem_right {b : α} {bs : List α} (as : List α) : b ∈ bs → b ∈ as ++ bs := by
  intro h
  induction as with
  | nil  => simp [h]
  | cons => apply Mem.tail; assumption

/-- `O(|l|^2)`. Erase duplicated elements in the list.
Keeps the first occurrence of duplicated elements.
* `eraseDups [1, 3, 2, 2, 3, 5] = [1, 3, 2, 5]`
-/
def eraseDups {α} [BEq α] (as : List α) : List α :=
  loop as []
where
  loop : List α → List α → List α
  | [],    bs => bs.reverse
  | a::as, bs => match bs.elem a with
    | true  => loop as bs
    | false => loop as (a::bs)

/--
`O(|l|)`. Erase repeated adjacent elements. Keeps the first occurrence of each run.
* `eraseReps [1, 3, 2, 2, 2, 3, 5] = [1, 3, 2, 3, 5]`
-/
def eraseReps {α} [BEq α] : List α → List α
  | []    => []
  | a::as => loop a as []
where
  loop {α} [BEq α] : α → List α → List α → List α
  | a, [], rs => (a::rs).reverse
  | a, a'::as, rs => match a == a' with
    | true  => loop a as rs
    | false => loop a' as (a::rs)

/--
`O(|l|)`. `span p l` splits the list `l` into two parts, where the first part
contains the longest initial segment for which `p` returns true
and the second part is everything else.

* `span (· > 5) [6, 8, 9, 5, 2, 9] = ([6, 8, 9], [5, 2, 9])`
* `span (· > 10) [6, 8, 9, 5, 2, 9] = ([6, 8, 9, 5, 2, 9], [])`
-/
@[inline] def span (p : α → Bool) (as : List α) : List α × List α :=
  loop as []
where
  @[specialize] loop : List α → List α → List α × List α
  | [],    rs => (rs.reverse, [])
  | a::as, rs => match p a with
    | true  => loop as (a::rs)
    | false => (rs.reverse, a::as)

/--
`O(|l|)`. `groupBy R l` splits `l` into chains of elements
such that adjacent elements are related by `R`.

* `groupBy (·==·) [1, 1, 2, 2, 2, 3, 2] = [[1, 1], [2, 2, 2], [3], [2]]`
* `groupBy (·<·) [1, 2, 5, 4, 5, 1, 4] = [[1, 2, 5], [4, 5], [1, 4]]`
-/
@[specialize] def groupBy (R : α → α → Bool) : List α → List (List α)
  | []    => []
  | a::as => loop as a [] []
where
  @[specialize] loop : List α → α → List α → List (List α) → List (List α)
  | a::as, ag, g, gs => match R ag a with
    | true  => loop as a (ag::g) gs
    | false => loop as a [] ((ag::g).reverse::gs)
  | [], ag, g, gs => ((ag::g).reverse::gs).reverse

/--
`O(|l|)`. `lookup a l` treats `l : List (α × β)` like an association list,
and returns the first `β` value corresponding to an `α` value in the list equal to `a`.

* `lookup 3 [(1, 2), (3, 4), (3, 5)] = some 4`
* `lookup 2 [(1, 2), (3, 4), (3, 5)] = none`
-/
def lookup [BEq α] : α → List (α × β) → Option β
  | _, []        => none
  | a, (k,b)::es => match a == k with
    | true  => some b
    | false => lookup a es

/-- `O(|xs|)`. Computes the "set difference" of lists,
by filtering out all elements of `xs` which are also in `ys`.
* `removeAll [1, 1, 5, 1, 2, 4, 5] [1, 2, 2] = [5, 4, 5]`
 -/
def removeAll [BEq α] (xs ys : List α) : List α :=
  xs.filter (fun x => ys.notElem x)

/--
`O(min n |xs|)`. Removes the first `n` elements of `xs`.
* `drop 0 [a, b, c, d, e] = [a, b, c, d, e]`
* `drop 3 [a, b, c, d, e] = [d, e]`
* `drop 6 [a, b, c, d, e] = []`
-/
def drop : Nat → List α → List α
  | 0,   a     => a
  | _+1, []    => []
  | n+1, _::as => drop n as

@[simp] theorem drop_nil : ([] : List α).drop i = [] := by
  cases i <;> rfl

theorem get_drop_eq_drop (as : List α) (i : Nat) (h : i < as.length) : as[i] :: as.drop (i+1) = as.drop i :=
  match as, i with
  | _::_, 0   => rfl
  | _::_, i+1 => get_drop_eq_drop _ i _

/--
`O(min n |xs|)`. Returns the first `n` elements of `xs`, or the whole list if `n` is too large.
* `take 0 [a, b, c, d, e] = []`
* `take 3 [a, b, c, d, e] = [a, b, c]`
* `take 6 [a, b, c, d, e] = [a, b, c, d, e]`
-/
def take : Nat → List α → List α
  | 0,   _     => []
  | _+1, []    => []
  | n+1, a::as => a :: take n as

/--
`O(|xs|)`. Returns the longest initial segment of `xs` for which `p` returns true.
* `takeWhile (· > 5) [7, 6, 4, 8] = [7, 6]`
* `takeWhile (· > 5) [7, 6, 6, 8] = [7, 6, 6, 8]`
-/
def takeWhile (p : α → Bool) : (xs : List α) → List α
  | []       => []
  | hd :: tl => match p hd with
   | true  => hd :: takeWhile p tl
   | false => []

/--
`O(|l|)`. Applies function `f` to all of the elements of the list, from right to left.
* `foldr f init [a, b, c] = f a <| f b <| f c <| init`
-/
@[specialize] def foldr (f : α → β → β) (init : β) : List α → β
  | []     => init
  | a :: l => f a (foldr f init l)

/--
`O(|l|)`. Returns true if `p` is true for any element of `l`.
* `any p [a, b, c] = p a || p b || p c`
-/
@[inline] def any (l : List α) (p : α → Bool) : Bool :=
  foldr (fun a r => p a || r) false l

/--
`O(|l|)`. Returns true if `p` is true for every element of `l`.
* `any p [a, b, c] = p a && p b && p c`
-/
@[inline] def all (l : List α) (p : α → Bool) : Bool :=
  foldr (fun a r => p a && r) true l

/--
`O(|l|)`. Returns true if `true` is an element of the list of booleans `l`.
* `or [a, b, c] = a || b || c`
-/
def or  (bs : List Bool) : Bool := bs.any id

/--
`O(|l|)`. Returns true if every element of `l` is the value `true`.
* `and [a, b, c] = a && b && c`
-/
def and (bs : List Bool) : Bool := bs.all id

/--
`O(min |xs| |ys|)`. Applies `f` to the two lists in parallel, stopping at the shorter list.
* `zipWith f [x₁, x₂, x₃] [y₁, y₂, y₃, y₄] = [f x₁ y₁, f x₂ y₂, f x₃ y₃]`
-/
@[specialize] def zipWith (f : α → β → γ) : (xs : List α) → (ys : List β) → List γ
  | x::xs, y::ys => f x y :: zipWith f xs ys
  | _,     _     => []

/--
`O(min |xs| |ys|)`. Combines the two lists into a list of pairs, with one element from each list.
The longer list is truncated to match the shorter list.
* `zip [x₁, x₂, x₃] [y₁, y₂, y₃, y₄] = [(x₁, y₁), (x₂, y₂), (x₃, y₃)]`
-/
def zip : List α → List β → List (Prod α β) :=
  zipWith Prod.mk

/--
`O(|l|)`. Separates a list of pairs into two lists containing the first components and second components.
* `unzip [(x₁, y₁), (x₂, y₂), (x₃, y₃)] = ([x₁, x₂, x₃], [y₁, y₂, y₃])`
-/
def unzip : List (α × β) → List α × List β
  | []          => ([], [])
  | (a, b) :: t => match unzip t with | (al, bl) => (a::al, b::bl)

/--
`O(n)`. `range n` is the numbers from `0` to `n` exclusive, in increasing order.
* `range 5 = [0, 1, 2, 3, 4]`
-/
def range (n : Nat) : List Nat :=
  loop n []
where
  loop : Nat → List Nat → List Nat
  | 0,   ns => ns
  | n+1, ns => loop n (n::ns)

/--
`O(n)`. `iota n` is the numbers from `1` to `n` inclusive, in decreasing order.
* `iota 5 = [5, 4, 3, 2, 1]`
-/
def iota : Nat → List Nat
  | 0       => []
  | m@(n+1) => m :: iota n

/-- Tail-recursive version of `iota`. -/
def iotaTR (n : Nat) : List Nat :=
  let rec go : Nat → List Nat → List Nat
    | 0, r => r.reverse
    | m@(n+1), r => go n (m::r)
  go n []

@[csimp]
theorem iota_eq_iotaTR : @iota = @iotaTR :=
  have aux (n : Nat) (r : List Nat) : iotaTR.go n r = r.reverse ++ iota n := by
    induction n generalizing r with
    | zero => simp [iota, iotaTR.go]
    | succ n ih => simp [iota, iotaTR.go, ih, append_assoc]
  funext fun n => by simp [iotaTR, aux]

/--
`O(|l|)`. `enumFrom n l` is like `enum` but it allows you to specify the initial index.
* `enumFrom 5 [a, b, c] = [(5, a), (6, b), (7, c)]`
-/
def enumFrom : Nat → List α → List (Nat × α)
  | _, [] => nil
  | n, x :: xs   => (n, x) :: enumFrom (n + 1) xs

/--
`O(|l|)`. `enum l` pairs up each element with its index in the list.
* `enum [a, b, c] = [(0, a), (1, b), (2, c)]`
-/
def enum : List α → List (Nat × α) := enumFrom 0

/--
`O(|l|)`. `intersperse sep l` alternates `sep` and the elements of `l`:
* `intersperse sep [] = []`
* `intersperse sep [a] = [a]`
* `intersperse sep [a, b] = [a, sep, b]`
* `intersperse sep [a, b, c] = [a, sep, b, sep, c]`
-/
def intersperse (sep : α) : List α → List α
  | []    => []
  | [x]   => [x]
  | x::xs => x :: sep :: intersperse sep xs

/--
`O(|xs|)`. `intercalate sep xs` alternates `sep` and the elements of `xs`:
* `intercalate sep [] = []`
* `intercalate sep [a] = a`
* `intercalate sep [a, b] = a ++ sep ++ b`
* `intercalate sep [a, b, c] = a ++ sep ++ b ++ sep ++ c`
-/
def intercalate (sep : List α) (xs : List (List α)) : List α :=
  join (intersperse sep xs)

/--
`bind xs f` is the bind operation of the list monad. It applies `f` to each element of `xs`
to get a list of lists, and then concatenates them all together.
* `[2, 3, 2].bind range = [0, 1, 0, 1, 2, 0, 1]`
-/
@[inline] protected def bind {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := join (map b a)

/-- `pure x = [x]` is the `pure` operation of the list monad. -/
@[inline] protected def pure {α : Type u} (a : α) : List α := [a]

/--
The lexicographic order on lists.
`[] < a::as`, and `a::as < b::bs` if `a < b` or if `a` and `b` are equivalent and `as < bs`.
-/
inductive lt [LT α] : List α → List α → Prop where
  /-- `[]` is the smallest element in the order. -/
  | nil  (b : α) (bs : List α) : lt [] (b::bs)
  /-- If `a < b` then `a::as < b::bs`. -/
  | head {a : α} (as : List α) {b : α} (bs : List α) : a < b → lt (a::as) (b::bs)
  /-- If `a` and `b` are equivalent and `as < bs`, then `a::as < b::bs`. -/
  | tail {a : α} {as : List α} {b : α} {bs : List α} : ¬ a < b → ¬ b < a → lt as bs → lt (a::as) (b::bs)

instance [LT α] : LT (List α) := ⟨List.lt⟩

instance hasDecidableLt [LT α] [h : DecidableRel (α:=α) (·<·)] : (l₁ l₂ : List α) → Decidable (l₁ < l₂)
  | [],    []    => isFalse (fun h => nomatch h)
  | [],    _::_  => isTrue (List.lt.nil _ _)
  | _::_, []     => isFalse (fun h => nomatch h)
  | a::as, b::bs =>
    match h a b with
    | isTrue h₁  => isTrue (List.lt.head _ _ h₁)
    | isFalse h₁ =>
      match h b a with
      | isTrue h₂  => isFalse (fun h => match h with
         | List.lt.head _ _ h₁' => absurd h₁' h₁
         | List.lt.tail _ h₂' _ => absurd h₂ h₂')
      | isFalse h₂ =>
        match hasDecidableLt as bs with
        | isTrue h₃  => isTrue (List.lt.tail h₁ h₂ h₃)
        | isFalse h₃ => isFalse (fun h => match h with
           | List.lt.head _ _ h₁' => absurd h₁' h₁
           | List.lt.tail _ _ h₃' => absurd h₃' h₃)

/-- The lexicographic order on lists. -/
@[reducible] protected def le [LT α] (a b : List α) : Prop := ¬ b < a

instance [LT α] : LE (List α) := ⟨List.le⟩

instance [LT α] [DecidableRel ((· < ·) : α → α → Prop)] : (l₁ l₂ : List α) → Decidable (l₁ ≤ l₂) :=
  fun _ _ => inferInstanceAs (Decidable (Not _))

/--  `isPrefixOf l₁ l₂` returns `true` Iff `l₁` is a prefix of `l₂`.
That is, there exists a `t` such that `l₂ == l₁ ++ t`. -/
def isPrefixOf [BEq α] : List α → List α → Bool
  | [],    _     => true
  | _,     []    => false
  | a::as, b::bs => a == b && isPrefixOf as bs

/-- `isPrefixOf? l₁ l₂` returns `some t` when `l₂ == l₁ ++ t`. -/
def isPrefixOf? [BEq α] : List α → List α → Option (List α)
  | [], l₂ => some l₂
  | _, [] => none
  | (x₁ :: l₁), (x₂ :: l₂) =>
    if x₁ == x₂ then isPrefixOf? l₁ l₂ else none

/--  `isSuffixOf l₁ l₂` returns `true` Iff `l₁` is a suffix of `l₂`.
That is, there exists a `t` such that `l₂ == t ++ l₁`. -/
def isSuffixOf [BEq α] (l₁ l₂ : List α) : Bool :=
  isPrefixOf l₁.reverse l₂.reverse

/-- `isSuffixOf? l₁ l₂` returns `some t` when `l₂ == t ++ l₁`.-/
def isSuffixOf? [BEq α] (l₁ l₂ : List α) : Option (List α) :=
  Option.map List.reverse <| isPrefixOf? l₁.reverse l₂.reverse

/--
`O(min |as| |bs|)`. Returns true if `as` and `bs` have the same length,
and they are pairwise related by `eqv`.
-/
@[specialize] def isEqv : (as bs : List α) → (eqv : α → α → Bool) → Bool
  | [],    [],    _   => true
  | a::as, b::bs, eqv => eqv a b && isEqv as bs eqv
  | _,     _,     _   => false

/--
The equality relation on lists asserts that they have the same length
and they are pairwise `BEq`.
-/
protected def beq [BEq α] : List α → List α → Bool
  | [],    []    => true
  | a::as, b::bs => a == b && List.beq as bs
  | _,     _     => false

instance [BEq α] : BEq (List α) := ⟨List.beq⟩

/--
`replicate n a` is `n` copies of `a`:
* `replicate 5 a = [a, a, a, a, a]`
-/
@[simp] def replicate : (n : Nat) → (a : α) → List α
  | 0,   _ => []
  | n+1, a => a :: replicate n a

/-- Tail-recursive version of `List.replicate`. -/
def replicateTR {α : Type u} (n : Nat) (a : α) : List α :=
  let rec loop : Nat → List α → List α
    | 0, as => as
    | n+1, as => loop n (a::as)
  loop n []

theorem replicateTR_loop_replicate_eq (a : α) (m n : Nat) :
  replicateTR.loop a n (replicate m a) = replicate (n + m) a := by
  induction n generalizing m with simp [replicateTR.loop]
  | succ n ih => simp [Nat.succ_add]; exact ih (m+1)

@[csimp] theorem replicate_eq_replicateTR : @List.replicate = @List.replicateTR := by
  apply funext; intro α; apply funext; intro n; apply funext; intro a
  exact (replicateTR_loop_replicate_eq _ 0 n).symm

/--
Removes the last element of the list.
* `dropLast [] = []`
* `dropLast [a] = []`
* `dropLast [a, b, c] = [a, b]`
-/
def dropLast {α} : List α → List α
  | []    => []
  | [_]   => []
  | a::as => a :: dropLast as

@[simp] theorem length_replicate (n : Nat) (a : α) : (replicate n a).length = n := by
  induction n <;> simp_all

@[simp] theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
  induction as with
  | nil => rfl
  | cons _ xs ih => simp [concat, ih]

@[simp] theorem length_set (as : List α) (i : Nat) (a : α) : (as.set i a).length = as.length := by
  induction as generalizing i with
  | nil => rfl
  | cons x xs ih =>
    cases i with
    | zero => rfl
    | succ i => simp [set, ih]

@[simp] theorem length_dropLast_cons (a : α) (as : List α) : (a :: as).dropLast.length = as.length := by
  match as with
  | []       => rfl
  | b::bs =>
    have ih := length_dropLast_cons b bs
    simp[dropLast, ih]

@[simp] theorem length_append (as bs : List α) : (as ++ bs).length = as.length + bs.length := by
  induction as with
  | nil => simp
  | cons _ as ih => simp [ih, Nat.succ_add]

@[simp] theorem length_map (as : List α) (f : α → β) : (as.map f).length = as.length := by
  induction as with
  | nil => simp [List.map]
  | cons _ as ih => simp [List.map, ih]

@[simp] theorem length_reverse (as : List α) : (as.reverse).length = as.length := by
  induction as with
  | nil => rfl
  | cons a as ih => simp [ih]

/--
Returns the largest element of the list, if it is not empty.
* `[].maximum? = none`
* `[4].maximum? = some 4`
* `[1, 4, 2, 10, 6].maximum? = some 10`
-/
def maximum? [Max α] : List α → Option α
  | []    => none
  | a::as => some <| as.foldl max a

/--
Returns the smallest element of the list, if it is not empty.
* `[].minimum? = none`
* `[4].minimum? = some 4`
* `[1, 4, 2, 10, 6].minimum? = some 1`
-/
def minimum? [Min α] : List α → Option α
  | []    => none
  | a::as => some <| as.foldl min a

instance [BEq α] [LawfulBEq α] : LawfulBEq (List α) where
  eq_of_beq {as bs} := by
    induction as generalizing bs with
    | nil => intro h; cases bs <;> first | rfl | contradiction
    | cons a as ih =>
      cases bs with
      | nil => intro h; contradiction
      | cons b bs =>
        simp [show (a::as == b::bs) = (a == b && as == bs) from rfl]
        intro ⟨h₁, h₂⟩
        exact ⟨h₁, ih h₂⟩
  rfl {as} := by
    induction as with
    | nil => rfl
    | cons a as ih => simp [BEq.beq, List.beq, LawfulBEq.rfl]; exact ih

theorem of_concat_eq_concat {as bs : List α} {a b : α} (h : as.concat a = bs.concat b) : as = bs ∧ a = b := by
  match as, bs with
  | [], [] => simp [concat] at h; simp [h]
  | [_], [] => simp [concat] at h
  | _::_::_, [] => simp [concat] at h
  | [], [_] => simp [concat] at h
  | [], _::_::_ => simp [concat] at h
  | _::_, _::_ => simp [concat] at h; simp [h]; apply of_concat_eq_concat h.2

theorem concat_eq_append (as : List α) (a : α) : as.concat a = as ++ [a] := by
  induction as <;> simp [concat, *]

theorem drop_eq_nil_of_le {as : List α} {i : Nat} (h : as.length ≤ i) : as.drop i = [] := by
  match as, i with
  | [],    i   => simp
  | _::_,  0   => simp at h
  | _::as, i+1 => simp at h; exact @drop_eq_nil_of_le as i (Nat.le_of_succ_le_succ h)

end List


import Advent.IO
import Lib.Logic.Classical
import Lib.Data.Array.Basic
import Lib.Data.Nat
import Lib.Tactic
import Std.Data.HashMap

def Dim := 5

structure Board where
mkImpl ::
  cells : Grid Dim Dim Nat
  marked : Grid Dim Dim Bool
  locs : Std.HashMap Nat (Fin Dim × Fin Dim)
  rows : Buffer Dim Nat
  cols : Buffer Dim Nat
  -- diag₀ : Nat
  -- diag₁ : Nat

instance : ToString Board where
  toString x :=
    let mark (x : Nat)
        | true => s!"({x})"
        | false => s!" {x} "
    let cells := x.cells.zipWith mark x.marked
    let inner := String.intercalate ",\n   " $
      cells.cells.cells.map (toString ∘ Buffer.cells) |>.toList
    s!"#[ {inner} ]"

namespace Board

@[inline]
def foldlIdx₂
    (ar : Grid m n α) (f : Fin m → Fin n → α → β → β) (x₀ : β) : β :=
ar.foldlIdx f x₀

def mk (cells : Array (Array Nat)) : Option Board := do
let cells ← Grid.mk cells
return {
    cells := cells,
    marked := cells.map λ _ => false,
    locs := foldlIdx₂ cells (λ i j x m => m.insert x (i, j)) (Std.mkHashMap 10),
    rows := Buffer.mkFilled Dim
    cols := Buffer.mkFilled Dim
    -- diag₀ := Dim
    -- diag₁ := Dim
  }

def Fin.max {n : Nat} m (h : m = Nat.succ n) : Fin m :=
⟨n, h ▸ Nat.lt_succ_self _ ⟩

def score (n : Nat) (b : Board) : Bool × Board := Id.run $ do
let some (i, j) ← b.locs.find? n | return (false, b)
-- let false       ← b.marked.get i j | return (false, b)
if ¬ b.marked.get i j then
  let b' := { b with
    marked := b.marked.set i j true
    rows := b.rows.modify i Nat.pred
    cols := b.cols.modify j Nat.pred }
    -- diag₀ := if i = j then b.diag₀ - 1 else b.diag₀
    -- diag₁ := if Fin.max Dim rfl - i = j then b.diag₁ - 1 else b.diag₁ }
  let win : Bool := b'.rows.get i = 0 ∨ b'.cols.get j = 0
  return(win, b')
else return (false, b)

end Board

section Logic

theorem And.congr {p p' q q'}
        (hp : p ↔ p')
        (hq : q ↔ q') :
  p ∧ q ↔ p' ∧ q' := by simp [*]

theorem And.congr_left {p p' q}
        (Hp : p ↔ p') :
  p ∧ q ↔ p' ∧ q :=
by apply And.congr <;> simp [*]

theorem And.congr_right {p q q'}
        (Hp : q ↔ q') :
  p ∧ q ↔ p ∧ q' :=
by apply And.congr <;> simp [*]

end Logic

structure Game where
  draw : Array Nat
  boards : Array Board

def Board.partRun (ar : Subarray Nat) (b : Board) : (n : Nat) → Board
| 0 => b
| Nat.succ n =>
if hsize : 0 < ar.size then
  let (_, b') := b.score $ ar.get ⟨0, hsize⟩
  partRun ar.popFront b' n
else
  b

def Board.sum (b : Board) : Nat :=
let unmarked x b := if b then 0 else x
(b.cells.zipWith unmarked b.marked).foldl (.+.) 0

def Board.run (n : Nat) (ar : Subarray Nat) (b : Board) :
  Option (Nat × Nat) :=
if hsize : 0 < ar.size then
  -- trace[foo] b'
  let draw := ar.get ⟨0, hsize⟩
  let (win, b') := b.score draw
  let n' := n + 1
  if win then
    let score := b'.sum * draw
    some (n', score)
  else
    have : ar.popFront.size < ar.size := by
      simp [*]; auto [Nat.sub_lt]
    run n' ar.popFront b'
else none
termination_by run ar _ => ar.size
-- decreasing_by prove_decr

def Option.combine (f : α → α → α) : Option α → Option α → Option α
| none, x => x
| x, none => x
| some x, some y => some $ f x y

def parseDraws (input : String) : IO (Array Nat) :=
(input.splitOn ",").toArray.mapM parseNat

partial def parseBoards (input : Subarray String) : IO (Array Board) :=
  let rec go (ar : Array Board) input := do
    let input := input.dropWhile String.isEmpty
    let (board, input) := input.span (not ∘ String.isEmpty)
    if board.size = 0 then
      return ar
    else do
      let x := Board.mk (← board.toArray.mapM
               λ x => (String.splitOn x " "
                      |>.filter (not ∘ String.isEmpty)
                      |>.toArray.mapM parseNat))
      match x with
       | some x => go (ar.push x) input
       | none => throw (IO.userError "parsing error")
  go (Array.mkEmpty 10) input

def parseInput (input : Array String) : IO Game := do
  let first := input.get! 0
  let input := input[1:]
  let draws ← parseDraws first
  let boards ← parseBoards input
  -- IO.println draws
  -- for x in boards do
  --   IO.println $ x.run 0 draws.toSubarray
  --   IO.println $ x.partRun draws.toSubarray 12

  return ⟨draws, boards⟩

-- Part 1
def Game.findWinner (g : Game) : Option Nat := do
let combine : Nat × Nat → Nat × Nat → Nat × Nat
    | ⟨n,score⟩, ⟨n',score'⟩ =>
      if n > n' then ⟨n,score⟩ -- <- Part 2
      else ⟨n', score'⟩
let go (acc : Option (Nat × Nat)) (b : Board) :=
    Option.combine combine acc $ b.run 0 g.draw.toSubarray
let (r, score) ← g.boards.foldl go none
return score

namespace Day4

def inputFileName := "Advent/Day4_input.txt"

def examples :=
"7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1

22 13 17 11  0
 8  2 23  4 24
21  9 14 16  7
 6 10  3 18  5
 1 12 20 15 19

 3 15  0  2 22
 9 18 13 17  5
19  8  7 25 23
20 11 10 24  4
14 21 16 12  6

14 21 17 24  4
10 16 15  9 19
18  8 23 26 20
22 11 13  6  5
 2  0 12  3  7"

def main : IO Unit := do
  -- let g ← parseInput $ lines examples
  let g ← parseInput (← IO.FS.lines inputFileName)
  IO.println $ g.findWinner
  IO.println "hello world"

#eval main

end Day4


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.CommRing.basic
import Mathlib.topology.category.Top.basic
import Mathlib.topology.algebra.ring
import Mathlib.PostPort

universes u l u_1 u_2

namespace Mathlib

/-- A bundled topological commutative ring. -/
structure TopCommRing
where
  α : Type u
  is_comm_ring : comm_ring α
  is_topological_space : topological_space α
  is_topological_ring : topological_ring α

namespace TopCommRing

protected instance has_coe_to_sort : has_coe_to_sort TopCommRing :=
  has_coe_to_sort.mk (Type u) α

protected instance category_theory.category : category_theory.category TopCommRing :=
  category_theory.category.mk

protected instance category_theory.concrete_category : category_theory.concrete_category TopCommRing :=
  category_theory.concrete_category.mk
    (category_theory.functor.mk (fun (R : TopCommRing) => ↥R) fun (R S : TopCommRing) (f : R ⟶ S) => ⇑(subtype.val f))

/-- Construct a bundled `TopCommRing` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] : TopCommRing :=
  mk X

@[simp] theorem coe_of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] : ↥(of X) = X :=
  rfl

protected instance forget_topological_space (R : TopCommRing) : topological_space (category_theory.functor.obj (category_theory.forget TopCommRing) R) :=
  is_topological_space R

protected instance forget_comm_ring (R : TopCommRing) : comm_ring (category_theory.functor.obj (category_theory.forget TopCommRing) R) :=
  is_comm_ring R

protected instance forget_topological_ring (R : TopCommRing) : topological_ring (category_theory.functor.obj (category_theory.forget TopCommRing) R) :=
  is_topological_ring R

protected instance has_forget_to_CommRing : category_theory.has_forget₂ TopCommRing CommRing :=
  category_theory.has_forget₂.mk' (fun (R : TopCommRing) => CommRing.of ↥R) sorry
    (fun (R S : TopCommRing) (f : R ⟶ S) => subtype.val f) sorry

protected instance forget_to_CommRing_topological_space (R : TopCommRing) : topological_space ↥(category_theory.functor.obj (category_theory.forget₂ TopCommRing CommRing) R) :=
  is_topological_space R

/-- The forgetful functor to Top. -/
protected instance has_forget_to_Top : category_theory.has_forget₂ TopCommRing Top :=
  category_theory.has_forget₂.mk' (fun (R : TopCommRing) => Top.of ↥R) sorry
    (fun (R S : TopCommRing) (f : R ⟶ S) => continuous_map.mk ⇑(subtype.val f)) sorry

protected instance forget_to_Top_comm_ring (R : TopCommRing) : comm_ring ↥(category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) R) :=
  is_comm_ring R

protected instance forget_to_Top_topological_ring (R : TopCommRing) : topological_ring ↥(category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) R) :=
  is_topological_ring R

/--
The forgetful functors to `Type` do not reflect isomorphisms,
but the forgetful functor from `TopCommRing` to `Top` does.
-/
protected instance category_theory.forget₂.category_theory.reflects_isomorphisms : category_theory.reflects_isomorphisms (category_theory.forget₂ TopCommRing Top) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : TopCommRing) (f : X ⟶ Y)
      (_x : category_theory.is_iso (category_theory.functor.map (category_theory.forget₂ TopCommRing Top) f)) =>
      let i_Top :
        category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) X ≅
          category_theory.functor.obj (category_theory.forget₂ TopCommRing Top) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget₂ TopCommRing Top) f);
      let e_Ring : ↥X ≃+* ↥Y :=
        ring_equiv.mk (ring_hom.to_fun (subtype.val f))
          (equiv.inv_fun
            (category_theory.iso.to_equiv (category_theory.functor.map_iso (category_theory.forget Top) i_Top)))
          sorry sorry sorry sorry;
      category_theory.is_iso.mk { val := ↑(ring_equiv.symm e_Ring), property := sorry }