/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta, Maxwell Thum
-/
--import analysis.convex.hull
--import linear_algebra.affine_space.independent
import data.finset.basic
import data.set.finite

/-!
# DISCLAIMER
**THIS IS MY COPY OF MATHLIB'S `analysis.convex.simplicial_complex.basic`!!!**
These edits have nothing to do with the original authors.
I'm not sure whether this will ultimately go in mathlib, so I'm changing a lot willy-nilly.

# Abstract simplicial complexes

In this file, we define abstract simplicial complexes. An abstract simplicial complex is...

## Main declarations

* `abstract_simplicial_complex E`: An abstract simplicial complex in the type `E`.
* `abstract_simplicial_complex.vertices`: The zero dimensional faces of an abstract simplicial complex.
* `abstract_simplicial_complex.facets`: The maximal faces of an abstract simplicial complex.

## Notation

`s ∈ K` means that `s` is a face of `K`.

`K ≤ L` means that the faces of `K` are faces of `L`.

## TODO

Simplicial complexes can be generalized to affine spaces once `convex_hull` has been ported.
-/

open finset set

variables (E : Type*) [decidable_eq E]

/-- An abstract simplicial complex in a type `E` is a downward closed set of nonempty
finite sets. -/
-- TODO: update to new binder order? not sure what binder order is correct for `down_closed`.
@[ext] structure abstract_simplicial_complex :=
(faces : set (finset E))
(not_empty_mem : ∅ ∉ faces)
--(indep : ∀ {s}, s ∈ faces → affine_independent 𝕜 (coe : (s : set E) → E))
(down_closed : ∀ s ∈ faces, ∀ t ⊆ s, t ≠ ∅ → t ∈ faces)
/-(inter_subset_convex_hull : ∀ {s t}, s ∈ faces → t ∈ faces →
  convex_hull 𝕜 ↑s ∩ convex_hull 𝕜 ↑t ⊆ convex_hull 𝕜 (s ∩ t : set E))-/

namespace abstract_simplicial_complex
variables {E} {K : abstract_simplicial_complex E} {s t : finset E} {x : E}

/-- A `finset` belongs to an `abstract_simplicial_complex` if it's a face of it. -/
instance : has_mem (finset E) (abstract_simplicial_complex E) := ⟨λ s K, s ∈ K.faces⟩

/-
/-- The underlying space of a simplicial complex is the union of its faces. -/
def space (K : simplicial_complex 𝕜 E) : set E := ⋃ s ∈ K.faces, convex_hull 𝕜 (s : set E)

lemma mem_space_iff : x ∈ K.space ↔ ∃ s ∈ K.faces, x ∈ convex_hull 𝕜 (s : set E) := mem_Union₂

lemma convex_hull_subset_space (hs : s ∈ K.faces) : convex_hull 𝕜 ↑s ⊆ K.space :=
subset_bUnion_of_mem hs

protected lemma subset_space (hs : s ∈ K.faces) : (s : set E) ⊆ K.space :=
(subset_convex_hull 𝕜 _).trans $ convex_hull_subset_space hs

lemma convex_hull_inter_convex_hull (hs : s ∈ K.faces) (ht : t ∈ K.faces) :
  convex_hull 𝕜 ↑s ∩ convex_hull 𝕜 ↑t = convex_hull 𝕜 (s ∩ t : set E) :=
(K.inter_subset_convex_hull hs ht).antisymm $ subset_inter
  (convex_hull_mono $ set.inter_subset_left _ _) $ convex_hull_mono $ set.inter_subset_right _ _
-/

/-- -/
lemma disjoint_or_exists_inter_eq_face (hs : s ∈ K.faces) (ht : t ∈ K.faces) :
  (s : set E) ∩ t = ∅ ∨ ∃ u ∈ K.faces, (s : set E) ∩ t = u :=
begin
  classical,
  by_contra' h,
  refine h.2 (s ∩ t) (K.down_closed s hs _ (inter_subset_left _ _) $ λ hst, h.1 _) _,
  { rw [← coe_inter],
    exact coe_eq_empty.mpr hst, },
  { rw [coe_inter], }
end

/-- Construct an abstract simplicial complex by removing the empty face for you. -/
@[simps] def of_erase
  (faces : set (finset E))
  --(indep : ∀ s ∈ faces, affine_independent 𝕜 (coe : (s : set E) → E))
  (down_closed : ∀ s ∈ faces, ∀ t ⊆ s, t ∈ faces)
  /-(inter_subset_convex_hull : ∀ s t ∈ faces,
    convex_hull 𝕜 ↑s ∩ convex_hull 𝕜 ↑t ⊆ convex_hull 𝕜 (s ∩ t : set E))-/ :
  abstract_simplicial_complex E :=
{ faces := faces \ {∅},
  not_empty_mem := λ h, h.2 (mem_singleton _),
  --indep := λ s hs, indep _ hs.1,
  down_closed := λ s hs t hts ht, ⟨down_closed s hs.1 t hts, ht⟩,
  --inter_subset_convex_hull := λ s t hs ht, inter_subset_convex_hull _ hs.1 _ ht.1
  }

/-- Construct an abstract simplicial complex as a subset of a given abstract simplicial
complex. -/
@[simps] def of_subcomplex (K : abstract_simplicial_complex E)
  (faces : set (finset E))
  (subset : faces ⊆ K.faces)
  (down_closed : ∀ s ∈ faces, ∀ t ⊆ s, t ∈ faces) :
  abstract_simplicial_complex E :=
{ faces := faces,
  not_empty_mem := λ h, K.not_empty_mem (subset h),
  --indep := λ s hs, K.indep (subset hs),
  down_closed := λ s hs t hts _, down_closed s hs t hts,
  --inter_subset_convex_hull := λ s t hs ht, K.inter_subset_convex_hull (subset hs) (subset ht)
}

/-! ### Degrees and Vertices -/

/-
/-- The degree (or dimension) of a simplex is its cardinality minus one. -/
def degree (s : finset E) : ℕ := s.card - 1
-/

/-- The set of `k`-faces in `K`, the faces in `K` with degree `k`. -/
def k_faces (K : abstract_simplicial_complex E) (k : ℕ) : set K.faces :=
  { s : K.faces | s.1.card = k + 1 }

/-- The vertices of an abstract simplicial complex are its zero dimensional faces. -/
def vertices (K : abstract_simplicial_complex E) : set E := {x | {x} ∈ K.faces}

lemma mem_vertices : x ∈ K.vertices ↔ {x} ∈ K.faces := iff.rfl

lemma vertices_eq : K.vertices = ⋃ k ∈ K.faces, (k : set E) :=
begin
  ext x,
  refine ⟨λ h, mem_bUnion h $ mem_coe.2 $ mem_singleton_self x, λ h, _⟩,
  obtain ⟨s, hs, hx⟩ := mem_Union₂.1 h,
  exact K.down_closed _ hs _ (finset.singleton_subset_iff.2 $ mem_coe.1 hx) (singleton_ne_empty _),
end

/-
lemma vertices_subset_space : K.vertices ⊆ K.space :=
vertices_eq.subset.trans $ Union₂_mono $ λ x hx, subset_convex_hull 𝕜 x

lemma vertex_mem_convex_hull_iff (hx : x ∈ K.vertices) (hs : s ∈ K.faces) :
  x ∈ convex_hull 𝕜 (s : set E) ↔ x ∈ s :=
begin
  refine ⟨λ h, _, λ h, subset_convex_hull _ _ h⟩,
  classical,
  have h := K.inter_subset_convex_hull hx hs ⟨by simp, h⟩,
  by_contra H,
  rwa [←coe_inter, finset.disjoint_iff_inter_eq_empty.1
    (finset.disjoint_singleton_right.2 H).symm, coe_empty, convex_hull_empty] at h,
end

/-- A face is a subset of another one iff its vertices are.  -/
lemma face_subset_face_iff (hs : s ∈ K.faces) (ht : t ∈ K.faces) :
  convex_hull 𝕜 (s : set E) ⊆ convex_hull 𝕜 ↑t ↔ s ⊆ t :=
⟨λ h x hxs, (vertex_mem_convex_hull_iff (K.down_closed hs (finset.singleton_subset_iff.2 hxs) $
  singleton_ne_empty _) ht).1 (h (subset_convex_hull 𝕜 ↑s hxs)), convex_hull_mono⟩
-/

/-! ### Facets -/

/-- A facet of an abstract simplicial complex is a maximal face. -/
def facets (K : abstract_simplicial_complex E) : set (finset E) :=
{s ∈ K.faces | ∀ ⦃t⦄, t ∈ K.faces → s ⊆ t → s = t}

lemma mem_facets : s ∈ K.facets ↔ s ∈ K.faces ∧ ∀ t ∈ K.faces, s ⊆ t → s = t := mem_sep_iff

lemma facets_subset : K.facets ⊆ K.faces := λ s hs, hs.1

