-- Copyright (c) 2018 Reid Barton. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Reid Barton, Scott Morrison

import category_theory.isomorphism
import category_theory.functor_category

universes v v' u u' -- declare the `v`'s first; see `category_theory.category` for an explanation

namespace category_theory

variables {C : Type u} [𝒞 : category.{v} C]
include 𝒞

def eq_to_hom {X Y : C} (p : X = Y) : X ⟶ Y := by rw p; exact 𝟙 _

@[simp] lemma eq_to_hom_refl (X : C) (p : X = X) : eq_to_hom p = 𝟙 X := rfl
@[simp] lemma eq_to_hom_trans {X Y Z : C} (p : X = Y) (q : Y = Z) :
  eq_to_hom p ≫ eq_to_hom q = eq_to_hom (p.trans q) :=
by cases p; cases q; simp
@[simp] lemma eq_to_hom_trans_assoc {X Y Z W : C} (p : X = Y) (q : Y = Z) (f : Z ⟶ W) :
  eq_to_hom p ≫ (eq_to_hom q ≫ f) = eq_to_hom (p.trans q) ≫ f :=
by cases p; cases q; simp

def eq_to_iso {X Y : C} (p : X = Y) : X ≅ Y :=
⟨eq_to_hom p, eq_to_hom p.symm, by simp, by simp⟩

@[simp] lemma eq_to_iso.hom {X Y : C} (p : X = Y) : (eq_to_iso p).hom = eq_to_hom p :=
rfl

@[simp]

variables {D : Type u'} [𝒟 : category.{v'} D]
include 𝒟

namespace functor

/-- Proving equality between functors. This isn't an extensionality lemma,
  because usually you don't really want to do this. -/
lemma ext {F G : C ⥤ D} (h_obj : ∀ X, F.obj X = G.obj X)
  (h_map : ∀ X Y f, F.map f = eq_to_hom (h_obj X) ≫ G.map f ≫ eq_to_hom (h_obj Y).symm) :
  F = G :=
begin
  cases F with F_obj _ _ _, cases G with G_obj _ _ _,
  have : F_obj = G_obj, by ext X; apply h_obj,
  subst this,
  congr,
  funext X Y f,
  simpa using h_map X Y f
end

-- Using equalities between functors.

lemma congr_obj {F G : C ⥤ D} (h : F = G) (X) : F.obj X = G.obj X :=
by subst h

lemma congr_hom {F G : C ⥤ D} (h : F = G) {X Y} (f : X ⟶ Y) :
  F.map f = eq_to_hom (congr_obj h X) ≫ G.map f ≫ eq_to_hom (congr_obj h Y).symm :=
by subst h; simp

end functor

@[simp] lemma eq_to_hom_map (F : C ⥤ D) {X Y : C} (p : X = Y) :
  F.map (eq_to_hom p) = eq_to_hom (congr_arg F.obj p) :=
by cases p; simp

@[simp] lemma eq_to_iso_map (F : C ⥤ D) {X Y : C} (p : X = Y) :
  F.on_iso (eq_to_iso p) = eq_to_iso (congr_arg F.obj p) :=
by ext; cases p; simp

@[simp] lemma eq_to_hom_app {F G : C ⥤ D} (h : F = G) (X : C) :
  (eq_to_hom h : F ⟹ G).app X = eq_to_hom (functor.congr_obj h X) :=
by subst h; refl

end category_theory


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.limits.shapes.finite_products
import category_theory.limits.shapes.kernels
import category_theory.limits.shapes.normal_mono
import category_theory.preadditive

/-!
# Every non_preadditive_abelian category is preadditive

In mathlib, we define an abelian category as a preadditive category with a zero object,
kernels and cokernels, products and coproducts and in which every monomorphism and epimorphis is
normal.

While virtually every interesting abelian category has a natural preadditive structure (which is why
it is included in the definition), preadditivity is not actually needed: Every category that has
all of the other properties appearing in the definition of an abelian category admits a preadditive
structure. This is the construction we carry out in this file.

The proof proceeds in roughly five steps:
1. Prove some results (for example that all equalizers exist) that would be trivial if we already
   had the preadditive structure but are a bit of work without it.
2. Develop images and coimages to show that every monomorphism is the kernel of its cokernel.

The results of the first two steps are also useful for the "normal" development of abelian
categories, and will be used there.

3. For every object `A`, define a "subtraction" morphism `σ : A ⨯ A ⟶ A` and use it to define
   subtraction on morphisms as `f - g := prod.lift f g ≫ σ`.
4. Prove a small number of identities about this subtraction from the definition of `σ`.
5. From these identities, prove a large number of other identities that imply that defining
   `f + g := f - (0 - g)` indeed gives an abelian group structure on morphisms such that composition
   is bilinear.

The construction is non-trivial and it is quite remarkable that this abelian group structure can
be constructed purely from the existence of a few limits and colimits. What's even more impressive
is that all additive structures on a category are in some sense isomorphic, so for abelian
categories with a natural preadditive structure, this construction manages to "almost" reconstruct
this natural structure. However, we have not formalized this isomorphism.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]

-/

noncomputable theory

open category_theory
open category_theory.limits

namespace category_theory
section
universes v u

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

/-- We call a category `non_preadditive_abelian` if it has a zero object, kernels, cokernels, binary
    products and coproducts, and every monomorphism and every epimorphism is normal. -/
class non_preadditive_abelian :=
[has_zero_object : has_zero_object C]
[has_zero_morphisms : has_zero_morphisms C]
[has_kernels : has_kernels C]
[has_cokernels : has_cokernels C]
[has_finite_products : has_finite_products C]
[has_finite_coproducts : has_finite_coproducts C]
(normal_mono : Π {X Y : C} (f : X ⟶ Y) [mono f], normal_mono f)
(normal_epi : Π {X Y : C} (f : X ⟶ Y) [epi f], normal_epi f)

set_option default_priority 100

attribute [instance] non_preadditive_abelian.has_zero_object
attribute [instance] non_preadditive_abelian.has_zero_morphisms
attribute [instance] non_preadditive_abelian.has_kernels
attribute [instance] non_preadditive_abelian.has_cokernels
attribute [instance] non_preadditive_abelian.has_finite_products
attribute [instance] non_preadditive_abelian.has_finite_coproducts

end
end category_theory

open category_theory

namespace category_theory.non_preadditive_abelian

universes v u

variables {C : Type u} [category.{v} C]

section
variables [non_preadditive_abelian C]

section strong
local attribute [instance] non_preadditive_abelian.normal_epi

/-- In a `non_preadditive_abelian` category, every epimorphism is strong. -/
lemma strong_epi_of_epi {P Q : C} (f : P ⟶ Q) [epi f] : strong_epi f := by apply_instance

end strong

section mono_epi_iso
variables {X Y : C} (f : X ⟶ Y)

local attribute [instance] strong_epi_of_epi

/-- In a `non_preadditive_abelian` category, a monomorphism which is also an epimorphism is an
    isomorphism. -/
lemma is_iso_of_mono_of_epi [mono f] [epi f] : is_iso f :=
is_iso_of_mono_of_strong_epi _

end mono_epi_iso

/-- The pullback of two monomorphisms exists. -/
@[irreducible]
lemma pullback_of_mono {X Y Z : C} (a : X ⟶ Z) (b : Y ⟶ Z) [mono a] [mono b] :
  has_limit (cospan a b) :=
let ⟨P, f, haf, i⟩ := non_preadditive_abelian.normal_mono a in
let ⟨Q, g, hbg, i'⟩ := non_preadditive_abelian.normal_mono b in
let ⟨a', ha'⟩ := kernel_fork.is_limit.lift' i (kernel.ι (prod.lift f g)) $
    calc kernel.ι (prod.lift f g) ≫ f
        = kernel.ι (prod.lift f g) ≫ prod.lift f g ≫ limits.prod.fst : by rw prod.lift_fst
    ... = (0 : kernel (prod.lift f g) ⟶ P ⨯ Q) ≫ limits.prod.fst : by rw kernel.condition_assoc
    ... = 0 : zero_comp in
let ⟨b', hb'⟩ := kernel_fork.is_limit.lift' i' (kernel.ι (prod.lift f g)) $
    calc kernel.ι (prod.lift f g) ≫ g
        = kernel.ι (prod.lift f g) ≫ (prod.lift f g) ≫ limits.prod.snd : by rw prod.lift_snd
    ... = (0 : kernel (prod.lift f g) ⟶ P ⨯ Q) ≫ limits.prod.snd : by rw kernel.condition_assoc
    ... = 0 : zero_comp in
has_limit.mk { cone := pullback_cone.mk a' b' $ by { simp at ha' hb', rw [ha', hb'] },
  is_limit := pullback_cone.is_limit.mk _
    (λ s, kernel.lift (prod.lift f g) (pullback_cone.snd s ≫ b) $ prod.hom_ext
      (calc ((pullback_cone.snd s ≫ b) ≫ prod.lift f g) ≫ limits.prod.fst
            = pullback_cone.snd s ≫ b ≫ f : by simp only [prod.lift_fst, category.assoc]
        ... = pullback_cone.fst s ≫ a ≫ f : by rw pullback_cone.condition_assoc
        ... = pullback_cone.fst s ≫ 0 : by rw haf
        ... = 0 ≫ limits.prod.fst :
          by rw [comp_zero, zero_comp])
      (calc ((pullback_cone.snd s ≫ b) ≫ prod.lift f g) ≫ limits.prod.snd
            = pullback_cone.snd s ≫ b ≫ g : by simp only [prod.lift_snd, category.assoc]
        ... = pullback_cone.snd s ≫ 0 : by rw hbg
        ... = 0 ≫ limits.prod.snd :
          by rw [comp_zero, zero_comp]))
    (λ s, (cancel_mono a).1 $
      by { rw kernel_fork.ι_of_ι at ha', simp [ha', pullback_cone.condition s] })
    (λ s, (cancel_mono b).1 $
      by { rw kernel_fork.ι_of_ι at hb', simp [hb'] })
    (λ s m h₁ h₂, (cancel_mono (kernel.ι (prod.lift f g))).1 $ calc m ≫ kernel.ι (prod.lift f g)
          = m ≫ a' ≫ a : by { congr, exact ha'.symm }
      ... = pullback_cone.fst s ≫ a : by rw [←category.assoc, h₁]
      ... = pullback_cone.snd s ≫ b : pullback_cone.condition s
      ... = kernel.lift (prod.lift f g) (pullback_cone.snd s ≫ b) _ ≫ kernel.ι (prod.lift f g) :
        by rw kernel.lift_ι) }

/-- The pushout of two epimorphisms exists. -/
@[irreducible]
lemma pushout_of_epi {X Y Z : C} (a : X ⟶ Y) (b : X ⟶ Z) [epi a] [epi b] :
  has_colimit (span a b) :=
let ⟨P, f, hfa, i⟩ := non_preadditive_abelian.normal_epi a in
let ⟨Q, g, hgb, i'⟩ := non_preadditive_abelian.normal_epi b in
let ⟨a', ha'⟩ := cokernel_cofork.is_colimit.desc' i (cokernel.π (coprod.desc f g)) $
  calc f ≫ cokernel.π (coprod.desc f g)
      = coprod.inl ≫ coprod.desc f g ≫ cokernel.π (coprod.desc f g) : by rw coprod.inl_desc_assoc
  ... = coprod.inl ≫ (0 : P ⨿ Q ⟶ cokernel (coprod.desc f g)) : by rw cokernel.condition
  ... = 0 : has_zero_morphisms.comp_zero _ _ in
let ⟨b', hb'⟩ := cokernel_cofork.is_colimit.desc' i' (cokernel.π (coprod.desc f g)) $
  calc g ≫ cokernel.π (coprod.desc f g)
      = coprod.inr ≫ coprod.desc f g ≫ cokernel.π (coprod.desc f g) : by rw coprod.inr_desc_assoc
  ... = coprod.inr ≫ (0 : P ⨿ Q ⟶ cokernel (coprod.desc f g)) :  by rw cokernel.condition
  ... = 0 : has_zero_morphisms.comp_zero _ _ in
has_colimit.mk
{ cocone := pushout_cocone.mk a' b' $ by { simp only [cofork.π_of_π] at ha' hb', rw [ha', hb'] },
  is_colimit := pushout_cocone.is_colimit.mk _
  (λ s, cokernel.desc (coprod.desc f g) (b ≫ pushout_cocone.inr s) $ coprod.hom_ext
    (calc coprod.inl ≫ coprod.desc f g ≫ b ≫ pushout_cocone.inr s
          = f ≫ b ≫ pushout_cocone.inr s : by rw coprod.inl_desc_assoc
      ... = f ≫ a ≫ pushout_cocone.inl s : by rw pushout_cocone.condition
      ... = 0 ≫ pushout_cocone.inl s : by rw reassoc_of hfa
      ... = coprod.inl ≫ 0 : by rw [comp_zero, zero_comp])
    (calc coprod.inr ≫ coprod.desc f g ≫ b ≫ pushout_cocone.inr s
          = g ≫ b ≫ pushout_cocone.inr s : by rw coprod.inr_desc_assoc
      ... = 0 ≫ pushout_cocone.inr s : by rw reassoc_of hgb
      ... = coprod.inr ≫ 0 : by rw [comp_zero, zero_comp]))
  (λ s, (cancel_epi a).1 $
    by { rw cokernel_cofork.π_of_π at ha', simp [reassoc_of ha', pushout_cocone.condition s] })
  (λ s, (cancel_epi b).1 $ by { rw cokernel_cofork.π_of_π at hb', simp [reassoc_of hb'] })
  (λ s m h₁ h₂, (cancel_epi (cokernel.π (coprod.desc f g))).1 $
  calc cokernel.π (coprod.desc f g) ≫ m
        = (a ≫ a') ≫ m : by { congr, exact ha'.symm }
    ... = a ≫ pushout_cocone.inl s : by rw [category.assoc, h₁]
    ... = b ≫ pushout_cocone.inr s : pushout_cocone.condition s
    ... = cokernel.π (coprod.desc f g) ≫
            cokernel.desc (coprod.desc f g) (b ≫ pushout_cocone.inr s) _ :
      by rw cokernel.π_desc) }

section

local attribute [instance] pullback_of_mono

/-- The pullback of `(𝟙 X, f)` and `(𝟙 X, g)` -/
private abbreviation P {X Y : C} (f g : X ⟶ Y)
  [mono (prod.lift (𝟙 X) f)] [mono (prod.lift (𝟙 X) g)] : C :=
pullback (prod.lift (𝟙 X) f) (prod.lift (𝟙 X) g)

/-- The equalizer of `f` and `g` exists. -/
@[irreducible]
lemma has_limit_parallel_pair {X Y : C} (f g : X ⟶ Y) : has_limit (parallel_pair f g) :=
have huv : (pullback.fst : P f g ⟶ X) = pullback.snd, from
  calc (pullback.fst : P f g ⟶ X) = pullback.fst ≫ 𝟙 _ : eq.symm $ category.comp_id _
    ... = pullback.fst ≫ prod.lift (𝟙 X) f ≫ limits.prod.fst : by rw prod.lift_fst
    ... = pullback.snd ≫ prod.lift (𝟙 X) g ≫ limits.prod.fst : by rw pullback.condition_assoc
    ... = pullback.snd : by rw [prod.lift_fst, category.comp_id],
have hvu : (pullback.fst : P f g ⟶ X) ≫ f = pullback.snd ≫ g, from
  calc (pullback.fst : P f g ⟶ X) ≫ f
        = pullback.fst ≫ prod.lift (𝟙 X) f ≫ limits.prod.snd : by rw prod.lift_snd
    ... = pullback.snd ≫ prod.lift (𝟙 X) g ≫ limits.prod.snd : by rw pullback.condition_assoc
    ... = pullback.snd ≫ g : by rw prod.lift_snd,
have huu : (pullback.fst : P f g ⟶ X) ≫ f = pullback.fst ≫ g, by rw [hvu, ←huv],
has_limit.mk { cone := fork.of_ι pullback.fst huu,
  is_limit := fork.is_limit.mk _
  (λ s, pullback.lift (fork.ι s) (fork.ι s) $ prod.hom_ext
    (by simp only [prod.lift_fst, category.assoc])
    (by simp only [fork.app_zero_right, fork.app_zero_left, prod.lift_snd, category.assoc]))
  (λ s, by simp only [fork.ι_of_ι, pullback.lift_fst])
  (λ s m h, pullback.hom_ext
    (by simpa only [pullback.lift_fst] using h walking_parallel_pair.zero)
    (by simpa only [huv.symm, pullback.lift_fst] using h walking_parallel_pair.zero)) }

