/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn

Basic properties of lists.
-/
import logic tools.helper_tactics data.nat.order data.nat.sub
open eq.ops nat prod function option

inductive list (T : Type) : Type :=
| nil {} : list T
| cons   : T → list T → list T

protected definition list.is_inhabited [instance] (A : Type) : inhabited (list A) :=
inhabited.mk list.nil

namespace list
notation h :: t  := cons h t
notation `[` l:(foldr `, ` (h t, cons h t) nil `]`) := l

variable {T : Type}

lemma cons_ne_nil [simp] (a : T) (l : list T) : a::l ≠ [] :=
by contradiction

lemma head_eq_of_cons_eq {A : Type} {h₁ h₂ : A} {t₁ t₂ : list A} :
      (h₁::t₁) = (h₂::t₂) → h₁ = h₂ :=
assume Peq, list.no_confusion Peq (assume Pheq Pteq, Pheq)

lemma tail_eq_of_cons_eq {A : Type} {h₁ h₂ : A} {t₁ t₂ : list A} :
      (h₁::t₁) = (h₂::t₂) → t₁ = t₂ :=
assume Peq, list.no_confusion Peq (assume Pheq Pteq, Pteq)

lemma cons_inj {A : Type} {a : A} : injective (cons a) :=
take l₁ l₂, assume Pe, tail_eq_of_cons_eq Pe

/- append -/

definition append : list T → list T → list T
| []       l := l
| (h :: s) t := h :: (append s t)

notation l₁ ++ l₂ := append l₁ l₂

theorem append_nil_left [simp] (t : list T) : [] ++ t = t :=
rfl

theorem append_cons [simp] (x : T) (s t : list T) : (x::s) ++ t = x::(s ++ t) :=
rfl

theorem append_nil_right [simp] : ∀ (t : list T), t ++ [] = t :=
by rec_inst_simp

theorem append.assoc [simp] : ∀ (s t u : list T), s ++ t ++ u = s ++ (t ++ u) :=
by rec_inst_simp

/- length -/
definition length : list T → nat
| []       := 0
| (a :: l) := length l + 1

theorem length_nil [simp] : length (@nil T) = 0 :=
rfl

theorem length_cons [simp] (x : T) (t : list T) : length (x::t) = length t + 1 :=
rfl

theorem length_append [simp] : ∀ (s t : list T), length (s ++ t) = length s + length t :=
by rec_inst_simp

theorem eq_nil_of_length_eq_zero : ∀ {l : list T}, length l = 0 → l = []
| []     H := rfl
| (a::s) H := by contradiction

theorem length_cons_pos (h : T) (tt : list T) : 0 < length (h::tt) :=
  begin
    apply lt_of_not_ge,
    intro H,
    let H' := list.eq_nil_of_length_eq_zero (eq_zero_of_le_zero H),
    apply !list.cons_ne_nil H'
  end

theorem ne_nil_of_length_eq_succ : ∀ {l : list T} {n : nat}, length l = succ n → l ≠ []
| []     n h := by contradiction
| (a::l) n h := by contradiction

/- concat -/

definition concat : Π (x : T), list T → list T
| a []       := [a]
| a (b :: l) := b :: concat a l

theorem concat_nil [simp] (x : T) : concat x [] = [x] :=
rfl

theorem concat_cons [simp] (x y : T) (l : list T) : concat x (y::l)  = y::(concat x l) :=
rfl

theorem concat_eq_append [simp] (a : T) : ∀ (l : list T), concat a l = l ++ [a] :=
by rec_inst_simp

theorem concat_ne_nil [simp] (a : T) : ∀ (l : list T), concat a l ≠ [] :=
by intro l; induction l; repeat contradiction

theorem length_concat [simp] (a : T) : ∀ (l : list T), length (concat a l) = length l + 1 :=
by rec_inst_simp

theorem concat_append [simp] (a : T) : ∀ (l₁ l₂ : list T), concat a l₁ ++ l₂ = l₁ ++ a :: l₂ :=
by rec_inst_simp

theorem append_concat (a : T)  : ∀(l₁ l₂ : list T), l₁ ++ concat a l₂ = concat a (l₁ ++ l₂) :=
by rec_inst_simp

/- last -/

definition last : Π l : list T, l ≠ [] → T
| []          h := absurd rfl h
| [a]         h := a
| (a₁::a₂::l) h := last (a₂::l) !cons_ne_nil

lemma last_singleton [simp] (a : T) (h : [a] ≠ []) : last [a] h = a :=
rfl

lemma last_cons_cons [simp] (a₁ a₂ : T) (l : list T) (h : a₁::a₂::l ≠ []) : last (a₁::a₂::l) h = last (a₂::l) !cons_ne_nil :=
rfl

theorem last_congr {l₁ l₂ : list T} (h₁ : l₁ ≠ []) (h₂ : l₂ ≠ []) (h₃ : l₁ = l₂) : last l₁ h₁ = last l₂ h₂ :=
by subst l₁

theorem last_concat [simp] {x : T} : ∀ {l : list T} (h : concat x l ≠ []), last (concat x l) h = x :=
by rec_simp

-- add_rewrite append_nil append_cons

/- reverse -/

definition reverse : list T → list T
| []       := []
| (a :: l) := concat a (reverse l)

theorem reverse_nil [simp] : reverse (@nil T) = [] :=
rfl

theorem reverse_cons [simp] (x : T) (l : list T) : reverse (x::l) = concat x (reverse l) :=
rfl

theorem reverse_singleton [simp] (x : T) : reverse [x] = [x] :=
rfl

theorem reverse_append [simp] : ∀ (s t : list T), reverse (s ++ t) = (reverse t) ++ (reverse s) :=
by rec_inst_simp

theorem reverse_reverse [simp] : ∀ (l : list T), reverse (reverse l) = l :=
by rec_inst_simp

theorem concat_eq_reverse_cons (x : T) (l : list T) : concat x l = reverse (x :: reverse l) :=
by inst_simp

theorem length_reverse : ∀ (l : list T), length (reverse l) = length l :=
by rec_inst_simp

/- head and tail -/

definition head [h : inhabited T] : list T → T
| []       := arbitrary T
| (a :: l) := a

theorem head_cons [simp] [h : inhabited T] (a : T) (l : list T) : head (a::l) = a :=
rfl

theorem head_append [simp] [h : inhabited T] (t : list T) : ∀ {s : list T}, s ≠ [] → head (s ++ t) = head s :=
by rec_inst_simp

definition tail : list T → list T
| []       := []
| (a :: l) := l

theorem tail_nil [simp] : tail (@nil T) = [] :=
rfl

theorem tail_cons [simp] (a : T) (l : list T) : tail (a::l) = l :=
rfl

theorem cons_head_tail [h : inhabited T] {l : list T} : l ≠ [] → (head l)::(tail l) = l :=
by rec_inst_simp

/- list membership -/

definition mem : T → list T → Prop
| a []       := false
| a (b :: l) := a = b ∨ mem a l

notation e ∈ s := mem e s
notation e ∉ s := ¬ e ∈ s

theorem mem_nil_iff (x : T) : x ∈ [] ↔ false :=
iff.rfl

theorem not_mem_nil (x : T) : x ∉ [] :=
iff.mp !mem_nil_iff

theorem mem_cons [simp] (x : T) (l : list T) : x ∈ x :: l :=
or.inl rfl

theorem mem_cons_of_mem (y : T) {x : T} {l : list T} : x ∈ l → x ∈ y :: l :=
assume H, or.inr H

theorem mem_cons_iff (x y : T) (l : list T) : x ∈ y::l ↔ (x = y ∨ x ∈ l) :=
iff.rfl

theorem eq_or_mem_of_mem_cons {x y : T} {l : list T} : x ∈ y::l → x = y ∨ x ∈ l :=
assume h, h

theorem mem_singleton {x a : T} : x ∈ [a] → x = a :=
suppose x ∈ [a], or.elim (eq_or_mem_of_mem_cons this)
  (suppose x = a, this)
  (suppose x ∈ [], absurd this !not_mem_nil)

theorem mem_of_mem_cons_of_mem {a b : T} {l : list T} : a ∈ b::l → b ∈ l → a ∈ l :=
assume ainbl binl, or.elim (eq_or_mem_of_mem_cons ainbl)
  (suppose a = b, by substvars; exact binl)
  (suppose a ∈ l, this)

theorem mem_or_mem_of_mem_append {x : T} {s t : list T} : x ∈ s ++ t → x ∈ s ∨ x ∈ t :=
list.induction_on s or.inr
  (take y s,
    assume IH : x ∈ s ++ t → x ∈ s ∨ x ∈ t,
    suppose x ∈ y::s ++ t,
    have x = y ∨ x ∈ s ++ t, from this,
    have x = y ∨ x ∈ s ∨ x ∈ t, from or_of_or_of_imp_right this IH,
    iff.elim_right or.assoc this)

theorem mem_append_of_mem_or_mem {x : T} {s t : list T} : x ∈ s ∨ x ∈ t → x ∈ s ++ t :=
list.induction_on s
  (take H, or.elim H false.elim (assume H, H))
  (take y s,
    assume IH : x ∈ s ∨ x ∈ t → x ∈ s ++ t,
    suppose x ∈ y::s ∨ x ∈ t,
      or.elim this
        (suppose x ∈ y::s,
          or.elim (eq_or_mem_of_mem_cons this)
            (suppose x = y, or.inl this)
            (suppose x ∈ s, or.inr (IH (or.inl this))))
        (suppose x ∈ t, or.inr (IH (or.inr this))))

theorem mem_append_iff (x : T) (s t : list T) : x ∈ s ++ t ↔ x ∈ s ∨ x ∈ t :=
iff.intro mem_or_mem_of_mem_append mem_append_of_mem_or_mem

theorem not_mem_of_not_mem_append_left {x : T} {s t : list T} : x ∉ s++t → x ∉ s :=
λ nxinst xins, absurd (mem_append_of_mem_or_mem (or.inl xins)) nxinst

theorem not_mem_of_not_mem_append_right {x : T} {s t : list T} : x ∉ s++t → x ∉ t :=
λ nxinst xint, absurd (mem_append_of_mem_or_mem (or.inr xint)) nxinst

theorem not_mem_append {x : T} {s t : list T} : x ∉ s → x ∉ t → x ∉ s++t :=
λ nxins nxint xinst, or.elim (mem_or_mem_of_mem_append xinst)
  (λ xins, by contradiction)
  (λ xint, by contradiction)

lemma length_pos_of_mem {a : T} : ∀ {l : list T}, a ∈ l → 0 < length l
| []     := assume Pinnil, by contradiction
| (b::l) := assume Pin, !zero_lt_succ

section
local attribute mem [reducible]
local attribute append [reducible]
theorem mem_split {x : T} {l : list T} : x ∈ l → ∃s t : list T, l = s ++ (x::t) :=
list.induction_on l
  (suppose x ∈ [], false.elim (iff.elim_left !mem_nil_iff this))
  (take y l,
    assume IH : x ∈ l → ∃s t : list T, l = s ++ (x::t),
    suppose x ∈ y::l,
    or.elim (eq_or_mem_of_mem_cons this)
      (suppose x = y,
        exists.intro [] (!exists.intro (this ▸ rfl)))
      (suppose x ∈ l,
        obtain s (H2 : ∃t : list T, l = s ++ (x::t)), from IH this,
        obtain t (H3 : l = s ++ (x::t)), from H2,
        have y :: l = (y::s) ++ (x::t),
          from H3 ▸ rfl,
        !exists.intro (!exists.intro this)))
end

theorem mem_append_left {a : T} {l₁ : list T} (l₂ : list T) : a ∈ l₁ → a ∈ l₁ ++ l₂ :=
assume ainl₁, mem_append_of_mem_or_mem (or.inl ainl₁)

theorem mem_append_right {a : T} (l₁ : list T) {l₂ : list T} : a ∈ l₂ → a ∈ l₁ ++ l₂ :=
assume ainl₂, mem_append_of_mem_or_mem (or.inr ainl₂)

