view cardinal.agda @ 247:d09437fcfc7c

fix pair
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 26 Aug 2019 12:27:20 +0900
parents 3506f53c7d83
children 9fd85b954477
line wrap: on
line source

open import Level
open import Ordinals
module cardinal {n : Level } (O : Ordinals {n}) where

open import zf
open import logic
import OD 
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

open inOrdinal O
open OD O
open OD.OD

open _∧_
open _∨_
open Bool

-- we have to work on Ordinal to keep OD Level n
-- since we use p∨¬p which works only on Level n

<_,_> : (x y : OD) → OD
< x , y > = (x , x ) , (x , y )

data ord-pair : (p : Ordinal) → Set n where
   pair : (x y : Ordinal ) → ord-pair ( od→ord ( < ord→od x , ord→od y > ) )

ZFProduct : OD
ZFProduct = record { def = λ x → ord-pair x }

pi1 : { p : Ordinal } →   ord-pair p →  Ordinal
pi1 ( pair x y ) = x

π1 : { p : OD } → ZFProduct ∋ p → Ordinal
π1 lt = pi1 lt 

pi2 : { p : Ordinal } →   ord-pair p →  Ordinal
pi2 ( pair x y ) = y

π2 : { p : OD } → ZFProduct ∋ p → Ordinal
π2 lt = pi2 lt 

p-cons :  ( x y  : OD ) → ZFProduct ∋ < x , y >
p-cons x y =  def-subst {_} {_} {ZFProduct} {od→ord (< x , y >)} (pair (od→ord x) ( od→ord y )) refl (
    let open ≡-Reasoning in begin
        od→ord < ord→od (od→ord x) , ord→od (od→ord y) >
    ≡⟨ cong₂ (λ j k → od→ord < j , k >) oiso oiso ⟩
        od→ord < x , y >
    ∎ )

open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 

eq-pair : { x x' y y' : Ordinal } → x ≡ x' → y ≡ y' → pair x y ≅ pair x' y'
eq-pair refl refl = HE.refl

eq-prod : { x x' y y' : OD } → x ≡ x' → y ≡ y' → < x , y > ≡ < x' , y' >
eq-prod refl refl = refl

-- prod-eq : { x x' y y' : OD } → < x , y > ≡ < x' , y' > → (x ≡ x' ) ∧ ( y ≡ y' )
-- prod-eq {x} {x'} {y} {y'} eq = {!!} where
--     lemma : < x , y > ≡ < x , y' > → y ≡ y'
--     lemma eq1 with trio< (od→ord x) (od→ord y) 
--     lemma eq1 | tri< a ¬b ¬c = {!!}
--     lemma eq1 | tri≈ ¬a b ¬c = {!!}
--     lemma eq1 | tri> ¬a ¬b c = {!!}

postulate
   def-eq :  { P Q p q : OD } →  P ≡ Q → p ≡ q → (pt : P ∋ p ) → (qt : Q ∋ q ) → pt ≅ qt

∈-to-ord : {p : Ordinal } → ( ZFProduct ∋  ord→od p ) → ord-pair p
∈-to-ord {p} lt = def-subst {ZFProduct} {(od→ord (ord→od p))} {_} {_} lt refl diso

ord-to-∈ : {p : Ordinal } → ord-pair p → ZFProduct ∋  ord→od p 
ord-to-∈ {p} lt = def-subst {_} {_} {ZFProduct} {(od→ord (ord→od p))} lt refl (sym diso)

lemma333 : { A a  : OD } → { x : A ∋ a } → def-subst {A} {od→ord a} (def-subst {A} {od→ord a} x refl refl ) refl refl ≡ x
lemma333 = refl

lemma334 : { A B  : OD } → {a b : Ordinal} → { x : A ∋ ord→od a } → { y : B ∋ ord→od b } → (f1 : A ≡ B) → (f2 : a ≡ b)
   → def-subst {B} {od→ord (ord→od b)} (def-subst {A} { od→ord (ord→od a)} x f1 (cong (λ k → od→ord (ord→od k)) f2 )) refl refl ≅ x
