changeset 329:ba0ae5de62d1

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 25 Jan 2022 09:11:01 +0900
parents cd73fe566291
children 407684f806e4
files automaton-in-agda/src/logic.agda automaton-in-agda/src/nat.agda automaton-in-agda/src/omega-automaton.agda
diffstat 3 files changed, 61 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/automaton-in-agda/src/logic.agda	Sun Jan 23 11:15:01 2022 +0900
+++ b/automaton-in-agda/src/logic.agda	Tue Jan 25 09:11:01 2022 +0900
@@ -43,6 +43,10 @@
 de-morgan {n} {A} {B} and (case1 ¬A) = ⊥-elim ( ¬A ( _∧_.proj1 and ))
 de-morgan {n} {A} {B} and (case2 ¬B) = ⊥-elim ( ¬B ( _∧_.proj2 and ))
 
+de-morgan∨ : {n  : Level } {A B : Set n} →  A ∨ B  → ¬ ( (¬ A ) ∧ (¬ B ) )
+de-morgan∨ {n} {A} {B} (case1 a) and = ⊥-elim (  _∧_.proj1 and a )
+de-morgan∨ {n} {A} {B} (case2 b) and = ⊥-elim (  _∧_.proj2 and b )
+
 dont-or : {n m : Level} {A  : Set n} { B : Set m } →  A ∨ B → ¬ A → B
 dont-or {A} {B} (case1 a) ¬A = ⊥-elim ( ¬A a )
 dont-or {A} {B} (case2 b) ¬A = b
--- a/automaton-in-agda/src/nat.agda	Sun Jan 23 11:15:01 2022 +0900
+++ b/automaton-in-agda/src/nat.agda	Tue Jan 25 09:11:01 2022 +0900
@@ -155,6 +155,13 @@
 x≤y+x : {z y : ℕ } → z ≤ y + z
 x≤y+x {z} {y} = subst (λ k → z ≤ k ) (+-comm _ y ) x≤x+y
 
+x≤x+sy : {x y : ℕ} → x < x + suc y
+x≤x+sy {x} {y} = begin
+        suc x ≤⟨ x≤x+y ⟩
+        suc x + y ≡⟨ cong (λ k → k + y) (+-comm 1 x ) ⟩
+        (x + 1) + y ≡⟨ (+-assoc x 1 _) ⟩
+        x + suc y ∎  where open ≤-Reasoning
+
 <-plus : {x y z : ℕ } → x < y → x + z < y + z 
 <-plus {zero} {suc y} {z} (s≤s z≤n) = s≤s (subst (λ k → z ≤ k ) (+-comm z _ ) x≤x+y  )
 <-plus {suc x} {suc y} {z} (s≤s lt) = s≤s (<-plus {x} {y} {z} lt)
--- a/automaton-in-agda/src/omega-automaton.agda	Sun Jan 23 11:15:01 2022 +0900
+++ b/automaton-in-agda/src/omega-automaton.agda	Tue Jan 25 09:11:01 2022 +0900
@@ -16,7 +16,7 @@
 
 ω-run : { Q  Σ : Set } → (Ω : Automaton Q Σ ) → Q →  ( ℕ → Σ )  → ( ℕ → Q )
 ω-run Ω x s zero = x
-ω-run Ω x  s (suc n) = δ Ω (ω-run Ω x s n) ( s n )
+ω-run Ω x s (suc n) = δ Ω (ω-run Ω x s n) ( s n )
 
 --
 -- accept as Buchi automaton
@@ -56,41 +56,59 @@
 open import nat
 open import Data.Nat.Properties
 
-LEMB : { Q  Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) → Q → Buchi Ω S ∨ (¬ ( Buchi Ω S ))
-LEMB = {!!}
+-- LEMB : { Q  Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) → Q → Buchi Ω S ∨ (¬ ( Buchi Ω S ))
+-- LEMB Ω S Q = {!!}  -- S need not to be constructive, so we have no constructive LEM
+
+-- LEMM : { Q  Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) → Q → Muller Ω S ∨ (¬ ( Muller Ω S ))
+-- LEMM = {!!}
 
