# HG changeset patch # User Shinji KONO # Date 1596272723 -32400 # Node ID 9984cdd88da335dbfad5cdeb3f6e474cdcdc7174 # Parent 44a484f17f26a6ad382cb6c51fe20ca98665ae2a ... diff -r 44a484f17f26 -r 9984cdd88da3 BAlgbra.agda --- a/BAlgbra.agda Sat Aug 01 11:06:29 2020 +0900 +++ b/BAlgbra.agda Sat Aug 01 18:05:23 2020 +0900 @@ -94,9 +94,9 @@ x-assoc : {a b c : L } → a x ( b x c ) ≡ (a x b) x c +-sym : {a b : L } → a + b ≡ b + a -sym : {a b : L } → a x b ≡ b x a - -aab : {a b : L } → a + ( a x b ) ≡ a + +-aab : {a b : L } → a + ( a x b ) ≡ a x-aab : {a b : L } → a x ( a + b ) ≡ a - -dist : {a b c : L } → a + ( b x c ) ≡ ( a x b ) + ( a x c ) + +-dist : {a b c : L } → a + ( b x c ) ≡ ( a x b ) + ( a x c ) x-dist : {a b c : L } → a x ( b + c ) ≡ ( a + b ) x ( a + c ) a+0 : {a : L } → a + b0 ≡ a ax1 : {a : L } → a x b1 ≡ a diff -r 44a484f17f26 -r 9984cdd88da3 OD.agda --- a/OD.agda Sat Aug 01 11:06:29 2020 +0900 +++ b/OD.agda Sat Aug 01 18:05:23 2020 +0900 @@ -34,11 +34,8 @@ eq→ : ∀ { x : Ordinal } → def a x → def b x eq← : ∀ { x : Ordinal } → def b x → def a x -id : {A : Set n} → A → A -id x = x - ==-refl : { x : OD } → x == x -==-refl {x} = record { eq→ = id ; eq← = id } +==-refl {x} = record { eq→ = λ x → x ; eq← = λ x → x } open _==_ @@ -148,23 +145,12 @@ d→∋ : ( a : HOD ) { x : Ordinal} → odef a x → a ∋ (* x) d→∋ a lt = subst (λ k → odef a k ) (sym &iso) lt -cseq : HOD → HOD -cseq x = record { od = record { def = λ y → odef x (osuc y) } ; odmax = osuc (odmax x) ; ¬a ¬b c | record { eq = eq1 } = next< (subst (λ k → k o< next o ) (sym eq1) (osucz → subst (λ k → def (od y) k ) &iso (incl lt (d→∋ x x>z))) - -- if we have & (x , x) ≡ osuc (& x), ⊆→o≤ → c<→o< ⊆→o≤→c<→o< : ({x : HOD} → & (x , x) ≡ osuc (& x) ) → ({y z : HOD } → ({x : Ordinal} → def (od y) x → def (od z) x ) → & y o< osuc (& z) ) @@ -306,19 +263,6 @@ lemma1 : osuc (& y) o< & (x , x) lemma1 = subst (λ k → osuc (& y) o< k ) (sym (peq {x})) (osucc c ) -subset-lemma : {A x : HOD } → ( {y : HOD } → x ∋ y → (A ∩ x ) ∋ y ) ⇔ ( x ⊆ A ) -subset-lemma {A} {x} = record { - proj1 = λ lt → record { incl = λ x∋z → proj1 (lt x∋z) } - ; proj2 = λ x⊆A lt → ⟪ incl x⊆A lt , lt ⟫ - } - -power< : {A x : HOD } → x ⊆ A → Ord (osuc (& A)) ∋ x -power< {A} {x} x⊆A = ⊆→o≤ (λ {y} x∋y → subst (λ k → def (od A) k) &iso (lemma y x∋y ) ) where - lemma : (y : Ordinal) → def (od x) y → def (od A) (& (* y)) - lemma y x∋y = incl x⊆A (d→∋ x x∋y) - -open import Data.Unit - ε-induction : { ψ : HOD → Set n} → ( {x : HOD } → ({ y : HOD } → x ∋ y → ψ y ) → ψ x ) → (x : HOD ) → ψ x @@ -415,9 +359,6 @@ -- infinite : HOD -- infinite = record { od = record { def = λ x → infinite-d x } ; odmax = ωmax ; ¬a ¬b c with (incl lt) (o<-subst c (sym &iso) refl ) ... | ttt = ⊥-elim ( o<¬≡ refl (o<-subst ttt &iso refl )) -open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) --- postulate f-extensionality : { n m : Level} → HE.Extensionality n m - -ω-prev-eq1 : {x y : Ordinal} → & (Union (* y , (* y , * y))) ≡ & (Union (* x , (* x , * x))) → ¬ (x o< y) -ω-prev-eq1 {x} {y} eq x (c<→o< {* y} {* u} (proj2 t)) (subst₂ (λ j k → j o< k ) - (trans (sym &iso) (trans (sym u=x) (sym &iso)) ) (sym &iso) x ¬a ¬b c = ⊥-elim (ω-prev-eq1 (sym eq) c) - -ω-∈s : (x : HOD) → Union ( x , (x , x)) ∋ x -ω-∈s x not = not (& (x , x)) ⟪ case2 refl , subst (λ k → odef k (& x) ) (sym *iso) (case1 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) ))) ) - -nat→ω-iso : {i : HOD} → (lt : infinite ∋ i ) → nat→ω ( ω→nat i lt ) ≡ i -nat→ω-iso {i} = ε-induction1 {λ i → (lt : infinite ∋ i ) → nat→ω ( ω→nat i lt ) ≡ i } ind i where - ind : {x : HOD} → ({y : HOD} → x ∋ y → (lt : infinite ∋ y) → nat→ω (ω→nat y lt) ≡ y) → - (lt : infinite ∋ x) → nat→ω (ω→nat x lt) ≡ x - ind {x} prev lt = ind1 lt *iso where - ind1 : {ox : Ordinal } → (ltd : infinite-d ox ) → * ox ≡ x → nat→ω (ω→nato ltd) ≡ x - ind1 {o∅} iφ refl = sym o∅≡od∅ - ind1 (isuc {x₁} ltd) ox=x = 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 *iso) ox=x ⟩ - x - ∎ where - open ≡-Reasoning - lemma0 : x ∋ * x₁ - lemma0 = subst (λ k → odef k (& (* x₁))) (trans (sym *iso) ox=x) (λ not → not - (& (* x₁ , * x₁)) ⟪ pair2 , subst (λ k → odef k (& (* x₁))) (sym *iso) pair1 ⟫ ) - lemma1 : infinite ∋ * x₁ - lemma1 = subst (λ k → odef infinite k) (sym &iso) ltd - lemma3 : {x y : Ordinal} → (ltd : infinite-d x ) (ltd1 : infinite-d y ) → y ≡ x → ltd ≅ ltd1 - lemma3 iφ iφ refl = HE.refl - 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 (sym eq)) - ... | t = HE.cong₂ (λ j k → isuc {j} k ) (HE.≡-to-≅ (ω-prev-eq eq)) t - lemma2 : {x y : Ordinal} → (ltd : infinite-d x ) (ltd1 : infinite-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 : infinite-d x } {ltd1 : infinite-d y } → y ≡ x → ltd ≅ ltd1 → ω→nato ltd ≡ ω→nato ltd1 - lemma6 refl HE.refl = refl - lemma : nat→ω (ω→nato ltd) ≡ * x₁ - lemma = trans (cong (λ k → nat→ω k) (lemma2 {x₁} {_} ltd (subst (λ k → infinite-d k ) (sym &iso) ltd) &iso ) ) ( prev {* x₁} lemma0 lemma1 ) - -ω→nat-iso : {i : Nat} → ω→nat ( nat→ω i ) (ω∋nat→ω {i}) ≡ i -ω→nat-iso {i} = lemma i (ω∋nat→ω {i}) *iso where - lemma : {x : Ordinal } → ( i : Nat ) → (ltd : infinite-d x ) → * x ≡ nat→ω i → ω→nato ltd ≡ i - lemma {x} Zero iφ eq = refl - lemma {x} (Suc i) iφ eq = ⊥-elim ( ωs≠0 (nat→ω i) (trans (sym eq) o∅≡od∅ )) -- Union (nat→ω i , (nat→ω i , nat→ω i)) ≡ od∅ - lemma Zero (isuc {x} ltd) eq = ⊥-elim ( ωs≠0 (* x) (subst (λ k → k ≡ od∅ ) *iso eq )) - lemma (Suc i) (isuc {x} ltd) eq = cong (λ k → Suc k ) (lemma i ltd (lemma1 eq) ) where -- * x ≡ nat→ω i - lemma1 : * (& (Union (* x , (* x , * x)))) ≡ Union (nat→ω i , (nat→ω i , nat→ω i)) → * x ≡ nat→ω i - lemma1 eq = subst (λ k → * x ≡ k ) *iso (cong (λ k → * k) - ( ω-prev-eq (subst (λ k → _ ≡ k ) &iso (cong (λ k → & k ) (sym - (subst (λ k → _ ≡ Union ( k , ( k , k ))) (sym *iso ) eq )))))) - ψiso : {ψ : HOD → Set n} {x y : HOD } → ψ x → x ≡ y → ψ y ψiso {ψ} t refl = t selection : {ψ : HOD → Set n} {X y : HOD} → ((X ∋ y) ∧ ψ y) ⇔ (Select X ψ ∋ y) @@ -588,12 +422,12 @@ replacement← : {ψ : HOD → HOD} (X x : HOD) → X ∋ x → Replace X ψ ∋ ψ x replacement← {ψ} X x lt = ⟪ sup-c< ψ {X} {x} lt , lemma ⟫ where lemma : def (in-codomain X ψ) (& (ψ x)) - lemma not = ⊥-elim ( not ( & x ) (⟪ lt , cong (λ k → & (ψ k)) (sym *iso)⟫ )) + lemma not = ⊥-elim ( not ( & x ) ⟪ lt , cong (λ k → & (ψ k)) (sym *iso)⟫ ) replacement→ : {ψ : HOD → HOD} (X x : HOD) → (lt : Replace X ψ ∋ x) → ¬ ( (y : HOD) → ¬ (x =h= ψ y)) replacement→ {ψ} X x lt = contra-position lemma (lemma2 (proj2 lt)) where lemma2 : ¬ ((y : Ordinal) → ¬ odef X y ∧ ((& x) ≡ & (ψ (* y)))) → ¬ ((y : Ordinal) → ¬ odef X y ∧ (* (& x) =h= ψ (* y))) - lemma2 not not2 = not ( λ y d → not2 y (⟪ proj1 d , lemma3 (proj2 d)⟫)) where + lemma2 not not2 = not ( λ y d → not2 y ⟪ proj1 d , lemma3 (proj2 d)⟫) where lemma3 : {y : Ordinal } → (& x ≡ & (ψ (* y))) → (* (& x) =h= ψ (* y)) lemma3 {y} eq = subst (λ k → * (& x) =h= k ) *iso (o≡→== eq ) lemma : ( (y : HOD) → ¬ (x =h= ψ y)) → ( (y : Ordinal) → ¬ odef X y ∧ (* (& x) =h= ψ (* y)) ) @@ -609,7 +443,7 @@ -- ∩-≡ : { a b : HOD } → ({x : HOD } → (a ∋ x → b ∋ x)) → a =h= ( b ∩ a ) ∩-≡ {a} {b} inc = record { - eq→ = λ {x} x ¬a ¬b c | record { eq = eq1 } = next< (subst (λ k → k o< next o ) (sym eq1) (osucz → subst (λ k → def (od y) k ) &iso (incl lt (d→∋ x x>z))) + +subset-lemma : {A x : HOD } → ( {y : HOD } → x ∋ y → (A ∩ x ) ∋ y ) ⇔ ( x ⊆ A ) +subset-lemma {A} {x} = record { + proj1 = λ lt → record { incl = λ x∋z → proj1 (lt x∋z) } + ; proj2 = λ x⊆A lt → ⟪ incl x⊆A lt , lt ⟫ + } + + +ω (c<→o< {* y} {* u} (proj2 t)) (subst₂ (λ j k → j o< k ) + (trans (sym &iso) (trans (sym u=x) (sym &iso)) ) (sym &iso) x ¬a ¬b c = ⊥-elim (ω-prev-eq1 (sym eq) c) + +ω-∈s : (x : HOD) → Union ( x , (x , x)) ∋ x +ω-∈s x not = not (& (x , x)) ⟪ case2 refl , subst (λ k → odef k (& x) ) (sym *iso) (case1 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) ))) ) + +nat→ω-iso : {i : HOD} → (lt : infinite ∋ i ) → nat→ω ( ω→nat i lt ) ≡ i +nat→ω-iso {i} = ε-induction1 {λ i → (lt : infinite ∋ i ) → nat→ω ( ω→nat i lt ) ≡ i } ind i where + ind : {x : HOD} → ({y : HOD} → x ∋ y → (lt : infinite ∋ y) → nat→ω (ω→nat y lt) ≡ y) → + (lt : infinite ∋ x) → nat→ω (ω→nat x lt) ≡ x + ind {x} prev lt = ind1 lt *iso where + ind1 : {ox : Ordinal } → (ltd : infinite-d ox ) → * ox ≡ x → nat→ω (ω→nato ltd) ≡ x + ind1 {o∅} iφ refl = sym o∅≡od∅ + ind1 (isuc {x₁} ltd) ox=x = 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 *iso) ox=x ⟩ + x + ∎ where + open ≡-Reasoning + lemma0 : x ∋ * x₁ + lemma0 = subst (λ k → odef k (& (* x₁))) (trans (sym *iso) ox=x) (λ not → not + (& (* x₁ , * x₁)) ⟪ pair2 , subst (λ k → odef k (& (* x₁))) (sym *iso) pair1 ⟫ ) + lemma1 : infinite ∋ * x₁ + lemma1 = subst (λ k → odef infinite k) (sym &iso) ltd + lemma3 : {x y : Ordinal} → (ltd : infinite-d x ) (ltd1 : infinite-d y ) → y ≡ x → ltd ≅ ltd1 + lemma3 iφ iφ refl = HE.refl + 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 (sym eq)) + ... | t = HE.cong₂ (λ j k → isuc {j} k ) (HE.≡-to-≅ (ω-prev-eq eq)) t + lemma2 : {x y : Ordinal} → (ltd : infinite-d x ) (ltd1 : infinite-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 : infinite-d x } {ltd1 : infinite-d y } → y ≡ x → ltd ≅ ltd1 → ω→nato ltd ≡ ω→nato ltd1 + lemma6 refl HE.refl = refl + lemma : nat→ω (ω→nato ltd) ≡ * x₁ + lemma = trans (cong (λ k → nat→ω k) (lemma2 {x₁} {_} ltd (subst (λ k → infinite-d k ) (sym &iso) ltd) &iso ) ) ( prev {* x₁} lemma0 lemma1 ) + +ω→nat-iso : {i : Nat} → ω→nat ( nat→ω i ) (ω∋nat→ω {i}) ≡ i +ω→nat-iso {i} = lemma i (ω∋nat→ω {i}) *iso where + lemma : {x : Ordinal } → ( i : Nat ) → (ltd : infinite-d x ) → * x ≡ nat→ω i → ω→nato ltd ≡ i + lemma {x} Zero iφ eq = refl + lemma {x} (Suc i) iφ eq = ⊥-elim ( ωs≠0 (nat→ω i) (trans (sym eq) o∅≡od∅ )) -- Union (nat→ω i , (nat→ω i , nat→ω i)) ≡ od∅ + lemma Zero (isuc {x} ltd) eq = ⊥-elim ( ωs≠0 (* x) (subst (λ k → k ≡ od∅ ) *iso eq )) + lemma (Suc i) (isuc {x} ltd) eq = cong (λ k → Suc k ) (lemma i ltd (lemma1 eq) ) where -- * x ≡ nat→ω i + lemma1 : * (& (Union (* x , (* x , * x)))) ≡ Union (nat→ω i , (nat→ω i , nat→ω i)) → * x ≡ nat→ω i + lemma1 eq = subst (λ k → * x ≡ k ) *iso (cong (λ k → * k) + ( ω-prev-eq (subst (λ k → _ ≡ k ) &iso (cong (λ k → & k ) (sym + (subst (λ k → _ ≡ Union ( k , ( k , k ))) (sym *iso ) eq )))))) + diff -r 44a484f17f26 -r 9984cdd88da3 OrdUtil.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/OrdUtil.agda Sat Aug 01 18:05:23 2020 +0900 @@ -0,0 +1,287 @@ +open import Level +open import Ordinals +module OrdUtil {n : Level} (O : Ordinals {n} ) where + +open import logic +open import nat +open import Data.Nat renaming ( zero to Zero ; suc to Suc ; ℕ to Nat ; _⊔_ to _n⊔_ ) +open import Data.Empty +open import Relation.Binary.PropositionalEquality +open import Relation.Nullary +open import Relation.Binary + +open Ordinals.Ordinals O +open Ordinals.IsOrdinals isOrdinal +open Ordinals.IsNext isNext + +o<-dom : { x y : Ordinal } → x o< y → Ordinal +o<-dom {x} _ = x + +o<-cod : { x y : Ordinal } → x o< y → Ordinal +o<-cod {_} {y} _ = y + +o<-subst : {Z X z x : Ordinal } → Z o< X → Z ≡ z → X ≡ x → z o< x +o<-subst df refl refl = df + +o<¬≡ : { ox oy : Ordinal } → ox ≡ oy → ox o< oy → ⊥ +o<¬≡ {ox} {oy} eq lt with trio< ox oy +o<¬≡ {ox} {oy} eq lt | tri< a ¬b ¬c = ¬b eq +o<¬≡ {ox} {oy} eq lt | tri≈ ¬a b ¬c = ¬a lt +o<¬≡ {ox} {oy} eq lt | tri> ¬a ¬b c = ¬b eq + +o<> : {x y : Ordinal } → y o< x → x o< y → ⊥ +o<> {ox} {oy} lt tl with trio< ox oy +o<> {ox} {oy} lt tl | tri< a ¬b ¬c = ¬c lt +o<> {ox} {oy} lt tl | tri≈ ¬a b ¬c = ¬a tl +o<> {ox} {oy} lt tl | tri> ¬a ¬b c = ¬a tl + +osuc-< : { x y : Ordinal } → y o< osuc x → x o< y → ⊥ +osuc-< {x} {y} y x x < osuc x -> y = x ∨ x < y → ⊥ +osucc {ox} {oy} oy ¬a ¬b c with osuc-≡< c +osucc {ox} {oy} oy ¬a ¬b c | case1 eq = ⊥-elim (o<¬≡ (sym eq) oy ¬a ¬b c | case2 lt = ⊥-elim (o<> lt oy ¬a ¬b c = ⊥-elim (o<> (osucc c) oy ¬a ¬b c = ⊥-elim ( o<¬≡ refl (a→b c ) ) + +maxα : Ordinal → Ordinal → Ordinal +maxα x y with trio< x y +maxα x y | tri< a ¬b ¬c = y +maxα x y | tri> ¬a ¬b c = x +maxα x y | tri≈ ¬a refl ¬c = x + +omin : Ordinal → Ordinal → Ordinal +omin x y with trio< x y +omin x y | tri< a ¬b ¬c = x +omin x y | tri> ¬a ¬b c = y +omin x y | tri≈ ¬a refl ¬c = x + +min1 : {x y z : Ordinal } → z o< x → z o< y → z o< omin x y +min1 {x} {y} {z} z ¬a ¬b c = z ¬a ¬b c = osuc x +omax x y | tri≈ ¬a refl ¬c = osuc x + +omax< : ( x y : Ordinal ) → x o< y → osuc y ≡ omax x y +omax< x y lt with trio< x y +omax< x y lt | tri< a ¬b ¬c = refl +omax< x y lt | tri≈ ¬a b ¬c = ⊥-elim (¬a lt ) +omax< x y lt | tri> ¬a ¬b c = ⊥-elim (¬a lt ) + +omax≤ : ( x y : Ordinal ) → x o≤ y → osuc y ≡ omax x y +omax≤ x y le with trio< x y +omax≤ x y le | tri< a ¬b ¬c = refl +omax≤ x y le | tri≈ ¬a refl ¬c = refl +omax≤ x y le | tri> ¬a ¬b c with osuc-≡< le +omax≤ x y le | tri> ¬a ¬b c | case1 eq = ⊥-elim (¬b eq) +omax≤ x y le | tri> ¬a ¬b c | case2 x ¬a ¬b c = ⊥-elim (¬b eq ) + +omax-x : ( x y : Ordinal ) → x o< omax x y +omax-x x y with trio< x y +omax-x x y | tri< a ¬b ¬c = ordtrans a <-osuc +omax-x x y | tri> ¬a ¬b c = <-osuc +omax-x x y | tri≈ ¬a refl ¬c = <-osuc + +omax-y : ( x y : Ordinal ) → y o< omax x y +omax-y x y with trio< x y +omax-y x y | tri< a ¬b ¬c = <-osuc +omax-y x y | tri> ¬a ¬b c = ordtrans c <-osuc +omax-y x y | tri≈ ¬a refl ¬c = <-osuc + +omxx : ( x : Ordinal ) → omax x x ≡ osuc x +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 + +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 )) + +open _∧_ + +o≤-refl : { i j : Ordinal } → i ≡ j → i o≤ j +o≤-refl {i} {j} eq = subst (λ k → i o< osuc k ) eq <-osuc +OrdTrans : Transitive _o≤_ +OrdTrans a≤b b≤c with osuc-≡< a≤b | osuc-≡< b≤c +OrdTrans a≤b b≤c | case1 refl | case1 refl = <-osuc +OrdTrans a≤b b≤c | case1 refl | case2 a≤c = ordtrans a≤c <-osuc +OrdTrans a≤b b≤c | case2 a≤c | case1 refl = ordtrans a≤c <-osuc +OrdTrans a≤b b≤c | case2 a ¬a ¬b c = ⊥-elim ( ¬x<0 c ) + +next< : {x y z : Ordinal} → x o< next z → y o< next x → y o< next z +next< {x} {y} {z} x ¬a ¬b c = ⊥-elim (¬nx osuc x o< next x o< next (osuc x) -> next x ≡ osuc z -> z o o< next x -> osuc z o< next x -> next x o< next x +nexto≡ {x} | tri< a ¬b ¬c = ⊥-elim (¬nx osuc x o< next (osuc x) o< next x -> next (osuc x) ≡ osuc z -> z o o< next (osuc x) ... +nexto≡ {x} | tri> ¬a ¬b c = ⊥-elim (¬nx ¬a ¬b c = -- x < y < next y < next x + ⊥-elim ( ¬nx ¬a ¬b c with osuc-≡< x≤y +≤next {x} {y} x≤y | tri> ¬a ¬b c | case1 refl = o≤-refl refl -- x = y < next x +≤next {x} {y} x≤y | tri> ¬a ¬b c | case2 x ¬a ¬b c = o≤-refl (sym ( x ¬a ¬b c = subst (λ k → osuc x o< k ) nexto≡ (osuc ¬a ¬b c = osuc ¬a ¬b c = subst (λ k → x o< k ) nexto≡ xnx + +record OrdinalSubset (maxordinal : Ordinal) : Set (suc n) where + field + os→ : (x : Ordinal) → x o< maxordinal → Ordinal + os← : Ordinal → Ordinal + os←limit : (x : Ordinal) → os← x o< maxordinal + os-iso← : {x : Ordinal} → os→ (os← x) (os←limit x) ≡ x + os-iso→ : {x : Ordinal} → (lt : x o< maxordinal ) → os← (os→ x lt) ≡ x + +module o≤-Reasoning {n : Level} (O : Ordinals {n} ) where + + -- open inOrdinal O + + resp-o< : _o<_ Respects₂ _≡_ + resp-o< = resp₂ _o<_ + + trans1 : {i j k : Ordinal} → i o< j → j o< osuc k → i o< k + trans1 {i} {j} {k} i ¬a ¬b c = ¬b eq - - o<> : {x y : Ordinal } → y o< x → x o< y → ⊥ - o<> {ox} {oy} lt tl with trio< ox oy - o<> {ox} {oy} lt tl | tri< a ¬b ¬c = ¬c lt - o<> {ox} {oy} lt tl | tri≈ ¬a b ¬c = ¬a tl - o<> {ox} {oy} lt tl | tri> ¬a ¬b c = ¬a tl - - osuc-< : { x y : Ordinal } → y o< osuc x → x o< y → ⊥ - osuc-< {x} {y} y x x < osuc x -> y = x ∨ x < y → ⊥ - osucc {ox} {oy} oy ¬a ¬b c with osuc-≡< c - osucc {ox} {oy} oy ¬a ¬b c | case1 eq = ⊥-elim (o<¬≡ (sym eq) oy ¬a ¬b c | case2 lt = ⊥-elim (o<> lt oy ¬a ¬b c = ⊥-elim (o<> (osucc c) oy ¬a ¬b c = ⊥-elim ( o<¬≡ refl (a→b c ) ) - - maxα : Ordinal → Ordinal → Ordinal - maxα x y with trio< x y - maxα x y | tri< a ¬b ¬c = y - maxα x y | tri> ¬a ¬b c = x - maxα x y | tri≈ ¬a refl ¬c = x - - omin : Ordinal → Ordinal → Ordinal - omin x y with trio< x y - omin x y | tri< a ¬b ¬c = x - omin x y | tri> ¬a ¬b c = y - omin x y | tri≈ ¬a refl ¬c = x - - min1 : {x y z : Ordinal } → z o< x → z o< y → z o< omin x y - min1 {x} {y} {z} z ¬a ¬b c = z ¬a ¬b c = osuc x - omax x y | tri≈ ¬a refl ¬c = osuc x - - omax< : ( x y : Ordinal ) → x o< y → osuc y ≡ omax x y - omax< x y lt with trio< x y - omax< x y lt | tri< a ¬b ¬c = refl - omax< x y lt | tri≈ ¬a b ¬c = ⊥-elim (¬a lt ) - omax< x y lt | tri> ¬a ¬b c = ⊥-elim (¬a lt ) - - omax≤ : ( x y : Ordinal ) → x o≤ y → osuc y ≡ omax x y - omax≤ x y le with trio< x y - omax≤ x y le | tri< a ¬b ¬c = refl - omax≤ x y le | tri≈ ¬a refl ¬c = refl - omax≤ x y le | tri> ¬a ¬b c with osuc-≡< le - omax≤ x y le | tri> ¬a ¬b c | case1 eq = ⊥-elim (¬b eq) - omax≤ x y le | tri> ¬a ¬b c | case2 x ¬a ¬b c = ⊥-elim (¬b eq ) - - omax-x : ( x y : Ordinal ) → x o< omax x y - omax-x x y with trio< x y - omax-x x y | tri< a ¬b ¬c = ordtrans a <-osuc - omax-x x y | tri> ¬a ¬b c = <-osuc - omax-x x y | tri≈ ¬a refl ¬c = <-osuc - - omax-y : ( x y : Ordinal ) → y o< omax x y - omax-y x y with trio< x y - omax-y x y | tri< a ¬b ¬c = <-osuc - omax-y x y | tri> ¬a ¬b c = ordtrans c <-osuc - omax-y x y | tri≈ ¬a refl ¬c = <-osuc - - omxx : ( x : Ordinal ) → omax x x ≡ osuc x - 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 - - 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 )) - - open _∧_ - - o≤-refl : { i j : Ordinal } → i ≡ j → i o≤ j - o≤-refl {i} {j} eq = subst (λ k → i o< osuc k ) eq <-osuc - OrdTrans : Transitive _o≤_ - OrdTrans a≤b b≤c with osuc-≡< a≤b | osuc-≡< b≤c - OrdTrans a≤b b≤c | case1 refl | case1 refl = <-osuc - OrdTrans a≤b b≤c | case1 refl | case2 a≤c = ordtrans a≤c <-osuc - OrdTrans a≤b b≤c | case2 a≤c | case1 refl = ordtrans a≤c <-osuc - OrdTrans a≤b b≤c | case2 a ¬a ¬b c = ⊥-elim ( ¬x<0 c ) - - next< : {x y z : Ordinal} → x o< next z → y o< next x → y o< next z - next< {x} {y} {z} x ¬a ¬b c = ⊥-elim (¬nx osuc x o< next x o< next (osuc x) -> next x ≡ osuc z -> z o o< next x -> osuc z o< next x -> next x o< next x - nexto≡ {x} | tri< a ¬b ¬c = ⊥-elim (¬nx osuc x o< next (osuc x) o< next x -> next (osuc x) ≡ osuc z -> z o o< next (osuc x) ... - nexto≡ {x} | tri> ¬a ¬b c = ⊥-elim (¬nx ¬a ¬b c = -- x < y < next y < next x - ⊥-elim ( ¬nx ¬a ¬b c with osuc-≡< x≤y - ≤next {x} {y} x≤y | tri> ¬a ¬b c | case1 refl = o≤-refl refl -- x = y < next x - ≤next {x} {y} x≤y | tri> ¬a ¬b c | case2 x ¬a ¬b c = o≤-refl (sym ( x ¬a ¬b c = subst (λ k → osuc x o< k ) nexto≡ (osuc ¬a ¬b c = osuc ¬a ¬b c = subst (λ k → x o< k ) nexto≡ xnx - - record OrdinalSubset (maxordinal : Ordinal) : Set (suc n) where - field - os→ : (x : Ordinal) → x o< maxordinal → Ordinal - os← : Ordinal → Ordinal - os←limit : (x : Ordinal) → os← x o< maxordinal - os-iso← : {x : Ordinal} → os→ (os← x) (os←limit x) ≡ x - os-iso→ : {x : Ordinal} → (lt : x o< maxordinal ) → os← (os→ x lt) ≡ x - -module o≤-Reasoning {n : Level} (O : Ordinals {n} ) where - - open inOrdinal O - - resp-o< : Ordinals._o<_ O Respects₂ _≡_ - resp-o< = resp₂ _o<_ - - trans1 : {i j k : Ordinal} → i o< j → j o< osuc k → i o< k - trans1 {i} {j} {k} i