changeset 148:1db02863ec58

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 13 Sep 2020 03:38:17 +0900
parents 91a858f0b78f
children c5ed0175ecb9
files FL.agda
diffstat 1 files changed, 15 insertions(+), 53 deletions(-) [+]
line wrap: on
line diff
--- a/FL.agda	Sat Sep 12 22:18:30 2020 +0900
+++ b/FL.agda	Sun Sep 13 03:38:17 2020 +0900
@@ -99,33 +99,9 @@
 ... | case2 x = case2 (subst (λ k →  (zero :: FL0) f< (k :: fmax)) b (f<t x)  )
 
 open import Relation.Binary as B hiding (Decidable; _⇔_)
-
--- f≤-isDecTotalOrder : ∀ {n} → IsDecTotalOrder _≡_ (_f≤_ {n})
--- f≤-isDecTotalOrder = record { isTotalOrder = record { isPartialOrder = record { isPreorder = {!!}
---         ; antisym = {!!}
---         }
---      ; total = {!!}
---      }
---   ; _≟_          = {!!}
---   ; _≤?_         = {!!}
---   }
-
 open import Data.Sum.Base as Sum --  inj₁
-
-total : {n : ℕ } → Total (_f≤_ {n})
-total f0 f0 = inj₁  (case1 refl) 
-total (x :: xt) (y :: yt) with <-fcmp x y
-... | tri< a ¬b ¬c = inj₁ (case2 (f<n a))
-... | tri> ¬a ¬b c = inj₂ (case2 (f<n c))
-... | tri≈ ¬a b ¬c with FLcmp xt yt
-... | tri< a ¬b ¬c₁ = inj₁ (case2 (subst (λ k → (x :: xt ) f< (k :: yt) ) b (f<t a)))
-... | 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 (⌊_⌋)
 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)
 
 FList : {n : ℕ } → Set
 FList {n} = List# (FL n) ⌊ _f<?_ ⌋
@@ -140,17 +116,10 @@
    []
 
 open import Data.Product
--- open import Data.Maybe
--- open TotalOrder
-
 open import Relation.Nullary.Decidable hiding (⌊_⌋)
 open import Data.Bool -- hiding (T)
 open import Data.Unit.Base using (⊤ ; tt)
 
--- T : Data.Bool.Bool → Set
--- T true  = ⊤
--- T false = ⊥
-
 --  fresh a []        = ⊤
 --  fresh a (x ∷# xs) = R a x × fresh a xs
 
@@ -167,33 +136,26 @@
        ttf1 t x<a = f<-trans x<a (toWitness t)
 
 FLinsert : {n : ℕ } → FL n → FList {n}  → FList {n} 
+FLfresh : {n : ℕ } → (a x : FL (suc n) ) → (y : FList {suc n} ) → a f< x
+     → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a y → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a (FLinsert x y)
 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₁
-FLinsert {suc n} x (cons a y x₁) | inj₁ (case2 lt) = cons x ( cons a y x₁) ( Level.lift (fromWitness lt ) , ttf lt y  x₁) 
-... | inj₂ (case1 eq) = cons a y x₁
-FLinsert {suc n} x (cons a [] x₁) | inj₂ (case2 lt) with FLinsert x [] | inspect ( FLinsert x ) []
+FLinsert {suc n} x (cons a y x₁) with FLcmp x a
+... | tri≈ ¬a b ¬c  = cons a y x₁
+... | tri< lt ¬b ¬c  = cons x ( cons a y x₁) ( Level.lift (fromWitness lt ) , ttf lt y  x₁) 
+FLinsert {suc n} x (cons a [] x₁) | tri> ¬a ¬b lt with FLinsert x [] | inspect ( FLinsert x ) []
 ... | [] | ()
 ... | cons a₁ t x₂ | e = cons a ( x  ∷# []  ) ( Level.lift (fromWitness lt) , Level.lift tt )
-FLinsert {suc n} x (cons a (cons a₁ y x₂) (lift a<a₁ , fr-ay)) | inj₂ (case2 a<x) with total x a₁
-... | inj₁ (case1 refl) =  cons a (cons a₁ y x₂) (Level.lift a<a₁ , fr-ay)
-... | inj₂ (case1 refl) =  cons a (cons a₁ y x₂) (Level.lift a<a₁ , fr-ay)
-... | inj₁ (case2 x<a₁) =  cons a (cons x  (cons a₁ y x₂) ( Level.lift (fromWitness x<a₁) , ttf x<a₁ y x₂))
-                   (  Level.lift (fromWitness a<x) , ttf a<x (cons  a₁ y x₂) ( Level.lift (fromWitness x<a₁) , ttf x<a₁ y x₂))
-... | inj₂ (case2 a₁<x) with FLinsert x y
-... | [] = []
-... | cons a₂ t x₁ = cons a ( cons a₁ ( cons a₂ t x₁ ) ( Level.lift (fromWitness ttf0) , ttf ttf0 t x₁))
-               ( Level.lift a<a₁ ,  Level.lift (fromWitness ttf1) , ttf ttf1 t x₁ ) where
-    ttf0 : a₁ f< a₂
-    ttf0 = ?
-    ttf1 : a  f< a₂
-    ttf1 = f<-trans (toWitness a<a₁) ttf0 
+FLinsert {suc n} x (cons a y yr) |  tri> ¬a ¬b a<x =
+        cons a (FLinsert x y) (FLfresh a x y a<x yr )
 
-
--- a₁<x  : a₁ f< x
--- a<x   : a f< x
--- a<a₁  : T (isYes (a f<? a₁ | FLcmp a a₁))
+FLfresh {n} a x [] a<x (Level.lift tt) = Level.lift (fromWitness a<x) , Level.lift tt
+FLfresh {n} a x (cons b y br) a<x (lift a<b , a<y) with FLinsert x (cons b y br)
+... | [] = Level.lift tt
+... | cons i t ir with FLcmp i x
+... | tri< i<x ¬b ¬c = {!!} , {!!}
+... | tri≈ ¬a refl ¬c =  Level.lift (fromWitness a<x) , ttf a<x t ir 
+... | tri> ¬a ¬b x<i =  Level.lift (fromWitness  (f<-trans a<x x<i)) , ttf (f<-trans a<x x<i) t ir
 
 
 fr6 = FLinsert ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) fr1