-LEMM : { Q  Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) → Q → Muller Ω S ∨ (¬ ( Muller Ω S ))
-LEMM = {!!}
+ω-run-eq : { Q  Σ : Set } → (Ω Ω' : Automaton Q Σ ) → (q : Q) →  ( S : ℕ → Σ )  → (x : ℕ)
+    → δ Ω ≡ δ Ω'
+    → ω-run Ω q S x ≡ ω-run Ω' q S x
+ω-run-eq Ω  Ω' q s zero refl =  refl
+ω-run-eq Ω  Ω' q s (suc n) eq = begin
+     ω-run Ω q s (suc n) ≡⟨⟩
+     δ Ω (ω-run Ω q s n) (s n) ≡⟨ cong₂ (λ j k → j k (s n) ) eq (ω-run-eq Ω  Ω' q s n eq) ⟩
+     δ Ω' (ω-run Ω' q s n) (s n) ≡⟨⟩
+     ω-run Ω' q s (suc n) ∎  where open ≡-Reasoning
 
 B→M : { Q  Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) → Q → Buchi Ω S → ¬ ( Muller record { δ = δ Ω ; aend = λ q → not (aend Ω q)} S )
-B→M {Q} {Σ} Ω S q b m = ¬t=f (aend Ω ( ω-run Ω bm00 S (from b + suc ( next m (from b ) ))))  {!!} where
-   bm00 : Q
-   bm00 = ω-run Ω q S (from b + suc (Muller.next m (from b)))
-   bm02 :  aend Ω (ω-run Ω bm00 S (from b + suc (next m (from b) ))) ≡ true
-   bm02 = stay b bm00 (from b + suc (next m (from b) )) {!!}
-   Ω' : Automaton Q Σ
-   Ω' = record { δ = δ Ω ; aend = λ q → not (aend Ω q) }
-   bm03 : aend  Ω' (ω-run  Ω' bm00 S (from b + suc (next m (from b) ))) ≡ true
-   bm03 = infinite m bm00  (from b)
-   bm05 : (q : Q) → (n : ℕ) → ω-run  Ω' q S n ≡ ω-run  Ω q S n
-   bm05 q zero = refl
-   bm05 q (suc n) = begin
-    ω-run  Ω' q S (suc n) ≡⟨⟩
-    δ Ω (ω-run Ω' q S n) (S n) ≡⟨ cong (λ k → δ Ω  k (S n) ) (bm05 q n) ⟩
-    δ Ω (ω-run Ω q S n) (S n) ≡⟨⟩
-    ω-run Ω q S (suc n) ∎ where open ≡-Reasoning
-   bm04 : (q : Q) → (n : ℕ) → aend  Ω' (ω-run  Ω' q S n) ≡ not aend  Ω (ω-run  Ω q S n) 
-   bm04 q zero = refl
-   bm04 q (suc n) = begin
-     aend Ω' (ω-run Ω' q S (suc n)) ≡⟨⟩
-     not aend Ω (δ Ω (ω-run Ω' q S n) (S n)) ≡⟨ cong (λ k → not aend Ω ( δ Ω k (S n))) (bm05 q n) ⟩
-     not aend Ω (δ Ω (ω-run Ω q S n) (S n)) ≡⟨⟩
-     not aend Ω (ω-run Ω q S (suc n)) ∎ where open ≡-Reasoning
-   bm01 :  (not aend Ω (ω-run Ω bm00 S (Muller.next m (from b) + from b))) ≡ aend Ω (ω-run Ω bm00 S (Muller.next m (from b) + from b))
-   bm01 = {!!}
+B→M {Q} {Σ} Ω S q b m = ¬-bool bm04 bm02 where
+   q1 : Q
+   q1 = ω-run Ω q S (from b + suc (next m (from b)))
+   bm02 : aend Ω q1 ≡ true
+   bm02 = stay b q (from b + suc (next m (from b) )) x≤x+sy 
+   Ω' : Automaton  Q Σ
+   Ω' = record {  δ = δ Ω ; aend = λ q → not (aend Ω q) }
+   bm03 : aend Ω' (ω-run Ω' q S (from b + (suc (next m (from b))))) ≡ true
+   bm03 = infinite m q (from b)
+   bm04 : aend Ω q1 ≡ false
+   bm04 = begin
+     aend Ω (ω-run Ω q S (from b + suc (next m (from b)))) ≡⟨ sym not-not-bool ⟩
+     not (not (aend Ω (ω-run Ω q S (from b + suc (next m (from b)))))) ≡⟨ cong (λ k → not (not (aend  Ω k))) (ω-run-eq Ω Ω' q S (from b + suc (next m (from b))) refl) ⟩
+     not (not (aend Ω (ω-run Ω' q S (from b + suc (next m (from b)))))) ≡⟨⟩
+     not (aend Ω' (ω-run Ω' q S (from b + (suc (next m (from b)))))) ≡⟨ cong (λ k → not k ) bm03  ⟩
+     false ∎  where open ≡-Reasoning
+
 
-M→B : { Q  Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) → Muller Ω S → ¬ ( Buchi record { δ = δ Ω ; aend = λ q → not (aend Ω q)} S )
-M→B = {!!}
+M→B : { Q  Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) → Q → Muller Ω S → ¬ ( Buchi record { δ = δ Ω ; aend = λ q → not (aend Ω q)} S )
+M→B {Q} {Σ} Ω S q m b = ¬-bool bm04 bm02 where
+   q1 : Q
+   q1 = ω-run Ω q S (from b + suc (next m (from b)))
+   bm02 : aend Ω q1 ≡ true
+   bm02 = infinite m q (from b)
+   Ω' : Automaton  Q Σ
+   Ω' = record {  δ = δ Ω ; aend = λ q → not (aend Ω q) }
+   bm03 : aend Ω' (ω-run Ω' q S (from b + (suc (next m (from b))))) ≡ true
+   bm03 = stay b q (from b + suc (next m (from b) )) x≤x+sy 
+   bm04 : aend Ω q1 ≡ false
+   bm04 = begin
+     aend Ω (ω-run Ω q S (from b + suc (next m (from b)))) ≡⟨ sym not-not-bool ⟩
+     not (not (aend Ω (ω-run Ω q S (from b + suc (next m (from b)))))) ≡⟨ cong (λ k → not (not (aend  Ω k))) (ω-run-eq Ω Ω' q S (from b + suc (next m (from b))) refl) ⟩
+     not (not (aend Ω (ω-run Ω' q S (from b + suc (next m (from b)))))) ≡⟨⟩
+     not (aend Ω' (ω-run Ω' q S (from b + (suc (next m (from b)))))) ≡⟨ cong (λ k → not k ) bm03 ⟩
+     false ∎  where open ≡-Reasoning
+
 
 
 data  States3   : Set  where