diff automaton-in-agda/src/bijection.agda @ 261:57fd08c16e25

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 06 Jul 2021 11:07:11 +0900
parents eddc2c1be16f
children cb13c38103b1
line wrap: on
line diff
--- a/automaton-in-agda/src/bijection.agda	Tue Jul 06 01:40:18 2021 +0900
+++ b/automaton-in-agda/src/bijection.agda	Tue Jul 06 11:07:11 2021 +0900
@@ -372,16 +372,50 @@
      lton x  = pred (lton1 x)
 
      lton1>0 : (x : List Bool ) → 0 < lton1 x 
-     lton1>0 x = {!!}
+     lton1>0 [] = a<sa
+     lton1>0 (true ∷ x₁) = 0<s
+     lton1>0 (false ∷ t) = ≤-trans (lton1>0 t) x≤x+y
+
+     2lton1>0 : (t : List Bool ) →  0 < lton1 t + lton1 t
+     2lton1>0 t = ≤-trans (lton1>0 t) x≤x+y
+
+     lton-cons>0 : {x : Bool} {y : List Bool } → 0 < lton (x ∷ y)
+     lton-cons>0 {true} {[]} = refl-≤s
+     lton-cons>0 {true} {x ∷ y} =  {!!}
+     lton-cons>0 {false} {[]} = refl-≤
+     lton-cons>0 {false} {x ∷ y} = {!!}
+
+     lb=0 : {x y : ℕ } → pred x  < pred y → suc (x + x ∸ 1) < suc (y + y ∸ 1)
+     lb=0 {0} {suc y} lt = s≤s (subst (λ k → 0 < k ) (+-comm (suc y) y ) 0<s)
+     lb=0 {suc x} {suc y} lt = begin
+            suc (suc ((suc x + suc x) ∸ 1)) ≡⟨ refl  ⟩
+            suc (suc x) + suc x ≡⟨ refl ⟩
+            suc (suc x + suc x) ≤⟨ <-plus (s≤s lt) ⟩
+            suc y + suc x <⟨ <-plus-0 {suc x} {suc y} {suc y} (s≤s lt) ⟩
+            suc y + suc y ≡⟨ refl ⟩
+            suc ((suc y + suc y) ∸ 1) ∎  where open ≤-Reasoning
+     lb=1 : {x y : List Bool} {z : Bool} → lton (z ∷ x) ≡ lton (z ∷ y) → lton x ≡ lton y 
+     lb=1 {x} {y} {true} eq = {!!}
+     lb=1 {x} {y} {false} eq with <-cmp (lton x) (lton y)
+     ... | tri< a ¬b ¬c = ⊥-elim (nat-≡< (cong suc eq) (lb=0 {lton1 x} {lton1 y} a))
+     ... | tri≈ ¬a b ¬c = b
+     ... | tri> ¬a ¬b c = ⊥-elim (nat-≡< (cong suc (sym eq)) (lb=0 {lton1 y} {lton1 x} c))
+
+     lb=b : (x y : List Bool) → lton x ≡ lton y → x ≡ y
+     lb=b [] [] eq = refl
+     lb=b [] (x ∷ y) eq = ⊥-elim ( nat-≡< eq (lton-cons>0 {x} {y} ))
+     lb=b (x ∷ y) [] eq = ⊥-elim ( nat-≡< (sym eq) (lton-cons>0 {x} {y} ))
+     lb=b (true ∷ x) (false ∷ y) eq = {!!}
+     lb=b (false ∷ x) (true ∷ y) eq = {!!}
+     lb=b (true ∷ x) (true ∷ y) eq = cong (λ k → true ∷ k ) (lb=b x y (lb=1 {x} {y} {true} eq)) 
+     lb=b (false ∷ x) (false ∷ y) eq = cong (λ k → false ∷ k ) (lb=b x y (lb=1 {x} {y} {false} eq)) 
 
      lb : (n : ℕ) → LB n lton
      lb zero = record { nlist = [] ; isBin = refl ; isUnique = lb05 } where
          lb05 : (x : List Bool) → lton x ≡ zero → [] ≡ x
