{-# OPTIONS --allow-unsolved-metas #-} open import Level hiding ( suc ; zero ) open import Ordinals open import Relation.Binary open import Relation.Binary.Core open import Relation.Binary.PropositionalEquality import OD module zorn {n : Level } (O : Ordinals {n}) (_<_ : (x y : OD.HOD O ) → Set n ) (PO : IsStrictPartialOrder _≡_ _<_ ) where -- -- Zorn-lemma : { A : HOD } -- → o∅ o< & A -- → ( ( B : HOD) → (B⊆A : B ⊆ A) → IsTotalOrderSet B → SUP A B ) -- SUP condition -- → Maximal A -- open import zf open import logic -- open import partfunc {n} O open import Relation.Nullary open import Data.Empty import BAlgbra open import Data.Nat hiding ( _<_ ; _≤_ ) open import Data.Nat.Properties open import nat open inOrdinal O open OD O open OD.OD open ODAxiom odAxiom import OrdUtil import ODUtil open Ordinals.Ordinals O open Ordinals.IsOrdinals isOrdinal open Ordinals.IsNext isNext open OrdUtil O open ODUtil O import ODC open _∧_ open _∨_ open Bool open HOD -- -- Partial Order on HOD ( possibly limited in A ) -- _<<_ : (x y : Ordinal ) → Set n x << y = * x < * y _<=_ : (x y : Ordinal ) → Set n -- we can't use * x ≡ * y, it is Set (Level.suc n). Level (suc n) troubles Chain x <= y = (x ≡ y ) ∨ ( * x < * y ) POO : IsStrictPartialOrder _≡_ _<<_ POO = record { isEquivalence = record { refl = refl ; sym = sym ; trans = trans } ; trans = IsStrictPartialOrder.trans PO ; irrefl = λ x=y x ¬a ¬b c = ⊥-elim ( nat-≤> x ¬a ¬b c = tri> (λ lt → <-irr (case2 fc12) lt) (λ eq → <-irr (case1 eq) fc12) fc12 where fc12 : * y < * x fc12 = fcn-< {A} s {y} {x} {f} mf cy cx c -- open import Relation.Binary.Properties.Poset as Poset IsTotalOrderSet : ( A : HOD ) → Set (Level.suc n) IsTotalOrderSet A = {a b : HOD} → odef A (& a) → odef A (& b) → Tri (a < b) (a ≡ b) (b < a ) ⊆-IsTotalOrderSet : { A B : HOD } → B ⊆ A → IsTotalOrderSet A → IsTotalOrderSet B ⊆-IsTotalOrderSet {A} {B} B⊆A T ax ay = T (incl B⊆A ax) (incl B⊆A ay) _⊆'_ : ( A B : HOD ) → Set n _⊆'_ A B = {x : Ordinal } → odef A x → odef B x -- -- inductive maxmum tree from x -- tree structure -- record HasPrev (A B : HOD) (x : Ordinal ) ( f : Ordinal → Ordinal ) : Set n where field ax : odef A x y : Ordinal ay : odef B y x=fy : x ≡ f y record IsSup (A B : HOD) {x : Ordinal } (xa : odef A x) : Set n where field x (λ lt → <-irr (case2 ct01) lt) (λ eq → <-irr (case1 eq) ct01) ct01 where ct01 : * b < * a ct01 = subst (λ k → * k < * a ) (sym eq) lt ct-ind xa xb {a} {b} (ch-is-sup ua u≤x supa fca) (ch-init fcb) | case2 lt = tri> (λ lt → <-irr (case2 ct01) lt) (λ eq → <-irr (case1 eq) ct01) ct01 where ct00 : * b < * (supf ua) ct00 = lt ct01 : * b < * a ct01 with s≤fc (supf ua) f mf fca ... | case1 eq = subst (λ k → * b < k ) eq ct00 ... | case2 lt = IsStrictPartialOrder.trans POO ct00 lt ct-ind xa xb {a} {b} (ch-is-sup ua ua ¬a ¬b c with ChainP.order supa (subst₂ (λ j k → j o< k ) (sym (ChainP.supu=u supb )) (sym (ChainP.supu=u supa )) c) fcb ... | case1 eq with s≤fc (supf ua) f mf fca ... | case1 eq1 = tri≈ (λ lt → ⊥-elim (<-irr (case1 (sym ct00)) lt)) ct00 (λ lt → ⊥-elim (<-irr (case1 ct00) lt)) where ct00 : * a ≡ * b ct00 = sym (trans (cong (*) eq) eq1) ... | case2 lt = tri> (λ lt → <-irr (case2 ct02) lt) (λ eq → <-irr (case1 eq) ct02) ct02 where ct02 : * b < * a ct02 = subst (λ k → * k < * a ) (sym eq) lt ct-ind xa xb {a} {b} (ch-is-sup ua ua ¬a ¬b c | case2 lt = tri> (λ lt → <-irr (case2 ct04) lt) (λ eq → <-irr (case1 (eq)) ct04) ct04 where ct05 : * b < * (supf ua) ct05 = lt ct04 : * b < * a ct04 with s≤fc (supf ua) f mf fca ... | case1 eq = subst (λ k → * b < k ) eq ct05 ... | case2 lt = IsStrictPartialOrder.trans POO ct05 lt ∈∧P→o< : {A : HOD } {y : Ordinal} → {P : Set n} → odef A y ∧ P → y o< & A ∈∧P→o< {A } {y} p = subst (λ k → k o< & A) &iso ( c<→o< (subst (λ k → odef A k ) (sym &iso ) (proj1 p ))) -- Union of supf z which o< x -- UnionCF : ( A : HOD ) ( f : Ordinal → Ordinal ) (mf : ≤-monotonic-f A f) {y : Ordinal } (ay : odef A y ) ( supf : Ordinal → Ordinal ) ( x : Ordinal ) → HOD UnionCF A f mf ay supf x = record { od = record { def = λ z → odef A z ∧ UChain A f mf ay supf (supf x) z } ; odmax = & A ; ¬a ¬b y sx ¬a ¬b c = ⊥-elim (<-irr (case2 sx ¬a ¬b y sx ¬a ¬b c = case1 ( λ lt → ⊥-elim ( ¬a lt ) ) ... | tri< a ¬b ¬c with prev z a ... | case2 mins = case2 mins ... | case1 not with ODC.p∨¬p O (odef A z ∧ xsup z) ... | case1 mins = case2 record { sup = z ; asm = proj1 mins ; x ¬a ¬b s ¬a ¬b c = ⊥-elim z17 where z15 : (* (f ( & ( SUP.sup sp1 ))) ≡ SUP.sup sp1) ∨ (* (f ( & ( SUP.sup sp1 ))) < SUP.sup sp1) z15 = SUP.x ¬a ¬b px (<-irr (case2 lt1)) (λ eq → <-irr (case1 eq) lt1) lt1 where lt1 : a0 < b0 lt1 = subst₂ (λ j k → j < k ) *iso *iso lt ptotal (case2 a) (case2 b) = subst₂ (λ j k → Tri (j < k) (j ≡ k) (k < j)) *iso *iso (fcn-cmp px f mf a b) sup1 : MinSUP A pchainpx sup1 = minsupP pchainpx zc01 ptotal sp1 : Ordinal sp1 = MinSUP.sup sup1 supf1 : Ordinal → Ordinal supf1 z with trio< z px ... | tri< a ¬b ¬c = supf0 z ... | tri≈ ¬a b ¬c = px --- supf px ≡ px ... | tri> ¬a ¬b c = sp1 --- this may equal or larger then x, and sp1 ≡ supf x, is not included in UniofCF apx : odef A px apx = subst (λ k → odef A k ) (sym sfpx=px) ( ZChain.asupf zc ) asupf1 : {z : Ordinal } → odef A (supf1 z ) asupf1 {z} with trio< z px ... | tri< a ¬b ¬c = ZChain.asupf zc ... | tri≈ ¬a b ¬c = subst (λ k → odef A k ) (trans (cong supf0 b) (sym sfpx=px)) ( ZChain.asupf zc ) ... | tri> ¬a ¬b c = MinSUP.asm sup1 sf1=sf0 : {z : Ordinal } → z o≤ px → supf1 z ≡ supf0 z sf1=sf0 {z} z ¬a ¬b c = ⊥-elim ( o≤> z ¬a ¬b c = ⊥-elim ( ¬b refl ) ... | case2 lt = subst₂ (λ j k → j o≤ k ) (sym (sf1=sf0 (o<→≤ lt))) (sym sfpx=px) ( supf-mono z≤w ) supf-mono1 {z} {w} z≤w | tri> ¬a ¬b c with trio< z px ... | tri< a ¬b ¬c = zc19 where zc21 : MinSUP A (UnionCF A f mf ay supf0 z) zc21 = ZChain.minsup zc ? -- (o<→≤ a) zc24 : {x₁ : Ordinal} → odef (UnionCF A f mf ay supf0 z) x₁ → (x₁ ≡ sp1) ∨ (x₁ << sp1) zc24 {x₁} ux = MinSUP.x ¬a ¬b c = o≤-refl supf-<1 : {z0 z1 : Ordinal} → supf1 z0 o< supf1 z1 → supf1 z0 << supf1 z1 supf-<1 {z0} {z1} sz0 ¬a ¬b px ¬a ¬b c = ⊥-elim ( o<¬≡ refl sz0 ¬a ¬b c | _ = ⊥-elim ( ¬p ¬a ¬b c | _ = ⊥-elim ( ¬p ¬a ¬b c with trio< z px ... | tri< a ¬b ¬c = ZChain.x≤supfx zc ? ... | tri≈ ¬a b ¬c = subst (λ k → k o< osuc px) (sym b) <-osuc ... | tri> ¬a ¬b lt = ⊥-elim ( o≤> sf04 c ) where -- c : sp1 o< z, lt : px o< z -- supf1 z ≡ sp1 -- supf1 z o< z z=x : z ≡ x z=x with trio< z x ... | tri< a ¬b ¬c = ⊥-elim ( ¬p ¬a ¬b c = ⊥-elim ( o≤> z≤x ? ) sf01 : supf1 x ≡ sp1 sf01 with trio< x px ... | tri< a ¬b ¬c = ⊥-elim ( ¬c (pxo ¬a ¬b c = refl sf02 : supf1 px o≤ supf1 x sf02 = supf-mono1 (o<→≤ (pxo ¬a ¬b px ¬a ¬b c = ⊥-elim ( ¬p ¬a ¬b c = supf0 px sf1=sf0 : {z : Ordinal } → z o< px → supf1 z ≡ supf0 z sf1=sf0 {z} z ¬a ¬b c = ⊥-elim ( ¬a z ¬a ¬b c = o≤-refl supf-mono1 {z} {w} z≤w | tri> ¬a ¬b c with trio< z px ... | tri< a ¬b ¬c = zc17 ... | tri≈ ¬a b ¬c = o≤-refl ... | tri> ¬a ¬b c = o≤-refl pchain1 : HOD pchain1 = UnionCF A f mf ay supf1 x zc10 : {z : Ordinal} → OD.def (od pchain) z → OD.def (od pchain1) z zc10 {z} ⟪ az , ch-init fc ⟫ = ⟪ az , ch-init fc ⟫ zc10 {z} ⟪ az , ch-is-sup u1 u1 ¬a ¬b px ¬a ¬b c = ⊥-elim ( o<> u1 ¬a ¬b px ¬a ¬b c = ⊥-elim ( o<> u1 ¬a ¬b px ¬a ¬b c = zc36 ¬b ... | tri≈ ¬a b ¬c = record { tsup = ? ; tsup=sup = ? } where zc37 : MinSUP A (UnionCF A f mf ay supf0 z) zc37 = record { sup = ? ; asm = ? ; x ¬a ¬b px ¬a ¬b c = ysp pchain : HOD pchain = UnionCF A f mf ay supf0 x ptotal0 : IsTotalOrderSet pchain ptotal0 {a} {b} ca cb = subst₂ (λ j k → Tri (j < k) (j ≡ k) (k < j)) *iso *iso uz01 where uz01 : Tri (* (& a) < * (& b)) (* (& a) ≡ * (& b)) (* (& b) < * (& a) ) uz01 = chain-total A f mf ay supf0 ( (proj2 ca)) ( (proj2 cb)) usup : MinSUP A pchain usup = minsupP pchain (λ lt → proj1 lt) ptotal0 spu = MinSUP.sup usup supf1 : Ordinal → Ordinal supf1 z with trio< z x ... | tri< a ¬b ¬c = ZChain.supf (pzc (osuc z) (ob ¬a ¬b c = spu pchain1 : HOD pchain1 = UnionCF A f mf ay supf1 x is-max-hp : (supf : Ordinal → Ordinal) (x : Ordinal) {a : Ordinal} {b : Ordinal} → odef (UnionCF A f mf ay supf x) a → b o< x → (ab : odef A b) → HasPrev A (UnionCF A f mf ay supf x) b f → * a < * b → odef (UnionCF A f mf ay supf x) b is-max-hp supf x {a} {b} ua b ¬a ¬b c = ? -- ⊥-elim ( o≤> u ¬a ¬b x ¬a ¬b x ¬a ¬b x