end

section
local attribute [instance] pushout_of_epi

/-- The pushout of `(𝟙 Y, f)` and `(𝟙 Y, g)`. -/
private abbreviation Q {X Y : C} (f g : X ⟶ Y)
  [epi (coprod.desc (𝟙 Y) f)] [epi (coprod.desc (𝟙 Y) g)] : C :=
pushout (coprod.desc (𝟙 Y) f) (coprod.desc (𝟙 Y) g)

/-- The coequalizer of `f` and `g` exists. -/
@[irreducible]
lemma has_colimit_parallel_pair {X Y : C} (f g : X ⟶ Y) : has_colimit (parallel_pair f g) :=
have huv : (pushout.inl : Y ⟶ Q f g) = pushout.inr, from
  calc (pushout.inl : Y ⟶ Q f g) = 𝟙 _ ≫ pushout.inl : eq.symm $ category.id_comp _
    ... = (coprod.inl ≫ coprod.desc (𝟙 Y) f) ≫ pushout.inl : by rw coprod.inl_desc
    ... = (coprod.inl ≫ coprod.desc (𝟙 Y) g) ≫ pushout.inr :
      by simp only [category.assoc, pushout.condition]
    ... = pushout.inr : by rw [coprod.inl_desc, category.id_comp],
have hvu : f ≫ (pushout.inl : Y ⟶ Q f g) = g ≫ pushout.inr, from
  calc f ≫ (pushout.inl : Y ⟶ Q f g)
        = (coprod.inr ≫ coprod.desc (𝟙 Y) f) ≫ pushout.inl : by rw coprod.inr_desc
    ... = (coprod.inr ≫ coprod.desc (𝟙 Y) g) ≫ pushout.inr :
      by simp only [category.assoc, pushout.condition]
    ... = g ≫ pushout.inr : by rw coprod.inr_desc,
have huu : f ≫ (pushout.inl : Y ⟶ Q f g) = g ≫ pushout.inl, by rw [hvu, huv],
has_colimit.mk { cocone := cofork.of_π pushout.inl huu,
  is_colimit := cofork.is_colimit.mk _
  (λ s, pushout.desc (cofork.π s) (cofork.π s) $ coprod.hom_ext
    (by simp only [coprod.inl_desc_assoc])
    (by simp only [cofork.right_app_one, coprod.inr_desc_assoc, cofork.left_app_one]))
  (λ s, by simp only [pushout.inl_desc, cofork.π_of_π])
  (λ s m h, pushout.hom_ext
    (by simpa only [pushout.inl_desc] using h walking_parallel_pair.one)
    (by simpa only [huv.symm, pushout.inl_desc] using h walking_parallel_pair.one)) }

end

section
local attribute [instance] has_limit_parallel_pair

/-- A `non_preadditive_abelian` category has all equalizers. -/
@[priority 100] instance has_equalizers : has_equalizers C :=
has_equalizers_of_has_limit_parallel_pair _

end

section
local attribute [instance] has_colimit_parallel_pair

/-- A `non_preadditive_abelian` category has all coequalizers. -/
@[priority 100] instance has_coequalizers : has_coequalizers C :=
has_coequalizers_of_has_colimit_parallel_pair _

end

section

/-- If a zero morphism is a kernel of `f`, then `f` is a monomorphism. -/
lemma mono_of_zero_kernel {X Y : C} (f : X ⟶ Y) (Z : C)
  (l : is_limit (kernel_fork.of_ι (0 : Z ⟶ X) (show 0 ≫ f = 0, by simp))) : mono f :=
⟨λ P u v huv,
 begin
  obtain ⟨W, w, hw, hl⟩ := non_preadditive_abelian.normal_epi (coequalizer.π u v),
  obtain ⟨m, hm⟩ := coequalizer.desc' f huv,
  have hwf : w ≫ f = 0,
  { rw [←hm, reassoc_of hw, zero_comp] },
  obtain ⟨n, hn⟩ := kernel_fork.is_limit.lift' l _ hwf,
  rw [fork.ι_of_ι, has_zero_morphisms.comp_zero] at hn,
  haveI : is_iso (coequalizer.π u v) :=
    by apply is_iso_colimit_cocone_parallel_pair_of_eq hn.symm hl,
  apply (cancel_mono (coequalizer.π u v)).1,
  exact coequalizer.condition _ _
 end⟩

/-- If a zero morphism is a cokernel of `f`, then `f` is an epimorphism. -/
lemma epi_of_zero_cokernel {X Y : C} (f : X ⟶ Y) (Z : C)
  (l : is_colimit (cokernel_cofork.of_π (0 : Y ⟶ Z) (show f ≫ 0 = 0, by simp))) : epi f :=
⟨λ P u v huv,
 begin
  obtain ⟨W, w, hw, hl⟩ := non_preadditive_abelian.normal_mono (equalizer.ι u v),
  obtain ⟨m, hm⟩ := equalizer.lift' f huv,
  have hwf : f ≫ w = 0,
  { rw [←hm, category.assoc, hw, comp_zero] },
  obtain ⟨n, hn⟩ := cokernel_cofork.is_colimit.desc' l _ hwf,
  rw [cofork.π_of_π, zero_comp] at hn,
  haveI : is_iso (equalizer.ι u v) :=
    by apply is_iso_limit_cone_parallel_pair_of_eq hn.symm hl,
  apply (cancel_epi (equalizer.ι u v)).1,
  exact equalizer.condition _ _
 end⟩

local attribute [instance] has_zero_object.has_zero

/-- If `g ≫ f = 0` implies `g = 0` for all `g`, then `0 : 0 ⟶ X` is a kernel of `f`. -/
def zero_kernel_of_cancel_zero {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Z ⟶ X) (hgf : g ≫ f = 0), g = 0) :
    is_limit (kernel_fork.of_ι (0 : 0 ⟶ X) (show 0 ≫ f = 0, by simp)) :=
fork.is_limit.mk _ (λ s, 0)
  (λ s, by rw [hf _ _ (kernel_fork.condition s), zero_comp])
  (λ s m h, by ext)

/-- If `f ≫ g = 0` implies `g = 0` for all `g`, then `0 : Y ⟶ 0` is a cokernel of `f`. -/
def zero_cokernel_of_zero_cancel {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Y ⟶ Z) (hgf : f ≫ g = 0), g = 0) :
    is_colimit (cokernel_cofork.of_π (0 : Y ⟶ 0) (show f ≫ 0 = 0, by simp)) :=
cofork.is_colimit.mk _ (λ s, 0)
  (λ s, by rw [hf _ _ (cokernel_cofork.condition s), comp_zero])
  (λ s m h, by ext)

/-- If `g ≫ f = 0` implies `g = 0` for all `g`, then `f` is a monomorphism. -/
lemma mono_of_cancel_zero {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Z ⟶ X) (hgf : g ≫ f = 0), g = 0) : mono f :=
mono_of_zero_kernel f 0 $ zero_kernel_of_cancel_zero f hf

/-- If `f ≫ g = 0` implies `g = 0` for all `g`, then `g` is a monomorphism. -/
lemma epi_of_zero_cancel {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Y ⟶ Z) (hgf : f ≫ g = 0), g = 0) : epi f :=
epi_of_zero_cokernel f 0 $ zero_cokernel_of_zero_cancel f hf

end

section factor

variables {P Q : C} (f : P ⟶ Q)

/-- The kernel of the cokernel of `f` is called the image of `f`. -/
protected abbreviation image : C := kernel (cokernel.π f)

/-- The inclusion of the image into the codomain. -/
protected abbreviation image.ι : non_preadditive_abelian.image f ⟶ Q :=
kernel.ι (cokernel.π f)

/-- There is a canonical epimorphism `p : P ⟶ image f` for every `f`. -/
protected abbreviation factor_thru_image : P ⟶ non_preadditive_abelian.image f :=
kernel.lift (cokernel.π f) f $ cokernel.condition f

/-- `f` factors through its image via the canonical morphism `p`. -/
@[simp, reassoc] protected lemma image.fac :
  non_preadditive_abelian.factor_thru_image f ≫ image.ι f = f :=
kernel.lift_ι _ _ _

/-- The map `p : P ⟶ image f` is an epimorphism -/
instance : epi (non_preadditive_abelian.factor_thru_image f) :=
let I := non_preadditive_abelian.image f, p := non_preadditive_abelian.factor_thru_image f,
    i := kernel.ι (cokernel.π f) in
