import cfr

example (a b : rat) : (¬ a < b) ∧ (¬ b < a) → a = b := by exact eq_of_incomp

def dice := list.to_buffer [1,2,3,4,5,6]
def claims := list.to_buffer [(1,2), (1,3), (1,4), (1,5), (1,6), (1,1), (2,2), (2,3), (2,4), (2,5), (2,6), (2,1)]
def AllowedClaim := {i // ∃ v, claims.read i = v}
instance : has_lt AllowedClaim := ⟨ fun a b, a.val < b.val ⟩
instance AllowedClaim_decidable_rel : decidable_rel ((<) : AllowedClaim → AllowedClaim → Prop) := infer_instance

inductive Action
| Claim (claim : AllowedClaim) : Action
| Dudo : Action

def Action.show : Action → string
| (Action.Claim ⟨ i, _⟩ ) := "Claim " ++ has_repr.repr (claims.read i)
| Action.Dudo := "Dudo"

instance : has_repr Action := ⟨ Action.show ⟩

def actions.begin := claims.attach_index
def actions.later := (actions.begin.iterate buffer.nil (fun i x s, s.push_back $ Action.Claim x)).push_back Action.Dudo

def Die := {die // die ∈ dice}
instance : has_lt Die := ⟨ fun a b, a.val < b.val ⟩
instance Die_decidable_rel : decidable_rel ((<) : Die → Die → Prop) := infer_instance

@[derive has_lt] def History := Die × list AllowedClaim
instance History_decidable_rel : decidable_rel ((<) : History → History → Prop) := infer_instance

def ℍ𝔸 : History → Type*
    | (die, []) := AllowedClaim
    | (die, _) := Action

def ha : HistoryToActions History ℍ𝔸
    | (_, []) := ⟨ actions.begin.1, actions.begin.read ⟩
    | (_, x :: xs) :=
        -- TODO: The way buffer.drop behaves on out of bounds is wonky. Replace it.
        let v := actions.later.drop (x.1 + 1) in ⟨ v.1, v.read ⟩

structure Particle (α : Type*) := mk ::
    (state : α)
    (probability : ℚ)
    (is_updateable : bool)

namespace game
def state := state (Infosets ha)
def read_dice (i : fin dice.1) : Die := ⟨ dice.read i, ⟨ i, rfl ⟩ ⟩

def chance (one : Particle unit) (next : Particle Die → state rat) : state rat :=
    chance_uniform ha ⟨ dice.1, read_dice ⟩ one.probability
        (fun dice prob, next {state:=dice, probability:=prob*one.probability, ..one})

def response (one two : Particle Die) (h : list AllowedClaim)
        (next : ℍ𝔸 ⟨ one.state, h ⟩ → Particle Die → state rat)
        : state rat :=
    response ha one.is_updateable one.probability two.probability ⟨ one.state, h ⟩
        (fun action prob, next action {probability:=prob, ..one})

def terminal := terminal ha

meta def dudo.main : Particle Die → Particle Die → list AllowedClaim → state rat
    | one two [] := response one two [] (fun action one, dudo.main two one [action])
    | one two h@(⟨i, _⟩ :: _) :=
        response one two h $ fun action one,
            match action with
            | Action.Dudo :=
                let (number, rank) := claims.read i in
                let check_guess (s x : nat) := if x = 1 ∨ x = rank then s+1 else s in
                let dice_guessed := check_guess (check_guess 0 one.state.val) two.state.val in
                terminal $ if dice_guessed < number then 1.0 else -1.0
            | Action.Claim claim := dudo.main two one (claim :: h)
            end

meta def dudo.initial (one : Particle unit) (two : Particle unit) : state rat :=
    chance one $ fun one,
        chance two $ fun two,
            dudo.main one two []

meta def train (num_iterations : nat): rat × Infosets ha :=
    let particle : Particle unit := {state:=(), probability:=1, is_updateable:=ff} in
    let particle_tt : Particle unit := {is_updateable:=tt, ..particle} in
    @nat.foldl.fin (fun i, rat × Infosets ha)
        num_iterations (0, buffer.nil)
        (fun i ⟨ util, infosets ⟩,
            let (util, infosets) := (dudo.initial {is_updateable:=tt, ..particle} particle).run infosets in
            let (util', infosets) := (dudo.initial particle {is_updateable:=tt, ..particle}).run infosets in
            ((util + util') / 2, infosets)
            )

end game


import model_theory.substructures
import model_theory.bundled

--OUTPUT 1
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  sorry,
end

--OUTPUT 2
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  let A := λ n : ℕ, ∃ (x1 : F.Model.sort 1) (x2 : F.Model.sort 1) (xs : fin n → F.Model.sort 1),
      ∀ (x : fin n), x1 ≠ x2 ∧ x1 ≠ xs x ∧ ∀ (x y : fin n), x ≠ y → xs x ≠ xs y,
  have hA : ∀ (n : ℕ), A n, from sorry,
  let Gamma := F.axioms ∪ { A n | n : ℕ},
  have hGamma : ∀ (n : ℕ), ∃ (m : F.Model), (F.Model.satisfies m) Gamma, from sorry,
  have h1 : F.Model.satisfies (F.Model.compact_closure Gamma), from sorry,
  have h2 : ∀ (n : ℕ), F.Model.satisfies (F.Model.compact_closure Gamma) (A n), from sorry,
  have h3 : infinite (F.Model.compact_closure Gamma), from sorry,
  show ∃ (M : F.Model), infinite M, from sorry,
end

--OUTPUT 3
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  assume L : first_order.language,
  assume F : L.Theory,
  assume h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin,

  let Γ : set L.formula := sorry,
  have h1 : ∀ s : set L.formula, finite s → (∃ (m : F.Model), s ⊆ m) → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h2 : ∀ s : set L.formula, finite s → (∃ (m : F.Model), s ⊆ m), from sorry,
  have h3 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h4 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h5 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h6 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h7 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h8 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h9 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h10 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h11 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h12 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h13 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h14 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h15 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h16 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h17 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h18 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h19 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h20 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h21 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h22 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h23 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h24 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h25 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h26 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h27 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h28 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h29 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h30 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h31 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h32 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h33 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h34 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h35 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h36 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h37 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h38 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h39 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h40 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h41 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h42 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h43 : ∀ s : set L.formula, finite s → s ⊆ Γ → ∃ (m : F.Model), s ⊆ m, from sorry,
  have h44 : ∀ s : set L.formula, finite s → s ⊆
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h2 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h3 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h4 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h5 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h6 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h7 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h8 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h9 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h10 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h11 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h12 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h13 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h14 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h15 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h16 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h17 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h18 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h19 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h20 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h21 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h22 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h23 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h24 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h25 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h26 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h27 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h28 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h29 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h30 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h31 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h32 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h33 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h34 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h35 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h36 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h37 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h38 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h39 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h40 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h41 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h42 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h43 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h44 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h45 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h46 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h47 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h48 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h49 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h50 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h51 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h52 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h53 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
  have h54 : ∀ n : ℕ, ∃ (m : F.Model), n ≤ @fintype.card m _, from sorry,
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∃ (x : ℕ) (m : F.Model) [mfin : fintype m], x = fintype.card m, from sorry,
  have h2 : ∃ (m : F.Model) [mfin : fintype m], 1 ≤ @fintype.card m mfin, from sorry,
  have h3 : ∃ (m : F.Model) [mfin : fintype m], 2 ≤ @fintype.card m mfin, from sorry,
  have h4 : ∃ (m : F.Model) [mfin : fintype m], 3 ≤ @fintype.card m mfin, from sorry,

  have h5 : ∃ (m : F.Model) [mfin : fintype m], 4 ≤ @fintype.card m mfin, from sorry,
  have h6 : ∃ (m : F.Model) [mfin : fintype m], 5 ≤ @fintype.card m mfin, from sorry,
  have h7 : ∃ (m : F.Model) [mfin : fintype m], 6 ≤ @fintype.card m mfin, from sorry,
  have h8 : ∃ (m : F.Model) [mfin : fintype m], 7 ≤ @fintype.card m mfin, from sorry,
  have h9 : ∃ (m : F.Model) [mfin : fintype m], 8 ≤ @fintype.card m mfin, from sorry,

  have h10 : ∃ (m : F.Model) [mfin : fintype m], 9 ≤ @fintype.card m mfin, from sorry,
  have h11 : ∃ (m : F.Model) [mfin : fintype m], 10 ≤ @fintype.card m mfin, from sorry,
  have h12 : ∃ (m : F.Model) [mfin : fintype m], 11 ≤ @fintype.card m mfin, from sorry,
  have h13 : ∃ (m : F.Model) [mfin : fintype m], 12 ≤ @fintype.card m mfin, from sorry,
  have h14 : ∃ (m : F.Model) [mfin : fintype m], 13 ≤ @fintype.card m mfin, from sorry,

  have h15 : ∃ (m : F.Model) [mfin : fintype m], 14 ≤ @fintype.card m mfin, from sorry,
  have h16 : ∃ (m : F.Model) [mfin : fintype m], 15 ≤ @fintype.card m mfin, from sorry,
  have h17 : ∃ (m : F.Model) [mfin : fintype m], 16 ≤ @fintype.card m mfin, from sorry,
  have h18 : ∃ (m : F.Model) [mfin : fintype m], 17 ≤ @fintype.card m mfin, from sorry,
  have h19 : ∃ (m : F.Model) [mfin : fintype m], 18 ≤ @fintype.card m mfin, from sorry,

  have h20 : ∃ (m : F.Model) [mfin : fintype m], 19 ≤ @fintype.card m mfin, from sorry,
  have h21 : ∃ (m : F.Model) [mfin : fintype m], 20 ≤ @fintype.card m mfin, from sorry,
  have h22 : ∃ (m : F.Model) [mfin : fintype m], 21 ≤ @fintype.card m mfin, from sorry,
  have h23 : ∃ (m : F.Model) [mfin : fintype m], 22 ≤ @fintype.card m mfin, from sorry,
  have h24 : ∃ (m : F.Model) [mfin : fintype m], 23 ≤ @fintype.card m mfin, from sorry,

  have h25 : ∃ (m : F.Model) [mfin : fintype m], 24 ≤ @fintype.card m mfin, from sorry,
  have h26 : ∃ (m : F.Model) [mfin : fintype m], 25 ≤ @fintype.card m mfin, from sorry,
  have h27 : ∃ (m : F.Model) [mfin : fintype m], 26 ≤ @fintype.card m mfin, from sorry,
  have h28 : ∃ (m : F.Model) [mfin : fintype m], 27 ≤ @fintype.card m mfin, from sorry,
  have h29 : ∃ (m : F.Model) [mfin : fintype m], 28 ≤ @fintype.card m mfin, from sorry,

  have h30 : ∃ (m : F.Model) [mfin : fintype m], 29 ≤ @fintype.card m mfin, from sorry,
  have h31 : ∃ (m : F.Model) [mfin : fintype m], 30 ≤ @fintype.card m mfin, from sorry,
  have h32 : ∃ (m : F.Model) [mfin : fintype m], 31 ≤ @fintype.card m mfin, from sorry,
  have h33 : ∃ (m : F.Model) [mfin : fintype m], 32 ≤ @fintype.card m mfin, from sorry,
  have h34 : ∃ (m : F.Model) [mfin : fintype m], 33 ≤ @fintype.card m mfin, from sorry,

  have h35 : ∃ (m : F.Model) [mfin : fintype m], 34 ≤ @fintype.card m mfin, from sorry,
  have h36 : ∃ (m : F.Model) [mfin : fintype m], 35 ≤ @fintype.card m mfin, from sorry,
  have h37 : ∃ (m : F.Model) [mfin : fintype m], 36 ≤ @fintype.card m mfin, from sorry,
  have h38 : ∃ (m : F.Model) [mfin : fintype m], 37 ≤ @fintype.card m mfin, from sorry,
  have h39 : ∃ (m : F.Model) [mfin : fintype m], 38 ≤ @fintype.card m mfin, from sorry,

  have h40 : ∃ (m : F.Model) [mfin : fintype m], 39 ≤ @fintype.card m mfin, from sorry,
  have h41 : ∃ (m : F.Model) [mfin : fintype m], 40 ≤ @fintype.card m mfin, from sorry,
  have h42 : ∃ (m : F.Model) [mfin : fintype m], 41 ≤ @fintype.card m mfin, from sorry,
  have h43 : ∃ (m : F.Model) [mfin : fintype m], 42 ≤ @fintype.card m mfin, from sorry,
  have h44 : ∃ (m : F.Model) [mfin : fintype m], 43 ≤ @fintype.card m mfin, from sorry,

  have h45 : ∃ (m : F.Model) [mfin : fintype m], 44 ≤ @fintype.card m mfin, from sorry,
  have h46 : ∃ (m : F.Model) [mfin : fintype m], 45 ≤ @fintype.card m mfin, from sorry,
  have h47 : ∃ (m : F.Model) [mfin : fintype m], 46 ≤ @fintype.card m mfin, from sorry,
  have h48 : ∃ (m : F.Model) [mfin : fintype m], 47 ≤ @fintype.card m mfin, from sorry,
  have h49 : ∃ (m : F.Model) [mfin : fintype m], 48 ≤ @fintype.card m mfin, from sorry,

  have h50 : ∃ (m : F.Model) [mfin : fintype m], 49 ≤ @fintype.card m mfin, from sorry,
  have h51 : ∃ (m : F.Model) [mfin : fintype m], 50 ≤ @fintype.card m mfin, from sorry,
  have h52
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  assume (n : ℕ),
  let A : L.Theory := F.union (L.Theory.of (L.model_of_nat n)),
  have h1 : ∀ (s : finset F.Model), (∀ (m : F.Model) (H : m ∈ s), m.satisfies A) → ∃ (M : F.Model), M.satisfies A, from sorry,
  have h2 : ∀ (s : finset F.Model), (∀ (m : F.Model) (H : m ∈ s), m.satisfies A) → ∃ (M : F.Model), M.satisfies A ∧ infinite M, from sorry,
  have h3 : ∃ (M : F.Model), M.satisfies A ∧ infinite M, from sorry,
  show ∃ (M : F.Model), infinite M, from sorry,
end

--OUTPUT 7
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  sorry,
end

--OUTPUT 8
theorem overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
begin
  have h1 : ∀ n : ℕ, ∃ (A : F.Model), n ≤ fintype.card A, from sorry,
  have h2 : ∀ n : ℕ, F.Formula.Existential n ∈ F.Theory.satisfiable, from sorry,
  have h3 : ∀ n : ℕ, F.Formula.ForAll n ∈ F.Theory.satisfiable, from sorry,
  have h4 : ∀ n : ℕ, ∃ (A : F.Model), F.Formula.ForAll n ∈ F.Model.satisfy A, from sorry,

  have h5 : ∀ n : ℕ,  F.Formula.ForAll (n + 1), from sorry,
  have h6 : ∀ n : ℕ,  F.Formula.ForAll (n + 2), from sorry,

  have h7 : ∀ n : ℕ,  F.Formula.ForAll (n + 3), from sorry,

  have h8 : ∀ n : ℕ,  F.Formula.ForAll (n + 4), from sorry,
  have h9 : ∀ n : ℕ,  F.Formula.ForAll (n + 5), from sorry,

  have h10 : ∀ n : ℕ,  F.Formula.ForAll (n + 6), from sorry,

  have h11 : ∀ n : ℕ,  F.Formula.ForAll (n + 7), from sorry,
  have h12 : ∀ n : ℕ,  F.Formula.ForAll (n + 8), from sorry,

  have h13 : ∀ n : ℕ,  F.Formula.ForAll (n + 9), from sorry,
  have h14 : ∀ n : ℕ,  F.Formula.ForAll (n + 10), from sorry,

  have h15 : ∀ n : ℕ,  F.Formula.ForAll (n + 11), from sorry,
  have h16 : ∀ n : ℕ,  F.Formula.ForAll (n + 12), from sorry,

  have h17 : ∀ n : ℕ,  F.Formula.ForAll (n + 13), from sorry,
  have h18 : ∀ n : ℕ,  F.Formula.ForAll (n + 14), from sorry,

  have h19 : ∀ n : ℕ,  F.Formula.ForAll (n + 15), from sorry,
  have h20 : ∀ n : ℕ,  F.Formula.ForAll (n + 16), from sorry,

  have h21 : ∀ n : ℕ,  F.Formula.ForAll (n + 17), from sorry,
  have h22 : ∀ n : ℕ,  F.Formula.ForAll (n + 18), from sorry,

  have h23 : ∀ n : ℕ,  F.Formula.ForAll (n + 19), from sorry,
  have h24 : ∀ n : ℕ,  F.Formula.ForAll (n + 20), from sorry,

  have h25 : ∀ n : ℕ,  F.Formula.ForAll (n + 21), from sorry,
  have h26 : ∀ n : ℕ,  F.Formula.ForAll (n + 22), from sorry,

  have h27 : ∀ n : ℕ,  F.Formula.ForAll (n + 23), from sorry,
  have h28 : ∀ n : ℕ,  F.Formula.ForAll (n + 24), from sorry,

  have h29 : ∀ n : ℕ,  F.Formula.ForAll (n + 25), from sorry,
  have h30 : ∀ n : ℕ,  F.Formula.ForAll (n + 26), from sorry,

  have h31 : ∀ n : ℕ,  F.Formula.ForAll (n + 27), from sorry,
  have h32 : ∀ n : ℕ,  F.Formula.ForAll (n + 28), from sorry,

  have h33 : ∀ n : ℕ,  F.Formula.ForAll (n + 29), from sorry,
  have h34 : ∀ n : ℕ,  F.Formula.ForAll (n + 30), from sorry,

  have h35 : ∀ n : ℕ,  F.Formula.ForAll (n + 31), from sorry,
  have h36 : ∀ n : ℕ,  F.Formula.ForAll (n + 32), from sorry,

  have h37 : ∀ n : ℕ,  F.Formula.ForAll (n + 33), from sorry,
  have h38 : ∀ n : ℕ,  F.Formula.ForAll (n + 34), from sorry,

  have h39 : ∀ n : ℕ,  F.Formula.ForAll (n + 35), from sorry,
  have h40 : ∀ n : ℕ,  F.Formula.ForAll (n + 36), from sorry,

  have h41 : ∀ n : ℕ,  F.Formula.ForAll (n + 37), from sorry,
  have h42 : ∀ n : ℕ,  F.Formula.ForAll (n + 38), from sorry,

  have h43 : ∀ n : ℕ,  F.Formula.ForAll (n + 39), from sorry,
  have h44 : ∀ n : ℕ,  F.Formula.ForAll (n + 40), from sorry,

  have h45 : ∀ n : ℕ,  F.Formula.ForAll (n + 41), from sorry,
  have h46 : ∀ n : ℕ,  F.Formula.ForAll (n + 42), from sorry,

  have h47 : ∀ n : ℕ,  F.Formula.ForAll (n + 43), from sorry,
  have h48 : ∀ n : ℕ,  F.Formula.ForAll (n + 44), from sorry,

  have h49 : ∀ n : ℕ,  F.Formula.ForAll (n + 45), from sorry,
  have h50 : ∀ n : ℕ,  F.Formula.ForAll (n + 46), from sorry,

  have h51 : ∀ n : ℕ,  F.Formula.ForAll (n + 47), from sorry,
  have h52 : ∀ n : ℕ,  F.Formula.ForAll (n + 48), from sorry,

  have h53 : ∀ n : ℕ,  F.Formula.ForAll (n + 49), from sorry,
  have h54 : ∀ n : ℕ,  F.Formula.ForAll (n + 50), from sorry,

  have h55 : ∀ n : ℕ,  F.Formula.ForAll (n + 51), from sorry,
  have h56 : ∀ n : ℕ,  F.Formula.ForAll (n + 52), from sorry,

  have h57 : ∀ n : ℕ,  F.Formula.ForAll (n + 53), from sorry,
  have h58 : ∀ n : ℕ,  F.Formula.ForAll (n + 54), from sorry,

  have h59 : ∀ n : ℕ,  F.Formula.ForAll (n + 55), from sorry,
  have h60 : ∀ n : ℕ,  F.Formula.ForAll (n + 56), from sorry,

  have h61 : ∀ n : ℕ,  F.Formula.ForAll (n + 57), from sorry,
  have h62 : ∀ n : ℕ,  F.Formula.ForAll (n + 58), from sorry,

  have h63 : ∀ n : ℕ,  F.Formula.ForAll (n + 59), from sorry,
  have h64 : ∀ n : ℕ,  F.Formula.ForAll (n + 60), from sorry,

  have h65 : ∀ n : ℕ,  F.Formula.ForAll (n + 61), from sorry,
  have h66 : ∀ n : ℕ,
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Overflow theorem
Let $F$ be a set of first-order formulas which has finite models of arbitrarily large size. Then $F$ has an infinite model.
`proof`
For each $n$, let $\mathbf A_n$ be the formula:

$\exists x_1 \exists x_2 \ldots \exists x_n: \{x_1 \ne x_2 \land x_1 \ne x_3 \land \ldots \land x_{n - 1} \ne x_n\}$

Then $\mathbf A_i$ is true in a structure $\AA$ iff $\AA$ has at least $n$ elements.

Take:
$$ \Gamma := F \cup \bigcup_{i \mathop = 1}^\infty A_i $$

Since $F$ has models of arbitrarily large size, every finite subset of $\Gamma$ is satisfiable.

From the Compactness Theorem, $\Gamma$ is satisfiable in some model $\mathbf{M}$.

But since $\mathbf{M} \models A_i$ for each $i$, $\mathbf{M}$ must be infinite.

So $F$ has an infinite model.

QED
-/
theorem  overflow {L : first_order.language} {F : L.Theory} (h : ∀ n : ℕ, ∃ (m : F.Model) [mfin : fintype m], n ≤ @fintype.card m mfin) : ∃ (M : F.Model), infinite M :=
FEW SHOT PROMPTS TO CODEX(END)-/


import for_mathlib.split_exact
import category_theory.limits.preserves.shapes.biproducts
import category_theory.limits.constructions.finite_products_of_binary_products

noncomputable theory

universes v u₁ u₂
open_locale tensor_product

open category_theory category_theory.limits opposite

section
variables {𝓐 : Type u₁} {𝓑 : Type u₂} [category.{v} 𝓐] [category.{v} 𝓑] (F : 𝓐 ⥤ 𝓑)
variables [abelian 𝓐] [abelian 𝓑]

def preserves_limits_of_shape_pempty_of_preserves_terminal
  [preserves_limit (functor.empty.{v} 𝓐) F] : preserves_limits_of_shape (discrete pempty) F :=
{ preserves_limit := λ K,
    preserves_limit_of_iso_diagram.{v v} F (functor.empty_ext (functor.empty 𝓐) _) }

def preserves_terminal_object_of_preserves_zero_morphisms
  [functor.preserves_zero_morphisms F] : preserves_limit (functor.empty 𝓐) F :=
preserves_terminal_of_iso F $
  (F.map_iso has_zero_object.zero_iso_terminal.symm).trans $
  (functor.map_zero_object F).trans $
  has_zero_object.zero_iso_terminal

def iso_of_ι {X Y : 𝓐} (f g : X ⟶ Y) (c : cone (parallel_pair f g)) :
  c ≅ fork.of_ι (fork.ι c) (fork.condition c) :=
fork.ext (iso.refl _) (by tidy)

def preserves_equalizer_of_preserves_kernels [F.additive]
  [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F] {X Y : 𝓐}
  (f g : X ⟶ Y) : preserves_limit (parallel_pair f g) F :=
begin
  constructor, intros c i,
  let c' := preadditive.is_limit_kernel_fork_of_fork (i.of_iso_limit (iso_of_ι _ _ c)),
  let iFc := is_limit_fork_map_of_is_limit' F (by simp) c',
  apply is_limit.of_iso_limit _ ((cones.functoriality _ F).map_iso (iso_of_ι _ _ c).symm),
  apply (is_limit_map_cone_fork_equiv F (fork.condition c)).inv_fun,
  let p : parallel_pair (F.map (f - g)) 0 ≅ parallel_pair (F.map f - F.map g) 0,
  { exact parallel_pair.ext (iso.refl _) (iso.refl _) (by simp) (by simp) },
  refine is_limit.of_iso_limit (preadditive.is_limit_fork_of_kernel_fork
    ((is_limit.postcompose_hom_equiv p _).symm iFc)) _,
  refine fork.ext (iso.refl _) _,
  dsimp only [p, preadditive.fork_of_kernel_fork, cones.postcompose, ← fork.app_zero_eq_ι],
  simp [- fork.app_zero_eq_ι]
end

def preserves_equalizers_of_preserves_kernels [F.additive]
  [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F] :
  preserves_limits_of_shape walking_parallel_pair F :=
{ preserves_limit := λ K,
  begin
    letI := preserves_equalizer_of_preserves_kernels F
      (K.map walking_parallel_pair_hom.left) (K.map walking_parallel_pair_hom.right),
    apply preserves_limit_of_iso_diagram F (diagram_iso_parallel_pair K).symm
  end }

-- todo: unify with `exact_comp_mono_iff`
lemma exact_comp_mono_iff' {X Y Z A : 𝓐} (f : X ⟶ Y) (g : Y ⟶ Z) (h : Z ⟶ A) [mono h]:
  exact f (g ≫ h) ↔ exact f g :=
begin
  refine ⟨λ hfg, ⟨zero_of_comp_mono h (by rw [category.assoc, hfg.1]), _⟩, λ h, exact_comp_mono h⟩,
  rw ← (iso.eq_comp_inv _).1 (image_to_kernel_comp_mono _ _ h hfg.1),
  haveI := hfg.2, apply epi_comp
end

end

lemma preserves_finite_limits_of_preserves_mono_preserves_finite_colimits
  {𝓐 : Type u₁} {𝓑 : Type u₂} [category.{v} 𝓐] [category.{v} 𝓑] [abelian 𝓐] [abelian 𝓑]
  (F : 𝓐 ⥤ 𝓑) (h1 : ∀ ⦃X Y : 𝓐⦄ (f : X ⟶ Y), mono f → mono (F.map f))
  [preserves_finite_colimits F] :
  preserves_finite_limits F :=
begin
  haveI : preserves_binary_biproducts F,
  { apply preserves_binary_biproducts_of_preserves_binary_coproducts },
  haveI : preserves_limits_of_shape (discrete walking_pair) F,
  { apply preserves_binary_products_of_preserves_binary_biproducts },
  haveI : F.additive,
  { apply functor.additive_of_preserves_binary_biproducts },
  haveI : ∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F,
  { intros X Y f,
    constructor,
    intros c hc,
    suffices hF : exact (F.map (fork.ι c)) (F.map f),
    { haveI : mono (F.map (fork.ι c)),
      { apply h1,
        exact limits.mono_of_is_limit_fork hc },
      let := abelian.is_limit_of_exact_of_mono _ _ hF,
      let α : parallel_pair f 0 ⋙ F ≅ parallel_pair (F.map f) 0,
      { refine diagram_iso_parallel_pair _ ≪≫ _,
        refine parallel_pair.ext (iso.refl _) (iso.refl _) (by simp) (by simp) },
      refine is_limit.postcompose_hom_equiv α _ _,
      refine this.of_iso_limit (cones.ext (iso.refl _) _),
      rintro (_|_),
      { simp, dsimp, simp },
      { simp } },
    let hc' := hc.of_iso_limit (iso_of_ι _ _ _),
    have := abelian.exact_of_is_kernel _ _ (kernel_fork.condition c) hc',
    simp_rw ← image.fac f at this,
    rw exact_comp_mono_iff' at this,
    let := abelian.is_colimit_of_exact_of_epi _ _ this,
    let q := is_colimit_cofork_map_of_is_colimit' F _ this,
    haveI : mono (F.map (image.ι f)),
    { apply h1, apply_instance },
    simp_rw ← image.fac f,
    rw [functor.map_comp, exact_comp_mono_iff'],
    exact abelian.exact_of_is_cokernel _ _ _ q },
  haveI : preserves_limits_of_shape walking_parallel_pair.{v} F,
  { apply preserves_equalizers_of_preserves_kernels },
  haveI : preserves_limit (functor.empty 𝓐) F,
  { apply preserves_terminal_object_of_preserves_zero_morphisms },
  haveI : preserves_limits_of_shape (discrete.{v} pempty) F,
  { apply preserves_limits_of_shape_pempty_of_preserves_terminal, },
  haveI p := preserves_finite_products_of_preserves_binary_and_terminal F,
  exact @preserves_finite_limits_of_preserves_equalizers_and_finite_products
    _ _ _ _ _ _ _ _ p,
end


import for_mathlib.derived.Ext_lemmas
import for_mathlib.Cech.homotopy
import for_mathlib.acyclic
import for_mathlib.exact_seq4
import for_mathlib.cech
import for_mathlib.chain_complex_exact
import for_mathlib.abelian_sheaves.exact
import for_mathlib.Cech.homotopy
import for_mathlib.wide_pullback_iso
import for_mathlib.equivalence_additive
import for_mathlib.op

import condensed.adjunctions2
import condensed.projective_resolution
import condensed.extr.equivalence
.

noncomputable theory

universes u

open category_theory category_theory.limits homotopy_category opposite
open function (surjective)

namespace condensed

set_option pp.universes true

-- ANNOYING!
instance presheaf_abelian : abelian (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) :=
category_theory.functor_category_is_abelian.{(u+2) u (u+1)}

-- ANNOYING!
instance ExtrDisc_presheaf_abelian : abelian (ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1}) :=
category_theory.functor_category_is_abelian.{(u+2) u (u+1)}

instance ExtrSheaf_abelian' : abelian (Sheaf ExtrDisc.proetale_topology.{u} Ab.{u+1}) :=
category_theory.Sheaf.abelian.{(u+2) u (u+1)}

instance ExtrSheaf_abelian : abelian (ExtrSheaf.{u} Ab.{u+1}) :=
category_theory.Sheaf.abelian.{(u+2) u (u+1)}

def Profinite_to_presheaf_Ab : Profinite.{u} ⥤ Profinite.{u}ᵒᵖ ⥤ Ab.{u+1} :=
yoneda ⋙ (whiskering_right _ _ _).obj (ulift_functor.{u+1} ⋙ AddCommGroup.free)

def Profinite_to_ExtrDisc_presheaf : Profinite.{u} ⥤ ExtrDisc.{u}ᵒᵖ ⥤ Type (u+1) :=
yoneda ⋙ (whiskering_left _ _ _).obj ExtrDisc_to_Profinite.op ⋙
  (whiskering_right _ _ _).obj ulift_functor.{u+1}

def Profinite_to_ExtrDisc_presheaf_Ab : Profinite.{u} ⥤ ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1} :=
yoneda ⋙ (whiskering_left _ _ _).obj ExtrDisc_to_Profinite.op ⋙
  (whiskering_right _ _ _).obj (ulift_functor.{u+1} ⋙ AddCommGroup.free)

def unsheafified_free_Cech' (F : arrow Profinite.{u}) :
  chain_complex (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) ℕ :=
simplicial_object.augmented.to_complex $
(((simplicial_object.augmented.whiskering _ _).obj Profinite_to_presheaf_Ab).obj
  F.augmented_cech_nerve)

def unsheafified_free_ExtrDiscr_Cech (F : arrow Profinite.{u}) :
  chain_complex (ExtrDisc.{u}ᵒᵖ ⥤ Ab.{u+1}) ℕ :=
simplicial_object.augmented.to_complex $
(((simplicial_object.augmented.whiskering _ _).obj Profinite_to_ExtrDisc_presheaf_Ab).obj
  F.augmented_cech_nerve)

def free_Cech' (F : arrow Profinite.{u}) :
  chain_complex (Condensed.{u} Ab.{u+1}) ℕ :=
(((simplicial_object.augmented.whiskering _ _).obj
  (Profinite_to_Condensed ⋙ CondensedSet_to_Condensed_Ab)).obj
  F.augmented_cech_nerve).to_complex

def free_ExtrDisc_Cech' (F : arrow Profinite.{u}) :
  chain_complex (ExtrSheaf.{u} Ab.{u+1}) ℕ :=
(((simplicial_object.augmented.whiskering _ _).obj
  (Profinite_to_ExtrDisc_presheaf_Ab ⋙ presheaf_to_Sheaf _ _)).obj
  F.augmented_cech_nerve).to_complex

def free_Cech (F : arrow Profinite.{u}) :
  chain_complex (Condensed.{u} Ab.{u+1}) ℤ :=
(homological_complex.embed $ complex_shape.embedding.nat_down_int_down).obj (free_Cech' F)

instance Condensed_ExtrSheaf_equiv_additive :
  functor.additive (Condensed_ExtrSheaf_equiv Ab.{u+1}).inverse :=
by constructor

def whiskering_Cech_comp_iso
  {C : Type*} [category C] {𝓐 : Type*} [category 𝓐] [abelian 𝓐] {𝓑 : Type*} [category 𝓑] [abelian 𝓑]
  (f : arrow C) [∀ (n : ℕ),
    has_wide_pullback f.right (λ (i : ulift (fin (n + 1))), f.left) (λ (i : ulift (fin (n + 1))), f.hom)]
  (F : C ⥤ 𝓐) (G : 𝓐 ⥤ 𝓑) (H : C ⥤ 𝓑) (E : F ⋙ G ≅ H) [G.additive] :
  (G.map_homological_complex _).obj ((((simplicial_object.augmented.whiskering _ _).obj F).obj
    f.augmented_cech_nerve).to_complex) ≅
  (((simplicial_object.augmented.whiskering _ _).obj H).obj f.augmented_cech_nerve).to_complex :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := E.app _
| i+1 := E.app _
end)
begin
  rintros i j (rfl : j + 1 = i),
  dsimp only [functor.map_homological_complex_obj_d,
    unsheafified_free_ExtrDiscr_Cech, free_ExtrDisc_Cech',
    simplicial_object.augmented.to_complex],
  rw [chain_complex.of_d, chain_complex.of_d],
  cases j,
  { dsimp only [whiskering_Cech_comp_iso._match_1],
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      nat_trans.comp_app, whisker_right_app, functor.const_comp_hom_app],
    rw [category.comp_id, category.comp_id, nat_iso.app_hom, ← E.hom.naturality],
    refl },
  {
    dsimp only [whiskering_Cech_comp_iso._match_1],
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.drop_obj,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      simplicial_object.whiskering_obj_obj_map,
      simplicial_object.boundary,
      nat_iso.app_hom],
    simp only [functor.map_sum, functor.map_zsmul, preadditive.comp_sum,
      preadditive.comp_zsmul, preadditive.sum_comp, preadditive.zsmul_comp],
    apply finset.sum_congr rfl, intros _ _,
    erw ← E.hom.naturality,
    refl, },
end

def free_Cech'_iso_ExtrDisc (F : arrow Profinite.{u}) :
  ((Condensed_ExtrSheaf_equiv _).inverse.map_homological_complex _).obj (free_Cech' F) ≅
  free_ExtrDisc_Cech' F :=
let e := ExtrDisc_sheafification_iso in
whiskering_Cech_comp_iso F
  (Profinite_to_Condensed.{u} ⋙ CondensedSet_to_Condensed_Ab.{u})
  ((Condensed_ExtrSheaf_equiv.{u u+2} Ab.{u+1}).inverse)
  (Profinite_to_ExtrDisc_presheaf_Ab.{u} ⋙ presheaf_to_Sheaf.{u+2 u u+1} ExtrDisc.proetale_topology.{u} Ab.{u+1}) $
nat_iso.of_components
(λ S, e.symm.app _)
begin
  intros S T f,
  dsimp only [nat_iso.app_hom],
  erw e.symm.hom.naturality,
  refl,
end

instance presheaf_to_Sheaf_additive :
  (presheaf_to_Sheaf.{u+2 u u+1} ExtrDisc.proetale_topology.{u} Ab.{u+1}).additive :=
category_theory.Sheaf.presheaf_to_Sheaf_additive

def acyclic_of_exact.induction_step_ex₂_aux
  {C : Type*} [category C] {𝓐 : Type*} [category 𝓐] [abelian 𝓐] {𝓑 : Type*} [category 𝓑] [abelian 𝓑]
  (f : arrow C) [∀ (n : ℕ),
    has_wide_pullback f.right (λ (i : ulift (fin (n + 1))), f.left) (λ (i : ulift (fin (n + 1))), f.hom)]
  (F : C ⥤ 𝓐) (G : 𝓐ᵒᵖ ⥤ 𝓑) [G.additive] :
  (G.map_homological_complex _).obj ((((simplicial_object.augmented.whiskering _ _).obj F).obj
    f.augmented_cech_nerve).to_complex).op ≅
  (((cosimplicial_object.augmented.whiskering _ _).obj (F.op ⋙ G)).obj
    f.augmented_cech_nerve.right_op).to_cocomplex :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := iso.refl _
| i+1 := iso.refl _
end)
begin
  rintros i j (rfl : i + 1 = j),
  dsimp only [functor.map_homological_complex_obj_d,
    unsheafified_free_ExtrDiscr_Cech, free_ExtrDisc_Cech',
    cosimplicial_object.augmented.to_cocomplex,
    simplicial_object.augmented.to_complex, homological_complex.op_d],
  rw [cochain_complex.of_d, chain_complex.of_d],
  cases i,
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      cosimplicial_object.augmented.to_cocomplex_d,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      cosimplicial_object.augmented.whiskering_obj_2,
      cosimplicial_object.augmented.whiskering_obj,
      nat_trans.comp_app, whisker_right_app,
      functor.const_comp_hom_app, functor.const_comp_inv_app],
    rw [category.comp_id, category.id_comp],
    refl, },
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.drop_obj,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      simplicial_object.whiskering_obj_obj_map,
      simplicial_object.boundary,
      cosimplicial_object.augmented.to_cocomplex_d,
      cosimplicial_object.augmented.drop_obj,
      cosimplicial_object.augmented.whiskering_obj_2,
      cosimplicial_object.augmented.whiskering_obj,
      cosimplicial_object.whiskering_obj_obj_map,
      cosimplicial_object.coboundary],
    simp only [G.map_sum, G.map_zsmul, op_sum, op_zsmul],
    refl, },
