# HG changeset patch # User Shinji KONO # Date 1704277763 -32400 # Node ID 484f83b04b5da79b7e03d9ef0dd4a8c0af3c308e # Parent 9c19a7177b8a9a9b95b3297e946f9b2fadbd2077 ... diff -r 9c19a7177b8a -r 484f83b04b5d src/BAlgebra.agda --- a/src/BAlgebra.agda Wed Jan 03 11:05:21 2024 +0900 +++ b/src/BAlgebra.agda Wed Jan 03 19:29:23 2024 +0900 @@ -1,118 +1,133 @@ -{-# OPTIONS --allow-unsolved-metas #-} - +{-# OPTIONS --cubical-compatible --safe #-} open import Level open import Ordinals -module BAlgebra {n : Level } (O : Ordinals {n}) where +import HODBase +import OD +module BAlgebra {n : Level } (O : Ordinals {n} ) (HODAxiom : HODBase.ODAxiom O) (ho< : OD.ODAxiom-ho< O HODAxiom ) + (AC : OD.AxiomOfChoice O HODAxiom ) + where --- open import zf +-- open import Data.Nat renaming ( zero to Zero ; suc to Suc ; ℕ to Nat ; _⊔_ to _n⊔_ ) +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Data.Empty +open import Data.Unit +open import Relation.Nullary +open import Relation.Binary hiding (_⇔_) +open import Relation.Binary.Core hiding (_⇔_) +import Relation.Binary.Reasoning.Setoid as EqR + open import logic import OrdUtil -import OD -import ODUtil -import ODC +open import nat -open import Relation.Nullary -open import Relation.Binary -open import Data.Empty -open import Relation.Binary -open import Relation.Binary.Core -open import Relation.Binary.PropositionalEquality -open import Data.Nat renaming ( zero to Zero ; suc to Suc ; ℕ to Nat ; _⊔_ to _n⊔_ ; _+_ to _n+_ ) - -open inOrdinal O open Ordinals.Ordinals O open Ordinals.IsOrdinals isOrdinal -- open Ordinals.IsNext isNext open OrdUtil O -open ODUtil O +import ODUtil +open ODUtil O HODAxiom ho< +import ODC -open OD O -open OD.OD -open ODAxiom odAxiom -open HOD +-- Ordinal Definable Set + +open HODBase.HOD +open HODBase.OD open _∧_ open _∨_ open Bool -L\L=0 : { L : HOD } → L \ L ≡ od∅ -L\L=0 {L} = ==→o≡ ( record { eq→ = lem0 ; eq← = lem1 } ) where +open HODBase._==_ + +open HODBase.ODAxiom HODAxiom +open OD O HODAxiom +open AxiomOfChoice AC + +open _∧_ +open _∨_ +open Bool + +L\L=0 : { L : HOD } → (L \ L) =h= od∅ +L\L=0 {L} = record { eq→ = lem0 ; eq← = lem1 } where lem0 : {x : Ordinal} → odef (L \ L) x → odef od∅ x lem0 {x} ⟪ lx , ¬lx ⟫ = ⊥-elim (¬lx lx) lem1 : {x : Ordinal} → odef od∅ x → odef (L \ L) x lem1 {x} lt = ⊥-elim ( ¬∅∋ (subst (λ k → odef od∅ k) (sym &iso) lt )) -L\Lx=x : { L x : HOD } → x ⊆ L → L \ ( L \ x ) ≡ x -L\Lx=x {L} {x} x⊆L = ==→o≡ ( record { eq→ = lem03 ; eq← = lem04 } ) where +L\Lx=x : { L x : HOD } → x ⊆ L → (L \ ( L \ x )) =h= x +L\Lx=x {L} {x} x⊆L = record { eq→ = lem03 ; eq← = lem04 } where lem03 : {z : Ordinal} → odef (L \ (L \ x)) z → odef x z - lem03 {z} ⟪ Lz , Lxz ⟫ with ODC.∋-p O x (* z) + lem03 {z} ⟪ Lz , Lxz ⟫ with ODC.∋-p O HODAxiom AC x (* z) ... | yes y = subst (λ k → odef x k ) &iso y ... | no n = ⊥-elim ( Lxz ⟪ Lz , ( subst (λ k → ¬ odef x k ) &iso n ) ⟫ ) lem04 : {z : Ordinal} → odef x z → odef (L \ (L \ x)) z - lem04 {z} xz with ODC.∋-p O L (* z) + lem04 {z} xz with ODC.∋-p O HODAxiom AC L (* z) ... | yes y = ⟪ subst (λ k → odef L k ) &iso y , ( λ p → proj2 p xz ) ⟫ ... | no n = ⊥-elim ( n (subst (λ k → odef L k ) (sym &iso) ( x⊆L xz) )) -L\0=L : { L : HOD } → L \ od∅ ≡ L -L\0=L {L} = ==→o≡ ( record { eq→ = lem05 ; eq← = lem06 } ) where +L\0=L : { L : HOD } → (L \ od∅) =h= L +L\0=L {L} = record { eq→ = lem05 ; eq← = lem06 } where lem05 : {x : Ordinal} → odef (L \ od∅) x → odef L x lem05 {x} ⟪ Lx , _ ⟫ = Lx lem06 : {x : Ordinal} → odef L x → odef (L \ od∅) x lem06 {x} Lx = ⟪ Lx , (λ lt → ¬x<0 lt) ⟫ ∨L\X : { L X : HOD } → {x : Ordinal } → odef L x → odef X x ∨ odef (L \ X) x -∨L\X {L} {X} {x} Lx with ODC.∋-p O X (* x) +∨L\X {L} {X} {x} Lx with ODC.∋-p O HODAxiom AC X (* x) ... | yes y = case1 ( subst (λ k → odef X k ) &iso y ) ... | no n = case2 ⟪ Lx , subst (λ k → ¬ odef X k) &iso n ⟫ \-⊆ : { P A B : HOD } → A ⊆ P → ( A ⊆ B → ( P \ B ) ⊆ ( P \ A )) ∧ (( P \ B ) ⊆ ( P \ A ) → A ⊆ B ) \-⊆ {P} {A} {B} A⊆P = ⟪ ( λ a ¬a ¬b c = ⊥-elim (ω-prev-eq1 (sym eq) c) +Omega-inject : {x y : Ordinal} → & (Union (* y , (* y , * y))) ≡ & (Union (* x , (* x , * x))) → y ≡ x +Omega-inject {x} {y} eq with trio< x y +Omega-inject {x} {y} eq | tri< a ¬b ¬c = ⊥-elim (ω-prev-eq1 eq a) +Omega-inject {x} {y} eq | tri≈ ¬a b ¬c = (sym b) +Omega-inject {x} {y} eq | tri> ¬a ¬b c = ⊥-elim (ω-prev-eq1 (sym eq) c) ω-inject : {x y : HOD} → Union ( y , ( y , y)) =h= Union ( x , ( x , x)) → y =h= x -ω-inject {x} {y} eq = ord→== ( ω-prev-eq (==→o≡ (==-trans Omega-iso (==-trans eq (==-sym Omega-iso))))) +ω-inject {x} {y} eq = ord→== ( Omega-inject (==→o≡ (==-trans Omega-iso (==-trans eq (==-sym Omega-iso))))) ω-∈s : (x : HOD) → Union ( x , (x , x)) ∋ x ω-∈s x = record { owner = & ( x , x ) ; ao = case2 refl ; ox = eq→ *iso== (case2 refl) } -ωs≠0 : (x : HOD) → ¬ ( Union ( x , (x , x)) ≡ od∅ ) -ωs≠0 y eq = ⊥-elim ( ¬x<0 (subst (λ k → & y o< k ) ord-od∅ (c<→o< (subst (λ k → odef k (& y )) eq (ω-∈s y) ))) ) +ωs≠0 : (x : HOD) → ¬ ( Union ( x , (x , x)) =h= od∅ ) +ωs≠0 x = ∅< {Union ( x , ( x , x))} (ω-∈s _) + +ω→nato-cong : {n m : Ordinal} → (x : odef (Omega ho< ) n) (y : odef (Omega ho< ) m) → n ≡ m → ω→nato x ≡ ω→nato y +ω→nato-cong OD.iφ OD.iφ eq = refl +ω→nato-cong OD.iφ (OD.isuc {x} y) eq = ⊥-elim ( ∅< {Union (* x , (* x , * x))} {* x} (ω-∈s _) (≡o∅→=od∅ (sym eq) ) ) +ω→nato-cong (OD.isuc {x} y) OD.iφ eq = ⊥-elim ( ∅< {Union (* x , (* x , * x))} {* x} (ω-∈s _) (≡o∅→=od∅ eq ) ) +ω→nato-cong (OD.isuc x) (OD.isuc y) eq = cong Suc ( ω→nato-cong x y (Omega-inject eq) ) ωs0 : o∅ ≡ & (nat→ω 0) ωs0 = trans (sym ord-od∅) (cong (&) refl ) +Omega-subst : (x y : HOD) → x =h= y → Union ( x , (x , x)) =h= Union ( y , (y , y)) +Omega-subst x y x=y = begin + Union (x , (x , x)) ≈⟨ ==-sym Omega-iso ⟩ + Union (* (& x) , (* (& x) , * (& x))) ≈⟨ ord→== (cong (λ k → & (Union (* k , (* k , * k )))) (==→o≡ x=y) ) ⟩ + Union (* (& y) , (* (& y) , * (& y))) ≈⟨ Omega-iso ⟩ + Union (y , (y , y)) ∎ where open EqR ==-Setoid + nat→ω-iso : {i : HOD} → (lt : Omega ho< ∋ i ) → nat→ω ( ω→nat i lt ) =h= i -nat→ω-iso {i} lt = ? where - nat→ω-iso-ord : (x : Ordinal) → odef (Omega ho< ) x → nat→ω ( ω→nat (* x) ? ) =h= (* x) - nat→ω-iso-ord x OD.iφ = ? - nat→ω-iso-ord x (OD.isuc lt) = ? --- -- ε-induction {λ i → Lift (suc n) ((lt : Omega ho< ∋ i ) → nat→ω ( ω→nat i lt ) =h= i) } ind i where --- ind : {x : HOD} → ({y : HOD} → x ∋ y → Lift (suc n) ((lt : Omega ho< ∋ y) → nat→ω (ω→nat y lt) =h= y)) → --- (Lift (suc n) ((lt : Omega ho< ∋ x) → nat→ω (ω→nat x lt) =h= x)) --- ind {x} prev = ? where --- ind1 : {ox : Ordinal } → (ltd : Omega-d ox ) → * ox =h= x → nat→ω (ω→nato ltd) =h= x --- ind1 {o∅} iφ eq = ==-sym ? --- ind1 (isuc {x₁} ltd) ox=x = ? where --- -- begin --- -- nat→ω (ω→nato (isuc ltd) ) --- -- ≡⟨⟩ --- -- Union (nat→ω (ω→nato ltd) , (nat→ω (ω→nato ltd) , nat→ω (ω→nato ltd))) --- -- ≡⟨ cong (λ k → Union (k , (k , k ))) lemma ⟩ --- -- Union (* x₁ , (* x₁ , * x₁)) --- -- ≡⟨ trans ( sym ? ) ox=x ⟩ --- -- x --- -- ∎ where --- open ≡-Reasoning --- lemma0 : x ∋ * x₁ --- lemma0 = eq→ ox=x (eq→ *iso== --- record { owner = & ( * x₁ , * x₁ ) ; ao = case2 refl ; ox = eq→ *iso== (case1 refl) }) --- lemma1 : Omega ho< ∋ * x₁ --- lemma1 = subst (λ k → odef (Omega ho<) k) (sym &iso) ltd --- lemma3 : {x y : Ordinal} → (ltd : Omega-d x ) (ltd1 : Omega-d y ) → y ≡ x → ? -- ltd ? ltd1 --- lemma3 = ? --- -- lemma3 iφ (isuc {y} ltd1) eq = ⊥-elim ( ¬x<0 (subst₂ (λ j k → j o< k ) &iso eq (c<→o< (ω-∈s (* y)) ))) --- -- lemma3 (isuc {y} ltd) iφ eq = ⊥-elim ( ¬x<0 (subst₂ (λ j k → j o< k ) &iso (sym eq) (c<→o< (ω-∈s (* y)) ))) --- -- lemma3 (isuc {x} ltd) (isuc {y} ltd1) eq with lemma3 ltd ltd1 (ω-prev-eq (eq)) --- -- ... | t = ? -- HE.cong₂ (λ j k → isuc {j} k ) (HE.≡-to-≅ (ω-prev-eq (sym eq))) t --- lemma2 : {x y : Ordinal} → (ltd : Omega-d x ) (ltd1 : Omega-d y ) → y ≡ x → ω→nato ltd ≡ ω→nato ltd1 --- lemma2 {x} {y} ltd ltd1 eq = lemma6 eq (lemma3 {x} {y} ltd ltd1 eq) where --- lemma6 : {x y : Ordinal} → {ltd : Omega-d x } {ltd1 : Omega-d y } → y ≡ x → ? → ω→nato ltd ≡ ω→nato ltd1 --- lemma6 = ? -- refl HE.refl = refl --- lemma : nat→ω (ω→nato ltd) =h= * x₁ --- lemma = ? -- trans (cong (λ k → nat→ω k) (lemma2 {x₁} {_} ltd (subst (λ k → Omega-d k ) (sym &iso) ltd) &iso ) ) ( prev {* x₁} lemma0 lemma1 ) +nat→ω-iso {i} lt = ==-trans (nat→ω-iso-ord _ lt) (==-sym *iso==) where + nat→ω-iso-ord : (x : Ordinal) → (lt : odef (Omega ho< ) x) → nat→ω ( ω→nato lt ) =h= (* x) + nat→ω-iso-ord _ OD.iφ = ==-sym o∅==od∅ + nat→ω-iso-ord x (OD.isuc OD.iφ) = ==-trans (Omega-subst _ _ (==-sym o∅==od∅)) *iso== + nat→ω-iso-ord x (OD.isuc (OD.isuc {y} lt)) = ==-trans (Omega-subst _ _ + (==-trans (Omega-subst _ _ lem02 ) *iso==) ) *iso== where + lem02 : nat→ω ( ω→nato lt ) =h= (* y) + lem02 = nat→ω-iso-ord y lt - -ω→nat-iso0 : (x : Nat) → {ox : Ordinal } → (ltd : Omega-d ox) → * ox ≡ nat→ω x → ω→nato ltd ≡ x +ω→nat-iso0 : (x : Nat) → {ox : Ordinal } → (ltd : Omega-d ox) → * ox =h= nat→ω x → ω→nato ltd ≡ x ω→nat-iso0 Zero iφ eq = refl -ω→nat-iso0 (Suc x) iφ eq = ⊥-elim ( ωs≠0 _ (trans (sym eq) ? )) -ω→nat-iso0 Zero (isuc ltd) eq = ⊥-elim ( ωs≠0 _ (subst (λ k → k ≡ od∅ ) ? eq )) +ω→nat-iso0 (Suc x) iφ eq = ⊥-elim ( ωs≠0 _ (begin + Union (nat→ω x , (nat→ω x , nat→ω x)) ≈⟨ ==-sym eq ⟩ + * o∅ ≈⟨ o∅==od∅ ⟩ + od∅ ∎ )) where open EqR ==-Setoid +ω→nat-iso0 Zero (isuc ltd) eq = ⊥-elim ( ωs≠0 _ (==-trans *iso== eq) ) ω→nat-iso0 (Suc i) (isuc {x} ltd) eq = cong Suc ( ω→nat-iso0 i ltd (lemma1 eq) ) where - lemma1 : * (& (Union (* x , (* x , * x)))) ≡ Union (nat→ω i , (nat→ω i , nat→ω i)) → * x ≡ nat→ω i - lemma1 eq = subst (λ k → * x ≡ k ) ? (cong (λ k → * k) - (sym ( ω-prev-eq (subst (λ k → _ ≡ k ) &iso (cong (λ k → & k ) (sym - (subst (λ k → _ ≡ Union ( k , ( k , k ))) (sym ? ) eq ))))))) + lemma1 : * (& (Union (* x , (* x , * x)))) =h= Union (nat→ω i , (nat→ω i , nat→ω i)) → * x =h= nat→ω i + lemma1 eq = begin + * x ≈⟨ (o≡→== ( Omega-inject (==→o≡ (begin + Union (* x , (* x , * x)) ≈⟨ *iso== ⟩ + * (& ( Union (* x , (* x , * x)))) ≈⟨ eq ⟩ + Union ((nat→ω i) , (nat→ω i , nat→ω i)) ≈⟨ ==-sym Omega-iso ⟩ + Union (* (& (nat→ω i)) , (* (& (nat→ω i)) , * (& (nat→ω i)))) ∎ )) )) ⟩ + * (& ( nat→ω i)) ≈⟨ (==-sym *iso==) ⟩ + nat→ω i ∎ where open EqR ==-Setoid ω→nat-iso : {i : Nat} → ω→nat ( nat→ω i ) (ω∋nat→ω {i}) ≡ i -ω→nat-iso {i} = ω→nat-iso0 i (ω∋nat→ω {i}) ? +ω→nat-iso {i} = ω→nat-iso0 i (ω∋nat→ω {i}) (==-sym *iso==) -nat→ω-inject : {i j : Nat} → nat→ω i ≡ nat→ω j → i ≡ j +nat→ω-inject : {i j : Nat} → nat→ω i =h= nat→ω j → i ≡ j nat→ω-inject {Zero} {Zero} eq = refl -nat→ω-inject {Zero} {Suc j} eq = ⊥-elim ( ¬0=ux (trans (trans (sym ord-od∅) (cong (&) eq)) refl )) -nat→ω-inject {Suc i} {Zero} eq = ⊥-elim ( ¬0=ux (trans (trans (sym ord-od∅) (cong (&) (sym eq))) refl )) -nat→ω-inject {Suc i} {Suc j} eq = ? -- cong Suc (nat→ω-inject {i} {j} ( ω-inject ? )) +nat→ω-inject {Zero} {Suc j} eq = ⊥-elim ( ∅< {Union (nat→ω j , (nat→ω j , nat→ω j))} (ω-∈s _) (==-sym eq) ) +nat→ω-inject {Suc i} {Zero} eq = ⊥-elim ( ∅< {Union (nat→ω i , (nat→ω i , nat→ω i))} (ω-∈s _) eq ) +nat→ω-inject {Suc i} {Suc j} eq = cong Suc (nat→ω-inject {i} {j} ( ω-inject eq )) Repl⊆ : {A B : HOD} (A⊆B : A ⊆ B) → { ψa : ( x : HOD) → A ∋ x → HOD } { ψb : ( x : HOD) → B ∋ x → HOD } → {Ca : HOD} → {rca : RXCod A Ca ψa } @@ -282,17 +250,3 @@ lem03 : odef (* (& P)) (& (p ∩ q)) lem03 = eq→ *iso== ( each (ppx _ xz) (ppy _ yz) ) --- ∋-irr : {X x : HOD} → (a b : X ∋ x ) → a ≡ b --- ∋-irr {X} {x} _ _ = refl --- is requireed in --- Replace∩ : {X P Q : HOD} → {ψ : (x : HOD) → X ∋ x → HOD} → (P⊆X : P ⊆ X) → (Q⊆X : Q ⊆ X ) --- → {C : HOD} → (rc : RXCod X C ψ ) --- → ( {x : HOD} → (a b : X ∋ x ) → ψ x a ≡ ψ x b ) --- → Replace' (P ∩ Q) (λ _ pq → ψ _ (P⊆X (proj1 pq ))) {C} record { ≤COD = λ lt → RXCod.≤COD rc ? } ⊆ ( Replace' P (λ _ p → ψ _ (P⊆X p)) ? ∩ Replace' Q (λ _ q → ψ _ (Q⊆X q)) ? ) --- Replace∩ {X} {P} {Q} {ψ} P⊆X Q⊆X rc ψ-irr = lem04 where --- lem04 : {x : Ordinal} → OD.def (od (Replace' (P ∩ Q) (λ z pq → ψ z (P⊆X (proj1 pq)) ) ? )) x --- → OD.def (od (Replace' P (λ z p → ψ z (P⊆X p) ) ? ∩ Replace' Q (λ z q → ψ z (Q⊆X q)) ? )) x --- lem04 {x} record { z = z ; az = az ; x=ψz = x=ψz } = ⟪ --- record { z = _ ; az = proj1 az ; x=ψz = trans x=ψz (cong (&)(ψ-irr _ _)) } , --- record { z = _ ; az = proj2 az ; x=ψz = trans x=ψz (cong (&)(ψ-irr _ _)) } ⟫ -