lemma334 {A} {A} {a} {a} {x} {y} refl refl with def-eq {A} {A} {ord→od a} {ord→od a} refl refl x y
... | HE.refl = HE.refl

lemma335 : { A B C : OD } → {a b c : Ordinal} → { x : A ∋ ord→od a } → { y : C ∋ ord→od c } → (f1 : A ≡ B) → (f2 : a ≡ b) → (g1 : B ≡ C) → (g2 : b ≡ c)
   → def-subst {B} {od→ord (ord→od b)} (def-subst {A} { od→ord (ord→od a)} x f1 (cong (λ k → od→ord (ord→od k)) f2 )) g1 (cong (λ k → od→ord (ord→od k)) g2 )
      ≅ def-subst {A} { od→ord (ord→od a)} {C } { od→ord (ord→od c)} x (trans f1 g1)
          (trans (cong (λ k → od→ord (ord→od k)) f2 ) (cong (λ k → od→ord (ord→od k)) g2 ))
lemma335 {A} {A} {A} {a} {a} {a} {x} {y} refl refl refl refl with def-eq {A} {A} {ord→od a} {ord→od a} refl refl x y
... | HE.refl = HE.refl

∈-to-ord-oiso : { p : Ordinal } → { x : ord-pair p } → ∈-to-ord (ord-to-∈ x) ≡ x
∈-to-ord-oiso {p} {x} = {!!} where
   lemma : def-subst {_} {_} {ZFProduct} {{!!}} (def-subst {_} {_} {ZFProduct} {{!!}} x refl (sym diso)) refl diso ≡ x
   lemma = {!!}

lemma34 : { p q : Ordinal } → (x :  ord-pair p ) → (y :  ord-pair q ) → p ≡ q → x ≅ y
lemma34 {p} {q} x y refl = subst₂ (λ j k → j ≅ k) ∈-to-ord-oiso ∈-to-ord-oiso (HE.cong (λ k → ∈-to-ord k) lemma1 ) where
   lemma : (pt : ZFProduct ∋ ord→od p ) → (qt : ZFProduct ∋ ord→od q ) → p ≡ q → pt ≅ qt
   lemma pt qt eq = def-eq {ZFProduct} {ZFProduct} refl (cong (λ k → ord→od k) eq) pt qt
   lemma1 : (ord-to-∈ x) ≅ (ord-to-∈ y )
   lemma1 = lemma (ord-to-∈ x) (ord-to-∈ y ) refl

π1-cong :  { p q : OD } →  p ≡ q → (pt : ZFProduct ∋ p ) → (qt : ZFProduct ∋ q ) → π1 pt ≅ π1 qt
π1-cong {p} {q} refl s t = HE.cong (λ k → pi1 k ) (def-eq {ZFProduct} {ZFProduct} refl refl s t ) 

π1--iso :  { x y : OD } → (p : ZFProduct ∋ < x , y > )  →  π1 p ≅  od→ord x
π1--iso {x} {y} p  = lemma (od→ord x) (od→ord y) {!!} {!!} refl where
   lemma1 : ( ox oy op : Ordinal ) → (p : ord-pair op) → op ≡  od→ord ( < ord→od ox , ord→od oy >)  → p ≅ pair ox oy
   lemma1 ox oy op (pair x' y')  eq = lemma34 {!!} {!!} {!!}
   lemma : ( ox oy op : Ordinal ) → (p : ord-pair op ) → op ≡ od→ord ( < ord→od ox , ord→od oy > )  → pi1 p ≅ ox
   lemma ox oy op p eq  = {!!} -- HE.cong (λ k → pi1 k ) (lemma1 ox oy op p eq  )

p-iso :  { x  : OD } → {p : ZFProduct ∋ x } → < ord→od (π1 p) , ord→od (π2 p) > ≡ x
p-iso {x} {p} with p-cons (ord→od (π1 p)) (ord→od (π2 p))
... | t = {!!}


