Mercurial > hg > Members > kono > Proof > galois
changeset 138:6bb9b3f7b844
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 09 Sep 2020 10:53:20 +0900 |
parents | 1722fd0f1fcf |
children | 065d8410d346 |
files | FL.agda |
diffstat | 1 files changed, 29 insertions(+), 15 deletions(-) [+] |
line wrap: on
line diff
--- a/FL.agda Tue Sep 08 17:33:49 2020 +0900 +++ b/FL.agda Wed Sep 09 10:53:20 2020 +0900 @@ -48,6 +48,12 @@ ... | tri≈ ¬a₁ refl ¬c₁ = tri≈ (λ lt → f-≡< refl lt ) refl (λ lt → f-≡< refl lt ) ... | tri> ¬a₁ ¬b c = tri> (λ lt → f-<> lt (f<t c) ) (λ eq → ¬b (proj₂ (FLeq eq) )) (f<t c) +f<-trans : {n : ℕ } { x y z : FL n } → x f< y → y f< z → x f< z +f<-trans {suc n} (f<n x) (f<n x₁) = f<n ( Data.Fin.Properties.<-trans x x₁ ) +f<-trans {suc n} (f<n x) (f<t y<z) = f<n x +f<-trans {suc n} (f<t x<y) (f<n x) = f<n x +f<-trans {suc n} (f<t x<y) (f<t y<z) = f<t (f<-trans x<y y<z) + infixr 250 _f<?_ _f<?_ : {n : ℕ} → (x y : FL n ) → Dec (x f< y ) @@ -116,7 +122,7 @@ ... | tri≈ ¬a₁ b₁ ¬c₁ = inj₁ (case1 (subst₂ (λ j k → j :: k ≡ y :: yt ) (sym b) (sym b₁ ) refl )) ... | tri> ¬a₁ ¬b c = inj₂ (case2 (subst (λ k → (y :: yt ) f< (k :: xt) ) (sym b) (f<t c))) -open import Relation.Nary using (⌊_⌋; fromWitness) +open import Relation.Nary using (⌊_⌋) open import Data.List.Fresh open import Data.List.Fresh.Relation.Unary.All open import Data.List.Fresh.Relation.Unary.Any as Any using (Any; here; there) @@ -145,21 +151,29 @@ -- T true = ⊤ -- T false = ⊥ -ttf< : {n : ℕ } → {x a : FL n } → x f< a → T (isYes (x f<? a)) -ttf< {n} {x} {a} x<a with x f<? a -... | yes y = subst (λ k → Data.Bool.T k ) refl tt -... | no nn = ⊥-elim ( nn x<a ) +-- fresh a [] = ⊤ +-- fresh a (x ∷# xs) = R a x × fresh a xs + +-- toWitness +-- ttf< : {n : ℕ } → {x a : FL n } → x f< a → T (isYes (x f<? a)) +-- ttf< {n} {x} {a} x<a with x f<? a +-- ... | yes y = subst (λ k → Data.Bool.T k ) refl tt +-- ... | no nn = ⊥-elim ( nn x<a ) -FLcons : {n : ℕ } → FL n → FList {n} → FList {n} -FLcons {zero} f0 y = f0 ∷# [] -FLcons {suc n} x [] = x ∷# [] -FLcons {suc n} x (cons a y x₁) with total x a +FLinsert : {n : ℕ } → FL n → FList {n} → FList {n} +FLinsert {zero} f0 y = f0 ∷# [] +FLinsert {suc n} x [] = x ∷# [] +FLinsert {suc n} x (cons a y x₁) with total x a ... | inj₁ (case1 eq) = cons a y x₁ -FLcons {suc n} x (cons a y x₁) | inj₁ (case2 lt) = cons x ( cons a y x₁) ( Level.lift (ttf< lt ) , ttf a y x₁) where - ttf : (a : FL (suc n)) → (y : FList {suc n}) → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a y → fresh (FL (suc n)) ⌊ _f<?_ ⌋ x y - ttf a [] fr = Level.lift tt - ttf a (cons a₁ y x1) (lift lt1 , _ ) = (Level.lift (ttf< {!!} )) , ttf a₁ y x1 +FLinsert {suc n} x (cons a y x₁) | inj₁ (case2 lt) = cons x ( cons a y x₁) ( Level.lift (fromWitness lt ) , ttf a lt y x₁) where + ttf : (a : FL (suc n)) → x f< a → (y : FList {suc n}) → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a y → fresh (FL (suc n)) ⌊ _f<?_ ⌋ x y + ttf a _ [] fr = Level.lift tt + ttf a lt (cons a₁ y x1) (lift lt1 , x2 ) = (Level.lift (fromWitness (ttf1 lt1 lt ))) , ttf a₁ (ttf1 lt1 lt) y x1 where + ttf1 : True (a f<? a₁) → x f< a → x f< a₁ + ttf1 t x<a = f<-trans x<a (toWitness t) ... | inj₂ (case1 eq) = cons a y x₁ -... | inj₂ (case2 lt) = cons a (cons x y {!!}) {!!} +... | inj₂ (case2 lt) = cons a (cons x y (ttf2 a lt y x₁)) (Level.lift (fromWitness lt ) , x₁) where + ttf2 : (a : FL (suc n)) → a f< x → (y : FList {suc n}) → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a y → fresh (FL (suc n)) ⌊ _f<?_ ⌋ x y + ttf2 = {!!} -fr6 = FLcons ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) fr1 +fr6 = FLinsert ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) fr1