definition decidable_mem [instance] [H : decidable_eq T] (x : T) (l : list T) : decidable (x ∈ l) :=
list.rec_on l
  (decidable.inr (not_of_iff_false !mem_nil_iff))
  (take (h : T) (l : list T) (iH : decidable (x ∈ l)),
    show decidable (x ∈ h::l), from
    decidable.rec_on iH
      (assume Hp : x ∈ l,
        decidable.rec_on (H x h)
          (suppose x = h,
            decidable.inl (or.inl this))
          (suppose x ≠ h,
            decidable.inl (or.inr Hp)))
      (suppose ¬x ∈ l,
        decidable.rec_on (H x h)
          (suppose x = h, decidable.inl (or.inl this))
          (suppose x ≠ h,
            have ¬(x = h ∨ x ∈ l), from
              suppose x = h ∨ x ∈ l, or.elim this
                (suppose x = h, by contradiction)
                (suppose x ∈ l, by contradiction),
            have ¬x ∈ h::l, from
              iff.elim_right (not_iff_not_of_iff !mem_cons_iff) this,
            decidable.inr this)))

theorem mem_of_ne_of_mem {x y : T} {l : list T} (H₁ : x ≠ y) (H₂ : x ∈ y :: l) : x ∈ l :=
or.elim (eq_or_mem_of_mem_cons H₂) (λe, absurd e H₁) (λr, r)

theorem ne_of_not_mem_cons {a b : T} {l : list T} : a ∉ b::l → a ≠ b :=
assume nin aeqb, absurd (or.inl aeqb) nin

theorem not_mem_of_not_mem_cons {a b : T} {l : list T} : a ∉ b::l → a ∉ l :=
assume nin nainl, absurd (or.inr nainl) nin

lemma not_mem_cons_of_ne_of_not_mem {x y : T} {l : list T} : x ≠ y → x ∉ l → x ∉ y::l :=
assume P1 P2, not.intro (assume Pxin, absurd (eq_or_mem_of_mem_cons Pxin) (not_or P1 P2))

lemma ne_and_not_mem_of_not_mem_cons {x y : T} {l : list T} : x ∉ y::l → x ≠ y ∧ x ∉ l :=
assume P, and.intro (ne_of_not_mem_cons P) (not_mem_of_not_mem_cons P)

definition sublist (l₁ l₂ : list T) := ∀ ⦃a : T⦄, a ∈ l₁ → a ∈ l₂

infix ⊆ := sublist

theorem nil_sub [simp] (l : list T) : [] ⊆ l :=
λ b i, false.elim (iff.mp (mem_nil_iff b) i)

theorem sub.refl [simp] (l : list T) : l ⊆ l :=
λ b i, i

theorem sub.trans {l₁ l₂ l₃ : list T} (H₁ : l₁ ⊆ l₂) (H₂ : l₂ ⊆ l₃) : l₁ ⊆ l₃ :=
λ b i, H₂ (H₁ i)

theorem sub_cons [simp] (a : T) (l : list T) : l ⊆ a::l :=
λ b i, or.inr i

theorem sub_of_cons_sub {a : T} {l₁ l₂ : list T} : a::l₁ ⊆ l₂ → l₁ ⊆ l₂ :=
λ s b i, s b (mem_cons_of_mem _ i)

theorem cons_sub_cons  {l₁ l₂ : list T} (a : T) (s : l₁ ⊆ l₂) : (a::l₁) ⊆ (a::l₂) :=
λ b Hin, or.elim (eq_or_mem_of_mem_cons Hin)
  (λ e : b = a,  or.inl e)
  (λ i : b ∈ l₁, or.inr (s i))

theorem sub_append_left [simp] (l₁ l₂ : list T) : l₁ ⊆ l₁++l₂ :=
λ b i, iff.mpr (mem_append_iff b l₁ l₂) (or.inl i)

theorem sub_append_right [simp] (l₁ l₂ : list T) : l₂ ⊆ l₁++l₂ :=
λ b i, iff.mpr (mem_append_iff b l₁ l₂) (or.inr i)

theorem sub_cons_of_sub (a : T) {l₁ l₂ : list T} : l₁ ⊆ l₂ → l₁ ⊆ (a::l₂) :=
λ (s : l₁ ⊆ l₂) (x : T) (i : x ∈ l₁), or.inr (s i)

theorem sub_app_of_sub_left (l l₁ l₂ : list T) : l ⊆ l₁ → l ⊆ l₁++l₂ :=
λ (s : l ⊆ l₁) (x : T) (xinl : x ∈ l),
  have x ∈ l₁, from s xinl,
  mem_append_of_mem_or_mem (or.inl this)

theorem sub_app_of_sub_right (l l₁ l₂ : list T) : l ⊆ l₂ → l ⊆ l₁++l₂ :=
λ (s : l ⊆ l₂) (x : T) (xinl : x ∈ l),
  have x ∈ l₂, from s xinl,
  mem_append_of_mem_or_mem (or.inr this)

theorem cons_sub_of_sub_of_mem {a : T} {l m : list T} : a ∈ m → l ⊆ m → a::l ⊆ m :=
λ (ainm : a ∈ m) (lsubm : l ⊆ m) (x : T) (xinal : x ∈ a::l), or.elim (eq_or_mem_of_mem_cons xinal)
  (suppose x = a, by substvars; exact ainm)
  (suppose x ∈ l, lsubm this)

theorem app_sub_of_sub_of_sub {l₁ l₂ l : list T} : l₁ ⊆ l → l₂ ⊆ l → l₁++l₂ ⊆ l :=
λ (l₁subl : l₁ ⊆ l) (l₂subl : l₂ ⊆ l) (x : T) (xinl₁l₂ : x ∈ l₁++l₂),
  or.elim (mem_or_mem_of_mem_append xinl₁l₂)
    (suppose x ∈ l₁, l₁subl this)
    (suppose x ∈ l₂, l₂subl this)

/- find -/
section
variable [H : decidable_eq T]
include H

definition find : T → list T → nat
| a []       := 0
| a (b :: l) := if a = b then 0 else succ (find a l)

theorem find_nil [simp] (x : T) : find x [] = 0 :=
rfl

theorem find_cons (x y : T) (l : list T) : find x (y::l) = if x = y then 0 else succ (find x l) :=
rfl

theorem find_cons_of_eq {x y : T} (l : list T) : x = y → find x (y::l) = 0 :=
assume e, if_pos e

theorem find_cons_of_ne {x y : T} (l : list T) : x ≠ y → find x (y::l) = succ (find x l) :=
assume n, if_neg n

theorem find_of_not_mem {l : list T} {x : T} : ¬x ∈ l → find x l = length l :=
list.rec_on l
   (suppose ¬x ∈ [], rfl)
   (take y l,
      assume iH : ¬x ∈ l → find x l = length l,
      suppose ¬x ∈ y::l,
      have ¬(x = y ∨ x ∈ l), from iff.elim_right (not_iff_not_of_iff !mem_cons_iff) this,
      have ¬x = y ∧ ¬x ∈ l, from (iff.elim_left !not_or_iff_not_and_not this),
      calc
        find x (y::l) = if x = y then 0 else succ (find x l) : !find_cons
                  ... = succ (find x l)                      : if_neg (and.elim_left this)
                  ... = succ (length l)                      : {iH (and.elim_right this)}
                  ... = length (y::l)                        : !length_cons⁻¹)

lemma find_le_length : ∀ {a} {l : list T}, find a l ≤ length l
| a []        := !le.refl
| a (b::l)    := decidable.rec_on (H a b)
              (assume Peq, by rewrite [find_cons_of_eq l Peq]; exact !zero_le)
              (assume Pne,
                begin
                  rewrite [find_cons_of_ne l Pne, length_cons],
                  apply succ_le_succ, apply find_le_length
                end)

lemma not_mem_of_find_eq_length : ∀ {a} {l : list T}, find a l = length l → a ∉ l
| a []        := assume Peq, !not_mem_nil
| a (b::l)    := decidable.rec_on (H a b)
                (assume Peq, by rewrite [find_cons_of_eq l Peq, length_cons]; contradiction)
                (assume Pne,
                  begin
                    rewrite [find_cons_of_ne l Pne, length_cons, mem_cons_iff],
                    intro Plen, apply (not_or Pne),
                    exact not_mem_of_find_eq_length (succ.inj Plen)
                  end)

lemma find_lt_length {a} {l : list T} (Pin : a ∈ l) : find a l < length l :=
begin
  apply nat.lt_of_le_and_ne,
  apply find_le_length,
  apply not.intro, intro Peq,
  exact absurd Pin (not_mem_of_find_eq_length Peq)
end

end

/- nth element -/
section nth
definition nth : list T → nat → option T
| []       n     := none
| (a :: l) 0     := some a
| (a :: l) (n+1) := nth l n

theorem nth_zero [simp] (a : T) (l : list T) : nth (a :: l) 0 = some a :=
rfl

theorem nth_succ [simp] (a : T) (l : list T) (n : nat) : nth (a::l) (succ n) = nth l n :=
rfl

theorem nth_eq_some : ∀ {l : list T} {n : nat}, n < length l → Σ a : T, nth l n = some a
| []     n        h := absurd h !not_lt_zero
| (a::l) 0        h := ⟨a, rfl⟩
| (a::l) (succ n) h :=
  have n < length l,                       from lt_of_succ_lt_succ h,
  obtain (r : T) (req : nth l n = some r), from nth_eq_some this,
  ⟨r, by rewrite [nth_succ, req]⟩

open decidable
theorem find_nth [decidable_eq T] {a : T} : ∀ {l}, a ∈ l → nth l (find a l) = some a
| []     ain   := absurd ain !not_mem_nil
| (b::l) ainbl := by_cases
  (λ aeqb : a = b, by rewrite [find_cons_of_eq _ aeqb, nth_zero, aeqb])
  (λ aneb : a ≠ b, or.elim (eq_or_mem_of_mem_cons ainbl)
    (λ aeqb : a = b, absurd aeqb aneb)
    (λ ainl : a ∈ l, by rewrite [find_cons_of_ne _ aneb, nth_succ, find_nth ainl]))

definition inth [h : inhabited T] (l : list T) (n : nat) : T :=
match nth l n with
| some a := a
| none   := arbitrary T
end

theorem inth_zero [inhabited T] (a : T) (l : list T) : inth (a :: l) 0 = a :=
rfl

theorem inth_succ [inhabited T] (a : T) (l : list T) (n : nat) : inth (a::l) (n+1) = inth l n :=
rfl

end nth

section ith
definition ith : Π (l : list T) (i : nat), i < length l → T
| nil     i        h := absurd h !not_lt_zero
| (x::xs) 0        h := x
| (x::xs) (succ i) h := ith xs i (lt_of_succ_lt_succ h)

lemma ith_zero [simp] (a : T) (l : list T) (h : 0 < length (a::l)) : ith (a::l) 0 h = a :=
rfl

lemma ith_succ [simp] (a : T) (l : list T) (i : nat) (h : succ i < length (a::l))
                      : ith (a::l) (succ i) h = ith l i (lt_of_succ_lt_succ h) :=
rfl
end ith

open decidable
definition has_decidable_eq {A : Type} [H : decidable_eq A] : ∀ l₁ l₂ : list A, decidable (l₁ = l₂)
| []      []      := inl rfl
| []      (b::l₂) := inr (by contradiction)
| (a::l₁) []      := inr (by contradiction)
| (a::l₁) (b::l₂) :=
  match H a b with
  | inl Hab  :=
    match has_decidable_eq l₁ l₂ with
    | inl He := inl (by congruence; repeat assumption)
    | inr Hn := inr (by intro H; injection H; contradiction)
    end
  | inr Hnab := inr (by intro H; injection H; contradiction)
  end

/- quasiequal a l l' means that l' is exactly l, with a added
   once somewhere -/
