import set_theory.cardinal
import fol
import completeness
import Rings.Notation
import Rings.ToMathlib.fol

noncomputable theory

namespace fol
open_locale cardinal

variables {L : Language}

lemma realize_lift_bounded_term (M : Structure L) {n} :
  Π {l} (t : bounded_preterm L n l) (xs : dvector M n) (v : dvector M l) (a : M),
  realize_bounded_term (dvector.cons a xs) (t ↑ 1) v =
    realize_bounded_term xs t v
| _ (bd_var k) _ _ _ :=
begin
  have hle : 0 ≤ (k : ℕ) := nat.zero_le _,
  dsimp [lift_bounded_term],
  rw [if_pos hle],
  congr',
end
| _ (bd_func f) _ _ _ := by { dsimp only [lift_bounded_term], simp }
| _ (bd_app t s) xs v _ :=
begin
  dsimp only [lift_bounded_term],
  simp only [lift_bounded_term_at, realize_bounded_term_bd_app],
  have hinds := realize_lift_bounded_term s xs,
  rw hinds,
  have hind := realize_lift_bounded_term t xs
    (dvector.cons (realize_bounded_term xs s dvector.nil) v),
  rw hind,
end

/-- The formula that will give rise to a witness for function symbols -/
abbreviation wit_bd_func {n : ℕ} (f : L.functions n) (xs : dvector L.constants n) :
  bounded_formula L 1 := bd_apps (bd_func f) (dvector.map bd_const xs) ≃ x_ 0

-- /-- The formula that will give rise to a witness for terms -/
-- abbreviation wit_bd_preterm {n l} (t : bounded_preterm L n l) (v : dvector ) :
--   bounded_preformula L (n+1) l := bd_equal (lift_bounded_term1 t) x_ 0

/-- The formula that will give rise to a witness for terms -/
abbreviation wit_bd_term (t : bounded_term L 0) :
  bounded_formula L 1 := (lift_bounded_term1 t : bounded_term L 1) ≃ x_ 0

variables (T : Theory L) [hcompl : fact (is_complete T)]

include hcompl

-- namespace is_complete

-- def M : Structure L := classical.some $ (model_existence _).1 hcompl.1.1

-- def hM0 : nonempty (M T) := (classical.some_spec $ (model_existence _).1 hcompl.1.1).1

-- def hMT : (M T) ⊨ T := (classical.some_spec $ (model_existence _).1 hcompl.1.1).2

-- end is_complete

instance equality_of_constants : setoid L.constants :=
{ r := λ c d, (bd_const c ≃ bd_const d) ∈ T,
  iseqv :=
  begin
    have hconsis := hcompl.1.1,
    have hcompl1 := hcompl.1,
    obtain ⟨ M , hM0 , hMT ⟩ := (model_existence _).1 hconsis,
    repeat {split},
    { intro c,
      apply or.resolve_right (hcompl1.2 (bd_const c ≃ bd_const c)),
      intro hmem,
      specialize hMT hmem,
      apply hMT,
      simp },
    { intros c d hcd,
      apply or.resolve_right (hcompl1.2 (bd_const d ≃ bd_const c)),
      intro hmem,
      apply hMT hmem,
      specialize hMT hcd,
      simp only [realize_sentence_equal, realize_closed_term] at hMT,
      simp [hMT] },
    { intros c d e hcd hde,
      apply or.resolve_right (hcompl1.2 (bd_const c ≃ bd_const e)),
      intro hmem,
      apply hMT hmem,
      have Hcd := hMT hcd,
      have Hde := hMT hde,
      simp only [realize_sentence_equal, realize_closed_term] at Hcd Hde,
      simp [Hcd, Hde] },
  end }

namespace bounded_model_of_infinite_model

variables (T)

def model_carrier := @quotient L.constants (@fol.equality_of_constants _ T _)

variables [hwit : fact (has_enough_constants T)]
include hwit

def w : bounded_formula L 1 → L.constants := classical.some hwit.1

lemma hw : ∀ (f : bounded_formula L 1), T ⊢' (∃' f) ⟹ f[bd_const ((w T) f) /0] :=
classical.some_spec hwit.1

variable {T}

