Mercurial > hg > Members > kono > Proof > ZF-in-agda
changeset 1461:fa52d72f4bb3
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 01 Jan 2024 18:21:36 +0900 |
parents | d1b6fb58aad0 |
children | 76df157f6a3f |
files | ZF.agda-lib src/OD.agda src/OrdUtil.agda src/Ordinals.agda src/Tychonoff.agda src/ZProduct.agda src/bijection.agda src/logic.agda src/nat.agda src/ordinal.agda src/zf.agda |
diffstat | 11 files changed, 264 insertions(+), 263 deletions(-) [+] |
line wrap: on
line diff
--- a/ZF.agda-lib Sat Aug 26 10:36:09 2023 +0900 +++ b/ZF.agda-lib Mon Jan 01 18:21:36 2024 +0900 @@ -1,3 +1,6 @@ name: ZF depend: standard-library include: src +flags: + --warning=noUnsupportedIndexedMatch +
--- a/src/OD.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/OD.agda Mon Jan 01 18:21:36 2024 +0900 @@ -1,7 +1,8 @@ -{-# OPTIONS --allow-unsolved-metas #-} +{-# OPTIONS --cubical-compatible --safe #-} open import Level open import Ordinals -module OD {n : Level } (O : Ordinals {n} ) where +import HODBase +module OD {n : Level } (O : Ordinals {n} ) (HODAxiom : HODBase.ODAxiom O) where open import Data.Nat renaming ( zero to Zero ; suc to Suc ; ℕ to Nat ; _⊔_ to _n⊔_ ) open import Relation.Binary.PropositionalEquality hiding ( [_] ) @@ -23,87 +24,25 @@ -- Ordinal Definable Set -record OD : Set (suc n ) where - field - def : (x : Ordinal ) → Set n - -open OD +open HODBase.HOD +open HODBase.OD open _∧_ open _∨_ open Bool -record _==_ ( a b : OD ) : Set n where - field - eq→ : ∀ { x : Ordinal } → def a x → def b x - eq← : ∀ { x : Ordinal } → def b x → def a x - -==-refl : { x : OD } → x == x -==-refl {x} = record { eq→ = λ x → x ; eq← = λ x → x } - -open _==_ +open HODBase._==_ -==-trans : { x y z : OD } → x == y → y == z → x == z -==-trans x=y y=z = record { eq→ = λ {m} t → eq→ y=z (eq→ x=y t) ; eq← = λ {m} t → eq← x=y (eq← y=z t) } - -==-sym : { x y : OD } → x == y → y == x -==-sym x=y = record { eq→ = λ {m} t → eq← x=y t ; eq← = λ {m} t → eq→ x=y t } - - -⇔→== : { x y : OD } → ( {z : Ordinal } → (def x z ⇔ def y z)) → x == y -eq→ ( ⇔→== {x} {y} eq ) {z} m = proj1 eq m -eq← ( ⇔→== {x} {y} eq ) {z} m = proj2 eq m +open HODBase.ODAxiom HODAxiom --- --- OD is an equation on Ordinals, so it contains Ordinals. If these Ordinals have one-to-one --- correspondence to the OD then the OD looks like a ZF Set. --- --- If all ZF Set have supreme upper bound, the solutions of OD have to be bounded, i.e. --- bbounded ODs are ZF Set. Unbounded ODs are classes. --- --- In classical Set Theory, HOD is used, as a subset of OD, --- HOD = { x | TC x ⊆ OD } --- where TC x is a transitive clusure of x, i.e. Union of all elemnts of all subset of x. --- This is not possible because we don't have V yet. So we assumes HODs are bounded OD. --- --- We also assumes HODs are isomorphic to Ordinals, which is ususally proved by Goedel number tricks. --- There two contraints on the HOD order, one is ∋, the other one is ⊂. --- ODs have an ovbious maximum, but Ordinals are not, but HOD has no maximum because there is an aribtrary --- bound on each HOD. --- --- In classical Set Theory, sup is defined by Uion, since we are working on constructive logic, --- we need explict assumption on sup for unrestricted Replacement. --- --- ==→o≡ is necessary to prove axiom of extensionality. - --- Ordinals in OD , the maximum -Ords : OD -Ords = record { def = λ x → Lift n ⊤ } - -record HOD : Set (suc n) where - field - od : OD - odmax : Ordinal - <odmax : {y : Ordinal} → def od y → y o< odmax - -open HOD - -open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) - -record ODAxiom : Set (suc n) where - field - -- HOD is isomorphic to Ordinal (by means of Goedel number) - & : HOD → Ordinal - * : Ordinal → HOD - c<→o< : {x y : HOD } → def (od y) ( & x ) → & x o< & y - ⊆→o≤ : {y z : HOD } → ({x : Ordinal} → def (od y) x → def (od z) x ) → & y o< osuc (& z) - *iso : {x : HOD } → * ( & x ) ≡ x - &iso : {x : Ordinal } → & ( * x ) ≡ x - ==→o≡ : {x y : HOD } → (od x == od y) → x ≡ y - ∋-irr : {X : HOD} {x : Ordinal } → (a b : def (od X) x) → a ≅ b - -postulate odAxiom : ODAxiom -open ODAxiom odAxiom +HOD = HODBase.HOD O +OD = HODBase.OD O +Ords = HODBase.Ords O +_==_ = HODBase._==_ O +==-refl = HODBase.==-refl O +==-trans = HODBase.==-trans O +==-sym = HODBase.==-sym O +⇔→== = HODBase.⇔→== O -- possible order restriction (required in the axiom of Omega ) @@ -152,12 +91,12 @@ otrans x<a y<x = ordtrans y<x x<a -- If we have reverse of c<→o<, everything becomes Ordinal -∈→c<→HOD=Ord : ( o<→c< : {x y : Ordinal } → x o< y → odef (* y) x ) → {x : HOD } → x ≡ Ord (& x) -∈→c<→HOD=Ord o<→c< {x} = ==→o≡ ( record { eq→ = lemma1 ; eq← = lemma2 } ) where +∈→c<→HOD=Ord : ( o<→c< : {x y : Ordinal } → x o< y → odef (* y) x ) → {x : HOD } → od x == od (Ord (& x)) +∈→c<→HOD=Ord o<→c< {x} = record { eq→ = lemma1 ; eq← = lemma2 } where lemma1 : {y : Ordinal} → odef x y → odef (Ord (& x)) y lemma1 {y} lt = subst ( λ k → k o< & x ) &iso (c<→o< {* y} {x} (d→∋ x lt)) lemma2 : {y : Ordinal} → odef (Ord (& x)) y → odef x y - lemma2 {y} lt = subst (λ k → odef k y ) *iso (o<→c< {y} {& x} lt ) + lemma2 {y} lt = eq→ *iso (o<→c< {y} {& x} lt ) -- avoiding lv != Zero error orefl : { x : HOD } → { y : Ordinal } → & x ≡ y → & x ≡ y @@ -165,14 +104,11 @@ ==-iso : { x y : HOD } → od (* (& x)) == od (* (& y)) → od x == od y ==-iso {x} {y} eq = record { - eq→ = λ {z} d → lemma ( eq→ eq (subst (λ k → odef k z ) (sym *iso) d )) ; - eq← = λ {z} d → lemma ( eq← eq (subst (λ k → odef k z ) (sym *iso) d )) } - where - lemma : {x : HOD } {z : Ordinal } → odef (* (& x)) z → odef x z - lemma {x} {z} d = subst (λ k → odef k z) (*iso) d + eq→ = λ {z} d → eq→ *iso ( eq→ eq (eq← *iso d) ) ; + eq← = λ {z} d → eq→ *iso ( eq← eq (eq← *iso d) ) } -=-iso : {x y : HOD } → (od x == od y) ≡ (od (* (& x)) == od y) -=-iso {_} {y} = cong ( λ k → od k == od y ) (sym *iso) +-- =-iso : {x y : HOD } → (od x == od y) ≡ (od (* (& x)) == od y) +-- =-iso {_} {y} = cong ( λ k → od k == od y ) ? -- (sym *iso) ord→== : { x y : HOD } → & x ≡ & y → od x == od y ord→== {x} {y} eq = ==-iso (lemma (& x) (& y) (orefl eq)) where @@ -185,11 +121,11 @@ *≡*→≡ : { x y : Ordinal } → * x ≡ * y → x ≡ y *≡*→≡ eq = subst₂ (λ j k → j ≡ k ) &iso &iso ( cong (&) eq ) -&≡&→≡ : { x y : HOD } → & x ≡ & y → x ≡ y -&≡&→≡ eq = subst₂ (λ j k → j ≡ k ) *iso *iso ( cong (*) eq ) +--- &≡&→≡ : { x y : HOD } → & x ≡ & y → x ≡ y +-- &≡&→≡ eq = ? -- subst₂ (λ j k → j ≡ k ) *iso *iso ( cong (*) eq ) -o∅≡od∅ : * (o∅ ) ≡ od∅ -o∅≡od∅ = ==→o≡ lemma where +o∅==od∅ : od ( * (o∅ )) == od od∅ +o∅==od∅ = lemma where lemma0 : {x : Ordinal} → odef (* o∅) x → odef od∅ x lemma0 {x} lt with c<→o< {* x} {* o∅} (subst (λ k → odef (* o∅) k ) (sym &iso) lt) ... | t = subst₂ (λ j k → j o< k ) &iso &iso t @@ -199,14 +135,14 @@ lemma = record { eq→ = lemma0 ; eq← = lemma1 } ord-od∅ : & (od∅ ) ≡ o∅ -ord-od∅ = sym ( subst (λ k → k ≡ & (od∅ ) ) &iso (cong ( λ k → & k ) o∅≡od∅ ) ) +ord-od∅ = trans (==→o≡ (==-sym o∅==od∅)) &iso ≡o∅→=od∅ : {x : HOD} → & x ≡ o∅ → od x == od od∅ ≡o∅→=od∅ {x} eq = record { eq→ = λ {y} lt → ⊥-elim ( ¬x<0 {y} (subst₂ (λ j k → j o< k ) &iso eq ( c<→o< {* y} {x} (d→∋ x lt)))) ; eq← = λ {y} lt → ⊥-elim ( ¬x<0 lt )} =od∅→≡o∅ : {x : HOD} → od x == od od∅ → & x ≡ o∅ -=od∅→≡o∅ {x} eq = trans (cong (λ k → & k ) (==→o≡ {x} {od∅} eq)) ord-od∅ +=od∅→≡o∅ {x} eq = trans (==→o≡ {x} {od∅} eq) ord-od∅ ≡od∅→=od∅ : {x : HOD} → x ≡ od∅ → od x == od od∅ ≡od∅→=od∅ {x} eq = ≡o∅→=od∅ (subst (λ k → & x ≡ k ) ord-od∅ ( cong & eq ) ) @@ -219,7 +155,7 @@ ∅< {x} {y} d eq with eq→ (==-trans eq (==-sym ∅0) ) d ∅< {x} {y} d eq | lift () -¬x∋y→x≡od∅ : { x : HOD } → ({y : Ordinal } → ¬ odef x y ) → x ≡ od∅ +¬x∋y→x≡od∅ : { x : HOD } → ({y : Ordinal } → ¬ odef x y ) → (& x) ≡ & od∅ ¬x∋y→x≡od∅ {x} nxy = ==→o≡ record { eq→ = λ {y} lt → ⊥-elim (nxy lt) ; eq← = λ {y} lt → ⊥-elim (¬x<0 lt) } 0<P→ne : { x : HOD } → o∅ o< & x → ¬ ( od x == od od∅ ) @@ -284,7 +220,7 @@ → {x y : HOD } → def (od y) ( & x ) → & x o< & y ⊆→o≤→c<→o< peq ⊆→o≤ {x} {y} y∋x with trio< (& x) (& y) ⊆→o≤→c<→o< peq ⊆→o≤ {x} {y} y∋x | tri< a ¬b ¬c = a -⊆→o≤→c<→o< peq ⊆→o≤ {x} {y} y∋x | tri≈ ¬a b ¬c = ⊥-elim ( o<¬≡ (peq {x}) (pair<y (subst (λ k → k ∋ x) (sym ( ==→o≡ {x} {y} (ord→== b))) y∋x ))) +⊆→o≤→c<→o< peq ⊆→o≤ {x} {y} y∋x | tri≈ ¬a b ¬c = ⊥-elim ( o<¬≡ (peq {x}) (pair<y (eq← (ord→== b) y∋x ) ) ) ⊆→o≤→c<→o< peq ⊆→o≤ {x} {y} y∋x | tri> ¬a ¬b c = ⊥-elim ( o<> (⊆→o≤ {x , x} {y} y⊆x,x ) lemma1 ) where lemma : {z : Ordinal} → (z ≡ & x) ∨ (z ≡ & x) → & x ≡ z @@ -298,20 +234,25 @@ ε-induction : { ψ : HOD → Set (suc n)} → ( {x : HOD } → ({ y : HOD } → x ∋ y → ψ y ) → ψ x ) → (x : HOD ) → ψ x -ε-induction {ψ} ind x = subst (λ k → ψ k ) *iso (ε-induction-ord (osuc (& x)) <-osuc ) where - induction : (ox : Ordinal) → ((oy : Ordinal) → oy o< ox → ψ (* oy)) → ψ (* ox) - induction ox prev = ind ( λ {y} lt → subst (λ k → ψ k ) *iso (prev (& y) (o<-subst (c<→o< lt) refl &iso ))) - ε-induction-ord : (ox : Ordinal) { oy : Ordinal } → oy o< ox → ψ (* oy) - ε-induction-ord ox {oy} lt = TransFinite {λ oy → ψ (* oy)} induction oy +ε-induction {ψ} ind x = ε-induction-hod _ {& x} <-osuc x <-osuc where + induction2 : (x₁ : Ordinal) → + ((y : Ordinal) → y o< x₁ → (y₁ : HOD) → & y₁ o< osuc y → ψ y₁) → + (y : HOD) → & y o< osuc x₁ → ψ y + induction2 x prev y y≤x = ind (λ {y₁} lt → prev (& y₁) (lemma1 y₁ lt) y₁ <-osuc ) where + lemma1 : (y₁ : HOD) → y ∋ y₁ → & y₁ o< x + lemma1 y₁ lt with trio< (& y₁) x + ... | tri< a ¬b ¬c = a + ... | tri> ¬a ¬b c = ⊥-elim (o≤> (ordtrans (c<→o< lt) y≤x) c ) + ... | tri≈ ¬a b ¬c with osuc-≡< y≤x + ... | case1 y=x = subst (λ k → & y₁ o< k ) y=x (c<→o< lt) + ... | case2 y<x = ⊥-elim ( o<¬≡ b ( (ordtrans (c<→o< lt) y<x) )) + ε-induction-hod : (ox : Ordinal) { oy : Ordinal } → oy o< ox → (y : HOD) → & y o< osuc oy → ψ y + ε-induction-hod ox {oy} lt = TransFinite {λ oy → (y : HOD) → & y o< osuc oy → ψ y} induction2 oy -ε-induction0 : { ψ : HOD → Set n} - → ( {x : HOD } → ({ y : HOD } → x ∋ y → ψ y ) → ψ x ) - → (x : HOD ) → ψ x -ε-induction0 {ψ} ind x = subst (λ k → ψ k ) *iso (ε-induction-ord (osuc (& x)) <-osuc ) where - induction : (ox : Ordinal) → ((oy : Ordinal) → oy o< ox → ψ (* oy)) → ψ (* ox) - induction ox prev = ind ( λ {y} lt → subst (λ k → ψ k ) *iso (prev (& y) (o<-subst (c<→o< lt) refl &iso ))) - ε-induction-ord : (ox : Ordinal) { oy : Ordinal } → oy o< ox → ψ (* oy) - ε-induction-ord ox {oy} lt = inOrdinal.TransFinite0 O {λ oy → ψ (* oy)} induction oy +-- we cannot prove this... +-- ε-induction0 : { ψ : HOD → Set n} +-- → ( {x : HOD } → ({ y : HOD } → x ∋ y → ψ y ) → ψ x ) +-- → (x : HOD ) → ψ x -- Open supreme upper bound leads a contradition, so we use domain restriction on sup ¬open-sup : ( sup-o : (Ordinal → Ordinal ) → Ordinal) → ((ψ : Ordinal → Ordinal ) → (x : Ordinal) → ψ x o< sup-o ψ ) → ⊥ @@ -339,7 +280,7 @@ umax1 = odef< (Own.ao uy) union→ : (X z u : HOD) → (X ∋ u) ∧ (u ∋ z) → Union X ∋ z -union→ X z u xx = record { owner = & u ; ao = proj1 xx ; ox = subst (λ k → odef k (& z)) (sym *iso) (proj2 xx) } +union→ X z u xx = record { owner = & u ; ao = proj1 xx ; ox = eq← *iso (proj2 xx) } union← : (X z : HOD) (X∋z : Union X ∋ z) → ¬ ( (u : HOD ) → ¬ ((X ∋ u) ∧ (u ∋ z ))) union← X z UX∋z not = ⊥-elim ( not (* (Own.owner UX∋z)) ⟪ subst (λ k → odef X k) (sym &iso) ( Own.ao UX∋z) , Own.ox UX∋z ⟫ ) @@ -366,7 +307,7 @@ r01 = sym (Replaced.x=ψz lt ) replacement← : {ψ : HOD → HOD} (X x : HOD) → X ∋ x → {C : HOD} → (rc : RCod C ψ) → Replace X ψ rc ∋ ψ x -replacement← {ψ} X x lt {C} rc = record { z = & x ; az = lt ; x=ψz = cong (λ k → & (ψ k)) (sym *iso) } +replacement← {ψ} X x lt {C} rc = record { z = & x ; az = lt ; x=ψz = cong (λ k → & (ψ k)) ? } replacement→ : {ψ : HOD → HOD} (X x : HOD) → {C : HOD} → (rc : RCod C ψ ) → (lt : Replace X ψ rc ∋ x) → ¬ ( (y : HOD) → ¬ (x =h= ψ y)) replacement→ {ψ} X x {C} rc lt eq = eq (* (Replaced.z lt)) (ord→== (Replaced.x=ψz lt)) @@ -378,6 +319,7 @@ record RXCod (X COD : HOD) (ψ : (x : HOD) → X ∋ x → HOD) : Set (suc n) where field ≤COD : ∀ {x : HOD } → (lt : X ∋ x) → ψ x lt ⊆ COD + ψ-eq : ∀ {x : HOD } → (lt lt1 : X ∋ x) → ψ x lt ≡ ψ x lt1 record Replaced1 (A : HOD) (ψ : (x : Ordinal ) → odef A x → Ordinal ) (x : Ordinal ) : Set n where field @@ -393,14 +335,15 @@ r01 = sym (Replaced1.x=ψz lt ) cod-conv : (X : HOD) → (ψ : (x : HOD) → X ∋ x → HOD) → {C : HOD} → (rc : RXCod X C ψ ) - → RXCod (* (& X)) C (λ y xy → ψ y (subst (λ k → k ∋ y) *iso xy)) -cod-conv X ψ {C} rc = record { ≤COD = λ {x} lt → RXCod.≤COD rc (subst (λ k → odef k (& x)) *iso lt) } + → RXCod (* (& X)) C (λ y xy → ψ y (eq→ *iso xy)) +cod-conv X ψ {C} rc = record { ≤COD = λ {x} lt → RXCod.≤COD rc (eq→ *iso lt ) + ; ψ-eq = λ {x} lt lt1 → RXCod.ψ-eq rc (eq→ *iso lt) (eq→ *iso lt1) } Replace'-iso : {X Y : HOD} → {fx : (x : HOD) → X ∋ x → HOD} {fy : (x : HOD) → Y ∋ x → HOD} → {CX : HOD} → (rcx : RXCod X CX fx ) → {CY : HOD} → (rcy : RXCod Y CY fy ) → X ≡ Y → ( (x : HOD) → (xx : X ∋ x ) → (yy : Y ∋ x ) → fx _ xx ≡ fy _ yy ) - → Replace' X fx rcx ≡ Replace' Y fy rcy -Replace'-iso {X} {X} {fx} {fy} _ _ refl eq = ==→o≡ record { eq→ = ri0 ; eq← = ri1 } where + → od (Replace' X fx rcx ) == od (Replace' Y fy rcy) +Replace'-iso {X} {X} {fx} {fy} _ _ refl eq = record { eq→ = ri0 ; eq← = ri1 } where ri0 : {x : Ordinal} → Replaced1 X (λ z xz → & (fx (* z) (subst (odef X) (sym &iso) xz))) x → Replaced1 X (λ z xz → & (fy (* z) (subst (odef X) (sym &iso) xz))) x ri0 {x} record { z = z ; az = az ; x=ψz = x=ψz } = record { z = z ; az = az ; x=ψz = trans x=ψz (cong (&) ( eq _ xz xz )) } where @@ -413,18 +356,19 @@ xz = subst (λ k → odef X k ) (sym &iso) az Replace'-iso1 : (X : HOD) → (ψ : (x : HOD) → X ∋ x → HOD) → {C : HOD} → (rc : RXCod X C ψ ) - → Replace' (* (& X)) (λ y xy → ψ y (subst (λ k → k ∋ y ) *iso xy) ) (cod-conv X ψ rc) - ≡ Replace' X ( λ y xy → ψ y xy ) rc -Replace'-iso1 X ψ rc = Replace'-iso {* (& X)} {X} {λ y xy → ψ y (subst (λ k → k ∋ y ) *iso xy) } { λ y xy → ψ y xy } - (cod-conv X ψ rc) rc - *iso (λ x xx yx → fi00 x xx yx ) where - fi00 : (x : HOD ) → (xx : (* (& X)) ∋ x ) → (yx : X ∋ x) → ψ x (subst (λ k → k ∋ x) *iso xx) ≡ ψ x yx - fi00 x xx yx = cong (λ k → ψ x k ) ( HE.≅-to-≡ ( ∋-irr {X} {& x} (subst (λ k → k ∋ x) *iso xx) yx ) ) - --- replacement←1 : {ψ : HOD → HOD} (X x : HOD) → X ∋ x → Replace1 X ψ ∋ ψ x --- replacement←1 {ψ} X x lt = record { z = & x ; az = lt ; x=ψz = cong (λ k → & (ψ k)) (sym *iso) } --- replacement→1 : {ψ : HOD → HOD} (X x : HOD) → (lt : Replace1 X ψ ∋ x) → ¬ ( (y : HOD) → ¬ (x =h= ψ y)) --- replacement→1 {ψ} X x lt eq = eq (* (Replaced.z lt)) (ord→== (Replaced.x=ψz lt)) + → od (Replace' (* (& X)) (λ y xy → ψ y (eq→ *iso xy) ) (cod-conv X ψ rc)) + == od ( Replace' X ( λ y xy → ψ y xy ) rc ) +Replace'-iso1 X ψ rc = record { eq→ = ri0 ; eq← = ri1 } where + ri0 : {x : Ordinal} → Replaced1 (* (& X)) + (λ z xz → & (ψ (* z) (eq→ *iso (subst (odef (* (& X))) (sym &iso) xz)))) x → + Replaced1 X (λ z xz → & (ψ (* z) (subst (odef X) (sym &iso) xz))) x + ri0 {x} record { z = z ; az = az ; x=ψz = x=ψz } = record { z = z ; az = eq→ *iso az + ; x=ψz = trans x=ψz (cong (&) (RXCod.ψ-eq rc _ _ )) } + ri1 : {x : Ordinal} → + Replaced1 X (λ z xz → & (ψ (* z) (subst (odef X) (sym &iso) xz))) x → + Replaced1 (* (& X)) (λ z xz → & (ψ (* z) (eq→ *iso (subst (odef (* (& X))) (sym &iso) xz)))) x + ri1 {x} record { z = z ; az = az ; x=ψz = x=ψz } = record { z = z ; az = eq← *iso az + ; x=ψz = trans x=ψz (cong (&) (RXCod.ψ-eq rc _ _ )) } _∈_ : ( A B : HOD ) → Set n A ∈ B = B ∋ A @@ -438,13 +382,13 @@ p01 = subst (λ k → k o≤ & A) &iso ( ⊆→o≤ (λ {x} yx → y⊆A x yx )) power→ : ( A t : HOD) → Power A ∋ t → {x : HOD} → t ∋ x → A ∋ x -power→ A t P∋t {x} t∋x = P∋t (& x) (subst (λ k → odef k (& x) ) (sym *iso) t∋x ) +power→ A t P∋t {x} t∋x = P∋t (& x) (eq← *iso t∋x ) power← : (A t : HOD) → ({x : HOD} → (t ∋ x → A ∋ x)) → Power A ∋ t -power← A t t⊆A z xz = subst (λ k → odef A k ) &iso ( t⊆A (subst₂ (λ j k → odef j k) *iso (sym &iso) xz )) +power← A t t⊆A z xz = subst (λ k → odef A k ) &iso ( t⊆A (subst (λ k → odef t k) (sym &iso) (eq→ *iso xz ))) Power∋∅ : {S : HOD} → odef (Power S) o∅ -Power∋∅ z xz = ⊥-elim (¬x<0 (subst (λ k → odef k z) o∅≡od∅ xz) ) +Power∋∅ z xz = ⊥-elim (¬x<0 ( eq→ o∅==od∅ xz) ) Intersection : (X : HOD ) → HOD -- ∩ X Intersection X = record { od = record { def = λ x → (x o≤ & X ) ∧ ( {y : Ordinal} → odef X y → odef (* y) x )} ; odmax = osuc (& X) ; <odmax = λ lt → proj1 lt } @@ -480,16 +424,17 @@ ¬0=ux : {x : HOD} → ¬ o∅ ≡ & (Union ( x , ( x , x))) ¬0=ux {x} eq = ⊥-elim ( o<¬≡ eq (ordtrans≤-< o∅<x (subst (λ k → k o< & (Union (x , (x , x)))) &iso (c<→o< lemma ) ))) where lemma : Own (x , (x , x)) (& ( * (& x ))) - lemma = record { owner = _ ; ao = case2 refl ; ox = subst₂ (λ j k → odef j k ) (sym *iso) (sym &iso) (case1 refl) } + lemma = record { owner = _ ; ao = case2 refl ; ox = eq← *iso (subst (λ k → odef (x , x) k) (sym &iso) (case1 refl)) } -ux-2cases : {x y : HOD } → Union ( x , ( x , x)) ∋ y → ( x ≡ y ) ∨ ( x ∋ y ) -ux-2cases {x} {y} record { owner = owner ; ao = (case1 eq) ; ox = ox } = case2 (subst (λ k → odef k (& y)) (trans (cong (*) eq) *iso) ox) -ux-2cases {x} {y} record { owner = owner ; ao = (case2 eq) ; ox = ox } with subst (λ k → odef k (& y)) (trans (cong (*) eq) *iso) ox -... | case1 eq = case1 (sym (&≡&→≡ eq)) -... | case2 eq = case1 (sym (&≡&→≡ eq)) +ux-2cases : {x y : HOD } → Union ( x , ( x , x)) ∋ y → ( & x ≡ & y ) ∨ ( x ∋ y ) +ux-2cases {x} {y} record { owner = owner ; ao = (case1 eq) ; ox = ox } + = case2 (eq→ *iso (subst (λ k → odef k (& y)) (cong (*) eq) ox )) +ux-2cases {x} {y} record { owner = owner ; ao = (case2 eq) ; ox = ox } with eq→ *iso (subst (λ k → odef k (& y)) (cong (*) eq) ox) +... | case1 y=x = case1 (sym y=x) +... | case2 y=x = case1 (sym y=x) ux-transitve : {x y : HOD} → x ∋ y → Union ( x , ( x , x)) ∋ y -ux-transitve {x} {y} ox = record { owner = _ ; ao = case1 refl ; ox = subst (λ k → odef k (& y)) (sym *iso) ox } +ux-transitve {x} {y} ox = record { owner = _ ; ao = case1 refl ; ox = eq← *iso ox } -- -- Possible Ordinal Limit @@ -502,38 +447,40 @@ omega : Ordinal ho< : {x : Ordinal } → Omega-d x → x o< omega -postulate - odaxion-ho< : ODAxiom-ho< +-- postulate +-- odaxion-ho< : ODAxiom-ho< -open ODAxiom-ho< odaxion-ho< +-- open ODAxiom-ho< odaxion-ho< -Omega : HOD -Omega = record { od = record { def = λ x → Omega-d x } ; odmax = omega ; <odmax = ho<} +Omega : ODAxiom-ho< → HOD +Omega ho< = record { od = record { def = λ x → Omega-d x } ; odmax = ODAxiom-ho<.omega ho< ; <odmax = λ lt → ODAxiom-ho<.ho< ho< lt } -infinity∅ : Omega ∋ od∅ -infinity∅ = subst (λ k → odef Omega k ) lemma iφ where +infinity∅ : (ho< : ODAxiom-ho<) → Omega ho< ∋ od∅ +infinity∅ ho< = subst (λ k → odef (Omega ho<) k ) lemma iφ where lemma : o∅ ≡ & od∅ - lemma = let open ≡-Reasoning in begin - o∅ - ≡⟨ sym &iso ⟩ - & ( * o∅ ) - ≡⟨ cong ( λ k → & k ) o∅≡od∅ ⟩ - & od∅ - ∎ + lemma = sym ord-od∅ -infinity : (x : HOD) → Omega ∋ x → Omega ∋ Union (x , (x , x )) -infinity x lt = subst (λ k → odef Omega k ) lemma (isuc {& x} lt) where - lemma : & (Union (* (& x) , (* (& x) , * (& x)))) - ≡ & (Union (x , (x , x))) - lemma = cong (λ k → & (Union ( k , ( k , k ) ))) *iso +infinity : (ho< : ODAxiom-ho<) → (x : HOD) → Omega ho< ∋ x → Omega ho< ∋ Union (x , (x , x )) +infinity ho< x lt = subst (λ k → odef (Omega ho<) k ) lemma (isuc {& x} lt) where + lemma : & (Union (* (& x) , (* (& x) , * (& x)))) ≡ & (Union (x , (x , x))) + lemma = ==→o≡ record { eq→ = lemma2 ; eq← = lemma3 } where + lemma2 : {y : Ordinal} → Own (* (& x) , (* (& x) , * (& x))) y → Own (x , (x , x)) y + lemma2 {y} record { owner = owner ; ao = case1 ao ; ox = ox } = record { owner = owner ; ao = case1 lemma4 ; ox = ox } where + lemma4 : owner ≡ & x + lemma4 = trans ao ( ==→o≡ *iso ) + lemma2 {y} record { owner = owner ; ao = case2 ao ; ox = ox } = record { owner = owner ; ao = case2 ? ; ox = ox } where + lemma4 : owner ≡ & (x , x ) + lemma4 = trans ao ( ==→o≡ record { eq→ = ? ; eq← = ? } ) + lemma3 : {y : Ordinal} → Own (x , (x , x)) y → Own (* (& x) , (* (& x) , * (& x))) y + lemma3 {y} record { owner = owner ; ao = ao ; ox = ox } = record { owner = owner ; ao = ? ; ox = ox } pair→ : ( x y t : HOD ) → (x , y) ∋ t → ( t =h= x ) ∨ ( t =h= y ) -pair→ x y t (case1 t≡x ) = case1 (subst₂ (λ j k → j =h= k ) *iso *iso (o≡→== t≡x )) -pair→ x y t (case2 t≡y ) = case2 (subst₂ (λ j k → j =h= k ) *iso *iso (o≡→== t≡y )) +pair→ x y t (case1 t≡x ) = case1 (subst₂ (λ j k → j =h= k ) ? ? (o≡→== t≡x )) +pair→ x y t (case2 t≡y ) = case2 (subst₂ (λ j k → j =h= k ) ? ? (o≡→== t≡y )) pair← : ( x y t : HOD ) → ( t =h= x ) ∨ ( t =h= y ) → (x , y) ∋ t -pair← x y t (case1 t=h=x) = case1 (cong (λ k → & k ) (==→o≡ t=h=x)) -pair← x y t (case2 t=h=y) = case2 (cong (λ k → & k ) (==→o≡ t=h=y)) +pair← x y t (case1 t=h=x) = case1 (cong (λ k → & k ) ?) -- (==→o≡ t=h=x)) +pair← x y t (case2 t=h=y) = case2 (cong (λ k → & k ) ?) -- (==→o≡ t=h=y)) o<→c< : {x y : Ordinal } → x o< y → (Ord x) ⊆ (Ord y) o<→c< lt {z} ox = ordtrans ox lt @@ -549,8 +496,8 @@ ψiso {ψ} t refl = t selection : {ψ : HOD → Set n} {X y : HOD} → ((X ∋ y) ∧ ψ y) ⇔ (Select X ψ ∋ y) selection {ψ} {X} {y} = ⟪ - ( λ cond → ⟪ proj1 cond , ψiso {ψ} (proj2 cond) (sym *iso) ⟫ ) - , ( λ select → ⟪ proj1 select , ψiso {ψ} (proj2 select) *iso ⟫ ) + ( λ cond → ⟪ proj1 cond , ψiso {ψ} (proj2 cond) (sym ?) ⟫ ) + , ( λ select → ⟪ proj1 select , ψiso {ψ} (proj2 select) ? ⟫ ) ⟫ selection-in-domain : {ψ : HOD → Set n} {X y : HOD} → Select X ψ ∋ y → X ∋ y @@ -574,8 +521,8 @@ eq← (extensionality0 {A} {B} eq ) {x} d = odef-iso {B} {A} (sym &iso) (proj2 (eq (* x))) d extensionality : {A B w : HOD } → ((z : HOD ) → (A ∋ z) ⇔ (B ∋ z)) → (w ∋ A) ⇔ (w ∋ B) -proj1 (extensionality {A} {B} {w} eq ) d = subst (λ k → w ∋ k) ( ==→o≡ (extensionality0 {A} {B} eq) ) d -proj2 (extensionality {A} {B} {w} eq ) d = subst (λ k → w ∋ k) (sym ( ==→o≡ (extensionality0 {A} {B} eq) )) d +proj1 (extensionality {A} {B} {w} eq ) d = subst (λ k → w ∋ k) ? d -- ( ==→o≡ (extensionality0 {A} {B} eq) ) d +proj2 (extensionality {A} {B} {w} eq ) d = subst (λ k → w ∋ k) ? d -- (sym ( ==→o≡ (extensionality0 {A} {B} eq) )) d open import zf @@ -585,7 +532,7 @@ sup-o≤ : (A : HOD) → { ψ : ( x : Ordinal ) → def (od A) x → Ordinal } → ∀ {x : Ordinal } → (lt : def (od A) x ) → ψ x lt o≤ sup-o A ψ sup-c≤ : (ψ : HOD → HOD) → {X x : HOD} → def (od X) (& x) → & (ψ x) o≤ (sup-o X (λ y X∋y → & (ψ (* y)))) - sup-c≤ ψ {X} {x} lt = subst (λ k → & (ψ k) o< _ ) *iso (sup-o≤ X lt ) + sup-c≤ ψ {X} {x} lt = subst (λ k → & (ψ k) o< _ ) ? (sup-o≤ X lt ) -- sup-o may contradict -- If we have open monotonic function in Ordinal, there is no sup-o. @@ -605,12 +552,12 @@ r01 = sym (Replaced.x=ψz lt ) zf-replacement← : (os : ODAxiom-sup) → {ψ : HOD → HOD} (X x : HOD) → X ∋ x → ZFReplace os X ψ ∋ ψ x -zf-replacement← os {ψ} X x lt = record { z = & x ; az = lt ; x=ψz = cong (λ k → & (ψ k)) (sym *iso) } +zf-replacement← os {ψ} X x lt = record { z = & x ; az = lt ; x=ψz = cong (λ k → & (ψ k)) (sym ?) } zf-replacement→ : (os : ODAxiom-sup ) → {ψ : HOD → HOD} (X x : HOD) → (lt : ZFReplace os X ψ ∋ x) → ¬ ( (y : HOD) → ¬ (x =h= ψ y)) zf-replacement→ os {ψ} X x lt eq = eq (* (Replaced.z lt)) (ord→== (Replaced.x=ψz lt)) -isZF : (os : ODAxiom-sup) → IsZF HOD _∋_ _=h=_ od∅ _,_ Union Power Select (ZFReplace os) Omega -isZF os = record { +isZF : (os : ODAxiom-sup) (ho< : ODAxiom-ho< ) → IsZF HOD _∋_ _=h=_ od∅ _,_ Union Power Select (ZFReplace os) (Omega ho<) +isZF os ho< = record { isEquivalence = record { refl = ==-refl ; sym = ==-sym; trans = ==-trans } ; pair→ = pair→ ; pair← = pair← @@ -621,15 +568,15 @@ ; power← = power← ; extensionality = λ {A} {B} {w} → extensionality {A} {B} {w} ; ε-induction = ε-induction - ; infinity∅ = infinity∅ - ; infinity = infinity + ; infinity∅ = infinity∅ ho< + ; infinity = infinity ho< ; selection = λ {X} {ψ} {y} → selection {X} {ψ} {y} ; replacement← = zf-replacement← os ; replacement→ = λ {ψ} → zf-replacement→ os {ψ} } -HOD→ZF : ODAxiom-sup → ZF -HOD→ZF os = record { +HOD→ZF : ODAxiom-sup → ODAxiom-ho< → ZF +HOD→ZF os ho< = record { ZFSet = HOD ; _∋_ = _∋_ ; _≈_ = _=h=_ @@ -639,8 +586,8 @@ ; Power = Power ; Select = Select ; Replace = ZFReplace os - ; infinite = Omega - ; isZF = isZF os + ; infinite = Omega ho< + ; isZF = isZF os ho< }
--- a/src/OrdUtil.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/OrdUtil.agda Mon Jan 01 18:21:36 2024 +0900 @@ -1,3 +1,5 @@ +{-# OPTIONS --cubical-compatible --safe #-} + open import Level open import Ordinals module OrdUtil {n : Level} (O : Ordinals {n} ) where @@ -152,7 +154,7 @@ omax x y with trio< x y omax x y | tri< a ¬b ¬c = osuc y omax x y | tri> ¬a ¬b c = osuc x -omax x y | tri≈ ¬a refl ¬c = osuc x +omax x y | tri≈ ¬a b ¬c = osuc x omax< : ( x y : Ordinal ) → x o< y → osuc y ≡ omax x y omax< x y lt with trio< x y @@ -190,7 +192,7 @@ omxx x with trio< x x omxx x | tri< a ¬b ¬c = ⊥-elim (¬b refl ) omxx x | tri> ¬a ¬b c = ⊥-elim (¬b refl ) -omxx x | tri≈ ¬a refl ¬c = refl +omxx x | tri≈ ¬a b ¬c = refl omxxx : ( x : Ordinal ) → omax x (omax x x ) ≡ osuc (osuc x) omxxx x = trans ( cong ( λ k → omax x k ) (omxx x )) (sym ( omax< x (osuc x) <-osuc ))
--- a/src/Ordinals.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/Ordinals.agda Mon Jan 01 18:21:36 2024 +0900 @@ -1,3 +1,5 @@ +{-# OPTIONS --cubical-compatible --safe #-} + open import Level module Ordinals where
--- a/src/Tychonoff.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/Tychonoff.agda Mon Jan 01 18:21:36 2024 +0900 @@ -376,7 +376,7 @@ import Axiom.Extensionality.Propositional postulate f-extensionality : { n m : Level} → Axiom.Extensionality.Propositional.Extensionality n m -open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) +-- open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) -- -- We have UFLP both in P and Q. Given an ultra filter F on P x Q. It has limits on P and Q because a projection of ultra filter
--- a/src/ZProduct.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/ZProduct.agda Mon Jan 01 18:21:36 2024 +0900 @@ -340,7 +340,7 @@ -- Set of All function from A to B -- -open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) +-- open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) Funcs : (A B : HOD) → HOD Funcs A B = record { od = record { def = λ x → FuncHOD A B x } ; odmax = osuc (& (ZFP A B)) @@ -361,6 +361,7 @@ record Injection (A B : Ordinal ) : Set n where field i→ : (x : Ordinal ) → odef (* A) x → Ordinal + irr : (x : Ordinal ) → ( lt1 lt2 : odef (* A) x ) → i→ x lt1 ≡ i→ x lt2 iB : (x : Ordinal ) → ( lt : odef (* A) x ) → odef (* B) ( i→ x lt ) inject : (x y : Ordinal ) → ( ltx : odef (* A) x ) ( lty : odef (* A) y ) → i→ x ltx ≡ i→ y lty → x ≡ y
--- a/src/bijection.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/bijection.agda Mon Jan 01 18:21:36 2024 +0900 @@ -47,6 +47,27 @@ bi-inject→ : {n m : Level} {R : Set n} {S : Set m} → (rs : Bijection R S) → {x y : R} → fun→ rs x ≡ fun→ rs y → x ≡ y bi-inject→ rs {x} {y} eq = subst₂ (λ j k → j ≡ k ) (fiso← rs _) (fiso← rs _) (cong (fun← rs) eq) +bi-∨ : {n m n1 m1 : Level } {A : Set n} {B : Set m} {C : Set n1} {D : Set m1} → (ab : Bijection A B) → (cd : Bijection C D ) + → Bijection (A ∨ C) (B ∨ D) +bi-∨ {_} {_} {_} {_} {A} {B} {C} {D} ab cd = record { + fun→ = fun→1 + ; fun← = fun←1 + ; fiso→ = fiso→1 + ; fiso← = fiso←1 + } where + fun→1 : (A ∨ C) → (B ∨ D) + fun→1 (case1 a) = case1 (fun→ ab a) + fun→1 (case2 c) = case2 (fun→ cd c) + fun←1 : (B ∨ D) → (A ∨ C) + fun←1 (case1 a) = case1 (fun← ab a) + fun←1 (case2 c) = case2 (fun← cd c) + fiso→1 : (x : B ∨ D) → fun→1 (fun←1 x) ≡ x + fiso→1 (case1 a) = cong case1 (fiso→ ab a) + fiso→1 (case2 c) = cong case2 (fiso→ cd c) + fiso←1 : (x : A ∨ C) → fun←1 (fun→1 x) ≡ x + fiso←1 (case1 a) = cong case1 (fiso← ab a) + fiso←1 (case2 c) = cong case2 (fiso← cd c) + open import Relation.Binary.Structures bijIsEquivalence : {n : Level } → IsEquivalence (Bijection {n} {n}) @@ -511,6 +532,42 @@ a : A fa=c : f a ≡ c +record IsImage0 (A B : Set ) (f : (x : A ) → B) (x : B ) : Set where + field + y : A + x=fy : x ≡ f y + +IsImage : (a b : Set) (iab : InjectiveF a b ) (x : b ) → Set +IsImage a b iab x = IsImage0 a b (InjectiveF.f iab) x + +Bernstein : (A B : Set) + → (fi : InjectiveF A B ) → (gi : InjectiveF B A ) + → (is-A : (b : B ) → Dec (Is A B (InjectiveF.f fi) b) ) + → (is-B : (a : A ) → Dec (Is B A (InjectiveF.f gi) a) ) + → Bijection A B +Bernstein A B fi gi isa isb = ? where + open InjectiveF + gfi : InjectiveF A A + gfi = record { f = λ x → f gi (f fi x) ; inject = λ {x} {y} eq → inject fi (inject gi eq) } + data gfImage : (x : A) → Set where + a-g : {x : A} → (¬ib : ¬ ( IsImage B A gi x )) → gfImage x + next-gf : {x : A} → (ix : IsImage A A gfi x) → (gfiy : gfImage (IsImage0.y ix) ) → gfImage x + data ¬gfImage : (x : A) → Set where + ngf : {x : A} → (¬gfiy : ¬ gfImage x) → ¬gfImage x + gf02 : {x : A} → IsImage B A gi x ∨ (¬ IsImage B A gi x) ∨ ((ix : IsImage A A gfi x) → ¬ gfImage (IsImage0.y ix) ) → ¬ gfImage x + gf02 {x} c gf = ? + gfi∨ : (x : A) → gfImage x ∨ ¬gfImage x + gfi∨ x with isb x + ... | no ¬ib = case1 ( a-g (λ ib → ¬ib (record { a = IsImage0.y ib ; fa=c = sym (IsImage0.x=fy ib) }))) + ... | yes ib with isa (f fi x) + ... | no ¬ia = case2 ( ngf ? ) + ... | yes ia = case1 ( next-gf record { y = f gi (Is.a ib) ; x=fy = br00 } (a-g br01 ) ) where + br00 : x ≡ f gi (f fi (f gi (Is.a ib))) + br00 = ? + br01 : ¬ IsImage B A gi (f gi (Is.a ib)) + br01 record { y = y ; x=fy = x=fy } = ? + + Countable-Bernstein : (A B C : Set) → Bijection A ℕ → Bijection C ℕ → (fi : InjectiveF A B ) → (gi : InjectiveF B C ) → (is-A : (c : C ) → Dec (Is A C (λ x → (InjectiveF.f gi (InjectiveF.f fi x))) c ))
--- a/src/logic.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/logic.agda Mon Jan 01 18:21:36 2024 +0900 @@ -1,3 +1,5 @@ +{-# OPTIONS --cubical-compatible --safe #-} + module logic where open import Level @@ -5,14 +7,11 @@ open import Relation.Binary hiding (_⇔_ ) open import Data.Empty + data Bool : Set where true : Bool false : Bool -data Two : Set where - i0 : Two - i1 : Two - record _∧_ {n m : Level} (A : Set n) ( B : Set m ) : Set (n ⊔ m) where constructor ⟪_,_⟫ field @@ -26,13 +25,6 @@ _⇔_ : {n m : Level } → ( A : Set n ) ( B : Set m ) → Set (n ⊔ m) _⇔_ A B = ( A → B ) ∧ ( B → A ) -∧-exch : {n m : Level} {A : Set n} { B : Set m } → A ∧ B → B ∧ A -∧-exch p = ⟪ _∧_.proj2 p , _∧_.proj1 p ⟫ - -∨-exch : {n m : Level} {A : Set n} { B : Set m } → A ∨ B → B ∨ A -∨-exch (case1 x) = case2 x -∨-exch (case2 x) = case1 x - contra-position : {n m : Level } {A : Set n} {B : Set m} → (A → B) → ¬ B → ¬ A contra-position {n} {m} {A} {B} f ¬b a = ¬b ( f a ) @@ -46,10 +38,6 @@ de-morgan {n} {A} {B} and (case1 ¬A) = ⊥-elim ( ¬A ( _∧_.proj1 and )) de-morgan {n} {A} {B} and (case2 ¬B) = ⊥-elim ( ¬B ( _∧_.proj2 and )) -de-morgan∨ : {n : Level } {A B : Set n} → A ∨ B → ¬ ( (¬ A ) ∧ (¬ B ) ) -de-morgan∨ {n} {A} {B} (case1 a) and = ⊥-elim ( _∧_.proj1 and a ) -de-morgan∨ {n} {A} {B} (case2 b) and = ⊥-elim ( _∧_.proj2 and b ) - dont-or : {n m : Level} {A : Set n} { B : Set m } → A ∨ B → ¬ A → B dont-or {A} {B} (case1 a) ¬A = ⊥-elim ( ¬A a ) dont-or {A} {B} (case2 b) ¬A = b @@ -79,11 +67,10 @@ false <=> false = true _ <=> _ = false -open import Relation.Binary.PropositionalEquality +infixr 130 _\/_ +infixr 140 _/\_ -not-not-bool : { b : Bool } → not (not b) ≡ b -not-not-bool {true} = refl -not-not-bool {false} = refl +open import Relation.Binary.PropositionalEquality record Bijection {n m : Level} (R : Set n) (S : Set m) : Set (n Level.⊔ m) where field @@ -96,13 +83,14 @@ injection R S f = (x y : R) → f x ≡ f y → x ≡ y +not-not-bool : { b : Bool } → not (not b) ≡ b +not-not-bool {true} = refl +not-not-bool {false} = refl + ¬t=f : (t : Bool ) → ¬ ( not t ≡ t) ¬t=f true () ¬t=f false () -infixr 130 _\/_ -infixr 140 _/\_ - ≡-Bool-func : {A B : Bool } → ( A ≡ true → B ≡ true ) → ( B ≡ true → A ≡ true ) → A ≡ B ≡-Bool-func {true} {true} a→b b→a = refl ≡-Bool-func {false} {true} a→b b→a with b→a refl @@ -129,89 +117,57 @@ ¬-bool refl () lemma-∧-0 : {a b : Bool} → a /\ b ≡ true → a ≡ false → ⊥ -lemma-∧-0 {true} {true} refl () lemma-∧-0 {true} {false} () lemma-∧-0 {false} {true} () lemma-∧-0 {false} {false} () +lemma-∧-0 {true} {true} eq1 () lemma-∧-1 : {a b : Bool} → a /\ b ≡ true → b ≡ false → ⊥ -lemma-∧-1 {true} {true} refl () lemma-∧-1 {true} {false} () lemma-∧-1 {false} {true} () lemma-∧-1 {false} {false} () +lemma-∧-1 {true} {true} eq1 () bool-and-tt : {a b : Bool} → a ≡ true → b ≡ true → ( a /\ b ) ≡ true bool-and-tt refl refl = refl bool-∧→tt-0 : {a b : Bool} → ( a /\ b ) ≡ true → a ≡ true -bool-∧→tt-0 {true} {true} refl = refl +bool-∧→tt-0 {true} {true} eq = refl bool-∧→tt-0 {false} {_} () bool-∧→tt-1 : {a b : Bool} → ( a /\ b ) ≡ true → b ≡ true -bool-∧→tt-1 {true} {true} refl = refl +bool-∧→tt-1 {true} {true} eq = refl bool-∧→tt-1 {true} {false} () bool-∧→tt-1 {false} {false} () bool-or-1 : {a b : Bool} → a ≡ false → ( a \/ b ) ≡ b -bool-or-1 {false} {true} refl = refl -bool-or-1 {false} {false} refl = refl +bool-or-1 {false} {true} eq = refl +bool-or-1 {false} {false} eq = refl bool-or-2 : {a b : Bool} → b ≡ false → (a \/ b ) ≡ a -bool-or-2 {true} {false} refl = refl -bool-or-2 {false} {false} refl = refl +bool-or-2 {true} {false} eq = refl +bool-or-2 {false} {false} eq = refl bool-or-3 : {a : Bool} → ( a \/ true ) ≡ true bool-or-3 {true} = refl bool-or-3 {false} = refl bool-or-31 : {a b : Bool} → b ≡ true → ( a \/ b ) ≡ true -bool-or-31 {true} {true} refl = refl -bool-or-31 {false} {true} refl = refl +bool-or-31 {true} {true} eq = refl +bool-or-31 {false} {true} eq = refl bool-or-4 : {a : Bool} → ( true \/ a ) ≡ true bool-or-4 {true} = refl bool-or-4 {false} = refl bool-or-41 : {a b : Bool} → a ≡ true → ( a \/ b ) ≡ true -bool-or-41 {true} {b} refl = refl +bool-or-41 {true} {b} eq = refl bool-and-1 : {a b : Bool} → a ≡ false → (a /\ b ) ≡ false -bool-and-1 {false} {b} refl = refl +bool-and-1 {false} {b} eq = refl bool-and-2 : {a b : Bool} → b ≡ false → (a /\ b ) ≡ false -bool-and-2 {true} {false} refl = refl -bool-and-2 {false} {false} refl = refl +bool-and-2 {true} {false} eq = refl +bool-and-2 {false} {false} eq = refl +bool-and-2 {true} {true} () +bool-and-2 {false} {true} () -open import Data.Nat -open import Data.Nat.Properties - -_≥b_ : ( x y : ℕ) → Bool -x ≥b y with <-cmp x y -... | tri< a ¬b ¬c = false -... | tri≈ ¬a b ¬c = true -... | tri> ¬a ¬b c = true - -_>b_ : ( x y : ℕ) → Bool -x >b y with <-cmp x y -... | tri< a ¬b ¬c = false -... | tri≈ ¬a b ¬c = false -... | tri> ¬a ¬b c = true - -_≤b_ : ( x y : ℕ) → Bool -x ≤b y = y ≥b x - -_<b_ : ( x y : ℕ) → Bool -x <b y = y >b x - -open import Relation.Binary.PropositionalEquality - -¬i0≡i1 : ¬ ( i0 ≡ i1 ) -¬i0≡i1 () - -¬i0→i1 : {x : Two} → ¬ (x ≡ i0 ) → x ≡ i1 -¬i0→i1 {i0} ne = ⊥-elim ( ne refl ) -¬i0→i1 {i1} ne = refl - -¬i1→i0 : {x : Two} → ¬ (x ≡ i1 ) → x ≡ i0 -¬i1→i0 {i0} ne = refl -¬i1→i0 {i1} ne = ⊥-elim ( ne refl ) -
--- a/src/nat.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/nat.agda Mon Jan 01 18:21:36 2024 +0900 @@ -1,4 +1,5 @@ -{-# OPTIONS --allow-unsolved-metas #-} +{-# OPTIONS --cubical-compatible --safe #-} + module nat where open import Data.Nat @@ -104,15 +105,15 @@ div2-eq : (x : ℕ ) → div2-rev ( div2 x ) ≡ x div2-eq zero = refl div2-eq (suc zero) = refl -div2-eq (suc (suc x)) with div2 x | inspect div2 x -... | ⟪ x1 , true ⟫ | record { eq = eq1 } = begin -- eq1 : div2 x ≡ ⟪ x1 , true ⟫ +div2-eq (suc (suc x)) with div2 x in eq1 +... | ⟪ x1 , true ⟫ = begin -- eq1 : div2 x ≡ ⟪ x1 , true ⟫ div2-rev ⟪ suc x1 , true ⟫ ≡⟨⟩ suc (suc (x1 + suc x1)) ≡⟨ cong (λ k → suc (suc k )) (+-comm x1 _ ) ⟩ suc (suc (suc (x1 + x1))) ≡⟨⟩ suc (suc (div2-rev ⟪ x1 , true ⟫)) ≡⟨ cong (λ k → suc (suc (div2-rev k ))) (sym eq1) ⟩ suc (suc (div2-rev (div2 x))) ≡⟨ cong (λ k → suc (suc k)) (div2-eq x) ⟩ suc (suc x) ∎ where open ≡-Reasoning -... | ⟪ x1 , false ⟫ | record { eq = eq1 } = begin +... | ⟪ x1 , false ⟫ = begin div2-rev ⟪ suc x1 , false ⟫ ≡⟨⟩ suc (x1 + suc x1) ≡⟨ cong (λ k → (suc k )) (+-comm x1 _ ) ⟩ suc (suc (x1 + x1)) ≡⟨⟩ @@ -138,6 +139,40 @@ _-_ = minus +sn-m=sn-m : {m n : ℕ } → m ≤ n → suc n - m ≡ suc ( n - m ) +sn-m=sn-m {0} {n} z≤n = refl +sn-m=sn-m {suc m} {suc n} (s≤s m<n) = sn-m=sn-m m<n + +si-sn=i-n : {i n : ℕ } → n < i → suc (i - suc n) ≡ (i - n) +si-sn=i-n {i} {n} n<i = begin + suc (i - suc n) ≡⟨ sym (sn-m=sn-m n<i ) ⟩ + suc i - suc n ≡⟨⟩ + i - n + ∎ where + open ≡-Reasoning + +refl-≤s : {x : ℕ } → x ≤ suc x +refl-≤s {zero} = z≤n +refl-≤s {suc x} = s≤s (refl-≤s {x}) + +a≤sa = refl-≤s + +n-m<n : (n m : ℕ ) → n - m ≤ n +n-m<n zero zero = z≤n +n-m<n (suc n) zero = s≤s (n-m<n n zero) +n-m<n zero (suc m) = z≤n +n-m<n (suc n) (suc m) = ≤-trans (n-m<n n m ) refl-≤s + +n-n-m=m : {m n : ℕ } → m ≤ n → m ≡ (n - (n - m)) +n-n-m=m {0} {zero} z≤n = refl +n-n-m=m {0} {suc n} z≤n = n-n-m=m {0} {n} z≤n +n-n-m=m {suc m} {suc n} (s≤s m≤n) = sym ( begin + suc n - ( n - m ) ≡⟨ sn-m=sn-m (n-m<n n m) ⟩ + suc (n - ( n - m )) ≡⟨ cong (λ k → suc k ) (sym (n-n-m=m m≤n)) ⟩ + suc m + ∎ ) where + open ≡-Reasoning + m+= : {i j m : ℕ } → m + i ≡ m + j → i ≡ j m+= {i} {j} {zero} refl = refl m+= {i} {j} {suc m} eq = m+= {i} {j} {m} ( cong (λ k → pred k ) eq ) @@ -238,12 +273,6 @@ ... | tri≈ ¬a refl ¬c = case2 ≤-refl ... | tri> ¬a ¬b c = case2 (<to≤ c) -refl-≤s : {x : ℕ } → x ≤ suc x -refl-≤s {zero} = z≤n -refl-≤s {suc x} = s≤s (refl-≤s {x}) - -a≤sa = refl-≤s - refl-≤ : {x : ℕ } → x ≤ x refl-≤ {zero} = z≤n refl-≤ {suc x} = s≤s (refl-≤ {x}) @@ -287,6 +316,9 @@ x≤y→x<sy {.zero} {y} z≤n = ≤-trans a<sa (s≤s z≤n) x≤y→x<sy {.(suc _)} {.(suc _)} (s≤s le) = s≤s ( x≤y→x<sy le) +sx≤y→x<y : {x y : ℕ } → suc x ≤ y → x < y +sx≤y→x<y {zero} {suc y} (s≤s le) = s≤s z≤n +sx≤y→x<y {suc x} {suc y} (s≤s le) = s≤s ( sx≤y→x<y {x} {y} le ) open import Data.Product @@ -693,15 +725,15 @@ m ∎ where open ≤-Reasoning 0<factor : { m k : ℕ } → k > 0 → m > 0 → (d : Dividable k m ) → Dividable.factor d > 0 -0<factor {m} {k} k>0 m>0 d with Dividable.factor d | inspect Dividable.factor d -... | zero | record { eq = eq1 } = ⊥-elim ( nat-≡< ff1 m>0 ) where +0<factor {m} {k} k>0 m>0 d with Dividable.factor d in eq1 +... | zero = ⊥-elim ( nat-≡< ff1 m>0 ) where ff1 : 0 ≡ m ff1 = begin 0 ≡⟨⟩ 0 * k + 0 ≡⟨ cong (λ j → j * k + 0) (sym eq1) ⟩ Dividable.factor d * k + 0 ≡⟨ Dividable.is-factor d ⟩ m ∎ where open ≡-Reasoning -... | suc t | _ = s≤s z≤n +... | suc t = s≤s z≤n div→k≤m : { m k : ℕ } → k > 1 → m > 0 → Dividable k m → m ≥ k div→k≤m {m} {k} k>1 m>0 d with <-cmp m k
--- a/src/ordinal.agda Sat Aug 26 10:36:09 2023 +0900 +++ b/src/ordinal.agda Mon Jan 01 18:21:36 2024 +0900 @@ -50,11 +50,11 @@ o∅ : {n : Level} → Ordinal {n} o∅ = record { lv = Zero ; ord = Φ Zero } -open import Relation.Binary.HeterogeneousEquality using (_≅_;refl) +-- open import Relation.Binary.HeterogeneousEquality using (_≅_;refl) -ordinal-cong : {n : Level} {x y : Ordinal {n}} → - lv x ≡ lv y → ord x ≅ ord y → x ≡ y -ordinal-cong refl refl = refl +-- ordinal-cong : {n : Level} {x y : Ordinal {n}} → +-- lv x ≡ lv y → ord x ≅ ord y → x ≡ y +-- ordinal-cong refl refl = refl ≡→¬d< : {n : Level} → {lv : ℕ} → {x : OrdinalD {n} lv } → x d< x → ⊥ ≡→¬d< {n} {lx} {OSuc lx y} (s< t) = ≡→¬d< t