∋-p : (A x : OD ) → Dec ( A ∋ x ) 
∋-p A x with p∨¬p ( A ∋ x )
∋-p A x | case1 t = yes t
∋-p A x | case2 t = no t

_⊗_  : (A B : OD) → OD
A ⊗ B  = record { def = λ x → def ZFProduct x ∧ ( { x : Ordinal } → (p : def ZFProduct x ) → checkAB p ) } where
    checkAB : { p : Ordinal } → def ZFProduct p → Set n
    checkAB (pair x y) = def A x ∧ def B y

func→od0  : (f : Ordinal → Ordinal ) → OD
func→od0  f = record { def = λ x → def ZFProduct x ∧ ( { x : Ordinal } → (p : def ZFProduct x ) → checkfunc p ) } where
    checkfunc : { p : Ordinal } → def ZFProduct p → Set n
    checkfunc (pair x y) = f x ≡ y

--  Power (Power ( A ∪ B )) ∋ ( A ⊗ B )

Func :  ( A B : OD ) → OD
Func A B = record { def = λ x → def (Power (A ⊗ B)) x } 

-- power→ :  ( A t : OD) → Power A ∋ t → {x : OD} → t ∋ x → ¬ ¬ (A ∋ x)


func→od : (f : Ordinal → Ordinal ) → ( dom : OD ) → OD 
func→od f dom = Replace dom ( λ x →  < x , ord→od (f (od→ord x)) > )

record Func←cd { dom cod : OD } {f : Ordinal }  : Set n where
   field
      func-1 : Ordinal → Ordinal
      func→od∈Func-1 :  Func dom cod ∋  func→od func-1 dom
 
od→func : { dom cod : OD } → {f : Ordinal }  → def (Func dom cod ) f  → Func←cd {dom} {cod} {f} 
od→func {dom} {cod} {f} lt = record { func-1 = λ x → sup-o ( λ y → lemma x y ) ; func→od∈Func-1 = record { proj1 = {!!} ; proj2 = {!!} } } where
   lemma : Ordinal → Ordinal → Ordinal
   lemma x y with IsZF.power→ isZF (dom ⊗ cod) (ord→od f) (subst (λ k → def (Power (dom ⊗ cod)) k ) (sym diso) lt ) | ∋-p (ord→od f) (ord→od y)
   lemma x y | p | no n  = o∅
   lemma x y | p | yes f∋y = lemma2 (proj1 (double-neg-eilm ( p {ord→od y} f∋y ))) where -- p : {y : OD} → f ∋ y → ¬ ¬ (dom ⊗ cod ∋ y) 
           lemma2 : {p : Ordinal} → ord-pair p  → Ordinal
           lemma2 (pair x1 y1) with decp ( x1 ≡ x)
           lemma2 (pair x1 y1) | yes p = y1
           lemma2 (pair x1 y1) | no ¬p = o∅
   fod : OD
   fod = Replace dom ( λ x →  < x , ord→od (sup-o ( λ y → lemma (od→ord x) y )) > )


open Func←cd

-- contra position of sup-o<
--

-- postulate
--   -- contra-position of mimimulity of supermum required in Cardinal
--   sup-x  : ( Ordinal  → Ordinal ) →  Ordinal 
--   sup-lb : { ψ : Ordinal  →  Ordinal } → {z : Ordinal }  →  z o< sup-o ψ → z o< osuc (ψ (sup-x ψ))

------------
--
-- Onto map
--          def X x ->  xmap
--     X ---------------------------> Y
--          ymap   <-  def Y y
--
record Onto  (X Y : OD )  : Set n where
   field
       xmap : Ordinal 
       ymap : Ordinal 
       xfunc : def (Func X Y) xmap 
       yfunc : def (Func Y X) ymap 
       onto-iso   : {y :  Ordinal  } → (lty : def Y y ) →
          func-1 ( od→func {X} {Y} {xmap} xfunc ) ( func-1 (od→func  yfunc) y )  ≡ y 