-         lb05 [] refl = refl
-         lb05 (true ∷ t) eq = {!!}
-         lb05 (false ∷ t) eq = {!!}
+         lb05 x eq = lb=b [] x (sym eq)
      lb (suc n) with LB.nlist (lb n) | inspect LB.nlist (lb n) 
-     ... | [] | record { eq = eq } = record { nlist = false ∷ [] ; isUnique = {!!} ; isBin = begin
+     ... | [] | record { eq = eq } = record { nlist = false ∷ [] ; isUnique = lb06 ; isBin = begin
        lton (false ∷ []) ≡⟨ refl ⟩ 
        suc 0  ≡⟨ refl ⟩ 
        suc (lton [])   ≡⟨ cong (λ k → suc (lton k)) (sym eq) ⟩ 
@@ -396,17 +430,23 @@
         lb01 : lton (true ∷ t) ≡ suc n
         lb01 = begin
            lton (true ∷ t)  ≡⟨ refl ⟩ 
-           lton1 t + lton1 t   ≡⟨ sym ( sucprd {!!} ) ⟩ 
+           lton1 t + lton1 t   ≡⟨ sym ( sucprd (2lton1>0 t) ) ⟩ 
            suc (pred (lton1 t + lton1 t ))  ≡⟨ refl ⟩ 
            suc (lton (false ∷ t))   ≡⟨ cong (λ k → suc (lton k )) (sym eq) ⟩ 
            suc (lton (LB.nlist (lb n))) ≡⟨  cong suc (LB.isBin (lb n)) ⟩ 
            suc n ∎  where open ≡-Reasoning
-     ... | true ∷ t | record { eq = eq } = record { nlist =  lb+1 (true ∷ t) ; isBin = lb02 (true ∷ t) lb03 ; isUnique = {!!}  } where
+     ... | true ∷ t | record { eq = eq } = record { nlist =  lb+1 (true ∷ t) ; isBin = lb02 (true ∷ t) lb03 ; isUnique = lb07 } where
         lb03 : lton (true ∷ t) ≡ n
         lb03 = begin
            lton (true ∷ t)   ≡⟨ cong (λ k → lton k ) (sym eq ) ⟩ 
            lton (LB.nlist (lb n)) ≡⟨ LB.isBin (lb n) ⟩ 
            n ∎  where open ≡-Reasoning
+        -- eq : LB.nlist (lb n) ≡ true ∷ t ,  eq1 : pred (suc (lton1 t1 + lton1 t1)) ≡ suc n
+        lb07 : (x : List Bool) → pred (lton1 x ) ≡ suc n → lb+1 (true ∷ t) ≡ x
+        lb07 (true ∷ t1) eq1 = ⊥-elim (nat-≡< eq1  (begin
+           lton1 (true ∷ t1) ≤⟨ {!!} ⟩
+           suc n ∎ )) where open ≤-Reasoning  -- lton1 (true ∷ t) ∸ 1 ≡ n, lton1 t1 + lton1 t1 ≡ suc n
+        lb07 (false ∷ t1) eq1 = {!!}
 
         add11 : (x1 : ℕ ) → suc x1 + suc x1 ≡ suc (suc  (x1 + x1))
         add11 zero = refl
@@ -427,7 +467,7 @@
         lb02 t eq1 = begin
             lton (lb+1 t) ≡⟨ refl ⟩
             pred (lton1 (lb+1 t)) ≡⟨ cong pred (sym (lb04 t)) ⟩
-            pred (suc (lton1 t))  ≡⟨ sym (sucprd {!!} ) ⟩
+            pred (suc (lton1 t))  ≡⟨ sym (sucprd (lton1>0 t)) ⟩
             suc (pred (lton1 t)) ≡⟨ refl ⟩
             suc (lton t) ≡⟨ cong suc eq1  ⟩
             suc n ∎  where open ≡-Reasoning