open import Level module ordinal-definable where open import zf open import ordinal open import Data.Nat renaming ( zero to Zero ; suc to Suc ; ℕ to Nat ; _⊔_ to _n⊔_ ) open import Relation.Binary.PropositionalEquality open import Data.Nat.Properties open import Data.Empty open import Relation.Nullary open import Relation.Binary open import Relation.Binary.Core -- Ordinal Definable Set record OD {n : Level} : Set (suc n) where field def : (x : Ordinal {n} ) → Set n open OD open import Data.Unit open Ordinal postulate od→ord : {n : Level} → OD {n} → Ordinal {n} ord→od : {n : Level} → Ordinal {n} → OD {n} _∋_ : { n : Level } → ( a x : OD {n} ) → Set n _∋_ {n} a x = def a ( od→ord x ) _c<_ : { n : Level } → ( a x : OD {n} ) → Set n x c< a = a ∋ x record _==_ {n : Level} ( a b : OD {n} ) : Set n where field eq→ : ∀ { x : Ordinal {n} } → def a x → def b x eq← : ∀ { x : Ordinal {n} } → def b x → def a x id : {n : Level} {A : Set n} → A → A id x = x eq-refl : {n : Level} { x : OD {n} } → x == x eq-refl {n} {x} = record { eq→ = id ; eq← = id } open _==_ eq-sym : {n : Level} { x y : OD {n} } → x == y → y == x eq-sym eq = record { eq→ = eq← eq ; eq← = eq→ eq } eq-trans : {n : Level} { x y z : OD {n} } → x == y → y == z → x == z eq-trans x=y y=z = record { eq→ = λ t → eq→ y=z ( eq→ x=y t) ; eq← = λ t → eq← x=y ( eq← y=z t) } _c≤_ : {n : Level} → OD {n} → OD {n} → Set (suc n) a c≤ b = (a ≡ b) ∨ ( b ∋ a ) od∅ : {n : Level} → OD {n} od∅ {n} = record { def = λ _ → Lift n ⊥ } postulate c<→o< : {n : Level} {x y : OD {n} } → x c< y → od→ord x o< od→ord y o<→c< : {n : Level} {x y : Ordinal {n} } → x o< y → ord→od x c< ord→od y oiso : {n : Level} {x : OD {n}} → ord→od ( od→ord x ) ≡ x diso : {n : Level} {x : Ordinal {n}} → od→ord ( ord→od x ) ≡ x sup-od : {n : Level } → ( OD {n} → OD {n}) → OD {n} sup-c< : {n : Level } → ( ψ : OD {n} → OD {n}) → ∀ {x : OD {n}} → ψ x c< sup-od ψ ∅1 : {n : Level} → ( x : OD {n} ) → ¬ ( x c< od∅ {n} ) ∅1 {n} x (lift ()) ∅3 : {n : Level} → { x : Ordinal {n}} → ( ∀(y : Ordinal {n}) → ¬ (y o< x ) ) → x ≡ o∅ {n} ∅3 {n} {x} = TransFinite {n} c1 c2 c3 x where c0 : Nat → Ordinal {n} → Set n c0 lx x = (∀(y : Ordinal {n}) → ¬ (y o< x)) → x ≡ o∅ {n} c1 : ∀ (lx : Nat ) → c0 lx (record { lv = Suc lx ; ord = ℵ lx } ) c1 lx not with not ( record { lv = lx ; ord = Φ lx } ) ... | t with t (case1 ≤-refl ) c1 lx not | t | () c2 : (lx : Nat) → c0 lx (record { lv = lx ; ord = Φ lx } ) c2 Zero not = refl c2 (Suc lx) not with not ( record { lv = lx ; ord = Φ lx } ) ... | t with t (case1 ≤-refl ) c2 (Suc lx) not | t | () c3 : (lx : Nat) (x₁ : OrdinalD lx) → c0 lx (record { lv = lx ; ord = x₁ }) → c0 lx (record { lv = lx ; ord = OSuc lx x₁ }) c3 lx (Φ .lx) d not with not ( record { lv = lx ; ord = Φ lx } ) ... | t with t (case2 Φ< ) c3 lx (Φ .lx) d not | t | () c3 lx (OSuc .lx x₁) d not with not ( record { lv = lx ; ord = OSuc lx x₁ } ) ... | t with t (case2 (s< s→¬< : {x y : Nat } → (x < y ) → ¬ ( y < x ) >→¬< (s≤s x→¬< x : {n : Level } ( ox oy : Ordinal {n}) → ox o< oy → oy o< ox → ⊥ o<> ox oy (case1 x→¬< x ox oy (case1 x ox oy (case2 x ox oy (case2 x x : {n : Level} → { x y : OD {n} } → (x == y) → (od→ord x ) o< ( od→ord y) → ⊥ o<→o> {n} {x} {y} record { eq→ = xy ; eq← = yx } (case1 lt) with yx (def-subst {n} {ord→od (od→ord y)} {od→ord (ord→od (od→ord x))} (o<→c< (case1 lt )) oiso diso ) ... | oyx with o<¬≡ (od→ord x) (od→ord x) refl (c<→o< oyx ) ... | () o<→o> {n} {x} {y} record { eq→ = xy ; eq← = yx } (case2 lt) with yx (def-subst {n} {ord→od (od→ord y)} {od→ord (ord→od (od→ord x))} (o<→c< (case2 lt )) oiso diso ) ... | oyx with o<¬≡ (od→ord x) (od→ord x) refl (c<→o< oyx ) ... | () ==→o≡ : {n : Level} → { x y : Ordinal {suc n} } → ord→od x == ord→od y → x ≡ y ==→o≡ {n} {x} {y} eq with trio< {n} x y ==→o≡ {n} {x} {y} eq | tri< a ¬b ¬c = ⊥-elim ( o<→o> eq (o<-subst a (sym ord-iso) (sym ord-iso ))) ==→o≡ {n} {x} {y} eq | tri≈ ¬a b ¬c = b ==→o≡ {n} {x} {y} eq | tri> ¬a ¬b c = ⊥-elim ( o<→o> (eq-sym eq) (o<-subst c (sym ord-iso) (sym ord-iso ))) ¬x<0 : {n : Level} → { x : Ordinal {suc n} } → ¬ ( x o< o∅ {suc n} ) ¬x<0 {n} {x} (case1 ()) ¬x<0 {n} {x} (case2 ()) -- o∅≡od∅0 : {n : Level} → ord→od (o∅ {suc n}) == od∅ {suc n} -- eq→ (o∅≡od∅0 {n} ) {x} y with c<→o< {suc n} {ord→od x} {ord→od (o∅ {suc n})} (def-subst {suc n} {_} {_} {ord→od o∅} {od→ord (ord→od x)} y refl (sym diso) ) -- eq→ (o∅≡od∅0 {n}) {x} y | lt = ⊥-elim ( ¬x<0 (o<-subst lt ord-iso diso ) ) -- eq← (o∅≡od∅0 {n}) {x} (lift ()) -- -- o∅≡od∅ : {n : Level} → ord→od (o∅ {suc n}) ≡ od∅ {suc n} -- o∅≡od∅ {n} = trans (cong (λ k → ord→od k ) ( ==→o≡ {n} (eq-trans o∅≡od∅0 (subst (λ k → od∅ == k ) (sym oiso) eq-refl )) ) ) oiso o∅≡od∅ : {n : Level} → ord→od (o∅ {suc n}) ≡ od∅ {suc n} o∅≡od∅ {n} with trio< {n} (o∅ {suc n}) (od→ord (od∅ {suc n} )) o∅≡od∅ {n} | tri< a ¬b ¬c = ⊥-elim (lemma a) where lemma : o∅ {suc n } o< (od→ord (od∅ {suc n} )) → ⊥ lemma lt with def-subst (o<→c< lt) oiso refl lemma lt | lift () o∅≡od∅ {n} | tri≈ ¬a b ¬c = trans (cong (λ k → ord→od k ) b ) oiso o∅≡od∅ {n} | tri> ¬a ¬b c = ⊥-elim (¬x<0 c) o<→¬== : {n : Level} → { x y : OD {n} } → (od→ord x ) o< ( od→ord y) → ¬ (x == y ) o<→¬== {n} {x} {y} lt eq = o<→o> eq lt o<→¬c> : {n : Level} → { x y : OD {n} } → (od→ord x ) o< ( od→ord y) → ¬ (y c< x ) o<→¬c> {n} {x} {y} olt clt = o<> (od→ord x) (od→ord y) olt (c<→o< clt ) where o≡→¬c< : {n : Level} → { x y : OD {n} } → (od→ord x ) ≡ ( od→ord y) → ¬ x c< y o≡→¬c< {n} {x} {y} oeq lt = o<¬≡ (od→ord x) (od→ord y) (orefl oeq ) (c<→o< lt) tri-c< : {n : Level} → Trichotomous _==_ (_c<_ {suc n}) tri-c< {n} x y with trio< {n} (od→ord x) (od→ord y) tri-c< {n} x y | tri< a ¬b ¬c = tri< (def-subst (o<→c< a) oiso diso) (o<→¬== a) ( o<→¬c> a ) tri-c< {n} x y | tri≈ ¬a b ¬c = tri≈ (o≡→¬c< b) (ord→== b) (o≡→¬c< (sym b)) tri-c< {n} x y | tri> ¬a ¬b c = tri> ( o<→¬c> c) (λ eq → o<→¬== c (eq-sym eq ) ) (def-subst (o<→c< c) oiso diso) c<> : {n : Level } { x y : OD {suc n}} → x c< y → y c< x → ⊥ c<> {n} {x} {y} x {n} {x} {y} x {n} {x} {y} x b ( c<→o< x {n} {x} {y} x ¬a ¬b c = ¬a x {n} {x} {x} x∋x x∋x def-iso : {n : Level} {A B : OD {n}} {x y : Ordinal {n}} → x ≡ y → (def A y → def B y) → def A x → def B x def-iso refl t = t is-∋ : {n : Level} → ( x y : OD {suc n} ) → Dec ( x ∋ y ) is-∋ {n} x y with tri-c< x y is-∋ {n} x y | tri< a ¬b ¬c = no ¬c is-∋ {n} x y | tri≈ ¬a b ¬c = no ¬c is-∋ {n} x y | tri> ¬a ¬b c = yes c is-o∅ : {n : Level} → ( x : Ordinal {suc n} ) → Dec ( x ≡ o∅ {suc n} ) is-o∅ {n} record { lv = Zero ; ord = (Φ .0) } = yes refl is-o∅ {n} record { lv = Zero ; ord = (OSuc .0 ord₁) } = no ( λ () ) is-o∅ {n} record { lv = (Suc lv₁) ; ord = ord } = no (λ()) open _∧_ ¬∅=→∅∈ : {n : Level} → { x : OD {suc n} } → ¬ ( x == od∅ {suc n} ) → x ∋ od∅ {suc n} ¬∅=→∅∈ {n} {x} ne = def-subst (lemma (od→ord x) (subst (λ k → ¬ (k == od∅ {suc n} )) (sym oiso) ne )) oiso refl where lemma : (ox : Ordinal {suc n}) → ¬ (ord→od ox == od∅ {suc n} ) → ord→od ox ∋ od∅ {suc n} lemma ox ne with is-o∅ ox lemma ox ne | yes refl with ne ( ord→== lemma1 ) where lemma1 : od→ord (ord→od o∅) ≡ od→ord od∅ lemma1 = cong ( λ k → od→ord k ) o∅≡od∅ lemma o∅ ne | yes refl | () lemma ox ne | no ¬p = subst ( λ k → def (ord→od ox) (od→ord k) ) o∅≡od∅ (o<→c< (∅5 ¬p)) -- open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) OD→ZF : {n : Level} → ZF {suc (suc n)} {suc n} OD→ZF {n} = record { ZFSet = OD {suc n} ; _∋_ = _∋_ ; _≈_ = _==_ ; ∅ = od∅ ; _,_ = _,_ ; Union = Union ; Power = Power ; Select = Select ; Replace = Replace ; infinite = ord→od ( record { lv = Suc Zero ; ord = ℵ Zero } ) ; isZF = isZF } where Replace : OD {suc n} → (OD {suc n} → OD {suc n} ) → OD {suc n} Replace X ψ = sup-od ψ Select : OD {suc n} → (OD {suc n} → Set (suc n) ) → OD {suc n} Select X ψ = record { def = λ x → ( def X x ∧ ψ ( ord→od x )) } _,_ : OD {suc n} → OD {suc n} → OD {suc n} x , y = record { def = λ z → ( (z ≡ od→ord x ) ∨ ( z ≡ od→ord y )) } Union : OD {suc n} → OD {suc n} Union U = record { def = λ y → osuc y o< (od→ord U) } -- power : ∀ X ∃ A ∀ t ( t ∈ A ↔ ( ∀ {x} → t ∋ x → X ∋ x ) Power : OD {suc n} → OD {suc n} Power X = record { def = λ y → ∀ (x : Ordinal {suc n} ) → ( def X x ∧ def (ord→od y) x ) } ZFSet = OD {suc n} _∈_ : ( A B : ZFSet ) → Set (suc n) A ∈ B = B ∋ A _⊆_ : ( A B : ZFSet ) → ∀{ x : ZFSet } → Set (suc n) _⊆_ A B {x} = A ∋ x → B ∋ x _∩_ : ( A B : ZFSet ) → ZFSet A ∩ B = Select (A , B) ( λ x → ( A ∋ x ) ∧ (B ∋ x) ) _∪_ : ( A B : ZFSet ) → ZFSet A ∪ B = Select (A , B) ( λ x → (A ∋ x) ∨ ( B ∋ x ) ) infixr 200 _∈_ infixr 230 _∩_ _∪_ infixr 220 _⊆_ isZF : IsZF (OD {suc n}) _∋_ _==_ od∅ _,_ Union Power Select Replace (ord→od ( record { lv = Suc Zero ; ord = ℵ Zero } )) isZF = record { isEquivalence = record { refl = eq-refl ; sym = eq-sym; trans = eq-trans } ; pair = pair ; union-u = union-u ; union→ = union→ ; union← = union← ; empty = empty ; power→ = power→ ; power← = power← ; extensionality = extensionality ; minimul = minimul ; regularity = regularity ; infinity∅ = infinity∅ ; infinity = {!!} ; selection = λ {ψ} {X} {y} → selection {ψ} {X} {y} ; replacement = {!!} } where open _∧_ open Minimumo pair : (A B : OD {suc n} ) → ((A , B) ∋ A) ∧ ((A , B) ∋ B) proj1 (pair A B ) = case1 refl proj2 (pair A B ) = case2 refl empty : (x : OD {suc n} ) → ¬ (od∅ ∋ x) empty x () --- Power X = record { def = λ y → ∀ (x : Ordinal {suc n} ) → ( def X x ∧ def (ord→od y) x ) } power→ : (A t : OD) → Power A ∋ t → {x : OD} → t ∋ x → A ∋ x power→ A t P∋t {x} t∋x = proj1 (P∋t (od→ord x) ) power← : (A t : OD) → ({x : OD} → (t ∋ x → A ∋ x)) → Power A ∋ t power← A t t→A z = record { proj1 = lemma2 ; proj2 = lemma1 } where lemma1 : def (ord→od (od→ord t)) z lemma1 = {!!} lemma2 : def A z lemma2 = {!!} union-u : (X z : OD {suc n}) → Union X ∋ z → OD {suc n} union-u X z U>z = ord→od ( osuc ( od→ord z ) ) union-lemma-u : {X z : OD {suc n}} → (U>z : Union X ∋ z ) → union-u X z U>z ∋ z union-lemma-u {X} {z} U>z = lemma <-osuc where lemma : {oz ooz : Ordinal {suc n}} → oz o< ooz → def (ord→od ooz) oz lemma {oz} {ooz} lt = def-subst {suc n} {ord→od ooz} (o<→c< lt) refl diso union→ : (X z u : OD) → (X ∋ u) ∧ (u ∋ z) → Union X ∋ z union→ X y u xx with trio< ( od→ord u ) ( osuc ( od→ord y )) union→ X y u xx | tri< a ¬b ¬c with osuc-< a (c<→o< (proj2 xx)) union→ X y u xx | tri< a ¬b ¬c | () union→ X y u xx | tri≈ ¬a b ¬c = lemma b (c<→o< (proj1 xx )) where lemma : {oX ou ooy : Ordinal {suc n}} → ou ≡ ooy → ou o< oX → ooy o< oX lemma refl lt = lt union→ X y u xx | tri> ¬a ¬b c = ordtrans {suc n} {osuc ( od→ord y )} {od→ord u} {od→ord X} c ( c<→o< (proj1 xx )) union← : (X z : OD) (X∋z : Union X ∋ z) → (X ∋ union-u X z X∋z) ∧ (union-u X z X∋z ∋ z ) union← X z X∋z = record { proj1 = def-subst {suc n} (o<→c< X∋z) oiso refl ; proj2 = union-lemma-u X∋z } ψiso : {ψ : OD {suc n} → Set (suc n)} {x y : OD {suc n}} → ψ x → x ≡ y → ψ y ψiso {ψ} t refl = t selection : {ψ : OD → Set (suc n)} {X y : OD} → ((X ∋ y) ∧ ψ y) ⇔ (Select X ψ ∋ y) selection {ψ} {X} {y} = record { proj1 = λ cond → record { proj1 = proj1 cond ; proj2 = ψiso {ψ} (proj2 cond) (sym oiso) } ; proj2 = λ select → record { proj1 = proj1 select ; proj2 = ψiso {ψ} (proj2 select) oiso } } ∅-iso : {x : OD} → ¬ (x == od∅) → ¬ ((ord→od (od→ord x)) == od∅) ∅-iso {x} neq = subst (λ k → ¬ k) (=-iso {n} ) neq minimul : (x : OD {suc n} ) → ¬ (x == od∅ )→ OD {suc n} minimul x not = od∅ regularity : (x : OD) (not : ¬ (x == od∅)) → (x ∋ minimul x not) ∧ (Select (minimul x not) (λ x₁ → (minimul x not ∋ x₁) ∧ (x ∋ x₁)) == od∅) proj1 (regularity x not ) = ¬∅=→∅∈ not proj2 (regularity x not ) = record { eq→ = reg ; eq← = λ () } where reg : {y : Ordinal} → def (Select (minimul x not) (λ x₂ → (minimul x not ∋ x₂) ∧ (x ∋ x₂))) y → def od∅ y reg {y} t with proj1 t ... | x∈∅ = x∈∅ extensionality : {A B : OD {suc n}} → ((z : OD) → (A ∋ z) ⇔ (B ∋ z)) → A == B eq→ (extensionality {A} {B} eq ) {x} d = def-iso {suc n} {A} {B} (sym diso) (proj1 (eq (ord→od x))) d eq← (extensionality {A} {B} eq ) {x} d = def-iso {suc n} {B} {A} (sym diso) (proj2 (eq (ord→od x))) d next : (x : OD) → Union (x , (x , x)) == ord→od (osuc (od→ord x)) eq→ (next x ) {y} z = {!!} eq← (next x ) {y} z = {!!} infinite : OD {suc n} infinite = ord→od ( record { lv = Suc Zero ; ord = ℵ Zero } ) infinity∅ : ord→od ( record { lv = Suc Zero ; ord = ℵ Zero } ) ∋ od∅ {suc n} infinity∅ = def-subst {suc n} {_} {od→ord (ord→od o∅)} {infinite} {od→ord od∅} (o<→c< ( case1 (s≤s z≤n ))) refl (cong (λ k → od→ord k) o∅≡od∅ ) infinity : (x : OD) → infinite ∋ x → infinite ∋ Union (x , (x , x )) infinity x ∞∋x = {!!} replacement : {ψ : OD → OD} (X x : OD) → Replace X ψ ∋ ψ x replacement {ψ} X x = {!!}