lemma all_realize_wit_of_mem (ϕ : bounded_formula L 1) : (∃' ϕ) ∈ T → T ⊨ ϕ[bd_const (w T ϕ) /0] :=
begin
  intro hmem,
  have hTϕ := hw T ϕ,
  rw completeness at hTϕ,
  intros M hM0 hMT,
  exact hTϕ hM0 hMT (hMT hmem),
end

variable (T)

/-- The action of a function symbol on the set of constant symbols is given by the witness property:
  if `xs` is a list of constant symbols then we take the formula `∃ v, f(xs) = v ∈ T`.
  The witness property gives us `c : L.constants` such that `f(xs) = c ∈ T`.
  Proving these formulas are in `T` repeatedly uses completeness and (hence) consistency of `T`.
-/
abbreviation fun_map_on_L_constants {n : ℕ} (f : L.functions n) (xs : dvector L.constants n) :
  L.constants := w T (wit_bd_func f xs)

lemma fun_map_on_L_constants_all_realize_sentence {n : ℕ} (f : L.functions n)
  (xs : dvector L.constants n) : T ⊨ (wit_bd_func f xs)[bd_const (w T (wit_bd_func f xs)) /0] :=
begin
  obtain ⟨ M , hM0 , hMT ⟩ := (model_existence _).1 hcompl.1.1,
  set x := realize_bounded_term (dvector.nil : dvector M 0)
    (bd_apps (bd_func f) (dvector.map bd_const xs)) dvector.nil with hx,
  apply all_realize_wit_of_mem,
  apply or.resolve_right (hcompl.1.2 _),
  intro hmem,
  have hbot := hMT hmem,
  simp only [realize_bounded_term, realize_sentence_not, realize_bounded_formula,
    realize_sentence_ex, dvector.nth, fin.val_zero', not_exists] at hbot,
  apply hbot x,
  simpa [realize_bounded_term_bd_apps, hx],
end

lemma bd_func_on_L_constants_mem {n : ℕ} (f : L.functions n) (xs : dvector L.constants n) :
  -- T ⊨ (wit_bd_func f xs)[bd_const (w T (wit_bd_func f xs)) /0] →
  ((bd_apps (bd_func f) (dvector.map bd_const xs)) ≃ (bd_const (w T (wit_bd_func f xs)))) ∈ T :=
begin
  obtain ⟨ M , hM0 , hMT ⟩ := (model_existence _).1 hcompl.1.1,
  apply or.resolve_right (hcompl.1.2 _),
  intro hmem,
  have hbot := hMT hmem,
  apply hbot,
  simp [realize_sentence_equal, realize_closed_term, bd_const, realize_bounded_term_bd_apps],
  have hMϕ := fun_map_on_L_constants_all_realize_sentence T f xs hM0 hMT,
  simp [realize_subst_formula0] at hMϕ, -- cannot fix
  convert hMϕ,
  simp [bd_const, realize_bounded_term_bd_apps],
end

/-- The map on functions uses choice twice, once to find representatives from the
  quotient terms, once to find constant a symbol using witness property / henkin / enough constants
  (since `fol.bounded_model_of_infinite_model.w` uses choice)
-/
def fun_map_on_M : Π {n : ℕ}, L.functions n → dvector (model_carrier T) n →
  model_carrier T :=
λ n f xs, quotient.mk (fun_map_on_L_constants T f (dvector.map quotient.out xs))

variable [L.is_algebraic]

def model :
  Structure L :=
{ carrier := model_carrier T,
  fun_map := λ _, fun_map_on_M T,
  rel_map := λ _ r, false.elim $ Language.is_algebraic.empty_relations _ r }

lemma realize_term_all_realize_sentence (t : bounded_term L 0) :
  T ⊨ (wit_bd_term t)[bd_const (w T (wit_bd_term t)) /0] :=
begin
  apply all_realize_wit_of_mem,
  obtain ⟨ M , hM0 , hMT ⟩ := (model_existence _).1 hcompl.1.1,
  apply or.resolve_right (hcompl.1.2 _),
  intro hmem,
  apply hMT hmem,
  simp only [realize_bounded_formula, lift_bounded_term1,
    realize_bounded_term, realize_bounded_formula_ex, dvector.nth, fin.val_zero'],
  use (realize_closed_term M t),
  rw realize_lift_bounded_term,
end

-- lemma realize_bounded_term {n l} (xs : dvector (model T) n) (t : bounded_preterm L n l)
--   (v : dvector (model T) l) :
--   realize_bounded_term xs t v
--   = realize_closed_term (model T) (bd_const (w T (wit_bd_term t))) :=

lemma realize_term' (t : bounded_term L 0) : realize_closed_term (model T) t
  = realize_closed_term (model T) (bd_const (w T (wit_bd_term t))) :=
begin
  sorry
  -- let ϕ := (lift_bounded_term1 t : bounded_term L 1) ≃ -- x_ 0,
  -- have hex : (∃' ϕ) ∈ T,
  -- {
  --   obtain ⟨ M , hM0 , hMT ⟩ := (model_existence _).1 hcompl.1.1,
  --   apply or.resolve_right (hcompl.1.2 _),
  --   intro hmem,
  --   apply hMT hmem,
  --   simp only [realize_bounded_formula, lift_bounded_term1,
  --     realize_bounded_term, realize_bounded_formula_ex, dvector.nth, fin.val_zero'],
  --   use (realize_closed_term M t),
  --   rw realize_lift_bounded_term },
  -- use w T ϕ,
  -- simp only [realize_closed_term],
  -- have hTϕ := all_realize_wit_of_mem ϕ hex,

  -- cases t with k,
  -- { apply fin_zero_elim k },
  -- {
    -- simp [bd_const],
    -- sorry
  -- },
  -- {sorry},
end

lemma realize_sentence_iff (ϕ : sentence L) : model T ⊨ ϕ ↔ ϕ ∈ T :=
begin
  obtain ⟨ M , hM0 , hMT ⟩ := (model_existence _).1 hcompl.1.1,
  cases ϕ,
  { simp only [false_of_satisfied_false, false_iff],
    intro hbot,
    apply hMT hbot },
  {
    simp [realize_sentence_equal, realize_closed_term],
    sorry
  },
  {
    sorry
  },
  {
    sorry
  },
  {
    sorry
  },
  {
    sorry
  },
end

lemma all_realize_sentence : model T ⊨ T :=
begin
  obtain ⟨ M , hM0 , hMT ⟩ := (model_existence _).1 hcompl.1.1,
  intro ϕ,
  cases ϕ,
  { intro hbot,
    exfalso,
    apply hMT hbot },
  {
    intro hmem,
    sorry
  },
  {
    sorry
  },
  {
    sorry
  },
  {
    sorry
  },
  {
    sorry
  },
end

lemma cardinality : #(model T) ≤ #L.constants := sorry

end bounded_model_of_infinite_model

/-- If a theory `T` is complete (i.e. maximal) and consistent
  then `T` has a model `M` with `#M ≤ |constant symbols of the language|` -/
theorem bounded_model_of_infinite_model
  [hwit : fact (has_enough_constants T)] [L.is_algebraic] :
  ∃ M : Structure L, nonempty M ∧ M ⊨ T ∧ #M ≤ #L.constants :=
⟨ bounded_model_of_infinite_model.model T,
    sorry,
    bounded_model_of_infinite_model.all_realize_sentence T ,
    bounded_model_of_infinite_model.cardinality T ⟩

#check Language.constants

end fol


import tactic

import data.stream.defs
import data.set.basic
import data.set.lattice
import data.list.basic
import data.list.nodup
import data.finset.basic
import justification
import tactic

@[reducible]
def Val : Type := ℕ
instance : has_lt Val := by {unfold Val, apply_instance}
instance : has_add Val := by {unfold Val, apply_instance}
def State (Var : Type) [fintype Var] [decidable_eq Var] : Type := Var → Val

def Trace (Var : Type) [fintype Var] [decidable_eq Var] : Type := stream (State Var)

class AssertionLang (Assertion : Type) (Var : Type) [fintype Var] [decidable_eq Var]
extends has_top Assertion :=
(compl : Assertion → Assertion)
(conj : Assertion → Assertion → Assertion)
(disj : Assertion → Assertion → Assertion)
(sem : Assertion → set (Trace Var))
(T_def : sem ⊤ = set.univ)
(compl_def : ∀ A : Assertion, sem (compl A) = set.univ \ (sem A))
(conj_def :  ∀ A B : Assertion, sem (conj A B) =  (sem A) ∩ (sem B))
(disj_def :  ∀ A B : Assertion,  sem (disj A B) =  (sem A) ∪ (sem B))

notation `⦃` Φ `;;`Var `;;` A `⦄` := (AssertionLang.sem Φ Var _ _ _ A)

namespace AssertionLang

variables {Φ Var : Type} [fintype Var] [decidable_eq Var] [AssertionLang Φ Var]

def Impl : Φ → Φ → Φ := λ P Q, AssertionLang.disj Var (AssertionLang.compl Var P) Q

lemma impl_def {P Q : Φ} {σ : Trace Var} :
  σ ∈ (@AssertionLang.sem Φ Var _ _ _ (@Impl Φ Var _ _ _ P Q)) ↔
  σ ∈ (@AssertionLang.sem Φ Var _ _ _ P) → σ ∈ (@AssertionLang.sem Φ Var _ _ _ Q) :=
begin
split,
intros h₁ h₂,
rw Impl at h₁,
simp at h₁,
rw disj_def at h₁,
cases h₁,
rw compl_def at h₁,
exfalso, exact set.not_mem_of_mem_diff h₁ h₂, assumption,

intros h,
rw Impl, rw disj_def, simp,
have : σ ∈  (@AssertionLang.sem Φ Var _ _ _ P) ∨ σ ∉  (@AssertionLang.sem Φ Var _ _ _ P), from or_not,
cases this,
right, apply h this,
left,rw compl_def,
exact set.mem_sep trivial this,
end

end AssertionLang

@[ext, derive decidable_eq]
structure Component (Var : Type) [fintype Var] [decidable_eq Var] :=
(ports : finset Var)

variables {Var : Type} [fintype Var] [decidable_eq Var]

@[reducible]
def Impl (Var : Type) [fintype Var] [decidable_eq Var] : Type := set (Trace Var)

@[reducible]
def Env (Var : Type) [fintype Var] [decidable_eq Var]: Type := set (Trace Var)

@[derive decidable_eq]
structure Contract (Φ : Type) (Var : Type)
[fintype Var] [decidable_eq Var] [AssertionLang Φ Var] :=
(A : Φ)
(G : Φ)

variables {Φ : Type} [fintype Var] [decidable_eq Var] [AssertionLang Φ Var]

instance : inhabited (Contract Φ Var) := ⟨{A := ⊤ , G := ⊤}⟩

namespace Contract
@[reducible]
def nf (C : Contract Φ Var) : Φ := AssertionLang.disj Var (AssertionLang.compl Var C.A) C.G
end Contract

theorem nf_def {C : Contract Φ Var} {x : Trace Var} : x ∈ (@AssertionLang.sem Φ Var _ _ _ C.nf) ↔
x ∈ (@AssertionLang.sem Φ Var _ _ _ C.A) → x ∈ (@AssertionLang.sem Φ Var _ _ _ C.G) :=
begin
rw AssertionLang.disj_def,
rw AssertionLang.compl_def,
rw imp_iff_not_or, simp,
end

structure ComponentWithContract (Φ : Type) (Var : Type)
[fintype Var] [decidable_eq Var] [AssertionLang Φ Var]
extends Component Var :=
(C : Contract Φ Var)

instance : has_coe (ComponentWithContract Φ Var) (Component Var) := ⟨λ C, {..C}⟩

namespace Impl

variables {S : Component Var}

def satisfiesContract (C : Contract Φ Var) : Impl Var → Prop :=
λ I, I ∩ (AssertionLang.sem C.A) ⊆ (AssertionLang.sem C.G)

end Impl

namespace Env

variables {S : Component Var}

def satisfiesContract (C : Contract Φ Var) : Env Var → Prop :=
λ En, En ⊆ (AssertionLang.sem C.A)

end Env

@[reducible]
def ImplC (S : ComponentWithContract Φ Var) : Type := set (Trace Var)

@[reducible]
def EnvC (S : ComponentWithContract Φ Var) : Type := set (Trace Var)

namespace ImplC

variables {S : ComponentWithContract Φ Var}

def toSet : ImplC S → set (Trace Var) := id

def satisfiesContract (C : Contract Φ Var) : ImplC S → Prop :=
λ I, (I.toSet) ∩ (AssertionLang.sem C.A) ⊆ (AssertionLang.sem C.G)

end ImplC

namespace EnvC

variables {S : ComponentWithContract Φ Var}

@[reducible, simp]
def toSet  : EnvC S → set (Trace Var) := id

instance : has_coe (set (Trace Var)) (EnvC S) := { coe := λ a, a}

def satisfiesContract (C : Contract Φ Var) : EnvC S → Prop :=
λ En, En.toSet ⊆ (AssertionLang.sem C.A)

end EnvC

namespace Contract

variables {S : Component Var} (C : Contract Φ Var)

def satisfyingImplentations : set (Impl Var) :=
{I | I.satisfiesContract C}

def satisfyingEnvironments : set (Env Var) :=
{E | E.satisfiesContract C}

end Contract

@[derive decidable_eq]
structure Architecture (S : Component Var) :=
(subs : list (Component Var))
(delegation : list (Var × Var))

variables {S : Component Var}

def Implementations (A : Architecture S) : Type :=
  Π (S' : Component Var) (h : S' ∈ A.subs), Impl Var

def CompositeImplementation
(A : Architecture S)
(Impls : Implementations A) : Impl Var
:= ⋂ (S' : Component Var) {S' ∈ A.subs} , Impls S' H

open list
def CompositeEnvironment
(A : Architecture S)
(U : Component Var)
(Impls : Implementations A)
(E : Env Var) : Env Var :=
E ∩ ⋂ (S' : Component Var) {S' ∈ A.subs.erase U}, Impls S' (mem_of_mem_erase H)


open classical

variables (α : Type) (p q : α → Prop)
variable a : α
variable r : Prop

-- This is required to add a to tactics
include a

example : (∃ x : α, r) → r :=
begin
  intros h,
  cases h,
  assumption
end
example : r → (∃ x : α, r) :=
begin
  intros,
  apply exists.intro,
  repeat { assumption }
end
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
begin
  apply iff.intro,
    intros,
    cases a_1 with x hpx,
    simp *,
    existsi x,
    simp *,
  intros,
  cases a_1.left with x hx,
  existsi x,
  simp *
end
example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
begin
  apply iff.intro,
    intros,
    cases a_1 with w hw,
    cases hw with h,
      left,
      existsi w,
      assumption,
    right,
    existsi w,
    assumption,
  intros,
  cases a_1 with hp hq,
    cases hp with w hw,
    existsi w,
    simp *,
  cases hq with w hw,
  existsi w,
  simp *
end

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
begin
  apply iff.intro,
    intros h hn,
    cases hn with w hw,
    simp * at *,
  intros,
  apply by_contradiction,
  intros,
  have : ∃ x, ¬ p x,
    apply exists.intro,
    apply a_2,
  contradiction
end
example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
begin
  apply iff.intro,
    intros h hn,
    simp * at *,
    cases h,
    contradiction,
  intros h,
  apply by_contradiction,
  intros hn,
  have : ∀ x, ¬ p x,
    intros y,
    apply not.intro,
    intros hy,
    have : ∃ x, p x,
      apply exists.intro,
      assumption,
    contradiction,
  contradiction
end
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
begin
  apply iff.intro,
    intros h x hp,
    have : ∃ x, p x,
      apply exists.intro,
      assumption,
    contradiction,
  intros h hp,
  cases hp with x hx,
  simp * at *
end
example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
begin
  apply iff.intro,
    intros h,
    apply by_contradiction,
    intros hn,
    have : ∀ x, p x,
      intros y,
      apply by_contradiction,
      intro hny,
      have : ∃ x, ¬ p x,
        apply exists.intro,
        assumption,
      contradiction,
    contradiction,
  intros h hn,
  cases h with w hw,
  simp * at *
end

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
begin
  apply iff.intro,
    intros h1 h2,
    cases h2 with w hw,
    apply h1,
    exact hw,
  intros h x hx,
  apply h,
  existsi x,
  assumption
end
example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
begin
  apply iff.intro,
    intros h1 h2,
    cases h1 with w hw,
    apply hw,
    simp [h2],
  intros h,
  apply by_cases,
    intros h1,
    have : r,
      apply h,
      assumption,
    existsi a,
    simp [h1 a, this],
  intros h1,
  have : ∃ x, ¬ p x,
    apply by_contradiction,
    intros h2,
    have : ∀ x, p x,
      intros,
        intros,
        apply by_contradiction,
        intro h3,
        have : ∃ x, ¬ p x,
          apply exists.intro,
          assumption,
        contradiction,
      intros,
      apply by_contradiction,
      intro h3,
      contradiction,
  cases this with w hw,
  existsi w,
  simp * at *,
end
example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
begin
  apply iff.intro,
    intros h hr,
    simp [hr] at h,
    assumption,
  intros h,
  apply by_cases,
    intros hr,
    have hp : ∃ x, p x,
      apply h,
      assumption,
    cases hp with w hw,
    apply exists.intro,
    intros,
    exact hw,
  intros hnr,
  simp * at *,
  existsi a,
  assumption
end


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

A model of ZFC in Lean.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.basic
import Mathlib.PostPort

universes u u_1 l u_2 u_3 v

namespace Mathlib

/-- The type of `n`-ary functions `α → α → ... → α`. -/
def arity (α : Type u) : ℕ → Type u := sorry

namespace arity

/-- Constant `n`-ary function with value `a`. -/
def const {α : Type u} (a : α) (n : ℕ) : arity α n := sorry

protected instance arity.inhabited {α : Type u_1} {n : ℕ} [Inhabited α] : Inhabited (arity α n) :=
  { default := const Inhabited.default n }

end arity

/-- The type of pre-sets in universe `u`. A pre-set
  is a family of pre-sets indexed by a type in `Type u`.
  The ZFC universe is defined as a quotient of this
  to ensure extensionality. -/
inductive pSet where
| mk : (α : Type u) → (α → pSet) → pSet

namespace pSet

/-- The underlying type of a pre-set -/
def type : pSet → Type u := sorry

/-- The underlying pre-set family of a pre-set -/
def func (x : pSet) : type x → pSet := sorry

theorem mk_type_func (x : pSet) : mk (type x) (func x) = x :=
  pSet.cases_on x
    fun (x_α : Type u_1) (x_A : x_α → pSet) =>
      idRhs
        (mk (type (mk x_α x_A)) (func (mk x_α x_A)) = mk (type (mk x_α x_A)) (func (mk x_α x_A)))
        rfl

/-- Two pre-sets are extensionally equivalent if every
  element of the first family is extensionally equivalent to
  some element of the second family and vice-versa. -/
def equiv (x : pSet) (y : pSet) :=
  pSet.rec (fun (α : Type u_1) (z : α → pSet) (m : α → pSet → Prop) (_x : pSet) => sorry) x y

theorem equiv.refl (x : pSet) : equiv x x :=
  pSet.rec_on x
    fun (α : Type u_1) (A : α → pSet) (IH : ∀ (ᾰ : α), equiv (A ᾰ) (A ᾰ)) =>
      { left := fun (a : α) => Exists.intro a (IH a),
        right := fun (a : α) => Exists.intro a (IH a) }

theorem equiv.euc {x : pSet} {y : pSet} {z : pSet} : equiv x y → equiv z y → equiv x z := sorry

theorem equiv.symm {x : pSet} {y : pSet} : equiv x y → equiv y x := equiv.euc (equiv.refl y)

theorem equiv.trans {x : pSet} {y : pSet} {z : pSet} (h1 : equiv x y) (h2 : equiv y z) :
    equiv x z :=
  equiv.euc h1 (equiv.symm h2)

protected instance setoid : setoid pSet := setoid.mk equiv sorry

protected def subset : pSet → pSet → Prop := sorry

protected instance has_subset : has_subset pSet := has_subset.mk pSet.subset

theorem equiv.ext (x : pSet) (y : pSet) : equiv x y ↔ x ⊆ y ∧ y ⊆ x := sorry

theorem subset.congr_left {x : pSet} {y : pSet} {z : pSet} : equiv x y → (x ⊆ z ↔ y ⊆ z) := sorry

theorem subset.congr_right {x : pSet} {y : pSet} {z : pSet} : equiv x y → (z ⊆ x ↔ z ⊆ y) := sorry

/-- `x ∈ y` as pre-sets if `x` is extensionally equivalent to a member
  of the family `y`. -/
def mem : pSet → pSet → Prop := sorry

protected instance has_mem : has_mem pSet pSet := has_mem.mk mem

theorem mem.mk {α : Type u} (A : α → pSet) (a : α) : A a ∈ mk α A :=
  (fun (this : mem (A a) (mk α A)) => this) (Exists.intro a (equiv.refl (A a)))

theorem mem.ext {x : pSet} {y : pSet} : (∀ (w : pSet), w ∈ x ↔ w ∈ y) → equiv x y := sorry

theorem mem.congr_right {x : pSet} {y : pSet} : equiv x y → ∀ {w : pSet}, w ∈ x ↔ w ∈ y := sorry

theorem equiv_iff_mem {x : pSet} {y : pSet} : equiv x y ↔ ∀ {w : pSet}, w ∈ x ↔ w ∈ y := sorry

theorem mem.congr_left {x : pSet} {y : pSet} : equiv x y → ∀ {w : pSet}, x ∈ w ↔ y ∈ w := sorry

/-- Convert a pre-set to a `set` of pre-sets. -/
def to_set (u : pSet) : set pSet := set_of fun (x : pSet) => x ∈ u

/-- Two pre-sets are equivalent iff they have the same members. -/
theorem equiv.eq {x : pSet} {y : pSet} : equiv x y ↔ to_set x = to_set y :=
  iff.trans equiv_iff_mem (iff.symm set.ext_iff)

protected instance set.has_coe : has_coe pSet (set pSet) := has_coe.mk to_set

/-- The empty pre-set -/
protected def empty : pSet := mk (ulift empty) fun (e : ulift empty) => sorry

protected instance has_emptyc : has_emptyc pSet := has_emptyc.mk pSet.empty

protected instance inhabited : Inhabited pSet := { default := ∅ }

theorem mem_empty (x : pSet) : ¬x ∈ ∅ := sorry

/-- Insert an element into a pre-set -/
protected def insert : pSet → pSet → pSet := sorry

protected instance has_insert : has_insert pSet pSet := has_insert.mk pSet.insert

protected instance has_singleton : has_singleton pSet pSet :=
  has_singleton.mk fun (s : pSet) => insert s ∅

protected instance is_lawful_singleton : is_lawful_singleton pSet pSet :=
  is_lawful_singleton.mk fun (_x : pSet) => rfl

/-- The n-th von Neumann ordinal -/
def of_nat : ℕ → pSet := sorry

/-- The von Neumann ordinal ω -/
def omega : pSet := mk (ulift ℕ) fun (n : ulift ℕ) => of_nat (ulift.down n)

/-- The separation operation `{x ∈ a | p x}` -/
protected def sep (p : set pSet) : pSet → pSet := sorry

protected instance has_sep : has_sep pSet pSet := has_sep.mk pSet.sep

/-- The powerset operator -/
def powerset : pSet → pSet := sorry

theorem mem_powerset {x : pSet} {y : pSet} : y ∈ powerset x ↔ y ⊆ x := sorry

/-- The set union operator -/
def Union : pSet → pSet := sorry

theorem mem_Union {x : pSet} {y : pSet} : y ∈ Union x ↔ ∃ (z : pSet), ∃ (_x : z ∈ x), y ∈ z := sorry

/-- The image of a function -/
def image (f : pSet → pSet) : pSet → pSet := sorry

theorem mem_image {f : pSet → pSet} (H : ∀ {x y : pSet}, equiv x y → equiv (f x) (f y)) {x : pSet}
    {y : pSet} : y ∈ image f x ↔ ∃ (z : pSet), ∃ (H : z ∈ x), equiv y (f z) :=
  sorry

/-- Universe lift operation -/
protected def lift : pSet → pSet := sorry

/-- Embedding of one universe in another -/
def embed : pSet := mk (ulift pSet) fun (_x : ulift pSet) => sorry

theorem lift_mem_embed (x : pSet) : pSet.lift x ∈ embed :=
  Exists.intro (ulift.up x) (equiv.refl (pSet.lift x))

/-- Function equivalence is defined so that `f ~ g` iff
  `∀ x y, x ~ y → f x ~ g y`. This extends to equivalence of n-ary
  functions. -/
def arity.equiv {n : ℕ} : arity pSet n → arity pSet n → Prop := sorry

theorem arity.equiv_const {a : pSet} (n : ℕ) : arity.equiv (arity.const a n) (arity.const a n) :=
  sorry

/-- `resp n` is the collection of n-ary functions on `pSet` that respect
  equivalence, i.e. when the inputs are equivalent the output is as well. -/
def resp (n : ℕ) := Subtype fun (x : arity pSet n) => arity.equiv x x

protected instance resp.inhabited {n : ℕ} : Inhabited (resp n) :=
  { default := { val := arity.const Inhabited.default n, property := sorry } }

def resp.f {n : ℕ} (f : resp (n + 1)) (x : pSet) : resp n :=
  { val := subtype.val f x, property := sorry }

def resp.equiv {n : ℕ} (a : resp n) (b : resp n) := arity.equiv (subtype.val a) (subtype.val b)

theorem resp.refl {n : ℕ} (a : resp n) : resp.equiv a a := subtype.property a

theorem resp.euc {n : ℕ} {a : resp n} {b : resp n} {c : resp n} :
    resp.equiv a b → resp.equiv c b → resp.equiv a c :=
  sorry

protected instance resp.setoid {n : ℕ} : setoid (resp n) := setoid.mk resp.equiv sorry

end pSet

/-- The ZFC universe of sets consists of the type of pre-sets,
  quotiented by extensional equivalence. -/
def Set := quotient pSet.setoid

namespace pSet

namespace resp

def eval_aux {n : ℕ} :
    Subtype fun (f : resp n → arity Set n) => ∀ (a b : resp n), equiv a b → f a = f b :=
  sorry

/-- An equivalence-respecting function yields an n-ary Set function. -/
def eval (n : ℕ) : resp n → arity Set n := subtype.val eval_aux

theorem eval_val {n : ℕ} {f : resp (n + 1)} {x : pSet} :
    eval (n + 1) f (quotient.mk x) = eval n (f f x) :=
  rfl

end resp

/-- A set function is "definable" if it is the image of some n-ary pre-set
  function. This isn't exactly definability, but is useful as a sufficient
  condition for functions that have a computable image. -/
class inductive definable (n : ℕ) : arity Set n → Type (u + 1) where
| mk : (f : resp n) → definable n (resp.eval n f)

def definable.eq_mk {n : ℕ} (f : resp n) {s : arity Set n} (H : resp.eval n f = s) :
    definable n s :=
  sorry

def definable.resp {n : ℕ} (s : arity Set n) [definable n s] : resp n := sorry

theorem definable.eq {n : ℕ} (s : arity Set n) [H : definable n s] :
    resp.eval n (definable.resp s) = s :=
  sorry

end pSet

namespace classical

def all_definable {n : ℕ} (F : arity Set n) : pSet.definable n F := sorry

end classical

namespace Set

def mk : pSet → Set := quotient.mk

@[simp] theorem mk_eq (x : pSet) : quotient.mk x = mk x := rfl

@[simp] theorem eval_mk {n : ℕ} {f : pSet.resp (n + 1)} {x : pSet} :
    pSet.resp.eval (n + 1) f (mk x) = pSet.resp.eval n (pSet.resp.f f x) :=
  rfl

def mem : Set → Set → Prop := quotient.lift₂ pSet.mem sorry

protected instance has_mem : has_mem Set Set := has_mem.mk mem

/-- Convert a ZFC set into a `set` of sets -/
def to_set (u : Set) : set Set := set_of fun (x : Set) => x ∈ u

protected def subset (x : Set) (y : Set) := ∀ {z : Set}, z ∈ x → z ∈ y

protected instance has_subset : has_subset Set := has_subset.mk Set.subset

theorem subset_def {x : Set} {y : Set} : x ⊆ y ↔ ∀ {z : Set}, z ∈ x → z ∈ y := iff.rfl

theorem subset_iff (x : pSet) (y : pSet) : mk x ⊆ mk y ↔ x ⊆ y := sorry

theorem ext {x : Set} {y : Set} : (∀ (z : Set), z ∈ x ↔ z ∈ y) → x = y :=
  quotient.induction_on₂ x y
    fun (u v : pSet) (h : ∀ (z : Set), z ∈ quotient.mk u ↔ z ∈ quotient.mk v) =>
      quotient.sound (pSet.mem.ext fun (w : pSet) => h (quotient.mk w))

theorem ext_iff {x : Set} {y : Set} : (∀ (z : Set), z ∈ x ↔ z ∈ y) ↔ x = y := sorry

/-- The empty set -/
def empty : Set := mk ∅

protected instance has_emptyc : has_emptyc Set := has_emptyc.mk empty

protected instance inhabited : Inhabited Set := { default := ∅ }

@[simp] theorem mem_empty (x : Set) : ¬x ∈ ∅ := quotient.induction_on x pSet.mem_empty

theorem eq_empty (x : Set) : x = ∅ ↔ ∀ (y : Set), ¬y ∈ x := sorry

/-- `insert x y` is the set `{x} ∪ y` -/
protected def insert : Set → Set → Set :=
  pSet.resp.eval (bit0 1) { val := pSet.insert, property := sorry }

protected instance has_insert : has_insert Set Set := has_insert.mk Set.insert

protected instance has_singleton : has_singleton Set Set :=
  has_singleton.mk fun (x : Set) => insert x ∅

protected instance is_lawful_singleton : is_lawful_singleton Set Set :=
  is_lawful_singleton.mk fun (x : Set) => rfl

@[simp] theorem mem_insert {x : Set} {y : Set} {z : Set} : x ∈ insert y z ↔ x = y ∨ x ∈ z := sorry

@[simp] theorem mem_singleton {x : Set} {y : Set} : x ∈ singleton y ↔ x = y :=
  iff.trans mem_insert
    { mp :=
        fun (o : x = y ∨ x ∈ ∅) =>
          Or._oldrec (fun (h : x = y) => h) (fun (n : x ∈ ∅) => absurd n (mem_empty x)) o,
      mpr := Or.inl }

@[simp] theorem mem_pair {x : Set} {y : Set} {z : Set} :
    x ∈ insert y (singleton z) ↔ x = y ∨ x = z :=
  iff.trans mem_insert (or_congr iff.rfl mem_singleton)

/-- `omega` is the first infinite von Neumann ordinal -/
def omega : Set := mk pSet.omega

@[simp] theorem omega_zero : ∅ ∈ omega :=
  (fun (this : pSet.mem ∅ pSet.omega) => this) (Exists.intro (ulift.up 0) (pSet.equiv.refl ∅))

@[simp] theorem omega_succ {n : Set} : n ∈ omega → insert n n ∈ omega := sorry

/-- `{x ∈ a | p x}` is the set of elements in `a` satisfying `p` -/
protected def sep (p : Set → Prop) : Set → Set :=
  pSet.resp.eval 1 { val := pSet.sep fun (y : pSet) => p (quotient.mk y), property := sorry }

protected instance has_sep : has_sep Set Set := has_sep.mk Set.sep

@[simp] theorem mem_sep {p : Set → Prop} {x : Set} {y : Set} :
    y ∈ has_sep.sep (fun (y : Set) => p y) x ↔ y ∈ x ∧ p y :=
  sorry

/-- The powerset operation, the collection of subsets of a set -/
def powerset : Set → Set := pSet.resp.eval 1 { val := pSet.powerset, property := sorry }

@[simp] theorem mem_powerset {x : Set} {y : Set} : y ∈ powerset x ↔ y ⊆ x := sorry

theorem Union_lem {α : Type u} {β : Type u} (A : α → pSet) (B : β → pSet)
    (αβ : ∀ (a : α), ∃ (b : β), pSet.equiv (A a) (B b)) (a : pSet.type (pSet.Union (pSet.mk α A))) :
    ∃ (b : pSet.type (pSet.Union (pSet.mk β B))),
        pSet.equiv (pSet.func (pSet.Union (pSet.mk α A)) a)
          (pSet.func (pSet.Union (pSet.mk β B)) b) :=
  sorry

/-- The union operator, the collection of elements of elements of a set -/
def Union : Set → Set := pSet.resp.eval 1 { val := pSet.Union, property := sorry }

notation:1024 "⋃" => Mathlib.Set.Union

@[simp] theorem mem_Union {x : Set} {y : Set} : y ∈ ⋃ ↔ ∃ (z : Set), ∃ (H : z ∈ x), y ∈ z := sorry

@[simp] theorem Union_singleton {x : Set} : ⋃ = x := sorry

theorem singleton_inj {x : Set} {y : Set} (H : singleton x = singleton y) : x = y :=
  let this : ⋃ = ⋃ := congr_arg ⋃ H;
  eq.mp (Eq._oldrec (Eq.refl (x = ⋃)) Union_singleton)
    (eq.mp (Eq._oldrec (Eq.refl (⋃ = ⋃)) Union_singleton) this)

/-- The binary union operation -/
protected def union (x : Set) (y : Set) : Set := ⋃

/-- The binary intersection operation -/
protected def inter (x : Set) (y : Set) : Set := has_sep.sep (fun (z : Set) => z ∈ y) x

/-- The set difference operation -/
protected def diff (x : Set) (y : Set) : Set := has_sep.sep (fun (z : Set) => ¬z ∈ y) x

protected instance has_union : has_union Set := has_union.mk Set.union

protected instance has_inter : has_inter Set := has_inter.mk Set.inter

protected instance has_sdiff : has_sdiff Set := has_sdiff.mk Set.diff

@[simp] theorem mem_union {x : Set} {y : Set} {z : Set} : z ∈ x ∪ y ↔ z ∈ x ∨ z ∈ y := sorry

@[simp] theorem mem_inter {x : Set} {y : Set} {z : Set} : z ∈ x ∩ y ↔ z ∈ x ∧ z ∈ y := mem_sep

@[simp] theorem mem_diff {x : Set} {y : Set} {z : Set} : z ∈ x \ y ↔ z ∈ x ∧ ¬z ∈ y := mem_sep

theorem induction_on {p : Set → Prop} (x : Set)
    (h : ∀ (x : Set), (∀ (y : Set), y ∈ x → p y) → p x) : p x :=
  sorry

theorem regularity (x : Set) (h : x ≠ ∅) : ∃ (y : Set), ∃ (H : y ∈ x), x ∩ y = ∅ := sorry

/-- The image of a (definable) set function -/
def image (f : Set → Set) [H : pSet.definable 1 f] : Set → Set :=
  let r : pSet.resp 1 := pSet.definable.resp f;
  pSet.resp.eval 1 { val := pSet.image (subtype.val r), property := sorry }

theorem image.mk (f : Set → Set) [H : pSet.definable 1 f] (x : Set) {y : Set} (h : y ∈ x) :
    f y ∈ image f x :=
  sorry

@[simp] theorem mem_image {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} :
    y ∈ image f x ↔ ∃ (z : Set), ∃ (H : z ∈ x), f z = y :=
  sorry

/-- Kuratowski ordered pair -/
def pair (x : Set) (y : Set) : Set := insert (singleton x) (singleton (insert x (singleton y)))

/-- A subset of pairs `{(a, b) ∈ x × y | p a b}` -/
def pair_sep (p : Set → Set → Prop) (x : Set) (y : Set) : Set :=
  has_sep.sep
    (fun (z : Set) => ∃ (a : Set), ∃ (H : a ∈ x), ∃ (b : Set), ∃ (H : b ∈ y), z = pair a b ∧ p a b)
    (powerset (powerset (x ∪ y)))

@[simp] theorem mem_pair_sep {p : Set → Set → Prop} {x : Set} {y : Set} {z : Set} :
    z ∈ pair_sep p x y ↔
        ∃ (a : Set), ∃ (H : a ∈ x), ∃ (b : Set), ∃ (H : b ∈ y), z = pair a b ∧ p a b :=
  sorry

theorem pair_inj {x : Set} {y : Set} {x' : Set} {y' : Set} (H : pair x y = pair x' y') :
    x = x' ∧ y = y' :=
  sorry

/-- The cartesian product, `{(a, b) | a ∈ x, b ∈ y}` -/
def prod : Set → Set → Set := pair_sep fun (a b : Set) => True

@[simp] theorem mem_prod {x : Set} {y : Set} {z : Set} :
    z ∈ prod x y ↔ ∃ (a : Set), ∃ (H : a ∈ x), ∃ (b : Set), ∃ (H : b ∈ y), z = pair a b :=
  sorry

@[simp] theorem pair_mem_prod {x : Set} {y : Set} {a : Set} {b : Set} :
    pair a b ∈ prod x y ↔ a ∈ x ∧ b ∈ y :=
  sorry

/-- `is_func x y f` is the assertion `f : x → y` where `f` is a ZFC function
  (a set of ordered pairs) -/
def is_func (x : Set) (y : Set) (f : Set) :=
  f ⊆ prod x y ∧ ∀ (z : Set), z ∈ x → exists_unique fun (w : Set) => pair z w ∈ f

/-- `funs x y` is `y ^ x`, the set of all set functions `x → y` -/
def funs (x : Set) (y : Set) : Set :=
  has_sep.sep (fun (f : Set) => is_func x y f) (powerset (prod x y))

@[simp] theorem mem_funs {x : Set} {y : Set} {f : Set} : f ∈ funs x y ↔ is_func x y f := sorry

-- TODO(Mario): Prove this computably

protected instance map_definable_aux (f : Set → Set) [H : pSet.definable 1 f] :
    pSet.definable 1 fun (y : Set) => pair y (f y) :=
  classical.all_definable fun (y : Set) => pair y (f y)

/-- Graph of a function: `map f x` is the ZFC function which maps `a ∈ x` to `f a` -/
def map (f : Set → Set) [H : pSet.definable 1 f] : Set → Set := image fun (y : Set) => pair y (f y)

@[simp] theorem mem_map {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} :
    y ∈ map f x ↔ ∃ (z : Set), ∃ (H : z ∈ x), pair z (f z) = y :=
  mem_image

theorem map_unique {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {z : Set} (zx : z ∈ x) :
    exists_unique fun (w : Set) => pair z w ∈ map f x :=
  sorry

@[simp] theorem map_is_func {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} :
    is_func x y (map f x) ↔ ∀ (z : Set), z ∈ x → f z ∈ y :=
  sorry

end Set

def Class := set Set

namespace Class

protected instance has_subset : has_subset Class := has_subset.mk set.subset

protected instance has_sep : has_sep Set Class := has_sep.mk set.sep

protected instance has_emptyc : has_emptyc Class := has_emptyc.mk fun (a : Set) => False

protected instance inhabited : Inhabited Class := { default := ∅ }

protected instance has_insert : has_insert Set Class := has_insert.mk set.insert

protected instance has_union : has_union Class := has_union.mk set.union

protected instance has_inter : has_inter Class := has_inter.mk set.inter

protected instance has_neg : Neg Class := { neg := set.compl }

protected instance has_sdiff : has_sdiff Class := has_sdiff.mk set.diff

/-- Coerce a set into a class -/
def of_Set (x : Set) : Class := set_of fun (y : Set) => y ∈ x

protected instance has_coe : has_coe Set Class := has_coe.mk of_Set

/-- The universal class -/
def univ : Class := set.univ

/-- Assert that `A` is a set satisfying `p` -/
def to_Set (p : Set → Prop) (A : Class) := ∃ (x : Set), ↑x = A ∧ p x

/-- `A ∈ B` if `A` is a set which is a member of `B` -/
protected def mem (A : Class) (B : Class) := to_Set B A

protected instance has_mem : has_mem Class Class := has_mem.mk Class.mem

theorem mem_univ {A : Class} : A ∈ univ ↔ ∃ (x : Set), ↑x = A :=
  exists_congr fun (x : Set) => and_true (↑x = A)

/-- Convert a conglomerate (a collection of classes) into a class -/
def Cong_to_Class (x : set Class) : Class := set_of fun (y : Set) => ↑y ∈ x

/-- Convert a class into a conglomerate (a collection of classes) -/
def Class_to_Cong (x : Class) : set Class := set_of fun (y : Class) => y ∈ x

/-- The power class of a class is the class of all subclasses that are sets -/
def powerset (x : Class) : Class := Cong_to_Class (𝒫 x)

/-- The union of a class is the class of all members of sets in the class -/
def Union (x : Class) : Class := ⋃₀Class_to_Cong x

notation:1024 "⋃" => Mathlib.Class.Union

theorem of_Set.inj {x : Set} {y : Set} (h : ↑x = ↑y) : x = y := sorry

@[simp] theorem to_Set_of_Set (p : Set → Prop) (x : Set) : to_Set p ↑x ↔ p x := sorry

@[simp] theorem mem_hom_left (x : Set) (A : Class) : ↑x ∈ A ↔ A x :=
  to_Set_of_Set (fun (x : Set) => A x) x

@[simp] theorem mem_hom_right (x : Set) (y : Set) : coe y x ↔ x ∈ y := iff.rfl

@[simp] theorem subset_hom (x : Set) (y : Set) : ↑x ⊆ ↑y ↔ x ⊆ y := iff.rfl

@[simp] theorem sep_hom (p : Set → Prop) (x : Set) :
    ↑(has_sep.sep (fun (y : Set) => p y) x) = has_sep.sep (fun (y : Set) => p y) ↑x :=
  set.ext fun (y : Set) => Set.mem_sep

@[simp] theorem empty_hom : ↑∅ = ∅ :=
  set.ext
    fun (y : Set) =>
      (fun (this : y ∈ ↑∅ ↔ False) => this)
        (eq.mpr (id (propext (iff_false (y ∈ ↑∅)))) (Set.mem_empty y))

@[simp] theorem insert_hom (x : Set) (y : Set) : insert x ↑y = ↑(insert x y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_insert

@[simp] theorem union_hom (x : Set) (y : Set) : ↑x ∪ ↑y = ↑(x ∪ y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_union

@[simp] theorem inter_hom (x : Set) (y : Set) : ↑x ∩ ↑y = ↑(x ∩ y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_inter

@[simp] theorem diff_hom (x : Set) (y : Set) : ↑x \ ↑y = ↑(x \ y) :=
  set.ext fun (z : Set) => iff.symm Set.mem_diff

@[simp] theorem powerset_hom (x : Set) : powerset ↑x = ↑(Set.powerset x) :=
  set.ext fun (z : Set) => iff.symm Set.mem_powerset

@[simp] theorem Union_hom (x : Set) : ⋃ = ↑⋃ := sorry

/-- The definite description operator, which is {x} if `{a | p a} = {x}`
  and ∅ otherwise -/
def iota (p : Set → Prop) : Class := ⋃

theorem iota_val (p : Set → Prop) (x : Set) (H : ∀ (y : Set), p y ↔ y = x) : iota p = ↑x := sorry

/-- Unlike the other set constructors, the `iota` definite descriptor
  is a set for any set input, but not constructively so, so there is no
  associated `(Set → Prop) → Set` function. -/
theorem iota_ex (p : Set → Prop) : iota p ∈ univ := sorry

/-- Function value -/
def fval (F : Class) (A : Class) : Class :=
  iota fun (y : Set) => to_Set (fun (x : Set) => F (Set.pair x y)) A

infixl:100 "′" => Mathlib.Class.fval

theorem fval_ex (F : Class) (A : Class) : F′A ∈ univ :=
  iota_ex fun (y : Set) => to_Set (fun (x : Set) => F (Set.pair x y)) A

end Class

namespace Set

@[simp] theorem map_fval {f : Set → Set} [H : pSet.definable 1 f] {x : Set} {y : Set} (h : y ∈ x) :
    ↑(map f x)′↑y = ↑(f y) :=
  sorry

/-- A choice function on the set of nonempty sets `x` -/
def choice (x : Set) : Set := map (fun (y : Set) => classical.epsilon fun (z : Set) => z ∈ y) x

theorem choice_mem_aux (x : Set) (h : ¬∅ ∈ x) (y : Set) (yx : y ∈ x) :
    (classical.epsilon fun (z : Set) => z ∈ y) ∈ y :=
  sorry

theorem choice_is_func (x : Set) (h : ¬∅ ∈ x) : is_func x ⋃ (choice x) := sorry

theorem choice_mem (x : Set) (h : ¬∅ ∈ x) (y : Set) (yx : y ∈ x) : ↑(choice x)′↑y ∈ ↑y := sorry

end Mathlib


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.concrete_category.default
import Mathlib.category_theory.discrete_category
import Mathlib.category_theory.eq_to_hom
import Mathlib.PostPort

universes v u u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Category of categories

This file contains the definition of the category `Cat` of all categories.
In this category objects are categories and
morphisms are functors between these categories.

## Implementation notes

Though `Cat` is not a concrete category, we use `bundled` to define
its carrier type.
-/

namespace category_theory

/-- Category of categories. -/
def Cat := bundled category

namespace Cat

protected instance inhabited : Inhabited Cat := { default := bundled.mk (Type u) }

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

protected instance str (C : Cat) : category ↥C := bundled.str C

/-- Construct a bundled `Cat` from the underlying type and the typeclass. -/
def of (C : Type u) [category C] : Cat := bundled.of C

/-- Category structure on `Cat` -/
protected instance category : large_category Cat := category.mk

/-- Functor that gets the set of objects of a category. It is not
called `forget`, because it is not a faithful functor. -/
def objects : Cat ⥤ Type u :=
  functor.mk (fun (C : Cat) => ↥C) fun (C D : Cat) (F : C ⟶ D) => functor.obj F

/-- Any isomorphism in `Cat` induces an equivalence of the underlying categories. -/
def equiv_of_iso {C : Cat} {D : Cat} (γ : C ≅ D) : ↥C ≌ ↥D :=
  equivalence.mk' (iso.hom γ) (iso.inv γ) (eq_to_iso sorry) (eq_to_iso (iso.inv_hom_id γ))

end Cat

/--
Embedding `Type` into `Cat` as discrete categories.

This ought to be modelled as a 2-functor!
-/
@[simp] theorem Type_to_Cat_obj (X : Type u) : functor.obj Type_to_Cat X = Cat.of (discrete X) :=
  Eq.refl (functor.obj Type_to_Cat X)

protected instance Type_to_Cat.faithful : faithful Type_to_Cat := faithful.mk

protected instance Type_to_Cat.full : full Type_to_Cat :=
  full.mk
    fun (X Y : Type (max (max (max u_1 u_2 u_3 u_4) u_1 u_2 u_3) (max u_1 u_2 u_3 u_4) u_1 u_2))
      (F : functor.obj Type_to_Cat X ⟶ functor.obj Type_to_Cat Y) => functor.obj F

end Mathlib


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import algebraic_geometry.morphisms.ring_hom_properties
import ring_theory.ring_hom.finite_type

/-!
# Morphisms of finite type

A morphism of schemes `f : X ⟶ Y` is locally of finite type if for each affine `U ⊆ Y` and
`V ⊆ f ⁻¹' U`, The induced map `Γ(Y, U) ⟶ Γ(X, V)` is of finite type.

A morphism of schemes is of finite type if it is both locally of finite type and quasi-compact.

We show that these properties are local, and are stable under compositions.

-/

noncomputable theory

open category_theory category_theory.limits opposite topological_space

universes v u

namespace algebraic_geometry

variables {X Y : Scheme.{u}} (f : X ⟶ Y)

/--
A morphism of schemes `f : X ⟶ Y` is locally of finite type if for each affine `U ⊆ Y` and
`V ⊆ f ⁻¹' U`, The induced map `Γ(Y, U) ⟶ Γ(X, V)` is of finite type.
-/
@[mk_iff]
class locally_of_finite_type (f : X ⟶ Y) : Prop :=
(finite_type_of_affine_subset :
  ∀ (U : Y.affine_opens) (V : X.affine_opens) (e : V.1 ≤ (opens.map f.1.base).obj U.1),
  (f.app_le e).finite_type)

lemma locally_of_finite_type_eq :
  @locally_of_finite_type = affine_locally @ring_hom.finite_type :=
begin
  ext X Y f,
  rw [locally_of_finite_type_iff, affine_locally_iff_affine_opens_le],
  exact ring_hom.finite_type_respects_iso
end

@[priority 900]
instance locally_of_finite_type_of_is_open_immersion {X Y : Scheme} (f : X ⟶ Y)
  [is_open_immersion f] : locally_of_finite_type f :=
locally_of_finite_type_eq.symm ▸ ring_hom.finite_type_is_local.affine_locally_of_is_open_immersion f

lemma locally_of_finite_type_stable_under_composition :
  morphism_property.stable_under_composition @locally_of_finite_type :=
locally_of_finite_type_eq.symm ▸
ring_hom.finite_type_is_local.affine_locally_stable_under_composition

instance locally_of_finite_type_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
  [hf : locally_of_finite_type f] [hg : locally_of_finite_type g] :
  locally_of_finite_type (f ≫ g) :=
locally_of_finite_type_stable_under_composition f g hf hg

lemma locally_of_finite_type_of_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
  [hf : locally_of_finite_type (f ≫ g)] :
  locally_of_finite_type f :=
begin
  unfreezingI { revert hf },
  rw [locally_of_finite_type_eq],
  apply ring_hom.finite_type_is_local.affine_locally_of_comp,
  introv H,
  exactI ring_hom.finite_type.of_comp_finite_type H,
end

lemma locally_of_finite_type.affine_open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y)
  (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)]
  (𝒰' : ∀ i, Scheme.open_cover.{u} ((𝒰.pullback_cover f).obj i))
  [∀ i j, is_affine ((𝒰' i).obj j)] :
  locally_of_finite_type f ↔
    (∀ i j, (Scheme.Γ.map ((𝒰' i).map j ≫ pullback.snd).op).finite_type) :=
locally_of_finite_type_eq.symm ▸ ring_hom.finite_type_is_local.affine_open_cover_iff f 𝒰 𝒰'

lemma locally_of_finite_type.source_open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y)
  (𝒰 : Scheme.open_cover.{u} X) :
  locally_of_finite_type f ↔ (∀ i, locally_of_finite_type (𝒰.map i ≫ f)) :=
locally_of_finite_type_eq.symm ▸ ring_hom.finite_type_is_local.source_open_cover_iff f 𝒰

lemma locally_of_finite_type.open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y)
  (𝒰 : Scheme.open_cover.{u} Y) :
  locally_of_finite_type f ↔
    (∀ i, locally_of_finite_type (pullback.snd : pullback f (𝒰.map i) ⟶ _)) :=
locally_of_finite_type_eq.symm ▸
  ring_hom.finite_type_is_local.is_local_affine_locally.open_cover_iff f 𝒰

lemma locally_of_finite_type_respects_iso :
  morphism_property.respects_iso @locally_of_finite_type :=
locally_of_finite_type_eq.symm ▸ target_affine_locally_respects_iso
  (source_affine_locally_respects_iso ring_hom.finite_type_respects_iso)

end algebraic_geometry


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.Mon.basic
import Mathlib.category_theory.endomorphism
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Category instances for group, add_group, comm_group, and add_comm_group.

We introduce the bundled categories:
* `Group`
* `AddGroup`
* `CommGroup`
* `AddCommGroup`
along with the relevant forgetful functors between them, and to the bundled monoid categories.
-/

/-- The category of groups and group morphisms. -/
def AddGroup :=
  category_theory.bundled add_group

/-- The category of additive groups and group morphisms -/
namespace Group

protected instance Mathlib.AddGroup.group.to_monoid.category_theory.bundled_hom.parent_projection : category_theory.bundled_hom.parent_projection add_group.to_add_monoid :=
  category_theory.bundled_hom.parent_projection.mk

protected instance has_coe_to_sort : has_coe_to_sort Group :=
  category_theory.bundled.has_coe_to_sort

/-- Construct a bundled `Group` from the underlying type and typeclass. -/
def of (X : Type u) [group X] : Group :=
  category_theory.bundled.of X

/-- Construct a bundled `AddGroup` from the underlying type and typeclass. -/
protected instance group (G : Group) : group ↥G :=
  category_theory.bundled.str G

@[simp] theorem coe_of (R : Type u) [group R] : ↥(of R) = R :=
  rfl

protected instance Mathlib.AddGroup.has_zero : HasZero AddGroup :=
  { zero := AddGroup.of PUnit }

protected instance inhabited : Inhabited Group :=
  { default := 1 }

protected instance one.unique : unique ↥1 :=
  unique.mk { default := 1 } sorry

@[simp] theorem one_apply (G : Group) (H : Group) (g : ↥G) : coe_fn 1 g = 1 :=
  rfl

theorem ext (G : Group) (H : Group) (f₁ : G ⟶ H) (f₂ : G ⟶ H) (w : ∀ (x : ↥G), coe_fn f₁ x = coe_fn f₂ x) : f₁ = f₂ :=
  monoid_hom.ext fun (x : ↥G) => w x

-- should to_additive do this automatically?

protected instance Mathlib.AddGroup.has_forget_to_AddMon : category_theory.has_forget₂ AddGroup AddMon :=
  category_theory.bundled_hom.forget₂ add_monoid_hom add_group.to_add_monoid

end Group

/-- The category of commutative groups and group morphisms. -/
def AddCommGroup :=
  category_theory.bundled add_comm_group

/-- The category of additive commutative groups and group morphisms. -/
/-- `Ab` is an abbreviation for `AddCommGroup`, for the sake of mathematicians' sanity. -/
def Ab :=
  AddCommGroup

namespace CommGroup

protected instance comm_group.to_group.category_theory.bundled_hom.parent_projection : category_theory.bundled_hom.parent_projection comm_group.to_group :=
  category_theory.bundled_hom.parent_projection.mk

protected instance large_category : category_theory.large_category CommGroup :=
  category_theory.bundled_hom.category
    (category_theory.bundled_hom.map_hom (category_theory.bundled_hom.map_hom monoid_hom group.to_monoid)
      comm_group.to_group)

/-- Construct a bundled `CommGroup` from the underlying type and typeclass. -/
def of (G : Type u) [comm_group G] : CommGroup :=
  category_theory.bundled.of G

/-- Construct a bundled `AddCommGroup` from the underlying type and typeclass. -/
protected instance Mathlib.AddCommGroup.add_comm_group_instance (G : AddCommGroup) : add_comm_group ↥G :=
  category_theory.bundled.str G

@[simp] theorem coe_of (R : Type u) [comm_group R] : ↥(of R) = R :=
  rfl

protected instance Mathlib.AddCommGroup.has_zero : HasZero AddCommGroup :=
  { zero := AddCommGroup.of PUnit }

protected instance inhabited : Inhabited CommGroup :=
  { default := 1 }

protected instance one.unique : unique ↥1 :=
  unique.mk { default := 1 } sorry

@[simp] theorem one_apply (G : CommGroup) (H : CommGroup) (g : ↥G) : coe_fn 1 g = 1 :=
  rfl

theorem ext (G : CommGroup) (H : CommGroup) (f₁ : G ⟶ H) (f₂ : G ⟶ H) (w : ∀ (x : ↥G), coe_fn f₁ x = coe_fn f₂ x) : f₁ = f₂ :=
  monoid_hom.ext fun (x : ↥G) => w x

protected instance Mathlib.AddCommGroup.has_forget_to_AddGroup : category_theory.has_forget₂ AddCommGroup AddGroup :=
  category_theory.bundled_hom.forget₂ (category_theory.bundled_hom.map_hom add_monoid_hom add_group.to_add_monoid)
    add_comm_group.to_add_group

protected instance Mathlib.AddCommGroup.has_forget_to_AddCommMon : category_theory.has_forget₂ AddCommGroup AddCommMon :=
  category_theory.induced_category.has_forget₂ fun (G : AddCommGroup) => AddCommMon.of ↥G

end CommGroup

-- This example verifies an improvement possible in Lean 3.8.

-- Before that, to have `monoid_hom.map_map` usable by `simp` here,

-- we had to mark all the concrete category `has_coe_to_sort` instances reducible.

-- Now, it just works.

namespace AddCommGroup

/-- Any element of an abelian group gives a unique morphism from `ℤ` sending
`1` to that element. -/
-- Note that because `ℤ : Type 0`, this forces `G : AddCommGroup.{0}`,

-- so we write this explicitly to be clear.

-- TODO generalize this, requiring a `ulift_instances.lean` file

def as_hom {G : AddCommGroup} (g : ↥G) : of ℤ ⟶ G :=
  coe_fn (gmultiples_hom ↥G) g

@[simp] theorem as_hom_apply {G : AddCommGroup} (g : ↥G) (i : ℤ) : coe_fn (as_hom g) i = i • g :=
  rfl

theorem as_hom_injective {G : AddCommGroup} : function.injective as_hom := sorry

theorem int_hom_ext {G : AddCommGroup} (f : of ℤ ⟶ G) (g : of ℤ ⟶ G) (w : coe_fn f 1 = coe_fn g 1) : f = g :=
  add_monoid_hom.ext_int w

-- TODO: this argument should be generalised to the situation where

-- the forgetful functor is representable.

theorem injective_of_mono {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) [category_theory.mono f] : function.injective ⇑f := sorry

end AddCommGroup

/-- Build an isomorphism in the category `Group` from a `mul_equiv` between `group`s. -/
def mul_equiv.to_Group_iso {X : Type u} {Y : Type u} [group X] [group Y] (e : X ≃* Y) : Group.of X ≅ Group.of Y :=
  category_theory.iso.mk (mul_equiv.to_monoid_hom e) (mul_equiv.to_monoid_hom (mul_equiv.symm e))

/-- Build an isomorphism in the category `AddGroup` from an `add_equiv` between `add_group`s. -/
/-- Build an isomorphism in the category `CommGroup` from a `mul_equiv` between `comm_group`s. -/
def add_equiv.to_AddCommGroup_iso {X : Type u} {Y : Type u} [add_comm_group X] [add_comm_group Y] (e : X ≃+ Y) : AddCommGroup.of X ≅ AddCommGroup.of Y :=
  category_theory.iso.mk (add_equiv.to_add_monoid_hom e) (add_equiv.to_add_monoid_hom (add_equiv.symm e))

/-- Build an isomorphism in the category `AddCommGroup` from a `add_equiv` between
`add_comm_group`s. -/
namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Group`. -/
@[simp] theorem Group_iso_to_add_equiv_apply {X : AddGroup} {Y : AddGroup} (i : X ≅ Y) : ∀ (ᾰ : ↥X), coe_fn (AddGroup_iso_to_add_equiv i) ᾰ = coe_fn (hom i) ᾰ :=
  fun (ᾰ : ↥X) => Eq.refl (coe_fn (hom i) ᾰ)

/-- Build a `mul_equiv` from an isomorphism in the category `CommGroup`. -/
@[simp] theorem CommGroup_iso_to_add_equiv_apply {X : AddCommGroup} {Y : AddCommGroup} (i : X ≅ Y) : ∀ (ᾰ : ↥X), coe_fn (AddCommGroup_iso_to_add_equiv i) ᾰ = coe_fn (hom i) ᾰ :=
  fun (ᾰ : ↥X) => Eq.refl (coe_fn (hom i) ᾰ)

end category_theory.iso

/-- multiplicative equivalences between `group`s are the same as (isomorphic to) isomorphisms
in `Group` -/
def add_equiv_iso_AddGroup_iso {X : Type u} {Y : Type u} [add_group X] [add_group Y] : X ≃+ Y ≅ AddGroup.of X ≅ AddGroup.of Y :=
  category_theory.iso.mk (fun (e : X ≃+ Y) => add_equiv.to_AddGroup_iso e)
    fun (i : AddGroup.of X ≅ AddGroup.of Y) => category_theory.iso.AddGroup_iso_to_add_equiv i

/-- multiplicative equivalences between `comm_group`s are the same as (isomorphic to) isomorphisms
in `CommGroup` -/
def mul_equiv_iso_CommGroup_iso {X : Type u} {Y : Type u} [comm_group X] [comm_group Y] : X ≃* Y ≅ CommGroup.of X ≅ CommGroup.of Y :=
  category_theory.iso.mk (fun (e : X ≃* Y) => mul_equiv.to_CommGroup_iso e)
    fun (i : CommGroup.of X ≅ CommGroup.of Y) => category_theory.iso.CommGroup_iso_to_mul_equiv i

namespace category_theory.Aut

/-- The (bundled) group of automorphisms of a type is isomorphic to the (bundled) group
of permutations. -/
def iso_perm {α : Type u} : Group.of (Aut α) ≅ Group.of (equiv.perm α) :=
  iso.mk (monoid_hom.mk (fun (g : ↥(Group.of (Aut α))) => iso.to_equiv g) sorry sorry)
    (monoid_hom.mk (fun (g : ↥(Group.of (equiv.perm α))) => equiv.to_iso g) sorry sorry)

/-- The (unbundled) group of automorphisms of a type is `mul_equiv` to the (unbundled) group
of permutations. -/
def mul_equiv_perm {α : Type u} : Aut α ≃* equiv.perm α :=
  iso.Group_iso_to_mul_equiv iso_perm

end category_theory.Aut

protected instance Group.forget_reflects_isos : category_theory.reflects_isomorphisms (category_theory.forget Group) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : Group) (f : X ⟶ Y)
      (_x : category_theory.is_iso (category_theory.functor.map (category_theory.forget Group) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget Group) X ≅
          category_theory.functor.obj (category_theory.forget Group) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget Group) f);
      let e : ↥X ≃* ↥Y :=
        mul_equiv.mk (monoid_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (mul_equiv.to_Group_iso e))

protected instance CommGroup.forget_reflects_isos : category_theory.reflects_isomorphisms (category_theory.forget CommGroup) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : CommGroup) (f : X ⟶ Y)
      (_x : category_theory.is_iso (category_theory.functor.map (category_theory.forget CommGroup) f)) =>
      let i :
        category_theory.functor.obj (category_theory.forget CommGroup) X ≅
          category_theory.functor.obj (category_theory.forget CommGroup) Y :=
        category_theory.as_iso (category_theory.functor.map (category_theory.forget CommGroup) f);
      let e : ↥X ≃* ↥Y :=
        mul_equiv.mk (monoid_hom.to_fun f) (equiv.inv_fun (category_theory.iso.to_equiv i)) sorry sorry sorry;
      category_theory.is_iso.mk (category_theory.iso.inv (mul_equiv.to_CommGroup_iso e))


import Table.API

universe u u_η

variable {η : Type u_η} [dec_η : DecidableEq η] {sch : @Schema η}

theorem emptyTable_spec1 : @schema η dec_η _ emptyTable = [] := rfl

theorem emptyTable_spec2 : @nrows η dec_η _ emptyTable = 0 := rfl

-- We omit the precondition because it is enforced by the type system
theorem addRows_spec1 :
  ∀ (t : Table sch) (rs : List (Row sch)), schema (addRows t rs) = schema t :=
λ t rs => rfl

theorem addRows_spec2 :
  ∀ (t : Table sch) (rs : List (Row sch)),
    nrows (addRows t rs) = nrows t + rs.length :=
λ t rs => List.length_append (t.rows) rs

-- TODO: deal with precondition 1
-- We must enforce decidable equality of τ to state this theorem
-- We omit the precondition because it is not required for this portion of the
-- spec
theorem addColumn_spec1 :
  ∀ {τ : Type u} [DecidableEq τ]
    (t : Table sch) (c : η) (vs : List $ Option τ),
    header (addColumn t c vs) = List.append (header t) [c]
:= by
  intros τ inst t c vs
  simp [header, addColumn, Schema.names]
  induction sch with
  | nil => simp [List.map, List.append]
  | cons s ss ih =>
    simp only [List.map]
    -- TODO: after updating to Lean 4 m4, these unfolds become necessary...
    unfold HAppend.hAppend at ih
    unfold instHAppend at ih
    unfold Append.append at ih
    unfold List.instAppendList at ih
    simp only at ih
    rw [ih]
    simp [List.append]
    -- TODO: Can we avoid this somehow? (Arises because of induction on schema
    -- used as index in Table type. Could use empty table instead, but this
    -- seems more suggestive.)
    exact dropColumn t ⟨_, Schema.HasName.hd⟩

-- ⟨cc.val,
-- by cases cc with | mk val prop =>
--    induction prop with
--    | hd => apply Schema.HasName.hd
--    | @tl r c' rs h ih =>
--     apply Schema.HasName.tl
--     simp only [schema, addColumn] at ih
-- ⟩

-- TODO: maybe use `lookupType` for this and `buildColumn_spec3`?
theorem addColumn_spec2 :
  ∀ {τ : Type u}
    (t : Table sch)
    (c : η)
    (vs : List $ Option τ)
    (c' : η)
    -- This is equivalent to `c ∈ header t`. (Unfortunately, we can't take the
    -- hypothesis in that form beecause creating a `HasName` therefrom would
    -- require large elimination from `Prop`)
    (h' : sch.HasName c'),
      (schema t).lookup ⟨c', h'⟩ =
      (schema (addColumn t c vs)).lookup ⟨c', Schema.hasNameOfAppend h'⟩ :=
λ t c vs c' h' => Schema.lookup_eq_lookup_append _ _ _ _

theorem addColumn_spec3 {τ : Type u} [DecidableEq τ] :
  ∀ (t : Table sch) (c : η) (vs : List $ Option τ),
    (schema (addColumn t c vs)).lookupType
      ⟨c, sch.hasAppendedSingletonName c τ⟩ = τ := by
  intros t c vs
  induction sch with
  | nil =>
    simp only [Schema.hasAppendedSingletonName, Schema.lookupType]
  | cons s ss ih =>
    simp only [Schema.hasAppendedSingletonName, Schema.lookupType]
    -- TODO: again, could use `Table.mk []`, but this is more suggestive?
    apply ih (dropColumn t ⟨_, Schema.HasName.hd⟩)

theorem addColumn_spec4 :
  ∀ {τ : Type u} [DecidableEq τ] (t : Table sch) (c : η) (vs : List $ Option τ),
    vs.length = nrows t →
    nrows (addColumn t c vs) = nrows t := by
  intros τ inst t c vs h
  simp only [nrows, addColumn, List.length_map]
  rw [List.zip_length_eq_of_length_eq]
  exact Eq.symm h

-- theorem addColumn_spec1' :
--   ∀ {τ : Type u} [DecidableEq τ] (t : Table sch) (c : η) (vs : List τ),
--     header (addColumn t c vs) = List.append (header t) [c] :=
-- λ t c vs =>
--   match sch with
--   | [] => by cases t with | mk rows => cases rows with | nil => simp [header, addColumn, Schema.names, List.map, List.append]
--                                                        | cons s ss => simp [header, addColumn, Schema.names, List.map, List.append]
--   | s :: ss =>
--     have h := @addColumn_spec1' _ _ ss _ _ t c vs
--     sorry

-- Spec 1 is enforced by the type system
theorem buildColumn_spec2 :
  ∀ {τ : Type u} (t : Table sch) (c : η) (f : Row sch → Option τ),
    header (buildColumn t c f) = List.append (header t) [c] :=
by intros τ t c f
   simp [header, Schema.names]
   induction sch with
  | nil => simp [List.map, List.append]
  | cons s ss ih =>
    simp only [List.map]
    -- TODO: same issue with the ih
    unfold HAppend.hAppend at ih
    unfold instHAppend at ih
    unfold Append.append at ih
    unfold List.instAppendList at ih
    simp only at ih
    rw [ih]
    simp [List.append]
    exact Table.mk []
    exact (λ x => f (Row.cons Cell.emp x))

theorem buildColumn_spec3 :
  ∀ {τ : Type u}
    (t : Table sch)
    (c : η)
    (f : Row sch → Option τ)
    (c' : η)
    (h' : sch.HasName c'),
      (schema t).lookup ⟨c', h'⟩ =
      (schema (buildColumn t c f)).lookup ⟨c', Schema.hasNameOfAppend h'⟩ :=
λ t c vs c' h' => Schema.lookup_eq_lookup_append _ _ _ _

theorem buildColumn_spec4 {τ : Type u} [DecidableEq τ] :
  ∀ (t : Table sch) (c : η) (f : Row sch → Option τ),
    (schema (buildColumn t c f)).lookupType
      ⟨c, sch.hasAppendedSingletonName c τ⟩ = τ := by
  intros t c f
  induction sch with
  | nil =>
    simp only [Schema.hasAppendedSingletonName, Schema.lookupType]
  | cons s ss ih =>
    simp only [Schema.hasAppendedSingletonName, Schema.lookupType]
    apply ih
    . exact (dropColumn t ⟨_, Schema.HasName.hd⟩)
    . exact f ∘ (Row.cons Cell.emp)

theorem buildColumn_spec5 :
  ∀ {τ : Type u} (t : Table sch) (c : η) (f : Row sch → Option τ),
    nrows (buildColumn t c f) = nrows t :=
by intros τ t c f
   simp only [nrows, buildColumn, addColumn]
   rw [List.length_map, List.zip_length_eq_of_length_eq]
   apply Eq.symm
   apply List.length_map

theorem vcat_spec1 :
  ∀ (t1 : Table sch) (t2 : Table sch),
    schema (vcat t1 t2) = schema t1 :=
λ _ _ => rfl

theorem vcat_spec2 :
  ∀ (t1 : Table sch) (t2 : Table sch),
    nrows (vcat t1 t2) = nrows t1 + nrows t2 :=
λ t1 t2 => List.length_append t1.rows t2.rows

-- This is precisely the type signature, but we can state it anyway
theorem hcat_spec1 :
  ∀ {sch₁ : @Schema η} {sch₂ : @Schema η} (t₁ : Table sch₁) (t₂ : Table sch₂),
    schema (hcat t₁ t₂) = List.append (schema t₁) (schema t₂) :=
λ _ _ => rfl

theorem hcat_spec2 :
  ∀ {sch₁ : @Schema η} {sch₂ : @Schema η} (t₁ : Table sch₁) (t₂ : Table sch₂),
    nrows t₁ = nrows t₂ → nrows (hcat t₁ t₂) = nrows t₁ :=
by intros sch₁ sch₂ t₁ t₂ h
   simp only [nrows, hcat]
   rw [List.length_map]
   apply List.zip_length_eq_of_length_eq _ _ h

theorem values_spec1 :
  ∀ (rs : List (Row sch)),
    (h : rs ≠ []) → schema (values rs) = Row.schema (rs.head h) :=
λ rs h => rfl

theorem values_spec2 :
  ∀ (rs : List (Row sch)), nrows (values rs) = rs.length :=
λ rs => rfl

theorem crossJoin_spec1 :
  ∀ {sch₁ : @Schema η} {sch₂ : @Schema η} (t₁ : Table sch₁) (t₂ : Table sch₂),
    schema (crossJoin t₁ t₂) = List.append (schema t₁) (schema t₂) :=
λ _ _ => rfl

theorem crossJoin_spec2 :
  ∀ {sch₁ : @Schema η} {sch₂ : @Schema η} (t₁ : Table sch₁) (t₂ : Table sch₂),
    nrows (crossJoin t₁ t₂) = nrows t₁ * nrows t₂ :=
by intros sch₁ sch₂ t₁ t₂
   simp only [nrows, crossJoin, List.length_map]
   apply List.length_prod

-- This is the closest we can approximate the spec given uniqueness issues
theorem leftJoin_spec1 {s₁ s₂ : @Schema η} :
  ∀ (t₁ : Table s₁) (t₂ : Table s₂)
    (cs : ActionList (Schema.removeOtherDecCH s₁) s₂),
  schema (leftJoin t₁ t₂ cs) =
  List.append (schema t₁)
              (Schema.removeOtherDecCHs (schema t₁) (schema t₂) cs) :=
λ _ _ _ => rfl

-- TODO: again, should we use `lookupType`?
theorem leftJoin_spec2 {s₁ s₂ : @Schema η} :
  ∀ (t₁ : Table s₁) (t₂ : Table s₂)
    (cs : ActionList (Schema.removeOtherDecCH s₁) s₂)
    (c : η)
    (h : s₁.HasName c),
      (schema t₁).lookup ⟨c, h⟩ =
      (schema (leftJoin t₁ t₂ cs)).lookup ⟨c, Schema.hasNameOfAppend h⟩ :=
λ _ _ _ _ _ => Schema.lookup_eq_lookup_append _ _ _ _

-- TODO: spec 3

-- TODO: Spec 4 appears to be wrong. Consider the following SQLite queries:
/-
CREATE TABLE demo (
  id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
  name VARCHAR(100) NOT NULL,
  age INTEGER NOT NULL
);

CREATE TABLE demo2 (
  id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
  name VARCHAR(100) NOT NULL,
  location VARCHAR(100) NOT NULL
);

INSERT INTO demo VALUES (NULL, "Bob", 18);
INSERT INTO demo2 VALUES (NULL, "Bob", "USA");
INSERT INTO demo2 VALUES (NULL, "Bob", "UK");

SELECT *
FROM demo
LEFT JOIN demo2
ON demo.name=demo2.name;
-/
-- theorem leftJoin_spec4 {s₁ s₂ : @Schema η} :
--   ∀ (t₁ : Table s₁) (t₂ : Table s₂)
--     (cs : ActionList (Schema.removeOtherDecCH s₁) s₂),
--   nrows (leftJoin t₁ t₂ cs) = nrows t₁ := by
--   intros t₁ t₂ cs
--   simp only [leftJoin, nrows]

-- The spec for `getValue` (as nearly as it can be approximated up to uniqueness
-- issues) is enforced by types

theorem getColumn1_spec1 :
  ∀ (t : Table sch) (n : Nat) (h : n < ncols t),
    List.length (getColumn1 t n h) = nrows t :=
λ t n h => List.length_map _ _

-- Spec 2 is encoded in the return type of `getColumn1`

-- TODO: gC2 spec 1
theorem getColumn2_spec2 :
  ∀ {τ : Type u} (t : Table sch) (c : η) (h : sch.HasCol (c, τ)),
    List.length (getColumn2 t c h) = nrows t :=
λ t c h => List.length_map _ _

-- Precondition is enforced by subtype
theorem selectRows1_spec1 :
  ∀ (t : Table sch) (ns : List {n // n < nrows t}),
    schema (selectRows1 t ns) = schema t :=
λ t ns => rfl

theorem selectRows1_spec2 :
  ∀ (t : Table sch) (ns : List {n // n < nrows t}),
    nrows (selectRows1 t ns) = ns.length :=
λ t ns => List.length_map _ _

-- Precondition is enforced by `h`
theorem selectRows2_spec1 :
  ∀ (t : Table sch) (bs : List Bool) (h : bs.length = nrows t),
    schema (selectRows2 t bs h) = schema t :=
λ t bs h => rfl

theorem selectRows2_spec2 :
  ∀ (t : Table sch) (bs : List Bool) (h : bs.length = nrows t),
    nrows (selectRows2 t bs h) = (bs.removeAll [false]).length :=
λ t bs h => List.sieve_removeAll _ _ h

theorem selectColumns1_spec1 :
  ∀ (t : Table sch) (bs : List Bool) (h : bs.length = ncols t),
    List.Sublist (header (selectColumns1 t bs h)) (header t) :=
λ t bs h => List.sublist_of_map_sublist _ _ Prod.fst $ List.sieve_sublist bs sch

-- TODO: sC1 spec 2 (I don't think this is actually currently true due to
-- uniqueness issues -- in particular, the same value may appear later in the
-- header. The failed proof below illustrates where this goes wrong more
-- clearly.)

-- theorem List.sieve_mem_iff_true :
--   List.get xs ⟨i, pf1⟩ ∈ List.sieve bs xs ↔ List.get bs ⟨i, pf2⟩ = true :=
-- by apply Iff.intro
--    . intro hf
--      cases xs with
--      | nil => contradiction
--      | cons x xs =>
--      cases bs with
--      | nil => contradiction
--      | cons b bs =>
--      induction i with
--      | zero =>
--       simp only [get] at *
--       cases b with
--       | false =>
--         simp only [sieve] at hf

-- The original failed proof
-- theorem ncols_eq_header_length :
--   ∀ (t : Table sch), ncols t = (header t).length :=
-- λ t => Eq.symm (List.length_map _ _)
-- theorem selectColumns1_spec2 :
--   ∀ (t : Table sch) (bs : List Bool) (h : bs.length = ncols t) (i : Nat) (h' : i < ncols t),
--   (List.get (header t) ⟨i, (ncols_eq_header_length t).subst h'⟩) ∈ (header (selectColumns1 t bs h)) ↔
--    List.get bs ⟨i, Eq.subst h.symm h'⟩ = true := sorry
-- by intros t bs h i h'
--    apply Iff.intro
--    . intros hforward
--      unfold Membership.mem at hforward
--      unfold List.instMembershipList at hforward
--      simp only [header, Schema.names] at hforward
--      cases sch with
--      | nil => contradiction
--      | cons hdr sch' =>
--      cases bs with
--      | nil => contradiction
--      | cons b bs' =>
--      simp only [List.sieve, List.map] at hforward
--      admit
--     . admit

theorem selectColumns1_spec3 :
  ∀ (t : Table sch) (bs : List Bool) (h : bs.length = ncols t),
    List.Sublist (schema (selectColumns1 t bs h)) (schema t) :=
λ t bs h => List.sieve_sublist _ _

theorem selectColumns1_spec4 :
  ∀ (t : Table sch) (bs : List Bool) (h : bs.length = ncols t),
    nrows (selectColumns1 t bs h) = nrows t :=
λ t bs h => List.length_map _ _

theorem selectColumns2_spec1 :
  ∀ (t : Table sch) (ns : List {n // n < ncols t}),
    ncols (selectColumns2 t ns) = ns.length :=
λ t ns => List.length_map _ _

-- TODO: sc2 specs 2 and 3

theorem selectColumns2_spec4 :
  ∀ (t : Table sch) (ns : List {n // n < ncols t}),
    nrows (selectColumns2 t ns) = nrows t :=
λ t ns => List.length_map _ _

theorem selectColumns3_spec1 :
  ∀ (t : Table sch) (cs : List (CertifiedHeader sch)),
    header (selectColumns3 t cs) = cs.map (Prod.fst ∘ Sigma.fst) :=
by intros t cs
   simp only [header, selectColumns3, Schema.names]
   induction cs with
   | nil => simp only [Schema.pick, List.map]
   | cons c cs ih =>
     simp only [Schema.pick, List.map, List.cons.injEq]
     apply And.intro
     . simp only [Function.comp, Schema.lookup_fst_eq_nm, CertifiedName.val]
     . exact ih

-- TODO: sc3 spec 2

theorem selectColumns3_spec3 :
  ∀ (t : Table sch) (cs : List (CertifiedHeader sch)),
    nrows (selectColumns3 t cs) = nrows t :=
λ t cs => List.length_map _ _

theorem head_spec1 : ∀ (t : Table sch) (z : {z : Int // z.abs < nrows t}),
  schema (head t z) = schema t :=
λ _ _ => rfl

theorem head_spec2 : ∀ (t : Table sch) (z : {z : Int // z.abs < nrows t}),
  z.val ≥ 0 → nrows (head t z) = z.val :=
by intros t z h
   cases z with | mk z prop =>
   simp only [head]
   have h_not_neg : ¬ (z < 0) := by
     intro contra
     cases z with
     | ofNat n => contradiction
     | negSucc n => contradiction
   simp only [ite_false, h_not_neg]
   simp only [List.take, nrows]
   rw [List.length_take]
   . exact Int.toNat_of_ofNat_inj z h
   . unfold nrows at prop
     rw [Int.abs_of_nonneg_eq_toNat] at prop
     . exact prop
     . exact h

-- TODO: changed slightly from B2T2 b/c casting is a pain (should this be redone
-- to match the spec exactly?)
theorem head_spec3 : ∀ (t : Table sch) (z : {z : Int // z.abs < nrows t}),
  z.val < 0 → nrows (head t z) = nrows t - z.val.abs :=
by intros t z h
   cases z with | mk z prop =>
   simp only [head, nrows, h, ite_true, List.dropLastN, Function.comp]
   rw [List.length_reverse, List.length_drop, List.length_reverse]
   -- Need separate `rw`s here so that the equality proof can be auto-generated
   rw [List.length_reverse]
   exact prop

-- theorem head_spec3' : ∀ (t : Table sch) (z : {z : Int // z.abs < nrows t}),
--   z.val < 0 → nrows (head t z) = nrows t + z.val :=
-- by intros t z h
--    rw [Int.add_neg_eq_sub]
--    cases z with | mk z prop =>
--    cases z with
--    | ofNat n => contradiction
--    | negSucc n =>
--      simp only [Int.abs]

theorem distinct_spec : ∀ (t : Table sch) [DecidableEq $ Row sch],
  schema (distinct t) = schema t :=
λ t => rfl

theorem dropColumn_spec1 : ∀ (t : Table sch) (c : CertifiedName sch),
  nrows (dropColumn t c) = nrows t :=
λ t c => List.length_map _ _

-- dC spec 2 is not currently true because of duplicate issues. This is the best
-- approximation we can get instead:
theorem dropColumn_spec2 : ∀ (t : Table sch) (c : CertifiedName sch),
  header (dropColumn t c) = Schema.names (sch.removeName c.2) :=
λ t c => rfl

theorem dropColumn_spec3 : ∀ (t : Table sch) (c : CertifiedName sch),
  List.Sublist (schema (dropColumn t c)) (schema t) :=
λ _ c => Schema.removeName_sublist sch c.val c.property

theorem dropColumns_spec1 :
  ∀ (t : Table sch) (cs : ActionList Schema.removeCertifiedName sch),
  nrows (dropColumns t cs) = nrows t :=
λ t cs => List.length_map _ _

-- dCs spec 2 has the same issue as dC spec 2.
theorem dropColumns_spec2 :
  ∀ (t : Table sch) (cs : ActionList Schema.removeCertifiedName sch),
  header (dropColumns t cs) = Schema.names (sch.removeNames cs) :=
λ t cs => rfl

theorem dropColumns_spec3 :
  ∀ (t : Table sch) (cs : ActionList Schema.removeCertifiedName sch),
  List.Sublist (schema $ dropColumns t cs) (schema t) :=
λ _ cs => Schema.removeNames_sublist sch cs

-- Spec 1 is enforced by types
theorem tfilter_spec2 : ∀ (t : Table sch) (f : Row sch → Bool),
  schema (tfilter t f) = schema t :=
λ t f => rfl

theorem tsort_spec1 : ∀ {τ : Type u} [inst : Ord τ]
                        (t : Table sch)
                        (c : ((c : η) × sch.HasCol (c, τ)))
                        (b : Bool),
  nrows (tsort t c b) = nrows t :=
λ t c b => List.length_mergeSortWith _ t.rows

theorem tsort_spec2 : ∀ {τ : Type u} [Ord τ]
                        (t : Table sch)
                        (c : ((c : η) × sch.HasCol (c, τ)))
                        (b : Bool),
  schema (tsort t c b) = schema t :=
λ t c b => rfl

theorem sortByColumns_spec1 :
  ∀ (t : Table sch) (hs : List ((h : Header) × sch.HasCol h × Ord h.snd)),
    nrows (sortByColumns t hs) = nrows t :=
by intros t hs
   simp only [nrows, sortByColumns]
   apply List.foldr_invariant (λ x => nrows x = nrows t)
   -- Initialization
   . rfl
   -- Preservation
   . intros x acc h
     rw [←h]
     apply tsort_spec1 (inst := x.snd.snd)

theorem sortByColumns_spec2 :
  ∀ (t : Table sch) (hs : List ((h : Header) × sch.HasCol h × Ord h.snd)),
    schema (sortByColumns t hs) = schema t :=
λ t hs => rfl

-- Spec 1 is enforced by types
theorem orderBy_spec2 :
  ∀ (t : Table sch)
    (cmps : List ((κ : Type u) × (Row sch → κ) × (κ → κ → Bool))),
    schema (orderBy t cmps) = schema t :=
λ _ _ => rfl

theorem orderBy_spec3 :
  ∀ (t : Table sch)
    (cmps : List ((κ : Type u) × (Row sch → κ) × (κ → κ → Bool))),
    nrows (orderBy t cmps) = nrows t :=
λ t _ => List.length_mergeSortWith _ t.rows

theorem count_spec1 :
  ∀ {τ} [DecidableEq τ]
    (t : Table sch) (c : ((c : η) × sch.HasCol (c, τ))),
    header (count t c) = ["value", "count"] :=
λ t c => rfl

-- This can't yet be in tactic mode because the `induction` tactic doesn't
-- support `(nm, τ)` as an index
theorem count_spec2 :
  ∀ {sch : @Schema η} {τ} [DecidableEq τ]
    (t : Table sch) (c : ((c : η) × sch.HasCol (c, τ))),
  (schema (count t c)).lookupType ⟨"value", Schema.HasName.hd⟩ =
  Option (sch.lookupType ⟨c.1, Schema.colImpliesName c.2⟩)
| _ :: _, _, _, t, ⟨_, Schema.HasCol.hd⟩ => rfl
  -- As with prior proofs, the table in the IH doesn't matter
| _ :: _, τ, _, t, ⟨nm, Schema.HasCol.tl h⟩ => count_spec2 (Table.mk []) ⟨nm, h⟩

theorem count_spec3 {τ} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  (schema (count t c)).lookupType ⟨"count", .tl .hd⟩ = Nat :=
λ _ _ => rfl

-- TODO: move this somewhere
theorem length_count_pairsToRow : ∀ (xs : List (Option τ × Nat)),
  List.length (count.pairsToRow xs) = xs.length
| [] => rfl
| x :: xs => congrArg (·+1) (length_count_pairsToRow xs)

theorem count_spec4 {τ} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  nrows (count t c) = (getColumn2 t c.1 c.2).unique.length :=
λ t c => Eq.trans (length_count_pairsToRow _) (List.length_counts _)

theorem bin_spec1 [ToString η] :
  ∀ (t : Table sch)
    (c : (c : η) × Schema.HasCol (c, Nat) sch)
    (n : { n // n > 0 }),
    header (bin t c n) = ["group", "count"] :=
λ _ _ _ => rfl

theorem bin_spec2 [ToString η] :
  ∀ (t : Table sch)
    (c : (c : η) × Schema.HasCol (c, Nat) sch)
    (n : { n // n > 0 }),
    (schema (bin t c n)).lookupType ⟨"group", Schema.HasName.hd⟩ = String :=
λ _ _ _ => rfl

theorem bin_spec3 [ToString η] :
  ∀ (t : Table sch)
    (c : (c : η) × Schema.HasCol (c, Nat) sch)
    (n : { n // n > 0 }),
    (schema (bin t c n)).lookupType
      ⟨"count", Schema.HasName.tl Schema.HasName.hd⟩ = Nat :=
λ _ _ _ => rfl

-- Spec 1 is enforced by types
theorem pivotTable_spec2 :
  ∀ (t : Table sch)
    (cs : List $ CertifiedHeader sch)
    (inst : DecidableEq (Row (Schema.fromCHeaders cs)))
    (aggs : List ((c' : Header) ×
                  (c : CertifiedHeader sch) ×
                  (List (Option c.fst.snd) → Option c'.snd))),
  header (pivotTable t cs inst aggs) =
  List.append (cs.map (·.1.1)) (aggs.map (·.1.1)) :=
λ t cs inst aggs => List.map_map_append cs aggs Prod.fst Sigma.fst Sigma.fst

-- TODO: get rid of `Classical.choice` (termination proof)
theorem pivotTable_spec3_aux :
  ∀ (cs : List $ CertifiedHeader sch)
    (aggs : List ((c' : Header) × (c : CertifiedHeader sch) ×
                  (List (Option c.fst.snd) → Option c'.snd)))
    (cn : CertifiedName (Schema.fromCHeaders cs)),
  Schema.lookup
    (List.append (Schema.fromCHeaders cs) (aggs.map (fun a => a.fst)))
    ⟨cn.fst, Schema.hasNameOfAppend cn.snd⟩ =
  Schema.lookup sch ⟨cn.fst, Schema.hasNameOfFromCHeaders cn.snd⟩
| ⟨(.(nm), τ), _⟩ :: cs, aggs, ⟨nm, .hd⟩ => by
  simp only [Schema.fromCHeaders, List.map, List.append, Schema.hasNameOfAppend]
  rw [Schema.lookup_eq_1,
      Schema.hasNameOfFromCHeaders_eq_1,
      Schema.lookup_of_colImpliesName]
| ⟨_, _⟩ :: cs, aggs, ⟨nm, .tl _⟩ => by
  simp only [Schema.fromCHeaders, List.map, List.append, Schema.hasNameOfAppend]
  rw [Schema.lookup_eq_2,
      Schema.hasNameOfFromCHeaders_eq_2]
  apply pivotTable_spec3_aux cs aggs ⟨nm, _⟩

theorem pivotTable_spec3 :
  ∀ (t : Table sch)
    (cs : List $ CertifiedHeader sch)
    (inst : DecidableEq (Row (Schema.fromCHeaders cs)))
    (aggs : List ((c' : Header) ×
                  (c : CertifiedHeader sch) ×
                  (List (Option c.fst.snd) → Option c'.snd)))
    (cn : CertifiedName (Schema.fromCHeaders cs)),
    (schema $ pivotTable t cs inst aggs).lookup
      ⟨cn.1, Schema.hasNameOfAppend cn.2⟩ =
    (schema t).lookup ⟨cn.1, Schema.hasNameOfFromCHeaders cn.2⟩ :=
λ t cs inst => pivotTable_spec3_aux cs

-- Spec 4 is enforced by types

-- Specs 1 and 2 are enforced by types
-- Spec 3 is also enforced by types, but since it is actually expressible as an
-- (albeit trivial) proof, we state it here for completeness
theorem groupBy_spec3  {η'} [DecidableEq η'] {sch' : @Schema η'}
                       {κ ν} [DecidableEq κ] :
  ∀ (t : Table sch)
    (key : Row sch → κ)
    (project : Row sch → ν)
    (aggregate : κ → List ν → Row sch')
    (k : κ) (vs : List ν),
  schema (groupBy t key project aggregate) = (aggregate k vs).schema :=
λ _ _ _ _ _ _ => rfl

theorem groupBy_spec4 {η'} [DecidableEq η'] {sch' : @Schema η'}
                      {κ ν} [DecidableEq κ] :
  ∀ (t : Table sch)
    (key : Row sch → κ)
    (project : Row sch → ν)
    (aggregate : κ → List ν → Row sch'),
  nrows (groupBy t key project aggregate) = (t.rows.map key).unique.length :=
by intros t key proj agg
   simp only [nrows, groupBy]
   rw [List.length_map, List.length_groupByKey]
   apply congrArg
   apply congrArg
   rw [List.map_map]
   apply congr _ rfl
   apply congrArg
   simp only [Function.comp]

theorem completeCases_spec {τ : Type u} :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  (completeCases t c).length = nrows t :=
λ t c => Eq.trans (List.length_map _ _) (List.length_map _ _)

theorem dropna_spec : ∀ (t : Table sch), schema (dropna t) = schema t :=
λ t => rfl

theorem fillna_spec1 {τ : Type u} :
  ∀ (t : Table sch)
    (c : (c : η) × sch.HasCol (c, τ))
    (v : τ),
    schema (fillna t c v) = schema t :=
λ _ _ _ => rfl

theorem fillna_spec2 {τ : Type u} :
  ∀ (t : Table sch)
    (c : (c : η) × sch.HasCol (c, τ))
    (v : τ),
    nrows (fillna t c v) = nrows t :=
λ _ _ _ => List.length_map _ _

-- TODO: `pivotLonger` and `pivotWider`
-- Specs 1 don't hold because of uniqueness issues, I think

theorem flatten_spec1 :
  ∀ (t : Table sch) (cs : ActionList Schema.flattenList sch),
  header (flatten t cs) = header t := by
  intros t cs
  simp only [flatten, header, Schema.names]
  induction cs with
  | nil => simp only [Schema.flattenLists]
  | cons c cs ih =>
    simp only [Schema.flattenLists]
    rw [ih]
    simp only [Schema.flattenList]
    apply Schema.retypeColumn_preserves_names
    -- TODO: this shouldn't be necessary with more careful induction
    exact Table.mk []

-- TODO: `flatten` spec 2

-- TODO: `transformColumn` spec 3

theorem transformColumn_spec1 {τ₁ τ₂} :
  ∀ (t : Table sch)
    (c : (c : η) × sch.HasCol (c, τ₁))
    (f : Option τ₁ → Option τ₂),
  sch.lookupType ⟨c.1, Schema.colImpliesName c.2⟩ = τ₁ :=
λ t c f => Eq.trans (Schema.lookupType_eq_snd_lookup sch
                        ⟨c.1, Schema.colImpliesName c.2⟩)
                    (Eq.subst (motive := λ a => a.snd = τ₁)
                        (Eq.symm $ Schema.lookup_of_colImpliesName sch c.2)
                        rfl)

theorem transformColumn_spec2 {τ₁ τ₂} :
  ∀ (t : Table sch)
    (c : (c : η) × sch.HasCol (c, τ₁))
    (f : Option τ₁ → Option τ₂),
  header (transformColumn t c f) = header t :=
λ t c f => sch.retypeColumn_preserves_names _ _

theorem transformColumn_spec4 :
  ∀ (t : Table sch)
    (c : (c : η) × sch.HasCol (c, τ₁))
    (f : Option τ₁ → Option τ₂),
  nrows (transformColumn t c f) = nrows t :=
λ t c f => List.length_map _ _

-- TODO: `renameColumns` specs 1 and 2

theorem renameColumns_spec3 :
  ∀ (t : Table sch)
    (ccs : ActionList Schema.renameColumnCN sch),
  nrows (renameColumns t ccs) = nrows t :=
λ _ _ => List.length_map _ _

-- The specification for `find` is contained in its type (`Option` corresponds
-- to "Error," and `Fin` restricts the range of the output)

-- TODO: `groupByRetentive` specs 2–6 (in progress)
theorem groupByRetentive_spec1 [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  header (groupByRetentive t c) = ["key", "groups"] :=
λ _ _ => rfl

theorem groupByRetentive_spec2
  {η : Type u_η} [DecidableEq η] {sch : @Schema η}
  {τ : Type u} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  (schema (groupByRetentive t c)).lookupType ⟨"key", Schema.HasName.hd⟩
    = ULift.{max (u+1) u_η} τ :=
λ _ _ => rfl

theorem groupByRetentive_spec3
  {η : Type u_η} [DecidableEq η] {sch : @Schema η}
  {τ : Type u} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  (schema (groupByRetentive t c)).lookupType ⟨"groups", .tl .hd⟩ = Table sch :=
λ _ _ => rfl

-- Need decidable equality of `ULift`s for `groupBy{Retentive,Subtractive}`
deriving instance DecidableEq for ULift

def Function.injective (f : α → β) := ∀ {x y}, f x = f y → x = y
def Function.biInjective (f : α → β → γ) := ∀ x₁ x₂ y₁ y₂, f x₁ x₂ = f y₁ y₂ → x₁ = y₁ ∧ x₂ = y₂

theorem List.groupByKey_fsts_no_duplicates [DecidableEq κ] (xs : List (κ × ν)) :
  NoDuplicates $ (groupByKey xs).map Prod.fst := sorry

theorem Cell.toOption_fromOption {nm : η} :
  ∀ (v : Option τ), toOption (fromOption (nm := nm) v) = v
| none => rfl
| some x => rfl

-- TODO: this cannot possibly be useful... delete?
theorem List.mem_exists {x : α} {xs : List α} :
  x ∈ xs ↔ ∃ y, y ∈ xs ∧ x = y := by
  apply Iff.intro
  . intros hf
    induction hf with
    | head x xs =>
      apply Exists.intro x
      apply And.intro (List.Mem.head _ _) rfl
    | tail x' xs ih =>
      apply Exists.elim ih
      intros yih hyih
      apply Exists.intro yih
      apply And.intro
      . apply List.Mem.tail _ hyih.left
      . apply hyih.right
  . intros hb
    apply Exists.elim hb
    intros y hy
    cases hy with | intro hmem heq =>
    rw [heq]
    apply hmem

theorem List.no_dups_of_cons : List.NoDuplicates (x :: xs) → List.NoDuplicates xs := sorry

theorem List.mem_of_mem_injective_map (f : α → β) (hf : f.injective) :
  ∀ (x : α) (xs : List α),
  f x ∈ map f xs → x ∈ xs := λ x xs h => sorry
  -- List.Mem.recOn (motive := (λ a as hmem => x ∈ xs
  --   -- hmem.casesOn (λ b bs => b ∈ bs) (λ b c bs mtv => b ∈ bs)
  --   -- match hmem with
  --   -- | Mem.head .(a) .(as) => sorry
  --   -- | Mem.tail _ _ => sorry
  -- )) h
  --   (λ a as => sorry)
  --   sorry

  -- := by
  -- intros x xs hin
  -- cases xs with | nil => contradiction | cons x' xs =>
  -- simp only [map] at hin

theorem List.no_dups_map_injective
  (f : α → β) (hf : f.injective) : ∀ (xs : List α) (hxs : NoDuplicates xs),
  NoDuplicates $ map f xs
| [], hxs => NoDuplicates.nil
| x :: xs, NoDuplicates.cons _ _ hxnin hndxs =>
  NoDuplicates.cons (f x) (map f xs)
    (λ hneg => absurd (mem_of_mem_injective_map f hf x xs hneg) hxnin)
    (no_dups_map_injective f hf xs hndxs)

-- TODO: this should be an interesting challenge...
-- set_option pp.explicit true
theorem groupByRetentive_spec4 [inst : DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  (getColumn2 (groupByRetentive t c) "key" Schema.HasCol.hd).NoDuplicates := by
  intros t c
  simp only [groupByRetentive, groupBy, getColumn2]
  rw [List.map_map]
  simp only [Function.comp, getValue, Row.getCell]
  conv =>
    rhs
    lhs
    apply funext (f₂ := _) _
    apply (λ x => Option.map ULift.up x.fst)
    -- `intros` doesn't seem to be working in `conv` mode?
    apply (λ x => Cell.toOption_fromOption _)
  conv =>
    rhs
    lhs
    apply funext (f₂ := _) _
    apply (λ x => Option.map ULift.up ∘ Prod.fst)
    apply (λ x => rfl)
  rw [←List.map_map]
  apply List.no_dups_map_injective
  -- Show `Option.map ULift.up` is injective
  . intros x y hxy
    cases x
    . cases y
      . rfl
      . contradiction
    . cases y
      . contradiction
      . cases hxy; rfl
  . apply List.groupByKey_fsts_no_duplicates

  -- simp only [getColumn2]
  -- simp only [groupByRetentive]
  -- cases c with | mk c pf =>
  -- simp only
  -- apply groupBy_specPlus
  -- intros x₁ x₂ y₁ y₂ heq
  -- simp at heq
  -- cases heq with | intro left right =>
  -- apply And.intro
  -- . have fromOpt_inj {η} [i : DecidableEq η] {nm : η} {δ} : Function.injective (Cell.fromOption (nm := nm) (τ := δ))
  --   | some x, some y, heq => by cases heq; rfl
  --   | none, none, heq => rfl
  --   have optMap_inj {α β} (f : α → β) (h : f.injective) : Function.injective (Option.map f)
  --   | some x, some y, heq => by
  --     simp only [Option.map, Option.bind, Function.comp] at heq
  --     injection heq with heq'
  --     apply congrArg _ (h heq')
  --   | none, none, _ => rfl
  --   have := fromOpt_inj left
  --   have := optMap_inj ULift.up (by intros x y hxy; cases hxy; rfl) this
  --   exact this
  -- . exact right

theorem groupByRetentive_spec5
  {η : Type u_η} {τ : Type u} [dec_η : DecidableEq η]
  {sch : @Schema η} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  ∀ t', t' ∈ (getColumn2 (groupByRetentive t c) "groups" (.tl .hd)).somes →
  schema t' = sch :=
λ _ _ _ _ => rfl

theorem groupByRetentive_spec6
  {η : Type u_η} {τ : Type u} [dec_η : DecidableEq η]
  {sch : @Schema η} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  nrows (groupByRetentive t c) = (getColumn2 t c.1 c.2).unique.length :=
λ t c =>
  groupBy_spec4 (sch' := [("key", ULift.{max (u+1) u_η} τ),
                          ("groups", Table sch)])
    t
    (λ r => getValue r c.1 c.2)
    (λ r => r)
    (λ k vs => Row.cons (Cell.fromOption (Option.map ULift.up k))
                        (Row.cons (Cell.val (Table.mk vs)) Row.nil))

theorem groupBySubtractive_spec1 [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  header (groupBySubtractive t c) = ["key", "groups"] :=
λ _ _ => rfl

theorem groupBySubtractive_spec2
  {η : Type u_η} [DecidableEq η] {sch : @Schema η}
  {τ : Type u} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  (schema (groupBySubtractive t c)).lookupType ⟨"key", Schema.HasName.hd⟩
    = ULift.{max (u+1) u_η} τ :=
λ _ _ => rfl

theorem groupBySubtractive_spec3
  {η : Type u_η} [DecidableEq η] {sch : @Schema η}
  {τ : Type u} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  (schema (groupBySubtractive t c)).lookupType ⟨"groups", .tl .hd⟩ =
  Table (sch.removeName (Schema.colImpliesName c.snd)) :=
λ _ _ => rfl

-- TODO: `groupBySubtractive` spec 4

-- Closest approximation possible given uniqueness issues
theorem groupBySubtractive_spec5
  {η : Type u_η} [DecidableEq η] {sch : @Schema η}
  {τ : Type u} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  ∀ t', t' ∈ (getColumn2 (groupBySubtractive t c) "groups" (.tl .hd)).somes →
  header t' = Schema.names (sch.removeName (Schema.colImpliesName c.2)) :=
λ _ _ _ _ => rfl

theorem groupBySubtractive_spec6
  {η : Type u_η} {τ : Type u} [dec_η : DecidableEq η]
  {sch : @Schema η} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  ∀ t', t' ∈ (getColumn2 (groupBySubtractive t c) "groups" (.tl .hd)).somes →
  List.Sublist (schema t') sch :=
λ _ c _ _ => Schema.removeName_sublist sch c.1 (Schema.colImpliesName c.2)

theorem groupBySubtractive_spec7
  {η : Type u_η} {τ : Type u} [dec_η : DecidableEq η]
  {sch : @Schema η} [DecidableEq τ] :
  ∀ (t : Table sch) (c : (c : η) × sch.HasCol (c, τ)),
  nrows (groupBySubtractive t c) = (getColumn2 t c.1 c.2).unique.length :=
λ t c =>
  groupBy_spec4
    t
    (λ r => getValue r c.1 c.2)
    (λ r => r)
    (λ k vs => Row.cons (Cell.fromOption (Option.map ULift.up k))
                        (Row.cons (Cell.val (Table.mk (vs.map (λ r =>
                          Row.removeColumn (Schema.colImpliesName c.snd) r))))
                        Row.nil))

-- TODO: `update` (once correctly implemented)

-- Specs 1, 2, and 3 are enforced by types
theorem select_spec4 {sch' : @Schema η} :
  ∀ (t : Table sch) (f : Row sch → Fin (nrows t) → Row sch'),
  nrows (select t f) = nrows t :=
λ t f => Eq.trans (List.length_map _ _) (List.length_verifiedEnum _)

-- All `selectMany` specifications are enforced by types

-- Specs 1 through 5 are enforced by types
theorem groupJoin_spec6
  {κ} [DecidableEq κ] {ν : Type _} {s₁ s₂ s₃ : @Schema η} :
  ∀ (t₁ : Table s₁) (t₂ : Table s₂)
    (getKey₁ : Row s₁ → κ) (getKey₂ : Row s₂ → κ)
    (aggregate : Row s₁ → Table s₂ → Row s₃),
  nrows (groupJoin t₁ t₂ getKey₁ getKey₂ aggregate) =
  nrows t₁ :=
λ _ _ _ _ _ => select_spec4 _ _

-- All `join` specifications are enforced by types