section qeq
variable {A : Type}
inductive qeq (a : A) : list A → list A → Prop :=
| qhead : ∀ l, qeq a l (a::l)
| qcons : ∀ (b : A) {l l' : list A}, qeq a l l' → qeq a (b::l) (b::l')

open qeq

notation l' `≈`:50 a `|` l:50 := qeq a l l'

theorem qeq_app : ∀ (l₁ : list A) (a : A) (l₂ : list A), l₁++(a::l₂) ≈ a|l₁++l₂
| []      a l₂ := qhead a l₂
| (x::xs) a l₂ := qcons x (qeq_app xs a l₂)

theorem mem_head_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → a ∈ l₁ :=
take q, qeq.induction_on q
  (λ l, !mem_cons)
  (λ b l l' q r, or.inr r)

theorem mem_tail_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → ∀ x, x ∈ l₂ → x ∈ l₁ :=
take q, qeq.induction_on q
  (λ l x i, or.inr i)
  (λ b l l' q r x xinbl, or.elim (eq_or_mem_of_mem_cons xinbl)
     (λ xeqb : x = b, xeqb ▸ mem_cons x l')
     (λ xinl : x ∈ l, or.inr (r x xinl)))

theorem mem_cons_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → ∀ x, x ∈ l₁ → x ∈ a::l₂ :=
take q, qeq.induction_on q
  (λ l x i, i)
  (λ b l l' q r x xinbl', or.elim (eq_or_mem_of_mem_cons xinbl')
    (λ xeqb  : x = b, xeqb ▸ or.inr (mem_cons x l))
    (λ xinl' : x ∈ l', or.elim (eq_or_mem_of_mem_cons (r x xinl'))
      (λ xeqa : x = a, xeqa ▸ mem_cons x (b::l))
      (λ xinl : x ∈ l, or.inr (or.inr xinl))))

theorem length_eq_of_qeq {a : A} {l₁ l₂ : list A} : l₁≈a|l₂ → length l₁ = succ (length l₂) :=
take q, qeq.induction_on q
  (λ l, rfl)
  (λ b l l' q r, by rewrite [*length_cons, r])

theorem qeq_of_mem {a : A} {l : list A} : a ∈ l → (∃l', l≈a|l') :=
list.induction_on l
  (λ h : a ∈ nil, absurd h (not_mem_nil a))
  (λ x xs r ainxxs, or.elim (eq_or_mem_of_mem_cons ainxxs)
    (λ aeqx  : a = x,
       have aux : ∃ l, x::xs≈x|l, from
         exists.intro xs (qhead x xs),
       by rewrite aeqx; exact aux)
    (λ ainxs : a ∈ xs,
       have ∃l', xs ≈ a|l', from r ainxs,
       obtain (l' : list A) (q : xs ≈ a|l'), from this,
       have x::xs ≈ a | x::l', from qcons x q,
       exists.intro (x::l') this))

theorem qeq_split {a : A} {l l' : list A} : l'≈a|l → ∃l₁ l₂, l = l₁++l₂ ∧ l' = l₁++(a::l₂) :=
take q, qeq.induction_on q
  (λ t,
    have t = []++t ∧ a::t = []++(a::t), from and.intro rfl rfl,
    exists.intro [] (exists.intro t this))
  (λ b t t' q r,
    obtain (l₁ l₂ : list A) (h : t = l₁++l₂ ∧ t' = l₁++(a::l₂)), from r,
    have b::t = (b::l₁)++l₂ ∧ b::t' = (b::l₁)++(a::l₂),
      begin
        rewrite [and.elim_right h, and.elim_left h],
        constructor, repeat reflexivity
      end,
    exists.intro (b::l₁) (exists.intro l₂ this))

theorem sub_of_mem_of_sub_of_qeq {a : A} {l : list A} {u v : list A} : a ∉ l → a::l ⊆ v → v≈a|u → l ⊆ u :=
λ (nainl : a ∉ l) (s : a::l ⊆ v) (q : v≈a|u) (x : A) (xinl : x ∈ l),
  have x ∈ v,    from s (or.inr xinl),
  have x ∈ a::u, from mem_cons_of_qeq q x this,
  or.elim (eq_or_mem_of_mem_cons this)
    (suppose x = a, by substvars; contradiction)
    (suppose x ∈ u, this)
end qeq

section firstn
variable {A : Type}

definition firstn : nat → list A → list A
| 0     l      := []
| (n+1) []     := []
| (n+1) (a::l) := a :: firstn n l

lemma firstn_zero [simp] : ∀ (l : list A), firstn 0 l = [] :=
by intros; reflexivity

lemma firstn_nil [simp] : ∀ n, firstn n [] = ([] : list A)
| 0     := rfl
| (n+1) := rfl

lemma firstn_cons : ∀ n (a : A) (l : list A), firstn (succ n) (a::l) = a :: firstn n l :=
by intros; reflexivity

lemma firstn_all : ∀ (l : list A), firstn (length l) l = l
| []     := rfl
| (a::l) := begin unfold [length, firstn], rewrite firstn_all end

lemma firstn_all_of_ge : ∀ {n} {l : list A}, n ≥ length l → firstn n l = l
| 0     []     h := rfl
| 0     (a::l) h := absurd h (not_le_of_gt !succ_pos)
| (n+1) []     h := rfl
| (n+1) (a::l) h := begin unfold firstn, rewrite [firstn_all_of_ge (le_of_succ_le_succ h)] end

lemma firstn_firstn : ∀ (n m) (l : list A), firstn n (firstn m l) = firstn (min n m) l
| n         0        l      := by rewrite [min_zero, firstn_zero, firstn_nil]
| 0         m        l      := by rewrite [zero_min]
| (succ n)  (succ m) nil    := by rewrite [*firstn_nil]
| (succ n)  (succ m) (a::l) := by rewrite [*firstn_cons, firstn_firstn, min_succ_succ]

lemma length_firstn_le : ∀ (n) (l : list A), length (firstn n l) ≤ n
| 0        l      := by rewrite [firstn_zero]
| (succ n) (a::l) := by rewrite [firstn_cons, length_cons, add_one]; apply succ_le_succ; apply length_firstn_le
| (succ n) []     := by rewrite [firstn_nil, length_nil]; apply zero_le

lemma length_firstn_eq : ∀ (n) (l : list A), length (firstn n l) = min n (length l)
| 0        l      := by rewrite [firstn_zero, zero_min]
| (succ n) (a::l) := by rewrite [firstn_cons, *length_cons, *add_one, min_succ_succ, length_firstn_eq]
| (succ n) []     := by rewrite [firstn_nil]
end firstn

section dropn
variables {A : Type}
-- 'dropn n l' drops the first 'n' elements of 'l'
definition dropn : ℕ → list A → list A
| 0 a := a
| (succ n) [] := []
| (succ n) (x::r) := dropn n r

theorem length_dropn
: ∀ (i : ℕ) (l : list A), length (dropn i l) = length l - i
| 0 l := rfl
| (succ i) [] := calc
  length (dropn (succ i) []) = 0 - succ i : nat.zero_sub (succ i)
| (succ i) (x::l) := calc
  length (dropn (succ i) (x::l))
          = length (dropn i l)       : rfl
      ... = length l - i             : length_dropn i l
      ... = succ (length l) - succ i : succ_sub_succ (length l) i
end dropn

section count
variable {A : Type}
variable [decA : decidable_eq A]
include decA

definition count (a : A) : list A → nat
| []      := 0
| (x::xs) := if a = x then succ (count xs) else count xs

lemma count_nil (a : A) : count a [] = 0 :=
rfl

lemma count_cons (a b : A) (l : list A) : count a (b::l) = if a = b then succ (count a l) else count a l :=
rfl

lemma count_cons_eq (a : A) (l : list A) : count a (a::l) = succ (count a l) :=
if_pos rfl

lemma count_cons_of_ne {a b : A} (h : a ≠ b) (l : list A) : count a (b::l) = count a l :=
if_neg h

lemma count_cons_ge_count (a b : A) (l : list A) : count a (b::l) ≥ count a l :=
by_cases
  (suppose a = b, begin subst b, rewrite count_cons_eq, apply le_succ end)
  (suppose a ≠ b, begin rewrite (count_cons_of_ne this), apply le.refl end)

lemma count_singleton (a : A) : count a [a] = 1 :=
by rewrite count_cons_eq

lemma count_append (a : A) : ∀ l₁ l₂, count a (l₁++l₂) = count a l₁ + count a l₂
| []      l₂ := by rewrite [append_nil_left, count_nil, zero_add]
| (b::l₁) l₂ := by_cases
  (suppose a = b, by rewrite [-this, append_cons, *count_cons_eq, succ_add, count_append])
  (suppose a ≠ b, by rewrite [append_cons, *count_cons_of_ne this, count_append])

lemma count_concat (a : A) (l : list A) : count a (concat a l) = succ (count a l) :=
by rewrite [concat_eq_append, count_append, count_singleton]

lemma mem_of_count_gt_zero : ∀ {a : A} {l : list A}, count a l > 0 → a ∈ l
| a []     h := absurd h !lt.irrefl
| a (b::l) h := by_cases
  (suppose a = b, begin subst b, apply mem_cons end)
  (suppose a ≠ b,
   have count a l > 0, by rewrite [count_cons_of_ne this at h]; exact h,
   have a ∈ l,    from mem_of_count_gt_zero this,
   show a ∈ b::l, from mem_cons_of_mem _ this)

lemma count_gt_zero_of_mem : ∀ {a : A} {l : list A}, a ∈ l → count a l > 0
| a []     h := absurd h !not_mem_nil
| a (b::l) h := or.elim h
  (suppose a = b, begin subst b, rewrite count_cons_eq, apply zero_lt_succ end)
  (suppose a ∈ l, calc
   count a (b::l) ≥ count a l : count_cons_ge_count
           ...    > 0         : count_gt_zero_of_mem this)

lemma count_eq_zero_of_not_mem {a : A} {l : list A} (h : a ∉ l) : count a l = 0 :=
match count a l with
| zero     := suppose count a l = zero, this
| (succ n) := suppose count a l = succ n, absurd (mem_of_count_gt_zero (begin rewrite this, exact dec_trivial end)) h
end rfl

end count
end list

attribute list.has_decidable_eq [instance]
attribute list.decidable_mem    [instance]


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

! This file was ported from Lean 3 source module algebra.lie.free
! leanprover-community/mathlib commit 841ac1a3d9162bf51c6327812ecb6e5e71883ac4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.OfAssociative
import Mathbin.Algebra.Lie.NonUnitalNonAssocAlgebra
import Mathbin.Algebra.Lie.UniversalEnveloping
import Mathbin.Algebra.FreeNonUnitalNonAssocAlgebra

/-!
# Free Lie algebras

Given a commutative ring `R` and a type `X` we construct the free Lie algebra on `X` with
coefficients in `R` together with its universal property.

## Main definitions

  * `free_lie_algebra`
  * `free_lie_algebra.lift`
  * `free_lie_algebra.of`
  * `free_lie_algebra.universal_enveloping_equiv_free_algebra`

## Implementation details

### Quotient of free non-unital, non-associative algebra

We follow [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 1--3*](bourbaki1975) and construct
the free Lie algebra as a quotient of the free non-unital, non-associative algebra. Since we do not
currently have definitions of ideals, lattices of ideals, and quotients for
`non_unital_non_assoc_semiring`, we construct our quotient using the low-level `quot` function on
an inductively-defined relation.

### Alternative construction (needs PBW)

An alternative construction of the free Lie algebra on `X` is to start with the free unital
associative algebra on `X`, regard it as a Lie algebra via the ring commutator, and take its
smallest Lie subalgebra containing `X`. I.e.:
`lie_subalgebra.lie_span R (free_algebra R X) (set.range (free_algebra.ι R))`.

However with this definition there does not seem to be an easy proof that the required universal
property holds, and I don't know of a proof that avoids invoking the Poincaré–Birkhoff–Witt theorem.
A related MathOverflow question is [this one](https://mathoverflow.net/questions/396680/).

## Tags

lie algebra, free algebra, non-unital, non-associative, universal property, forgetful functor,
adjoint functor
-/

universe u v w

noncomputable section

variable (R : Type u) (X : Type v) [CommRing R]

-- mathport name: exprlib
/- We save characters by using Bourbaki's name `lib` (as in «libre») for
`free_non_unital_non_assoc_algebra` in this file. -/
local notation "lib" => FreeNonUnitalNonAssocAlgebra

-- mathport name: «exprlib.lift»
local notation "lib.lift" => FreeNonUnitalNonAssocAlgebra.lift

-- mathport name: «exprlib.of»
local notation "lib.of" => FreeNonUnitalNonAssocAlgebra.of

-- mathport name: «exprlib.lift_of_apply»
local notation "lib.lift_of_apply" => FreeNonUnitalNonAssocAlgebra.lift_of_apply

-- mathport name: «exprlib.lift_comp_of»
local notation "lib.lift_comp_of" => FreeNonUnitalNonAssocAlgebra.lift_comp_of

namespace FreeLieAlgebra

/-- The quotient of `lib R X` by the equivalence relation generated by this relation will give us
the free Lie algebra. -/
inductive Rel : lib R X → lib R X → Prop
  | lie_self (a : lib R X) : Rel (a * a) 0
  | leibniz_lie (a b c : lib R X) : Rel (a * (b * c)) (a * b * c + b * (a * c))
  | smul (t : R) {a b : lib R X} : Rel a b → Rel (t • a) (t • b)
  | add_right {a b : lib R X} (c : lib R X) : Rel a b → Rel (a + c) (b + c)
  | mul_left (a : lib R X) {b c : lib R X} : Rel b c → Rel (a * b) (a * c)
  | mul_right {a b : lib R X} (c : lib R X) : Rel a b → Rel (a * c) (b * c)
#align free_lie_algebra.rel FreeLieAlgebra.Rel

variable {R X}

theorem Rel.addLeft (a : lib R X) {b c : lib R X} (h : Rel R X b c) : Rel R X (a + b) (a + c) :=
  by
  rw [add_comm _ b, add_comm _ c]
  exact h.add_right _
#align free_lie_algebra.rel.add_left FreeLieAlgebra.Rel.addLeft

theorem Rel.neg {a b : lib R X} (h : Rel R X a b) : Rel R X (-a) (-b) := by
  simpa only [neg_one_smul] using h.smul (-1)
#align free_lie_algebra.rel.neg FreeLieAlgebra.Rel.neg

theorem Rel.subLeft (a : lib R X) {b c : lib R X} (h : Rel R X b c) : Rel R X (a - b) (a - c) := by
  simpa only [sub_eq_add_neg] using h.neg.add_left a
#align free_lie_algebra.rel.sub_left FreeLieAlgebra.Rel.subLeft

theorem Rel.subRight {a b : lib R X} (c : lib R X) (h : Rel R X a b) : Rel R X (a - c) (b - c) := by
  simpa only [sub_eq_add_neg] using h.add_right (-c)
#align free_lie_algebra.rel.sub_right FreeLieAlgebra.Rel.subRight

theorem Rel.smulOfTower {S : Type _} [Monoid S] [DistribMulAction S R] [IsScalarTower S R R] (t : S)
    (a b : lib R X) (h : Rel R X a b) : Rel R X (t • a) (t • b) :=
  by
  rw [← smul_one_smul R t a, ← smul_one_smul R t b]
  exact h.smul _
#align free_lie_algebra.rel.smul_of_tower FreeLieAlgebra.Rel.smulOfTower

end FreeLieAlgebra

/-- The free Lie algebra on the type `X` with coefficients in the commutative ring `R`. -/
def FreeLieAlgebra :=
  Quot (FreeLieAlgebra.Rel R X)deriving Inhabited
#align free_lie_algebra FreeLieAlgebra

namespace FreeLieAlgebra

instance {S : Type _} [Monoid S] [DistribMulAction S R] [IsScalarTower S R R] :
    SMul S (FreeLieAlgebra R X) where smul t := Quot.map ((· • ·) t) (Rel.smulOfTower t)

instance {S : Type _} [Monoid S] [DistribMulAction S R] [DistribMulAction Sᵐᵒᵖ R]
    [IsScalarTower S R R] [IsCentralScalar S R] : IsCentralScalar S (FreeLieAlgebra R X)
    where op_smul_eq_smul t := Quot.ind fun a => congr_arg (Quot.mk _) (op_smul_eq_smul t a)

instance : Zero (FreeLieAlgebra R X) where zero := Quot.mk _ 0

instance : Add (FreeLieAlgebra R X)
    where add := Quot.map₂ (· + ·) (fun _ _ _ => Rel.addLeft _) fun _ _ _ => Rel.add_right _

instance : Neg (FreeLieAlgebra R X) where neg := Quot.map Neg.neg fun _ _ => Rel.neg

instance : Sub (FreeLieAlgebra R X)
    where sub := Quot.map₂ Sub.sub (fun _ _ _ => Rel.subLeft _) fun _ _ _ => Rel.subRight _

instance : AddGroup (FreeLieAlgebra R X) :=
  Function.Surjective.addGroup (Quot.mk _) (surjective_quot_mk _) rfl (fun _ _ => rfl)
    (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ _ => rfl

instance : AddCommSemigroup (FreeLieAlgebra R X) :=
  Function.Surjective.addCommSemigroup (Quot.mk _) (surjective_quot_mk _) fun _ _ => rfl

instance : AddCommGroup (FreeLieAlgebra R X) :=
  { FreeLieAlgebra.addGroup R X, FreeLieAlgebra.addCommSemigroup R X with }

instance {S : Type _} [Semiring S] [Module S R] [IsScalarTower S R R] :
    Module S (FreeLieAlgebra R X) :=
  Function.Surjective.module S ⟨Quot.mk _, rfl, fun _ _ => rfl⟩ (surjective_quot_mk _) fun _ _ =>
    rfl

/-- Note that here we turn the `has_mul` coming from the `non_unital_non_assoc_semiring` structure
on `lib R X` into a `has_bracket` on `free_lie_algebra`. -/
instance : LieRing (FreeLieAlgebra R X)
    where
  bracket := Quot.map₂ (· * ·) (fun _ _ _ => Rel.mul_left _) fun _ _ _ => Rel.mul_right _
  add_lie := by
    rintro ⟨a⟩ ⟨b⟩ ⟨c⟩
    change Quot.mk _ _ = Quot.mk _ _
    rw [add_mul]
  lie_add := by
    rintro ⟨a⟩ ⟨b⟩ ⟨c⟩
    change Quot.mk _ _ = Quot.mk _ _
    rw [mul_add]
  lie_self := by
    rintro ⟨a⟩
    exact Quot.sound (rel.lie_self a)
  leibniz_lie := by
    rintro ⟨a⟩ ⟨b⟩ ⟨c⟩
    exact Quot.sound (rel.leibniz_lie a b c)

instance : LieAlgebra R (FreeLieAlgebra R X)
    where lie_smul := by
    rintro t ⟨a⟩ ⟨c⟩
    change Quot.mk _ (a • t • c) = Quot.mk _ (t • a • c)
    rw [← smul_comm]

variable {X}

/-- The embedding of `X` into the free Lie algebra of `X` with coefficients in the commutative ring
`R`. -/
def of : X → FreeLieAlgebra R X := fun x => Quot.mk _ (lib.of R x)
#align free_lie_algebra.of FreeLieAlgebra.of

variable {L : Type w} [LieRing L] [LieAlgebra R L]

/-- An auxiliary definition used to construct the equivalence `lift` below. -/
def liftAux (f : X → CommutatorRing L) :=
  lib.lift R f
#align free_lie_algebra.lift_aux FreeLieAlgebra.liftAux

theorem liftAux_map_smul (f : X → L) (t : R) (a : lib R X) :
    liftAux R f (t • a) = t • liftAux R f a :=
  NonUnitalAlgHom.map_smul _ t a
#align free_lie_algebra.lift_aux_map_smul FreeLieAlgebra.liftAux_map_smul

theorem liftAux_map_add (f : X → L) (a b : lib R X) :
    liftAux R f (a + b) = liftAux R f a + liftAux R f b :=
  NonUnitalAlgHom.map_add _ a b
#align free_lie_algebra.lift_aux_map_add FreeLieAlgebra.liftAux_map_add

theorem liftAux_map_mul (f : X → L) (a b : lib R X) :
    liftAux R f (a * b) = ⁅liftAux R f a, liftAux R f b⁆ :=
  NonUnitalAlgHom.map_mul _ a b
#align free_lie_algebra.lift_aux_map_mul FreeLieAlgebra.liftAux_map_mul

theorem liftAux_spec (f : X → L) (a b : lib R X) (h : FreeLieAlgebra.Rel R X a b) :
    liftAux R f a = liftAux R f b := by
  induction h
  case lie_self a' => simp only [lift_aux_map_mul, NonUnitalAlgHom.map_zero, lie_self]
  case leibniz_lie a' b' c' =>
    simp only [lift_aux_map_mul, lift_aux_map_add, sub_add_cancel, lie_lie]
  case smul t a' b' h₁ h₂ => simp only [lift_aux_map_smul, h₂]
  case add_right a' b' c' h₁ h₂ => simp only [lift_aux_map_add, h₂]
  case mul_left a' b' c' h₁ h₂ => simp only [lift_aux_map_mul, h₂]
  case mul_right a' b' c' h₁ h₂ => simp only [lift_aux_map_mul, h₂]
#align free_lie_algebra.lift_aux_spec FreeLieAlgebra.liftAux_spec

/-- The quotient map as a `non_unital_alg_hom`. -/
def mk : lib R X →ₙₐ[R] CommutatorRing (FreeLieAlgebra R X)
    where
  toFun := Quot.mk (Rel R X)
  map_smul' t a := rfl
  map_zero' := rfl
  map_add' a b := rfl
  map_mul' a b := rfl
#align free_lie_algebra.mk FreeLieAlgebra.mk

/-- The functor `X ↦ free_lie_algebra R X` from the category of types to the category of Lie
algebras over `R` is adjoint to the forgetful functor in the other direction. -/
def lift : (X → L) ≃ (FreeLieAlgebra R X →ₗ⁅R⁆ L)
    where
  toFun f :=
    { toFun := fun c => Quot.liftOn c (liftAux R f) (liftAux_spec R f)
      map_add' := by
        rintro ⟨a⟩ ⟨b⟩
        rw [← lift_aux_map_add]
        rfl
      map_smul' := by
        rintro t ⟨a⟩
        rw [← lift_aux_map_smul]
        rfl
      map_lie' := by
        rintro ⟨a⟩ ⟨b⟩
        rw [← lift_aux_map_mul]
        rfl }
  invFun F := F ∘ of R
  left_inv f := by
    ext x
    simp only [lift_aux, of, Quot.liftOn_mk, LieHom.coe_mk, Function.comp_apply, lib.lift_of_apply]
  right_inv F := by
    ext ⟨a⟩
    let F' := F.to_non_unital_alg_hom.comp (mk R)
    exact NonUnitalAlgHom.congr_fun (lib.lift_comp_of R F') a
#align free_lie_algebra.lift FreeLieAlgebra.lift

@[simp]
theorem lift_symm_apply (F : FreeLieAlgebra R X →ₗ⁅R⁆ L) : (lift R).symm F = F ∘ of R :=
  rfl
#align free_lie_algebra.lift_symm_apply FreeLieAlgebra.lift_symm_apply

variable {R}

@[simp]
theorem of_comp_lift (f : X → L) : lift R f ∘ of R = f :=
  (lift R).left_inv f
#align free_lie_algebra.of_comp_lift FreeLieAlgebra.of_comp_lift

@[simp]
theorem lift_unique (f : X → L) (g : FreeLieAlgebra R X →ₗ⁅R⁆ L) : g ∘ of R = f ↔ g = lift R f :=
  (lift R).symm_apply_eq
#align free_lie_algebra.lift_unique FreeLieAlgebra.lift_unique

@[simp]
theorem lift_of_apply (f : X → L) (x) : lift R f (of R x) = f x := by
  rw [← Function.comp_apply (lift R f) (of R) x, of_comp_lift]
#align free_lie_algebra.lift_of_apply FreeLieAlgebra.lift_of_apply

@[simp]
theorem lift_comp_of (F : FreeLieAlgebra R X →ₗ⁅R⁆ L) : lift R (F ∘ of R) = F :=
  by
  rw [← lift_symm_apply]
  exact (lift R).apply_symm_apply F
#align free_lie_algebra.lift_comp_of FreeLieAlgebra.lift_comp_of

@[ext]
theorem hom_ext {F₁ F₂ : FreeLieAlgebra R X →ₗ⁅R⁆ L} (h : ∀ x, F₁ (of R x) = F₂ (of R x)) :
    F₁ = F₂ :=
  have h' : (lift R).symm F₁ = (lift R).symm F₂ := by ext; simp [h]
  (lift R).symm.Injective h'
#align free_lie_algebra.hom_ext FreeLieAlgebra.hom_ext

variable (R X)

/-- The universal enveloping algebra of the free Lie algebra is just the free unital associative
algebra. -/
@[simps]
def universalEnvelopingEquivFreeAlgebra :
    UniversalEnvelopingAlgebra R (FreeLieAlgebra R X) ≃ₐ[R] FreeAlgebra R X :=
  AlgEquiv.ofAlgHom (UniversalEnvelopingAlgebra.lift R <| FreeLieAlgebra.lift R <| FreeAlgebra.ι R)
    (FreeAlgebra.lift R <| UniversalEnvelopingAlgebra.ι R ∘ FreeLieAlgebra.of R)
    (by
      ext
      simp)
    (by
      ext
      simp)
#align free_lie_algebra.universal_enveloping_equiv_free_algebra FreeLieAlgebra.universalEnvelopingEquivFreeAlgebra

end FreeLieAlgebra


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

open_locale nat rat real big_operators topological_space

theorem amc12b_2002_p2
  (x : ℤ)
  (h₀ : x = 4) :
  (3 * x - 2) * (4 * x + 1) - (3 * x - 2) * (4 * x) + 1 = 11 :=
begin
  rw h₀,
  linarith,
end


variable p : Prop

example : ¬(p ↔ ¬p) :=
  assume h,
  suffices hnp : ¬p, from hnp (h.mpr hnp),
  assume hp,
  h.mp hp hp


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import algebra.lie.of_associative
import ring_theory.algebra_tower

/-!
# Derivations

This file defines derivation. A derivation `D` from the `R`-algebra `A` to the `A`-module `M` is an
`R`-linear map that satisfy the Leibniz rule `D (a * b) = a * D b + D a * b`.

## Notation

The notation `⁅D1, D2⁆` is used for the commutator of two derivations.

TODO: this file is just a stub to go on with some PRs in the geometry section. It only
implements the definition of derivations in commutative algebra. This will soon change: as soon
as bimodules will be there in mathlib I will change this file to take into account the
non-commutative case. Any development on the theory of derivations is discouraged until the
definitive definition of derivation will be implemented.
-/

open algebra ring_hom

/-- `D : derivation R A M` is an `R`-linear map from `A` to `M` that satisfies the `leibniz`
equality.
TODO: update this when bimodules are defined. -/
@[protect_proj]
structure derivation (R : Type*) (A : Type*) [comm_semiring R] [comm_semiring A]
  [algebra R A] (M : Type*) [add_cancel_comm_monoid M] [module A M] [module R M]
  [is_scalar_tower R A M]
  extends A →ₗ[R] M :=
(leibniz' (a b : A) : to_fun (a * b) = a • to_fun b + b • to_fun a)

namespace derivation

section

variables {R : Type*} [comm_semiring R]
variables {A : Type*} [comm_semiring A] [algebra R A]
variables {M : Type*} [add_cancel_comm_monoid M] [module A M] [module R M]
variables [is_scalar_tower R A M]
variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)

instance : has_coe_to_fun (derivation R A M) := ⟨_, λ D, D.to_linear_map.to_fun⟩

instance has_coe_to_linear_map : has_coe (derivation R A M) (A →ₗ[R] M) :=
⟨λ D, D.to_linear_map⟩

@[simp] lemma to_fun_eq_coe : D.to_fun = ⇑D := rfl

@[simp, norm_cast]
lemma coe_fn_coe (f : derivation R A M) :
  ⇑(f : A →ₗ[R] M) = f := rfl

lemma coe_injective (H : ⇑D1 = D2) : D1 = D2 :=
by { cases D1, cases D2, congr', exact linear_map.coe_injective H }

@[ext] theorem ext (H : ∀ a, D1 a = D2 a) : D1 = D2 :=
coe_injective $ funext H

@[simp] lemma map_add : D (a + b) = D a + D b := is_add_hom.map_add D a b
@[simp] lemma map_zero : D 0 = 0 := is_add_monoid_hom.map_zero D
@[simp] lemma map_smul : D (r • a) = r • D a := linear_map.map_smul D r a
@[simp] lemma leibniz : D (a * b) = a • D b + b • D a := D.leibniz' _ _

@[simp] lemma map_one_eq_zero : D 1 = 0 :=
begin
  have h : D 1 = D (1 * 1) := by rw mul_one,
  rwa [leibniz D 1 1, one_smul, self_eq_add_right] at h
end

@[simp] lemma map_algebra_map : D (algebra_map R A r) = 0 :=
by rw [←mul_one r, ring_hom.map_mul, map_one, ←smul_def, map_smul, map_one_eq_zero, smul_zero]

instance : has_zero (derivation R A M) :=
⟨⟨(0 : A →ₗ[R] M), λ a b, by simp only [add_zero, linear_map.zero_apply,
                                        linear_map.to_fun_eq_coe, smul_zero]⟩⟩

instance : inhabited (derivation R A M) := ⟨0⟩

instance : add_comm_monoid (derivation R A M) :=
{ add := λ D1 D2, ⟨D1 + D2, λ a b, by { simp only [leibniz, linear_map.add_apply,
    linear_map.to_fun_eq_coe, coe_fn_coe, smul_add], cc }⟩,
  add_assoc := λ D E F, ext $ λ a, add_assoc _ _ _,
  zero_add := λ D, ext $ λ a, zero_add _,
  add_zero := λ D, ext $ λ a, add_zero _,
  add_comm := λ D E, ext $ λ a, add_comm _ _,
  ..derivation.has_zero }

@[simp] lemma add_apply : (D1 + D2) a = D1 a + D2 a := rfl

@[priority 100]
instance derivation.Rmodule : module R (derivation R A M) :=
{ smul := λ r D, ⟨r • D, λ a b, by simp only [linear_map.smul_apply, leibniz,
    linear_map.to_fun_eq_coe, smul_algebra_smul_comm, coe_fn_coe, smul_add, add_comm],⟩,
  mul_smul := λ a1 a2 D, ext $ λ b, mul_smul _ _ _,
  one_smul := λ D, ext $ λ b, one_smul _ _,
  smul_add := λ a D1 D2, ext $ λ b, smul_add _ _ _,
  smul_zero := λ a, ext $ λ b, smul_zero _,
  add_smul := λ a1 a2 D, ext $ λ b, add_smul _ _ _,
  zero_smul := λ D, ext $ λ b, zero_smul _ _ }

@[simp] lemma smul_to_linear_map_coe : ↑(r • D) = (r • D : A →ₗ[R] M) := rfl
@[simp] lemma Rsmul_apply : (r • D) a = r • D a := rfl

instance : module A (derivation R A M) :=
{ smul := λ a D, ⟨a • D, λ b c, by { dsimp, simp only [smul_add, leibniz, smul_comm a, add_comm] }⟩,
  mul_smul := λ a1 a2 D, ext $ λ b, mul_smul _ _ _,
  one_smul := λ D, ext $ λ b, one_smul A _,
  smul_add := λ a D1 D2, ext $ λ b, smul_add _ _ _,
  smul_zero := λ a, ext $ λ b, smul_zero _,
  add_smul := λ a1 a2 D, ext $ λ b, add_smul _ _ _,
  zero_smul := λ D, ext $ λ b, zero_smul A _ }

@[simp] lemma smul_apply : (a • D) b = a • D b := rfl

instance : is_scalar_tower R A (derivation R A M) :=
⟨λ x y z, ext (λ a, smul_assoc _ _ _)⟩

end

section

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

section

variables {M : Type*} [add_comm_group M] [module A M] [module R M] [is_scalar_tower R A M]
variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)

@[simp] lemma map_neg : D (-a) = -D a := linear_map.map_neg D a
@[simp] lemma map_sub : D (a - b) = D a - D b := linear_map.map_sub D a b

instance : add_comm_group (derivation R A M) :=
{ neg := λ D, ⟨-D, λ a b, by simp only [linear_map.neg_apply, smul_neg, neg_add_rev, leibniz,
    linear_map.to_fun_eq_coe, coe_fn_coe, add_comm]⟩,
  sub := λ D1 D2, ⟨D1 - D2, λ a b, by { simp only [linear_map.to_fun_eq_coe, linear_map.sub_apply,
    leibniz, coe_fn_coe, smul_sub], abel }⟩,
  sub_eq_add_neg := λ D1 D2, ext (λ i, sub_eq_add_neg _ _),
  add_left_neg := λ D, ext $ λ a, add_left_neg _,
  ..derivation.add_comm_monoid }

@[simp] lemma sub_apply : (D1 - D2) a = D1 a - D2 a := rfl

end

section lie_structures

/-! # Lie structures -/

variables (D : derivation R A A) {D1 D2 : derivation R A A} (r : R) (a b : A)

/-- The commutator of derivations is again a derivation. -/
def commutator (D1 D2 : derivation R A A) : derivation R A A :=
{ leibniz' := λ a b, by
  { simp only [ring.lie_def, map_add, id.smul_eq_mul, linear_map.mul_apply, leibniz,
               linear_map.to_fun_eq_coe, coe_fn_coe, linear_map.sub_apply], ring, },
  ..⁅(D1 : module.End R A), (D2 : module.End R A)⁆, }

instance : has_bracket (derivation R A A) (derivation R A A) := ⟨derivation.commutator⟩

@[simp] lemma commutator_coe_linear_map :
  ↑⁅D1, D2⁆ = ⁅(D1 : module.End R A), (D2 : module.End R A)⁆ := rfl

lemma commutator_apply : ⁅D1, D2⁆ a = D1 (D2 a) - D2 (D1 a) := rfl

instance : lie_ring (derivation R A A) :=
{ add_lie     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
  lie_add     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
  lie_self    := λ d, by { ext a, simp only [commutator_apply, add_apply, map_add], ring_nf, },
  leibniz_lie := λ d e f,
    by { ext a, simp only [commutator_apply, add_apply, sub_apply, map_sub], ring, } }

instance : lie_algebra R (derivation R A A) :=
{ lie_smul := λ r d e, by { ext a, simp only [commutator_apply, map_smul, smul_sub, Rsmul_apply]},
  ..derivation.Rmodule }

end lie_structures

end

end derivation

section comp_der

namespace linear_map

variables {R : Type*} [comm_semiring R]
variables {A : Type*} [comm_semiring A] [algebra R A]
variables {M : Type*} [add_cancel_comm_monoid M] [module A M] [module R M]
variables {N : Type*} [add_cancel_comm_monoid N] [module A N] [module R N]
variables [is_scalar_tower R A M] [is_scalar_tower R A N]

/-- The composition of a linear map and a derivation is a derivation. -/
def comp_der (f : M →ₗ[A] N) (D : derivation R A M) : derivation R A N :=
{ to_fun := λ a, f (D a),
  map_add' := λ a1 a2, by rw [D.map_add, f.map_add],
  map_smul' := λ r a, by rw [derivation.map_smul, map_smul_of_tower],
  leibniz' := λ a b, by simp only [derivation.leibniz, linear_map.map_smul, linear_map.map_add,
                                   add_comm] }

@[simp] lemma comp_der_apply (f : M →ₗ[A] N) (D : derivation R A M) (a : A) :
  f.comp_der D a = f (D a) := rfl

end linear_map

end comp_der


/-
Copyright (c) 2021 Apurva Nakade. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Apurva Nakade
-/
import algebra.algebra.basic
import set_theory.game.birthday
import set_theory.surreal.basic
import ring_theory.localization.basic

/-!
# Dyadic numbers
Dyadic numbers are obtained by localizing ℤ away from 2. They are the initial object in the category
of rings with no 2-torsion.

## Dyadic surreal numbers
We construct dyadic surreal numbers using the canonical map from ℤ[2 ^ {-1}] to surreals.
As we currently do not have a ring structure on `surreal` we construct this map explicitly. Once we
have the ring structure, this map can be constructed directly by sending `2 ^ {-1}` to `half`.

## Embeddings
The above construction gives us an abelian group embedding of ℤ into `surreal`. The goal is to
extend this to an embedding of dyadic rationals into `surreal` and use Cauchy sequences of dyadic
rational numbers to construct an ordered field embedding of ℝ into `surreal`.
-/

universes u

local infix (name := pgame.equiv) ` ≈ ` := pgame.equiv

namespace pgame

/-- For a natural number `n`, the pre-game `pow_half (n + 1)` is recursively defined as
`{0 | pow_half n}`. These are the explicit expressions of powers of `1 / 2`. By definition, we have
`pow_half 0 = 1` and `pow_half 1 ≈ 1 / 2` and we prove later on that
`pow_half (n + 1) + pow_half (n + 1) ≈ pow_half n`. -/
def pow_half : ℕ → pgame
| 0       := 1
| (n + 1) := ⟨punit, punit, 0, λ _, pow_half n⟩

@[simp] lemma pow_half_zero : pow_half 0 = 1 := rfl

lemma pow_half_left_moves (n) : (pow_half n).left_moves = punit := by cases n; refl
lemma pow_half_zero_right_moves : (pow_half 0).right_moves = pempty := rfl
lemma pow_half_succ_right_moves (n) : (pow_half (n + 1)).right_moves = punit := rfl

@[simp] lemma pow_half_move_left (n i) : (pow_half n).move_left i = 0 :=
by cases n; cases i; refl
@[simp] lemma pow_half_succ_move_right (n i) : (pow_half (n + 1)).move_right i = pow_half n :=
rfl

instance unique_pow_half_left_moves (n) : unique (pow_half n).left_moves :=
by cases n; exact punit.unique
instance is_empty_pow_half_zero_right_moves : is_empty (pow_half 0).right_moves :=
pempty.is_empty
instance unique_pow_half_succ_right_moves (n) : unique (pow_half (n + 1)).right_moves :=
punit.unique

@[simp]

/-- For all natural numbers `n`, the pre-games `pow_half n` are numeric. -/
theorem numeric_pow_half (n) : (pow_half n).numeric :=
begin
  induction n with n hn,
  { exact numeric_one },
  { split,
    { simpa using hn.move_left_lt default },
    { exact ⟨λ _, numeric_zero, λ _, hn⟩ } }
end

theorem pow_half_succ_lt_pow_half (n : ℕ) : pow_half (n + 1) < pow_half n :=
(numeric_pow_half (n + 1)).lt_move_right default

theorem pow_half_succ_le_pow_half (n : ℕ) : pow_half (n + 1) ≤ pow_half n :=
(pow_half_succ_lt_pow_half n).le

theorem pow_half_le_one (n : ℕ) : pow_half n ≤ 1 :=
begin
  induction n with n hn,
  { exact le_rfl },
  { exact (pow_half_succ_le_pow_half n).trans hn }
end

theorem pow_half_succ_lt_one (n : ℕ) : pow_half (n + 1) < 1 :=
(pow_half_succ_lt_pow_half n).trans_le $ pow_half_le_one n

theorem pow_half_pos (n : ℕ) : 0 < pow_half n :=
by { rw [←lf_iff_lt numeric_zero (numeric_pow_half n), zero_lf_le], simp }

theorem zero_le_pow_half (n : ℕ) : 0 ≤ pow_half n :=
(pow_half_pos n).le

theorem add_pow_half_succ_self_eq_pow_half (n) : pow_half (n + 1) + pow_half (n + 1) ≈ pow_half n :=
begin
  induction n using nat.strong_induction_on with n hn,
  { split; rw le_iff_forall_lf; split,
    { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩); apply lf_of_lt,
      { calc 0 + pow_half n.succ ≈ pow_half n.succ : zero_add_equiv _
                             ... < pow_half n      : pow_half_succ_lt_pow_half n },
      { calc pow_half n.succ + 0 ≈ pow_half n.succ : add_zero_equiv _
                             ... < pow_half n      : pow_half_succ_lt_pow_half n } },
    { cases n, { rintro ⟨ ⟩ },
      rintro ⟨ ⟩,
      apply lf_of_move_right_le,
      swap, exact sum.inl default,
      calc  pow_half n.succ + pow_half (n.succ + 1)
          ≤ pow_half n.succ + pow_half n.succ : add_le_add_left (pow_half_succ_le_pow_half _) _
      ... ≈ pow_half n                        : hn _ (nat.lt_succ_self n) },
    { simp only [pow_half_move_left, forall_const],
      apply lf_of_lt,
      calc 0 ≈ 0 + 0                            : (add_zero_equiv 0).symm
        ... ≤ pow_half n.succ + 0               : add_le_add_right (zero_le_pow_half _) _
        ... < pow_half n.succ + pow_half n.succ : add_lt_add_left (pow_half_pos _) _ },
    { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩); apply lf_of_lt,
      { calc pow_half n
            ≈ pow_half n + 0               : (add_zero_equiv _).symm
        ... < pow_half n + pow_half n.succ : add_lt_add_left (pow_half_pos _) _ },
      { calc pow_half n
            ≈ 0 + pow_half n               : (zero_add_equiv _).symm
        ... < pow_half n.succ + pow_half n : add_lt_add_right (pow_half_pos _) _  } } }
end

theorem half_add_half_equiv_one : pow_half 1 + pow_half 1 ≈ 1 :=
add_pow_half_succ_self_eq_pow_half 0

end pgame

namespace surreal
open pgame

/-- Powers of the surreal number `half`. -/
def pow_half (n : ℕ) : surreal := ⟦⟨pgame.pow_half n, pgame.numeric_pow_half n⟩⟧

@[simp] lemma pow_half_zero : pow_half 0 = 1 := rfl

@[simp] lemma double_pow_half_succ_eq_pow_half (n : ℕ) : 2 • pow_half n.succ = pow_half n :=
by { rw two_nsmul, exact quotient.sound (pgame.add_pow_half_succ_self_eq_pow_half n) }

@[simp] lemma nsmul_pow_two_pow_half (n : ℕ) : 2 ^ n • pow_half n = 1 :=
begin
  induction n with n hn,
  { simp only [nsmul_one, pow_half_zero, nat.cast_one, pow_zero] },
  { rw [← hn, ← double_pow_half_succ_eq_pow_half n, smul_smul (2^n) 2 (pow_half n.succ),
        mul_comm, pow_succ] }
end

@[simp] lemma nsmul_pow_two_pow_half' (n k : ℕ) : 2 ^ n • pow_half (n + k) = pow_half k :=
begin
  induction k with k hk,
  { simp only [add_zero, surreal.nsmul_pow_two_pow_half, nat.nat_zero_eq_zero, eq_self_iff_true,
               surreal.pow_half_zero] },
  { rw [← double_pow_half_succ_eq_pow_half (n + k), ← double_pow_half_succ_eq_pow_half k,
        smul_algebra_smul_comm] at hk,
    rwa ← zsmul_eq_zsmul_iff' two_ne_zero }
end

lemma zsmul_pow_two_pow_half (m : ℤ) (n k : ℕ) :
  (m * 2 ^ n) • pow_half (n + k) = m • pow_half k :=
begin
  rw mul_zsmul,
  congr,
  norm_cast,
  exact nsmul_pow_two_pow_half' n k
end

lemma dyadic_aux {m₁ m₂ : ℤ} {y₁ y₂ : ℕ} (h₂ : m₁ * (2 ^ y₁) = m₂ * (2 ^ y₂)) :
  m₁ • pow_half y₂ = m₂ • pow_half y₁ :=
begin
  revert m₁ m₂,
  wlog h : y₁ ≤ y₂,
  { intros m₁ m₂ aux, exact (this (le_of_not_le h) aux.symm).symm },
  intros m₁ m₂ h₂,
  obtain ⟨c, rfl⟩ := le_iff_exists_add.mp h,
  rw [add_comm, pow_add, ← mul_assoc, mul_eq_mul_right_iff] at h₂,
  cases h₂,
  { rw [h₂, add_comm, zsmul_pow_two_pow_half m₂ c y₁] },
  { have := nat.one_le_pow y₁ 2 nat.succ_pos',
    norm_cast at h₂, linarith },
end

/-- The additive monoid morphism `dyadic_map` sends ⟦⟨m, 2^n⟩⟧ to m • half ^ n. -/
def dyadic_map : localization.away (2 : ℤ) →+ surreal :=
{ to_fun :=
  λ x, localization.lift_on x (λ x y, x • pow_half (submonoid.log y)) $
  begin
    intros m₁ m₂ n₁ n₂ h₁,
    obtain ⟨⟨n₃, y₃, hn₃⟩, h₂⟩ := localization.r_iff_exists.mp h₁,
    simp only [subtype.coe_mk, mul_eq_mul_left_iff] at h₂,
    cases h₂,
    { simp only,
      obtain ⟨a₁, ha₁⟩ := n₁.prop,
      obtain ⟨a₂, ha₂⟩ := n₂.prop,
      have hn₁ : n₁ = submonoid.pow 2 a₁ := subtype.ext ha₁.symm,
      have hn₂ : n₂ = submonoid.pow 2 a₂ := subtype.ext ha₂.symm,
      have h₂ : 1 < (2 : ℤ).nat_abs, from one_lt_two,
      rw [hn₁, hn₂, submonoid.log_pow_int_eq_self h₂, submonoid.log_pow_int_eq_self h₂],
      apply dyadic_aux,
      rwa [ha₁, ha₂, mul_comm, mul_comm m₂] },
    { have : (1 : ℤ) ≤ 2 ^ y₃ := by exact_mod_cast nat.one_le_pow y₃ 2 nat.succ_pos',
      linarith }
    end,
  map_zero' := localization.lift_on_zero _ _,
  map_add' := λ x y, localization.induction_on₂ x y $
  begin
    rintro ⟨a, ⟨b, ⟨b', rfl⟩⟩⟩ ⟨c, ⟨d, ⟨d', rfl⟩⟩⟩,
    have h₂ : 1 < (2 : ℤ).nat_abs, from one_lt_two,
    have hpow₂ := submonoid.log_pow_int_eq_self h₂,
    simp_rw submonoid.pow_apply at hpow₂,
    simp_rw [localization.add_mk, localization.lift_on_mk, subtype.coe_mk,
      submonoid.log_mul (int.pow_right_injective h₂), hpow₂],
    calc (2 ^ b' * c + 2 ^ d' * a) • pow_half (b' + d')
        = (c * 2 ^ b') • pow_half (b' + d') + (a * 2 ^ d') • pow_half (d' + b')
        : by simp only [add_smul, mul_comm,add_comm]
    ... = c • pow_half d' + a • pow_half b' : by simp only [zsmul_pow_two_pow_half]
    ... = a • pow_half b' + c • pow_half d' : add_comm _ _,
  end }

@[simp] lemma dyadic_map_apply (m : ℤ) (p : submonoid.powers (2 : ℤ)) :
  dyadic_map (is_localization.mk' (localization (submonoid.powers 2)) m p) =
  m • pow_half (submonoid.log p) :=
by { rw ← localization.mk_eq_mk', refl }

@[simp] lemma dyadic_map_apply_pow (m : ℤ) (n : ℕ) :
  dyadic_map (is_localization.mk' (localization (submonoid.powers 2)) m (submonoid.pow 2 n)) =
  m • pow_half n :=
by rw [dyadic_map_apply, @submonoid.log_pow_int_eq_self 2 one_lt_two]

/-- We define dyadic surreals as the range of the map `dyadic_map`. -/
def dyadic : set surreal := set.range dyadic_map

-- We conclude with some ideas for further work on surreals; these would make fun projects.

-- TODO show that the map from dyadic rationals to surreals is injective

-- TODO map the reals into the surreals, using dyadic Dedekind cuts
-- TODO show this is a group homomorphism, and injective

-- TODO show the maps from the dyadic rationals and from the reals
-- into the surreals are multiplicative

end surreal


import h0
import group_theory.quotient_group

theorem function.lift_aux {X : Type*} {Y : Type*} {Z : Type*} (f : X → Y)
(i : Z → Y) (h2 : set.range f ⊆ set.range i) (x : X) : ∃ z : Z, i z = f x :=
begin
show f x ∈ set.range i,
apply h2,
use x,
end

noncomputable def function.lift {X : Type*} {Y : Type*} {Z : Type*} (f : X → Y)
(i : Z → Y) (h2 : set.range f ⊆ set.range i) :
(X → Z) :=
λ x, classical.some $ function.lift_aux f i h2 x

theorem function.lift_eq {X : Type*} {Y : Type*} {Z : Type*} (f : X → Y)
(i : Z → Y) (h2 : set.range f ⊆ set.range i) (x : X) :
 i (function.lift f i h2 x) = f x := classical.some_spec $ function.lift_aux f i h2 x

variables (G : Type*) [group G] (M : Type*) [add_comm_group M]
[G_module G M]

-- definition of cocycle as a subtype
def cocycle (G : Type*) [group G] (M : Type*) [add_comm_group M] [G_module G M] :=
{f : G → M // ∀ g h : G, f (g * h) = f g + g • (f h)}

variable {G} -- I want G to be implicit in this definition

-- so a cocycle is a pair: the function f, and the proof that it satisfies the cocycle identity.

-- This line lets us think about a cocycle as the function.
instance : has_coe_to_fun (cocycle G M) :=
{ F := λ _, G → M,
  coe := λ f, f.1}

theorem cocycle.eq (e f : cocycle G M) : (e : G → M) = f → e = f := subtype.eq

@[simp] def cocycle.condition (f : cocycle G M) : ∀ (g h : G), f (g * h) = f g + g • (f h) :=
  f.property

namespace cocycle

variable {M}
def mk (m : M) : (cocycle G M) := ⟨λ g, g • m - m,
begin
intros g h,
rw ←G_module.mul,
rw G_module.map_sub,
simp,
end ⟩
variable (M)

/-- The zero cocycle -/
def zero : cocycle G M := ⟨λ g, 0, begin
 intro g,
 intro h,
 symmetry,
 calc
 0 + g • (0 : M)  = g • 0 : zero_add _
 ...               = 0 : g_zero g
 end⟩

-- notation
instance : has_zero (cocycle G M) := ⟨zero M⟩

/-- addition of cocycles -/
def add (e f : cocycle G M) : cocycle G M :=
⟨λ g, e g + f g, begin
intro g,
intro h,
rw cocycle.condition M e,
rw cocycle.condition M f,
rw G_module.linear g (e h) (f h),
simp,

/-
calc
e (g * h) + f (g * h) = e g + g • (e h) + f (g * h) : rw e.condition g h
...                   = e g + g • (e h) + (f g + g • (f h)) : rw f.condition g h
...                   = e g + g • (e h) + g • (f h) + f g : by simp?
...                   = e g + g • (e h + f h) + f g : by rw G_module.linear g (e h) (f h)
...                   = e g + f g +  g • (e h + f h) : by add_comm

-/

end⟩

-- notation
instance : has_add (cocycle G M) := ⟨add M⟩

@[simp] lemma cocycle.cast_add (a b : cocycle G M) (x : G) : ((a+b) x = a x + b x) :=
begin
refl,
end

/-- negation of a cocycle -/
def neg (f : cocycle G M) : cocycle G M :=
⟨λ g, -(f g), begin
intro g,
intro h,
rw cocycle.condition M f,
rw neg_add,
rw g_neg g (f h),
/-
calc
- f (g * h) = - (f g + g • (f h)) : rw f.condition g h
...         = - f g - g • (f h) :
...         = - f g + g (- f h)  : by rw g_neg g (f h)
-/

end⟩

-- notation
instance : has_neg (cocycle G M) := ⟨neg M⟩

-- proof that cocycles form a group
instance : add_comm_group (cocycle G M) :=
{ add := (+),
  add_assoc := begin
  intros a b c,
  apply cocycle.eq,
  ext x,
  simp,
  end,
  zero := 0,
  zero_add := begin
  intro a,
  apply cocycle.eq,
  ext x,
  simp,
  change a x + 0 = a x,
  rw add_zero,
  end,
  add_zero := begin
  intro a,
  apply cocycle.eq,
  ext x,
  change a x + 0 = a x,
  rw add_zero,
  end,
  neg := has_neg.neg,
  add_left_neg := begin
  intro a,
  show -a + a = 0,
  apply cocycle.eq,
  ext x,
  change - a x + a x = 0,
  simp,
  end,
  add_comm := begin
  intros a b,
  apply cocycle.eq,
  ext x,
  change a x + b x = b x + a x,
  rw add_comm,
  end }

  def map (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] :
  cocycle G A → cocycle G B :=
λ c, ⟨λ g, f (c g), begin
intros g h,
rw cocycle.condition A c,
rw G_module_hom.add G f (c g) (g • (c h)),
rw G_module_hom.G_hom f g,
end⟩

noncomputable def lift (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] (hf : function.injective f)
  (x : cocycle G B) (h : set.range x ⊆ set.range f) : (cocycle G A) :=
  ⟨function.lift x f h, begin
  intros g1 g2,
  apply hf,
  rw function.lift_eq x f,
  rw is_add_group_hom.map_add f,
  rw function.lift_eq x f,
  rw G_module_hom.G_hom f,
  rw function.lift_eq x f,
  exact x.property g1 g2,
  apply_instance,
  end⟩

theorem lift_eq (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] (hf : function.injective f)
  (x : cocycle G B) (h : set.range x ⊆ set.range f) :
  (map G f (lift G f hf x h)) = x :=
  begin
  apply cocycle.eq,
  ext g,
  show f (function.lift (x) f h g) = x g,
  rw function.lift_eq x f,
  end

end cocycle

def coboundary (G : Type*) [group G] (M : Type*) [add_comm_group M] [G_module G M] :=
  {f : cocycle G M | ∃ m : M, ∀ g : G, f g = g • m - m}

instance : is_add_subgroup (coboundary G M) :=
{ zero_mem := begin
  use 0,
  intro g,
  rw g_zero g,
  simp,
  refl,
  end,
  add_mem := begin
  intros a b,
  intros ha hb,
  cases ha with m hm,
  cases hb with n hn,
  use m+n,
  simp [hm, hn],
  end,
  neg_mem := begin
  intro a,
  intro ha,
  cases ha with m hm,
  use -m,
  intro g,
  show - a g = _,
  simp [hm],
  rw g_neg g,
  end }

def H1 (G : Type*) [group G] (M : Type*) [add_comm_group M] [G_module G M] :=
  quotient_add_group.quotient (coboundary G M)

instance (G : Type*) [group G] (M : Type*) [add_comm_group M] [G_module G M]
  : add_comm_group (H1 G M)
  := quotient_add_group.add_comm_group (coboundary G M)

lemma coboundary.map (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] (c : cocycle G A) :
  c ∈ coboundary G A → cocycle.map G f c ∈ coboundary G B :=
  begin
  intro hc,
  cases hc with m hm,
  use f m,
  change ∀ (g : G), f (c g) = g • f m - f m,
  intro g,
  rw hm,
  simp,
  rw [G_module_hom.add G f (-m) (g • m), G_module_hom.G_hom f g, is_add_group_hom.map_neg f m],
  end

  /-
  bad lean:

  unfold coe_fn has_coe_to_fun.coe,
  unfold cocycle.map,
  dsimp,
  unfold coe_fn has_coe_to_fun.coe,
  dsimp,
  I also used set_option pp.notation false (temporarily) because
  I couldn't remember what the actual function name was for the notation ⇑.
  in the main Lean window, if you type #print notation ⇑ it tells you the name
  of the function, and if you hover over the ⇑ it tells you the keyboard shortcut.
  -/

instance (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] :
  is_add_group_hom (cocycle.map G f) :=
{ map_add := begin
  intros a b,
  show cocycle.map G f (a + b) = (cocycle.map G f a) + (cocycle.map G f b),
  cases a with a ha,
  cases b with b hb,
  apply cocycle.eq,
  ext g,
  show f (a g + b g)  = f (a g) + f (b g),
  rw G_module_hom.add G f (a g) (b g),
  end }

--variables
--  {A : Type*} [add_comm_group A] [G_module G A]
--  {B : Type*} [add_comm_group B] [G_module G B]

instance : normal_add_subgroup (coboundary G M) := normal_add_subgroup_of_add_comm_group (coboundary G M)

def H1_f (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] :
  H1 G A → H1 G B := quotient_add_group.map (coboundary G A) (coboundary G B)
    (cocycle.map G f) (coboundary.map G f)

lemma cocycle.map_mk (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] (ca : cocycle G A) :
  H1_f G f (quotient_add_group.mk ca) = quotient_add_group.mk (cocycle.map G f ca) := rfl

instance (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  (f : A → B) [G_module_hom G f] :
  is_add_group_hom (H1_f G f) := quotient_add_group.map_is_add_group_hom
  (coboundary G A) (coboundary G B) (cocycle.map G f) (coboundary.map G f)

open set function is_add_group_hom

/- First attempt of delta

noncomputable def delta (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  (f : A → B) [G_module_hom G f]
  (g : B → C) [G_module_hom G g]
  (hfg : short_exact f g) : H0 G C → H1 G A :=
λ c, begin
  rcases hfg with ⟨hf, hg, hfg⟩,
  choose b hb using (hg c.val),
  apply quotient.mk,
  let h : G → A,
  { intro γ,
    let b' := γ • b - b,
    have hb' : b' ∈ ker g,
    { rw mem_ker,
      rw is_add_group_hom.map_sub g,
      rw sub_eq_zero,
      rw G_module_hom.G_hom g,
      rw hb,
      exact c.property γ,
      apply_instance,
    },
    change set.range f = ker g at hfg,
    rw ←hfg at hb',
    choose a ha using hb',
    exact a
  },
  use h,
  sorry -- TODO (KMB will try this)
end
-/

noncomputable def delta_b (G : Type*) [group G]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {g : B → C} [G_module_hom G g]
  (hg : surjective g) : H0 G C → B :=
λ c, classical.some (hg c.val)

lemma delta_im_b (G : Type*) [group G]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {g : B → C} [G_module_hom G g]
  (hg : surjective g) (c : H0 G C) :
  g (delta_b G hg c) = c.val := classical.some_spec (hg c.val)

/- c1,c2 : H0 G C then delta_b(c1) + delta_b(c2) - delta_b(c1+c2) is in ker g-/
lemma delta_mem_ker (G : Type*) [group G]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {g : B → C} [G_module_hom G g]
  (hg : surjective g) (c1 c2 : H0 G C) :
  delta_b G hg c1 + delta_b G hg c2 - delta_b G hg (c1+c2) ∈ ker g :=
begin
rw mem_ker,
rw is_add_group_hom.map_sub g,
rw is_add_group_hom.map_add g,
rw delta_im_b G hg,
rw delta_im_b G hg,
rw delta_im_b G hg,
cases c1 with c1 h1,
cases c2 with c2 h2,
show c1 + c2 - (c1 + c2) = 0,
simp,
end

lemma delta_gb_sub_b_mem_ker (G : Type*) [group G]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {g : B → C} [G_module_hom G g]
  (hg : surjective g) (c : H0 G C) (γ : G) :
  γ • (delta_b G hg c) - (delta_b G hg c) ∈ ker g :=
by rw [mem_ker, is_add_group_hom.map_sub g, sub_eq_zero,
  G_module_hom.G_hom g γ, delta_im_b G hg c, c.property γ]

def delta_cocycle_ex_a (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hg : surjective g) (hfg : range f = ker g)
  (c : H0 G C) (γ : G) :
  ∃ a : A, f a = γ • (delta_b G hg c) - (delta_b G hg c) :=
begin
  show γ • (delta_b G hg c) - (delta_b G hg c) ∈ range f,
  rw hfg,
  exact delta_gb_sub_b_mem_ker G hg c γ
end

noncomputable def delta_cocycle_aux (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hg : surjective g) (hfg : range f = ker g)
  (c : H0 G C) : G → A :=
  λ γ, classical.some (delta_cocycle_ex_a G hg hfg c γ)

lemma delta_cocycle_aux_a (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hg : surjective g) (hfg : range f = ker g)
  (c : H0 G C) (γ : G) : f (delta_cocycle_aux G hg hfg c γ) =
    γ • (delta_b G hg c) - (delta_b G hg c) :=
classical.some_spec (delta_cocycle_ex_a G hg hfg c γ)

noncomputable def delta_cocycle (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hf : injective f)
  (hg : surjective g) (hfg : range f = ker g)
  (c : H0 G C) : cocycle G A :=
⟨delta_cocycle_aux G hg hfg c,
begin
  intros γ1 γ2,
  apply hf,
  rw delta_cocycle_aux_a G hg hfg,
  rw is_add_group_hom.map_add f,
  rw delta_cocycle_aux_a G hg hfg,
  rw G_module_hom.G_hom f γ1,
  rw delta_cocycle_aux_a G hg hfg,
  rw ←G_module.mul,
  rw G_module.map_sub,
  simp,
end⟩

noncomputable def delta  (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hf : injective f)
  (hg : surjective g) (hfg : range f = ker g)
  (c : H0 G C) : H1 G A :=
  quotient_add_group.mk (delta_cocycle G hf hg hfg c)

instance
  (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hf : injective f)
  (hg : surjective g) (hfg : range f = ker g)
: is_add_group_hom (delta G hf hg hfg) :=
{ map_add :=
begin
intros a b,
show delta G hf hg hfg (a + b) = (delta G hf hg hfg a) + (delta G hf hg hfg b),
unfold delta,
let Q := (quotient_add_group.mk : cocycle G A → H1 G A),
rw ←is_add_group_hom.map_add Q,
have eq' : ∀ x y : cocycle G A, Q x = Q y ↔ -x + y ∈ coboundary G A := λ x y, quotient_add_group.eq,
show Q (delta_cocycle G hf hg hfg (a+b)) = _,
rw eq',
have h := delta_mem_ker G hg a b,
rw ←hfg at h,
cases h with a' ha',
use a',
intro g,
apply hf,
rw is_add_group_hom.map_sub f,
rw G_module_hom.G_hom f g,
rw ha',
cases a with a ha,
cases b with b hb,
show f
      (-delta_cocycle_aux G hg hfg ⟨a + b, _⟩ g +
          (delta_cocycle_aux G hg hfg ⟨a, ha⟩ g
           + delta_cocycle_aux G hg hfg ⟨b, hb⟩
         g)) =  _,
rw is_add_group_hom.map_add f,
rw is_add_group_hom.map_add f,
rw is_add_group_hom.map_neg f,
rw delta_cocycle_aux_a G hg hfg,
rw delta_cocycle_aux_a G hg hfg,
rw delta_cocycle_aux_a G hg hfg,
simp,
rw g_neg,
refl,
end }

  /- H0(G,B) -> H0(G,C) -> H1(G,A) -/
lemma h0b_hoc_h1a_exact (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hf : injective f)
  (hg : surjective g) (hfg : range f = ker g)
  : is_exact (H0_f G g) (delta G hf hg hfg) :=
begin
  apply subset.antisymm,
  { intros fc h,
    rw mem_ker,
    cases h with b hb,
    cases fc with c fc,
    cases b with b propb,
    injection hb,
    change g b = c at h_1,
    unfold delta,
    suffices : delta_cocycle G hf hg hfg ⟨c, fc⟩ ∈ ker (quotient_add_group.mk),
      rw mem_ker at this,
      exact this,
      swap, apply_instance,
      swap, apply_instance,
    rw quotient_add_group.ker_mk,
    let b' : B := delta_b G hg ⟨c, fc⟩,
    have hb' : b' - b ∈ range f,
      have hb'' : b' - b ∈ ker g,
        rw mem_ker,
        rw is_add_group_hom.map_sub g,
        rw delta_im_b G hg ⟨c, fc⟩,
        simp,
      rw h_1,
      simp,
      rw hfg,
      exact hb'',
      cases hb' with a ha,
      unfold delta_cocycle,
      use a,
      intro γ,
      apply hf,
      rw is_add_group_hom.map_sub f,
      rw G_module_hom.G_hom f,
      swap, apply_instance,
      swap, apply_instance,
      show f (delta_cocycle_aux G hg hfg ⟨c, fc⟩ γ) = _,
      rw delta_cocycle_aux_a G hg hfg ⟨c, fc⟩ γ,
      rw ha,
      rw G_module.map_sub,
      change γ • b' - b' = γ • b' - γ • b - (b' - b),
      rw propb,
      simp,
  },
  { intros x h,
    cases x with c fc,
    rw mem_ker at h,
    unfold delta at h,
    replace h := (mem_ker quotient_add_group.mk).2 h,
    rw quotient_add_group.ker_mk (coboundary G A) at h,
    cases h with a ha,
    let b' : B := delta_b G hg ⟨c, fc⟩,
    let b : B := f a,
    use b'-b,
    intro γ,
    have h1 := ha γ,
    have h2 := congr_arg f h1,
    change f (delta_cocycle_aux G hg hfg ⟨c, fc⟩ γ) = _ at h2,
    rw delta_cocycle_aux_a G hg hfg ⟨c, fc⟩ γ at h2,
    change γ • b' - b' = _ at h2,
    rw is_add_group_hom.map_sub f at h2,
    rw G_module_hom.G_hom f at h2,
    change γ • b' - b' = γ • b - b at h2,
    rw ←sub_eq_zero at h2,
    rw G_module.map_sub,
    rw ←sub_eq_zero,
    swap,
    apply_instance,
    swap,
    apply subtype.eq,
    unfold H0_f,
    show g (b' - b) = c,
    rw is_add_group_hom.map_sub g,
    show g (delta_b G hg ⟨c, fc⟩) - g b = _,
    rw delta_im_b G hg ⟨c, fc⟩,
    have hb' : b ∈ range f,
      use a,
    have hb : b ∈ ker g,
      rw ←hfg,
    exact hb',
    rw mem_ker at hb,
    show c - g b = c,
    rw hb,
    simp,
    rw ←sub_add,
    rw ←sub_add at h2,
    rw add_comm (γ • b' - γ • b - b') b,
    rw add_comm (γ • b' - b' - γ • b) b at h2,
    rw ←sub_add_eq_sub_sub_swap (γ • b') b' (γ • b),
    rw ←neg_neg (γ • b),
    change b + (γ • b' - (b' - (-(γ • b)))) = 0,
    rw ←sub_add,
    exact h2,
  },
end

  /- H0(G,C) -> H1(G,A) -> H1(G,B) -/
lemma h0c_h1a_h1b_exact (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hf : injective f)
  (hg : surjective g) (hfg : range f = ker g)
  : is_exact (delta G hf hg hfg) (H1_f G f) :=
begin
  apply subset.antisymm,
  { intros fa h,
    rw mem_ker,
    cases h with c hc,
    rw ←hc,
    unfold delta,
    rw cocycle.map_mk G f (delta_cocycle G hf hg hfg c),
    suffices : (cocycle.map G f (delta_cocycle G hf hg hfg c)) ∈ ker (quotient_add_group.mk),
      rw mem_ker at this,
      exact this,
      swap, apply_instance,
      swap, apply_instance,
    rw quotient_add_group.ker_mk,
    use (delta_b G hg c),
    intro γ,
    change f (delta_cocycle_aux G hg hfg c γ) = _,
    exact delta_cocycle_aux_a G hg hfg c γ,
  },
  { intros x h,
    rw mem_ker at h,
    induction x,
    swap,
    refl,
    unfold H1_f at h,
    change quotient_add_group.mk (cocycle.map G f x) = 0 at h,
    rw ←mem_ker quotient_add_group.mk at h,
    swap,
    apply_instance,
    swap,
    apply_instance,
    rw quotient_add_group.ker_mk at h,
    cases h with b hb,
    change ∀ (g : G), f (x g) = g • b - b at hb,
    let c : C := g b,
    use c,
    intro γ,
    rw ←sub_eq_zero,
    rw ←G_module_hom.G_hom g,
    rw ←is_add_group_hom.map_sub g,
    rw ←mem_ker g,
    rw ←hfg,
    rw ←hb,
    use x γ,
    apply_instance,
    change delta G hf hg hfg ⟨c, _⟩ = quotient_add_group.mk x,
    unfold delta,
    apply quotient_add_group.eq.2,
    have hc : ∀ γ : G, γ • c = c,
      intro γ,
      rw ←sub_eq_zero,
      change γ • g b - g b = 0,
      rw ←G_module_hom.G_hom g,
      rw ←is_add_group_hom.map_sub g,
      rw ←mem_ker g,
      have h1 : γ • b - b ∈ range f,
        rw ←hb,
        use x γ,
      convert h1,
      exact hfg.symm,
      apply_instance,
    let b' : B := delta_b G hg ⟨c, hc⟩,
    have hb' : b - b' ∈ range f,
      have hb'' : b - b' ∈ ker g,
        rw mem_ker,
        rw is_add_group_hom.map_sub g,
        rw delta_im_b G hg ⟨c, hc⟩,
        simp,
    rw hfg,
    exact hb'',
    cases hb' with a ha,
    use a,
    intro g',
    change - (delta_cocycle_aux G hg hfg ⟨c, hc⟩ g') + x g' = g' • a - a,
    apply hf,
    rw is_add_group_hom.map_add f,
    rw is_add_group_hom.map_neg f,
    rw is_add_group_hom.map_sub f,
    rw G_module_hom.G_hom f,
    rw delta_cocycle_aux_a G hg hfg ⟨c, hc⟩ g',
    rw hb,
    rw ha,
    change - (g' • b' - b') + (g' • b - b) = _,
    rw G_module.map_sub,
    simp,
    apply_instance,
  },
end

  /- H1(G,A) -> H1(G,B) -> H1(G,C) -/
  lemma h1a_h1b_h1c_exact (G : Type*) [group G]
  {A : Type*} [add_comm_group A] [G_module G A]
  {B : Type*} [add_comm_group B] [G_module G B]
  {C : Type*} [add_comm_group C] [G_module G C]
  {f : A → B} [G_module_hom G f]
  {g : B → C} [G_module_hom G g]
  (hf : injective f)
  (hg : surjective g) (hfg : range f = ker g)
  : is_exact (H1_f G f) (H1_f G g) :=
begin
  apply subset.antisymm,
  { intros fb h,
    rw mem_ker,
    cases h with fa hfa,
    induction fa,
    swap,
    refl,
    change H1_f G f (quotient_add_group.mk fa) = _ at hfa,
    rw ←hfa,
    rw cocycle.map_mk G f fa,
    rw cocycle.map_mk G g,
    suffices : (cocycle.map G g (cocycle.map G f fa)) ∈ ker (quotient_add_group.mk),
      rw mem_ker at this,
      exact this,
      swap, apply_instance,
      swap, apply_instance,
    rw quotient_add_group.ker_mk,
    use 0,
    intro x,
    cases fa with fa pfa,
    show g (f (fa x)) = _,
    rw g_zero,
    rw sub_zero,
    rw ←mem_ker g,
    rw ←hfg,
    use fa x,
  },
  { intros x h,
    induction x,
    swap,
    refl,
    rw mem_ker at h,
    unfold H1_f at h,
    change quotient_add_group.mk (cocycle.map G g x) = 0 at h,
    rw ←mem_ker quotient_add_group.mk at h,
    swap,
    apply_instance,
    swap,
    apply_instance,
    rw quotient_add_group.ker_mk at h,
    cases h with c hc,
    rcases (hg c) with ⟨b, rfl⟩,
    let y := x - cocycle.mk b,
    have hy : range y ⊆ range f,
    {
      rintros b' ⟨γ, rfl⟩,
      rw hfg,
      rw mem_ker,
      change g ( x γ - (γ • b - b)) = 0,
      rw is_add_group_hom.map_sub g,
      rw sub_eq_zero,
      convert hc γ,
      rw is_add_group_hom.map_sub g,
      congr',
      rw G_module_hom.G_hom g,
      apply_instance,
    },
    let z : cocycle G A := cocycle.lift G f hf y hy,
    use quotient_add_group.mk z,
    change quotient_add_group.mk (cocycle.map G f (cocycle.lift G f hf y hy)) = quotient_add_group.mk x,
    rw cocycle.lift_eq,
    apply quotient_add_group.eq.2,
    use b,
    have hb : -y + x = cocycle.mk b,
    {
      show -(x - cocycle.mk b) + x = _,
      simp,
    },
    intro g',
    rw hb,
    refl,
  },
end