open Onto

onto-restrict : {X Y Z : OD} → Onto X Y → ({x : OD} → _⊆_ Z Y {x}) → Onto X Z
onto-restrict {X} {Y} {Z} onto  Z⊆Y = record {
     xmap = xmap1
   ; ymap = zmap
   ; xfunc = xfunc1
   ; yfunc = zfunc
   ; onto-iso = onto-iso1
  } where
       xmap1 : Ordinal 
       xmap1 = od→ord (Select (ord→od (xmap onto)) {!!} ) 
       zmap : Ordinal 
       zmap = {!!}
       xfunc1 : def (Func X Z) xmap1
       xfunc1 = {!!}
       zfunc : def (Func Z X) zmap 
       zfunc = {!!}
       onto-iso1   : {z :  Ordinal  } → (ltz : def Z z ) → func-1 (od→func  xfunc1 )  (func-1 (od→func  zfunc ) z )  ≡ z
       onto-iso1   = {!!}


record Cardinal  (X  : OD ) : Set n where
   field
       cardinal : Ordinal 
       conto : Onto X (Ord cardinal)  
       cmax : ( y : Ordinal  ) → cardinal o< y → ¬ Onto X (Ord y)  

cardinal :  (X  : OD ) → Cardinal X
cardinal  X = record {
       cardinal = sup-o ( λ x → proj1 ( cardinal-p x) )
     ; conto = onto
     ; cmax = cmax
   } where
    cardinal-p : (x  : Ordinal ) →  ( Ordinal  ∧ Dec (Onto X (Ord x) ) )
    cardinal-p x with p∨¬p ( Onto X (Ord x)  ) 
    cardinal-p x | case1 True  = record { proj1 = x  ; proj2 = yes True }
    cardinal-p x | case2 False = record { proj1 = o∅ ; proj2 = no False }
    S = sup-o (λ x → proj1 (cardinal-p x))
    lemma1 :  (x : Ordinal) → ((y : Ordinal) → y o< x → Lift (suc n) (y o< (osuc S) → Onto X (Ord y))) →
                    Lift (suc n) (x o< (osuc S) → Onto X (Ord x) )
    lemma1 x prev with trio< x (osuc S)
    lemma1 x prev | tri< a ¬b ¬c with osuc-≡< a
    lemma1 x prev | tri< a ¬b ¬c | case1 x=S = lift ( λ lt → {!!} )
    lemma1 x prev | tri< a ¬b ¬c | case2 x<S = lift ( λ lt → lemma2 ) where
         lemma2 : Onto X (Ord x) 
         lemma2 with prev {!!} {!!}
         ... | lift t = t {!!}
    lemma1 x prev | tri≈ ¬a b ¬c = lift ( λ lt → ⊥-elim ( o<¬≡ b lt ))
    lemma1 x prev | tri> ¬a ¬b c = lift ( λ lt → ⊥-elim ( o<> c lt ))
    onto : Onto X (Ord S) 
    onto with TransFinite {λ x → Lift (suc n) ( x o< osuc S → Onto X (Ord x) ) } lemma1 S 
    ... | lift t = t <-osuc  
    cmax : (y : Ordinal) → S o< y → ¬ Onto X (Ord y) 
    cmax y lt ontoy = o<> lt (o<-subst  {_} {_} {y} {S}
       (sup-o<  {λ x → proj1 ( cardinal-p x)}{y}  ) lemma refl ) where
          lemma : proj1 (cardinal-p y) ≡ y
          lemma with  p∨¬p ( Onto X (Ord y) )
          lemma | case1 x = refl
          lemma | case2 not = ⊥-elim ( not ontoy )


-----
--  All cardinal is ℵ0,  since we are working on Countable Ordinal, 
--  Power ω is larger than ℵ0, so it has no cardinal.