-- It will suffice to consider some g : I ⟶ R such that p ≫ g = 0 and show that g = 0.
epi_of_zero_cancel _ $ λ R (g : I ⟶ R) (hpg : p ≫ g = 0),
begin
  -- Since C is abelian, u := ker g ≫ i is the kernel of some morphism h.
  let u := kernel.ι g ≫ i,
  haveI : mono u := mono_comp _ _,
  haveI hu := non_preadditive_abelian.normal_mono u,
  let h := hu.g,
  -- By hypothesis, p factors through the kernel of g via some t.
  obtain ⟨t, ht⟩ := kernel.lift' g p hpg,
  have fh : f ≫ h = 0, calc
    f ≫ h = (p ≫ i) ≫ h : (image.fac f).symm ▸ rfl
       ... = ((t ≫ kernel.ι g) ≫ i) ≫ h : ht ▸ rfl
       ... = t ≫ u ≫ h : by simp only [category.assoc]; conv_lhs { congr, skip, rw ←category.assoc }
       ... = t ≫ 0 : hu.w ▸ rfl
       ... = 0 : has_zero_morphisms.comp_zero _ _,
  -- h factors through the cokernel of f via some l.
  obtain ⟨l, hl⟩ := cokernel.desc' f h fh,
  have hih : i ≫ h = 0, calc
    i ≫ h = i ≫ cokernel.π f ≫ l : hl ▸ rfl
       ... = 0 ≫ l : by rw [←category.assoc, kernel.condition]
       ... = 0 : zero_comp,
  -- i factors through u = ker h via some s.
  obtain ⟨s, hs⟩ := normal_mono.lift' u i hih,
  have hs' : (s ≫ kernel.ι g) ≫ i = 𝟙 I ≫ i, by rw [category.assoc, hs, category.id_comp],
  haveI : epi (kernel.ι g) := epi_of_epi_fac ((cancel_mono _).1 hs'),
  -- ker g is an epimorphism, but ker g ≫ g = 0 = ker g ≫ 0, so g = 0 as required.
  exact zero_of_epi_comp _ (kernel.condition g)
end

instance mono_factor_thru_image [mono f] : mono (non_preadditive_abelian.factor_thru_image f) :=
mono_of_mono_fac $ image.fac f

instance is_iso_factor_thru_image [mono f] : is_iso (non_preadditive_abelian.factor_thru_image f) :=
is_iso_of_mono_of_epi _

/-- The cokernel of the kernel of `f` is called the coimage of `f`. -/
protected abbreviation coimage : C := cokernel (kernel.ι f)

/-- The projection onto the coimage. -/
protected abbreviation coimage.π : P ⟶ non_preadditive_abelian.coimage f :=
cokernel.π (kernel.ι f)

/-- There is a canonical monomorphism `i : coimage f ⟶ Q`. -/
protected abbreviation factor_thru_coimage : non_preadditive_abelian.coimage f ⟶ Q :=
cokernel.desc (kernel.ι f) f $ kernel.condition f

/-- `f` factors through its coimage via the canonical morphism `p`. -/
protected lemma coimage.fac : coimage.π f ≫ non_preadditive_abelian.factor_thru_coimage f = f :=
cokernel.π_desc _ _ _

/-- The canonical morphism `i : coimage f ⟶ Q` is a monomorphism -/
instance : mono (non_preadditive_abelian.factor_thru_coimage f) :=
let I := non_preadditive_abelian.coimage f, i := non_preadditive_abelian.factor_thru_coimage f,
    p := cokernel.π (kernel.ι f) in
mono_of_cancel_zero _ $ λ R (g : R ⟶ I) (hgi : g ≫ i = 0),
begin
  -- Since C is abelian, u := p ≫ coker g is the cokernel of some morphism h.
  let u := p ≫ cokernel.π g,
  haveI : epi u := epi_comp _ _,
  haveI hu := non_preadditive_abelian.normal_epi u,
  let h := hu.g,
  -- By hypothesis, i factors through the cokernel of g via some t.
  obtain ⟨t, ht⟩ := cokernel.desc' g i hgi,
  have hf : h ≫ f = 0, calc
    h ≫ f = h ≫ (p ≫ i) : (coimage.fac f).symm ▸ rfl
    ... = h ≫ (p ≫ (cokernel.π g ≫ t)) : ht ▸ rfl
    ... = h ≫ u ≫ t : by simp only [category.assoc]; conv_lhs { congr, skip, rw ←category.assoc }
    ... = 0 ≫ t : by rw [←category.assoc, hu.w]
    ... = 0 : zero_comp,
  -- h factors through the kernel of f via some l.
  obtain ⟨l, hl⟩ := kernel.lift' f h hf,
  have hhp : h ≫ p = 0, calc
    h ≫ p = (l ≫ kernel.ι f) ≫ p : hl ▸ rfl
    ... = l ≫ 0 : by rw [category.assoc, cokernel.condition]
    ... = 0 : comp_zero,
  -- p factors through u = coker h via some s.
  obtain ⟨s, hs⟩ := normal_epi.desc' u p hhp,
  have hs' : p ≫ cokernel.π g ≫ s = p ≫ 𝟙 I, by rw [←category.assoc, hs, category.comp_id],
  haveI : mono (cokernel.π g) := mono_of_mono_fac ((cancel_epi _).1 hs'),
  -- coker g is a monomorphism, but g ≫ coker g = 0 = 0 ≫ coker g, so g = 0 as required.
  exact zero_of_comp_mono _ (cokernel.condition g)
end

instance epi_factor_thru_coimage [epi f] : epi (non_preadditive_abelian.factor_thru_coimage f) :=
epi_of_epi_fac $ coimage.fac f

instance is_iso_factor_thru_coimage [epi f] :
  is_iso (non_preadditive_abelian.factor_thru_coimage f) :=
is_iso_of_mono_of_epi _

end factor

section cokernel_of_kernel
variables {X Y : C} {f : X ⟶ Y}

/-- In a `non_preadditive_abelian` category, an epi is the cokernel of its kernel. More precisely:
    If `f` is an epimorphism and `s` is some limit kernel cone on `f`, then `f` is a cokernel
    of `fork.ι s`. -/
def epi_is_cokernel_of_kernel [epi f] (s : fork f 0) (h : is_limit s) :
  is_colimit (cokernel_cofork.of_π f (kernel_fork.condition s)) :=
is_cokernel.cokernel_iso _ _
  (cokernel.of_iso_comp _ _
    (limits.is_limit.cone_point_unique_up_to_iso (limit.is_limit _) h)
    (cone_morphism.w (limits.is_limit.unique_up_to_iso (limit.is_limit _) h).hom _))
  (as_iso $ non_preadditive_abelian.factor_thru_coimage f) (coimage.fac f)

/-- In a `non_preadditive_abelian` category, a mono is the kernel of its cokernel. More precisely:
    If `f` is a monomorphism and `s` is some colimit cokernel cocone on `f`, then `f` is a kernel
    of `cofork.π s`. -/
def mono_is_kernel_of_cokernel [mono f] (s : cofork f 0) (h : is_colimit s) :
  is_limit (kernel_fork.of_ι f (cokernel_cofork.condition s)) :=
is_kernel.iso_kernel _ _
  (kernel.of_comp_iso _ _
    (limits.is_colimit.cocone_point_unique_up_to_iso h (colimit.is_colimit _))
    (cocone_morphism.w (limits.is_colimit.unique_up_to_iso h $ colimit.is_colimit _).hom _))
  (as_iso $ non_preadditive_abelian.factor_thru_image f) (image.fac f)

end cokernel_of_kernel
section

/-- The composite `A ⟶ A ⨯ A ⟶ cokernel (Δ A)`, where the first map is `(𝟙 A, 0)` and the second map
    is the canonical projection into the cokernel. -/
abbreviation r (A : C) : A ⟶ cokernel (diag A) := prod.lift (𝟙 A) 0 ≫ cokernel.π (diag A)

instance mono_Δ {A : C} : mono (diag A) := mono_of_mono_fac $ prod.lift_fst _ _

instance mono_r {A : C} : mono (r A) :=
begin
  let hl : is_limit (kernel_fork.of_ι (diag A) (cokernel.condition (diag A))),
  { exact mono_is_kernel_of_cokernel _ (colimit.is_colimit _) },
  apply mono_of_cancel_zero,
  intros Z x hx,
  have hxx : (x ≫ prod.lift (𝟙 A) (0 : A ⟶ A)) ≫ cokernel.π (diag A) = 0,
  { rw [category.assoc, hx] },
  obtain ⟨y, hy⟩ := kernel_fork.is_limit.lift' hl _ hxx,
  rw kernel_fork.ι_of_ι at hy,
  have hyy : y = 0,
  { erw [←category.comp_id y, ←limits.prod.lift_snd (𝟙 A) (𝟙 A),  ←category.assoc, hy,
      category.assoc, prod.lift_snd, has_zero_morphisms.comp_zero] },
  haveI : mono (prod.lift (𝟙 A) (0 : A ⟶ A)) := mono_of_mono_fac (prod.lift_fst _ _),
  apply (cancel_mono (prod.lift (𝟙 A) (0 : A ⟶ A))).1,
  rw [←hy, hyy, zero_comp, zero_comp]
end

instance epi_r {A : C} : epi (r A) :=
begin
  have hlp : prod.lift (𝟙 A) (0 : A ⟶ A) ≫ limits.prod.snd = 0 := prod.lift_snd _ _,
  let hp1 : is_limit (kernel_fork.of_ι (prod.lift (𝟙 A) (0 : A ⟶ A)) hlp),
  { refine fork.is_limit.mk _ (λ s, fork.ι s ≫ limits.prod.fst) _ _,
    { intro s,
      ext; simp, erw category.comp_id },
    { intros s m h,
      haveI : mono (prod.lift (𝟙 A) (0 : A ⟶ A)) := mono_of_mono_fac (prod.lift_fst _ _),
      apply (cancel_mono (prod.lift (𝟙 A) (0 : A ⟶ A))).1,
      convert h walking_parallel_pair.zero,
      ext; simp } },
  let hp2 : is_colimit (cokernel_cofork.of_π (limits.prod.snd : A ⨯ A ⟶ A) hlp),
  { exact epi_is_cokernel_of_kernel _ hp1 },
  apply epi_of_zero_cancel,
  intros Z z hz,
  have h : prod.lift (𝟙 A) (0 : A ⟶ A) ≫ cokernel.π (diag A) ≫ z = 0,
  { rw [←category.assoc, hz] },
  obtain ⟨t, ht⟩ := cokernel_cofork.is_colimit.desc' hp2 _ h,
  rw cokernel_cofork.π_of_π at ht,
  have htt : t = 0,
  { rw [←category.id_comp t],
    change 𝟙 A ≫ t = 0,
    rw [←limits.prod.lift_snd (𝟙 A) (𝟙 A), category.assoc, ht, ←category.assoc,
      cokernel.condition, zero_comp] },
  apply (cancel_epi (cokernel.π (diag A))).1,
  rw [←ht, htt, comp_zero, comp_zero]
end

instance is_iso_r {A : C} : is_iso (r A) :=
is_iso_of_mono_of_epi _

/-- The composite `A ⨯ A ⟶ cokernel (diag A) ⟶ A` given by the natural projection into the cokernel
    followed by the inverse of `r`. In the category of modules, using the normal kernels and
    cokernels, this map is equal to the map `(a, b) ↦ a - b`, hence the name `σ` for
    "subtraction". -/
abbreviation σ {A : C} : A ⨯ A ⟶ A := cokernel.π (diag A) ≫ inv (r A)

end

@[simp, reassoc] lemma diag_σ {X : C} : diag X ≫ σ = 0 :=
by rw [cokernel.condition_assoc, zero_comp]

@[simp, reassoc] lemma lift_σ {X : C} : prod.lift (𝟙 X) 0 ≫ σ = 𝟙 X :=
by rw [←category.assoc, is_iso.hom_inv_id]

@[reassoc] lemma lift_map {X Y : C} (f : X ⟶ Y) :
  prod.lift (𝟙 X) 0 ≫ limits.prod.map f f = f ≫ prod.lift (𝟙 Y) 0 :=
by simp

/-- σ is a cokernel of Δ X. -/
def is_colimit_σ {X : C} : is_colimit (cokernel_cofork.of_π σ diag_σ) :=
cokernel.cokernel_iso _ σ (as_iso (r X)).symm (by rw [iso.symm_hom, as_iso_inv])

/-- This is the key identity satisfied by `σ`. -/
lemma σ_comp {X Y : C} (f : X ⟶ Y) : σ ≫ f = limits.prod.map f f ≫ σ :=
begin
  obtain ⟨g, hg⟩ :=
    cokernel_cofork.is_colimit.desc' is_colimit_σ (limits.prod.map f f ≫ σ) (by simp),
  suffices hfg : f = g,
  { rw [←hg, cofork.π_of_π, hfg] },
  calc f = f ≫ prod.lift (𝟙 Y) 0 ≫ σ : by rw [lift_σ, category.comp_id]
    ... = prod.lift (𝟙 X) 0 ≫ limits.prod.map f f ≫ σ : by rw lift_map_assoc
    ... = prod.lift (𝟙 X) 0 ≫ σ ≫ g : by rw [←hg, cokernel_cofork.π_of_π]
    ... = g : by rw [←category.assoc, lift_σ, category.id_comp]
end

section

/- We write `f - g` for `prod.lift f g ≫ σ`. -/
/-- Subtraction of morphisms in a `non_preadditive_abelian` category. -/
def has_sub {X Y : C} : has_sub (X ⟶ Y) := ⟨λ f g, prod.lift f g ≫ σ⟩
local attribute [instance] has_sub

/- We write `-f` for `0 - f`. -/
/-- Negation of morphisms in a `non_preadditive_abelian` category. -/
def has_neg {X Y : C} : has_neg (X ⟶ Y) := ⟨λ f, 0 - f⟩
local attribute [instance] has_neg

/- We write `f + g` for `f - (-g)`. -/
/-- Addition of morphisms in a `non_preadditive_abelian` category. -/
def has_add {X Y : C} : has_add (X ⟶ Y) := ⟨λ f g, f - (-g)⟩
local attribute [instance] has_add

lemma sub_def {X Y : C} (a b : X ⟶ Y) : a - b = prod.lift a b ≫ σ := rfl
lemma add_def {X Y : C} (a b : X ⟶ Y) : a + b = a - (-b) := rfl
lemma neg_def {X Y : C} (a : X ⟶ Y) : -a = 0 - a := rfl

lemma sub_self {X Y : C} (a : X ⟶ Y) : a - a = 0 :=
by rw [sub_def, ←category.comp_id a, ← prod.comp_lift, category.assoc, diag_σ, comp_zero]

lemma lift_sub_lift {X Y : C} (a b c d : X ⟶ Y) :
  prod.lift a b - prod.lift c d = prod.lift (a - c) (b - d) :=
begin
  simp only [sub_def],
  ext,
  { rw [category.assoc, σ_comp, prod.lift_map_assoc, prod.lift_fst, prod.lift_fst, prod.lift_fst] },
  { rw [category.assoc, σ_comp, prod.lift_map_assoc, prod.lift_snd, prod.lift_snd, prod.lift_snd] }
end

lemma sub_sub_sub {X Y : C} (a b c d : X ⟶ Y) : (a - c) - (b - d) = (a - b) - (c - d) :=
begin
  rw [sub_def, ←lift_sub_lift, sub_def, category.assoc, σ_comp, prod.lift_map_assoc], refl
end

lemma neg_sub {X Y : C} (a b : X ⟶ Y) : (-a) - b = (-b) - a :=
by conv_lhs { rw [neg_def, ←sub_zero b, sub_sub_sub, sub_zero, ←neg_def] }

lemma neg_neg {X Y : C} (a : X ⟶ Y) : -(-a) = a :=
begin
  rw [neg_def, neg_def],
  conv_lhs { congr, rw ←sub_self a },
  rw [sub_sub_sub, sub_zero, sub_self, sub_zero]
end

lemma add_comm {X Y : C} (a b : X ⟶ Y) : a + b = b + a :=
begin
  rw [add_def],
  conv_lhs { rw ←neg_neg a },
  rw [neg_def, neg_def, neg_def, sub_sub_sub],
  conv_lhs {congr, skip, rw [←neg_def, neg_sub] },
  rw [sub_sub_sub, add_def, ←neg_def, neg_neg b, neg_def]
end

lemma add_neg {X Y : C} (a b : X ⟶ Y) : a + (-b) = a - b :=
by rw [add_def, neg_neg]

lemma add_neg_self {X Y : C} (a : X ⟶ Y) : a + (-a) = 0 :=
by rw [add_neg, sub_self]

lemma neg_add_self {X Y : C} (a : X ⟶ Y) : (-a) + a = 0 :=
by rw [add_comm, add_neg_self]

lemma neg_sub' {X Y : C} (a b : X ⟶ Y) : -(a - b) = (-a) + b :=
begin
  rw [neg_def, neg_def],
  conv_lhs { rw ←sub_self (0 : X ⟶ Y) },
  rw [sub_sub_sub, add_def, neg_def]
end

lemma neg_add {X Y : C} (a b : X ⟶ Y) : -(a + b) = (-a) - b :=
by rw [add_def, neg_sub', add_neg]

lemma sub_add {X Y : C} (a b c : X ⟶ Y) : (a - b) + c = a - (b - c) :=
by rw [add_def, neg_def, sub_sub_sub, sub_zero]

lemma add_assoc {X Y : C} (a b c : X ⟶ Y) : (a + b) + c = a + (b + c) :=
begin
  conv_lhs { congr, rw add_def },
  rw [sub_add, ←add_neg, neg_sub', neg_neg]
end

lemma add_zero {X Y : C} (a : X ⟶ Y) : a + 0 = a :=
by rw [add_def, neg_def, sub_self, sub_zero]

lemma comp_sub {X Y Z : C} (f : X ⟶ Y) (g h : Y ⟶ Z) : f ≫ (g - h) = f ≫ g - f ≫ h :=
by rw [sub_def, ←category.assoc, prod.comp_lift, sub_def]

lemma sub_comp {X Y Z : C} (f g : X ⟶ Y) (h : Y ⟶ Z) : (f - g) ≫ h = f ≫ h - g ≫ h :=
by rw [sub_def, category.assoc, σ_comp, ←category.assoc, prod.lift_map, sub_def]

lemma comp_add (X Y Z : C) (f : X ⟶ Y) (g h : Y ⟶ Z) : f ≫ (g + h) = f ≫ g + f ≫ h :=
by rw [add_def, comp_sub, neg_def, comp_sub, comp_zero, add_def, neg_def]

lemma add_comp (X Y Z : C) (f g : X ⟶ Y) (h : Y ⟶ Z) : (f + g) ≫ h = f ≫ h + g ≫ h :=
by rw [add_def, sub_comp, neg_def, sub_comp, zero_comp, add_def, neg_def]

/-- Every `non_preadditive_abelian` category is preadditive. -/
def preadditive : preadditive C :=
{ hom_group := λ X Y,
  { add := (+),
    add_assoc := add_assoc,
    zero := 0,
    zero_add := neg_neg,
    add_zero := add_zero,
    neg := λ f, -f,
    add_left_neg := neg_add_self,
    add_comm := add_comm },
  add_comp' := add_comp,
  comp_add' := comp_add }

end

end

end category_theory.non_preadditive_abelian


/-
Copyright (c) 2018 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 set_theory.zfc.basic
! leanprover-community/mathlib commit 229f6f14a8b345d28ad17aaa1e9e79beb9e231da
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Lattice
import Mathbin.Logic.Small.Basic
import Mathbin.Order.WellFounded

/-!
# A model of ZFC

In this file, we model Zermelo-Fraenkel set theory (+ Choice) using Lean's underlying type theory.
We do this in four main steps:
* Define pre-sets inductively.
* Define extensional equivalence on pre-sets and give it a `setoid` instance.
* Define ZFC sets by quotienting pre-sets by extensional equivalence.
* Define classes as sets of ZFC sets.
Then the rest is usual set theory.

## The model

* `pSet`: Pre-set. A pre-set is inductively defined by its indexing type and its members, which are
  themselves pre-sets.
* `Set`: ZFC set. Defined as `pSet` quotiented by `pSet.equiv`, the extensional equivalence.
* `Class`: Class. Defined as `set Set`.
* `Set.choice`: Axiom of choice. Proved from Lean's axiom of choice.

## Other definitions

* `arity α n`: `n`-ary function `α → α → ... → α`. Defined inductively.
* `arity.const a n`: `n`-ary constant function equal to `a`.
* `pSet.type`: Underlying type of a pre-set.
* `pSet.func`: Underlying family of pre-sets of a pre-set.
* `pSet.equiv`: Extensional equivalence of pre-sets. Defined inductively.
* `pSet.omega`, `Set.omega`: The von Neumann ordinal `ω` as a `pSet`, as a `Set`.
* `pSet.arity.equiv`: Extensional equivalence of `n`-ary `pSet`-valued functions. Extension of
  `pSet.equiv`.
* `pSet.resp`: Collection of `n`-ary `pSet`-valued functions that respect extensional equivalence.
* `pSet.eval`: Turns a `pSet`-valued function that respect extensional equivalence into a
  `Set`-valued function.
* `classical.all_definable`: All functions are classically definable.
* `Set.is_func` : Predicate that a ZFC set is a subset of `x × y` that can be considered as a ZFC
  function `x → y`. That is, each member of `x` is related by the ZFC set to exactly one member of
  `y`.
* `Set.funs`: ZFC set of ZFC functions `x → y`.
* `Set.hereditarily p x`: Predicate that every set in the transitive closure of `x` has property
  `p`.
* `Class.iota`: Definite description operator.

## Notes

To avoid confusion between the Lean `set` and the ZFC `Set`, docstrings in this file refer to them
respectively as "`set`" and "ZFC set".

## TODO

Prove `Set.map_definable_aux` computably.
-/

universe u v

/-- The type of `n`-ary functions `α → α → ... → α`. -/
def Arity (α : Type u) : ℕ → Type u
  | 0 => α
  | n + 1 => α → Arity n
#align arity Arity

@[simp]
theorem arity_zero (α : Type u) : Arity α 0 = α :=
  rfl
#align arity_zero arity_zero

@[simp]
theorem arity_succ (α : Type u) (n : ℕ) : Arity α n.succ = (α → Arity α n) :=
  rfl
#align arity_succ arity_succ

namespace Arity

/-- Constant `n`-ary function with value `a`. -/
def const {α : Type u} (a : α) : ∀ n, Arity α n
  | 0 => a
  | n + 1 => fun _ => const n
#align arity.const Arity.const

@[simp]
theorem const_zero {α : Type u} (a : α) : const a 0 = a :=
  rfl
#align arity.const_zero Arity.const_zero

@[simp]
theorem const_succ {α : Type u} (a : α) (n : ℕ) : const a n.succ = fun _ => const a n :=
  rfl
#align arity.const_succ Arity.const_succ

theorem const_succ_apply {α : Type u} (a : α) (n : ℕ) (x : α) : const a n.succ x = const a n :=
  rfl
#align arity.const_succ_apply Arity.const_succ_apply

instance Arity.inhabited {α n} [Inhabited α] : Inhabited (Arity α n) :=
  ⟨const default _⟩
#align arity.arity.inhabited Arity.Arity.inhabited

end Arity

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

namespace PSet

/-- The underlying type of a pre-set -/
def Type : PSet → Type u
  | ⟨α, A⟩ => α
#align pSet.type PSet.Type

/-- The underlying pre-set family of a pre-set -/
def func : ∀ x : PSet, x.type → PSet
  | ⟨α, A⟩ => A
#align pSet.func PSet.func

@[simp]
theorem mk_type (α A) : Type ⟨α, A⟩ = α :=
  rfl
#align pSet.mk_type PSet.mk_type

@[simp]
theorem mk_func (α A) : func ⟨α, A⟩ = A :=
  rfl
#align pSet.mk_func PSet.mk_func

@[simp]
theorem eta : ∀ x : PSet, mk x.type x.func = x
  | ⟨α, A⟩ => rfl
#align pSet.eta PSet.eta

/-- Two pre-sets are extensionally equivalent if every element of the first family is extensionally
equivalent to some element of the second family and vice-versa. -/
def Equiv (x y : PSet) : Prop :=
  PSet.rec (fun α z m ⟨β, B⟩ => (∀ a, ∃ b, m a (B b)) ∧ ∀ b, ∃ a, m a (B b)) x y
#align pSet.equiv PSet.Equiv

theorem equiv_iff :
    ∀ {x y : PSet},
      Equiv x y ↔ (∀ i, ∃ j, Equiv (x.func i) (y.func j)) ∧ ∀ j, ∃ i, Equiv (x.func i) (y.func j)
  | ⟨α, A⟩, ⟨β, B⟩ => Iff.rfl
#align pSet.equiv_iff PSet.equiv_iff

theorem Equiv.exists_left {x y : PSet} (h : Equiv x y) : ∀ i, ∃ j, Equiv (x.func i) (y.func j) :=
  (equiv_iff.1 h).1
#align pSet.equiv.exists_left PSet.Equiv.exists_left

theorem Equiv.exists_right {x y : PSet} (h : Equiv x y) : ∀ j, ∃ i, Equiv (x.func i) (y.func j) :=
  (equiv_iff.1 h).2
#align pSet.equiv.exists_right PSet.Equiv.exists_right

@[refl]
protected theorem Equiv.refl (x) : Equiv x x :=
  PSet.recOn x fun α A IH => ⟨fun a => ⟨a, IH a⟩, fun a => ⟨a, IH a⟩⟩
#align pSet.equiv.refl PSet.Equiv.refl

protected theorem Equiv.rfl : ∀ {x}, Equiv x x :=
  Equiv.refl
#align pSet.equiv.rfl PSet.Equiv.rfl

protected theorem Equiv.euc {x} : ∀ {y z}, Equiv x y → Equiv z y → Equiv x z :=
  PSet.recOn x fun α A IH y =>
    PSet.casesOn y fun β B ⟨γ, Γ⟩ ⟨αβ, βα⟩ ⟨γβ, βγ⟩ =>
      ⟨fun a =>
        let ⟨b, ab⟩ := αβ a
        let ⟨c, bc⟩ := βγ b
        ⟨c, IH a ab bc⟩,
        fun c =>
        let ⟨b, cb⟩ := γβ c
        let ⟨a, ba⟩ := βα b
        ⟨a, IH a ba cb⟩⟩
#align pSet.equiv.euc PSet.Equiv.euc

@[symm]
protected theorem Equiv.symm {x y} : Equiv x y → Equiv y x :=
  (Equiv.refl y).euc
#align pSet.equiv.symm PSet.Equiv.symm

protected theorem Equiv.comm {x y} : Equiv x y ↔ Equiv y x :=
  ⟨Equiv.symm, Equiv.symm⟩
#align pSet.equiv.comm PSet.Equiv.comm

@[trans]
protected theorem Equiv.trans {x y z} (h1 : Equiv x y) (h2 : Equiv y z) : Equiv x z :=
  h1.euc h2.symm
#align pSet.equiv.trans PSet.Equiv.trans

protected theorem equiv_of_isEmpty (x y : PSet) [IsEmpty x.type] [IsEmpty y.type] : Equiv x y :=
  equiv_iff.2 <| by simp
#align pSet.equiv_of_is_empty PSet.equiv_of_isEmpty

instance setoid : Setoid PSet :=
  ⟨PSet.Equiv, Equiv.refl, fun x y => Equiv.symm, fun x y z => Equiv.trans⟩
#align pSet.setoid PSet.setoid

/-- A pre-set is a subset of another pre-set if every element of the first family is extensionally
equivalent to some element of the second family.-/
protected def Subset (x y : PSet) : Prop :=
  ∀ a, ∃ b, Equiv (x.func a) (y.func b)
#align pSet.subset PSet.Subset

instance : HasSubset PSet :=
  ⟨PSet.Subset⟩

instance : IsRefl PSet (· ⊆ ·) :=
  ⟨fun x a => ⟨a, Equiv.refl _⟩⟩

instance : IsTrans PSet (· ⊆ ·) :=
  ⟨fun x y z hxy hyz a => by
    cases' hxy a with b hb
    cases' hyz b with c hc
    exact ⟨c, hb.trans hc⟩⟩

theorem Equiv.ext : ∀ x y : PSet, Equiv x y ↔ x ⊆ y ∧ y ⊆ x
  | ⟨α, A⟩, ⟨β, B⟩ =>
    ⟨fun ⟨αβ, βα⟩ =>
      ⟨αβ, fun b =>
        let ⟨a, h⟩ := βα b
        ⟨a, Equiv.symm h⟩⟩,
      fun ⟨αβ, βα⟩ =>
      ⟨αβ, fun b =>
        let ⟨a, h⟩ := βα b
        ⟨a, Equiv.symm h⟩⟩⟩
#align pSet.equiv.ext PSet.Equiv.ext

theorem Subset.congr_left : ∀ {x y z : PSet}, Equiv x y → (x ⊆ z ↔ y ⊆ z)
  | ⟨α, A⟩, ⟨β, B⟩, ⟨γ, Γ⟩, ⟨αβ, βα⟩ =>
    ⟨fun αγ b =>
      let ⟨a, ba⟩ := βα b
      let ⟨c, ac⟩ := αγ a
      ⟨c, (Equiv.symm ba).trans ac⟩,
      fun βγ a =>
      let ⟨b, ab⟩ := αβ a
      let ⟨c, bc⟩ := βγ b
      ⟨c, Equiv.trans ab bc⟩⟩
#align pSet.subset.congr_left PSet.Subset.congr_left

theorem Subset.congr_right : ∀ {x y z : PSet}, Equiv x y → (z ⊆ x ↔ z ⊆ y)
  | ⟨α, A⟩, ⟨β, B⟩, ⟨γ, Γ⟩, ⟨αβ, βα⟩ =>
    ⟨fun γα c =>
      let ⟨a, ca⟩ := γα c
      let ⟨b, ab⟩ := αβ a
      ⟨b, ca.trans ab⟩,
      fun γβ c =>
      let ⟨b, cb⟩ := γβ c
      let ⟨a, ab⟩ := βα b
      ⟨a, cb.trans (Equiv.symm ab)⟩⟩
#align pSet.subset.congr_right PSet.Subset.congr_right

/-- `x ∈ y` as pre-sets if `x` is extensionally equivalent to a member of the family `y`. -/
protected def Mem (x y : PSet.{u}) : Prop :=
  ∃ b, Equiv x (y.func b)
#align pSet.mem PSet.Mem

instance : Membership PSet PSet :=
  ⟨PSet.Mem⟩

theorem Mem.mk {α : Type u} (A : α → PSet) (a : α) : A a ∈ mk α A :=
  ⟨a, Equiv.refl (A a)⟩
#align pSet.mem.mk PSet.Mem.mk

theorem func_mem (x : PSet) (i : x.type) : x.func i ∈ x :=
  by
  cases x
  apply mem.mk
#align pSet.func_mem PSet.func_mem

theorem Mem.ext : ∀ {x y : PSet.{u}}, (∀ w : PSet.{u}, w ∈ x ↔ w ∈ y) → Equiv x y
  | ⟨α, A⟩, ⟨β, B⟩, h =>
    ⟨fun a => (h (A a)).1 (Mem.mk A a), fun b =>
      let ⟨a, ha⟩ := (h (B b)).2 (Mem.mk B b)
      ⟨a, ha.symm⟩⟩
#align pSet.mem.ext PSet.Mem.ext

theorem Mem.congr_right : ∀ {x y : PSet.{u}}, Equiv x y → ∀ {w : PSet.{u}}, w ∈ x ↔ w ∈ y
  | ⟨α, A⟩, ⟨β, B⟩, ⟨αβ, βα⟩, w =>
    ⟨fun ⟨a, ha⟩ =>
      let ⟨b, hb⟩ := αβ a
      ⟨b, ha.trans hb⟩,
      fun ⟨b, hb⟩ =>
      let ⟨a, ha⟩ := βα b
      ⟨a, hb.euc ha⟩⟩
#align pSet.mem.congr_right PSet.Mem.congr_right

theorem equiv_iff_mem {x y : PSet.{u}} : Equiv x y ↔ ∀ {w : PSet.{u}}, w ∈ x ↔ w ∈ y :=
  ⟨Mem.congr_right,
    match x, y with
    | ⟨α, A⟩, ⟨β, B⟩, h =>
      ⟨fun a => h.1 (Mem.mk A a), fun b =>
        let ⟨a, h⟩ := h.2 (Mem.mk B b)
        ⟨a, h.symm⟩⟩⟩
#align pSet.equiv_iff_mem PSet.equiv_iff_mem

theorem Mem.congr_left : ∀ {x y : PSet.{u}}, Equiv x y → ∀ {w : PSet.{u}}, x ∈ w ↔ y ∈ w
  | x, y, h, ⟨α, A⟩ => ⟨fun ⟨a, ha⟩ => ⟨a, h.symm.trans ha⟩, fun ⟨a, ha⟩ => ⟨a, h.trans ha⟩⟩
#align pSet.mem.congr_left PSet.Mem.congr_left

private theorem mem_wf_aux : ∀ {x y : PSet.{u}}, Equiv x y → Acc (· ∈ ·) y
  | ⟨α, A⟩, ⟨β, B⟩, H =>
    ⟨_, by
      rintro ⟨γ, C⟩ ⟨b, hc⟩
      cases' H.exists_right b with a ha
      have H := ha.trans hc.symm
      rw [mk_func] at H
      exact mem_wf_aux H⟩
#align pSet.mem_wf_aux pSet.mem_wf_aux

theorem mem_wf : @WellFounded PSet (· ∈ ·) :=
  ⟨fun x => mem_wf_aux <| Equiv.refl x⟩
#align pSet.mem_wf PSet.mem_wf

instance : WellFoundedRelation PSet :=
  ⟨_, mem_wf⟩

instance : IsAsymm PSet (· ∈ ·) :=
  mem_wf.IsAsymm

theorem mem_asymm {x y : PSet} : x ∈ y → y ∉ x :=
  asymm
#align pSet.mem_asymm PSet.mem_asymm

theorem mem_irrefl (x : PSet) : x ∉ x :=
  irrefl x
#align pSet.mem_irrefl PSet.mem_irrefl

/-- Convert a pre-set to a `set` of pre-sets. -/
def toSet (u : PSet.{u}) : Set PSet.{u} :=
  { x | x ∈ u }
#align pSet.to_set PSet.toSet

@[simp]
theorem mem_toSet (a u : PSet.{u}) : a ∈ u.toSet ↔ a ∈ u :=
  Iff.rfl
#align pSet.mem_to_set PSet.mem_toSet

/-- A nonempty set is one that contains some element. -/
protected def Nonempty (u : PSet) : Prop :=
  u.toSet.Nonempty
#align pSet.nonempty PSet.Nonempty

theorem nonempty_def (u : PSet) : u.Nonempty ↔ ∃ x, x ∈ u :=
  Iff.rfl
#align pSet.nonempty_def PSet.nonempty_def

theorem nonempty_of_mem {x u : PSet} (h : x ∈ u) : u.Nonempty :=
  ⟨x, h⟩
#align pSet.nonempty_of_mem PSet.nonempty_of_mem

@[simp]
theorem nonempty_toSet_iff {u : PSet} : u.toSet.Nonempty ↔ u.Nonempty :=
  Iff.rfl
#align pSet.nonempty_to_set_iff PSet.nonempty_toSet_iff

theorem nonempty_type_iff_nonempty {x : PSet} : Nonempty x.type ↔ PSet.Nonempty x :=
  ⟨fun ⟨i⟩ => ⟨_, func_mem _ i⟩, fun ⟨i, j, h⟩ => ⟨j⟩⟩
#align pSet.nonempty_type_iff_nonempty PSet.nonempty_type_iff_nonempty

theorem nonempty_of_nonempty_type (x : PSet) [h : Nonempty x.type] : PSet.Nonempty x :=
  nonempty_type_iff_nonempty.1 h
#align pSet.nonempty_of_nonempty_type PSet.nonempty_of_nonempty_type

/-- Two pre-sets are equivalent iff they have the same members. -/
theorem Equiv.eq {x y : PSet} : Equiv x y ↔ toSet x = toSet y :=
  equiv_iff_mem.trans Set.ext_iff.symm
#align pSet.equiv.eq PSet.Equiv.eq

instance : Coe PSet (Set PSet) :=
  ⟨toSet⟩

/-- The empty pre-set -/
protected def empty : PSet :=
  ⟨_, PEmpty.elim⟩
#align pSet.empty PSet.empty

instance : EmptyCollection PSet :=
  ⟨PSet.empty⟩

instance : Inhabited PSet :=
  ⟨∅⟩

instance : IsEmpty (Type ∅) :=
  PEmpty.isEmpty

@[simp]
theorem not_mem_empty (x : PSet.{u}) : x ∉ (∅ : PSet.{u}) :=
  IsEmpty.exists_iff.1
#align pSet.not_mem_empty PSet.not_mem_empty

@[simp]
theorem toSet_empty : toSet ∅ = ∅ := by simp [to_set]
#align pSet.to_set_empty PSet.toSet_empty

@[simp]
theorem empty_subset (x : PSet.{u}) : (∅ : PSet) ⊆ x := fun x => x.elim
#align pSet.empty_subset PSet.empty_subset

@[simp]
theorem not_nonempty_empty : ¬PSet.Nonempty ∅ := by simp [PSet.Nonempty]
#align pSet.not_nonempty_empty PSet.not_nonempty_empty

protected theorem equiv_empty (x : PSet) [IsEmpty x.type] : Equiv x ∅ :=
  PSet.equiv_of_isEmpty x _
#align pSet.equiv_empty PSet.equiv_empty

/-- Insert an element into a pre-set -/
protected def insert (x y : PSet) : PSet :=
  ⟨Option y.type, fun o => Option.rec x y.func o⟩
#align pSet.insert PSet.insert

instance : Insert PSet PSet :=
  ⟨PSet.insert⟩

instance : Singleton PSet PSet :=
  ⟨fun s => insert s ∅⟩

instance : IsLawfulSingleton PSet PSet :=
  ⟨fun _ => rfl⟩

instance (x y : PSet) : Inhabited (insert x y).type :=
  Option.inhabited _

/-- The n-th von Neumann ordinal -/
def ofNat : ℕ → PSet
  | 0 => ∅
  | n + 1 => insert (of_nat n) (of_nat n)
#align pSet.of_nat PSet.ofNat

/-- The von Neumann ordinal ω -/
def omega : PSet :=
  ⟨ULift ℕ, fun n => ofNat n.down⟩
#align pSet.omega PSet.omega

/-- The pre-set separation operation `{x ∈ a | p x}` -/
protected def sep (p : PSet → Prop) (x : PSet) : PSet :=
  ⟨{ a // p (x.func a) }, fun y => x.func y.1⟩
#align pSet.sep PSet.sep

instance : Sep PSet PSet :=
  ⟨PSet.sep⟩

/-- The pre-set powerset operator -/
def powerset (x : PSet) : PSet :=
  ⟨Set x.type, fun p => ⟨{ a // p a }, fun y => x.func y.1⟩⟩
#align pSet.powerset PSet.powerset

@[simp]
theorem mem_powerset : ∀ {x y : PSet}, y ∈ powerset x ↔ y ⊆ x
  | ⟨α, A⟩, ⟨β, B⟩ =>
    ⟨fun ⟨p, e⟩ => (Subset.congr_left e).2 fun ⟨a, pa⟩ => ⟨a, Equiv.refl (A a)⟩, fun βα =>
      ⟨{ a | ∃ b, Equiv (B b) (A a) }, fun b =>
        let ⟨a, ba⟩ := βα b
        ⟨⟨a, b, ba⟩, ba⟩,
        fun ⟨a, b, ba⟩ => ⟨b, ba⟩⟩⟩
#align pSet.mem_powerset PSet.mem_powerset

/-- The pre-set union operator -/
def sUnion (a : PSet) : PSet :=
  ⟨Σx, (a.func x).type, fun ⟨x, y⟩ => (a.func x).func y⟩
#align pSet.sUnion PSet.sUnion

-- mathport name: pSet.sUnion
prefix:110 "⋃₀ " => PSet.sUnion

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem mem_sUnion : ∀ {x y : PSet.{u}}, y ∈ ⋃₀ x ↔ ∃ z ∈ x, y ∈ z
  | ⟨α, A⟩, y =>
    ⟨fun ⟨⟨a, c⟩, (e : Equiv y ((A a).func c))⟩ =>
      have : func (A a) c ∈ mk (A a).type (A a).func := Mem.mk (A a).func c
      ⟨_, Mem.mk _ _, (Mem.congr_left e).2 (by rwa [eta] at this)⟩,
      fun ⟨⟨β, B⟩, ⟨a, (e : Equiv (mk β B) (A a))⟩, ⟨b, yb⟩⟩ =>
      by
      rw [← eta (A a)] at e
      exact
        let ⟨βt, tβ⟩ := e
        let ⟨c, bc⟩ := βt b
        ⟨⟨a, c⟩, yb.trans bc⟩⟩
#align pSet.mem_sUnion PSet.mem_sUnion

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem toSet_sUnion (x : PSet.{u}) : (⋃₀ x).toSet = ⋃₀ (toSet '' x.toSet) :=
  by
  ext
  simp
#align pSet.to_set_sUnion PSet.toSet_sUnion

/-- The image of a function from pre-sets to pre-sets. -/
def image (f : PSet.{u} → PSet.{u}) (x : PSet.{u}) : PSet :=
  ⟨x.type, f ∘ x.func⟩
#align pSet.image PSet.image

theorem mem_image {f : PSet.{u} → PSet.{u}} (H : ∀ {x y}, Equiv x y → Equiv (f x) (f y)) :
    ∀ {x y : PSet.{u}}, y ∈ image f x ↔ ∃ z ∈ x, Equiv y (f z)
  | ⟨α, A⟩, y =>
    ⟨fun ⟨a, ya⟩ => ⟨A a, Mem.mk A a, ya⟩, fun ⟨z, ⟨a, za⟩, yz⟩ => ⟨a, yz.trans (H za)⟩⟩
#align pSet.mem_image PSet.mem_image

/-- Universe lift operation -/
protected def lift : PSet.{u} → PSet.{max u v}
  | ⟨α, A⟩ => ⟨ULift α, fun ⟨x⟩ => lift (A x)⟩
#align pSet.lift PSet.lift

-- intended to be used with explicit universe parameters
/-- Embedding of one universe in another -/
@[nolint check_univs]
def embed : PSet.{max (u + 1) v} :=
  ⟨ULift.{v, u + 1} PSet, fun ⟨x⟩ => PSet.lift.{u, max (u + 1) v} x⟩
#align pSet.embed PSet.embed

theorem lift_mem_embed : ∀ x : PSet.{u}, PSet.lift.{u, max (u + 1) v} x ∈ embed.{u, v} := fun x =>
  ⟨⟨x⟩, Equiv.rfl⟩
#align pSet.lift_mem_embed PSet.lift_mem_embed

/-- Function equivalence is defined so that `f ~ g` iff `∀ x y, x ~ y → f x ~ g y`. This extends to
equivalence of `n`-ary functions. -/
def Arity.Equiv : ∀ {n}, Arity PSet.{u} n → Arity PSet.{u} n → Prop
  | 0, a, b => Equiv a b
  | n + 1, a, b => ∀ x y, Equiv x y → arity.equiv (a x) (b y)
#align pSet.arity.equiv PSet.Arity.Equiv

theorem Arity.equiv_const {a : PSet.{u}} : ∀ n, Arity.Equiv (Arity.const a n) (Arity.const a n)
  | 0 => Equiv.rfl
  | n + 1 => fun x y h => arity.equiv_const _
#align pSet.arity.equiv_const PSet.Arity.equiv_const

/-- `resp n` is the collection of n-ary functions on `pSet` that respect
  equivalence, i.e. when the inputs are equivalent the output is as well. -/
def Resp (n) :=
  { x : Arity PSet.{u} n // Arity.Equiv x x }
#align pSet.resp PSet.Resp

instance Resp.inhabited {n} : Inhabited (Resp n) :=
  ⟨⟨Arity.const default _, Arity.equiv_const _⟩⟩
#align pSet.resp.inhabited PSet.Resp.inhabited

/-- The `n`-ary image of a `(n + 1)`-ary function respecting equivalence as a function respecting
equivalence. -/
def Resp.f {n} (f : Resp (n + 1)) (x : PSet) : Resp n :=
  ⟨f.1 x, f.2 _ _ <| Equiv.refl x⟩
#align pSet.resp.f PSet.Resp.f

/-- Function equivalence for functions respecting equivalence. See `pSet.arity.equiv`. -/
def Resp.Equiv {n} (a b : Resp n) : Prop :=
  Arity.Equiv a.1 b.1
#align pSet.resp.equiv PSet.Resp.Equiv

protected theorem Resp.Equiv.refl {n} (a : Resp n) : Resp.Equiv a a :=
  a.2
#align pSet.resp.equiv.refl PSet.Resp.Equiv.refl

protected theorem Resp.Equiv.euc :
    ∀ {n} {a b c : Resp n}, Resp.Equiv a b → Resp.Equiv c b → Resp.Equiv a c
  | 0, a, b, c, hab, hcb => Equiv.euc hab hcb
  | n + 1, a, b, c, hab, hcb => fun x y h =>
    @resp.equiv.euc n (a.f x) (b.f y) (c.f y) (hab _ _ h) (hcb _ _ <| Equiv.refl y)
#align pSet.resp.equiv.euc PSet.Resp.Equiv.euc

protected theorem Resp.Equiv.symm {n} {a b : Resp n} : Resp.Equiv a b → Resp.Equiv b a :=
  (Resp.Equiv.refl b).euc
#align pSet.resp.equiv.symm PSet.Resp.Equiv.symm

protected theorem Resp.Equiv.trans {n} {x y z : Resp n} (h1 : Resp.Equiv x y)
    (h2 : Resp.Equiv y z) : Resp.Equiv x z :=
  h1.euc h2.symm
#align pSet.resp.equiv.trans PSet.Resp.Equiv.trans

instance Resp.setoid {n} : Setoid (Resp n) :=
  ⟨Resp.Equiv, Resp.Equiv.refl, fun x y => Resp.Equiv.symm, fun x y z => Resp.Equiv.trans⟩
#align pSet.resp.setoid PSet.Resp.setoid

end PSet

/-- The ZFC universe of sets consists of the type of pre-sets,
  quotiented by extensional equivalence. -/
def SetCat : Type (u + 1) :=
  Quotient PSet.setoid.{u}
#align Set SetCat

namespace PSet

namespace Resp

/-- Helper function for `pSet.eval`. -/
def evalAux :
    ∀ {n}, { f : Resp n → Arity SetCat.{u} n // ∀ a b : Resp n, Resp.Equiv a b → f a = f b }
  | 0 => ⟨fun a => ⟦a.1⟧, fun a b h => Quotient.sound h⟩
  | n + 1 =>
    let F : Resp (n + 1) → Arity SetCat (n + 1) := fun a =>
      @Quotient.lift _ _ PSet.setoid (fun x => eval_aux.1 (a.f x)) fun b c h =>
        eval_aux.2 _ _ (a.2 _ _ h)
    ⟨F, fun b c h =>
      funext <|
        @Quotient.ind _ _ (fun q => F b q = F c q) fun z =>
          eval_aux.2 (Resp.f b z) (Resp.f c z) (h _ _ (PSet.Equiv.refl z))⟩
#align pSet.resp.eval_aux PSet.Resp.evalAux

/-- An equivalence-respecting function yields an n-ary ZFC set function. -/
def eval (n) : Resp n → Arity SetCat.{u} n :=
  evalAux.1
#align pSet.resp.eval PSet.Resp.eval

theorem eval_val {n f x} : (@eval (n + 1) f : SetCat → Arity SetCat n) ⟦x⟧ = eval n (Resp.f f x) :=
  rfl
#align pSet.resp.eval_val PSet.Resp.eval_val

end Resp

/-- A set function is "definable" if it is the image of some n-ary pre-set
  function. This isn't exactly definability, but is useful as a sufficient
  condition for functions that have a computable image. -/
class inductive Definable (n) : Arity SetCat.{u} n → Type (u + 1)
  | mk (f) : definable (Resp.eval n f)
#align pSet.definable PSet.Definable

attribute [instance] definable.mk

/-- The evaluation of a function respecting equivalence is definable, by that same function. -/
def Definable.eqMk {n} (f) : ∀ {s : Arity SetCat.{u} n} (H : Resp.eval _ f = s), Definable n s
  | _, rfl => ⟨f⟩
#align pSet.definable.eq_mk PSet.Definable.eqMk

/-- Turns a definable function into a function that respects equivalence. -/
def Definable.resp {n} : ∀ (s : Arity SetCat.{u} n) [Definable n s], Resp n
  | _, ⟨f⟩ => f
#align pSet.definable.resp PSet.Definable.resp

theorem Definable.eq {n} :
    ∀ (s : Arity SetCat.{u} n) [H : Definable n s], (@Definable.resp n s H).eval _ = s
  | _, ⟨f⟩ => rfl
#align pSet.definable.eq PSet.Definable.eq

end PSet

namespace Classical

open PSet

/-- All functions are classically definable. -/
noncomputable def allDefinable : ∀ {n} (F : Arity SetCat.{u} n), Definable n F
  | 0, F =>
    let p := @Quotient.exists_rep PSet _ F
    Definable.eqMk ⟨choose p, Equiv.rfl⟩ (choose_spec p)
  | n + 1, (F : Arity SetCat.{u} (n + 1)) =>
    by
    have I := fun x => all_definable (F x)
    refine' definable.eq_mk ⟨fun x : PSet => (@definable.resp _ _ (I ⟦x⟧)).1, _⟩ _
    · dsimp [arity.equiv]
      intro x y h
      rw [@Quotient.sound PSet _ _ _ h]
      exact (definable.resp (F ⟦y⟧)).2
    refine' funext fun q => Quotient.inductionOn q fun x => _
    simp_rw [resp.eval_val, resp.f, Subtype.val_eq_coe, Subtype.coe_eta]
    exact @definable.eq _ (F ⟦x⟧) (I ⟦x⟧)
#align classical.all_definable Classical.allDefinable

end Classical

namespace SetCat

open PSet

/-- Turns a pre-set into a ZFC set. -/
def mk : PSet → SetCat :=
  Quotient.mk'
#align Set.mk SetCat.mk

@[simp]
theorem mk'_eq (x : PSet) : @Eq SetCat ⟦x⟧ (mk x) :=
  rfl
#align Set.mk_eq SetCat.mk'_eq

@[simp]
theorem mk_out : ∀ x : SetCat, mk x.out = x :=
  Quotient.out_eq
#align Set.mk_out SetCat.mk_out

theorem eq {x y : PSet} : mk x = mk y ↔ Equiv x y :=
  Quotient.eq'
#align Set.eq SetCat.eq

theorem sound {x y : PSet} (h : PSet.Equiv x y) : mk x = mk y :=
  Quotient.sound h
#align Set.sound SetCat.sound

theorem exact {x y : PSet} : mk x = mk y → PSet.Equiv x y :=
  Quotient.exact
#align Set.exact SetCat.exact

@[simp]
theorem eval_mk {n f x} :
    (@Resp.eval (n + 1) f : SetCat → Arity SetCat n) (mk x) = Resp.eval n (Resp.f f x) :=
  rfl
#align Set.eval_mk SetCat.eval_mk

/-- The membership relation for ZFC sets is inherited from the membership relation for pre-sets. -/
protected def Mem : SetCat → SetCat → Prop :=
  Quotient.lift₂ PSet.Mem fun x y x' y' hx hy =>
    propext ((Mem.congr_left hx).trans (Mem.congr_right hy))
#align Set.mem SetCat.Mem

instance : Membership SetCat SetCat :=
  ⟨SetCat.Mem⟩

@[simp]
theorem mk_mem_iff {x y : PSet} : mk x ∈ mk y ↔ x ∈ y :=
  Iff.rfl
#align Set.mk_mem_iff SetCat.mk_mem_iff

/-- Convert a ZFC set into a `set` of ZFC sets -/
def toSet (u : SetCat.{u}) : Set SetCat.{u} :=
  { x | x ∈ u }
#align Set.to_set SetCat.toSet

@[simp]
theorem mem_toSet (a u : SetCat.{u}) : a ∈ u.toSet ↔ a ∈ u :=
  Iff.rfl
#align Set.mem_to_set SetCat.mem_toSet

instance small_toSet (x : SetCat.{u}) : Small.{u} x.toSet :=
  Quotient.inductionOn x fun a =>
    by
    let f : a.type → (mk a).toSet := fun i => ⟨mk <| a.func i, func_mem a i⟩
    suffices Function.Surjective f by exact small_of_surjective this
    rintro ⟨y, hb⟩
    induction y using Quotient.inductionOn
    cases' hb with i h
    exact ⟨i, Subtype.coe_injective (Quotient.sound h.symm)⟩
#align Set.small_to_set SetCat.small_toSet

/-- A nonempty set is one that contains some element. -/
protected def Nonempty (u : SetCat) : Prop :=
  u.toSet.Nonempty
#align Set.nonempty SetCat.Nonempty

theorem nonempty_def (u : SetCat) : u.Nonempty ↔ ∃ x, x ∈ u :=
  Iff.rfl
#align Set.nonempty_def SetCat.nonempty_def

theorem nonempty_of_mem {x u : SetCat} (h : x ∈ u) : u.Nonempty :=
  ⟨x, h⟩
#align Set.nonempty_of_mem SetCat.nonempty_of_mem

@[simp]
theorem nonempty_toSet_iff {u : SetCat} : u.toSet.Nonempty ↔ u.Nonempty :=
  Iff.rfl
#align Set.nonempty_to_set_iff SetCat.nonempty_toSet_iff

/-- `x ⊆ y` as ZFC sets means that all members of `x` are members of `y`. -/
protected def Subset (x y : SetCat.{u}) :=
  ∀ ⦃z⦄, z ∈ x → z ∈ y
#align Set.subset SetCat.Subset

instance hasSubset : HasSubset SetCat :=
  ⟨SetCat.Subset⟩
#align Set.has_subset SetCat.hasSubset

theorem subset_def {x y : SetCat.{u}} : x ⊆ y ↔ ∀ ⦃z⦄, z ∈ x → z ∈ y :=
  Iff.rfl
#align Set.subset_def SetCat.subset_def

instance : IsRefl SetCat (· ⊆ ·) :=
  ⟨fun x a => id⟩

instance : IsTrans SetCat (· ⊆ ·) :=
  ⟨fun x y z hxy hyz a ha => hyz (hxy ha)⟩

@[simp]
theorem subset_iff : ∀ {x y : PSet}, mk x ⊆ mk y ↔ x ⊆ y
  | ⟨α, A⟩, ⟨β, B⟩ =>
    ⟨fun h a => @h ⟦A a⟧ (Mem.mk A a), fun h z =>
      Quotient.inductionOn z fun z ⟨a, za⟩ =>
        let ⟨b, ab⟩ := h a
        ⟨b, za.trans ab⟩⟩
#align Set.subset_iff SetCat.subset_iff

@[simp]
theorem toSet_subset_iff {x y : SetCat} : x.toSet ⊆ y.toSet ↔ x ⊆ y := by
  simp [subset_def, Set.subset_def]
#align Set.to_set_subset_iff SetCat.toSet_subset_iff

@[ext]
theorem ext {x y : SetCat.{u}} : (∀ z : SetCat.{u}, z ∈ x ↔ z ∈ y) → x = y :=
  Quotient.induction_on₂ x y fun u v h => Quotient.sound (Mem.ext fun w => h ⟦w⟧)
#align Set.ext SetCat.ext

theorem ext_iff {x y : SetCat.{u}} : x = y ↔ ∀ z : SetCat.{u}, z ∈ x ↔ z ∈ y :=
  ⟨fun h => by simp [h], ext⟩
#align Set.ext_iff SetCat.ext_iff

theorem toSet_injective : Function.Injective toSet := fun x y h => ext <| Set.ext_iff.1 h
#align Set.to_set_injective SetCat.toSet_injective

@[simp]
theorem toSet_inj {x y : SetCat} : x.toSet = y.toSet ↔ x = y :=
  toSet_injective.eq_iff
#align Set.to_set_inj SetCat.toSet_inj

instance : IsAntisymm SetCat (· ⊆ ·) :=
  ⟨fun a b hab hba => ext fun c => ⟨@hab c, @hba c⟩⟩

/-- The empty ZFC set -/
protected def empty : SetCat :=
  mk ∅
#align Set.empty SetCat.empty

instance : EmptyCollection SetCat :=
  ⟨SetCat.empty⟩

instance : Inhabited SetCat :=
  ⟨∅⟩

@[simp]
theorem not_mem_empty (x) : x ∉ (∅ : SetCat.{u}) :=
  Quotient.inductionOn x PSet.not_mem_empty
#align Set.not_mem_empty SetCat.not_mem_empty

@[simp]
theorem toSet_empty : toSet ∅ = ∅ := by simp [to_set]
#align Set.to_set_empty SetCat.toSet_empty

@[simp]
theorem empty_subset (x : SetCat.{u}) : (∅ : SetCat) ⊆ x :=
  Quotient.inductionOn x fun y => subset_iff.2 <| PSet.empty_subset y
#align Set.empty_subset SetCat.empty_subset

@[simp]
theorem not_nonempty_empty : ¬SetCat.Nonempty ∅ := by simp [SetCat.Nonempty]
#align Set.not_nonempty_empty SetCat.not_nonempty_empty

@[simp]
theorem nonempty_mk_iff {x : PSet} : (mk x).Nonempty ↔ x.Nonempty :=
  by
  refine' ⟨_, fun ⟨a, h⟩ => ⟨mk a, h⟩⟩
  rintro ⟨a, h⟩
  induction a using Quotient.inductionOn
  exact ⟨a, h⟩
#align Set.nonempty_mk_iff SetCat.nonempty_mk_iff

theorem eq_empty (x : SetCat.{u}) : x = ∅ ↔ ∀ y : SetCat.{u}, y ∉ x :=
  by
  rw [ext_iff]
  simp
#align Set.eq_empty SetCat.eq_empty

theorem eq_empty_or_nonempty (u : SetCat) : u = ∅ ∨ u.Nonempty :=
  by
  rw [eq_empty, ← not_exists]
  apply em'
#align Set.eq_empty_or_nonempty SetCat.eq_empty_or_nonempty

/-- `insert x y` is the set `{x} ∪ y` -/
protected def insert : SetCat → SetCat → SetCat :=
  Resp.eval 2
    ⟨PSet.insert, fun u v uv ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩ =>
      ⟨fun o =>
        match o with
        | some a =>
          let ⟨b, hb⟩ := αβ a
          ⟨some b, hb⟩
        | none => ⟨none, uv⟩,
        fun o =>
        match o with
        | some b =>
          let ⟨a, ha⟩ := βα b
          ⟨some a, ha⟩
        | none => ⟨none, uv⟩⟩⟩
#align Set.insert SetCat.insert

instance : Insert SetCat SetCat :=
  ⟨SetCat.insert⟩

instance : Singleton SetCat SetCat :=
  ⟨fun x => insert x ∅⟩

instance : IsLawfulSingleton SetCat SetCat :=
  ⟨fun x => rfl⟩

@[simp]
theorem mem_insert_iff {x y z : SetCat.{u}} : x ∈ insert y z ↔ x = y ∨ x ∈ z :=
  Quotient.induction_on₃ x y z fun x y ⟨α, A⟩ =>
    show (x ∈ PSet.mk (Option α) fun o => Option.rec y A o) ↔ mk x = mk y ∨ x ∈ PSet.mk α A from
      ⟨fun m =>
        match m with
        | ⟨some a, ha⟩ => Or.inr ⟨a, ha⟩
        | ⟨none, h⟩ => Or.inl (Quotient.sound h),
        fun m =>
        match m with
        | Or.inr ⟨a, ha⟩ => ⟨some a, ha⟩
        | Or.inl h => ⟨none, Quotient.exact h⟩⟩
#align Set.mem_insert_iff SetCat.mem_insert_iff

theorem mem_insert (x y : SetCat) : x ∈ insert x y :=
  mem_insert_iff.2 <| Or.inl rfl
#align Set.mem_insert SetCat.mem_insert

theorem mem_insert_of_mem {y z : SetCat} (x) (h : z ∈ y) : z ∈ insert x y :=
  mem_insert_iff.2 <| Or.inr h
#align Set.mem_insert_of_mem SetCat.mem_insert_of_mem

@[simp]
theorem toSet_insert (x y : SetCat) : (insert x y).toSet = insert x y.toSet :=
  by
  ext
  simp
#align Set.to_set_insert SetCat.toSet_insert

@[simp]
theorem mem_singleton {x y : SetCat.{u}} : x ∈ @singleton SetCat.{u} SetCat.{u} _ y ↔ x = y :=
  Iff.trans mem_insert_iff
    ⟨fun o => Or.ndrec (fun h => h) (fun n => absurd n (not_mem_empty _)) o, Or.inl⟩
#align Set.mem_singleton SetCat.mem_singleton

@[simp]
theorem toSet_singleton (x : SetCat) : ({x} : SetCat).toSet = {x} :=
  by
  ext
  simp
#align Set.to_set_singleton SetCat.toSet_singleton

theorem insert_nonempty (u v : SetCat) : (insert u v).Nonempty :=
  ⟨u, mem_insert u v⟩
#align Set.insert_nonempty SetCat.insert_nonempty

theorem singleton_nonempty (u : SetCat) : SetCat.Nonempty {u} :=
  insert_nonempty u ∅
#align Set.singleton_nonempty SetCat.singleton_nonempty

@[simp]
theorem mem_pair {x y z : SetCat.{u}} : x ∈ ({y, z} : SetCat) ↔ x = y ∨ x = z :=
  Iff.trans mem_insert_iff <| or_congr Iff.rfl mem_singleton
#align Set.mem_pair SetCat.mem_pair

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

@[simp]
theorem omega_zero : ∅ ∈ omega :=
  ⟨⟨0⟩, Equiv.rfl⟩
#align Set.omega_zero SetCat.omega_zero

@[simp]
theorem omega_succ {n} : n ∈ omega.{u} → insert n n ∈ omega.{u} :=
  Quotient.inductionOn n fun x ⟨⟨n⟩, h⟩ =>
    ⟨⟨n + 1⟩,
      SetCat.exact <|
        show insert (mk x) (mk x) = insert (mk <| ofNat n) (mk <| ofNat n) by rw [SetCat.sound h];
          rfl⟩
#align Set.omega_succ SetCat.omega_succ

/-- `{x ∈ a | p x}` is the set of elements in `a` satisfying `p` -/
protected def sep (p : SetCat → Prop) : SetCat → SetCat :=
  Resp.eval 1
    ⟨PSet.sep fun y => p (mk y), fun ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩ =>
      ⟨fun ⟨a, pa⟩ =>
        let ⟨b, hb⟩ := αβ a
        ⟨⟨b, by rwa [mk_func, ← SetCat.sound hb]⟩, hb⟩,
        fun ⟨b, pb⟩ =>
        let ⟨a, ha⟩ := βα b
        ⟨⟨a, by rwa [mk_func, SetCat.sound ha]⟩, ha⟩⟩⟩
#align Set.sep SetCat.sep

instance : Sep SetCat SetCat :=
  ⟨SetCat.sep⟩

@[simp]
theorem mem_sep {p : SetCat.{u} → Prop} {x y : SetCat.{u}} : y ∈ { y ∈ x | p y } ↔ y ∈ x ∧ p y :=
  Quotient.induction_on₂ x y fun ⟨α, A⟩ y =>
    ⟨fun ⟨⟨a, pa⟩, h⟩ => ⟨⟨a, h⟩, by rwa [@Quotient.sound PSet _ _ _ h]⟩, fun ⟨⟨a, h⟩, pa⟩ =>
      ⟨⟨a, by
          rw [mk_func] at h
          rwa [mk_func, ← SetCat.sound h]⟩,
        h⟩⟩
#align Set.mem_sep SetCat.mem_sep

@[simp]
theorem toSet_sep (a : SetCat) (p : SetCat → Prop) :
    { x ∈ a | p x }.toSet = { x ∈ a.toSet | p x } :=
  by
  ext
  simp
#align Set.to_set_sep SetCat.toSet_sep

/-- The powerset operation, the collection of subsets of a ZFC set -/
def powerset : SetCat → SetCat :=
  Resp.eval 1
    ⟨powerset, fun ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩ =>
      ⟨fun p =>
        ⟨{ b | ∃ a, p a ∧ Equiv (A a) (B b) }, fun ⟨a, pa⟩ =>
          let ⟨b, ab⟩ := αβ a
          ⟨⟨b, a, pa, ab⟩, ab⟩,
          fun ⟨b, a, pa, ab⟩ => ⟨⟨a, pa⟩, ab⟩⟩,
        fun q =>
        ⟨{ a | ∃ b, q b ∧ Equiv (A a) (B b) }, fun ⟨a, b, qb, ab⟩ => ⟨⟨b, qb⟩, ab⟩, fun ⟨b, qb⟩ =>
          let ⟨a, ab⟩ := βα b
          ⟨⟨a, b, qb, ab⟩, ab⟩⟩⟩⟩
#align Set.powerset SetCat.powerset

@[simp]
theorem mem_powerset {x y : SetCat.{u}} : y ∈ powerset x ↔ y ⊆ x :=
  Quotient.induction_on₂ x y fun ⟨α, A⟩ ⟨β, B⟩ =>
    show (⟨β, B⟩ : PSet.{u}) ∈ PSet.powerset.{u} ⟨α, A⟩ ↔ _ by simp [mem_powerset, subset_iff]
#align Set.mem_powerset SetCat.mem_powerset

theorem sUnion_lem {α β : Type u} (A : α → PSet) (B : β → PSet) (αβ : ∀ a, ∃ b, Equiv (A a) (B b)) :
    ∀ a, ∃ b, Equiv ((sUnion ⟨α, A⟩).func a) ((sUnion ⟨β, B⟩).func b)
  | ⟨a, c⟩ => by
    let ⟨b, hb⟩ := αβ a
    induction' ea : A a with γ Γ
    induction' eb : B b with δ Δ
    rw [ea, eb] at hb
    cases' hb with γδ δγ
    exact
      let c : type (A a) := c
      let ⟨d, hd⟩ := γδ (by rwa [ea] at c)
      have : PSet.Equiv ((A a).func c) ((B b).func (Eq.ndrec d (Eq.symm eb))) :=
        match A a, B b, ea, eb, c, d, hd with
        | _, _, rfl, rfl, x, y, hd => hd
      ⟨⟨b, by
          rw [mk_func]
          exact Eq.ndrec d (Eq.symm eb)⟩,
        this⟩
#align Set.sUnion_lem SetCat.sUnion_lem

/-- The union operator, the collection of elements of elements of a ZFC set -/
def sUnion : SetCat → SetCat :=
  Resp.eval 1
    ⟨PSet.sUnion, fun ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩ =>
      ⟨sUnion_lem A B αβ, fun a =>
        Exists.elim
          (sUnion_lem B A (fun b => Exists.elim (βα b) fun c hc => ⟨c, PSet.Equiv.symm hc⟩) a)
          fun b hb => ⟨b, PSet.Equiv.symm hb⟩⟩⟩
#align Set.sUnion SetCat.sUnion

-- mathport name: Set.sUnion
prefix:110 "⋃₀ " => SetCat.sUnion

/-- The intersection operator, the collection of elements in all of the elements of a ZFC set. We
special-case `⋂₀ ∅ = ∅`. -/
noncomputable def sInter (x : SetCat) : SetCat := by
  classical exact dite x.nonempty (fun h => { y ∈ h.some | ∀ z ∈ x, y ∈ z }) fun _ => ∅
#align Set.sInter SetCat.sInter

-- mathport name: Set.sInter
prefix:110 "⋂₀ " => SetCat.sInter

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem mem_sUnion {x y : SetCat.{u}} : y ∈ ⋃₀ x ↔ ∃ z ∈ x, y ∈ z :=
  Quotient.induction_on₂ x y fun x y =>
    Iff.trans mem_sUnion
      ⟨fun ⟨z, h⟩ => ⟨⟦z⟧, h⟩, fun ⟨z, h⟩ => Quotient.inductionOn z (fun z h => ⟨z, h⟩) h⟩
#align Set.mem_sUnion SetCat.mem_sUnion

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem mem_sInter {x y : SetCat} (h : x.Nonempty) : y ∈ ⋂₀ x ↔ ∀ z ∈ x, y ∈ z :=
  by
  rw [sInter, dif_pos h]
  simp only [mem_to_set, mem_sep, and_iff_right_iff_imp]
  exact fun H => H _ h.some_mem
#align Set.mem_sInter SetCat.mem_sInter

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sUnion_empty : ⋃₀ (∅ : SetCat) = ∅ := by
  ext
  simp
#align Set.sUnion_empty SetCat.sUnion_empty

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sInter_empty : ⋂₀ (∅ : SetCat) = ∅ :=
  dif_neg <| by simp
#align Set.sInter_empty SetCat.sInter_empty

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem mem_of_mem_sInter {x y z : SetCat} (hy : y ∈ ⋂₀ x) (hz : z ∈ x) : y ∈ z :=
  by
  rcases eq_empty_or_nonempty x with (rfl | hx)
  · exact (not_mem_empty z hz).elim
  · exact (mem_sInter hx).1 hy z hz
#align Set.mem_of_mem_sInter SetCat.mem_of_mem_sInter

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem mem_sUnion_of_mem {x y z : SetCat} (hy : y ∈ z) (hz : z ∈ x) : y ∈ ⋃₀ x :=
  mem_sUnion.2 ⟨z, hz, hy⟩
#align Set.mem_sUnion_of_mem SetCat.mem_sUnion_of_mem

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem not_mem_sInter_of_not_mem {x y z : SetCat} (hy : ¬y ∈ z) (hz : z ∈ x) : ¬y ∈ ⋂₀ x :=
  fun hx => hy <| mem_of_mem_sInter hx hz
#align Set.not_mem_sInter_of_not_mem SetCat.not_mem_sInter_of_not_mem

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sUnion_singleton {x : SetCat.{u}} : ⋃₀ ({x} : SetCat) = x :=
  ext fun y => by simp_rw [mem_sUnion, exists_prop, mem_singleton, exists_eq_left]
#align Set.sUnion_singleton SetCat.sUnion_singleton

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sInter_singleton {x : SetCat.{u}} : ⋂₀ ({x} : SetCat) = x :=
  ext fun y => by simp_rw [mem_sInter (singleton_nonempty x), mem_singleton, forall_eq]
#align Set.sInter_singleton SetCat.sInter_singleton

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem toSet_sUnion (x : SetCat.{u}) : (⋃₀ x).toSet = ⋃₀ (toSet '' x.toSet) :=
  by
  ext
  simp
#align Set.to_set_sUnion SetCat.toSet_sUnion

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem toSet_sInter {x : SetCat.{u}} (h : x.Nonempty) : (⋂₀ x).toSet = ⋂₀ (toSet '' x.toSet) :=
  by
  ext
  simp [mem_sInter h]
#align Set.to_set_sInter SetCat.toSet_sInter

theorem singleton_injective : Function.Injective (@singleton SetCat SetCat _) := fun x y H =>
  by
  let this := congr_arg sUnion H
  rwa [sUnion_singleton, sUnion_singleton] at this
#align Set.singleton_injective SetCat.singleton_injective

@[simp]
theorem singleton_inj {x y : SetCat} : ({x} : SetCat) = {y} ↔ x = y :=
  singleton_injective.eq_iff
#align Set.singleton_inj SetCat.singleton_inj

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The binary union operation -/
protected def union (x y : SetCat.{u}) : SetCat.{u} :=
  ⋃₀ {x, y}
#align Set.union SetCat.union

/-- The binary intersection operation -/
protected def inter (x y : SetCat.{u}) : SetCat.{u} :=
  { z ∈ x | z ∈ y }
#align Set.inter SetCat.inter

/-- The set difference operation -/
protected def diff (x y : SetCat.{u}) : SetCat.{u} :=
  { z ∈ x | z ∉ y }
#align Set.diff SetCat.diff

instance : Union SetCat :=
  ⟨SetCat.union⟩

instance : Inter SetCat :=
  ⟨SetCat.inter⟩

instance : SDiff SetCat :=
  ⟨SetCat.diff⟩

@[simp]
theorem toSet_union (x y : SetCat.{u}) : (x ∪ y).toSet = x.toSet ∪ y.toSet :=
  by
  unfold Union.union
  rw [SetCat.union]
  simp
#align Set.to_set_union SetCat.toSet_union

@[simp]
theorem toSet_inter (x y : SetCat.{u}) : (x ∩ y).toSet = x.toSet ∩ y.toSet :=
  by
  unfold Inter.inter
  rw [SetCat.inter]
  ext
  simp
#align Set.to_set_inter SetCat.toSet_inter

@[simp]
theorem toSet_sdiff (x y : SetCat.{u}) : (x \ y).toSet = x.toSet \ y.toSet :=
  by
  change { z ∈ x | z ∉ y }.toSet = _
  ext
  simp
#align Set.to_set_sdiff SetCat.toSet_sdiff

@[simp]
theorem mem_union {x y z : SetCat.{u}} : z ∈ x ∪ y ↔ z ∈ x ∨ z ∈ y :=
  by
  rw [← mem_to_set]
  simp
#align Set.mem_union SetCat.mem_union

@[simp]
theorem mem_inter {x y z : SetCat.{u}} : z ∈ x ∩ y ↔ z ∈ x ∧ z ∈ y :=
  @mem_sep fun z : SetCat.{u} => z ∈ y
#align Set.mem_inter SetCat.mem_inter

@[simp]
theorem mem_diff {x y z : SetCat.{u}} : z ∈ x \ y ↔ z ∈ x ∧ z ∉ y :=
  @mem_sep fun z : SetCat.{u} => z ∉ y
#align Set.mem_diff SetCat.mem_diff

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sUnion_pair {x y : SetCat.{u}} : ⋃₀ ({x, y} : SetCat.{u}) = x ∪ y :=
  by
  ext
  simp_rw [mem_union, mem_sUnion, mem_pair]
  constructor
  · rintro ⟨w, rfl | rfl, hw⟩
    · exact Or.inl hw
    · exact Or.inr hw
  · rintro (hz | hz)
    · exact ⟨x, Or.inl rfl, hz⟩
    · exact ⟨y, Or.inr rfl, hz⟩
#align Set.sUnion_pair SetCat.sUnion_pair

theorem mem_wf : @WellFounded SetCat (· ∈ ·) :=
  wellFounded_lift₂_iff.mpr PSet.mem_wf
#align Set.mem_wf SetCat.mem_wf

/-- Induction on the `∈` relation. -/
@[elab_as_elim]
theorem induction_on {p : SetCat → Prop} (x) (h : ∀ x, (∀ y ∈ x, p y) → p x) : p x :=
  mem_wf.induction x h
#align Set.induction_on SetCat.induction_on

instance : WellFoundedRelation SetCat :=
  ⟨_, mem_wf⟩

instance : IsAsymm SetCat (· ∈ ·) :=
  mem_wf.IsAsymm

theorem mem_asymm {x y : SetCat} : x ∈ y → y ∉ x :=
  asymm
#align Set.mem_asymm SetCat.mem_asymm

theorem mem_irrefl (x : SetCat) : x ∉ x :=
  irrefl x
#align Set.mem_irrefl SetCat.mem_irrefl

theorem regularity (x : SetCat.{u}) (h : x ≠ ∅) : ∃ y ∈ x, x ∩ y = ∅ :=
  by_contradiction fun ne =>
    h <|
      (eq_empty x).2 fun y =>
        induction_on y fun z (IH : ∀ w : SetCat.{u}, w ∈ z → w ∉ x) =>
          show z ∉ x from fun zx =>
            Ne
              ⟨z, zx,
                (eq_empty _).2 fun w wxz =>
                  let ⟨wx, wz⟩ := mem_inter.1 wxz
                  IH w wz wx⟩
#align Set.regularity SetCat.regularity

/-- The image of a (definable) ZFC set function -/
def image (f : SetCat → SetCat) [H : Definable 1 f] : SetCat → SetCat :=
  let r := @Definable.resp 1 f _
  Resp.eval 1
    ⟨image r.1, fun x y e =>
      Mem.ext fun z =>
        Iff.trans (mem_image r.2) <|
          Iff.trans
              ⟨fun ⟨w, h1, h2⟩ => ⟨w, (mem.congr_right e).1 h1, h2⟩, fun ⟨w, h1, h2⟩ =>
                ⟨w, (mem.congr_right e).2 h1, h2⟩⟩ <|
            Iff.symm (mem_image r.2)⟩
#align Set.image SetCat.image

theorem image.mk :
    ∀ (f : SetCat.{u} → SetCat.{u}) [H : Definable 1 f] (x) {y} (h : y ∈ x), f y ∈ @image f H x
  | _, ⟨F⟩, x, y => Quotient.induction_on₂ x y fun ⟨α, A⟩ y ⟨a, ya⟩ => ⟨a, F.2 _ _ ya⟩
#align Set.image.mk SetCat.image.mk

@[simp]
theorem mem_image :
    ∀ {f : SetCat.{u} → SetCat.{u}} [H : Definable 1 f] {x y : SetCat.{u}},
      y ∈ @image f H x ↔ ∃ z ∈ x, f z = y
  | _, ⟨F⟩, x, y =>
    Quotient.induction_on₂ x y fun ⟨α, A⟩ y =>
      ⟨fun ⟨a, ya⟩ => ⟨⟦A a⟧, Mem.mk A a, Eq.symm <| Quotient.sound ya⟩, fun ⟨z, hz, e⟩ =>
        e ▸ image.mk _ _ hz⟩
#align Set.mem_image SetCat.mem_image

@[simp]
theorem toSet_image (f : SetCat → SetCat) [H : Definable 1 f] (x : SetCat) :
    (image f x).toSet = f '' x.toSet := by
  ext
  simp
#align Set.to_set_image SetCat.toSet_image

/-- The range of an indexed family of sets. The universes allow for a more general index type
  without manual use of `ulift`. -/
noncomputable def range {α : Type u} (f : α → SetCat.{max u v}) : SetCat.{max u v} :=
  ⟦⟨ULift α, Quotient.out ∘ f ∘ ULift.down⟩⟧
#align Set.range SetCat.range

@[simp]
theorem mem_range {α : Type u} {f : α → SetCat.{max u v}} {x : SetCat.{max u v}} :
    x ∈ range f ↔ x ∈ Set.range f :=
  Quotient.inductionOn x fun y => by
    constructor
    · rintro ⟨z, hz⟩
      exact ⟨z.down, Quotient.eq_mk_iff_out.2 hz.symm⟩
    · rintro ⟨z, hz⟩
      use z
      simpa [hz] using PSet.Equiv.symm (Quotient.mk_out y)
#align Set.mem_range SetCat.mem_range

@[simp]
theorem toSet_range {α : Type u} (f : α → SetCat.{max u v}) : (range f).toSet = Set.range f :=
  by
  ext
  simp
#align Set.to_set_range SetCat.toSet_range

/-- Kuratowski ordered pair -/
def pair (x y : SetCat.{u}) : SetCat.{u} :=
  {{x}, {x, y}}
#align Set.pair SetCat.pair

@[simp]
theorem toSet_pair (x y : SetCat.{u}) : (pair x y).toSet = {{x}, {x, y}} := by simp [pair]
#align Set.to_set_pair SetCat.toSet_pair

/-- A subset of pairs `{(a, b) ∈ x × y | p a b}` -/
def pairSep (p : SetCat.{u} → SetCat.{u} → Prop) (x y : SetCat.{u}) : SetCat.{u} :=
  { z ∈ powerset (powerset (x ∪ y)) | ∃ a ∈ x, ∃ b ∈ y, z = pair a b ∧ p a b }
#align Set.pair_sep SetCat.pairSep

@[simp]
theorem mem_pairSep {p} {x y z : SetCat.{u}} :
    z ∈ pairSep p x y ↔ ∃ a ∈ x, ∃ b ∈ y, z = pair a b ∧ p a b :=
  by
  refine' mem_sep.trans ⟨And.right, fun e => ⟨_, e⟩⟩
  rcases e with ⟨a, ax, b, bY, rfl, pab⟩
  simp only [mem_powerset, subset_def, mem_union, pair, mem_pair]
  rintro u (rfl | rfl) v <;> simp only [mem_singleton, mem_pair]
  · rintro rfl
    exact Or.inl ax
  · rintro (rfl | rfl) <;> [left, right] <;> assumption
#align Set.mem_pair_sep SetCat.mem_pairSep

theorem pair_injective : Function.Injective2 pair := fun x x' y y' H =>
  by
  have ae := ext_iff.1 H
  simp only [pair, mem_pair] at ae
  obtain rfl : x = x' := by
    cases' (ae {x}).1 (by simp) with h h
    · exact singleton_injective h
    · have m : x' ∈ ({x} : SetCat) := by simp [h]
      rw [mem_singleton.mp m]
  have he : x = y → y = y' := by
    rintro rfl
    cases' (ae {x, y'}).2 (by simp only [eq_self_iff_true, or_true_iff]) with xy'x xy'xx
    · rw [eq_comm, ← mem_singleton, ← xy'x, mem_pair]
      exact Or.inr rfl
    · simpa [eq_comm] using (ext_iff.1 xy'xx y').1 (by simp)
  obtain xyx | xyy' := (ae {x, y}).1 (by simp)
  · obtain rfl := mem_singleton.mp ((ext_iff.1 xyx y).1 <| by simp)
    simp [he rfl]
  · obtain rfl | yy' := mem_pair.mp ((ext_iff.1 xyy' y).1 <| by simp)
    · simp [he rfl]
    · simp [yy']
#align Set.pair_injective SetCat.pair_injective

@[simp]
theorem pair_inj {x y x' y' : SetCat} : pair x y = pair x' y' ↔ x = x' ∧ y = y' :=
  pair_injective.eq_iff
#align Set.pair_inj SetCat.pair_inj

/-- The cartesian product, `{(a, b) | a ∈ x, b ∈ y}` -/
def prod : SetCat.{u} → SetCat.{u} → SetCat.{u} :=
  pairSep fun a b => True
#align Set.prod SetCat.prod

@[simp]
theorem mem_prod {x y z : SetCat.{u}} : z ∈ prod x y ↔ ∃ a ∈ x, ∃ b ∈ y, z = pair a b := by
  simp [Prod]
#align Set.mem_prod SetCat.mem_prod

@[simp]
theorem pair_mem_prod {x y a b : SetCat.{u}} : pair a b ∈ prod x y ↔ a ∈ x ∧ b ∈ y :=
  ⟨fun h =>
    let ⟨a', a'x, b', b'y, e⟩ := mem_prod.1 h
    match a', b', pair_injective e, a'x, b'y with
    | _, _, ⟨rfl, rfl⟩, ax, bY => ⟨ax, bY⟩,
    fun ⟨ax, bY⟩ => mem_prod.2 ⟨a, ax, b, bY, rfl⟩⟩
#align Set.pair_mem_prod SetCat.pair_mem_prod

/-- `is_func x y f` is the assertion that `f` is a subset of `x × y` which relates to each element
of `x` a unique element of `y`, so that we can consider `f`as a ZFC function `x → y`. -/
def IsFunc (x y f : SetCat.{u}) : Prop :=
  f ⊆ prod x y ∧ ∀ z : SetCat.{u}, z ∈ x → ∃! w, pair z w ∈ f
#align Set.is_func SetCat.IsFunc

/-- `funs x y` is `y ^ x`, the set of all set functions `x → y` -/
def funs (x y : SetCat.{u}) : SetCat.{u} :=
  { f ∈ powerset (prod x y) | IsFunc x y f }
#align Set.funs SetCat.funs

@[simp]
theorem mem_funs {x y f : SetCat.{u}} : f ∈ funs x y ↔ IsFunc x y f := by simp [funs, is_func]
#align Set.mem_funs SetCat.mem_funs

-- TODO(Mario): Prove this computably
noncomputable instance mapDefinableAux (f : SetCat → SetCat) [H : Definable 1 f] :
    Definable 1 fun y => pair y (f y) :=
  @Classical.allDefinable 1 _
#align Set.map_definable_aux SetCat.mapDefinableAux

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

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

theorem map_unique {f : SetCat.{u} → SetCat.{u}} [H : Definable 1 f] {x z : SetCat.{u}}
    (zx : z ∈ x) : ∃! w, pair z w ∈ map f x :=
  ⟨f z, image.mk _ _ zx, fun y yx =>
    by
    let ⟨w, wx, we⟩ := mem_image.1 yx
    let ⟨wz, fy⟩ := pair_injective we
    rw [← fy, wz]⟩
#align Set.map_unique SetCat.map_unique

@[simp]
theorem map_isFunc {f : SetCat → SetCat} [H : Definable 1 f] {x y : SetCat} :
    IsFunc x y (map f x) ↔ ∀ z ∈ x, f z ∈ y :=
  ⟨fun ⟨ss, h⟩ z zx =>
    let ⟨t, t1, t2⟩ := h z zx
    (t2 (f z) (image.mk _ _ zx)).symm ▸ (pair_mem_prod.1 (ss t1)).right,
    fun h =>
    ⟨fun y yx =>
      let ⟨z, zx, ze⟩ := mem_image.1 yx
      ze ▸ pair_mem_prod.2 ⟨zx, h z zx⟩,
      fun z => map_unique⟩⟩
#align Set.map_is_func SetCat.map_isFunc

/-- Given a predicate `p` on ZFC sets. `hereditarily p x` means that `x` has property `p` and the
members of `x` are all `hereditarily p`. -/
def Hereditarily (p : SetCat → Prop) : SetCat → Prop
  | x => p x ∧ ∀ y ∈ x, hereditarily y
#align Set.hereditarily SetCat.Hereditarily

section Hereditarily

variable {p : SetCat.{u} → Prop} {x y : SetCat.{u}}

theorem hereditarily_iff : Hereditarily p x ↔ p x ∧ ∀ y ∈ x, Hereditarily p y := by
  rw [← hereditarily]
#align Set.hereditarily_iff SetCat.hereditarily_iff

alias hereditarily_iff ↔ hereditarily.def _
#align Set.hereditarily.def SetCat.Hereditarily.def

theorem Hereditarily.self (h : x.Hereditarily p) : p x :=
  h.def.1
#align Set.hereditarily.self SetCat.Hereditarily.self

theorem Hereditarily.mem (h : x.Hereditarily p) (hy : y ∈ x) : y.Hereditarily p :=
  h.def.2 _ hy
#align Set.hereditarily.mem SetCat.Hereditarily.mem

theorem Hereditarily.empty : Hereditarily p x → p ∅ :=
  by
  apply x.induction_on
  intro y IH h
  rcases SetCat.eq_empty_or_nonempty y with (rfl | ⟨a, ha⟩)
  · exact h.self
  · exact IH a ha (h.mem ha)
#align Set.hereditarily.empty SetCat.Hereditarily.empty

end Hereditarily

end SetCat

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler has_sep[has_sep] Set[Set] -/
/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler has_insert[has_insert] Set[Set] -/
/-- The collection of all classes.

We define `Class` as `set Set`, as this allows us to get many instances automatically. However, in
practice, we treat it as (the definitionally equal) `Set → Prop`. This means, the preferred way to
state that `x : Set` belongs to `A : Class` is to write `A x`. -/
def Class :=
  Set SetCat deriving HasSubset,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler has_sep[has_sep] Set[Set]»,
  EmptyCollection, Inhabited,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler has_insert[has_insert] Set[Set]»,
  Union, Inter, HasCompl, SDiff
#align Class Class

namespace Class

@[ext]
theorem ext {x y : Class.{u}} : (∀ z : SetCat.{u}, x z ↔ y z) → x = y :=
  Set.ext
#align Class.ext Class.ext

theorem ext_iff {x y : Class.{u}} : x = y ↔ ∀ z, x z ↔ y z :=
  Set.ext_iff
#align Class.ext_iff Class.ext_iff

/-- Coerce a ZFC set into a class -/
def ofSet (x : SetCat.{u}) : Class.{u} :=
  { y | y ∈ x }
#align Class.of_Set Class.ofSet

instance : Coe SetCat Class :=
  ⟨ofSet⟩

/-- The universal class -/
def univ : Class :=
  Set.univ
#align Class.univ Class.univ

/-- Assert that `A` is a ZFC set satisfying `B` -/
def ToSet (B : Class.{u}) (A : Class.{u}) : Prop :=
  ∃ x, ↑x = A ∧ B x
#align Class.to_Set Class.ToSet

/-- `A ∈ B` if `A` is a ZFC set which satisfies `B` -/
protected def Mem (A B : Class.{u}) : Prop :=
  ToSet.{u} B A
#align Class.mem Class.Mem

instance : Membership Class Class :=
  ⟨Class.Mem⟩

theorem mem_def (A B : Class.{u}) : A ∈ B ↔ ∃ x, ↑x = A ∧ B x :=
  Iff.rfl
#align Class.mem_def Class.mem_def

@[simp]
theorem not_mem_empty (x : Class.{u}) : x ∉ (∅ : Class.{u}) := fun ⟨_, _, h⟩ => h
#align Class.not_mem_empty Class.not_mem_empty

@[simp]
theorem not_empty_hom (x : SetCat.{u}) : ¬(∅ : Class.{u}) x :=
  id
#align Class.not_empty_hom Class.not_empty_hom

@[simp]
theorem mem_univ {A : Class.{u}} : A ∈ univ.{u} ↔ ∃ x : SetCat.{u}, ↑x = A :=
  exists_congr fun x => and_true_iff _
#align Class.mem_univ Class.mem_univ

@[simp]
theorem mem_univ_hom (x : SetCat.{u}) : univ.{u} x :=
  trivial
#align Class.mem_univ_hom Class.mem_univ_hom

theorem eq_univ_iff_forall {A : Class.{u}} : A = univ ↔ ∀ x : SetCat, A x :=
  Set.eq_univ_iff_forall
#align Class.eq_univ_iff_forall Class.eq_univ_iff_forall

theorem eq_univ_of_forall {A : Class.{u}} : (∀ x : SetCat, A x) → A = univ :=
  Set.eq_univ_of_forall
#align Class.eq_univ_of_forall Class.eq_univ_of_forall

theorem mem_wf : @WellFounded Class.{u} (· ∈ ·) :=
  ⟨by
    have H : ∀ x : SetCat.{u}, @Acc Class.{u} (· ∈ ·) ↑x :=
      by
      refine' fun a => SetCat.induction_on a fun x IH => ⟨x, _⟩
      rintro A ⟨z, rfl, hz⟩
      exact IH z hz
    · refine' fun A => ⟨A, _⟩
      rintro B ⟨x, rfl, hx⟩
      exact H x⟩
#align Class.mem_wf Class.mem_wf

instance : WellFoundedRelation Class :=
  ⟨_, mem_wf⟩

instance : IsAsymm Class (· ∈ ·) :=
  mem_wf.IsAsymm

theorem mem_asymm {x y : Class} : x ∈ y → y ∉ x :=
  asymm
#align Class.mem_asymm Class.mem_asymm

theorem mem_irrefl (x : Class) : x ∉ x :=
  irrefl x
#align Class.mem_irrefl Class.mem_irrefl

/-- **There is no universal set.**

This is stated as `univ ∉ univ`, meaning that `univ` (the class of all sets) is proper (does not
belong to the class of all sets). -/
theorem univ_not_mem_univ : univ ∉ univ :=
  mem_irrefl _
#align Class.univ_not_mem_univ Class.univ_not_mem_univ

/-- Convert a conglomerate (a collection of classes) into a class -/
def congToClass (x : Set Class.{u}) : Class.{u} :=
  { y | ↑y ∈ x }
#align Class.Cong_to_Class Class.congToClass

@[simp]
theorem congToClass_empty : congToClass ∅ = ∅ :=
  by
  ext
  simp [Cong_to_Class]
#align Class.Cong_to_Class_empty Class.congToClass_empty

/-- Convert a class into a conglomerate (a collection of classes) -/
def classToCong (x : Class.{u}) : Set Class.{u} :=
  { y | y ∈ x }
#align Class.Class_to_Cong Class.classToCong

@[simp]
theorem classToCong_empty : classToCong ∅ = ∅ :=
  by
  ext
  simp [Class_to_Cong]
#align Class.Class_to_Cong_empty Class.classToCong_empty

/-- The power class of a class is the class of all subclasses that are ZFC sets -/
def powerset (x : Class) : Class :=
  congToClass (Set.powerset x)
#align Class.powerset Class.powerset

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The union of a class is the class of all members of ZFC sets in the class -/
def sUnion (x : Class) : Class :=
  ⋃₀ classToCong x
#align Class.sUnion Class.sUnion

-- mathport name: Class.sUnion
prefix:110 "⋃₀ " => Class.sUnion

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The intersection of a class is the class of all members of ZFC sets in the class -/
def sInter (x : Class) : Class :=
  ⋂₀ classToCong x
#align Class.sInter Class.sInter

-- mathport name: Class.sInter
prefix:110 "⋂₀ " => Class.sInter

theorem ofSet.inj {x y : SetCat.{u}} (h : (x : Class.{u}) = y) : x = y :=
  SetCat.ext fun z => by
    change (x : Class.{u}) z ↔ (y : Class.{u}) z
    rw [h]
#align Class.of_Set.inj Class.ofSet.inj

@[simp]
theorem toSet_of_setCat (A : Class.{u}) (x : SetCat.{u}) : ToSet A x ↔ A x :=
  ⟨fun ⟨y, yx, py⟩ => by rwa [of_Set.inj yx] at py, fun px => ⟨x, rfl, px⟩⟩
#align Class.to_Set_of_Set Class.toSet_of_setCat

@[simp, norm_cast]
theorem coe_mem {x : SetCat.{u}} {A : Class.{u}} : (x : Class.{u}) ∈ A ↔ A x :=
  toSet_of_setCat _ _
#align Class.coe_mem Class.coe_mem

@[simp]
theorem coe_apply {x y : SetCat.{u}} : (y : Class.{u}) x ↔ x ∈ y :=
  Iff.rfl
#align Class.coe_apply Class.coe_apply

@[simp, norm_cast]
theorem coe_subset (x y : SetCat.{u}) : (x : Class.{u}) ⊆ y ↔ x ⊆ y :=
  Iff.rfl
#align Class.coe_subset Class.coe_subset

@[simp, norm_cast]
theorem coe_sep (p : Class.{u}) (x : SetCat.{u}) :
    (↑({ y ∈ x | p y }) : Class.{u}) = { y ∈ x | p y } :=
  ext fun y => SetCat.mem_sep
#align Class.coe_sep Class.coe_sep

@[simp, norm_cast]
theorem coe_empty : ↑(∅ : SetCat.{u}) = (∅ : Class.{u}) :=
  ext fun y => (iff_false_iff _).2 <| SetCat.not_mem_empty y
#align Class.coe_empty Class.coe_empty

@[simp, norm_cast]
theorem coe_insert (x y : SetCat.{u}) : ↑(insert x y) = @insert SetCat.{u} Class.{u} _ x y :=
  ext fun z => SetCat.mem_insert_iff
#align Class.coe_insert Class.coe_insert

@[simp, norm_cast]
theorem coe_union (x y : SetCat.{u}) : ↑(x ∪ y) = (x : Class.{u}) ∪ y :=
  ext fun z => SetCat.mem_union
#align Class.coe_union Class.coe_union

@[simp, norm_cast]
theorem coe_inter (x y : SetCat.{u}) : ↑(x ∩ y) = (x : Class.{u}) ∩ y :=
  ext fun z => SetCat.mem_inter
#align Class.coe_inter Class.coe_inter

@[simp, norm_cast]
theorem coe_diff (x y : SetCat.{u}) : ↑(x \ y) = (x : Class.{u}) \ y :=
  ext fun z => SetCat.mem_diff
#align Class.coe_diff Class.coe_diff

@[simp, norm_cast]
theorem coe_powerset (x : SetCat.{u}) : ↑x.powerset = powerset.{u} x :=
  ext fun z => SetCat.mem_powerset
#align Class.coe_powerset Class.coe_powerset

@[simp]
theorem powerset_apply {A : Class.{u}} {x : SetCat.{u}} : powerset A x ↔ ↑x ⊆ A :=
  Iff.rfl
#align Class.powerset_apply Class.powerset_apply

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sUnion_apply {x : Class} {y : SetCat} : (⋃₀ x) y ↔ ∃ z : SetCat, x z ∧ y ∈ z :=
  by
  constructor
  · rintro ⟨-, ⟨z, rfl, hxz⟩, hyz⟩
    exact ⟨z, hxz, hyz⟩
  · exact fun ⟨z, hxz, hyz⟩ => ⟨_, coe_mem.2 hxz, hyz⟩
#align Class.sUnion_apply Class.sUnion_apply

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp, norm_cast]
theorem coe_sUnion (x : SetCat.{u}) : ↑(⋃₀ x) = ⋃₀ (x : Class.{u}) :=
  ext fun y =>
    SetCat.mem_sUnion.trans (sUnion_apply.trans <| by simp_rw [coe_apply, exists_prop]).symm
#align Class.coe_sUnion Class.coe_sUnion

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem mem_sUnion {x y : Class.{u}} : y ∈ ⋃₀ x ↔ ∃ z, z ∈ x ∧ y ∈ z :=
  by
  constructor
  · rintro ⟨w, rfl, z, hzx, hwz⟩
    exact ⟨z, hzx, coe_mem.2 hwz⟩
  · rintro ⟨w, hwx, z, rfl, hwz⟩
    exact ⟨z, rfl, w, hwx, hwz⟩
#align Class.mem_sUnion Class.mem_sUnion

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sInter_apply {x : Class.{u}} {y : SetCat.{u}} : (⋂₀ x) y ↔ ∀ z : SetCat.{u}, x z → y ∈ z :=
  by
  refine' ⟨fun hxy z hxz => hxy _ ⟨z, rfl, hxz⟩, _⟩
  rintro H - ⟨z, rfl, hxz⟩
  exact H _ hxz
#align Class.sInter_apply Class.sInter_apply

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp, norm_cast]
theorem sInter_coe {x : SetCat.{u}} (h : x.Nonempty) : ⋂₀ (x : Class.{u}) = ⋂₀ x :=
  Set.ext fun y => sInter_apply.trans (SetCat.mem_sInter h).symm
#align Class.sInter_coe Class.sInter_coe

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem mem_of_mem_sInter {x y z : Class} (hy : y ∈ ⋂₀ x) (hz : z ∈ x) : y ∈ z :=
  by
  obtain ⟨w, rfl, hw⟩ := hy
  exact coe_mem.2 (hw z hz)
#align Class.mem_of_mem_sInter Class.mem_of_mem_sInter

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem mem_sInter {x y : Class.{u}} (h : x.Nonempty) : y ∈ ⋂₀ x ↔ ∀ z, z ∈ x → y ∈ z :=
  by
  refine' ⟨fun hy z => mem_of_mem_sInter hy, fun H => _⟩
  simp_rw [mem_def, sInter_apply]
  obtain ⟨z, hz⟩ := h
  obtain ⟨y, rfl, hzy⟩ := H z (coe_mem.2 hz)
  refine' ⟨y, rfl, fun w hxw => _⟩
  simpa only [coe_mem, coe_apply] using H w (coe_mem.2 hxw)
#align Class.mem_sInter Class.mem_sInter

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sUnion_empty : ⋃₀ (∅ : Class.{u}) = ∅ :=
  by
  ext
  simp
#align Class.sUnion_empty Class.sUnion_empty

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem sInter_empty : ⋂₀ (∅ : Class.{u}) = univ :=
  by
  ext
  simp [sInter, ← univ]
#align Class.sInter_empty Class.sInter_empty

/-- An induction principle for sets. If every subset of a class is a member, then the class is
  universal. -/
theorem eq_univ_of_powerset_subset {A : Class} (hA : powerset A ⊆ A) : A = univ :=
  eq_univ_of_forall
    (by
      by_contra' hnA
      exact
        WellFounded.min_mem SetCat.mem_wf _ hnA
          (hA fun x hx =>
            Classical.not_not.1 fun hB =>
              WellFounded.not_lt_min SetCat.mem_wf _ hnA hB <| coe_apply.1 hx))
#align Class.eq_univ_of_powerset_subset Class.eq_univ_of_powerset_subset

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The definite description operator, which is `{x}` if `{y | A y} = {x}` and `∅` otherwise. -/
def iota (A : Class) : Class :=
  ⋃₀ { x | ∀ y, A y ↔ y = x }
#align Class.iota Class.iota

theorem iota_val (A : Class) (x : SetCat) (H : ∀ y, A y ↔ y = x) : iota A = ↑x :=
  ext fun y =>
    ⟨fun ⟨_, ⟨x', rfl, h⟩, yx'⟩ => by rwa [← (H x').1 <| (h x').2 rfl], fun yx =>
      ⟨_, ⟨x, rfl, H⟩, yx⟩⟩
#align Class.iota_val Class.iota_val

/-- Unlike the other set constructors, the `iota` definite descriptor
  is a set for any set input, but not constructively so, so there is no
  associated `Class → Set` function. -/
theorem iota_ex (A) : iota.{u} A ∈ univ.{u} :=
  mem_univ.2 <|
    Or.elim (Classical.em <| ∃ x, ∀ y, A y ↔ y = x) (fun ⟨x, h⟩ => ⟨x, Eq.symm <| iota_val A x h⟩)
      fun hn =>
      ⟨∅, ext fun z => coe_empty.symm ▸ ⟨False.ndrec _, fun ⟨_, ⟨x, rfl, H⟩, zA⟩ => hn ⟨x, H⟩⟩⟩
#align Class.iota_ex Class.iota_ex

/-- Function value -/
def fval (F A : Class.{u}) : Class.{u} :=
  iota fun y => ToSet (fun x => F (SetCat.pair x y)) A
#align Class.fval Class.fval

-- mathport name: «expr ′ »
infixl:100 " ′ " => fval

theorem fval_ex (F A : Class.{u}) : F ′ A ∈ univ.{u} :=
  iota_ex _
#align Class.fval_ex Class.fval_ex

end Class

namespace SetCat

@[simp]
theorem map_fval {f : SetCat.{u} → SetCat.{u}} [H : PSet.Definable 1 f] {x y : SetCat.{u}}
    (h : y ∈ x) : (SetCat.map f x ′ y : Class.{u}) = f y :=
  Class.iota_val _ _ fun z =>
    by
    rw [Class.toSet_of_setCat, Class.coe_apply, mem_map]
    exact
      ⟨fun ⟨w, wz, pr⟩ => by
        let ⟨wy, fw⟩ := SetCat.pair_injective pr
        rw [← fw, wy], fun e => by
        subst e
        exact ⟨_, h, rfl⟩⟩
#align Set.map_fval SetCat.map_fval

variable (x : SetCat.{u}) (h : ∅ ∉ x)

/-- A choice function on the class of nonempty ZFC sets. -/
noncomputable def choice : SetCat :=
  @map (fun y => Classical.epsilon fun z => z ∈ y) (Classical.allDefinable _) x
#align Set.choice SetCat.choice

include h

theorem choice_mem_aux (y : SetCat.{u}) (yx : y ∈ x) :
    (Classical.epsilon fun z : SetCat.{u} => z ∈ y) ∈ y :=
  (@Classical.epsilon_spec _ fun z : SetCat.{u} => z ∈ y) <|
    by_contradiction fun n => h <| by rwa [← (eq_empty y).2 fun z zx => n ⟨z, zx⟩]
#align Set.choice_mem_aux SetCat.choice_mem_aux

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem choice_isFunc : IsFunc x (⋃₀ x) (choice x) :=
  (@map_isFunc _ (Classical.allDefinable _) _ _).2 fun y yx =>
    mem_sUnion.2 ⟨y, yx, choice_mem_aux x h y yx⟩
#align Set.choice_is_func SetCat.choice_isFunc

theorem choice_mem (y : SetCat.{u}) (yx : y ∈ x) : (choice x ′ y : Class.{u}) ∈ (y : Class.{u}) :=
  by
  delta choice
  rw [map_fval yx, Class.coe_mem, Class.coe_apply]
  exact choice_mem_aux x h y yx
#align Set.choice_mem SetCat.choice_mem

end SetCat