end

def free_ExtrDisc_Cech'_iso (F : arrow Profinite.{u}) :
  free_ExtrDisc_Cech' F ≅
  ((presheaf_to_Sheaf _ _).map_homological_complex _).obj (unsheafified_free_ExtrDiscr_Cech F) :=
(whiskering_Cech_comp_iso F _ _ _ $ iso.refl _).symm
/-
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := iso.refl _
| i+1 := iso.refl _
end)
begin
  rintros i j (rfl : j + 1 = i),
  dsimp only [functor.map_homological_complex_obj_d,
    unsheafified_free_ExtrDiscr_Cech, free_ExtrDisc_Cech',
    simplicial_object.augmented.to_complex],
  rw [chain_complex.of_d, chain_complex.of_d],
  cases j,
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      nat_trans.comp_app, whisker_right_app, functor.const_comp_hom_app],
    rw [category.comp_id, category.comp_id],
    refl, },
  { refine (category.id_comp _).trans ((category.comp_id _).trans _).symm,
    dsimp only [simplicial_object.augmented.to_complex_d,
      simplicial_object.augmented.drop_obj,
      simplicial_object.augmented.whiskering_obj_2,
      simplicial_object.augmented.whiskering_obj,
      simplicial_object.whiskering_obj_obj_map,
      simplicial_object.boundary],
    simp only [functor.map_sum, functor.map_zsmul],
    refl, },
