/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.int.preterm
import Mathlib.PostPort

universes l

namespace Mathlib

/-
Linear integer arithmetic formulas in pre-normalized form.
-/

namespace omega

namespace int

/-- Intermediate shadow syntax for LNA formulas that includes unreified exprs -/
/-- Intermediate shadow syntax for LIA formulas that includes non-canonical terms -/
inductive preform where
| eq : preterm → preterm → preform
| le : preterm → preterm → preform
| not : preform → preform
| or : preform → preform → preform
| and : preform → preform → preform

namespace preform

/-- Evaluate a preform into prop using the valuation v. -/
@[simp] def holds (v : ℕ → ℤ) : preform → Prop := sorry

end preform

/-- univ_close p n := p closed by prepending n universal quantifiers -/
@[simp] def univ_close (p : preform) : (ℕ → ℤ) → ℕ → Prop := sorry

namespace preform

/-- Fresh de Brujin index not used by any variable in argument -/
def fresh_index : preform → ℕ := sorry

/-- All valuations satisfy argument -/
def valid (p : preform) := ∀ (v : ℕ → ℤ), holds v p

/-- There exists some valuation that satisfies argument -/
def sat (p : preform) := ∃ (v : ℕ → ℤ), holds v p

/-- implies p q := under any valuation, q holds if p holds -/
def implies (p : preform) (q : preform) := ∀ (v : ℕ → ℤ), holds v p → holds v q

/-- equiv p q := under any valuation, p holds iff q holds -/
def equiv (p : preform) (q : preform) := ∀ (v : ℕ → ℤ), holds v p ↔ holds v q

theorem sat_of_implies_of_sat {p : preform} {q : preform} : implies p q → sat p → sat q :=
  fun (h1 : implies p q) (h2 : sat p) => exists_imp_exists h1 h2

theorem sat_or {p : preform} {q : preform} : sat (or p q) ↔ sat p ∨ sat q := sorry

/-- There does not exist any valuation that satisfies argument -/
def unsat (p : preform) := ¬sat p

def repr : preform → string := sorry

protected instance has_repr : has_repr preform := has_repr.mk repr

end preform

theorem univ_close_of_valid {p : preform} {m : ℕ} {v : ℕ → ℤ} :
    preform.valid p → univ_close p v m :=
  sorry

theorem valid_of_unsat_not {p : preform} : preform.unsat (preform.not p) → preform.valid p := sorry

end Mathlib


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import data.rbtree.find
import data.rbtree.insert
import data.rbtree.min_max
import order.rel_classes

universes u

namespace rbnode
variables {α : Type u} {lt : α → α → Prop}

lemma is_searchable_of_well_formed {t : rbnode α} [is_strict_weak_order α lt] :
  t.well_formed lt → is_searchable lt t none none :=