lemma not_facet_iff_subface (hs : s ∈ K.faces) : (s ∉ K.facets ↔ ∃ t, t ∈ K.faces ∧ s ⊂ t) :=
begin
  refine ⟨λ (hs' : ¬ (_ ∧ _)), _, _⟩,
  { push_neg at hs',
    obtain ⟨t, ht⟩ := hs' hs,
    exact ⟨t, ht.1, ⟨ht.2.1, (λ hts, ht.2.2 (subset.antisymm ht.2.1 hts))⟩⟩ },
  { rintro ⟨t, ht⟩ ⟨hs, hs'⟩,
    have := hs' ht.1 ht.2.1,
    rw this at ht,
    exact ht.2.2 (subset.refl t) } -- `has_ssubset.ssubset.ne` would be handy here
end

/-!
### The semilattice of abstract simplicial complexes

`K ≤ L` means that `K.faces ⊆ L.faces`.
-/

variables (E)

/-- The complex consisting of only the faces present in both of its arguments. -/
instance : has_inf (abstract_simplicial_complex E) :=
⟨λ K L, { faces := K.faces ∩ L.faces,
  not_empty_mem := λ h, K.not_empty_mem (set.inter_subset_left _ _ h),
  --indep := λ s hs, K.indep hs.1,
  down_closed := λ s hs t hst ht, ⟨K.down_closed _ hs.1 _ hst ht, L.down_closed _ hs.2 _ hst ht⟩,
  --inter_subset_convex_hull := λ s t hs ht, K.inter_subset_convex_hull hs.1 ht.1
  }⟩

instance : semilattice_inf (abstract_simplicial_complex E) :=
{ inf := (⊓),
  inf_le_left := λ K L s hs, hs.1,
  inf_le_right := λ K L s hs, hs.2,
  le_inf := λ K L M hKL hKM s hs, ⟨hKL hs, hKM hs⟩,
  .. (partial_order.lift faces $ λ x y, ext _ _) }

instance : has_bot (abstract_simplicial_complex E) :=
⟨{ faces := ∅,
  not_empty_mem := set.not_mem_empty ∅,
  --indep := λ s hs, (set.not_mem_empty _ hs).elim,
  down_closed := λ s hs _, (set.not_mem_empty _ hs).elim,
  --inter_subset_convex_hull := λ s _ hs, (set.not_mem_empty _ hs).elim
  }⟩

instance : order_bot (abstract_simplicial_complex E) :=
{ bot_le := λ K, set.empty_subset _, .. abstract_simplicial_complex.has_bot E }

instance : inhabited (abstract_simplicial_complex E) := ⟨⊥⟩

variables {E}

lemma faces_bot : (⊥ : abstract_simplicial_complex E).faces = ∅ := rfl

--lemma space_bot : (⊥ : simplicial_complex 𝕜 E).space = ∅ := set.bUnion_empty _

lemma facets_bot : (⊥ : abstract_simplicial_complex E).facets = ∅ := eq_empty_of_subset_empty facets_subset

end abstract_simplicial_complex


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.fintype.order
import order.category.LinearOrder

/-!
# Nonempty finite linear orders

This defines `NonemptyFinLinOrd`, the category of nonempty finite linear orders with monotone maps.
This is the index category for simplicial objects.
-/

universes u v

open category_theory

/-- A typeclass for nonempty finite linear orders. -/
class nonempty_fin_lin_ord (α : Type*) extends fintype α, linear_order α :=
(nonempty : nonempty α . tactic.apply_instance)

attribute [instance] nonempty_fin_lin_ord.nonempty

@[priority 100]
instance nonempty_fin_lin_ord.to_bounded_order (α : Type*) [nonempty_fin_lin_ord α] :
  bounded_order α :=
fintype.to_bounded_order α

instance punit.nonempty_fin_lin_ord : nonempty_fin_lin_ord punit :=
{ .. punit.linear_ordered_cancel_add_comm_monoid,
  .. punit.fintype }

instance fin.nonempty_fin_lin_ord (n : ℕ) : nonempty_fin_lin_ord (fin (n+1)) :=
{ .. fin.fintype _,
  .. fin.linear_order }

instance ulift.nonempty_fin_lin_ord (α : Type u) [nonempty_fin_lin_ord α] :
  nonempty_fin_lin_ord (ulift.{v} α) :=
{ nonempty := ⟨ulift.up ⊥⟩,
  .. linear_order.lift equiv.ulift (equiv.injective _),
  .. ulift.fintype _ }

instance (α : Type*) [nonempty_fin_lin_ord α] : nonempty_fin_lin_ord αᵒᵈ :=
{ ..order_dual.fintype α }

/-- The category of nonempty finite linear orders. -/
def NonemptyFinLinOrd := bundled nonempty_fin_lin_ord

namespace NonemptyFinLinOrd

instance : bundled_hom.parent_projection @nonempty_fin_lin_ord.to_linear_order := ⟨⟩

attribute [derive [large_category, concrete_category]] NonemptyFinLinOrd

instance : has_coe_to_sort NonemptyFinLinOrd Type* := bundled.has_coe_to_sort

/-- Construct a bundled `NonemptyFinLinOrd` from the underlying type and typeclass. -/
def of (α : Type*) [nonempty_fin_lin_ord α] : NonemptyFinLinOrd := bundled.of α

@[simp] lemma coe_of (α : Type*) [nonempty_fin_lin_ord α] : ↥(of α) = α := rfl

instance : inhabited NonemptyFinLinOrd := ⟨of punit⟩

instance (α : NonemptyFinLinOrd) : nonempty_fin_lin_ord α := α.str

instance has_forget_to_LinearOrder : has_forget₂ NonemptyFinLinOrd LinearOrder :=
bundled_hom.forget₂ _ _

/-- Constructs an equivalence between nonempty finite linear orders from an order isomorphism
between them. -/
@[simps] def iso.mk {α β : NonemptyFinLinOrd.{u}} (e : α ≃o β) : α ≅ β :=
{ hom := e,
  inv := e.symm,
  hom_inv_id' := by { ext, exact e.symm_apply_apply x },
  inv_hom_id' := by { ext, exact e.apply_symm_apply x } }

/-- `order_dual` as a functor. -/
@[simps] def dual : NonemptyFinLinOrd ⥤ NonemptyFinLinOrd :=
{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }

/-- The equivalence between `FinPartialOrder` and itself induced by `order_dual` both ways. -/
@[simps functor inverse] def dual_equiv : NonemptyFinLinOrd ≌ NonemptyFinLinOrd :=
equivalence.mk dual dual
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)

end NonemptyFinLinOrd

lemma NonemptyFinLinOrd_dual_comp_forget_to_LinearOrder :
  NonemptyFinLinOrd.dual ⋙ forget₂ NonemptyFinLinOrd LinearOrder =
    forget₂ NonemptyFinLinOrd LinearOrder ⋙ LinearOrder.dual := rfl


import data.equiv.basic
import group_theory.subgroup

universes u v

section
open tactic interactive (parse loc.wildcard) interactive.types (location) lean.parser (many ident)

run_cmd mk_simp_attr `with_zero_simp

meta def tactic.with_zero_cases : list expr → tactic unit
| (h::t) := seq (induction h [] (some `with_zero.cases_on) >> skip) $ tactic.with_zero_cases t
| [] := do try (interactive.norm_cast loc.wildcard),
           try (tactic.interactive.simp_core {} assumption ff [] [`with_zero_simp] loc.wildcard),
           try (do exfalso, assumption)

/-- Case bashing for with_zero. If `x₁, ... x_n` have type `with_zero α` then
`with_zero cases x₁ ... x_n` will split according to whether each `x_i` is zero or coerced from
`α` then run `norm_cast at *`, try to simplify using the simp rules `with_zero_simp`, and try to
get a contradiction. -/
meta def tactic.interactive.with_zero_cases (l : parse $ many ident) :=
l.mmap tactic.get_local >>= tactic.with_zero_cases
end

namespace with_zero

variables {α : Type u} {β : Type v}

@[simp, with_zero_simp] lemma zero_le [preorder α] {x : with_zero α} : 0 ≤ x :=
by { intros y hy, cases hy }

@[simp, with_zero_simp] lemma zero_lt_coe [preorder α] {a : α} : (0 : with_zero α) < a :=
⟨a, rfl, λ y hy, by cases hy⟩

@[simp, with_zero_simp] lemma not_coe_eq_zero [preorder α] {x : α} : ¬ (x : with_zero α) = 0 :=
λ h, option.no_confusion h

@[elim_cast] lemma coe_le_coe [preorder α] {x y : α} :
  (x : with_zero α) ≤ (y : with_zero α) ↔ x ≤ y :=
⟨λ h, by rcases (h x rfl) with ⟨z, ⟨h2⟩, h3⟩; exact h3, λ _ _ h, ⟨y, rfl, by cases h ; assumption⟩⟩

@[elim_cast] lemma coe_lt_coe [preorder α] {x y : α} :
  (x : with_zero α) < (y : with_zero α) ↔ x < y :=
by repeat { rw [lt_iff_le_not_le, coe_le_coe] }

-- TODO: replace `coe_one` in mathlib by this one, which seems to be stated as needed by norm_cast.
-- Same remark applies to the next two lemmas.
@[elim_cast] lemma coe_one' [has_one α] : (1 : with_zero α) = ((1 : α) : with_zero α) := rfl

@[move_cast] lemma inv_coe' {α : Type*} [has_inv α] (a : α) :
 ((a⁻¹ : α) : with_zero α) = (a : with_zero α)⁻¹  := rfl

@[move_cast] lemma mul_coe' {α : Type*} [has_mul α] (a b : α) :
  ((a * b : α) : with_zero α) = (a : with_zero α) * b := rfl

attribute [elim_cast] coe_inj

@[simp] lemma le_zero_iff_eq_zero [preorder α] {x : with_zero α} : x ≤ 0 ↔ x = 0 :=
begin
  with_zero_cases x,
  intro h,
  rcases h x rfl with ⟨_, h, _⟩,
  exact option.no_confusion h,
end

@[simp] lemma not_coe_le_zero [preorder α] (x : α) : ¬ (x : with_zero α) ≤ 0 :=
begin
  intro h,
  rw le_zero_iff_eq_zero at h,
  exact not_coe_eq_zero h,
end

@[simp] lemma not_lt_zero [preorder α] (x : with_zero α) : ¬ x < 0 :=
begin
  intro h,
  with_zero_cases x,
  exact lt_irrefl _ h,
  exact not_coe_le_zero x (le_of_lt h),
end

@[simp] lemma map_zero {f : α → β} : map f 0 = 0 := option.map_none'

@[simp, elim_cast] lemma map_coe {f : α → β} {a : α} : map f (a : with_zero α) = f a :=
option.map_some'

@[simp] lemma map_id {α : Type*} : map (id : α → α) = id := option.map_id

lemma map_comp {α β γ : Type*} (f : α → β) (g : β → γ) (r : with_zero α) :
  map (g ∘ f) r = map g (map f r) :=
by cases r; refl

@[simp] lemma map_eq_zero_iff {f : α → β} {a : with_zero α} : map f a = 0 ↔ a = 0 :=
⟨λ h, by with_zero_cases a, λ h, by simp [h]⟩

lemma injective_map {f : α → β} (H : function.injective f) :
function.injective (map f) := option.injective_map H

lemma map_monotone [preorder α] [preorder β] {f : α → β} (H : monotone f) :
  monotone (map f) :=
λ x y, by { with_zero_cases x y, exact λ h, H h }

lemma map_strict_mono [linear_order α] [partial_order β] {f : α → β}
  (H : ∀ a b, a < b → f a < f b) :
  strict_mono (map f) :=
λ x y, by { with_zero_cases x y, exact λ h, H _ _ h }

lemma map_le [preorder α] [preorder β] {f : α → β}
  (H : ∀ a b : α, a ≤ b ↔ f a ≤ f b) (x y : with_zero α) :
x ≤ y ↔ map f x ≤ map f y :=
by { with_zero_cases x y, exact H x y }

@[move_cast] lemma coe_min (x y : α) [decidable_linear_order α] :
  ((min x y : α) : with_zero α) = min x y :=
begin
  by_cases h: x ≤ y,
  { simp [min_eq_left, h] },
  { simp [min_eq_right, le_of_not_le h] }
end

section group
variables [group α]

lemma mul_left_cancel : ∀ {x : with_zero α} (h : x ≠ 0) {y z : with_zero α}, x * y = x * z → y = z
| 0       h := false.elim $ h rfl
| (a : α) h := λ y z h2, begin
  have h3 : (a⁻¹ : with_zero α) * (a * y) = a⁻¹ * (a * z) := by rw h2,
  rwa [←mul_assoc, ←mul_assoc, mul_left_inv _ h, one_mul, one_mul] at h3,
end

lemma mul_right_cancel : ∀ {x : with_zero α} (h : x ≠ 0) {y z : with_zero α}, y * x = z * x → y = z
| 0       h := false.elim $ h rfl
| (a : α) h := λ y z h2, begin
  have h3 : (y * a) * a⁻¹ = (z * a) * a⁻¹ := by rw h2,
  rwa [mul_assoc, mul_assoc, mul_right_inv _ h, mul_one, mul_one] at h3,
end

lemma mul_inv_eq_of_eq_mul : ∀ {x : with_zero α} (h : x ≠ 0) {y z : with_zero α},
  y = z * x → y * x⁻¹ = z
| 0       h := false.elim $ h rfl
| (x : α) h := λ _ _ _, mul_right_cancel h (by rwa [mul_assoc, mul_left_inv _ h, mul_one])

lemma eq_mul_inv_of_mul_eq {x : with_zero α} (h : x ≠ 0) {y z : with_zero α} (h2 : z * x = y) :
  z = y * x⁻¹ := eq.symm $ mul_inv_eq_of_eq_mul h h2.symm

end group

end with_zero


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

! This file was ported from Lean 3 source module data.list.sublists
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Choose.Basic
import Mathbin.Data.List.Perm

/-! # sublists

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

`list.sublists` gives a list of all (not necessarily contiguous) sublists of a list.

This file contains basic results on this function.
-/

universe u v w

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

open Nat

namespace List

/-! ### sublists -/

#print List.sublists'_nil /-
@[simp]
theorem sublists'_nil : sublists' (@nil α) = [[]] :=
  rfl
#align list.sublists'_nil List.sublists'_nil
-/

#print List.sublists'_singleton /-
@[simp]
theorem sublists'_singleton (a : α) : sublists' [a] = [[], [a]] :=
  rfl
#align list.sublists'_singleton List.sublists'_singleton
-/

/- warning: list.map_sublists'_aux clashes with [anonymous] -> [anonymous]
warning: list.map_sublists'_aux -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u}} {β : Type.{v}} {γ : Type.{w}} (g : (List.{v} β) -> (List.{w} γ)) (l : List.{u} α) (f : (List.{u} α) -> (List.{v} β)) (r : List.{v} (List.{v} β)), Eq.{succ w} (List.{w} (List.{w} γ)) (List.map.{v, w} (List.{v} β) (List.{w} γ) g (List.sublists'Aux.{u, v} α β l f r)) (List.sublists'Aux.{u, w} α γ l (Function.comp.{succ u, succ v, succ w} (List.{u} α) (List.{v} β) (List.{w} γ) g f) (List.map.{v, w} (List.{v} β) (List.{w} γ) g r))
but is expected to have type
  forall {α : Type.{u}} {β : Type.{v}}, (Nat -> α -> β) -> Nat -> (List.{u} α) -> (List.{v} β)
Case conversion may be inaccurate. Consider using '#align list.map_sublists'_aux [anonymous]ₓ'. -/
theorem [anonymous] (g : List β → List γ) (l : List α) (f r) :
    map g (sublists'Aux l f r) = sublists'Aux l (g ∘ f) (map g r) := by
  induction l generalizing f r <;> [rfl, simp only [*, sublists'_aux]]
#align list.map_sublists'_aux [anonymous]

/- warning: list.sublists'_aux_append clashes with [anonymous] -> [anonymous]
warning: list.sublists'_aux_append -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (r' : List.{u2} (List.{u2} β)) (l : List.{u1} α) (f : (List.{u1} α) -> (List.{u2} β)) (r : List.{u2} (List.{u2} β)), Eq.{succ u2} (List.{u2} (List.{u2} β)) (List.sublists'Aux.{u1, u2} α β l f (Append.append.{u2} (List.{u2} (List.{u2} β)) (List.hasAppend.{u2} (List.{u2} β)) r r')) (Append.append.{u2} (List.{u2} (List.{u2} β)) (List.hasAppend.{u2} (List.{u2} β)) (List.sublists'Aux.{u1, u2} α β l f r) r')
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}}, (Nat -> α -> β) -> Nat -> (List.{u1} α) -> (List.{u2} β)
Case conversion may be inaccurate. Consider using '#align list.sublists'_aux_append [anonymous]ₓ'. -/
theorem [anonymous] (r' : List (List β)) (l : List α) (f r) :
    sublists'Aux l f (r ++ r') = sublists'Aux l f r ++ r' := by
  induction l generalizing f r <;> [rfl, simp only [*, sublists'_aux]]
#align list.sublists'_aux_append [anonymous]

/- warning: list.sublists'_aux_eq_sublists' clashes with [anonymous] -> [anonymous]
warning: list.sublists'_aux_eq_sublists' -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (l : List.{u1} α) (f : (List.{u1} α) -> (List.{u2} β)) (r : List.{u2} (List.{u2} β)), Eq.{succ u2} (List.{u2} (List.{u2} β)) (List.sublists'Aux.{u1, u2} α β l f r) (Append.append.{u2} (List.{u2} (List.{u2} β)) (List.hasAppend.{u2} (List.{u2} β)) (List.map.{u1, u2} (List.{u1} α) (List.{u2} β) f (List.sublists'.{u1} α l)) r)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}}, (Nat -> α -> β) -> Nat -> (List.{u1} α) -> (List.{u2} β)
Case conversion may be inaccurate. Consider using '#align list.sublists'_aux_eq_sublists' [anonymous]ₓ'. -/
theorem [anonymous] (l f r) : @sublists'Aux α β l f r = map f (sublists' l) ++ r := by
  rw [sublists', map_sublists'_aux, ← sublists'_aux_append] <;> rfl
#align list.sublists'_aux_eq_sublists' [anonymous]

#print List.sublists'_cons /-
@[simp]
theorem sublists'_cons (a : α) (l : List α) :
    sublists' (a :: l) = sublists' l ++ map (cons a) (sublists' l) := by
  rw [sublists', sublists'_aux] <;> simp only [sublists'_aux_eq_sublists', map_id, append_nil] <;>
    rfl
#align list.sublists'_cons List.sublists'_cons
-/

#print List.mem_sublists' /-
@[simp]
theorem mem_sublists' {s t : List α} : s ∈ sublists' t ↔ s <+ t :=
  by
  induction' t with a t IH generalizing s
  · simp only [sublists'_nil, mem_singleton]
    exact ⟨fun h => by rw [h], eq_nil_of_sublist_nil⟩
  simp only [sublists'_cons, mem_append, IH, mem_map]
  constructor <;> intro h; rcases h with (h | ⟨s, h, rfl⟩)
  · exact sublist_cons_of_sublist _ h
  · exact h.cons_cons _
  · cases' h with _ _ _ h s _ _ h
    · exact Or.inl h
    · exact Or.inr ⟨s, h, rfl⟩
#align list.mem_sublists' List.mem_sublists'
-/

#print List.length_sublists' /-
@[simp]
theorem length_sublists' : ∀ l : List α, length (sublists' l) = 2 ^ length l
  | [] => rfl
  | a :: l => by
    simp only [sublists'_cons, length_append, length_sublists' l, length_map, length, pow_succ',
      mul_succ, MulZeroClass.mul_zero, zero_add]
#align list.length_sublists' List.length_sublists'
-/

#print List.sublists_nil /-
@[simp]
theorem sublists_nil : sublists (@nil α) = [[]] :=
  rfl
#align list.sublists_nil List.sublists_nil
-/

#print List.sublists_singleton /-
@[simp]
theorem sublists_singleton (a : α) : sublists [a] = [[], [a]] :=
  rfl
#align list.sublists_singleton List.sublists_singleton
-/

/- warning: list.sublists_aux₁_eq_sublists_aux clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux₁_eq_sublists_aux -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (l : List.{u1} α) (f : (List.{u1} α) -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.sublistsAux₁.{u1, u2} α β l f) (List.sublistsAux.{u1, u2} α β l (fun (ys : List.{u1} α) (r : List.{u2} β) => Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (f ys) r))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}}, (Nat -> α -> β) -> Nat -> (List.{u1} α) -> (List.{u2} β)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux₁_eq_sublists_aux [anonymous]ₓ'. -/
theorem [anonymous] :
    ∀ (l) (f : List α → List β), sublistsAux₁ l f = sublistsAux l fun ys r => f ys ++ r
  | [], f => rfl
  | a :: l, f => by rw [sublists_aux₁, sublists_aux] <;> simp only [*, append_assoc]
#align list.sublists_aux₁_eq_sublists_aux [anonymous]

/- warning: list.sublists_aux_cons_eq_sublists_aux₁ clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux_cons_eq_sublists_aux₁ -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u}} (l : List.{u} α), Eq.{succ u} (List.{u} (List.{u} α)) (List.sublistsAux.{u, u} α (List.{u} α) l (List.cons.{u} (List.{u} α))) (List.sublistsAux₁.{u, u} α (List.{u} α) l (fun (x : List.{u} α) => List.cons.{u} (List.{u} α) x (List.nil.{u} (List.{u} α))))
but is expected to have type
  forall {α : Type.{u}} {l : Type.{v}}, (Nat -> α -> l) -> Nat -> (List.{u} α) -> (List.{v} l)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux_cons_eq_sublists_aux₁ [anonymous]ₓ'. -/
theorem [anonymous] (l : List α) : sublistsAux l cons = sublistsAux₁ l fun x => [x] := by
  rw [sublists_aux₁_eq_sublists_aux] <;> rfl
#align list.sublists_aux_cons_eq_sublists_aux₁ [anonymous]

/- warning: list.sublists_aux_eq_foldr.aux clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux_eq_foldr.aux -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {a : α} {l : List.{u1} α}, (forall (f : (List.{u1} α) -> (List.{u2} β) -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.sublistsAux.{u1, u2} α β l f) (List.foldr.{u1, u2} (List.{u1} α) (List.{u2} β) f (List.nil.{u2} β) (List.sublistsAux.{u1, u1} α (List.{u1} α) l (List.cons.{u1} (List.{u1} α))))) -> (forall (f : (List.{u1} α) -> (List.{u1} (List.{u1} α)) -> (List.{u1} (List.{u1} α))), Eq.{succ u1} (List.{u1} (List.{u1} α)) (List.sublistsAux.{u1, u1} α (List.{u1} α) l f) (List.foldr.{u1, u1} (List.{u1} α) (List.{u1} (List.{u1} α)) f (List.nil.{u1} (List.{u1} α)) (List.sublistsAux.{u1, u1} α (List.{u1} α) l (List.cons.{u1} (List.{u1} α))))) -> (forall (f : (List.{u1} α) -> (List.{u2} β) -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.sublistsAux.{u1, u2} α β (List.cons.{u1} α a l) f) (List.foldr.{u1, u2} (List.{u1} α) (List.{u2} β) f (List.nil.{u2} β) (List.sublistsAux.{u1, u1} α (List.{u1} α) (List.cons.{u1} α a l) (List.cons.{u1} (List.{u1} α)))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}}, (Nat -> α -> β) -> Nat -> (List.{u1} α) -> (List.{u2} β)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux_eq_foldr.aux [anonymous]ₓ'. -/
theorem [anonymous] {a : α} {l : List α}
    (IH₁ : ∀ f : List α → List β → List β, sublistsAux l f = foldr f [] (sublistsAux l cons))
    (IH₂ :
      ∀ f : List α → List (List α) → List (List α),
        sublistsAux l f = foldr f [] (sublistsAux l cons))
    (f : List α → List β → List β) :
    sublistsAux (a :: l) f = foldr f [] (sublistsAux (a :: l) cons) :=
  by
  simp only [sublists_aux, foldr_cons]; rw [IH₂, IH₁]; congr 1
  induction' sublists_aux l cons with _ _ ih; · rfl
  simp only [ih, foldr_cons]
#align list.sublists_aux_eq_foldr.aux [anonymous]

/- warning: list.sublists_aux_eq_foldr clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux_eq_foldr -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (l : List.{u1} α) (f : (List.{u1} α) -> (List.{u2} β) -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.sublistsAux.{u1, u2} α β l f) (List.foldr.{u1, u2} (List.{u1} α) (List.{u2} β) f (List.nil.{u2} β) (List.sublistsAux.{u1, u1} α (List.{u1} α) l (List.cons.{u1} (List.{u1} α))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}}, (Nat -> α -> β) -> Nat -> (List.{u1} α) -> (List.{u2} β)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux_eq_foldr [anonymous]ₓ'. -/
theorem [anonymous] (l : List α) :
    ∀ f : List α → List β → List β, sublistsAux l f = foldr f [] (sublistsAux l cons) :=
  by
  suffices
    _ ∧
      ∀ f : List α → List (List α) → List (List α),
        sublistsAux l f = foldr f [] (sublistsAux l cons)
    from this.1
  induction' l with a l IH; · constructor <;> intro <;> rfl
  exact ⟨sublists_aux_eq_foldr.aux IH.1 IH.2, sublists_aux_eq_foldr.aux IH.2 IH.2⟩
#align list.sublists_aux_eq_foldr [anonymous]

/- warning: list.sublists_aux_cons_cons clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux_cons_cons -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u}} (l : List.{u} α) (a : α), Eq.{succ u} (List.{u} (List.{u} α)) (List.sublistsAux.{u, u} α (List.{u} α) (List.cons.{u} α a l) (List.cons.{u} (List.{u} α))) (List.cons.{u} (List.{u} α) (List.cons.{u} α a (List.nil.{u} α)) (List.foldr.{u, u} (List.{u} α) (List.{u} (List.{u} α)) (fun (ys : List.{u} α) (r : List.{u} (List.{u} α)) => List.cons.{u} (List.{u} α) ys (List.cons.{u} (List.{u} α) (List.cons.{u} α a ys) r)) (List.nil.{u} (List.{u} α)) (List.sublistsAux.{u, u} α (List.{u} α) l (List.cons.{u} (List.{u} α)))))
but is expected to have type
  forall {α : Type.{u}} {l : Type.{v}}, (Nat -> α -> l) -> Nat -> (List.{u} α) -> (List.{v} l)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux_cons_cons [anonymous]ₓ'. -/
theorem [anonymous] (l : List α) (a : α) :
    sublistsAux (a :: l) cons =
      [a] :: foldr (fun ys r => ys :: (a :: ys) :: r) [] (sublistsAux l cons) :=
  by rw [← sublists_aux_eq_foldr] <;> rfl
#align list.sublists_aux_cons_cons [anonymous]

/- warning: list.sublists_aux₁_append clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux₁_append -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (l₁ : List.{u1} α) (l₂ : List.{u1} α) (f : (List.{u1} α) -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.sublistsAux₁.{u1, u2} α β (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l₁ l₂) f) (Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (List.sublistsAux₁.{u1, u2} α β l₁ f) (List.sublistsAux₁.{u1, u2} α β l₂ (fun (x : List.{u1} α) => Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (f x) (List.sublistsAux₁.{u1, u2} α β l₁ (Function.comp.{succ u1, succ u1, succ u2} (List.{u1} α) (List.{u1} α) (List.{u2} β) f (fun (_x : List.{u1} α) => Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) _x x))))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}}, (Nat -> α -> β) -> Nat -> (List.{u1} α) -> (List.{u2} β)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux₁_append [anonymous]ₓ'. -/
theorem [anonymous] :
    ∀ (l₁ l₂ : List α) (f : List α → List β),
      sublistsAux₁ (l₁ ++ l₂) f =
        sublistsAux₁ l₁ f ++ sublistsAux₁ l₂ fun x => f x ++ sublistsAux₁ l₁ (f ∘ (· ++ x))
  | [], l₂, f => by simp only [sublists_aux₁, nil_append, append_nil]
  | a :: l₁, l₂, f => by
    simp only [sublists_aux₁, cons_append, sublists_aux₁_append l₁, append_assoc] <;> rfl
#align list.sublists_aux₁_append [anonymous]

/- warning: list.sublists_aux₁_concat clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux₁_concat -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (l : List.{u1} α) (a : α) (f : (List.{u1} α) -> (List.{u2} β)), Eq.{succ u2} (List.{u2} β) (List.sublistsAux₁.{u1, u2} α β (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α a (List.nil.{u1} α))) f) (Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (List.sublistsAux₁.{u1, u2} α β l f) (f (List.cons.{u1} α a (List.nil.{u1} α)))) (List.sublistsAux₁.{u1, u2} α β l (fun (x : List.{u1} α) => f (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) x (List.cons.{u1} α a (List.nil.{u1} α))))))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}}, (Nat -> α -> β) -> Nat -> (List.{u1} α) -> (List.{u2} β)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux₁_concat [anonymous]ₓ'. -/
theorem [anonymous] (l : List α) (a : α) (f : List α → List β) :
    sublistsAux₁ (l ++ [a]) f = sublistsAux₁ l f ++ f [a] ++ sublistsAux₁ l fun x => f (x ++ [a]) :=
  by simp only [sublists_aux₁_append, sublists_aux₁, append_assoc, append_nil]
#align list.sublists_aux₁_concat [anonymous]

/- warning: list.sublists_aux₁_bind clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux₁_bind -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u}} {β : Type.{v}} {γ : Type.{w}} (l : List.{u} α) (f : (List.{u} α) -> (List.{v} β)) (g : β -> (List.{w} γ)), Eq.{succ w} (List.{w} γ) (List.bind.{v, w} β γ (List.sublistsAux₁.{u, v} α β l f) g) (List.sublistsAux₁.{u, w} α γ l (fun (x : List.{u} α) => List.bind.{v, w} β γ (f x) g))
but is expected to have type
  forall {α : Type.{u}} {β : Type.{v}}, (Nat -> α -> β) -> Nat -> (List.{u} α) -> (List.{v} β)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux₁_bind [anonymous]ₓ'. -/
theorem [anonymous] :
    ∀ (l : List α) (f : List α → List β) (g : β → List γ),
      (sublistsAux₁ l f).bind g = sublistsAux₁ l fun x => (f x).bind g
  | [], f, g => rfl
  | a :: l, f, g => by simp only [sublists_aux₁, bind_append, sublists_aux₁_bind l]
#align list.sublists_aux₁_bind [anonymous]

/- warning: list.sublists_aux_cons_append clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux_cons_append -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u}} (l₁ : List.{u} α) (l₂ : List.{u} α), Eq.{succ u} (List.{u} (List.{u} α)) (List.sublistsAux.{u, u} α (List.{u} α) (Append.append.{u} (List.{u} α) (List.hasAppend.{u} α) l₁ l₂) (List.cons.{u} (List.{u} α))) (Append.append.{u} (List.{u} (List.{u} α)) (List.hasAppend.{u} (List.{u} α)) (List.sublistsAux.{u, u} α (List.{u} α) l₁ (List.cons.{u} (List.{u} α))) (Bind.bind.{u, u} List.{u} (Monad.toHasBind.{u, u} List.{u} List.monad.{u}) (List.{u} α) (List.{u} α) (List.sublistsAux.{u, u} α (List.{u} α) l₂ (List.cons.{u} (List.{u} α))) (fun (x : List.{u} α) => Functor.map.{u, u} List.{u} (Traversable.toFunctor.{u} List.{u} List.traversable.{u}) (List.{u} α) (List.{u} α) (fun (_x : List.{u} α) => Append.append.{u} (List.{u} α) (List.hasAppend.{u} α) _x x) (List.sublists.{u} α l₁))))
but is expected to have type
  forall {α : Type.{u}} {l₁ : Type.{v}}, (Nat -> α -> l₁) -> Nat -> (List.{u} α) -> (List.{v} l₁)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux_cons_append [anonymous]ₓ'. -/
theorem [anonymous] (l₁ l₂ : List α) :
    sublistsAux (l₁ ++ l₂) cons =
      sublistsAux l₁ cons ++ do
        let x ← sublistsAux l₂ cons
        (· ++ x) <$> sublists l₁ :=
  by
  simp only [sublists, sublists_aux_cons_eq_sublists_aux₁, sublists_aux₁_append, bind_eq_bind,
    sublists_aux₁_bind]
  congr ; funext x; apply congr_arg _
  rw [← bind_ret_eq_map, sublists_aux₁_bind]; exact (append_nil _).symm
#align list.sublists_aux_cons_append [anonymous]

/- warning: list.sublists_append -> List.sublists_append is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (l₁ : List.{u1} α) (l₂ : List.{u1} α), Eq.{succ u1} (List.{u1} (List.{u1} α)) (List.sublists.{u1} α (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l₁ l₂)) (Bind.bind.{u1, u1} List.{u1} (Monad.toHasBind.{u1, u1} List.{u1} List.monad.{u1}) (List.{u1} α) (List.{u1} α) (List.sublists.{u1} α l₂) (fun (x : List.{u1} α) => Functor.map.{u1, u1} List.{u1} (Traversable.toFunctor.{u1} List.{u1} List.traversable.{u1}) (List.{u1} α) (List.{u1} α) (fun (_x : List.{u1} α) => Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) _x x) (List.sublists.{u1} α l₁)))
but is expected to have type
  forall {α : Type.{u1}} (l₁ : List.{u1} α) (l₂ : List.{u1} α), Eq.{succ u1} (List.{u1} (List.{u1} α)) (List.sublists.{u1} α (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) l₁ l₂)) (Bind.bind.{u1, u1} List.{u1} (Monad.toBind.{u1, u1} List.{u1} List.instMonadList.{u1}) (List.{u1} α) (List.{u1} α) (List.sublists.{u1} α l₂) (fun (x : List.{u1} α) => List.map.{u1, u1} (List.{u1} α) (List.{u1} α) (fun (_x : List.{u1} α) => HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _x x) (List.sublists.{u1} α l₁)))
Case conversion may be inaccurate. Consider using '#align list.sublists_append List.sublists_appendₓ'. -/
theorem sublists_append (l₁ l₂ : List α) :
    sublists (l₁ ++ l₂) = do
      let x ← sublists l₂
      (· ++ x) <$> sublists l₁ :=
  by
  simp only [map, sublists, sublists_aux_cons_append, map_eq_map, bind_eq_bind, cons_bind, map_id',
        append_nil, cons_append, map_id' fun _ => rfl] <;>
      constructor <;>
    rfl
#align list.sublists_append List.sublists_append

#print List.sublists_concat /-
@[simp]
theorem sublists_concat (l : List α) (a : α) :
    sublists (l ++ [a]) = sublists l ++ map (fun x => x ++ [a]) (sublists l) := by
  rw [sublists_append, sublists_singleton, bind_eq_bind, cons_bind, cons_bind, nil_bind, map_eq_map,
    map_eq_map, map_id' append_nil, append_nil]
#align list.sublists_concat List.sublists_concat
-/

#print List.sublists_reverse /-
theorem sublists_reverse (l : List α) : sublists (reverse l) = map reverse (sublists' l) := by
  induction' l with hd tl ih <;> [rfl,
    simp only [reverse_cons, sublists_append, sublists'_cons, map_append, ih, sublists_singleton,
      map_eq_map, bind_eq_bind, map_map, cons_bind, append_nil, nil_bind, (· ∘ ·)]]
#align list.sublists_reverse List.sublists_reverse
-/

#print List.sublists_eq_sublists' /-
theorem sublists_eq_sublists' (l : List α) : sublists l = map reverse (sublists' (reverse l)) := by
  rw [← sublists_reverse, reverse_reverse]
#align list.sublists_eq_sublists' List.sublists_eq_sublists'
-/

#print List.sublists'_reverse /-
theorem sublists'_reverse (l : List α) : sublists' (reverse l) = map reverse (sublists l) := by
  simp only [sublists_eq_sublists', map_map, map_id' reverse_reverse]
#align list.sublists'_reverse List.sublists'_reverse
-/

#print List.sublists'_eq_sublists /-
theorem sublists'_eq_sublists (l : List α) : sublists' l = map reverse (sublists (reverse l)) := by
  rw [← sublists'_reverse, reverse_reverse]
#align list.sublists'_eq_sublists List.sublists'_eq_sublists
-/

/- warning: list.sublists_aux_ne_nil clashes with [anonymous] -> [anonymous]
warning: list.sublists_aux_ne_nil -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u}} (l : List.{u} α), Not (Membership.Mem.{u, u} (List.{u} α) (List.{u} (List.{u} α)) (List.hasMem.{u} (List.{u} α)) (List.nil.{u} α) (List.sublistsAux.{u, u} α (List.{u} α) l (List.cons.{u} (List.{u} α))))
but is expected to have type
  forall {α : Type.{u}} {l : Type.{v}}, (Nat -> α -> l) -> Nat -> (List.{u} α) -> (List.{v} l)
Case conversion may be inaccurate. Consider using '#align list.sublists_aux_ne_nil [anonymous]ₓ'. -/
theorem [anonymous] : ∀ l : List α, [] ∉ sublistsAux l cons
  | [] => id
  | a :: l => by
    rw [sublists_aux_cons_cons]
    refine' not_mem_cons_of_ne_of_not_mem (cons_ne_nil _ _).symm _
    have := sublists_aux_ne_nil l; revert this
    induction sublists_aux l cons <;> intro ; · rwa [foldr]
    simp only [foldr, mem_cons_iff, false_or_iff, not_or]
    exact ⟨ne_of_not_mem_cons this, ih (not_mem_of_not_mem_cons this)⟩
#align list.sublists_aux_ne_nil [anonymous]

#print List.mem_sublists /-
@[simp]
theorem mem_sublists {s t : List α} : s ∈ sublists t ↔ s <+ t := by
  rw [← reverse_sublist_iff, ← mem_sublists', sublists'_reverse,
    mem_map_of_injective reverse_injective]
#align list.mem_sublists List.mem_sublists
-/

#print List.length_sublists /-
@[simp]
theorem length_sublists (l : List α) : length (sublists l) = 2 ^ length l := by
  simp only [sublists_eq_sublists', length_map, length_sublists', length_reverse]
#align list.length_sublists List.length_sublists
-/

#print List.map_ret_sublist_sublists /-
theorem map_ret_sublist_sublists (l : List α) : map List.ret l <+ sublists l :=
  reverseRecOn l (nil_sublist _) fun l a IH => by
    simp only [map, map_append, sublists_concat] <;>
      exact
        ((append_sublist_append_left _).2 <|
              singleton_sublist.2 <| mem_map.2 ⟨[], mem_sublists.2 (nil_sublist _), by rfl⟩).trans
          ((append_sublist_append_right _).2 IH)
#align list.map_ret_sublist_sublists List.map_ret_sublist_sublists
-/

/-! ### sublists_len -/

#print List.sublistsLenAux /-
/-- Auxiliary function to construct the list of all sublists of a given length. Given an
integer `n`, a list `l`, a function `f` and an auxiliary list `L`, it returns the list made of
of `f` applied to all sublists of `l` of length `n`, concatenated with `L`. -/
def sublistsLenAux {α β : Type _} : ℕ → List α → (List α → β) → List β → List β
  | 0, l, f, r => f [] :: r
  | n + 1, [], f, r => r
  | n + 1, a :: l, f, r => sublists_len_aux (n + 1) l f (sublists_len_aux n l (f ∘ List.cons a) r)
#align list.sublists_len_aux List.sublistsLenAux
-/

#print List.sublistsLen /-
/-- The list of all sublists of a list `l` that are of length `n`. For instance, for
`l = [0, 1, 2, 3]` and `n = 2`, one gets
`[[2, 3], [1, 3], [1, 2], [0, 3], [0, 2], [0, 1]]`. -/
def sublistsLen {α : Type _} (n : ℕ) (l : List α) : List (List α) :=
  sublistsLenAux n l id []
#align list.sublists_len List.sublistsLen
-/

/- warning: list.sublists_len_aux_append -> List.sublistsLenAux_append is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} (n : Nat) (l : List.{u1} α) (f : (List.{u1} α) -> β) (g : β -> γ) (r : List.{u2} β) (s : List.{u3} γ), Eq.{succ u3} (List.{u3} γ) (List.sublistsLenAux.{u1, u3} α γ n l (Function.comp.{succ u1, succ u2, succ u3} (List.{u1} α) β γ g f) (Append.append.{u3} (List.{u3} γ) (List.hasAppend.{u3} γ) (List.map.{u2, u3} β γ g r) s)) (Append.append.{u3} (List.{u3} γ) (List.hasAppend.{u3} γ) (List.map.{u2, u3} β γ g (List.sublistsLenAux.{u1, u2} α β n l f r)) s)
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} (n : Nat) (l : List.{u3} α) (f : (List.{u3} α) -> β) (g : β -> γ) (r : List.{u2} β) (s : List.{u1} γ), Eq.{succ u1} (List.{u1} γ) (List.sublistsLenAux.{u3, u1} α γ n l (Function.comp.{succ u3, succ u2, succ u1} (List.{u3} α) β γ g f) (HAppend.hAppend.{u1, u1, u1} (List.{u1} γ) (List.{u1} γ) (List.{u1} γ) (instHAppend.{u1} (List.{u1} γ) (List.instAppendList.{u1} γ)) (List.map.{u2, u1} β γ g r) s)) (HAppend.hAppend.{u1, u1, u1} (List.{u1} γ) (List.{u1} γ) (List.{u1} γ) (instHAppend.{u1} (List.{u1} γ) (List.instAppendList.{u1} γ)) (List.map.{u2, u1} β γ g (List.sublistsLenAux.{u3, u2} α β n l f r)) s)
Case conversion may be inaccurate. Consider using '#align list.sublists_len_aux_append List.sublistsLenAux_appendₓ'. -/
theorem sublistsLenAux_append {α β γ : Type _} :
    ∀ (n : ℕ) (l : List α) (f : List α → β) (g : β → γ) (r : List β) (s : List γ),
      sublistsLenAux n l (g ∘ f) (r.map g ++ s) = (sublistsLenAux n l f r).map g ++ s
  | 0, l, f, g, r, s => rfl
  | n + 1, [], f, g, r, s => rfl
  | n + 1, a :: l, f, g, r, s => by
    unfold sublists_len_aux
    rw [show (g ∘ f) ∘ List.cons a = g ∘ f ∘ List.cons a by rfl, sublists_len_aux_append,
      sublists_len_aux_append]
#align list.sublists_len_aux_append List.sublistsLenAux_append

/- warning: list.sublists_len_aux_eq -> List.sublistsLenAux_eq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (l : List.{u1} α) (n : Nat) (f : (List.{u1} α) -> β) (r : List.{u2} β), Eq.{succ u2} (List.{u2} β) (List.sublistsLenAux.{u1, u2} α β n l f r) (Append.append.{u2} (List.{u2} β) (List.hasAppend.{u2} β) (List.map.{u1, u2} (List.{u1} α) β f (List.sublistsLen.{u1} α n l)) r)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (l : List.{u2} α) (n : Nat) (f : (List.{u2} α) -> β) (r : List.{u1} β), Eq.{succ u1} (List.{u1} β) (List.sublistsLenAux.{u2, u1} α β n l f r) (HAppend.hAppend.{u1, u1, u1} (List.{u1} β) (List.{u1} β) (List.{u1} β) (instHAppend.{u1} (List.{u1} β) (List.instAppendList.{u1} β)) (List.map.{u2, u1} (List.{u2} α) β f (List.sublistsLen.{u2} α n l)) r)
Case conversion may be inaccurate. Consider using '#align list.sublists_len_aux_eq List.sublistsLenAux_eqₓ'. -/
theorem sublistsLenAux_eq {α β : Type _} (l : List α) (n) (f : List α → β) (r) :
    sublistsLenAux n l f r = (sublistsLen n l).map f ++ r := by
  rw [sublists_len, ← sublists_len_aux_append] <;> rfl
#align list.sublists_len_aux_eq List.sublistsLenAux_eq

/- warning: list.sublists_len_aux_zero -> List.sublistsLenAux_zero is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} {α : Type.{u2}} (l : List.{u2} α) (f : (List.{u2} α) -> β) (r : List.{u1} β), Eq.{succ u1} (List.{u1} β) (List.sublistsLenAux.{u2, u1} α β (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) l f r) (List.cons.{u1} β (f (List.nil.{u2} α)) r)
but is expected to have type
  forall {β : Type.{u2}} {α : Type.{u1}} (l : List.{u1} α) (f : (List.{u1} α) -> β) (r : List.{u2} β), Eq.{succ u2} (List.{u2} β) (List.sublistsLenAux.{u1, u2} α β (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) l f r) (List.cons.{u2} β (f (List.nil.{u1} α)) r)
Case conversion may be inaccurate. Consider using '#align list.sublists_len_aux_zero List.sublistsLenAux_zeroₓ'. -/
theorem sublistsLenAux_zero {α : Type _} (l : List α) (f : List α → β) (r) :
    sublistsLenAux 0 l f r = f [] :: r := by cases l <;> rfl
#align list.sublists_len_aux_zero List.sublistsLenAux_zero

#print List.sublistsLen_zero /-
@[simp]
theorem sublistsLen_zero {α : Type _} (l : List α) : sublistsLen 0 l = [[]] :=
  sublistsLenAux_zero _ _ _
#align list.sublists_len_zero List.sublistsLen_zero
-/

#print List.sublistsLen_succ_nil /-
@[simp]
theorem sublistsLen_succ_nil {α : Type _} (n) : sublistsLen (n + 1) (@nil α) = [] :=
  rfl
#align list.sublists_len_succ_nil List.sublistsLen_succ_nil
-/

#print List.sublistsLen_succ_cons /-
@[simp]
theorem sublistsLen_succ_cons {α : Type _} (n) (a : α) (l) :
    sublistsLen (n + 1) (a :: l) = sublistsLen (n + 1) l ++ (sublistsLen n l).map (cons a) := by
  rw [sublists_len, sublists_len_aux, sublists_len_aux_eq, sublists_len_aux_eq, map_id,
      append_nil] <;>
    rfl
#align list.sublists_len_succ_cons List.sublistsLen_succ_cons
-/

#print List.length_sublistsLen /-
@[simp]
theorem length_sublistsLen {α : Type _} :
    ∀ (n) (l : List α), length (sublistsLen n l) = Nat.choose (length l) n
  | 0, l => by simp
  | n + 1, [] => by simp
  | n + 1, a :: l => by simp [-add_comm, Nat.choose, *] <;> apply add_comm
#align list.length_sublists_len List.length_sublistsLen
-/

#print List.sublistsLen_sublist_sublists' /-
theorem sublistsLen_sublist_sublists' {α : Type _} :
    ∀ (n) (l : List α), sublistsLen n l <+ sublists' l
  | 0, l => singleton_sublist.2 (mem_sublists'.2 (nil_sublist _))
  | n + 1, [] => nil_sublist _
  | n + 1, a :: l => by
    rw [sublists_len_succ_cons, sublists'_cons]
    exact (sublists_len_sublist_sublists' _ _).append ((sublists_len_sublist_sublists' _ _).map _)
#align list.sublists_len_sublist_sublists' List.sublistsLen_sublist_sublists'
-/

#print List.sublistsLen_sublist_of_sublist /-
theorem sublistsLen_sublist_of_sublist {α : Type _} (n) {l₁ l₂ : List α} (h : l₁ <+ l₂) :
    sublistsLen n l₁ <+ sublistsLen n l₂ :=
  by
  induction' n with n IHn generalizing l₁ l₂; · simp
  induction' h with l₁ l₂ a s IH l₁ l₂ a s IH; · rfl
  · refine' IH.trans _
    rw [sublists_len_succ_cons]
    apply sublist_append_left
  · simp [sublists_len_succ_cons]
    exact IH.append ((IHn s).map _)
#align list.sublists_len_sublist_of_sublist List.sublistsLen_sublist_of_sublist
-/

#print List.length_of_sublistsLen /-
theorem length_of_sublistsLen {α : Type _} :
    ∀ {n} {l l' : List α}, l' ∈ sublistsLen n l → length l' = n
  | 0, l, l', Or.inl rfl => rfl
  | n + 1, a :: l, l', h =>
    by
    rw [sublists_len_succ_cons, mem_append, mem_map] at h
    rcases h with (h | ⟨l', h, rfl⟩)
    · exact length_of_sublists_len h
    · exact congr_arg (· + 1) (length_of_sublists_len h)
#align list.length_of_sublists_len List.length_of_sublistsLen
-/

#print List.mem_sublistsLen_self /-
theorem mem_sublistsLen_self {α : Type _} {l l' : List α} (h : l' <+ l) :
    l' ∈ sublistsLen (length l') l :=
  by
  induction' h with l₁ l₂ a s IH l₁ l₂ a s IH
  · exact Or.inl rfl
  · cases' l₁ with b l₁
    · exact Or.inl rfl
    · rw [length, sublists_len_succ_cons]
      exact mem_append_left _ IH
  · rw [length, sublists_len_succ_cons]
    exact mem_append_right _ (mem_map.2 ⟨_, IH, rfl⟩)
#align list.mem_sublists_len_self List.mem_sublistsLen_self
-/

#print List.mem_sublistsLen /-
@[simp]
theorem mem_sublistsLen {α : Type _} {n} {l l' : List α} :
    l' ∈ sublistsLen n l ↔ l' <+ l ∧ length l' = n :=
  ⟨fun h =>
    ⟨mem_sublists'.1 ((sublistsLen_sublist_sublists' _ _).Subset h), length_of_sublistsLen h⟩,
    fun ⟨h₁, h₂⟩ => h₂ ▸ mem_sublistsLen_self h₁⟩
#align list.mem_sublists_len List.mem_sublistsLen
-/

#print List.sublistsLen_of_length_lt /-
theorem sublistsLen_of_length_lt {n} {l : List α} (h : l.length < n) : sublistsLen n l = [] :=
  eq_nil_iff_forall_not_mem.mpr fun x =>
    mem_sublistsLen.Not.mpr fun ⟨hs, hl⟩ => (h.trans_eq hl.symm).not_le (Sublist.length_le hs)
#align list.sublists_len_of_length_lt List.sublistsLen_of_length_lt
-/

#print List.sublistsLen_length /-
@[simp]
theorem sublistsLen_length : ∀ l : List α, sublistsLen l.length l = [l]
  | [] => rfl
  | a :: l => by
    rw [length, sublists_len_succ_cons, sublists_len_length, map_singleton,
      sublists_len_of_length_lt (lt_succ_self _), nil_append]
#align list.sublists_len_length List.sublistsLen_length
-/

open Function

#print List.Pairwise.sublists' /-
theorem Pairwise.sublists' {R} :
    ∀ {l : List α}, Pairwise R l → Pairwise (Lex (swap R)) (sublists' l)
  | _, pairwise.nil => pairwise_singleton _ _
  | _, @pairwise.cons _ _ a l H₁ H₂ =>
    by
    simp only [sublists'_cons, pairwise_append, pairwise_map, mem_sublists', mem_map, exists_imp,
      and_imp]
    refine' ⟨H₂.sublists', H₂.sublists'.imp fun l₁ l₂ => lex.cons, _⟩
    rintro l₁ sl₁ x l₂ sl₂ rfl
    cases' l₁ with b l₁; · constructor
    exact lex.rel (H₁ _ <| sl₁.subset <| mem_cons_self _ _)
#align list.pairwise.sublists' List.Pairwise.sublists'
-/

#print List.pairwise_sublists /-
theorem pairwise_sublists {R} {l : List α} (H : Pairwise R l) :
    Pairwise (fun l₁ l₂ => Lex R (reverse l₁) (reverse l₂)) (sublists l) :=
  by
  have := (pairwise_reverse.2 H).sublists'
  rwa [sublists'_reverse, pairwise_map] at this
#align list.pairwise_sublists List.pairwise_sublists
-/

#print List.nodup_sublists /-
@[simp]
theorem nodup_sublists {l : List α} : Nodup (sublists l) ↔ Nodup l :=
  ⟨fun h => (h.Sublist (map_ret_sublist_sublists _)).of_map _, fun h =>
    (pairwise_sublists h).imp fun _ _ h => mt reverse_inj.2 h.to_ne⟩
#align list.nodup_sublists List.nodup_sublists
-/

#print List.nodup_sublists' /-
@[simp]
theorem nodup_sublists' {l : List α} : Nodup (sublists' l) ↔ Nodup l := by
  rw [sublists'_eq_sublists, nodup_map_iff reverse_injective, nodup_sublists, nodup_reverse]
#align list.nodup_sublists' List.nodup_sublists'
-/

alias nodup_sublists ↔ nodup.of_sublists nodup.sublists
#align list.nodup.of_sublists List.nodup.of_sublists
#align list.nodup.sublists List.nodup.sublists

alias nodup_sublists' ↔ nodup.of_sublists' nodup.sublists'
#align list.nodup.of_sublists' List.nodup.of_sublists'
#align list.nodup.sublists' List.nodup.sublists'

attribute [protected] nodup.sublists nodup.sublists'

#print List.nodup_sublistsLen /-
theorem nodup_sublistsLen (n : ℕ) {l : List α} (h : Nodup l) : (sublistsLen n l).Nodup :=
  h.sublists'.Sublist <| sublistsLen_sublist_sublists' _ _
#align list.nodup_sublists_len List.nodup_sublistsLen
-/

#print List.sublists_cons_perm_append /-
theorem sublists_cons_perm_append (a : α) (l : List α) :
    sublists (a :: l) ~ sublists l ++ map (cons a) (sublists l) :=
  by
  simp only [sublists, sublists_aux_cons_cons, cons_append, perm_cons]
  refine' (perm.cons _ _).trans perm_middle.symm
  induction' sublists_aux l cons with b l IH <;> simp
  exact (IH.cons _).trans perm_middle.symm
#align list.sublists_cons_perm_append List.sublists_cons_perm_append
-/

#print List.sublists_perm_sublists' /-
theorem sublists_perm_sublists' : ∀ l : List α, sublists l ~ sublists' l
  | [] => Perm.refl _
  | a :: l => by
    let IH := sublists_perm_sublists' l
    rw [sublists'_cons] <;> exact (sublists_cons_perm_append _ _).trans (IH.append (IH.map _))
#align list.sublists_perm_sublists' List.sublists_perm_sublists'
-/

#print List.revzip_sublists /-
theorem revzip_sublists (l : List α) : ∀ l₁ l₂, (l₁, l₂) ∈ revzip l.sublists → l₁ ++ l₂ ~ l :=
  by
  rw [revzip]
  apply List.reverseRecOn l
  · intro l₁ l₂ h
    simp at h
    simp [h]
  · intro l a IH l₁ l₂ h
    rw [sublists_concat, reverse_append, zip_append, ← map_reverse, zip_map_right, zip_map_left] at
        h <;>
      [skip, · simp]
    simp only [Prod.mk.inj_iff, mem_map, mem_append, Prod.map_mk, Prod.exists] at h
    rcases h with (⟨l₁, l₂', h, rfl, rfl⟩ | ⟨l₁', l₂, h, rfl, rfl⟩)
    · rw [← append_assoc]
      exact (IH _ _ h).append_right _
    · rw [append_assoc]
      apply (perm_append_comm.append_left _).trans
      rw [← append_assoc]
      exact (IH _ _ h).append_right _
#align list.revzip_sublists List.revzip_sublists
-/

#print List.revzip_sublists' /-
theorem revzip_sublists' (l : List α) : ∀ l₁ l₂, (l₁, l₂) ∈ revzip l.sublists' → l₁ ++ l₂ ~ l :=
  by
  rw [revzip]
  induction' l with a l IH <;> intro l₁ l₂ h
  · simp at h
    simp [h]
  · rw [sublists'_cons, reverse_append, zip_append, ← map_reverse, zip_map_right, zip_map_left] at
        h <;> [simp at h, simp]
    rcases h with (⟨l₁, l₂', h, rfl, rfl⟩ | ⟨l₁', h, rfl⟩)
    · exact perm_middle.trans ((IH _ _ h).cons _)
    · exact (IH _ _ h).cons _
#align list.revzip_sublists' List.revzip_sublists'
-/

#print List.range_bind_sublistsLen_perm /-
theorem range_bind_sublistsLen_perm {α : Type _} (l : List α) :
    ((List.range (l.length + 1)).bind fun n => sublistsLen n l) ~ sublists' l :=
  by
  induction' l with h tl
  · simp [range_succ]
  · simp_rw [range_succ_eq_map, length, cons_bind, map_bind, sublists_len_succ_cons, sublists'_cons,
      List.sublistsLen_zero, List.singleton_append]
    refine' ((bind_append_perm (range (tl.length + 1)) _ _).symm.cons _).trans _
    simp_rw [← List.bind_map, ← cons_append]
    rw [← List.singleton_append, ← List.sublistsLen_zero tl]
    refine' perm.append _ (l_ih.map _)
    rw [List.range_succ, append_bind, bind_singleton,
      sublists_len_of_length_lt (Nat.lt_succ_self _), append_nil, ←
      List.map_bind (fun n => sublists_len n tl) Nat.succ, ←
      cons_bind 0 _ fun n => sublists_len n tl, ← range_succ_eq_map]
    exact l_ih
#align list.range_bind_sublists_len_perm List.range_bind_sublistsLen_perm
-/

end List


/-
Copyright (c) 2019 The Flypitch Project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Jesse Han, Floris van Doorn
-/
import .bfol .forcing .forcing_CH

open lattice

open bSet

open fol
local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`:0) := l

local infixr ` ⟹' `:65 := lattice.imp
local prefix `∃'` := bd_ex
local prefix `∼` := bd_not
local infixr ` ⊓' `:70 := bd_and
local infixr ` ⊔' `:70 := bd_or

local infix ` ⟹'' `:62 := bd_imp

local infix ` ⇔' `:50 := lattice.biimp

-- local infix ` ⇔ `:61 := bd_biimp

universe u

section ZFC
inductive ZFC_rel : ℕ → Type 1
| ε : ZFC_rel 2

inductive ZFC_func : ℕ → Type 1
| emptyset : ZFC_func 0
| pr : ZFC_func 2
| ω : ZFC_func 0
| P : ZFC_func 1
| Union : ZFC_func 1

def L_ZFC : Language.{1} :=
{ functions := ZFC_func,
  relations := ZFC_rel }

end ZFC

section ZFC
variables {β : Type 0} [nontrivial_complete_boolean_algebra β]

def bSet_model_fun_map : Π {n : ℕ}, L_ZFC.functions n → dvector (bSet β) n → bSet β :=
begin
  intros n S, induction S,
  from λ _, bSet.empty,
  from λ x, by {cases x, refine bSet.pair x_x _, cases x_xs, from x_xs_x},
  from λ _, bSet.omega,
  from λ x, by {cases x, exact bv_powerset x_x},
  from λ x, by {cases x, from bv_union ‹_›}
end

def bSet_model_rel_map : Π {n : ℕ}, L_ZFC.relations n → dvector (bSet β) n → β :=
begin
  intros n R, induction R,
  intro x, cases x, cases x_xs,
  from x_x ∈ᴮ x_xs_x
end

variable (β)
def V : bStructure L_ZFC (β) :=
{ carrier := (bSet β),
  fun_map := by apply bSet_model_fun_map,
  rel_map := by apply bSet_model_rel_map,
  eq := bv_eq,
  eq_refl := bv_eq_refl,
  eq_symm := by apply bv_eq_symm,
  eq_trans := by apply bv_eq_trans,
  fun_congr :=
  begin
    intros n F, cases F,
      {intros x y, cases x, cases y, simp},
      tactic.rotate 1,
      {intros x y, cases x, cases y, simp},
      {intros x y, cases x, cases y, cases x_xs, cases y_xs,
        change (_ ⊓ _ : β) ≤ (bv_powerset _) =ᴮ (bv_powerset _), simp,
        tidy_context, apply bv_powerset_congr ‹_› },
      {intros x y, cases x, cases y, cases x_xs, cases y_xs,
        change (_ ⊓ _ : β) ≤ (bv_union _) =ᴮ (bv_union _), simp,
        tidy_context, from bv_union_congr ‹_›},
      {intros x y, cases x, cases y, cases x_xs, cases y_xs,
        change (_ ⊓ (_ ⊓ _) : β) ≤ pair x_x x_xs_x =ᴮ pair y_x y_xs_x,
        cases x_xs_xs, cases y_xs_xs, simp }
  end,
  rel_congr :=
  begin
    intros n R, cases R, intros x y,
    cases x, cases y, cases x_xs, cases y_xs,
    cases x_xs_xs, cases y_xs_xs,
    change ((_ ⊓ _) ⊓ (_ ∈ᴮ _) : β) ≤ (_ ∈ᴮ _), simp,
    tidy_context, apply mem_congr; from ‹_›
  end}

@[simp] lemma carrier_V : ↥(V β) = bSet β := rfl

@[simp]lemma V_forall {C : (V β) → β} : (⨅(x : V β), C x) = (⨅(x : bSet β), C x) := rfl

@[simp]lemma V_exists {C : (V β) → β} : (⨆(x : V β), C x) = (⨆(x : bSet β), C x) := rfl

@[simp]lemma V_eq {a b} : (V β).eq a b = a =ᴮ b := rfl

@[instance]lemma V_β_nonempty : nonempty (V β) := ⟨bSet.empty⟩

lemma alpha_equiv₁ {C : (bSet β) → β} : (⨅(x : bSet β), C x) = ⨅(y : bSet β), C y := rfl
lemma alpha_equiv₂ {C : (bSet β) → β} : (⨆(x : bSet β), C x) = ⨆(y : bSet β), C y := rfl

def emptyset {n} : bounded_term L_ZFC n := bd_const ZFC_func.emptyset

notation `∅'` := emptyset

def omega {n} : bounded_term L_ZFC n := bd_const ZFC_func.ω

notation `ω'` := omega

def Powerset {n} : bounded_term L_ZFC n → bounded_term L_ZFC n := bd_app (bd_func ZFC_func.P)

notation `P'` := Powerset

def mem {n} (t₁ t₂ : bounded_term L_ZFC n) : bounded_formula L_ZFC n :=
@bounded_formula_of_relation L_ZFC 2 n ZFC_rel.ε t₁ t₂

local infix ` ∈'`:100 := _root_.mem

def pair' {n} (t₁ t₂ : bounded_term L_ZFC n) : bounded_term L_ZFC n :=
@bounded_term_of_function L_ZFC 2 n ZFC_func.pr t₁ t₂

def union' {n} : bounded_term L_ZFC n → bounded_term L_ZFC n := bd_app (bd_func ZFC_func.Union)

notation `⋃'` := union'

local prefix `&'`:max := bd_var

@[simp] lemma boolean_realize_bounded_formula_mem {n} {v : dvector (V β) n}
  (t₁ t₂ : bounded_term L_ZFC n) :
  boolean_realize_bounded_formula v (t₁ ∈' t₂) ([]) =
  boolean_realize_bounded_term v t₁ ([]) ∈ᴮ boolean_realize_bounded_term v t₂ ([]) :=
by refl

@[simp] lemma boolean_realize_bounded_term_Union {n} {v : dvector (V β) n}
  (t : bounded_term L_ZFC n) :
  boolean_realize_bounded_term v (⋃' t) ([]) =
  bv_union (boolean_realize_bounded_term v t ([])) :=
by refl

@[simp] lemma boolean_realize_bounded_term_Powerset {n} {v : dvector (V β) n}
  (t : bounded_term L_ZFC n) :
  boolean_realize_bounded_term v (P' t) ([]) =
  bv_powerset (boolean_realize_bounded_term v t ([])) :=
by refl

@[simp] lemma boolean_realize_bounded_term_omega {n} {v : dvector (V β) n} :
  boolean_realize_bounded_term v ω' ([]) = bSet.omega :=
by refl

@[simp] lemma boolean_realize_bounded_term_emptyset {n} {v : dvector (V β) n} :
  boolean_realize_bounded_term v ∅' ([]) = bSet.empty :=
by refl

@[simp]lemma boolean_realize_bounded_term_pair {n} {v : dvector (V β) n}
  (t₁ t₂ : bounded_term L_ZFC n) :  boolean_realize_bounded_term v (pair' t₁ t₂) ([]) =
  pair (boolean_realize_bounded_term v t₁ ([])) (boolean_realize_bounded_term v t₂ ([])) :=
by refl

@[simp] lemma fin_0 {n : ℕ} : (0 : fin (n+1)).1 = 0 := by refl
@[simp] lemma fin_1 {n : ℕ} : (1 : fin (n+2)).1 = 1 := by refl
@[simp] lemma fin_2 {n : ℕ} : (2 : fin (n+3)).1 = 2 := by refl
@[simp] lemma fin_3 {n : ℕ} : (3 : fin (n+4)).1 = 3 := by refl

-- axiom of emptyset
-- ∀ x, x ∉ ∅
def axiom_of_emptyset : sentence L_ZFC := ∀' (∼(&0 ∈' ∅'))

lemma bSet_models_emptyset : ⊤ ⊩[V β] axiom_of_emptyset :=
by {change ⊤ ≤ _, simp[axiom_of_emptyset, -top_le_iff], intro x, from empty_spec}

-- axiom of ordered pairs
-- ∀ x y z w, (x, y) = (z, w) ↔ x = z ∧ y = w
def axiom_of_ordered_pairs : sentence L_ZFC :=
 ∀' ∀' ∀' ∀'(((pair' &'3 &'2 ≃ pair' &'1 &'0)) ⇔ (&'3 ≃ &'1 ⊓ &'2 ≃ &'0))

lemma bSet_models_ordered_pairs : ⊤ ⊩[V β] axiom_of_ordered_pairs :=
begin
  change ⊤ ≤ _, simp[axiom_of_ordered_pairs], intros a b x y, tidy,
  from eq_of_eq_pair_left, from eq_of_eq_pair_right
end

-- axiom of extensionality
-- ∀ x y, (∀ z, (z ∈ x ↔ z ∈ y)) → x = y
def axiom_of_extensionality : sentence L_ZFC :=
∀' ∀' (∀'(&'0  ∈' &'2 ⇔  &'0 ∈' &'1) ⟹ (&1 ≃ &0))

lemma bSet_models_extensionality : ⊤ ⊩[V β] axiom_of_extensionality :=
by { simp [forced_in, axiom_of_extensionality], exact bSet_axiom_of_extensionality }

-- axiom schema of "strong" collection
-- For every formula `ϕ(x,y,p)` with (at most) `n+2` free variables (`p` is a vector of length `n`),
-- ∀ p ∀ A, (∀ x ∈ A, ∃ y, ϕ(x,y,p)) →
--  (∃ B, (∀ x ∈ A, ∃ y ∈ B, ϕ(x,y,p)) ∧ ∀ y ∈ B, ∃ x ∈ A, ϕ(x,y,p))
def axiom_of_collection {n} (ϕ : bounded_formula L_ZFC (n+2)) : sentence L_ZFC :=
bd_alls (n+1) $ (∀' (&'0 ∈' &'1 ⟹ ∃' (ϕ ↑' 1 # 2))) ⟹
(∃' (∀'(&'0 ∈' &'2 ⟹ ∃' (&'0 ∈' &'2 ⊓ (ϕ ↑' 2 # 2))) ⊓
     ∀'(&'0 ∈' &'1 ⟹ ∃' (&'0 ∈' &'3 ⊓' ((ϕ ↑' 3 # 2)[&'1/0] : _)))))

lemma lift2_helper {L n l} (f : bounded_preformula L n l) {k} (m : ℕ) :
  f ↑' (k+2) # m = ((f ↑' (k+1) # m) ↑' 1 # m : _) :=
by { ext, simp only [lift_bounded_formula_fst], rw [lift_formula_at2_medium], refl, linarith }

lemma B_ext_left_realize_bounded_formula {n : ℕ} (ϕ : bounded_formula L_ZFC (n + 1)) (xs : dvector (V β) n) : ∀ (x y : V β), x =ᴮ y ⊓ (boolean_realize_bounded_formula (x::xs) ϕ dvector.nil) ≤ boolean_realize_bounded_formula (y::xs) ϕ dvector.nil :=
begin
  intros x y,
  suffices : (x =ᴮ y = ⨅ (m : fin (n+1)), (V β).eq ((x::xs).nth _ m.is_lt) ((y::xs).nth _ m.is_lt)),
    by {rw this, apply boolean_realize_bounded_formula_congr, apply_instance},
  refine le_antisymm _ _,
    { apply le_infi, rintro ⟨m,Hm⟩,
      cases m,
        { refl },
        { rw [dvector.nth_cons, dvector.nth_cons],
          {exact bSet.bv_refl, { exact nat.lt_of_succ_lt_succ Hm }},
      }},
    { tidy_context, exact a ⟨0, dec_trivial⟩ }
end

lemma B_ext_right_realize_bounded_formula {n : ℕ} (ϕ : bounded_formula L_ZFC (n + 2)) (xs : dvector (V β) n) : ∀ (x y z : V β), x =ᴮ y ⊓ (boolean_realize_bounded_formula (z::x::xs) ϕ dvector.nil) ≤ boolean_realize_bounded_formula (z::y::xs) ϕ dvector.nil :=
begin
  intros x y z,
  suffices : (x =ᴮ y = ⨅ (m : fin (n+2)), (V β).eq ((z::x::xs).nth _ m.is_lt) ((z::y::xs).nth _ m.is_lt)),
    by {rw this, apply boolean_realize_bounded_formula_congr, apply_instance},
  refine le_antisymm _ _,
    { apply le_infi, rintro ⟨m,Hm⟩,
      cases m,
        { exact bSet.bv_refl },
        { cases m,
          { refl },
          { repeat {rw dvector.nth_cons},
            { exact bSet.bv_refl, apply nat.lt_of_succ_lt_succ,
              apply nat.lt_of_succ_lt_succ, from ‹_› }} }},
    { tidy_context, exact a ⟨1, dec_trivial⟩ }
end

lemma bSet_models_collection {n} (ϕ : bounded_formula L_ZFC (n+2)) : ⊤ ⊩[V β] axiom_of_collection ϕ :=
begin
  change ⊤ ≤ _, simp only [axiom_of_collection, boolean_realize_sentence_bd_alls],
  bv_intro xs, cases xs with _ u xs,
  simp only
    [ boolean_realize_bounded_formula_and,
      boolean_realize_bounded_term, imp_top_iff_le,
      boolean_realize_bounded_formula_ex, top_le_iff,
      boolean_realize_bounded_formula, boolean_realize_formula_insert_lift2,
      lift2_helper, boolean_realize_subst_formula0, fin_2 ],
  have := bSet_axiom_of_collection
            (λ a b : V β, boolean_realize_bounded_formula (b :: a :: xs) ϕ ([])) _ _ u,
  simp only [lattice.top_le_iff, bSet.mem, lattice.imp_top_iff_le, lattice.le_infi_iff] at this,
  exact this,
  { intros, apply B_ext_left_realize_bounded_formula },
  { intros, apply B_ext_right_realize_bounded_formula },
end

-- axiom of union
-- ∀ u x, x ∈ ⋃ u ↔ ∃ y ∈ u, x ∈ y
def axiom_of_union : sentence L_ZFC :=
∀' ∀' (&'0 ∈' ⋃' &'1 ⇔ (∃' (&'0 ∈' &'2 ⊓ &'1 ∈' &'0)))

lemma bSet_models_union : ⊤ ⊩[V β] axiom_of_union :=
begin
  simp [-top_le_iff, forced_in, axiom_of_union, -lattice.le_inf_iff],
  intros x z,
  have := @bv_union_spec' _ _ x ⊤,
  replace this := this z, dsimp at this,
  bv_split, bv_split_goal
end

-- axiom of powerset
-- ∀ z y, y ∈ P(z) ↔ ∀ x ∈ y, x ∈ z

def axiom_of_powerset : sentence L_ZFC :=
  ∀' ∀' (&'0 ∈' P' &'1 ⇔ (∀' (&'0 ∈' &'1 ⟹ &'0 ∈' &'2)))

lemma bSet_models_powerset : ⊤ ⊩[V β] axiom_of_powerset :=
begin
  simp [forced_in, axiom_of_powerset, -lattice.le_inf_iff, -top_le_iff],
  intros x z, have := @bv_powerset_spec _ _ x z,
  rw [subset_unfold'] at this,
  apply le_inf, bv_imp_intro, exact this.mpr H, bv_imp_intro, exact this.mp H
end

/-- &1 ⊆ &0 ↔ ∀ z, (z ∈ &1 → z ∈ &0)-/
def subset'' {n} (t₁ t₂ : bounded_term L_ZFC n): bounded_formula L_ZFC n :=
∀' (&'0 ∈' (t₁ ↑ 1) ⟹ &'0 ∈' (t₂ ↑ 1))

local infix ` ⊆'`:100 := subset''

@[simp] lemma boolean_realize_bounded_formula_subset {n} {v : dvector (V β) n}
  (t₁ t₂ : bounded_term L_ZFC n) :
  boolean_realize_bounded_formula v (t₁ ⊆' t₂) ([]) =
  boolean_realize_bounded_term v t₁ ([]) ⊆ᴮ boolean_realize_bounded_term v t₂ ([]) :=
by { simp [subset'', subset_unfold'] }

/- `z` is transitive if `∀ x, x ∈ z → x ⊆ z` -/
def is_transitive_f : bounded_formula L_ZFC 1 := ∀' ((&'0 ∈' &'1) ⟹ &'0 ⊆' &'1)

/- `z` is `∈`-trichotomous if `∀ x y ∈ z, x = y ∨ x ∈ y ∨ y ∈ x` -/
def epsilon_trichotomy_f : bounded_formula L_ZFC 1 :=
∀' ((&'0 ∈' &'1) ⟹''(∀' (&'0 ∈' &'2 ⟹'' (&'1 ≃ &'0 ⊔' &'1 ∈' &'0) ⊔' &'0 ∈' &'1)))

/- `z` is `∈`-well-founded if `∀ x, x ⊆ z → x ≠ ∅ → ∃ y ∈ x, ∀ w ∈ x, w ∉ y`.
  Note: this is true for every set by regularity, so we don't have to assume this. But we do it for
  completeness, to explicitly state that the order relation is well-founded. -/
def epsilon_well_founded_f : bounded_formula L_ZFC 1 :=
∀' (((&'0 ⊆' &'1) ⟹'' ((∼(&'0 ≃ ∅')) ⟹'' ∃' (&'0 ∈' &'1 ⊓' (∀' (&'0 ∈' &'2 ⟹'' ∼(&'0 ∈' &'1)))))))

/- `z` is `∈`-well-order if it is `∈`-well-founded and `∈`-trichotomous. -/
def ewo_f : bounded_formula L_ZFC 1 := epsilon_trichotomy_f ⊓' epsilon_well_founded_f

/- `z` is an ordinal if forms is an `∈`-well-order and `∈` is transitive on `z`. -/
def Ord_f : bounded_formula L_ZFC 1 := ewo_f ⊓' is_transitive_f

@[simp]lemma Ord_f_is_Ord {x : V β} : boolean_realize_bounded_formula (by exact [x]) Ord_f dvector.nil = Ord x :=
by {simp [Ord_f,ewo_f,is_transitive_f,epsilon_well_founded_f, epsilon_trichotomy_f], refl}

-- axiom of infinity
-- ∅ ∈ ω ∧ (∀ x ∈ ω, ∃ y ∈ ω, x ∈ y) ∧ (∃ α, Ord(α) ∧ ω = α) ∧
--   ∀ α, Ord(α) → (∅ ∈ α ∧ ∀ x ∈ α, ∃ y ∈ α, x ∈ y) → ω ⊆ α
-- this is the usual axiom of infinity, plus a characterization of omega as the least limit ordinal
def axiom_of_infinity : sentence L_ZFC :=
  (∅' ∈' ω' ⊓' ∀'(&'0 ∈' ω' ⟹ ∃' (&'0 ∈' ω' ⊓' &'1 ∈' &'0)))
  ⊓' (∃' (Ord_f ⊓' ω' ≃ &'0))
  ⊓' ∀' (Ord_f ⟹ ((∅' ∈' &'0 ⊓' ∀'(&'0 ∈' &'1 ⟹ ∃' (&'0 ∈' &'2 ⊓' &'1 ∈' &'0))) ⟹ ω' ⊆' &0))

lemma bSet_models_infinity : ⊤ ⊩[V β] axiom_of_infinity :=
begin
  simp [forced_in, axiom_of_infinity, boolean_realize_sentence,
    -lattice.le_inf_iff, -top_le_iff],
  refine le_inf _ _,
    { exact bSet_axiom_of_infinity' },
    { refine le_inf _ _,
      { apply bv_use bSet.omega, exact le_inf Ord_omega bv_refl },
      { exact omega_least_is_limit } }
end

-- axiom of regularity
-- ∀ x, x ≠ ∅ → ∃ y ∈ x, ∀ z ∈ x, z ∉ y

def axiom_of_regularity : sentence L_ZFC :=
  ∀' (∼(&0 ≃ ∅') ⟹ (∃' (&'0 ∈' &'1 ⊓ ∀' (&'0 ∈' &'2 ⟹ ∼(&'0 ∈' &'1)))))

lemma bSet_models_regularity : ⊤ ⊩[V β] axiom_of_regularity :=
begin
  change ⊤ ≤ _, unfold axiom_of_regularity,
  simp[-top_le_iff], intro x,
  bv_imp_intro,
  apply bSet_axiom_of_regularity, convert H
end

-- Zorn's lemma (as an axiom)
-- ∀ z, z ≠ ∅ → (∀ y, (y ⊆ z ∧ ∀ x₁ x₂ ∈ y, x₁ ⊆ x₂ ∨ x₂ ⊆ x₁) → (⋃y) ∈ z) →
--  ∃ m ∈ x, ∀ x ∈ z, m ⊆ x → m = x
def zorns_lemma : sentence L_ZFC :=
∀' (∼ (&'0 ≃ ∅')
  ⟹ (∀' (&'0 ⊆' &'1 ⊓' (∀' ∀' ((&'1 ∈' &'2 ⊓' &'0 ∈' &'2) ⟹ (&'1 ⊆' &'0 ⊔' &'0 ⊆' &'1)))
    ⟹ (⋃' &' 0 ∈' &'1)))
    ⟹  (∃' (&'0 ∈' &'1 ⊓ ∀' (&'0 ∈' &'2 ⟹ &'1 ⊆' &'0 ⟹ &'1 ≃ &'0 ))))

lemma bSet_models_Zorn : ⊤ ⊩[V β] zorns_lemma :=
begin
  simp [forced_in, zorns_lemma, boolean_realize_sentence, -lattice.le_inf_iff, -top_le_iff, -lattice.le_infi_iff],
  from bSet_zorns_lemma'
end

def ZFC : Theory L_ZFC :=
  {axiom_of_emptyset, axiom_of_ordered_pairs, axiom_of_extensionality, axiom_of_union,
   axiom_of_powerset, axiom_of_infinity, axiom_of_regularity, zorns_lemma} ∪
  set.Union (λ(n : ℕ), axiom_of_collection '' (set.univ : set $ bounded_formula L_ZFC (n+2)))

theorem bSet_models_ZFC : ⊤ ⊩[V β] ZFC :=
begin
  change ⊤ ≤ _, bv_intro f, bv_intro H,
  repeat{auto_cases}; try{subst H}; try {cases H},
  from bSet_models_Zorn _,
  from bSet_models_regularity _,
  from bSet_models_infinity _,
  from bSet_models_powerset _,
  from bSet_models_union _,
  from bSet_models_extensionality _,
  from bSet_models_ordered_pairs _,
  from bSet_models_emptyset _,
  from bSet_models_collection _ ‹_›
end

include β
theorem ZFC_consistent : is_consistent ZFC := consis_of_exists_bmodel (bSet_models_ZFC β)
omit β

/-- f is =ᴮ-extensional if for every w₁ w₂ v₁ v₂, if pair (w₁, v₁) and pair (w₂, v₂) ∈ f and
    w₁ =ᴮ w₂, then v₁ =ᴮ v₂ -/
def is_func_f : bounded_formula L_ZFC 1 :=
∀' ∀' ∀' ∀' ((pair' &'3 &'1 ∈' &'4 ⊓' pair' &'2 &'0 ∈' &'4
  ⟹ (&'3 ≃ &'2 ⟹ &'1 ≃ &'0)))

@[simp]lemma realize_is_func_f {f : V β} : boolean_realize_bounded_formula (by exact [f]) is_func_f dvector.nil = is_func f :=
begin
  simp[is_func_f, bSet.is_func], refl
end

def is_total'_f : bounded_formula L_ZFC 3 :=
(∀' (&'0 ∈' &'3 ⟹ (∃' (&'0 ∈' &'3 ⊓' (pair' &'1 &'0 ∈' &'2)))))

@[simp]lemma realize_is_total'_f {x y f : V β} : boolean_realize_bounded_formula (by exact [f, y, x]) is_total'_f dvector.nil = is_total x y f :=
begin
  simp [bSet.is_total, is_total'_f]
end

-- is_total'_f₂ S y f is the same as is_total'_f y S f
def is_total'_f₂ : bounded_formula L_ZFC 3 :=
(∀' (&'0 ∈' &'2 ⟹ (∃' (&'0 ∈' &'4 ⊓' (pair' &'1 &'0 ∈' &'2)))))

@[simp]lemma realize_is_total'_f₂ {x y f : V β} : boolean_realize_bounded_formula (by exact [f, y, x]) is_total'_f₂ dvector.nil = is_total y x f :=
begin
  rw [bSet.is_total, is_total'_f₂], simp, refl
end

def is_func'_f : bounded_formula L_ZFC 3 :=
  (is_func_f.cast (dec_trivial)) ⊓' is_total'_f

def is_func'_f₂ : bounded_formula L_ZFC 3 :=
(is_func_f.cast dec_trivial) ⊓' is_total'_f₂

@[simp]lemma realize_is_func'_f {x y f : V β} : boolean_realize_bounded_formula (by exact [f, y, x]) is_func'_f dvector.nil = is_func' x y f :=
by simp [is_func'_f, is_func']

@[simp]lemma realize_is_func'_f₂ {x y f : V β} : boolean_realize_bounded_formula (by exact [f, y, x]) is_func'_f₂ dvector.nil = is_func' y x f :=
by simp [is_func'_f₂, is_func']

/-
  `at_most_f x y` means
  `∃ S, ∃ f, S ⊆ y ∧ f contains a function from S to x ∧ f surjects S onto x`
  In `bSet` it corresponds to the formula `larger_than y x`.

  `at_most_f x y` is equivalent to `¬ y ≺ x`.
-/
def at_most_f : bounded_formula L_ZFC 2 :=
∃' (∃' (((&'1 ⊆' &'3) ⊓' (is_func'_f₂).cast (dec_trivial : 3 ≤ 4)) ⊓'
        ∀' ( &0 ∈' &3 ⟹ (∃' (&'0 ∈' &'3 ⊓' pair' &'0 &'1 ∈' &'2)))))

@[simp]lemma realize_at_most_f {x y : V β} :
  boolean_realize_bounded_formula ([y,x]) at_most_f dvector.nil = larger_than x y :=
by simp[larger_than, at_most_f, is_func]

def is_inj_f : bounded_formula L_ZFC 1 :=
∀' ∀' ∀' ∀' (((pair' &'3 &'1 ∈' &'4 ⊓' pair' &'2 &'0 ∈' &'4) ⊓ &'1 ≃ &'0) ⟹ &'3 ≃ &'2)

@[simp]lemma realize_is_inj_f (f : V β) :
  boolean_realize_bounded_formula (by exact [f]) is_inj_f dvector.nil = is_inj f :=
by {simp[is_inj_f, is_inj], refl}

def injects_into_f : bounded_formula L_ZFC 2 :=
 ∃' (is_func'_f ⊓' is_inj_f.cast (dec_trivial))

@[simp]lemma realize_injects_into {x y : V β} :
  boolean_realize_bounded_formula (by exact [y,x]) injects_into_f dvector.nil = injects_into x y :=
by {simp[injects_into_f, injects_into]}

def non_empty_f : bounded_formula L_ZFC 1 := ∼(&'0 ≃ ∅')

@[simp]lemma non_empty_f_is_non_empty {x : V β} : boolean_realize_bounded_formula (by exact [x]) non_empty_f dvector.nil = not_empty x := by {simp[non_empty_f], refl}

/-- The continuum hypothesis is given by the formula
  `∀x, x is an ordinal → x ≤ ω ∨ P(ω) ≤ x`.
  Here `a ≤ b` means there is a surjection from a subset of `b` to `a`.
  We have to perform two substitutions (`substmax_bounded_formula` and `[../0]`)
  to apply `at_most_f` to the appropriate arguments. -/
def CH_f : sentence L_ZFC :=
∀' (Ord_f ⟹ (substmax_bounded_formula at_most_f ω' ⊔' at_most_f[Powerset omega/0]))

variable {β}
lemma CH_f_is_CH : ⟦CH_f⟧[V β] = CH₂ :=
begin
  have h1 : ∀(x : V β), boolean_realize_bounded_formula ([x])
    (substmax_bounded_formula at_most_f omega) ([]) =
    boolean_realize_bounded_formula ([x,omega]) at_most_f ([]),
  { intro, refl },
  have h2 : ∀(x : V β), boolean_realize_bounded_formula ([x]) (at_most_f[P' omega /0]) ([]) =
    boolean_realize_bounded_formula (([bv_powerset omega, x] : dvector (V β) 2)) at_most_f ([]),
  { intro, refl },
  -- note: once we have proven realize_substmax_bf and realize_subst0_bf, we can add them to this simp set
  simp [-substmax_bounded_formula, CH_f, CH₂, neg_supr, sup_assoc, h1, h2, lattice.imp]
end

lemma CH_f_sound {Γ : β} : Γ ⊩[V β] CH_f ↔ Γ ≤ CH₂ :=
by {change _ ≤ _ ↔ _ ≤ _, rw CH_f_is_CH}

lemma neg_CH_f_sound {Γ : β} : Γ ⊩[V β] ∼CH_f ↔ Γ ≤ - CH₂ :=
by {change _ ≤ _ ↔ _ ≤ _, rw [boolean_realize_sentence_not, CH_f_is_CH]}

end ZFC

open pSet cardinal

section CH_unprovable

lemma V_𝔹_cohen_models_neg_CH : ⊤ ⊩[V 𝔹_cohen] ∼CH_f :=
begin
  rw neg_CH_f_sound, exact neg_CH₂
end

instance V_𝔹_nonempty : nonempty (V 𝔹_cohen) := ⟨bSet.empty⟩

theorem CH_f_unprovable : ¬ (ZFC ⊢' CH_f) :=
unprovable_of_model_neg _ (bSet_models_ZFC _) (nontrivial.bot_lt_top) V_𝔹_cohen_models_neg_CH

end CH_unprovable

open collapse_algebra

section neg_CH_unprovable

instance V_𝔹_collapse_nonempty : nonempty (V 𝔹_collapse) := ⟨bSet.empty⟩

lemma V_𝔹_collapse_models_CH : ⊤ ⊩[V 𝔹_collapse] CH_f :=
by { rw CH_f_sound, exact CH₂_true }

theorem neg_CH_f_unprovable : ¬ (ZFC ⊢' ∼CH_f) :=
unprovable_of_model_neg (V 𝔹_collapse) (bSet_models_ZFC _)
  (nontrivial.bot_lt_top) (by {rw forced_in_not, from V_𝔹_collapse_models_CH})

end neg_CH_unprovable

section
-- a nicer formulation of CH using formulae

@[simp] def Powerset_t : term L_ZFC → term L_ZFC := app (func ZFC_func.P)
@[simp] def omega_t : term L_ZFC := func ZFC_func.ω
@[simp] def leq_f : formula L_ZFC := at_most_f.fst
@[simp] def is_ordinal : formula L_ZFC := Ord_f.fst

def CH_formula : formula L_ZFC :=
∀' (is_ordinal ⟹ leq_f[omega_t//1] ⊔ leq_f[Powerset_t omega_t//0])

lemma CH_f_fst : CH_f.fst = CH_formula :=
by { simp [CH_f, CH_formula, -substmax_bounded_formula], refl }

end