end
-/

/-
def free_Cech_iso (F : arrow Profinite.{u}) :
  free_Cech F ≅ (homological_complex.embed $ complex_shape.embedding.nat_down_int_down).obj
  ((presheaf_to_Condensed_Ab.map_homological_complex _).obj
  (unsheafified_free_Cech' F)) :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| int.of_nat 0 := iso.refl _
| int.of_nat (n+1) := iso.refl _
| -[1+i] := iso.refl _
end)
(by admit)
-/

-- SO ANNOYING
instance evaluation_additive (X : ExtrDisc.{u}) :
  functor.additive ((evaluation ExtrDisc.{u}ᵒᵖ Ab.{u+1}).obj (op X)) :=
category_theory.evaluation_additive.{(u+2) u (u+1)} _

def evaluated_free_ExtrDisc_Cech (F : arrow Profinite.{u}) (X : ExtrDisc.{u}) :
  chain_complex Ab.{u+1} ℕ :=
(((simplicial_object.augmented.whiskering _ _).obj
  AddCommGroup.free).obj $
  ((Profinite_to_ExtrDisc_presheaf.flip.obj (op X)).map_arrow.obj F).augmented_cech_nerve).to_complex

.

def yet_another_iso (F : arrow Profinite.{u}) (X : ExtrDisc.{u}) :
  (((evaluation.{u u+1 u+1 u+2} ExtrDisc.{u}ᵒᵖ Ab.{u+1}).obj
  (op X)).map_homological_complex
  (complex_shape.down.{0} ℕ)).obj
  (unsheafified_free_ExtrDiscr_Cech.{u} F) ≅
  evaluated_free_ExtrDisc_Cech F X :=
homological_complex.hom.iso_of_components
(λ i,
match i with
| 0 := iso.refl _
| i+1 := begin apply AddCommGroup.free.map_iso, apply ulift_wide_pullback_iso, end
end)
begin
  rintros (_|i) (_|j) ⟨rfl⟩,
  { dsimp [yet_another_iso._match_1, iso.refl_hom], rw category.comp_id,
    dsimp [evaluated_free_ExtrDisc_Cech, unsheafified_free_ExtrDiscr_Cech],
    rw if_pos (rfl : (1 : ℕ) = 0 + 1), erw category.id_comp,
    rw if_pos (rfl : (1 : ℕ) = 0 + 1), erw category.id_comp,
    apply free_abelian_group.lift.ext,
    rintro ⟨t⟩,
    dsimp [AddCommGroup.free, simplicial_object.augmented.to_complex_d],
    simp only [category.comp_id, comp_apply, free_abelian_group.map_of_apply],
    dsimp at t,
    dsimp [ulift_wide_pullback_iso, ulift_wide_pullback_iso_hom_aux,
      Profinite_to_ExtrDisc_presheaf_Ab], congr' 1,
    have := types_comp_apply
      (wide_pullback.lift.{u+1 u+2} (ulift_functor.{u+1 u}.map ((yoneda.{u u+1}.map
        (wide_pullback.base.{u u+1} (λ (_x : ulift.{u 0} (fin (0 + 0 + 1))), F.hom))).app
        (op.{u+2} X.val))) (λ (q : ulift.{u+1 0} (fin (0 + 0 + 1))), ulift_functor.{u+1 u}.map
        ((yoneda.{u u+1}.map (wide_pullback.π.{u u+1} (λ (_x : ulift.{u 0} (fin (0 + 0 + 1))),
        F.hom) {down := q.down})).app (op.{u+2} X.val))) _)
      (wide_pullback.base.{u+1 u+2} (λ (i : ulift.{u+1 0} (fin (0 + 0 + 1))),
        (Profinite_to_ExtrDisc_presheaf.{u}.map F.hom).app (op.{u+2} X)))
      (ulift.up t),
    rw ← this, clear this, rw wide_pullback.lift_base, refl },
  { dsimp [yet_another_iso._match_1,
      evaluated_free_ExtrDisc_Cech,
      unsheafified_free_ExtrDiscr_Cech],
    rw [if_pos, if_pos], swap, refl, swap, refl, rw [category.id_comp, category.id_comp],
    dsimp [simplicial_object.augmented.to_complex_d, simplicial_object.boundary],
    simp only [preadditive.sum_comp, preadditive.comp_sum, preadditive.zsmul_comp,
      preadditive.comp_zsmul, category_theory.nat_trans.app_sum,
      category_theory.nat_trans.app_zsmul],
    apply finset.sum_congr rfl, rintros i -, congr' 1,
    dsimp [simplicial_object.δ],

    apply free_abelian_group.lift.ext,
    rintro ⟨t⟩,
    simp only [comp_apply],
    dsimp [AddCommGroup.free, Profinite_to_ExtrDisc_presheaf_Ab], congr' 1,
    dsimp [ulift_wide_pullback_iso, ulift_wide_pullback_iso_hom_aux],

    let f1 := wide_pullback.lift.{u+1 u+2} (wide_pullback.base.{u+1 u+2} (λ (i : ulift.{u+1 0}
      (fin (j + 1 + 1))), (Profinite_to_ExtrDisc_presheaf.{u}.map F.hom).app (op.{u+2} X)))
      (λ (i_1 : ulift.{u+1 0} (fin (j + 1))), wide_pullback.π.{u+1 u+2} (λ (i : ulift.{u+1 0}
      (fin (j + 1 + 1))), (Profinite_to_ExtrDisc_presheaf.{u}.map F.hom).app (op.{u+2} X))
      {down := (simplex_category.hom.to_order_hom (simplex_category.δ i)) i_1.down}) _,

    let f2 := wide_pullback.lift.{u+1 u+2} (ulift_functor.{u+1 u}.map ((yoneda.{u u+1}.map
      (wide_pullback.base.{u u+1} (λ (_x : ulift.{u 0} (fin (j.succ + 0 + 1))), F.hom))).app
      (op.{u+2} X.val))) (λ (q : ulift.{u+1 0} (fin (j.succ + 0 + 1))), ulift_functor.{u+1 u}.map
      ((yoneda.{u u+1}.map (wide_pullback.π.{u u+1} (λ (_x : ulift.{u 0} (fin (j.succ + 0 + 1))),
      F.hom) {down := q.down})).app (op.{u+2} X.val))) _,

    let f3 := wide_pullback.lift.{u+1 u+2} (ulift_functor.{u+1 u}.map ((yoneda.{u u+1}.map
      (wide_pullback.base.{u u+1} (λ (_x : ulift.{u 0} (fin (j + 0 + 1))), F.hom))).app
      (op.{u+2} X.val))) (λ (q : ulift.{u+1 0} (fin (j + 0 + 1))), ulift_functor.{u+1 u}.map
      ((yoneda.{u u+1}.map (wide_pullback.π.{u u+1} (λ (_x : ulift.{u 0} (fin (j + 0 + 1))),
      F.hom) {down := q.down})).app (op.{u+2} X.val))) _,

    change (f2 ≫ f1) _ = f3 _,

    let f4 := wide_pullback.lift.{u u+1} (wide_pullback.base.{u u+1} (λ (i : ulift.{u 0}
      (fin (j + 1 + 1))), F.hom)) (λ (i_1 : ulift.{u 0} (fin (j + 1))), wide_pullback.π.{u u+1}
      (λ (i : ulift.{u 0} (fin (j + 1 + 1))), F.hom) {down := (simplex_category.hom.to_order_hom
      (simplex_category.δ i)) i_1.down}) _,

    suffices : f2 ≫ f1 = ((yoneda'.map f4).app (op X.val) ≫ f3),
    { rw this, refl },

    apply wide_pullback.hom_ext,

    { intros k,
      dsimp [f4,f3,f2,f1],
      simp only [category.assoc, wide_pullback.lift_π, wide_pullback.lift_π_assoc],
      erw [wide_pullback.lift_π],
      erw [← functor.map_comp, ← nat_trans.comp_app, ← functor.map_comp, wide_pullback.lift_π] },

    { dsimp [f4,f3,f2,f1],
      simp only [category.assoc, wide_pullback.lift_base, wide_pullback.lift_base_assoc],
      erw wide_pullback.lift_base,
      erw [← functor.map_comp, ← nat_trans.comp_app, ← functor.map_comp,
        wide_pullback.lift_base] } }
end

lemma free_Cech_exact (F : arrow Profinite.{u}) (hF : function.surjective F.hom) : ∀ (n : ℤ),
  is_zero $ (free_Cech F).homology n :=
begin
  dsimp only [free_Cech],
  rw chain_complex.homology_zero_iff_homology_zero,
  rw chain_complex.homology_zero_iff_map_homology_zero _
    (Condensed_ExtrSheaf_equiv Ab.{u+1}).symm,
  intros i,
  dsimp only [equivalence.symm_functor],
  let E := (_root_.homology_functor _ _ i).map_iso (free_Cech'_iso_ExtrDisc F),
  apply is_zero.of_iso _ E, clear E,
  let E := (_root_.homology_functor _ _ i).map_iso (free_ExtrDisc_Cech'_iso F),
  apply is_zero.of_iso _ E, clear E,
  dsimp only [_root_.homology_functor],
  revert i,
  apply category_theory.Sheaf.map_presheaf_to_Sheaf_homology_zero_of_homology_zero.{(u+2) u (u+1)},
  apply category_theory.homology_zero_of_eval.{(u+2) u (u+1)},
  any_goals { apply_instance },
  intros X, tactic.op_induction',
  intros i,
  let E := (_root_.homology_functor _ _ i).map_iso (yet_another_iso F X),
  apply is_zero.of_iso _ E,
  -- Now we can use the splitting similarly to arrow.conerve_to_cocomplex_homology_is_zero
  -- but we need a dual variant.
  let G := ((Profinite_to_ExtrDisc_presheaf.flip.obj (op X)).map_arrow.obj F),
  haveI : G.split,
  { suffices : function.surjective G.hom,
    { refine ⟨λ i, (this i).some, _⟩,
      ext1 i, exact (this i).some_spec },
    dsimp [G, functor.map_arrow, Profinite_to_ExtrDisc_presheaf, ulift_functor, yoneda],
    rintros ⟨e⟩,
    use ExtrDisc.lift _ hF e,
    ext1,
    dsimp,
    rw ExtrDisc.lift_lifts },
  apply arrow.nerve_to_complex_homology_is_zero AddCommGroup.free G,
  recover,
end

lemma free_Cech_kernel_SES (F : arrow Profinite.{u}) (hF : function.surjective F.hom) : ∀ n,
  short_exact (kernel.ι $ (free_Cech F).d (n+1+1) (n+1)) (delta_to_kernel _ (n+1+1) (n+1) n) :=
begin
  erw ← is_acyclic_iff_short_exact_to_cycles' (free_Cech F), exact free_Cech_exact F hF
end

variable (M : Condensed.{u} Ab.{u+1})

abbreviation HH (i : ℤ) (S : Profinite.{u}) (M : Condensed.{u} Ab.{u+1}) :=
((Ext' i).obj (op $ (CondensedSet_to_Condensed_Ab).obj $ Profinite.to_Condensed S)).obj M

def acyclic_of_exact.IH (n : ℤ) : Prop := ∀ S, ∀ i > 0, i ≤ n → is_zero (HH i S M)

/-- Consider the following commutative diagram
```
     O₀
     ↓
A₁ → B₁ → C₁ → O₁
   ↘ ↓
     B₂
     ↓  ↘
O₃ → B₃ → C₃
```
where `O₀`, `O₁`, and `O₃` are zero objects, and all sequence are exact.

Then `C₁` is also a zero object.
-/
lemma acyclic_of_exact.induction_step_aux {𝓐 : Type*} [category 𝓐] [abelian 𝓐]
  {O₀ O₁ O₃ A₁ B₁ C₁ B₂ B₃ C₃ : 𝓐}
  {α₁ : A₁ ⟶ B₁} {β₁ : B₁ ⟶ C₁} {γ₁ : C₁ ⟶ O₁} (ex₁ : exact_seq 𝓐 [α₁, β₁, γ₁])
  {d₁ : A₁ ⟶ B₂} {d₂ : B₂ ⟶ C₃}                 (exd : exact d₁ d₂)
  {b₀ : O₀ ⟶ B₁} {b₁ : B₁ ⟶ B₂} {b₂ : B₂ ⟶ B₃} (exb : exact_seq 𝓐 [b₀, b₁, b₂])
  {α₃ : O₃ ⟶ B₃} {β₃ : B₃ ⟶ C₃}                 (ex₃ : exact α₃ β₃)
  (hO₀ : is_zero O₀) (hO₁ : is_zero O₁) (hO₃ : is_zero O₃)
  (tr₁ : α₁ ≫ b₁ = d₁) (tr₂ : b₂ ≫ β₃ = d₂) :
  is_zero C₁ :=
begin
  refine (ex₁.drop 1).pair.is_zero_of_eq_zero_eq_zero
    (ex₁.pair.eq_zero_of_epi _) (hO₁.eq_of_tgt _ _),
  haveI : mono b₁ := exb.pair.mono_of_eq_zero (hO₀.eq_of_src _ _),
  haveI : mono β₃ := ex₃.mono_of_eq_zero (hO₃.eq_of_src _ _),
  let l' := abelian.is_limit_of_exact_of_mono _ _ (exb.drop 1).pair,
  let l := is_kernel_comp_mono l' β₃ tr₂.symm,
  obtain rfl :
    α₁ = kernel.lift _ _ exd.w ≫ (is_limit.cone_point_unique_up_to_iso (limit.is_limit _) l).hom,
  { erw [← cancel_mono b₁, category.assoc,
      is_limit.cone_point_unique_up_to_iso_hom_comp _ _ walking_parallel_pair.zero, is_limit.fac,
      fork.of_ι_π_app, tr₁] },
  apply epi_comp
end

lemma acyclic_of_exact.induction_step_ex₁
  (F : arrow Profinite.{u})
  (h : ∀ i, is_zero (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i)) :
  let C := (((cosimplicial_object.augmented.whiskering Profiniteᵒᵖ Ab).obj
    ((Profinite_to_Condensed ⋙ CondensedSet_to_Condensed_Ab).op ⋙ preadditive_yoneda.obj M)).obj
    F.augmented_cech_nerve.right_op).to_cocomplex
  in ∀ i, is_zero (C.homology i) :=
begin
  intros C i,
  apply is_zero.of_iso (h i),
  refine (_root_.homology_functor _ _ i).map_iso _,
  refine cosimplicial_object.augmented.cocomplex.map_iso _,
  refine iso.app (functor.map_iso _ (condensed.profinite_free_adj _)) _,
end

lemma acyclic_of_exact.induction_step_ex₂
  (F : arrow Profinite.{u})
  (h : let C := (((cosimplicial_object.augmented.whiskering Profiniteᵒᵖ Ab).obj
    ((Profinite_to_Condensed ⋙ CondensedSet_to_Condensed_Ab).op ⋙ preadditive_yoneda.obj M)).obj
    F.augmented_cech_nerve.right_op).to_cocomplex
    in ∀ i, is_zero (C.homology i)) :
  ∀ i, is_zero ((((preadditive_yoneda.obj M).map_homological_complex _).obj (free_Cech' F).op).homology i) :=
begin
  intro i, apply (h i).of_iso,
  refine (_root_.homology_functor _ _ _).map_iso _,
  apply acyclic_of_exact.induction_step_ex₂_aux,
end

lemma int.of_nat_add_one (i : ℕ) : int.of_nat i + 1 = int.of_nat (i+1) := rfl

lemma complex_shape.embedding.nat_down_int_down.r_int_of_nat (i : ℕ) :
  complex_shape.embedding.nat_down_int_down.r (int.of_nat i) = option.some i := rfl

-- move me
lemma cochain_complex.mono_of_is_zero_homology_0
  {𝓐 : Type*} [category 𝓐] [abelian 𝓐]
  (C : cochain_complex 𝓐 ℕ) (h : is_zero $ C.homology 0) :
  mono (C.d 0 1) :=
begin
  delta homological_complex.homology at h,
  simp only [homological_complex.d_to_eq_zero, cochain_complex.prev_nat_zero, eq_self_iff_true] at h,
  have f := homology_iso_cokernel_lift (C.d_to 0) (C.d_from 0) (by simp),
  simp only [homological_complex.d_to_eq_zero, cochain_complex.prev_nat_zero, eq_self_iff_true,
    kernel.lift_zero] at f,
  replace f := f ≪≫ limits.cokernel_zero_iso_target,
  simp_rw [C.d_from_eq (show (complex_shape.up ℕ).rel 0 1, by simp)] at f h,
  exact preadditive.mono_of_kernel_zero (is_zero.eq_of_src (is_zero.of_iso h
    (f ≪≫ (kernel_comp_mono _ _)).symm) _ _)
end

lemma acyclic_of_exact.induction_step_ex₃
  (F : arrow Profinite.{u}) (i : ℤ)
  (h : ∀ i, is_zero ((((preadditive_yoneda.obj M).map_homological_complex _).obj (free_Cech' F).op).homology i)) :
  exact ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1) i).op)
    ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op) :=
begin
  rcases i with (i|i),
  { delta free_Cech,
    dsimp only [homological_complex.embed, homological_complex.embed.obj],
    rw [int.of_nat_add_one, int.of_nat_add_one],
    erw [complex_shape.embedding.nat_down_int_down.r_int_of_nat],
    erw [complex_shape.embedding.nat_down_int_down.r_int_of_nat],
    erw [complex_shape.embedding.nat_down_int_down.r_int_of_nat],
    dsimp only [homological_complex.embed.d],
    refine exact_of_homology_is_zero ((h (i+1)).of_iso $ _),
    { rw [← functor.map_comp, ← op_comp, homological_complex.d_comp_d, op_zero, functor.map_zero] },
    clear h,
    refine _ ≪≫ (homology_iso _ i (i+1) (i+1+1) _ _).symm,
    swap, { dsimp, refl }, swap, { dsimp, refl },
    refl, },
  { have aux : (preadditive_yoneda.obj M).map ((free_Cech F).d (-[1+ i] + 1) -[1+ i]).op = 0,
    { cases i; erw [op_zero, functor.map_zero], },
    rw [aux], clear aux, apply_with exact_zero_left_of_mono {instances:=ff}, { apply_instance },
    cases i,
    { exact cochain_complex.mono_of_is_zero_homology_0 _ (h 0), },
    { apply mono_of_is_zero_object,
      rw [is_zero_iff_id_eq_zero, ← category_theory.functor.map_id,
        is_zero_iff_id_eq_zero.mp, functor.map_zero],
      refine (is_zero_zero _).op, } },
end

lemma acyclic_of_exact.induction_step_ex₄
  (F : arrow Profinite.{u}) (i : ℤ)
  (h : exact ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1) i).op)
    ((preadditive_yoneda.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op)) :
  exact (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1) i).op)
        (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op) :=
begin
  let e := (bounded_derived_category.Ext'_zero_flip_iso _ M).symm,
  apply preadditive.exact_of_iso_of_exact' _ _ _ _ (e.app _) (e.app _) (e.app _) _ _ h,
  { simp only [nat_iso.app_hom, nat_trans.naturality], },
  { simp only [nat_iso.app_hom, nat_trans.naturality], }
end

lemma acyclic_of_exact.induction_step_ex
  (F : arrow Profinite.{u}) (surj : function.surjective F.hom)
  (h : ∀ i, is_zero (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i))
  (i : ℤ) :
  exact (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1) i).op)
        (((Ext' 0).flip.obj M).map $ ((free_Cech F).d (i+1+1) (i+1)).op) :=
begin
  apply acyclic_of_exact.induction_step_ex₄,
  apply acyclic_of_exact.induction_step_ex₃,
  apply acyclic_of_exact.induction_step_ex₂,
  apply acyclic_of_exact.induction_step_ex₁ _ F h,
end

lemma acyclic_of_exact.induction_step
  (h : ∀ (F : arrow Profinite.{u}) (surj : function.surjective F.hom),
    ∀ i, is_zero (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i))
  (n : ℤ) (ih : acyclic_of_exact.IH M n) :
  acyclic_of_exact.IH M (n+1) :=
begin
  intros S i h1 h2,
  rw [le_iff_eq_or_lt, or_comm, int.lt_add_one_iff] at h2,
  cases h2 with h2 h2, { exact ih S i h1 h2 },
  subst i,
  let F := arrow.mk S.projective_presentation.f,
  have hF : function.surjective F.hom,
  { rw ← Profinite.epi_iff_surjective, apply projective_presentation.epi },
  let E := λ i, (Ext' i).flip.obj M,
  have ih' : ∀ (i j : ℤ) (h0i : 0 < i) (hin : i ≤ n),
    is_zero ((E i).obj (op ((free_Cech F).X j))),
  { intros i j h0i hin,
    cases j with j j,
    { cases j; exact ih _ _ h0i hin, },
    { apply bounded_derived_category.Ext'_zero_left_is_zero,
      exact (is_zero_zero _).op, } },
  let K := λ i, kernel ((free_Cech F).d (i + 1) i),
  have LES := λ i j, (free_Cech_kernel_SES F hF i).Ext'_five_term_exact_seq M j,
  have H1 : ∀ i > 0, is_zero ((E i).obj (op ((free_Cech F).X 1))),
  { intros i hi,
    apply bounded_derived_category.Ext'_is_zero_of_projective _ _ _ _ hi,
    apply_with Condensed_Ab.free.category_theory.projective {instances:=ff},
    rw [simplicial_object.augmented.drop_obj, arrow.augmented_cech_nerve_left],
    apply projective.of_iso (arrow.cech_nerve_obj_0 F).symm,
    apply projective_presentation.projective, },
  have aux0 : ∀ (i : ℤ) (h0i : 0 < i+1) (H : is_zero ((E i).obj (op $ K 0))),
    is_zero ((E (i+1)).obj (op $ K (-1))),
  { intros i h0i H,
    refine is_zero_of_exact_is_zero_is_zero _ _ ((LES (-1) i).drop 2).pair H (H1 _ h0i), },
  have aux : ∀ (i j : ℤ) (h0i : 0 < i+1) (hi : i+1 ≤ n) (H : is_zero ((E i).obj (op $ K (j+1)))),
    is_zero ((E (i+1)).obj (op $ K j)),
  { intros i j h0i hi H,
    refine is_zero_of_exact_is_zero_is_zero _ _ ((LES j i).drop 2).pair H _,
    refine ih' _ _ h0i hi },
  suffices : ∀ i j, 0 < i → -1 ≤ j → i + j = n → is_zero ((E i).obj (op $ K j)),
  { refine is_zero_of_exact_is_zero_is_zero _ _ (LES (-2) (n+1)).pair _ _; clear LES,
    { apply bounded_derived_category.Ext'_zero_left_is_zero,
      refine (is_zero_of_mono (kernel.ι _) _).op, refine is_zero_zero _, },
    { refine this (n+1) (-1) h1 le_rfl _, rw [← sub_eq_add_neg, add_sub_cancel] } },
  obtain ⟨n, rfl⟩ : ∃ k, k+1 = n := ⟨n-1, sub_add_cancel _ _⟩,
  suffices : is_zero ((E 1).obj (op $ K n)),
  { intro i,
    apply int.induction_on' i 1; clear i,
    { intros j h0i hj hijn, rw [add_comm (1:ℤ), add_left_inj] at hijn, subst j, exact this },
    { intros i hi IH j hi' hj hijn,
      rw le_iff_eq_or_lt at hj, cases hj with hj hj,
      { subst j, apply aux0 _ hi', apply IH; linarith only [hi, hijn] },
      { apply aux _ _ hi' _ (IH _ _ _ _); linarith only [hi, hijn, hj], } },
    { intros i hi IH j hi', exfalso, linarith only [hi, hi'] } },
  clear aux0 aux,
  have aux := λ i, ((LES i (-1)).drop 2).pair.cons (LES i 0),
  have exd := acyclic_of_exact.induction_step_ex M F hF (h F hF) (n+1+1),
  apply acyclic_of_exact.induction_step_aux
    ((LES n 0).drop 1) exd ((aux (n+1)).extract 0 3) (aux (n+1+1)).pair; clear LES aux exd,
  { apply Ext'_is_zero_of_neg, dec_trivial },
  { obtain (rfl|hn) : n = -1 ∨ 1 ≤ n + 1,
    { rw [or_iff_not_imp_right], intro h2, linarith only [h1, h2] },
    { exact H1 _ zero_lt_one },
    { exact ih' _ _ zero_lt_one hn } },
  { apply Ext'_is_zero_of_neg, dec_trivial },
  { conv_rhs { rw [← delta_to_kernel_ι _ _ _ (n+1), op_comp, functor.map_comp] }, refl },
  { conv_rhs { rw [← delta_to_kernel_ι _ _ _ (n+1+1), op_comp, functor.map_comp] }, refl },
end

lemma acyclic_of_exact
  (h : ∀ (F : arrow Profinite.{u}) (surj : function.surjective F.hom),
    ∀ i, is_zero
    (((((cosimplicial_object.augmented.whiskering _ _).obj M.val).obj
      F.augmented_cech_nerve.right_op).to_cocomplex).homology i))
  (S : Profinite.{u}) :
  ∀ i > 0, is_zero (HH i S M)  :=
begin
  intros i hi,
  suffices : acyclic_of_exact.IH M i,
  { apply this S i hi le_rfl, },
  apply int.induction_on' i 0; clear hi i S,
  { intros S i h1 h2, exfalso, exact h2.not_lt h1 },
  { intros k hk, apply acyclic_of_exact.induction_step M h, },
  { rintros k hk aux S i h1 h2, exfalso, linarith only [hk, h1, h2] }
end

end condensed


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.cauchy
import Mathlib.topology.uniform_space.separation
import Mathlib.topology.dense_embedding
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Theory of complete separated uniform spaces.

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/

/-In a separated space, a complete set is closed -/

theorem is_complete.is_closed {α : Type u_1} [uniform_space α] [separated_space α] {s : set α}
    (h : is_complete s) : is_closed s :=
  sorry

namespace dense_inducing

theorem continuous_extend_of_cauchy {α : Type u_1} [topological_space α] {β : Type u_2}
    [topological_space β] {γ : Type u_3} [uniform_space γ] [complete_space γ] [separated_space γ]
    {e : α → β} {f : α → γ} (de : dense_inducing e)
    (h : ∀ (b : β), cauchy (filter.map f (filter.comap e (nhds b)))) : continuous (extend de f) :=
  continuous_extend de fun (b : β) => complete_space.complete (h b)

end Mathlib


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard
-/
import group_theory.submonoid.basic
import algebra.big_operators.basic
import deprecated.group

/-!
# Unbundled submonoids (deprecated)

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines unbundled multiplicative and additive submonoids. Instead of using this file,
please use `submonoid G` and `add_submonoid A`, defined in `group_theory.submonoid.basic`.

## Main definitions

`is_add_submonoid (S : set M)` : the predicate that `S` is the underlying subset of an additive
submonoid of `M`. The bundled variant `add_submonoid M` should be used in preference to this.

`is_submonoid (S : set M)` : the predicate that `S` is the underlying subset of a submonoid
of `M`. The bundled variant `submonoid M` should be used in preference to this.

## Tags
submonoid, submonoids, is_submonoid
-/

open_locale big_operators

variables {M : Type*} [monoid M] {s : set M}
variables {A : Type*} [add_monoid A] {t : set A}

/-- `s` is an additive submonoid: a set containing 0 and closed under addition.
Note that this structure is deprecated, and the bundled variant `add_submonoid A` should be
preferred. -/
structure is_add_submonoid (s : set A) : Prop :=
(zero_mem : (0:A) ∈ s)
(add_mem {a b} : a ∈ s → b ∈ s → a + b ∈ s)

/-- `s` is a submonoid: a set containing 1 and closed under multiplication.
Note that this structure is deprecated, and the bundled variant `submonoid M` should be
preferred. -/
@[to_additive]
structure is_submonoid (s : set M) : Prop :=
(one_mem : (1:M) ∈ s)
(mul_mem {a b} : a ∈ s → b ∈ s → a * b ∈ s)

lemma additive.is_add_submonoid
  {s : set M} : ∀ (is : is_submonoid s), @is_add_submonoid (additive M) _ s
| ⟨h₁, h₂⟩ := ⟨h₁, @h₂⟩

theorem additive.is_add_submonoid_iff
  {s : set M} : @is_add_submonoid (additive M) _ s ↔ is_submonoid s :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, @h₂⟩, additive.is_add_submonoid⟩

lemma multiplicative.is_submonoid
  {s : set A} : ∀ (is : is_add_submonoid s), @is_submonoid (multiplicative A) _ s
| ⟨h₁, h₂⟩ := ⟨h₁, @h₂⟩

theorem multiplicative.is_submonoid_iff
  {s : set A} : @is_submonoid (multiplicative A) _ s ↔ is_add_submonoid s :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, @h₂⟩, multiplicative.is_submonoid⟩

/-- The intersection of two submonoids of a monoid `M` is a submonoid of `M`. -/
@[to_additive "The intersection of two `add_submonoid`s of an `add_monoid` `M` is
an `add_submonoid` of M."]
lemma is_submonoid.inter {s₁ s₂ : set M} (is₁ : is_submonoid s₁) (is₂ : is_submonoid s₂) :
  is_submonoid (s₁ ∩ s₂) :=
{ one_mem := ⟨is₁.one_mem, is₂.one_mem⟩,
  mul_mem := λ x y hx hy,
    ⟨is₁.mul_mem hx.1 hy.1, is₂.mul_mem hx.2 hy.2⟩ }

/-- The intersection of an indexed set of submonoids of a monoid `M` is a submonoid of `M`. -/
@[to_additive "The intersection of an indexed set of `add_submonoid`s of an `add_monoid` `M` is
an `add_submonoid` of `M`."]
lemma is_submonoid.Inter {ι : Sort*} {s : ι → set M} (h : ∀ y : ι, is_submonoid (s y)) :
  is_submonoid (set.Inter s) :=
{ one_mem := set.mem_Inter.2 $ λ y, (h y).one_mem,
  mul_mem := λ x₁ x₂ h₁ h₂, set.mem_Inter.2 $
    λ y, (h y).mul_mem (set.mem_Inter.1 h₁ y) (set.mem_Inter.1 h₂ y) }

/-- The union of an indexed, directed, nonempty set of submonoids of a monoid `M` is a submonoid
    of `M`. -/
@[to_additive "The union of an indexed, directed, nonempty set
of `add_submonoid`s of an `add_monoid` `M` is an `add_submonoid` of `M`. "]
lemma is_submonoid_Union_of_directed {ι : Type*} [hι : nonempty ι]
  {s : ι → set M} (hs : ∀ i, is_submonoid (s i))
  (directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
  is_submonoid (⋃i, s i) :=
{ one_mem := let ⟨i⟩ := hι in set.mem_Union.2 ⟨i, (hs i).one_mem⟩,
  mul_mem := λ a b ha hb,
    let ⟨i, hi⟩ := set.mem_Union.1 ha in
    let ⟨j, hj⟩ := set.mem_Union.1 hb in
    let ⟨k, hk⟩ := directed i j in
    set.mem_Union.2 ⟨k, (hs k).mul_mem (hk.1 hi) (hk.2 hj)⟩ }

section powers

/-- The set of natural number powers `1, x, x², ...` of an element `x` of a monoid. -/
@[to_additive multiples
"The set of natural number multiples `0, x, 2x, ...` of an element `x` of an `add_monoid`."]
def powers (x : M) : set M := {y | ∃ n:ℕ, x^n = y}

/-- 1 is in the set of natural number powers of an element of a monoid. -/
@[to_additive "0 is in the set of natural number multiples of an element of an `add_monoid`."]
lemma powers.one_mem {x : M} : (1 : M) ∈ powers x := ⟨0, pow_zero _⟩

/-- An element of a monoid is in the set of that element's natural number powers. -/
@[to_additive
"An element of an `add_monoid` is in the set of that element's natural number multiples."]
lemma powers.self_mem {x : M} : x ∈ powers x := ⟨1, pow_one _⟩

/-- The set of natural number powers of an element of a monoid is closed under multiplication. -/
@[to_additive
"The set of natural number multiples of an element of an `add_monoid` is closed under addition."]
lemma powers.mul_mem {x y z : M} : (y ∈ powers x) → (z ∈ powers x) → (y * z ∈ powers x) :=
λ ⟨n₁, h₁⟩ ⟨n₂, h₂⟩, ⟨n₁ + n₂, by simp only [pow_add, *]⟩

/-- The set of natural number powers of an element of a monoid `M` is a submonoid of `M`. -/
@[to_additive "The set of natural number multiples of an element of
an `add_monoid` `M` is an `add_submonoid` of `M`."]
lemma powers.is_submonoid (x : M) : is_submonoid (powers x) :=
{ one_mem := powers.one_mem,
  mul_mem := λ y z, powers.mul_mem }

/-- A monoid is a submonoid of itself. -/
@[to_additive "An `add_monoid` is an `add_submonoid` of itself."]
lemma univ.is_submonoid : is_submonoid (@set.univ M) := by split; simp

/-- The preimage of a submonoid under a monoid hom is a submonoid of the domain. -/
@[to_additive "The preimage of an `add_submonoid` under an `add_monoid` hom is
an `add_submonoid` of the domain."]
lemma is_submonoid.preimage {N : Type*} [monoid N] {f : M → N} (hf : is_monoid_hom f)
  {s : set N} (hs : is_submonoid s) : is_submonoid (f ⁻¹' s) :=
{ one_mem := show f 1 ∈ s, by rw is_monoid_hom.map_one hf; exact hs.one_mem,
  mul_mem := λ a b (ha : f a ∈ s) (hb : f b ∈ s),
    show f (a * b) ∈ s, by rw is_monoid_hom.map_mul hf; exact hs.mul_mem ha hb }

/-- The image of a submonoid under a monoid hom is a submonoid of the codomain. -/
@[to_additive "The image of an `add_submonoid` under an `add_monoid`
hom is an `add_submonoid` of the codomain."]
lemma is_submonoid.image {γ : Type*} [monoid γ] {f : M → γ} (hf : is_monoid_hom f)
  {s : set M} (hs : is_submonoid s) : is_submonoid (f '' s) :=
{ one_mem := ⟨1, hs.one_mem, hf.map_one⟩,
  mul_mem := λ a b ⟨x, hx⟩ ⟨y, hy⟩, ⟨x * y, hs.mul_mem hx.1 hy.1,
    by rw [hf.map_mul, hx.2, hy.2]⟩ }

/-- The image of a monoid hom is a submonoid of the codomain. -/
@[to_additive "The image of an `add_monoid` hom is an `add_submonoid`
of the codomain."]
lemma range.is_submonoid {γ : Type*} [monoid γ] {f : M → γ} (hf : is_monoid_hom f) :
  is_submonoid (set.range f) :=
by { rw ← set.image_univ, exact univ.is_submonoid.image hf }

/-- Submonoids are closed under natural powers. -/
@[to_additive is_add_submonoid.smul_mem
"An `add_submonoid` is closed under multiplication by naturals."]
lemma is_submonoid.pow_mem {a : M} (hs : is_submonoid s) (h : a ∈ s) : ∀ {n : ℕ}, a ^ n ∈ s
| 0 := by { rw pow_zero, exact hs.one_mem }
| (n + 1) := by { rw pow_succ, exact hs.mul_mem h is_submonoid.pow_mem }

/-- The set of natural number powers of an element of a submonoid is a subset of the submonoid. -/
@[to_additive is_add_submonoid.multiples_subset "The set of natural number multiples of an element
of an `add_submonoid` is a subset of the `add_submonoid`."]
lemma is_submonoid.power_subset {a : M} (hs : is_submonoid s) (h : a ∈ s) : powers a ⊆ s :=
assume x ⟨n, hx⟩, hx ▸ hs.pow_mem h

end powers

namespace is_submonoid

/-- The product of a list of elements of a submonoid is an element of the submonoid. -/
@[to_additive "The sum of a list of elements of an `add_submonoid` is an element of the
`add_submonoid`."]
lemma list_prod_mem (hs : is_submonoid s) : ∀{l : list M}, (∀x∈l, x ∈ s) → l.prod ∈ s
| []     h := hs.one_mem
| (a::l) h :=
  suffices a * l.prod ∈ s, by simpa,
  have a ∈ s ∧ (∀x∈l, x ∈ s), by simpa using h,
  hs.mul_mem this.1 (list_prod_mem this.2)

/-- The product of a multiset of elements of a submonoid of a `comm_monoid` is an element of
the submonoid. -/
@[to_additive "The sum of a multiset of elements of an `add_submonoid` of an `add_comm_monoid`
is an element of the `add_submonoid`. "]
lemma multiset_prod_mem {M} [comm_monoid M] {s : set M} (hs : is_submonoid s) (m : multiset M) :
  (∀a∈m, a ∈ s) → m.prod ∈ s :=
begin
  refine quotient.induction_on m (assume l hl, _),
  rw [multiset.quot_mk_to_coe, multiset.coe_prod],
  exact list_prod_mem hs hl
end

/-- The product of elements of a submonoid of a `comm_monoid` indexed by a `finset` is an element
of the submonoid. -/
@[to_additive "The sum of elements of an `add_submonoid` of an `add_comm_monoid` indexed by
a `finset` is an element of the `add_submonoid`."]
lemma finset_prod_mem {M A} [comm_monoid M] {s : set M} (hs : is_submonoid s) (f : A → M) :
  ∀(t : finset A), (∀b∈t, f b ∈ s) → ∏ b in t, f b ∈ s
| ⟨m, hm⟩ _ := multiset_prod_mem hs _ (by simpa)

end is_submonoid

namespace add_monoid

/-- The inductively defined membership predicate for the submonoid generated by a subset of a
    monoid. -/
inductive in_closure (s : set A) : A → Prop
| basic {a : A} : a ∈ s → in_closure a
| zero : in_closure 0
| add {a b : A} : in_closure a → in_closure b → in_closure (a + b)

end add_monoid

namespace monoid

/-- The inductively defined membership predicate for the `submonoid` generated by a subset of an
    monoid. -/
@[to_additive]
inductive in_closure (s : set M) : M → Prop
| basic {a : M} : a ∈ s → in_closure a
| one : in_closure 1
| mul {a b : M} : in_closure a → in_closure b → in_closure (a * b)

/-- The inductively defined submonoid generated by a subset of a monoid. -/
@[to_additive "The inductively defined `add_submonoid` genrated by a subset of an `add_monoid`."]
def closure (s : set M) : set M := {a | in_closure s a }

@[to_additive]
lemma closure.is_submonoid (s : set M) : is_submonoid (closure s) :=
{ one_mem := in_closure.one, mul_mem := assume a b, in_closure.mul }

/-- A subset of a monoid is contained in the submonoid it generates. -/
@[to_additive "A subset of an `add_monoid` is contained in the `add_submonoid` it generates."]
theorem subset_closure {s : set M} : s ⊆ closure s :=
assume a, in_closure.basic

/-- The submonoid generated by a set is contained in any submonoid that contains the set. -/
@[to_additive "The `add_submonoid` generated by a set is contained in any `add_submonoid` that
contains the set."]
theorem closure_subset {s t : set M} (ht : is_submonoid t) (h : s ⊆ t) : closure s ⊆ t :=
assume a ha, by induction ha; simp [h _, *, is_submonoid.one_mem, is_submonoid.mul_mem]

/-- Given subsets `t` and `s` of a monoid `M`, if `s ⊆ t`, the submonoid of `M` generated by `s` is
    contained in the submonoid generated by `t`. -/
@[to_additive "Given subsets `t` and `s` of an `add_monoid M`, if `s ⊆ t`, the `add_submonoid`
of `M` generated by `s` is contained in the `add_submonoid` generated by `t`."]
theorem closure_mono {s t : set M} (h : s ⊆ t) : closure s ⊆ closure t :=
closure_subset (closure.is_submonoid t) $ set.subset.trans h subset_closure

/-- The submonoid generated by an element of a monoid equals the set of natural number powers of
    the element. -/
@[to_additive "The `add_submonoid` generated by an element of an `add_monoid` equals the set of
natural number multiples of the element."]
theorem closure_singleton {x : M} : closure ({x} : set M) = powers x :=
set.eq_of_subset_of_subset (closure_subset (powers.is_submonoid x) $ set.singleton_subset_iff.2 $
  powers.self_mem) $ is_submonoid.power_subset (closure.is_submonoid _) $
  set.singleton_subset_iff.1 $ subset_closure

/-- The image under a monoid hom of the submonoid generated by a set equals the submonoid generated
    by the image of the set under the monoid hom. -/
@[to_additive "The image under an `add_monoid` hom of the `add_submonoid` generated by a set equals
the `add_submonoid` generated by the image of the set under the `add_monoid` hom."]
lemma image_closure {A : Type*} [monoid A] {f : M → A} (hf : is_monoid_hom f) (s : set M) :
  f '' closure s = closure (f '' s) :=
le_antisymm
  begin
    rintros _ ⟨x, hx, rfl⟩,
    apply in_closure.rec_on hx; intros,
    { solve_by_elim [subset_closure, set.mem_image_of_mem] },
    { rw [hf.map_one], apply is_submonoid.one_mem (closure.is_submonoid (f '' s))},
    { rw [hf.map_mul], solve_by_elim [(closure.is_submonoid _).mul_mem] }
  end
  (closure_subset (is_submonoid.image hf (closure.is_submonoid _)) $
    set.image_subset _ subset_closure)

/-- Given an element `a` of the submonoid of a monoid `M` generated by a set `s`, there exists
a list of elements of `s` whose product is `a`. -/
@[to_additive "Given an element `a` of the `add_submonoid` of an `add_monoid M` generated by
a set `s`, there exists a list of elements of `s` whose sum is `a`."]
theorem exists_list_of_mem_closure {s : set M} {a : M} (h : a ∈ closure s) :
  (∃l:list M, (∀x∈l, x ∈ s) ∧ l.prod = a) :=
begin
  induction h,
  case in_closure.basic : a ha { existsi ([a]), simp [ha] },
  case in_closure.one { existsi ([]), simp },
  case in_closure.mul : a b _ _ ha hb
  { rcases ha with ⟨la, ha, eqa⟩,
    rcases hb with ⟨lb, hb, eqb⟩,
    existsi (la ++ lb),
    simp [eqa.symm, eqb.symm, or_imp_distrib],
    exact assume a, ⟨ha a, hb a⟩ }
end

/-- Given sets `s, t` of a commutative monoid `M`, `x ∈ M` is in the submonoid of `M` generated by
    `s ∪ t` iff there exists an element of the submonoid generated by `s` and an element of the
    submonoid generated by `t` whose product is `x`. -/
@[to_additive "Given sets `s, t` of a commutative `add_monoid M`, `x ∈ M` is in the `add_submonoid`
of `M` generated by `s ∪ t` iff there exists an element of the `add_submonoid` generated by `s`
and an element of the `add_submonoid` generated by `t` whose sum is `x`."]
theorem mem_closure_union_iff {M : Type*} [comm_monoid M] {s t : set M} {x : M} :
  x ∈ closure (s ∪ t) ↔ ∃ y ∈ closure s, ∃ z ∈ closure t, y * z = x :=
⟨λ hx, let ⟨L, HL1, HL2⟩ := exists_list_of_mem_closure hx in HL2 ▸
  list.rec_on L (λ _, ⟨1, (closure.is_submonoid _).one_mem, 1,
    (closure.is_submonoid _).one_mem, mul_one _⟩)
    (λ hd tl ih HL1, let ⟨y, hy, z, hz, hyzx⟩ := ih (list.forall_mem_of_forall_mem_cons HL1) in
      or.cases_on (HL1 hd $ list.mem_cons_self _ _)
        (λ hs, ⟨hd * y, (closure.is_submonoid _).mul_mem (subset_closure hs) hy, z, hz,
          by rw [mul_assoc, list.prod_cons, ← hyzx]; refl⟩)
        (λ ht, ⟨y, hy, z * hd, (closure.is_submonoid _).mul_mem hz (subset_closure ht),
          by rw [← mul_assoc, list.prod_cons, ← hyzx, mul_comm hd]; refl⟩)) HL1,
λ ⟨y, hy, z, hz, hyzx⟩, hyzx ▸ (closure.is_submonoid _).mul_mem
  (closure_mono (set.subset_union_left _ _) hy)
  (closure_mono (set.subset_union_right _ _) hz)⟩

end monoid

/-- Create a bundled submonoid from a set `s` and `[is_submonoid s]`. -/
@[to_additive "Create a bundled additive submonoid from a set `s` and `[is_add_submonoid s]`."]
def submonoid.of {s : set M} (h : is_submonoid s) : submonoid M := ⟨s, h.2, h.1⟩

@[to_additive]
lemma submonoid.is_submonoid (S : submonoid M) : is_submonoid (S : set M) := ⟨S.3, S.2⟩


import category_theory.sites.sheafification

namespace category_theory

open category_theory

universes v u
variables {C : Type u} [category.{v} C] (J : grothendieck_topology C)

noncomputable theory

@[simps]
def presheaf_to_SheafOfTypes : (Cᵒᵖ ⥤ Type (max v u)) ⥤ SheafOfTypes J :=
{ obj := λ P,
  { val := J.sheafify P,
    cond := begin
      rw ← is_sheaf_iff_is_sheaf_of_type,
      exact grothendieck_topology.plus.is_sheaf_plus_plus J P,
    end },
  map := λ P Q η, ⟨J.sheafify_map η⟩,
  map_id' := λ P, SheafOfTypes.hom.ext _ _ $ J.sheafify_map_id _,
  map_comp' := λ P Q R η γ, SheafOfTypes.hom.ext _ _ $ J.sheafify_map_comp _ _ }

-- Sanity check
def presheaf_to_SheafOfTypes_iso : presheaf_to_SheafOfTypes J ≅
  presheaf_to_Sheaf J _ ⋙ (Sheaf_equiv_SheafOfTypes J).functor := eq_to_iso rfl

-- The adjunction for sheaves of types
def sheafification_adjunction_types :
  (presheaf_to_SheafOfTypes J) ⊣ SheafOfTypes_to_presheaf J :=
show presheaf_to_Sheaf J _ ⋙ (Sheaf_equiv_SheafOfTypes J).functor ⊣
  (Sheaf_equiv_SheafOfTypes J).inverse ⋙ Sheaf_to_presheaf J _,
from adjunction.comp (sheafification_adjunction _ _) $
  (Sheaf_equiv_SheafOfTypes J).to_adjunction

@[simp]
lemma sheafification_adjunction_types_hom_equiv_apply (X : Cᵒᵖ ⥤ Type (max v u))
  (Y : SheafOfTypes J) (e : (presheaf_to_SheafOfTypes _).obj X ⟶ Y) :
  (sheafification_adjunction_types J).hom_equiv _ _ e =
  J.to_sheafify _ ≫ e.val := rfl

@[simp]
lemma sheafification_adjunction_types_hom_equiv_symm_apply (X : Cᵒᵖ ⥤ Type (max v u))
  (Y : SheafOfTypes J) (e : X ⟶ (SheafOfTypes_to_presheaf _).obj Y) :
  (((sheafification_adjunction_types J).hom_equiv _ _).symm e).val =
  J.sheafify_lift e (by { rw is_sheaf_iff_is_sheaf_of_type, exact Y.2 }) := rfl

@[simp]
lemma sheafification_adjunction_types_unit_app (X : Cᵒᵖ ⥤ Type (max v u)) :
  (sheafification_adjunction_types J).unit.app X = J.to_sheafify X := rfl

@[simp]
lemma sheafification_adjunction_types_counit_app (Y : SheafOfTypes J) :
  ((sheafification_adjunction_types J).counit.app Y).val =
  J.sheafify_lift (𝟙 _) (by { rw is_sheaf_iff_is_sheaf_of_type, exact Y.2 }) := rfl

instance is_iso_sheafification_types_adjunction_counit_app (X : SheafOfTypes J) :
  is_iso ((sheafification_adjunction_types J).counit.app X) :=
begin
  apply is_iso_of_reflects_iso _ (Sheaf_equiv_SheafOfTypes J).inverse,
  change is_iso ((sheafification_adjunction J (Type (max v u))).counit.app
    ((Sheaf_equiv_SheafOfTypes J).inverse.obj X)),
  apply_instance
end

instance sheafification_types_reflective : is_iso (sheafification_adjunction_types J).counit :=
nat_iso.is_iso_of_is_iso_app _

end category_theory


import tactic
import .direction
import .list2d
import .boolset2d
import .component2d
import .sokostate

structure boxint :=
(subboxes : bset2d)
(supboxes : bset2d)
(sk_comp : bset2d)

structure boxint.valid (avail : bset2d) (as : boxint) : Prop :=
(sub_sup : as.subboxes ⊆ as.supboxes)
(sup_avail : as.supboxes ⊆ avail)
(sub_disj : as.subboxes.disjoint as.sk_comp)
(sk_comp_avail : as.sk_comp ⊆ avail)
(sk_comp_closed : ∀ xy ∈ as.sk_comp, ∀ d : direction,
  d.shift xy ∈ avail →
  (d.shift xy ∈ as.sk_comp ∨ d.shift xy ∈ as.subboxes))

def boxint.mem (s : sokostate) (as : boxint)
  := s.storekeeper ∈ as.sk_comp ∧
     as.subboxes ⊆ s.boxes ∧ s.boxes ⊆ as.supboxes
instance : has_mem sokostate boxint
:= ⟨boxint.mem⟩
lemma boxint.mem.unfold
  {s : sokostate} {as : boxint}
  : s ∈ as = (s.storekeeper ∈ as.sk_comp ∧
     as.subboxes ⊆ s.boxes ∧ s.boxes ⊆ as.supboxes)
:= rfl
instance boxint.mem.decidable
  (s : sokostate) (as : boxint) : decidable (s ∈ as)
:= begin
  unfold has_mem.mem, unfold boxint.mem, apply_instance,
end

def boxint.disjoint
  (as1 : boxint) (as2 : boxes_only) : Prop
  := ¬ (as1.subboxes ⊆ as2.boxes ∧ as2.boxes ⊆ as1.supboxes)
lemma boxint.disjoint_correct
  (as : boxint) (bs : boxes_only)
  (s : sokostate)
  : as.disjoint bs → s ∈ as → s ∈ bs → false :=
begin
  simp [boxint.mem.unfold, boxes_only.mem.unfold, boxint.disjoint],
  introv Hnsol Hsk Hsub Hsup Hsbs Hbss,
  exact Hnsol (bset2d.subset.trans Hsub Hsbs) (bset2d.subset.trans Hbss Hsup),
end
instance boxint.disjoint.decidable
  (as : boxint) (bs : boxes_only) : decidable (as.disjoint bs)
:= begin
  unfold boxint.disjoint, apply_instance,
end

def boxint.subset (as1 as2 : boxint) : Prop
  := as1.sk_comp ⊆ as2.sk_comp ∧ as2.subboxes ⊆ as1.subboxes
  ∧ as1.supboxes ⊆ as2.supboxes
instance : has_subset boxint := ⟨boxint.subset⟩

lemma boxint.subset_correct (as1 as2 : boxint)
  : as1 ⊆ as2 → ∀ s : sokostate, s ∈ as1 → s ∈ as2 :=
begin
  intros H12 s H1,
  rcases H12 with ⟨H12sk,H12sub,H12sup⟩,
  rcases H1 with ⟨H1sk,H1sub,H1sup⟩,
  split, exact H12sk _ H1sk,
  split, exact bset2d.subset.trans H12sub H1sub,
  exact bset2d.subset.trans H1sup H12sup,
end
instance boxint.subset.decidable
  (as1 as2 : boxint) : decidable (as1 ⊆ as2)
:= begin
  unfold has_subset.subset, unfold boxint.subset, apply_instance,
end

def boxint.subset_g (as1 as2 : boxint) (goal : boxes_only) : Prop
  := as1.sk_comp ⊆ as2.sk_comp ∧ as2.subboxes ⊆ as1.subboxes
  ∧ ( as1.supboxes ⊆ as2.supboxes ∨
    goal.boxes.count ≤ as1.subboxes.count ∧ as1.subboxes ⊆ as2.supboxes )
lemma boxint.subset_g_correct {avail : bset2d} {as1 as2 : boxint} {goal : boxes_only}
: as1.subset_g as2 goal → ∀ s sg : sokostate,
s ∈ as1 → sg ∈ goal → sg.reachable avail s → s ∈ as2
:=
begin
  intros H12 s sg H1 Hg Hr,
  rcases H12 with ⟨H12sk, H12sub, H12sup_cnt⟩,
  rcases H1 with ⟨H1sk,H1sub, H1sup⟩,
  split, exact H12sk _ H1sk,
  split, exact bset2d.subset.trans H12sub H1sub,
  cases H12sup_cnt with H12sup H12sup_cnt,
    exact bset2d.subset.trans H1sup H12sup,
  { cases H12sup_cnt with H_cnt H12sup,
    have : sg.boxes.count = s.boxes.count := sokostate.reachable_keep_box_count Hr,
    have : as1.subboxes.count ≤ s.boxes.count := bset2d.count_le_of_subset _ _ H1sub,
    have : sg.boxes.count ≤ goal.boxes.count := bset2d.count_le_of_subset _ _ Hg.1,
    have : as1.subboxes.count = s.boxes.count, by omega,
    have : s.boxes ⊆ as1.subboxes := bset2d.subset_eq_of_count_eq _ _ H1sub this,
    exact bset2d.subset.trans this H12sup,
  }
end
instance boxint.subset_g.decidable
  (as1 as2 : boxint) (goal : boxes_only) : decidable (as1.subset_g as2 goal)
:= begin
  unfold boxint.subset_g, apply_instance,
end

def boxint.generate (avail : bset2d) (subboxes supboxes : bset2d) (sk : ℕ × ℕ) : boxint
  := {
    subboxes := subboxes,
    supboxes := supboxes,
    sk_comp := component2d (avail \ subboxes) (bset2d.from_index sk),
  }

theorem boxint.generate_valid {avail subboxes supboxes : bset2d} {sk : ℕ × ℕ}
  : subboxes ⊆ supboxes → supboxes ⊆ avail →
  (boxint.generate avail subboxes supboxes sk).valid avail :=
begin
  intros sub_sup sup_avail, split, exact sub_sup, exact sup_avail, {
    intros xy Hsub Hcomp,
    exact bset2d.nmem_of_mem_sdiff (component2d_subset_avail xy Hcomp) Hsub,
  }, {
    intros xy Hcomp,
    exact bset2d.mem_of_mem_sdiff (component2d_subset_avail xy Hcomp),
  }, {
    introv Hcomp Ha2, by_cases C : d.shift xy ∈ subboxes,
    { right, exact C, }, left,
    have Ha2 : d.shift xy ∈ avail \ subboxes
      := bset2d.mem_sdiff_of_mem_nmem Ha2 C,
    exact component2d_closed Hcomp Ha2,
  },
end

def boxint.get_pushes (avail : bset2d) (s : boxint)
  : list (direction × (ℕ × ℕ))
  := do
  box ← s.subboxes.to_indexes,
  d ← direction.luniv,
  if d.shift box ∈ avail ∧ d.shift box ∉ s.subboxes
    ∧ d.opposite.shift box ∈ s.sk_comp
  then return (d, box)
  else list.nil

def boxint.get_appearances (avail : bset2d) (s : boxint)
  : list (direction × (ℕ × ℕ))
  := do
  box ← (avail \ s.supboxes).to_indexes,
  d ← direction.luniv,
  if d.shift box ∈ s.supboxes ∧ d.shift box ∉ s.subboxes
    ∧ d.shift (d.shift box) ∈ s.sk_comp
    ∧ d.shift (d.shift box) ≠ d.shift box
  then return (d.opposite, d.shift box)
  else list.nil

def boxint.get_moves (avail : bset2d) (as : boxint)
  : list (direction × (ℕ × ℕ))
  := boxint.get_pushes avail as ++ boxint.get_appearances avail as

lemma boxint.in_get_moves_iff (avail : bset2d) (s : boxint) (Hv : s.valid avail)
  : ∀ (d : direction) (box : ℕ×ℕ),
  (d,box) ∈ boxint.get_moves avail s ↔ (
    d.opposite.shift box ∈ s.sk_comp ∧
    d.opposite.shift box ≠ box ∧
    d.shift box ∈ avail ∧ d.shift box ∉ s.subboxes ∧
    box ∈ s.supboxes ∧ (d.shift box ∈ s.supboxes → box ∈ s.subboxes)
  ) :=
begin
  intros, unfold boxint.get_moves, rw list.mem_append,
  split, {
    rename box box', rename d d',
    intro H, cases H, {
      unfold boxint.get_pushes at H, simp [-prod.exists] at H,
      rcases H with ⟨box,Hbox,d,Huniv,H⟩, clear Huniv,
      have Hbox := (bset2d.to_indexes_iff _ _).mp Hbox,
      by_cases C : d.shift box ∈ avail ∧ d.shift box ∉ s.subboxes
          ∧ d.opposite.shift box ∈ s.sk_comp, {
        simp [C] at H, rw [H.1, H.2], clear H,
        rcases C with ⟨Ha2, Hnb2, Hsk⟩,
        split, exact Hsk,
        split, { -- disproving border case
          assume Heq, rw Heq at Hsk,
          exact Hv.sub_disj box Hbox Hsk,
        },
        split, exact Ha2, split, exact Hnb2,
        split, exact Hv.sub_sup box Hbox,
        intro, exact Hbox,
      }, { simp [C] at H, exact false.elim H, },
    }, {
      unfold boxint.get_appearances at H, simp [-prod.exists] at H,
      rcases H with ⟨box,Hbox,d,Huniv,H⟩, clear Huniv,
      have Hbox := (bset2d.to_indexes_iff _ box).mp Hbox,
      have Hba: box ∈ avail, from bset2d.mem_of_mem_sdiff Hbox,
      have Hbnsup: box ∉ s.supboxes, from bset2d.nmem_of_mem_sdiff Hbox,
      by_cases C : d.shift box ∈ s.supboxes ∧ d.shift box ∉ s.subboxes
          ∧ d.shift (d.shift box) ∈ s.sk_comp ∧ d.shift (d.shift box) ≠ d.shift box, {
        simp [C] at H, rw [H.1, H.2], clear H,
        rcases C with ⟨Hsup2, Hfree, Hcomp, Hnngen⟩,
        cases direction.opposite_shift d box with Heq Hop_simp, {
          -- border case d.shift box = box
          simp [Heq] at Hnngen, exact false.elim Hnngen,
        }, {
          rw [Hop_simp, direction.opposite_opposite],
          split, exact Hcomp,
          split, exact Hnngen,
          split, exact Hba,
          split, exact mt (Hv.sub_sup box) Hbnsup,
          split, exact Hsup2,
          assume Hbsup, exact false.elim (Hbnsup Hbsup),
        }
      },
      { simp [C] at H, exact false.elim H, }
    }
  }, {
    rintros ⟨Hcomp, Hnngen, Hav, Hfree, Hsup, H⟩,
    by_cases C : box ∈ s.subboxes, { left,
      unfold boxint.get_pushes, simp [-prod.exists], existsi box,
      split, exact (bset2d.to_indexes_iff s.subboxes box).mpr C,
      existsi d, split, exact direction.luniv_complete,
      simp [Hfree, Hcomp, Hav],
    }, { right,
      unfold boxint.get_appearances, simp [-prod.exists], existsi d.shift box,
      split, { show d.shift box ∈ (avail \ s.supboxes).to_indexes,
        apply (bset2d.to_indexes_iff _ _).mpr,
        apply bset2d.mem_sdiff_of_mem_nmem,
        exact Hav, assume H2, exact C (H H2),
      },
      existsi d.opposite,
      split, exact direction.luniv_complete,
      simp [direction.opposite_opposite],
      cases direction.opposite_shift d box with Heq Hop_simp, {
        -- border case, d.shift box = box
        rw Heq at H Hfree, exact false.elim (C (H Hsup)),
      },
      { rw Hop_simp, simp! [Hsup, C, Hcomp, Hnngen], }
    },
  }
end

def boxint.move (avail : bset2d)
  (s : boxint) (d : direction) (box : ℕ×ℕ)
  := boxint.generate avail
     ((s.subboxes.remove box).add (d.shift box))
     ((s.supboxes.remove box).add (d.shift box))
     box

def boxint.next_states (avail : bset2d) (s : boxint) : list boxint
  := list.map (function.uncurry (boxint.move avail s)) (boxint.get_moves avail s)

theorem boxint.next_valid (avail : bset2d) (as1 : boxint)
  : as1.valid avail →
  ∀ as2 : boxint, as2 ∈ as1.next_states avail → as2.valid avail
:=
begin
  introv Hv H, simp [boxint.next_states, -prod.exists] at H,
  rcases H with ⟨⟨d, box⟩, H, Heq⟩,
  simp at Heq, rw ←Heq, clear Heq as2,
  rw (boxint.in_get_moves_iff avail as1 Hv) at H,
  rcases H with ⟨Hcomp, Hnng, Hav, Hnb, Hsp, Hextra⟩,
  apply boxint.generate_valid, {
    apply bset2d.subset_add_same,
    apply bset2d.subset_remove_same,
    exact Hv.sub_sup,
  }, {
    assume xy, assume H,
    cases bset2d.of_mem_add H with H H,
    rw H, exact Hav,
    have := bset2d.mem_of_mem_remove H,
    exact Hv.sup_avail xy this,
  }
end

theorem boxint.next_of_real_move (avail : bset2d) (as1 : boxint) :
  as1.valid avail →
  ∀ (s : sokostate) (d : direction), s ∈ as1 → s.move avail d ∈ as1 ∨
  (∃ as2 : boxint, as2 ∈ as1.next_states avail ∧ s.move avail d ∈ as2)
:=
begin
  intros Hv s d Hin,
  have := Hin,
  rcases this with ⟨Hsk,Hsub,Hsup⟩,
  let box := d.shift s.storekeeper,
  let box2 := d.shift box,
  by_cases C : box ∈ s.boxes ∧ box2 ∈ avail ∧ box2 ∉ s.boxes
    ∧ (box ∈ as1.subboxes ∨ box2 ∉ as1.supboxes), {

    right, -- we move to another abstract state

    existsi as1.move avail d box,
    rcases C with ⟨Hbb, Hb2a, Hb2nb, Has⟩,
    split, { -- in next_states
      simp [boxint.next_states, -prod.exists],
      existsi (d,box), split, {
        apply (boxint.in_get_moves_iff avail as1 Hv d box).mpr,
        have Hngen : box ≠ s.storekeeper, {
          assume Heq, simp [box] at Heq,
          simp only [box,box2,Heq] at Hbb Hb2nb,
          exact false.elim (Hb2nb Hbb),
        },
        have : d.opposite.shift box = s.storekeeper
          := or.resolve_left (direction.opposite_shift d s.storekeeper) Hngen,
        rw this,
        split, exact Hsk,
        split, exact ne_comm.mp Hngen,
        split, exact Hb2a,
        split, exact mt (Hsub box2) Hb2nb,
        split, exact Hsup box Hbb,
        exact or.neg_resolve_right Has,
      }, refl,
    }, { -- emulates real move
      have Hba : box ∈ avail := Hv.sup_avail box (Hsup box Hbb),
      simp [boxint.move, boxint.generate],
      simp [sokostate.move, Hba, Hbb, Hb2a, Hb2nb],
      split, simp, {
        apply component2d_supset, {
          intros xy H,
          rw (bset2d.from_index_iff box xy).1 H, clear H xy,
          apply bset2d.mem_sdiff_of_mem_nmem Hba,
          apply bset2d.nmem_add_of_neq_nmem, {
            intro contra, rw contra at Hbb, exact Hb2nb Hbb,
          }, exact bset2d.nmem_remove,
        },
        exact (bset2d.from_index_iff box box).2 rfl,
      },
      simp, split, {
        apply bset2d.subset_add_same,
        apply bset2d.subset_remove_same,
        exact Hsub,
      },
      apply bset2d.subset_add_same,
      apply bset2d.subset_remove_same,
      exact Hsup,
    }
  },

  left, -- the abstract state remains the same

  simp at C,
  simp [sokostate.move],
  by_cases Cba : box ∈ avail, {
    simp [Cba], by_cases Cbb : box ∈ s.boxes, {
      simp [Cbb], by_cases Cb2a : box2 ∈ avail, {
        simp [Cb2a], by_cases Cb2b : box2 ∈ s.boxes,
        { simp [Cb2b], exact Hin, }, {
          simp [Cb2b],
          have C := C Cbb Cb2a Cb2b,
          cases not_or_distrib.mp C with C1 C2,
          have C2 := not_not.mp C2,
          rw boxint.mem.unfold, split,
            exact or.resolve_right (Hv.sk_comp_closed s.storekeeper Hsk d Cba) C1,
          split, {
            intros xy Hin, apply bset2d.mem_add_of_mem,
            apply bset2d.mem_remove_of_neq_mem,
            { intro contra, rw contra at Hin, exact C1 Hin, },
            { exact Hsub xy Hin },
          }, {
            intros xy Hin, cases bset2d.of_mem_add Hin with Heq Hin,
            { rw Heq, exact C2, },
            { exact Hsup xy (bset2d.mem_of_mem_remove Hin), },
          },
        },
      },
      { simp [Cb2a], exact Hin, },
    },
    { simp [Cbb], split,
      exact or.resolve_right
        (Hv.sk_comp_closed s.storekeeper Hsk d Cba)
        (mt (Hsub box) Cbb),
      exact and.intro Hsub Hsup,
    },
  },
  { simp [Cba], exact Hin, },
end