begin
  intro h, induction h,
  { constructor, simp [lift] },
  { subst h_n', apply is_searchable_insert, assumption }
end

open color

lemma is_red_black_of_well_formed {t : rbnode α} : t.well_formed lt → ∃ c n, is_red_black t c n :=
begin
  intro h, induction h,
  { existsi black, existsi 0, constructor },
  { cases h_ih with c ih, cases ih with n ih, subst h_n', apply insert_is_red_black, assumption }
end

end rbnode

namespace rbtree
variables {α : Type u} {lt : α → α → Prop}

lemma balanced (t : rbtree α lt) : t.depth max ≤ 2 * t.depth min + 1 :=
begin
  cases t with n p, simp only [depth],
  have := rbnode.is_red_black_of_well_formed p,
  cases this with _ this, cases this with _ this,
  apply rbnode.balanced, assumption
end

lemma not_mem_mk_rbtree : ∀ (a : α), a ∉ mk_rbtree α lt :=
by simp [has_mem.mem, rbtree.mem, rbnode.mem, mk_rbtree]

lemma not_mem_of_empty {t : rbtree α lt} (a : α) : t.empty = tt → a ∉ t :=
by cases t with n p; cases n; simp [empty, has_mem.mem, rbtree.mem, rbnode.mem, false_implies_iff]

lemma mem_of_mem_of_eqv [is_strict_weak_order α lt] {t : rbtree α lt} {a b : α} :
  a ∈ t → a ≈[lt] b → b ∈ t :=
begin
  cases t with n p; simp [has_mem.mem, rbtree.mem]; clear p; induction n;
    simp only [rbnode.mem, strict_weak_order.equiv, false_implies_iff]; intros h₁ h₂; blast_disjs,
  iterate 2
  { { have : rbnode.mem lt b n_lchild := n_ih_lchild h₁ h₂, simp [this] },
    { simp [incomp_trans_of lt h₂.swap h₁] },
    { have : rbnode.mem lt b n_rchild := n_ih_rchild h₁ h₂, simp [this] } }
end

section dec

variables [decidable_rel lt]

lemma insert_ne_mk_rbtree (t : rbtree α lt) (a : α) : t.insert a ≠ mk_rbtree α lt :=
begin
  cases t with n p,
  simpa [insert, mk_rbtree] using rbnode.insert_ne_leaf lt n a
end

lemma find_correct [is_strict_weak_order α lt] (a : α) (t : rbtree α lt) :
  a ∈ t ↔ (∃ b, t.find a = some b ∧ a ≈[lt] b) :=
begin cases t, apply rbnode.find_correct, apply rbnode.is_searchable_of_well_formed, assumption end

lemma find_correct_of_total [is_strict_total_order α lt] (a : α) (t : rbtree α lt) :
  a ∈ t ↔ t.find a = some a :=
iff.intro
  (λ h, match iff.mp (find_correct a t) h with
        | ⟨b, heq, heqv⟩ := by simp [heq, (eq_of_eqv_lt heqv).symm]
        end)
  (λ h, iff.mpr (find_correct a t) ⟨a, ⟨h, refl a⟩⟩)

lemma find_correct_exact [is_strict_total_order α lt] (a : α) (t : rbtree α lt) :
  mem_exact a t ↔ t.find a = some a :=
begin
  cases t, apply rbnode.find_correct_exact, apply rbnode.is_searchable_of_well_formed, assumption
end

lemma find_insert_of_eqv [is_strict_weak_order α lt] (t : rbtree α lt) {x y} :
  x ≈[lt] y → (t.insert x).find y = some x :=
begin
  cases t, intro h, apply rbnode.find_insert_of_eqv lt h, apply rbnode.is_searchable_of_well_formed,
  assumption
end

lemma find_insert [is_strict_weak_order α lt] (t : rbtree α lt) (x) :
  (t.insert x).find x = some x :=
find_insert_of_eqv t (refl x)

lemma find_insert_of_disj [is_strict_weak_order α lt] {x y : α} (t : rbtree α lt) :
  lt x y ∨ lt y x → (t.insert x).find y = t.find y :=
begin
  cases t, intro h, apply rbnode.find_insert_of_disj lt h,
  apply rbnode.is_searchable_of_well_formed,
  assumption
end

lemma find_insert_of_not_eqv [is_strict_weak_order α lt] {x y : α} (t : rbtree α lt) :
  ¬ x ≈[lt] y → (t.insert x).find y = t.find y :=
begin
  cases t, intro h, apply rbnode.find_insert_of_not_eqv lt h,
  apply rbnode.is_searchable_of_well_formed, assumption
end

lemma find_insert_of_ne [is_strict_total_order α lt] {x y : α} (t : rbtree α lt) :
  x ≠ y → (t.insert x).find y = t.find y :=
begin
  cases t, intro h,
  have : ¬ x ≈[lt] y := λ h', h (eq_of_eqv_lt h'),
  apply rbnode.find_insert_of_not_eqv lt this,
  apply rbnode.is_searchable_of_well_formed, assumption
end

lemma not_mem_of_find_none [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} :
  t.find a = none → a ∉ t :=
λ h, iff.mpr (not_iff_not_of_iff (find_correct a t)) $
  begin
    intro h,
    cases h with _ h, cases h with h₁ h₂,
    rw [h] at h₁, contradiction
  end

lemma eqv_of_find_some [is_strict_weak_order α lt] {a b : α} {t : rbtree α lt} :
  t.find a = some b → a ≈[lt] b :=
begin
  cases t, apply rbnode.eqv_of_find_some, apply rbnode.is_searchable_of_well_formed, assumption
end

lemma eq_of_find_some [is_strict_total_order α lt] {a b : α} {t : rbtree α lt} :
  t.find a = some b → a = b :=
λ h, suffices a ≈[lt] b, from eq_of_eqv_lt this,
     eqv_of_find_some h

lemma find_eq_find_of_eqv [is_strict_weak_order α lt] {a b : α} (t : rbtree α lt) :
  a ≈[lt] b → t.find a = t.find b :=
begin
  cases t, apply rbnode.find_eq_find_of_eqv,
  apply rbnode.is_searchable_of_well_formed, assumption
end

lemma contains_correct [is_strict_weak_order α lt] (a : α) (t : rbtree α lt) :
  a ∈ t ↔ (t.contains a = tt) :=
begin
  have h := find_correct a t,
  simp [h, contains], apply iff.intro,
  { intro h', cases h' with _ h', cases h', simp [*], simp [option.is_some] },
  { intro h',
    cases heq : find t a with v, simp [heq, option.is_some] at h', contradiction,
    existsi v, simp, apply eqv_of_find_some heq }
end

lemma mem_insert_of_incomp {a b : α} (t : rbtree α lt) : (¬ lt a b ∧ ¬ lt b a) → a ∈ t.insert b :=
begin cases t, apply rbnode.mem_insert_of_incomp end

lemma mem_insert [is_irrefl α lt] : ∀ (a : α) (t : rbtree α lt), a ∈ t.insert a :=
begin intros, apply mem_insert_of_incomp, split; apply irrefl_of lt end

lemma mem_insert_of_equiv {a b : α} (t : rbtree α lt) : a ≈[lt] b → a ∈ t.insert b :=
begin cases t, apply rbnode.mem_insert_of_incomp end

lemma mem_insert_of_mem [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} (b : α) :
  a ∈ t → a ∈ t.insert b :=
begin cases t, apply rbnode.mem_insert_of_mem end

lemma equiv_or_mem_of_mem_insert {a b : α} {t : rbtree α lt} :
  a ∈ t.insert b → a ≈[lt] b ∨ a ∈ t :=
begin cases t, apply rbnode.equiv_or_mem_of_mem_insert end

lemma incomp_or_mem_of_mem_ins {a b : α} {t : rbtree α lt} :
  a ∈ t.insert b → (¬ lt a b ∧ ¬ lt b a) ∨ a ∈ t :=
equiv_or_mem_of_mem_insert

lemma eq_or_mem_of_mem_ins [is_strict_total_order α lt] {a b : α} {t : rbtree α lt} :
  a ∈ t.insert b → a = b ∨ a ∈ t :=
λ h, suffices a ≈[lt] b ∨ a ∈ t, by simp [eqv_lt_iff_eq] at this; assumption,
  incomp_or_mem_of_mem_ins h

end dec

lemma mem_of_min_eq [is_irrefl α lt] {a : α} {t : rbtree α lt} : t.min = some a → a ∈ t :=
begin cases t, apply rbnode.mem_of_min_eq end

lemma mem_of_max_eq [is_irrefl α lt] {a : α} {t : rbtree α lt} : t.max = some a → a ∈ t :=
begin cases t, apply rbnode.mem_of_max_eq end

lemma eq_leaf_of_min_eq_none {t : rbtree α lt} :
  t.min = none → t = mk_rbtree α lt :=
begin cases t, intro h, congr, apply rbnode.eq_leaf_of_min_eq_none h end

lemma eq_leaf_of_max_eq_none {t : rbtree α lt} :
  t.max = none → t = mk_rbtree α lt :=
begin cases t, intro h, congr, apply rbnode.eq_leaf_of_max_eq_none h end

lemma min_is_minimal [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} :
  t.min = some a → ∀ {b}, b ∈ t → a ≈[lt] b ∨ lt a b :=
by { classical, cases t, apply rbnode.min_is_minimal, apply rbnode.is_searchable_of_well_formed,
  assumption }

lemma max_is_maximal [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} :
  t.max = some a → ∀ {b}, b ∈ t → a ≈[lt] b ∨ lt b a :=
by { cases t, apply rbnode.max_is_maximal, apply rbnode.is_searchable_of_well_formed, assumption }

end rbtree


import .basic

variables {σ : Type*} {sig : σ → ℕ} {α : Type*}
include sig

definition use : term sig → ℕ
| (term.var n) := n+1
| (term.app s ts) :=
  if hs : sig s = 0 then 0
  else tup.max' hs (λ i, use (ts i))

lemma use_app {s : σ} {ts : term sig ^ (sig s)} (i : fin (sig s)) :
use (ts i) ≤ use (term.app s ts) :=
if hs : sig s = 0 then
  fin.elim0 (eq.rec_on hs i)
else
  calc
  use (term.app s ts)
      = tup.max' hs (tup.map use ts) : dif_neg hs
  ... ≥ (tup.map use ts)[i]          : tup.le_max'
  ... = use ts[i]                    : rfl

@[reducible]
definition eval_use (a : alg sig α) : Π (t : term sig), α ^ (use t) → α
| (term.var n) val :=
  val ⟨n, nat.lt_succ_self n⟩
| (term.app s ts) val :=
  a.app s (λ i, eval_use (ts i) (tup.take (use_app i) val))

lemma eval_use_eq_eval {a : alg sig α} {val : ℕ → α} :
Π (t : term sig), eval_use a t (tup.bar val (use t)) = eval a val t
| (term.var n) := rfl
| (term.app s ts) :=
  let m := use (term.app s ts) in
  let valm := tup.bar val m in
  have ∀ i, tup.take (use_app i) valm = tup.bar val (use ts[i]),
  from λ i, tup.take_bar val (use_app i),
  have ∀ i,
  eval_use a ts[i] (tup.take (use_app i) valm)
  = eval_use a ts[i] (tup.bar val (use ts[i])),
  begin
  intro i,
  rw tup.take_bar val (use_app i)
  end,
  calc
  eval_use a (term.app s ts) valm
      = a.app s (λ i, eval_use a ts[i] (tup.take (use_app i) valm)) : rfl
  ... = a.app s (λ i, eval_use a ts[i] (tup.bar val (use ts[i]))) : by rw tup.ext this
  ... = a.app s (λ i, eval a val ts[i]) : by rw tup.ext (λ i, eval_use_eq_eval (ts i))
  ... = eval a val (term.app s ts) : rfl

theorem eval_continuity {t : term sig} {a : alg sig α} {val₁ val₂ : ℕ → α} :
(∀ i < use t, val₁ i = val₂ i) → eval a val₁ t = eval a val₂ t :=
assume h,
have tup.bar val₁ (use t) = tup.bar val₂ (use t),
from tup.ext (λ ⟨i,hi⟩, h i hi),
calc
eval a val₁ t
    = eval_use a t (tup.bar val₁ (use t)) : by rw eval_use_eq_eval
... = eval_use a t (tup.bar val₂ (use t)) : by rw this
... = eval a val₂ t : by rw eval_use_eq_eval

@[reducible]
definition eval_use_of_le (a : alg sig α) {n : ℕ} (val : α ^ n) (t : term sig) :
use t ≤ n → α := λ h, eval_use a t (tup.take h val)

lemma eval_use_of_le_app (a : alg sig α) {n : ℕ} (val : α ^ n)
{s : σ} {ts : term sig ^ sig s} (h : use (term.app s ts) ≤ n) :
eval_use_of_le a val (term.app s ts) h = a.app s (λ i, eval_use_of_le a val ts[i] (le_trans (use_app i) h)) :=
begin
simp [eval_use_of_le, eval_use]
end

lemma eval_eq_eval_use_of_le {a : alg sig α} {val : ℕ → α} (t : term sig) {m : ℕ} {hm : use t ≤ m} :
eval a val t = eval_use_of_le a (tup.bar val m) t hm :=
calc
eval a val t
    = eval_use a t (tup.bar val (use t)) : by rw eval_use_eq_eval
... = eval_use a t (tup.take hm (tup.bar val m)) : by rw tup.take_bar
... = eval_use_of_le a (tup.bar val m) t hm : rfl

definition sat_use (a : alg sig α) (e : eqn sig) : Prop :=
∀ (val : α ^ max (use e.fst) (use e.snd)), eval_use_of_le a val e.fst (le_max_left _ _) = eval_use_of_le a val e.snd (le_max_right _ _)

lemma sat_iff_sat_use {a : alg sig α} {e : eqn sig} :
a ⊧ e ↔ sat_use a e :=
let m := max (use e.fst) (use e.snd) in iff.intro
 (λ h val,
  let x := eval_use_of_le a val e.fst (le_max_left _ _) in
  calc
  eval_use_of_le a val e.fst (le_max_left _ _)
      = eval_use_of_le a (tup.bar (tup.extend val x) m) e.fst (le_max_left _ _) : by rw tup.bar_extend
  ... = eval a (tup.extend val x) e.fst : by rw eval_eq_eval_use_of_le
  ... = eval a (tup.extend val x) e.snd : by apply h
  ... = eval_use_of_le a (tup.bar (tup.extend val x) m) e.snd (le_max_right _ _) : by rw eval_eq_eval_use_of_le
  ... = eval_use_of_le a val (e.snd) (le_max_right _ _) : by rw tup.bar_extend)
 (λ h val,
  calc
  eval a val e.fst
      = eval_use_of_le a (tup.bar val m) e.fst (le_max_left _ _) : by rw eval_eq_eval_use_of_le
  ... = eval_use_of_le a (tup.bar val m) e.snd (le_max_right _ _) : by apply h
  ... = eval a val e.snd : by rw eval_eq_eval_use_of_le)


import Kenny_comm_alg.temp

universe u

namespace is_ideal

variables {α : Type u} [comm_ring α] (S S₁ S₂ S₃ S₄ T T₁ T₂ : set α)
variables [is_ideal S] [is_ideal S₁] [is_ideal S₂] [is_ideal S₃] [is_ideal S₄]

@[reducible] def add_ideal : set α :=
{ x | ∃ y z, y ∈ T₁ ∧ z ∈ T₂ ∧ x = y + z }

infix + := add_ideal

variables {S₁ S₂}

instance add.is_ideal : is_ideal (S₁ + S₂) :=
{ zero_ := ⟨0, 0, is_ideal.zero S₁, is_ideal.zero S₂, by simp⟩,
  add_  := λ x₁ x₂ ⟨y₁, z₁, hy₁, hz₁, hx₁⟩ ⟨y₂, z₂, hy₂, hz₂, hx₂⟩,
    ⟨y₁ + y₂, z₁ + z₂, is_ideal.add hy₁ hy₂, is_ideal.add hz₁ hz₂, by simp [hx₁, hx₂]⟩,
  smul  := λ x₁ x₂ ⟨y, z, hy, hz, hx⟩,
    ⟨x₁ * y, x₁ * z, mul_left hy, mul_left hz, by simp [hx, mul_add]⟩ }

theorem subset_add_left : S₁ ⊆ S₁ + S₂ :=
λ x hx, ⟨x, 0, hx, is_ideal.zero S₂, eq.symm $ add_zero x⟩

theorem subset_add_right : S₂ ⊆ S₁ + S₂ :=
λ x hx, ⟨0, x, is_ideal.zero S₁, hx, eq.symm $ zero_add x⟩

theorem add_self : S₁ + S₁ = S₁ :=
set.ext $ λ x,
⟨λ ⟨y, z, hy, hz, hx⟩, set.mem_of_eq_of_mem hx $ is_ideal.add hy hz,
 λ hx, subset_add_left hx⟩

@[reducible] def mul_ideal : set α :=
span { x | ∃ y z, y ∈ T₁ ∧ z ∈ T₂ ∧ x = y * z}

infix * := mul_ideal

instance mul.is_ideal : is_ideal (S₁ * S₂) :=
{ ..is_submodule_span }

instance inter.is_ideal : is_ideal (S₁ ∩ S₂) :=
{ zero_ := ⟨is_ideal.zero S₁, is_ideal.zero S₂⟩,
  add_  := λ x y ⟨hx1, hx2⟩ ⟨hy1, hy2⟩, ⟨is_ideal.add hx1 hy1, is_ideal.add hx2 hy2⟩,
  smul  := λ x y ⟨hy1, hy2⟩, ⟨mul_left hy1, mul_left hy2⟩ }

instance sInter.is_ideal (S : set $ set α) (h : ∀ A ∈ S, is_ideal A) : is_ideal (⋂₀ S) :=
{ zero_ := λ A ha, @@is_ideal.zero _ A (h A ha),
  add_  := λ x y hx hy A ha, @@is_ideal.add _ (h A ha) (hx A ha) (hy A ha),
  smul  := λ x y hy A ha, @@mul_left _ (h A ha) (hy A ha) }

instance sInter'.is_ideal (SS : set $ {S : set α // is_ideal S}) :
  is_ideal {x | ∀ S:{S : set α // is_ideal S}, S ∈ SS → x ∈ S.val} :=
{ zero_ := λ A ha, @@is_ideal.zero _ A.1 A.2,
  add_  := λ x y hx hy A ha, @@is_ideal.add _ A.2 (hx A ha) (hy A ha),
  smul  := λ x y hy A ha, @@mul_left _ A.2 (hy A ha) }

variables {S₁ S₂ S₃ S₄}

theorem mem_add {x y : α} : x ∈ S₁ → y ∈ S₂ → x + y ∈ S₁ + S₂ :=
λ hx hy, ⟨x, y, hx, hy, rfl⟩

theorem mem_mul {x y : α} : x ∈ S₁ → y ∈ S₂ → x * y ∈ S₁ * S₂ :=
λ hx hy, subset_span ⟨x, y, hx, hy, rfl⟩

theorem add_comm : S₁ + S₂ = S₂ + S₁ :=
set.ext $ λ x,
⟨λ ⟨y, z, hy, hz, hx⟩, ⟨z, y, hz, hy, add_comm y z ▸ hx⟩,
 λ ⟨y, z, hy, hz, hx⟩, ⟨z, y, hz, hy, add_comm y z ▸ hx⟩⟩

lemma span_ext {T₁ T₂ : set α} : (∀ x, x ∈ T₁ ↔ x ∈ T₂) → span T₁ = span T₂ :=
λ hx, congr_arg span $ set.ext hx

theorem mul_comm : S₁ * S₂ = S₂ * S₁ :=
span_ext $ λ x,
⟨λ ⟨y, z, hy, hz, hx⟩, ⟨z, y, hz, hy, mul_comm y z ▸ hx⟩,
 λ ⟨y, z, hy, hz, hx⟩, ⟨z, y, hz, hy, mul_comm y z ▸ hx⟩⟩

theorem add_assoc : (S₁ + S₂) + S₃ = S₁ + (S₂ + S₃) :=
set.ext $ λ x,
⟨λ ⟨pq, r, ⟨p, q, hp, hq, hpq⟩, hr, hx⟩, ⟨p, q + r, hp, ⟨q, r, hq, hr, rfl⟩, add_assoc p q r ▸ hpq ▸ hx⟩,
 λ ⟨p, qr, hp, ⟨q, r, hq, hr, hqr⟩, hx⟩, ⟨p + q, r, ⟨p, q, hp, hq, rfl⟩, hr, (add_assoc p q r).symm ▸ hqr ▸ hx⟩⟩

theorem mul_subset_left : S₁ * S₂ ⊆ S₁ :=
span_minimal _inst_3.to_is_submodule $
λ z ⟨p, q, hp, hq, hz⟩, calc
    z = p * q : hz
  ... ∈ S₁    : mul_right hp

theorem mul_subset_right : S₁ * S₂ ⊆ S₂ :=
span_minimal _inst_4.to_is_submodule $
λ z ⟨p, q, hp, hq, hz⟩, calc
    z = p * q : hz
  ... ∈ S₂    : mul_left hq

theorem mul_subset_inter : S₁ * S₂ ⊆ S₁ ∩ S₂ :=
λ x hx, ⟨mul_subset_left hx, mul_subset_right hx⟩

theorem add_univ : S₁ + set.univ = set.univ :=
set.ext $ λ x, ⟨λ hx, show true,by trivial, λ hx, subset_add_right hx⟩

theorem univ_add : set.univ + S₁ = set.univ :=
set.ext $ λ x, ⟨λ hx, show true, by trivial, λ hx, subset_add_left hx⟩

theorem add_zero : S₁ + ({0}:set α) = S₁ :=
set.ext $ λ x,
⟨λ ⟨y, z, hy, hz, hx⟩, by simp at hz; simp [hz] at hx; simpa [hx],
 λ hx, subset_add_left hx⟩

theorem zero_add : ({0}:set α) + S₁ = S₁ :=
set.ext $ λ x,
⟨λ ⟨y, z, hy, hz, hx⟩, by simp at hy; simp [hy] at hx; simpa [hx],
 λ hx, subset_add_right hx⟩

lemma subset_span_of_subset {T₁ T₂ : set α} : T₁ ⊆ T₂ → T₁ ⊆ span T₂ :=
λ h, set.subset.trans h subset_span

theorem mul_univ : S₁ * set.univ = S₁ :=
span_eq _inst_3.to_is_submodule
  (λ x ⟨y, z, hy, hz, hx⟩, by rw hx; exact mul_right hy)
  (subset_span_of_subset $
   λ x hx, ⟨x, 1, hx, show true, by trivial, eq.symm $ mul_one x⟩)

theorem univ_mul : set.univ * S₁ = S₁ :=
span_eq _inst_3.to_is_submodule
  (λ x ⟨y, z, hy, hz, hx⟩, by rw hx; exact mul_left hz)
  (subset_span_of_subset $
   λ x hx, ⟨1, x, show true, by trivial, hx, eq.symm $ one_mul x⟩)

theorem mul_zero : S₁ * ({0}:set α) = ({0}:set α) :=
span_eq is_submodule.single_zero
  (λ x ⟨y, z, hy, hz, hx⟩, by simp at hz; simp [hx, hz])
  (subset_span_of_subset $
   λ x hx, ⟨0, 0, by simp at hx; simp [hx, is_ideal.zero]⟩)

theorem zero_mul : ({0}:set α) * S₁ = ({0}:set α) :=
span_eq is_submodule.single_zero
  (λ x ⟨y, z, hy, hz, hx⟩, by simp at hy; simp [hx, hy])
  (subset_span_of_subset $
   λ x hx, ⟨0, 0, by simp at hx; simp [hx, is_ideal.zero]⟩)

/-
(0,2) -> (x+y, 0)
(1,0) -> (0, 1) [(x+y)^(1+0-1) = (0)*x^1+(1)*y^0]
(1,1) -> (1, 1) [(x+y)^(1+1-1) = (1)*x^1+(1)*y^1]
(1,2) -> (x+2y, 1) [(x+y)^(1+2-1) = (x+2y)*x^1+(1)*y^2]
(1,3) -> (x^2+3xy+3y^2, 1) [(x+y)^3 = (x^2+3xy+3y^2)*x^1+(1)*y^3]
(2,2) -> (x+3y, y+3x)
(3,2) -> (x+4y, y^2+4xy+6x^2)
(4,1) -> (1, y^3+4xy^2+6x^2y+4x^3)
(4,2) -> (x+5y, y^3+5xy^2+10x^2y+10x^3)
(4,3) -> (x^2+6xy+15y^2, y^3+6xy^2+14x^2y+20x^3)
(4,4) -> (x^3+7x^2y+21xy^2+35y^3, y^3+7xy^2+21x^2y+35x^3)

(x,y,1,0) : 0
(x,y,1,1) : 1 = 0*(x+y) + 1*y^0
(x,y,1,2) : x+2y = 1*(x+y) + 1*y^1
(x,y,1,3) : x^2+3xy+3y^2 = (x+2y)*(x+y) + 1*y^2

(y,x,2,3): y^2+4xy+6x^2 = (y+3x)(y+x) + 3x^2
(y,x,2,4): y^3+5xy^2+10x^2y+10x^3 = (y^2+4xy+6x^2)(y+x) + 4x^3

A(x,y,4,3) = A(x,y,4,2)*(x+y)+(5C2)y^3
A(x,y,4,4) = A(x,y,4,3)*(x+y)+(6C3)y^3

(x+y)^(4+3-1) = x^4(x^2+6xy+15y^2) + y^3(y^3+6xy^2+15x^2y+20x^3)
(x+y)^(5+3-1)
= (x^4(x^2+6xy+15y^2) + y^3(y^3+6xy^2+15x^2y+20x^3))(x+y)
= x^5(x^2+6xy+15y^2) + x^4(x^2+6xy+15y^2)y + y^3(y^3+6xy^2+15x^2y+20x^3)(x+y)
= x^5(x^2+6xy+15y^2) + x^4(x^2+6xy+15y^2)y + y^3(y^3+6xy^2+15x^2y+20x^3)(x+y)

(x+y)^(1+2+1) = (x^2+4xy+6y^2)*x^2 + (y+4x)*y^3
(x+y)^(1+1+1) = (x+3y)*x^2 + (y+3x)*y^2
(x+y)^(1+0+1) = (1)*x^2 + (y+2x)*y^1
(x+y)^(0+0+1) = (1)*x^1 + (1)*y^1

A(x,y,0,0) = 1
A(x,y,0,1) = x+2y = (1)*(x+y)+y
A(x,y,0,2) = x^2+3xy+3y^2
A(x,y,0,3) = x^3+4x^2y+6xy^2+4y^3 = A(x,y,0,2)*(x+y)+y^3
A(x,y,1,0) = 1
A(x,y,1,1) = x+3y = (1)*(x+y)+2y
A(x,y,1,2) = x^2+4xy+6y^2 = (x+3y)*(x+y)+3y^2 [remark: 3C1]
A(x,y,1,3) = x^3+5x^2y+10xy^2+10y^3
A(x,y,2,0) = 1
A(x,y,2,1) = x+4y
A(x,y,2,2) = x^2+5xy+10y^2
A(x,y,2,3) = x^3+6x^2y+15xy^2+20y^3 = A(x,y,1,3) + y*A(x,y,2,2)

-/

def some_binomial_boi (x y : α) : nat → nat → α
| m     0     := 1
| 0     (n+1) := (some_binomial_boi 0 n) * (x + y) + y^(n+1)
| (m+1) (n+1) := some_binomial_boi m (n+1) + y * some_binomial_boi (m+1) n

lemma some_lemma_boi (x y : α) (n : nat) : some_binomial_boi x y n 0 = 1 :=
by cases n; refl

theorem some_binomial_theorem_boi (x y : α) (m n : nat) :
  (x + y)^(m+n+1) = (some_binomial_boi x y m n)*x^(m+1) + (some_binomial_boi y x n m)*y^(n+1) :=
begin
  induction m with m m_ih generalizing n;
  induction n with n n_ih,
  { simp [some_binomial_boi] },
  { rw nat.zero_add at n_ih ⊢,
    unfold pow at n_ih ⊢,
    unfold monoid.pow at n_ih ⊢,
    rw n_ih,
    unfold some_binomial_boi,
    rw some_lemma_boi,
    unfold pow,
    unfold monoid.pow,
    ring },
  { specialize m_ih 0,
    simp [pow_succ] at m_ih ⊢,
    rw m_ih,
    unfold some_binomial_boi,
    rw some_lemma_boi,
    unfold pow,
    unfold monoid.pow,
    ring },
  { calc  (x + y) ^ (nat.succ m + nat.succ n + 1)
        = x * (x + y) ^ (m + (n + 1) + 1) + y * (x + y) ^ (nat.succ m + n + 1) :
            by rw [pow_succ, add_mul]; simp [nat.succ_eq_add_one]
    ... = x * (some_binomial_boi x y m (n + 1) * x ^ (m + 1) + some_binomial_boi y x (n + 1) m * y ^ ((n + 1) + 1)) +
          y * (some_binomial_boi x y (nat.succ m) n * x ^ (nat.succ m + 1) + some_binomial_boi y x n (nat.succ m) * y ^ (n + 1)) :
            by rw [m_ih, n_ih]
    ... = some_binomial_boi x y (nat.succ m) (nat.succ n) * x ^ (nat.succ m + 1) +
          some_binomial_boi y x (nat.succ n) (nat.succ m) * y ^ (nat.succ n + 1) :
            by unfold some_binomial_boi; unfold pow; unfold monoid.pow; simp [nat.succ_eq_add_one]; ring SOP; ac_refl }
end

def radical : set α := {x | ∃ n : ℕ, x ^ (n+1) ∈ S}

instance radical.is_ideal : is_ideal (radical S) :=
{ zero_ := ⟨0, by simp [is_ideal.zero]⟩,
  add_  := λ x y ⟨m, hxms⟩ ⟨n, hyns⟩,
    ⟨m + n, by rw some_binomial_theorem_boi;
     exact is_ideal.add
       (is_ideal.mul_left hxms)
       (is_ideal.mul_left hyns)⟩,
  smul  := λ x y ⟨n, hyns⟩,
    ⟨n, by dsimp [(•)]; rw mul_pow;
       exact is_ideal.mul_left hyns⟩ }

theorem subset_radical : S ⊆ radical S :=
λ x hx, ⟨0, by simpa⟩

end is_ideal