Mercurial > hg > Members > kono > Proof > automaton
changeset 141:b3f05cd08d24
clean up
line wrap: on
line diff
--- a/a02/agda-install.ind Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/agda-install.ind Sun Dec 27 13:26:44 2020 +0900 @@ -17,11 +17,11 @@ install 先がどこかは、 - /usr/local/Cellar/agda/2.5.2/lib/agda + /usr/local/Cellar/agda/2.6.1/lib/agda などになるので、 -~/.agda に以下のファイルを置きます +brew install の指示通りに ~/.agda に以下のファイルを置きます defaults libraries @@ -32,6 +32,21 @@ libraries の中には /usr/local/Cellar/agda/2.5.2/lib/agda/standard-library.agda-lib +--VS-code + +plugin から agda-mode を探して install + +test.agda を作って + + module test where + open import Data.Nat + a : ? + a = 1 + +として C-C C-L が通れば Ok + +--Emacs + ~/.emacs.d/init.el に以下のファイルを置きます。あるいは自分のinit.el に適当に追加します。 中のpathは正しいものに置き換えます。 @@ -61,8 +76,3 @@ が使えます。 ---VS-code - -<a href="https://github.com/freebroccolo/vscode-agda"> vscode </a> - -があるみたい。試してません。
--- a/a02/agda/dag.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/agda/dag.agda Sun Dec 27 13:26:44 2020 +0900 @@ -39,22 +39,22 @@ true : Bool false : Bool -data connected { V : Set } ( E : V -> V -> Set ) ( x y : V ) : Set where - direct : E x y -> connected E x y - indirect : { z : V } -> E x z -> connected {V} E z y -> connected E x y +data connected { V : Set } ( E : V → V → Set ) ( x y : V ) : Set where + direct : E x y → connected E x y + indirect : { z : V } → E x z → connected {V} E z y → connected E x y lemma1 : connected TwoArrow t0 t1 -lemma1 = ? +lemma1 = {!!} lemma2 : ¬ ( connected TwoArrow t1 t0 ) -lemma2 x = ? +lemma2 = {!!} -- lemma2 (direct ()) -- lemma2 (indirect () (direct _)) -- lemma2 (indirect () (indirect _ _ )) lemma3 : connected Circle t0 t0 -lemma3 = indirect r0 ( direct r1 ) +lemma3 = {!!} data Dec (P : Set) : Set where yes : P → Dec P @@ -67,9 +67,9 @@ dag {V} E = ∀ (n : V) → ¬ ( connected E n n ) lemma4 : dag TwoArrow -lemma4 x = ? +lemma4 = {!!} lemma5 : ¬ ( dag Circle ) -lemma5 x = ⊥-elim ? +lemma5 x = ⊥-elim {!!}
--- a/a02/agda/equality.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/agda/equality.agda Sun Dec 27 13:26:44 2020 +0900 @@ -19,8 +19,8 @@ subst : {A : Set } → { x y : A } → ( f : A → Set ) → x == y → f x → f y subst {A} {x} {y} f refl fx = fx -ex5 : {A : Set} {x y z : A } → x == y → y == z → x == z -ex5 {A} {x} {y} {z} x==y y==z = subst {!!} {!!} {!!} +-- ex5 : {A : Set} {x y z : A } → x == y → y == z → x == z +-- ex5 {A} {x} {y} {z} x==y y==z = subst (λ refl → {!!} ) x==y {!!}
--- a/a02/agda/lambda.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/agda/lambda.agda Sun Dec 27 13:26:44 2020 +0900 @@ -22,23 +22,26 @@ ex2 : {A : Set} → Set ex2 {A} = A → ( A → A ) -ex3 : {A B : Set} → Set -ex3 {A}{B} = A → B +proof2 : {A : Set } → ex2 {A} +proof2 = {!!} -ex4 : {A B : Set} → Set -ex4 {A}{B} = A → B → B +ex3 : {A B : Set} → A → B +ex3 a = {!!} -ex5 : {A B : Set} → Set -ex5 {A}{B} = A → B → A +ex4 : {A B : Set} → A → B → B +ex4 {A}{B} a b = {!!} -proof5 : {A B : Set } → ex5 {A} {B} -proof5 = {!!} +ex5 : {A B : Set} → A → B → A +ex5 = {!!} -postulate S : Set -postulate s : S -ex6 : {A : Set} → A → S +postulate + Domain : Set + Range : Set + r : Range + +ex6 : Domain → Range ex6 a = {!!} ex7 : {A : Set} → A → T @@ -56,6 +59,4 @@ ex14 : {A B : Set} → ( A → B ) → A → B ex14 x = {!!} -proof5' : {A B : Set} → ex5 {A} {B} -proof5' = {!!}
--- a/a02/agda/logic.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/agda/logic.agda Sun Dec 27 13:26:44 2020 +0900 @@ -2,7 +2,7 @@ open import Level open import Relation.Nullary -open import Relation.Binary +open import Relation.Binary hiding (_⇔_) open import Data.Empty
--- a/a02/agda/practice-logic.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/agda/practice-logic.agda Sun Dec 27 13:26:44 2020 +0900 @@ -7,7 +7,7 @@ postulate b : B lemma0 : A -> B -lemma0 a = b +lemma0 a = {!!} id : { A : Set } → ( A → A ) id = {!!} @@ -27,7 +27,7 @@ -- lemma1 a a-b = a-b a -lemma2 : Lemma1 +lemma2 : Lemma1 -- π lemma2 = \a b -> {!!} -- lemma1 = \a a-b -> a-b a @@ -38,9 +38,10 @@ lemma3 = \a -> ( \b -> {!!} ) record _∧_ (A B : Set) : Set where + constructor _,_ field - and1 : A - and2 : B + π1 : A + π2 : B data _∧d_ ( A B : Set ) : Set where and : A -> B -> A ∧d B @@ -57,8 +58,8 @@ lemma5 = \a -> {!!} data _∨_ (A B : Set) : Set where - or1 : A -> A ∨ B - or2 : B -> A ∨ B + case1 : A -> A ∨ B + case2 : B -> A ∨ B Lemma6 : Set Lemma6 = B -> ( A ∨ B ) @@ -78,7 +79,7 @@ ex3 a b = {!!} ex4 : {A : Set} → A → ( A ∧ A ) -ex4 a = record { and1 = {!!} ; and2 = {!!} } +ex4 a = record { π1 = {!!} ; π2 = {!!} } ex5 : {A B C : Set} → ( A ∧ B ) ∧ C → A ∧ (B ∧ C) ex5 a∧b∧c = {!!} @@ -87,7 +88,8 @@ ex6 p a = {!!} ex7 : {A : Set} → ( A ∨ A ) → A -ex7 = {!!} +ex7 (case1 a) = a +ex7 (case2 a) = a ex8 : {A B : Set} → B → ( A ∨ ( B → A ) ) → A ex8 = {!!} @@ -99,9 +101,23 @@ contra-position : {A : Set } {B : Set } → (A → B) → ¬ B → ¬ A contra-position {A} {B} f ¬b a = {!!} -double-neg : {A : Set } → A → ¬ ¬ A -double-neg x y = y x +contra-position' : {A : Set } {B : Set } → (A → B) → (B → ⊥) → A → ⊥ +contra-position' f ¬b a = {!!} + +contra-position1 : {A : Set } {B : Set } → (B ∨ ( ¬ B )) → (¬ B → ¬ A )→ (A → B) +contra-position1 {A} {B} = {!!} + +double-neg : {A : Set } → A → ¬ (¬ A) +double-neg = {!!} +double-neg' : {A : Set } → A → ( A → ⊥ ) → ⊥ +double-neg' = {!!} + +double-neg1 : {A : Set } → ¬ (¬ A) → A +double-neg1 x = {!!} + +lem : {A : Set } → A ∨ ( ¬ A ) -- 排中律 law of exclude middle LEM +lem = {!!} lemma : {A : Set } → A ∨ ( ¬ A ) → ¬ ¬ A → A lemma = {!!} @@ -109,10 +125,10 @@ double-neg2 : {A : Set } → ¬ ¬ ¬ A → ¬ A double-neg2 = {!!} -de-morgan : {A B : Set } → A ∧ B → ¬ ( (¬ A ) ∨ (¬ B ) ) -de-morgan {A} {B} = {!!} +de-mcasegan : {A B : Set } → A ∧ B → ¬ ( (¬ A ) ∨ (¬ B ) ) +de-mcasegan {A} {B} = {!!} -dont-or : {A : Set } { B : Set } → A ∨ B → ¬ A → B -dont-or {A} {B} = {!!} +dont-case : {A : Set } { B : Set } → A ∨ B → ¬ A → B +dont-case {A} {B} = {!!}
--- a/a02/agda/practice-nat.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/agda/practice-nat.agda Sun Dec 27 13:26:44 2020 +0900 @@ -3,12 +3,12 @@ open import Data.Nat open import Data.Empty open import Relation.Nullary -open import Relation.Binary.PropositionalEquality +open import Relation.Binary.PropositionalEquality hiding (_⇔_) open import logic -- hint : it has two inputs, use recursion nat-<> : { x y : ℕ } → x < y → y < x → ⊥ -nat-<> = {!!} +nat-<> = {!!} -- hint : use recursion nat-<≡ : { x : ℕ } → x < x → ⊥ @@ -42,10 +42,20 @@ max = {!!} sum : (x y : ℕ) → ℕ -sum = {!!} +sum zero y = y +sum (suc x) y = suc ( sum x y ) + +sum' : (x y : ℕ) → ℕ +sum' x zero = x +sum' x (suc y) = suc (sum' x y) + +sum-sym0 : {x y : ℕ} → sum x y ≡ sum' y x +sum-sym0 {zero} {zero} = refl +sum-sym0 {suc x} {y} = cong (λ k → suc k ) (sum-sym0 {x} {y}) +sum-sym0 {zero} {y} = refl sum-6 : sum 3 4 ≡ 7 -sum-6 = {!!} +sum-6 = refl sum1 : (x y : ℕ) → sum x (suc y) ≡ suc (sum x y ) sum1 x y = let open ≡-Reasoning in @@ -55,6 +65,9 @@ suc (sum x y ) ∎ +sum0 : (x : ℕ) → sum 0 x ≡ x +sum0 zero = refl +sum0 (suc x) = refl sum-sym : (x y : ℕ) → sum x y ≡ sum y x sum-sym = {!!} @@ -63,7 +76,25 @@ sum-assoc = {!!} mul : (x y : ℕ) → ℕ -mul = {!!} +mul x zero = zero +mul x (suc y) = sum x ( mul x y ) + +mulr : (x y : ℕ) → ℕ +mulr zero y = zero +mulr (suc x) y = sum y ( mulr x y ) + +mul-sym1 : {x y : ℕ } → mul x y ≡ mulr y x +mul-sym1 {zero} {zero} = refl +mul-sym1 {zero} {suc y} = begin + mul zero (suc y) + ≡⟨⟩ + sum 0 (mul 0 y) + ≡⟨ cong (λ k → sum 0 k ) {!!} ⟩ + sum 0 (mulr y 0) + ≡⟨⟩ + mulr (suc y) zero + ∎ where open ≡-Reasoning +mul-sym1 {suc x} {y} = {!!} mul-9 : mul 3 4 ≡ 12 mul-9 = {!!} @@ -83,4 +114,5 @@ mul-assoc : (x y z : ℕ) → mul x (mul y z ) ≡ mul (mul x y) z mul-assoc = {!!} - +evenp : (x : ℕ) → Bool +evenp = {!!}
--- a/a02/lecture.ind Sat Mar 14 19:42:27 2020 +0900 +++ b/a02/lecture.ind Sun Dec 27 13:26:44 2020 +0900 @@ -281,17 +281,17 @@ A B : : A ∨ B C C A B - ------------------------ ----------- p1 ---------- p2 + ------------------------ ----------- case1 ---------- case2 C A ∨ B A ∨ B data _∨_ (A B : Set) : Set where - p1 : A → A ∨ B - p2 : B → A ∨ B + case1 : A → A ∨ B + case2 : B → A ∨ B dataはCで言えばcase文とunion に相当する。Scala のCase Classもこれである。Cと違いunionにはどの型が入っているかを区別するtagが付いている。 -p1 と p2 は A ∨ B を構成する constructor (推論ではintroduction)であり、case 文が eliminator に相当する。 +case1 と case2 は A ∨ B を構成する constructor (推論ではintroduction)であり、case 文が eliminator に相当する。 Haskellと同様にp1/p2はパターンマッチで場合分けする。 @@ -301,8 +301,8 @@ 場合分けには、? の部分にcursolを合わせて C-C C-C すると場合分けを生成してくれる。 ex3 : {A B : Set} → ( A ∨ A ) → A - ex3 (p1 x) = ? - ex3 (p2 x) = ? + ex3 (case1 x) = ? + ex3 (case2 x) = ? ---問題2.3 Agdaのdata
--- a/a02/unificagtion.ind Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,27 +0,0 @@ --title: unification - -Unification (単一化) は、二つの項が同じになる可能性があるかどうかを調べる。 - -これは、引数に data 型がある時にも起きる。 - -可能性がなければ失敗する。 - ----Term - -Term は以下の規則によって型と一緒に構築される。 - -1. Haskell の変数 x,y,z は項。つまり let a = ... で宣言された小文字で始まる記号。対応する型(変数で指定された)を持つ。 - 1 や 'a' も対応する型を持つ項である。 - -2. u が型U、v が型V を持てば、(u,v) は型(U,V)を持つ項である。 - -3. 型(U,V)を持つ項 t に対して、fst t は型U を持つ項、snd t は型 V を持つ項である。 - -4. v が型V を持つ項で、x0,x1,...,xn が型Uを持てば、 \x0 x1 ..., xn -> v は項である。 - Haskell によって変数の名前のスコープは適切に扱われるとする。 - -5. t が型 U->V を持ち、u が 型U を持てば、 t u は型V を持つ項である。 - ---単一化 - -
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/a02/unification.ind Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,27 @@ +-title: unification + +Unification (単一化) は、二つの項が同じになる可能性があるかどうかを調べる。 + +これは、引数に data 型がある時にも起きる。 + +可能性がなければ失敗する。 + +---Term + +Term は以下の規則によって型と一緒に構築される。 + +1. Haskell の変数 x,y,z は項。つまり let a = ... で宣言された小文字で始まる記号。対応する型(変数で指定された)を持つ。 + 1 や 'a' も対応する型を持つ項である。 + +2. u が型U、v が型V を持てば、(u,v) は型(U,V)を持つ項である。 + +3. 型(U,V)を持つ項 t に対して、fst t は型U を持つ項、snd t は型 V を持つ項である。 + +4. v が型V を持つ項で、x0,x1,...,xn が型Uを持てば、 \x0 x1 ..., xn -> v は項である。 + Haskell によって変数の名前のスコープは適切に扱われるとする。 + +5. t が型 U->V を持ち、u が 型U を持てば、 t u は型V を持つ項である。 + +--単一化 + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/a04/fig/concat.svg Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,251 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> +<svg version="1.1" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" viewBox="96 65 681 696" width="681" height="696"> + <defs> + <font-face font-family="Helvetica Neue" font-size="16" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <font-face font-family="Helvetica Neue" font-size="32" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <font-face font-family="Helvetica Neue" font-size="26" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + </defs> + <metadata> Produced by OmniGraffle 7.18\n2020-12-09 05:54:46 +0000</metadata> + <g id="Canvas_1" stroke="none" fill-opacity="1" fill="none" stroke-dasharray="none" stroke-opacity="1"> + <title>Canvas 1</title> + <rect fill="white" x="96" y="65" width="681" height="696"/> + <g id="Canvas_1_Layer_1"> + <title>Layer 1</title> + <g id="Graphic_3"> + <rect x="103" y="110" width="44" height="40" fill="white"/> + <rect x="103" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(108 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="12.704" y="15">a</tspan> + </text> + </g> + <g id="Graphic_4"> + <rect x="163" y="110" width="44" height="40" fill="white"/> + <rect x="163" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(168 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="12.256" y="15">b</tspan> + </text> + </g> + <g id="Graphic_5"> + <rect x="223" y="110" width="44" height="40" fill="white"/> + <rect x="223" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(228 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="12.704" y="15">c</tspan> + </text> + </g> + <g id="Graphic_6"> + <rect x="283" y="110" width="44" height="40" fill="white"/> + <rect x="283" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(288 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="14.632" y="15">f</tspan> + </text> + </g> + <g id="Graphic_7"> + <rect x="343" y="110" width="44" height="40" fill="white"/> + <rect x="343" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(348 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="12.256" y="15">b</tspan> + </text> + </g> + <g id="Graphic_8"> + <rect x="403" y="110" width="44" height="40" fill="white"/> + <rect x="403" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(408 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="14.632" y="15">f</tspan> + </text> + </g> + <g id="Graphic_9"> + <rect x="463" y="110" width="44" height="40" fill="white"/> + <rect x="463" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(468 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="14.632" y="15">f</tspan> + </text> + </g> + <g id="Graphic_10"> + <rect x="523" y="110" width="44" height="40" fill="white"/> + <rect x="523" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(528 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="12.256" y="15">b</tspan> + </text> + </g> + <g id="Graphic_11"> + <rect x="583" y="110" width="44" height="40" fill="white"/> + <rect x="583" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(588 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="12.704" y="15">c</tspan> + </text> + </g> + <g id="Graphic_12"> + <rect x="643" y="110" width="44" height="40" fill="white"/> + <rect x="643" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(648 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="12.256" y="15">d</tspan> + </text> + </g> + <g id="Graphic_13"> + <rect x="703" y="110" width="44" height="40" fill="white"/> + <rect x="703" y="110" width="44" height="40" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(708 120.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="14.632" y="15">f</tspan> + </text> + </g> + <g id="Graphic_14"> + <text transform="translate(197 211.5122)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="4.804" y="30">(a.*f)</tspan> + </text> + </g> + <g id="Graphic_15"> + <text transform="translate(579 211.5122)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="3.908" y="30">(b.*f)</tspan> + </text> + </g> + <g id="Line_16"> + <line x1="103" y1="180" x2="507" y2="180" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_17"> + <line x1="518" y1="180" x2="753" y2="180" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_18"> + <line x1="97" y1="495.1482" x2="321" y2="495.1482" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_19"> + <line x1="343" y1="495.1482" x2="747" y2="495.1482" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_20"> + <text transform="translate(104.816 297.9602)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">a0</tspan> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x=".304" y="67.896">ae</tspan> + </text> + </g> + <g id="Graphic_21"> + <text transform="translate(233.28 297.9602)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="14210855e-21" y="30">b1</tspan> + </text> + </g> + <g id="Graphic_22"> + <text transform="translate(350.384 283.5122)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">…</tspan> + </text> + </g> + <g id="Graphic_23"> + <text transform="translate(721.816 297.9602)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">be</tspan> + </text> + </g> + <g id="Line_25"> + <line x1="97" y1="278.5122" x2="147" y2="278.5122" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_24"> + <line x1="163" y1="278.5122" x2="747" y2="278.5122" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_31"> + <text transform="translate(109.82 402.2102)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">a0 a1</tspan> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="44.48" y="67.896"> ae</tspan> + </text> + </g> + <g id="Graphic_30"> + <text transform="translate(231.588 402.2102)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="14210855e-21" y="30">b0</tspan> + </text> + </g> + <g id="Graphic_29"> + <text transform="translate(350.384 384.4082)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">…</tspan> + </text> + </g> + <g id="Graphic_28"> + <text transform="translate(729 402.2102)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">be</tspan> + </text> + </g> + <g id="Line_27"> + <path d="M 97 379.4082 L 211.46 379.4082 L 193.06 379.4082" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_26"> + <line x1="226.588" y1="379.4082" x2="747" y2="379.4082" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_32"> + <text transform="translate(168 297.9602)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="14210855e-21" y="30">b0</tspan> + </text> + </g> + <g id="Graphic_37"> + <text transform="translate(666 610.4082)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="14210855e-21" y="30">b0</tspan> + </text> + </g> + <g id="Graphic_36"> + <text transform="translate(352.896 606.4602)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">…</tspan> + </text> + </g> + <g id="Graphic_35"> + <text transform="translate(729 610.4082)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">be</tspan> + </text> + </g> + <g id="Line_34"> + <line x1="666.916" y1="601.4602" x2="762.976" y2="601.4602" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_33"> + <line x1="97" y1="601.4602" x2="641.056" y2="601.4602" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_39"> + <text transform="translate(610.2 610.4082)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">ae</tspan> + </text> + </g> + <g id="Graphic_40"> + <text transform="translate(499.923 681.6162)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="26" font-weight="400" fill="black" x="0" y="25">success at one of them</tspan> + </text> + </g> + <g id="Line_41"> + <line x1="334.5" y1="132.51221" x2="334.5" y2="760.3286" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_42"> + <text transform="translate(108 610.4082)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">a0 a1</tspan> + </text> + </g> + <g id="Graphic_56"> + <text transform="translate(108.584 510.4082)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="3836931e-19" y="30">a0 a1 a2 a3</tspan> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="167.808" y="67.896"> ae</tspan> + </text> + </g> + <g id="Graphic_55"/> + <g id="Graphic_54"> + <text transform="translate(423 491.4082)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">…</tspan> + </text> + </g> + <g id="Graphic_53"> + <text transform="translate(729 509.2102)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="0" y="30">be</tspan> + </text> + </g> + <g id="Line_50"> + <path d="M 335.692 66 L 335.92247 95.50391 L 335.692 693.8164" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_57"> + <text transform="translate(350.384 509.2102)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="32" font-weight="400" fill="black" x="14210855e-21" y="30">b0</tspan> + </text> + </g> + </g> + </g> +</svg>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/a04/fig/nfa.svg Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,167 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> +<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/" version="1.1" viewBox="61 123 727 595" width="727" height="595"> + <defs> + <font-face font-family="Helvetica Neue" font-size="35" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <font-face font-family="Helvetica Neue" font-size="16" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" stroke-linejoin="miter" stroke-miterlimit="10" viewBox="-1 -3 7 6" markerWidth="7" markerHeight="6" color="#7f8080"> + <g> + <path d="M 4.8 0 L 0 -1.8 L 0 1.8 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/> + </g> + </marker> + <font-face font-family="Hiragino Sans" font-size="35" panose-1="2 11 3 0 0 0 0 0 0 0" units-per-em="1000" underline-position="-75" underline-thickness="50" slope="0" x-height="545" cap-height="766" ascent="880.0018" descent="-120.00024" font-weight="300"> + <font-face-src> + <font-face-name name="HiraginoSans-W3"/> + </font-face-src> + </font-face> + <font-face font-family="Helvetica Neue" font-size="25" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <font-face font-family="Hiragino Sans" font-size="25" panose-1="2 11 3 0 0 0 0 0 0 0" units-per-em="1000" underline-position="-75" underline-thickness="50" slope="0" x-height="545" cap-height="766" ascent="880.0018" descent="-120.00024" font-weight="300"> + <font-face-src> + <font-face-name name="HiraginoSans-W3"/> + </font-face-src> + </font-face> + </defs> + <metadata> Produced by OmniGraffle 7.17.5\n2020-11-25 07:08:06 +0000</metadata> + <g id="Canvas_1" stroke-opacity="1" stroke-dasharray="none" fill="none" stroke="none" fill-opacity="1"> + <title>Canvas 1</title> + <rect fill="white" x="61" y="123" width="727" height="595"/> + <g id="Canvas_1_Layer_1"> + <title>Layer 1</title> + <g id="Graphic_3"> + <text transform="translate(66 168)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">01111</tspan> + </text> + </g> + <g id="Graphic_5"> + <ellipse cx="310.614" cy="232.5" rx="39.5000631171249" ry="34.5000551276154" fill="white"/> + <ellipse cx="310.614" cy="232.5" rx="39.5000631171249" ry="34.5000551276154" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(284.014 223.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="17.408" y="15">q1</tspan> + </text> + </g> + <g id="Graphic_6"> + <ellipse cx="427.4051" cy="232.5" rx="37.2911554779238" ry="34.5000551276154" fill="white"/> + <ellipse cx="427.4051" cy="232.5" rx="37.2911554779238" ry="34.5000551276154" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(402.5722 223.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="4.224876" y="15">q2,q3</tspan> + </text> + </g> + <g id="Line_11"> + <path d="M 279.114 203 C 279.114 203 258.03487 174.69784 271.114 157.60547 C 284.19313 140.5131 302.35467 133.75603 325.28025 142.66797 C 348.2058 151.5799 356.1909 163.61264 352.03587 189.0625 C 351.37396 193.1168 349.87173 196.9817 347.8137 200.6147" marker-end="url(#FilledArrow_Marker)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_12"> + <text transform="translate(222.5226 128)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="7247536e-19" y="33">0,1</tspan> + </text> + </g> + <g id="Line_14"> + <path d="M 308.35514 267.9451 C 309.3978 282.0848 313.3626 297.0917 324.114 306 C 348.9032 326.5396 368.8511 325.8229 398.114 305 C 407.0135 298.66727 413.2091 289.4808 417.5223 279.7621" marker-end="url(#FilledArrow_Marker)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_15"/> + <g id="Graphic_16"> + <text transform="translate(339.479 282.51)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">1</tspan> + </text> + </g> + <g id="Graphic_17"> + <ellipse cx="669.4051" cy="232.5" rx="37.2911554779237" ry="34.5000551276154" fill="white"/> + <ellipse cx="669.4051" cy="232.5" rx="37.2911554779237" ry="34.5000551276154" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="4"/> + <text transform="translate(644.5722 223.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="15.640876" y="15">q4</tspan> + </text> + </g> + <g id="Line_18"> + <path d="M 452.1305 259.61016 C 471.61146 278.3919 501.399 302.0832 537.114 314 C 601.6435 335.5312 617.70026 331.58936 655.179 308.5 C 666.6821 301.41335 672.46416 291.51748 674.95345 281.2044" marker-end="url(#FilledArrow_Marker)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_19"> + <text transform="translate(607.114 282.51)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">1</tspan> + </text> + </g> + <g id="Line_21"> + <path d="M 663.37286 200.47566 C 663.4085 191.62342 665.2221 182.4995 670.7134 175.36526 C 686.4296 154.94684 701.9541 151.51583 724.8797 160.42776 C 747.8052 169.3397 767.3515 186.40387 751.6353 206.8223 C 745.4774 214.82256 731.5211 220.4956 716.8228 224.4369" marker-end="url(#FilledArrow_Marker)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_20"> + <text transform="translate(734.114 128)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="7247536e-19" y="33">0,1</tspan> + </text> + </g> + <g id="Line_22"> + <line x1="206.114" y1="295" x2="265.14417" y2="259.18036" marker-end="url(#FilledArrow_Marker)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_25"> + <text transform="translate(452.114 152.02)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">0</tspan> + </text> + </g> + <g id="Graphic_26"> + <ellipse cx="555.4051" cy="232.5" rx="37.2911554779238" ry="34.5000551276154" fill="white"/> + <ellipse cx="555.4051" cy="232.5" rx="37.2911554779238" ry="34.5000551276154" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(530.5722 223.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="15.640876" y="15">q3</tspan> + </text> + </g> + <g id="Line_27"> + <path d="M 407.1183 202.38196 C 402.62863 192.961 399.71323 182.69688 401.6843 173.7539 C 407.07096 149.31427 419.5047 147.36706 446.4187 146.23384 C 473.33266 145.10062 465.8079 145.31427 496.6843 169.7539 C 506.17094 177.26287 515.37134 186.08085 523.5659 194.69463" marker-end="url(#FilledArrow_Marker)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_29"> + <path d="M 539.2252 200.31396 C 536.3024 191.01935 534.9217 181.04528 537.5906 172.35385 C 545.2171 147.51757 555.411 145.967 582.32494 144.83378 C 609.2389 143.70056 607.9203 143.51757 632.5906 168.35385 C 638.4048 174.20722 643.5233 180.86452 647.95105 187.62168" marker-end="url(#FilledArrow_Marker)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Graphic_30"> + <text transform="translate(587.1751 158)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">1</tspan> + </text> + </g> + <g id="Graphic_31"> + <text transform="translate(79.114 350)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">.*</tspan> + <tspan font-family="Hiragino Sans" font-size="35" font-weight="300" fill="black" y="33">(</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" y="33">101|11).*</tspan> + </text> + </g> + <g id="Graphic_32"> + <text transform="translate(120.114 433)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">0 {q1}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="73.98">1 {q1,q2,q3}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="114.95999">1 {q1,q2,q3,q4}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="155.93999">1 {q1,q2,q3,q4}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="196.91998">1 {q1,q2,q3,</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" y="196.91998">q4</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" y="196.91998">}</tspan> + </text> + </g> + <g id="Graphic_33"> + <text transform="translate(523.114 433)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="33">0 {q1}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="73.98">1 {q1,q2,q3}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="114.95999">0 {q1,q3}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="155.93999">0 {q1}</tspan> + <tspan font-family="Helvetica Neue" font-size="35" font-weight="400" fill="black" x="0" y="196.91998">1 {q1,q2,q3}</tspan> + </text> + </g> + <g id="Graphic_34"> + <text transform="translate(108.45 673)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="25" font-weight="400" fill="black" x="7247536e-19" y="24">accept</tspan> + </text> + </g> + <g id="Graphic_35"> + <text transform="translate(528.114 673)" fill="black"> + <tspan font-family="Hiragino Sans" font-size="25" font-weight="300" fill="black" x="0" y="24">not </tspan> + <tspan font-family="Helvetica Neue" font-size="25" font-weight="400" fill="black" y="24">accept</tspan> + </text> + </g> + </g> + </g> +</svg>
--- a/a04/lecture.ind Sat Mar 14 19:42:27 2020 +0900 +++ b/a04/lecture.ind Sun Dec 27 13:26:44 2020 +0900 @@ -1,15 +1,49 @@ -title: 非決定性オートマトン 決定性オートマトンは入力に対して次の状態が一意に決まる。一つの入力に対して可能な状態が複数ある場合を考える。 +例えば、ドアの鍵がテンキーだったら、次に何を入れるかには自由度がある。 +この拡張は容易で、状態遷移関数が状態の代わりに状態のリストを返せば良い。しかし、リストを使うとかなり煩雑になる。 -例えば、ドアの鍵がテンキーだったら、次に何を入れるかには自由度がある。 - -この拡張は容易で、状態遷移関数が状態の代わりに状態のリストを返せば良い。しかし、リストを使うとかなり煩雑になる。 +このようなものが必要な理由は、 Regular Language の Concatを考えるためである。 Regular Language は Concatについて閉じている。これは オートマトン A と B があった時に、z を前半 x ++ y にわけて x を A が受理し、y を B で受理するものを、単一ののオートマトンで実現できると言う意味である。 しかい、 これを決定性オートマトンで示すのは難しい。A ++ B の 境目がどこかを前もって予測することができないからである。 +<center><img src="fig/concat.svg"></center> + +このためには後半のB automatonを、前半のA automatonが終わる可能性がある時だけ、 +一文字毎に増やしてやればよい。増やしたものの一つでも成功すればよい。Bが増えるので、その増えた状態を覚えておく必要がある。 + + an (Aのn番目の状態)と、b0...bn の部分集合 + +状態はAの状態とBの状態の部分集合の組になる。 + +--非決定性オートマトン + +そこで、状態の部分集合からなるオートマトンを考える。 + +これは状態遷移が非決定的な場合に相当する。この場合では 1 が来た時に q1 に +行っても、q2,q3 に行っても良い。q1から始める。 + + q1 0 → q1 + q1 1 → q1 + q1 1 → q2 + q1 1 → q3 + q2 0 → q3 + q3 1 → q4 + q4 0 → q4 + q4 1 → q4 + +最後に q4で accept。 + +<center><img src="fig/nfa.svg"></center> + +この時に、入力に従って状態の部分集合を計算していく方法でNFAのacceptを決定できる。 + +このNFA(nondeterministic automaton)は .*(101|11).* に対応している。 + + --Agda での非決定性オートマトン ここでは、部分集合を写像を使って表す。集合 Q から Bool (true または false) への写像を使う。true になる要素が
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/a06/fig/derivation.svg Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,122 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> +<svg xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:xl="http://www.w3.org/1999/xlink" xmlns="http://www.w3.org/2000/svg" version="1.1" viewBox="45 155 400 395" width="400" height="395"> + <defs> + <font-face font-family="Helvetica Neue" font-size="14" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" stroke-linejoin="miter" stroke-miterlimit="10" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"> + <g> + <path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/> + </g> + </marker> + <marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" stroke-linejoin="miter" stroke-miterlimit="10" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="#7f8080"> + <g> + <path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/> + </g> + </marker> + <font-face font-family="Hiragino Sans" font-size="14" panose-1="2 11 3 0 0 0 0 0 0 0" units-per-em="1000" underline-position="-75" underline-thickness="50" slope="0" x-height="545" cap-height="766" ascent="880.0018" descent="-120.00024" font-weight="300"> + <font-face-src> + <font-face-name name="HiraginoSans-W3"/> + </font-face-src> + </font-face> + </defs> + <metadata> Produced by OmniGraffle 7.18\n2020-12-23 01:04:40 +0000</metadata> + <g id="Canvas_1" stroke-opacity="1" fill-opacity="1" stroke-dasharray="none" fill="none" stroke="none"> + <title>Canvas 1</title> + <rect fill="white" x="45" y="155" width="400" height="395"/> + <g id="Canvas_1_Layer_1"> + <title>Layer 1</title> + <g id="Graphic_2"> + <circle cx="97.23" cy="335" r="42.0000671118797" fill="white"/> + <circle cx="97.23" cy="335" r="42.0000671118797" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(68.63 326.804)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="14" font-weight="400" fill="black" x="5.9060004" y="13">1*(01*)*</tspan> + </text> + </g> + <g id="Graphic_3"/> + <g id="Graphic_4"> + <circle cx="202" cy="270" r="42.0000671118797" fill="white"/> + <circle cx="202" cy="270" r="42.0000671118797" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(173.4 261.804)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="14" font-weight="400" fill="black" x="19.661" y="13">fail</tspan> + </text> + </g> + <g id="Line_6"> + <path d="M 140.16462 332.6221 C 156.7499 331.79873 177.4449 330.86532 201 330 C 223.2652 329.18207 244.30733 328.56378 262.10935 328.10756" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_8"> + <path d="M 71.71827 367.1007 C 57.957636 386.39034 44.12476 410.0216 46 425 C 49.617805 453.8971 95.48628 462.49745 110 437 C 116.43869 425.6886 114.6514 404.33916 110.66952 384.0841" marker-end="url(#FilledArrow_Marker_2)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_10"> + <circle cx="315" cy="327" r="42.0000671118797" fill="white"/> + <circle cx="315" cy="327" r="42.0000671118797" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(286.4 318.804)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="14" font-weight="400" fill="black" x="8.37" y="13">1(01*)*</tspan> + </text> + </g> + <g id="Graphic_11"> + <circle cx="315" cy="464" r="42.0000671118797" fill="white"/> + <circle cx="315" cy="464" r="42.0000671118797" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + <text transform="translate(286.4 455.804)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="14" font-weight="400" fill="black" x="12.262" y="13">(01*)*</tspan> + </text> + </g> + <g id="Graphic_14"> + <text transform="translate(199.115 343)" fill="black"> + <tspan font-family="Hiragino Sans" font-size="14" font-weight="300" fill="black" x="0" y="12">０</tspan> + </text> + </g> + <g id="Graphic_15"> + <text transform="translate(125.032 415)" fill="black"> + <tspan font-family="Hiragino Sans" font-size="14" font-weight="300" fill="black" x="15987212e-20" y="12">1</tspan> + </text> + </g> + <g id="Line_17"> + <path d="M 313.34975 284.03147 C 310.39053 267.1332 303.81176 250.0872 289.76172 243 C 277.82438 236.97852 262.58688 239.20184 248.17018 244.3585" marker-end="url(#FilledArrow_Marker_2)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_18"> + <text transform="translate(289 217)" fill="black"> + <tspan font-family="Hiragino Sans" font-size="14" font-weight="300" fill="black" x="0" y="12">０</tspan> + </text> + </g> + <g id="Line_20"> + <path d="M 342.2887 360.23536 C 350.32035 373.1295 357 388.50595 357 403.98438 C 357 412.40937 355.02103 420.0046 351.92224 426.73335" marker-end="url(#FilledArrow_Marker_2)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_21"> + <text transform="translate(359 385)" fill="black"> + <tspan font-family="Hiragino Sans" font-size="14" font-weight="300" fill="black" x="15987212e-20" y="12">1</tspan> + </text> + </g> + <g id="Line_25"> + <path d="M 283.14303 435.11733 C 277.29744 426.3152 273 415.62227 273 403.20703 C 273 391.1954 277.02256 379.31966 282.5779 368.6461" marker-end="url(#FilledArrow_Marker_2)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_26"> + <text transform="translate(283 393)" fill="black"> + <tspan font-family="Hiragino Sans" font-size="14" font-weight="300" fill="black" x="0" y="12">０</tspan> + </text> + </g> + <g id="Graphic_27"> + <circle cx="315" cy="464" r="36.0000575244682" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"/> + </g> + <g id="Line_28"> + <path d="M 71 180 C 71 180 44.37091 209.59163 51.802 253.5039 C 54.281893 268.15825 60.165845 282.1078 66.90568 294.19095" marker-end="url(#FilledArrow_Marker_2)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_29"> + <path d="M 349.981 451.9189 C 368.66078 443.5726 391.3686 430.24855 409 410 C 445.26304 368.35415 440.7535 368.525 443 317 C 445.2465 265.475 444.41027 269.49144 416.9297 228.1289 C 389.4491 186.76638 390.17566 189.73465 346 171 C 301.82434 152.26535 300.7479 152.89772 261 162 C 221.25209 171.10228 222.41421 172.53197 205.69922 203.1289 C 203.1308 207.83042 201.26436 212.666 199.94481 217.4834" marker-end="url(#FilledArrow_Marker_2)" stroke="#7f8080" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_30"> + <text transform="translate(430.198 399)" fill="black"> + <tspan font-family="Hiragino Sans" font-size="14" font-weight="300" fill="black" x="15987212e-20" y="12">1</tspan> + </text> + </g> + <g id="Graphic_31"> + <text transform="translate(162.666 528)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="14" font-weight="400" fill="black" x="1.946" y="13">derivating method </tspan> + </text> + </g> + </g> + </g> +</svg>
--- a/a06/lecture.ind Sat Mar 14 19:42:27 2020 +0900 +++ b/a06/lecture.ind Sun Dec 27 13:26:44 2020 +0900 @@ -14,6 +14,8 @@ --微分法 +<center><img src="fig/derivation.svg"> </center> + --オートマトンから正規表現を生成する 状態遷移の条件を正規表現した一般化オートマトンを考える。
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/a13/fig/semaphore.svg Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,89 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> +<svg version="1.1" xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/" viewBox="179 136 616 375" width="616" height="375"> + <defs> + <font-face font-family="Helvetica Neue" font-size="16" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" stroke-linejoin="miter" stroke-miterlimit="10" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"> + <g> + <path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/> + </g> + </marker> + </defs> + <metadata> Produced by OmniGraffle 7.9.1 + <dc:date>2019-01-30 12:19:10 +0000</dc:date> + </metadata> + <g id="Canvas_1" fill-opacity="1" stroke-opacity="1" stroke="none" stroke-dasharray="none" fill="none"> + <title>Canvas 1</title> + <g id="Canvas_1: Layer 1"> + <title>Layer 1</title> + <g id="Graphic_2"> + <circle cx="283.5" cy="283.5" r="50.0000798950948" fill="white"/> + <circle cx="283.5" cy="283.5" r="50.0000798950948" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(248.5 274.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="22.408" y="15">idle</tspan> + </text> + </g> + <g id="Graphic_6"> + <circle cx="463" cy="283.5" r="50.0000798950948" fill="white"/> + <circle cx="463" cy="283.5" r="50.0000798950948" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(428 274.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="10.256" y="15">entring</tspan> + </text> + </g> + <g id="Graphic_7"> + <circle cx="642" cy="283.5" r="50.0000798950948" fill="white"/> + <circle cx="642" cy="283.5" r="50.0000798950948" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(607 274.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="11.6" y="15">critical</tspan> + </text> + </g> + <g id="Graphic_8"> + <circle cx="463" cy="460.5" r="50.0000798950948" fill="white"/> + <circle cx="463" cy="460.5" r="50.0000798950948" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(428 451.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="11.448" y="15">exiting</tspan> + </text> + </g> + <g id="Line_9"> + <path d="M 283.5 233.49998 C 283.5 233.49998 290.643 186.14304 265.0039 171.26953 C 239.3648 156.39603 213.19765 158.27805 193 181 C 172.80235 203.72195 178.08817 232.45023 193.71094 251.47266 C 204.62247 264.75863 226.84556 257.86234 239.25656 252.49478" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_10"> + <path d="M 318.8553 248.1447 C 318.8553 248.1447 349.6716 233.5 380.4922 233.5 C 398.55714 233.5 411.6445 238.5312 419.38307 242.69572" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_11"> + <path d="M 498.3553 248.1447 C 498.3553 248.1447 524.43045 233.5 555.1094 233.5 C 573.9841 233.5 589.1409 239.0432 598.0102 243.3089" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_14"> + <path d="M 642 333.50002 C 642 333.50002 655.4923 379.1 638.90234 416.57812 C 622.3124 454.05627 619.11016 453.3458 583.4414 465.78906 C 558.9261 474.3414 534.8341 468.6391 522.1643 464.23674" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_18"> + <path d="M 412.99998 460.5 C 412.99998 460.5 365.55285 479.65744 329.0508 465.4922 C 292.5487 451.32694 297.061 447.89404 284.15625 410.5 C 275.13552 384.3607 278.40553 357.14057 281.19108 343.1232" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_19"> + <path d="M 463 233.49998 C 463 233.49998 500.9744 216.25857 495.0781 188.78906 C 489.18184 161.31955 471.10674 136.196 442.1875 136.53906 C 413.26826 136.88213 397.12005 158.38156 393 190 C 390.0725 212.46638 408.79657 232.36184 419.8813 241.99715" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_20"> + <path d="M 677.3553 318.8553 C 677.3553 318.8553 707.329 348.51655 740.375 340.625 C 773.421 332.73345 792.0047 325.46693 794 291 C 795.9953 256.53307 780.464 231.10596 747.418 218.96484 C 723.1369 210.04397 696.71214 229.98623 684.4028 241.19256" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_21"> + <text transform="translate(448.5625 164.776)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".256" y="15">semaphore=true</tspan> + </text> + </g> + <g id="Graphic_22"> + <text transform="translate(498 202.026)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".448" y="15">semaphore=false</tspan> + </text> + </g> + <g id="Graphic_23"> + <text transform="translate(629.5 426.276)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".256" y="15">semaphore=true</tspan> + </text> + </g> + </g> + </g> +</svg>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/FSetUtil.agda Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,411 @@ +module FSetUtil where + +open import Data.Nat hiding ( _≟_ ) +open import Data.Fin renaming ( _<_ to _<<_ ) hiding (_≤_) +open import Data.Fin.Properties +open import Data.Empty +open import Relation.Nullary +open import Relation.Binary.Definitions +open import Relation.Binary.PropositionalEquality +open import logic +open import nat +open import finiteSet +open import Data.Nat.Properties as NatP hiding ( _≟_ ) +open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) + +record ISO (A B : Set) : Set where + field + A←B : B → A + B←A : A → B + iso← : (q : A) → A←B ( B←A q ) ≡ q + iso→ : (f : B) → B←A ( A←B f ) ≡ f + +iso-fin : {A B : Set} → FiniteSet A → ISO A B → FiniteSet B +iso-fin {A} {B} fin iso = record { + Q←F = λ f → ISO.B←A iso ( FiniteSet.Q←F fin f ) + ; F←Q = λ b → FiniteSet.F←Q fin ( ISO.A←B iso b ) + ; finiso→ = finiso→ + ; finiso← = finiso← + } where + finiso→ : (q : B) → ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) ≡ q + finiso→ q = begin + ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) + ≡⟨ cong (λ k → ISO.B←A iso k ) (FiniteSet.finiso→ fin _ ) ⟩ + ISO.B←A iso (ISO.A←B iso q) + ≡⟨ ISO.iso→ iso _ ⟩ + q + ∎ where + open ≡-Reasoning + finiso← : (f : Fin (FiniteSet.finite fin ))→ FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) ≡ f + finiso← f = begin + FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) + ≡⟨ cong (λ k → FiniteSet.F←Q fin k ) (ISO.iso← iso _) ⟩ + FiniteSet.F←Q fin (FiniteSet.Q←F fin f) + ≡⟨ FiniteSet.finiso← fin _ ⟩ + f + ∎ where + open ≡-Reasoning + +data One : Set where + one : One + +fin-∨1 : {B : Set} → (fb : FiniteSet B ) → FiniteSet (One ∨ B) +fin-∨1 {B} fb = record { + Q←F = Q←F + ; F←Q = F←Q + ; finiso→ = finiso→ + ; finiso← = finiso← + } where + b = FiniteSet.finite fb + Q←F : Fin (suc b) → One ∨ B + Q←F zero = case1 one + Q←F (suc f) = case2 (FiniteSet.Q←F fb f) + F←Q : One ∨ B → Fin (suc b) + F←Q (case1 one) = zero + F←Q (case2 f ) = suc (FiniteSet.F←Q fb f) + finiso→ : (q : One ∨ B) → Q←F (F←Q q) ≡ q + finiso→ (case1 one) = refl + finiso→ (case2 b) = cong (λ k → case2 k ) (FiniteSet.finiso→ fb b) + finiso← : (q : Fin (suc b)) → F←Q (Q←F q) ≡ q + finiso← zero = refl + finiso← (suc f) = cong ( λ k → suc k ) (FiniteSet.finiso← fb f) + + +fin-∨2 : {B : Set} → ( a : ℕ ) → FiniteSet B → FiniteSet (Fin a ∨ B) +fin-∨2 {B} zero fb = iso-fin fb iso where + iso : ISO B (Fin zero ∨ B) + iso = record { + A←B = A←B + ; B←A = λ b → case2 b + ; iso→ = iso→ + ; iso← = λ _ → refl + } where + A←B : Fin zero ∨ B → B + A←B (case2 x) = x + iso→ : (f : Fin zero ∨ B ) → case2 (A←B f) ≡ f + iso→ (case2 x) = refl +fin-∨2 {B} (suc a) fb = iso-fin (fin-∨1 (fin-∨2 a fb) ) iso + where + iso : ISO (One ∨ (Fin a ∨ B) ) (Fin (suc a) ∨ B) + ISO.A←B iso (case1 zero) = case1 one + ISO.A←B iso (case1 (suc f)) = case2 (case1 f) + ISO.A←B iso (case2 b) = case2 (case2 b) + ISO.B←A iso (case1 one) = case1 zero + ISO.B←A iso (case2 (case1 f)) = case1 (suc f) + ISO.B←A iso (case2 (case2 b)) = case2 b + ISO.iso← iso (case1 one) = refl + ISO.iso← iso (case2 (case1 x)) = refl + ISO.iso← iso (case2 (case2 x)) = refl + ISO.iso→ iso (case1 zero) = refl + ISO.iso→ iso (case1 (suc x)) = refl + ISO.iso→ iso (case2 x) = refl + + +FiniteSet→Fin : {A : Set} → (fin : FiniteSet A ) → ISO (Fin (FiniteSet.finite fin)) A +ISO.A←B (FiniteSet→Fin fin) f = FiniteSet.F←Q fin f +ISO.B←A (FiniteSet→Fin fin) f = FiniteSet.Q←F fin f +ISO.iso← (FiniteSet→Fin fin) = FiniteSet.finiso← fin +ISO.iso→ (FiniteSet→Fin fin) = FiniteSet.finiso→ fin + + +fin-∨ : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A ∨ B) +fin-∨ {A} {B} fa fb = iso-fin (fin-∨2 a fb ) iso2 where + a = FiniteSet.finite fa + ia = FiniteSet→Fin fa + iso2 : ISO (Fin a ∨ B ) (A ∨ B) + ISO.A←B iso2 (case1 x) = case1 ( ISO.A←B ia x ) + ISO.A←B iso2 (case2 x) = case2 x + ISO.B←A iso2 (case1 x) = case1 ( ISO.B←A ia x ) + ISO.B←A iso2 (case2 x) = case2 x + ISO.iso← iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso← ia x) + ISO.iso← iso2 (case2 x) = refl + ISO.iso→ iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso→ ia x) + ISO.iso→ iso2 (case2 x) = refl + +open import Data.Product + +fin-× : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A × B) +fin-× {A} {B} fa fb with FiniteSet→Fin fa +... | a=f = iso-fin (fin-×-f a ) iso-1 where + a = FiniteSet.finite fa + b = FiniteSet.finite fb + iso-1 : ISO (Fin a × B) ( A × B ) + ISO.A←B iso-1 x = ( FiniteSet.F←Q fa (proj₁ x) , proj₂ x) + ISO.B←A iso-1 x = ( FiniteSet.Q←F fa (proj₁ x) , proj₂ x) + ISO.iso← iso-1 x = lemma where + lemma : (FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj₁ x)) , proj₂ x) ≡ ( proj₁ x , proj₂ x ) + lemma = cong ( λ k → ( k , proj₂ x ) ) (FiniteSet.finiso← fa _ ) + ISO.iso→ iso-1 x = cong ( λ k → ( k , proj₂ x ) ) (FiniteSet.finiso→ fa _ ) + + iso-2 : {a : ℕ } → ISO (B ∨ (Fin a × B)) (Fin (suc a) × B) + ISO.A←B iso-2 (zero , b ) = case1 b + ISO.A←B iso-2 (suc fst , b ) = case2 ( fst , b ) + ISO.B←A iso-2 (case1 b) = ( zero , b ) + ISO.B←A iso-2 (case2 (a , b )) = ( suc a , b ) + ISO.iso← iso-2 (case1 x) = refl + ISO.iso← iso-2 (case2 x) = refl + ISO.iso→ iso-2 (zero , b ) = refl + ISO.iso→ iso-2 (suc a , b ) = refl + + fin-×-f : ( a : ℕ ) → FiniteSet ((Fin a) × B) + fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () ; finite = 0 } + fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2 + +open _∧_ + +fin-∧ : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A ∧ B) +fin-∧ {A} {B} fa fb with FiniteSet→Fin fa -- same thing for our tool +... | a=f = iso-fin (fin-×-f a ) iso-1 where + a = FiniteSet.finite fa + b = FiniteSet.finite fb + iso-1 : ISO (Fin a ∧ B) ( A ∧ B ) + ISO.A←B iso-1 x = record { proj1 = FiniteSet.F←Q fa (proj1 x) ; proj2 = proj2 x} + ISO.B←A iso-1 x = record { proj1 = FiniteSet.Q←F fa (proj1 x) ; proj2 = proj2 x} + ISO.iso← iso-1 x = lemma where + lemma : record { proj1 = FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj1 x)) ; proj2 = proj2 x} ≡ record {proj1 = proj1 x ; proj2 = proj2 x } + lemma = cong ( λ k → record {proj1 = k ; proj2 = proj2 x } ) (FiniteSet.finiso← fa _ ) + ISO.iso→ iso-1 x = cong ( λ k → record {proj1 = k ; proj2 = proj2 x } ) (FiniteSet.finiso→ fa _ ) + + iso-2 : {a : ℕ } → ISO (B ∨ (Fin a ∧ B)) (Fin (suc a) ∧ B) + ISO.A←B iso-2 (record { proj1 = zero ; proj2 = b }) = case1 b + ISO.A←B iso-2 (record { proj1 = suc fst ; proj2 = b }) = case2 ( record { proj1 = fst ; proj2 = b } ) + ISO.B←A iso-2 (case1 b) = record {proj1 = zero ; proj2 = b } + ISO.B←A iso-2 (case2 (record { proj1 = a ; proj2 = b })) = record { proj1 = suc a ; proj2 = b } + ISO.iso← iso-2 (case1 x) = refl + ISO.iso← iso-2 (case2 x) = refl + ISO.iso→ iso-2 (record { proj1 = zero ; proj2 = b }) = refl + ISO.iso→ iso-2 (record { proj1 = suc a ; proj2 = b }) = refl + + fin-×-f : ( a : ℕ ) → FiniteSet ((Fin a) ∧ B) + fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () ; finite = 0 } + fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2 + +-- import Data.Nat.DivMod + +open import Data.Vec +import Data.Product + +exp2 : (n : ℕ ) → exp 2 (suc n) ≡ exp 2 n Data.Nat.+ exp 2 n +exp2 n = begin + exp 2 (suc n) + ≡⟨⟩ + 2 * ( exp 2 n ) + ≡⟨ *-comm 2 (exp 2 n) ⟩ + ( exp 2 n ) * 2 + ≡⟨ *-suc ( exp 2 n ) 1 ⟩ + (exp 2 n ) Data.Nat.+ ( exp 2 n ) * 1 + ≡⟨ cong ( λ k → (exp 2 n ) Data.Nat.+ k ) (proj₂ *-identity (exp 2 n) ) ⟩ + exp 2 n Data.Nat.+ exp 2 n + ∎ where + open ≡-Reasoning + open Data.Product + +cast-iso : {n m : ℕ } → (eq : n ≡ m ) → (f : Fin m ) → cast eq ( cast (sym eq ) f) ≡ f +cast-iso refl zero = refl +cast-iso refl (suc f) = cong ( λ k → suc k ) ( cast-iso refl f ) + + +fin2List : {n : ℕ } → FiniteSet (Vec Bool n) +fin2List {zero} = record { + Q←F = λ _ → Vec.[] + ; F←Q = λ _ → # 0 + ; finiso→ = finiso→ + ; finiso← = finiso← + } where + Q = Vec Bool zero + finiso→ : (q : Q) → [] ≡ q + finiso→ [] = refl + finiso← : (f : Fin (exp 2 zero)) → # 0 ≡ f + finiso← zero = refl +fin2List {suc n} = subst (λ k → FiniteSet (Vec Bool (suc n)) ) (sym (exp2 n)) ( iso-fin (fin-∨ (fin2List ) (fin2List )) iso ) + where + QtoR : Vec Bool (suc n) → Vec Bool n ∨ Vec Bool n + QtoR ( true ∷ x ) = case1 x + QtoR ( false ∷ x ) = case2 x + RtoQ : Vec Bool n ∨ Vec Bool n → Vec Bool (suc n) + RtoQ ( case1 x ) = true ∷ x + RtoQ ( case2 x ) = false ∷ x + isoRQ : (x : Vec Bool (suc n) ) → RtoQ ( QtoR x ) ≡ x + isoRQ (true ∷ _ ) = refl + isoRQ (false ∷ _ ) = refl + isoQR : (x : Vec Bool n ∨ Vec Bool n ) → QtoR ( RtoQ x ) ≡ x + isoQR (case1 x) = refl + isoQR (case2 x) = refl + iso : ISO (Vec Bool n ∨ Vec Bool n) (Vec Bool (suc n)) + iso = record { A←B = QtoR ; B←A = RtoQ ; iso← = isoQR ; iso→ = isoRQ } + +F2L : {Q : Set } {n : ℕ } → (fin : FiniteSet Q ) → n < suc (FiniteSet.finite fin) → ( (q : Q) → toℕ (FiniteSet.F←Q fin q ) < n → Bool ) → Vec Bool n +F2L {Q} {zero} fin _ Q→B = [] +F2L {Q} {suc n} fin (s≤s n<m) Q→B = Q→B (FiniteSet.Q←F fin (fromℕ< n<m)) lemma6 ∷ F2L {Q} fin (NatP.<-trans n<m a<sa ) qb1 where + lemma6 : toℕ (FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ< n<m))) < suc n + lemma6 = subst (λ k → toℕ k < suc n ) (sym (FiniteSet.finiso← fin _ )) (subst (λ k → k < suc n) (sym (toℕ-fromℕ< n<m )) a<sa ) + qb1 : (q : Q) → toℕ (FiniteSet.F←Q fin q) < n → Bool + qb1 q q<n = Q→B q (NatP.<-trans q<n a<sa) + +List2Func : { Q : Set } → {n : ℕ } → (fin : FiniteSet Q ) → n < suc (FiniteSet.finite fin) → Vec Bool n → Q → Bool +List2Func {Q} {zero} fin (s≤s z≤n) [] q = false +List2Func {Q} {suc n} fin (s≤s n<m) (h ∷ t) q with FiniteSet.F←Q fin q ≟ fromℕ< n<m +... | yes _ = h +... | no _ = List2Func {Q} fin (NatP.<-trans n<m a<sa ) t q + +open import Level renaming ( suc to Suc ; zero to Zero) +open import Axiom.Extensionality.Propositional +postulate f-extensionality : { n : Level} → Axiom.Extensionality.Propositional.Extensionality n n + +F2L-iso : { Q : Set } → (fin : FiniteSet Q ) → (x : Vec Bool (FiniteSet.finite fin) ) → F2L fin a<sa (λ q _ → List2Func fin a<sa x q ) ≡ x +F2L-iso {Q} fin x = f2l m a<sa x where + m = FiniteSet.finite fin + f2l : (n : ℕ ) → (n<m : n < suc m )→ (x : Vec Bool n ) → F2L fin n<m (λ q q<n → List2Func fin n<m x q ) ≡ x + f2l zero (s≤s z≤n) [] = refl + f2l (suc n) (s≤s n<m) (h ∷ t ) = lemma1 lemma2 lemma3 where + lemma1 : {n : ℕ } → {h h1 : Bool } → {t t1 : Vec Bool n } → h ≡ h1 → t ≡ t1 → h ∷ t ≡ h1 ∷ t1 + lemma1 refl refl = refl + lemma2 : List2Func fin (s≤s n<m) (h ∷ t) (FiniteSet.Q←F fin (fromℕ< n<m)) ≡ h + lemma2 with FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ< n<m)) ≟ fromℕ< n<m + lemma2 | yes p = refl + lemma2 | no ¬p = ⊥-elim ( ¬p (FiniteSet.finiso← fin _) ) + lemma4 : (q : Q ) → toℕ (FiniteSet.F←Q fin q ) < n → List2Func fin (s≤s n<m) (h ∷ t) q ≡ List2Func fin (NatP.<-trans n<m a<sa) t q + lemma4 q _ with FiniteSet.F←Q fin q ≟ fromℕ< n<m + lemma4 q lt | yes p = ⊥-elim ( nat-≡< (toℕ-fromℕ< n<m) (lemma5 n lt (cong (λ k → toℕ k) p))) where + lemma5 : {j k : ℕ } → ( n : ℕ) → suc j ≤ n → j ≡ k → k < n + lemma5 {zero} (suc n) (s≤s z≤n) refl = s≤s z≤n + lemma5 {suc j} (suc n) (s≤s lt) refl = s≤s (lemma5 {j} n lt refl) + lemma4 q _ | no ¬p = refl + lemma3 : F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (s≤s n<m) (h ∷ t) q ) ≡ t + lemma3 = begin + F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (s≤s n<m) (h ∷ t) q ) + ≡⟨ cong (λ k → F2L fin (NatP.<-trans n<m a<sa) ( λ q q<n → k q q<n )) + (f-extensionality ( λ q → + (f-extensionality ( λ q<n → lemma4 q q<n )))) ⟩ + F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (NatP.<-trans n<m a<sa) t q ) + ≡⟨ f2l n (NatP.<-trans n<m a<sa ) t ⟩ + t + ∎ where + open ≡-Reasoning + + +L2F : {Q : Set } {n : ℕ } → (fin : FiniteSet Q ) → n < suc (FiniteSet.finite fin) → Vec Bool n → (q : Q ) → toℕ (FiniteSet.F←Q fin q ) < n → Bool +L2F fin n<m x q q<n = List2Func fin n<m x q + +L2F-iso : { Q : Set } → (fin : FiniteSet Q ) → (f : Q → Bool ) → (q : Q ) → (L2F fin a<sa (F2L fin a<sa (λ q _ → f q) )) q (toℕ<n _) ≡ f q +L2F-iso {Q} fin f q = l2f m a<sa (toℕ<n _) where + m = FiniteSet.finite fin + lemma11 : {n : ℕ } → (n<m : n < m ) → ¬ ( FiniteSet.F←Q fin q ≡ fromℕ< n<m ) → toℕ (FiniteSet.F←Q fin q) ≤ n → toℕ (FiniteSet.F←Q fin q) < n + lemma11 n<m ¬q=n q≤n = lemma13 n<m (contra-position (lemma12 n<m _) ¬q=n ) q≤n where + lemma13 : {n nq : ℕ } → (n<m : n < m ) → ¬ ( nq ≡ n ) → nq ≤ n → nq < n + lemma13 {0} {0} (s≤s z≤n) nt z≤n = ⊥-elim ( nt refl ) + lemma13 {suc _} {0} (s≤s (s≤s n<m)) nt z≤n = s≤s z≤n + lemma13 {suc n} {suc nq} n<m nt (s≤s nq≤n) = s≤s (lemma13 {n} {nq} (NatP.<-trans a<sa n<m ) (λ eq → nt ( cong ( λ k → suc k ) eq )) nq≤n) + lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt) + lemma3 (s≤s lt) = refl + lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m ) → toℕ f ≡ n → f ≡ fromℕ< n<m + lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl + lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl = subst ( λ k → suc f ≡ k ) (sym (lemma3 n<m) ) ( cong ( λ k → suc k ) ( lemma12 {n} {m} n<m f refl ) ) + l2f : (n : ℕ ) → (n<m : n < suc m ) → (q<n : toℕ (FiniteSet.F←Q fin q ) < n ) → (L2F fin n<m (F2L fin n<m (λ q _ → f q))) q q<n ≡ f q + l2f zero (s≤s z≤n) () + l2f (suc n) (s≤s n<m) (s≤s n<q) with FiniteSet.F←Q fin q ≟ fromℕ< n<m + l2f (suc n) (s≤s n<m) (s≤s n<q) | yes p = begin + f (FiniteSet.Q←F fin (fromℕ< n<m)) + ≡⟨ cong ( λ k → f (FiniteSet.Q←F fin k )) (sym p) ⟩ + f (FiniteSet.Q←F fin ( FiniteSet.F←Q fin q )) + ≡⟨ cong ( λ k → f k ) (FiniteSet.finiso→ fin _ ) ⟩ + f q + ∎ where + open ≡-Reasoning + l2f (suc n) (s≤s n<m) (s≤s n<q) | no ¬p = l2f n (NatP.<-trans n<m a<sa) (lemma11 n<m ¬p n<q) + +fin→ : {A : Set} → FiniteSet A → FiniteSet (A → Bool ) +fin→ {A} fin = iso-fin fin2List iso where + a = FiniteSet.finite fin + iso : ISO (Vec Bool a ) (A → Bool) + ISO.A←B iso x = F2L fin a<sa ( λ q _ → x q ) + ISO.B←A iso x = List2Func fin a<sa x + ISO.iso← iso x = F2L-iso fin x + ISO.iso→ iso x = lemma where + lemma : List2Func fin a<sa (F2L fin a<sa (λ q _ → x q)) ≡ x + lemma = f-extensionality ( λ q → L2F-iso fin x q ) + + +Fin2Finite : ( n : ℕ ) → FiniteSet (Fin n) +Fin2Finite n = record { F←Q = λ x → x ; Q←F = λ x → x ; finiso← = λ q → refl ; finiso→ = λ q → refl } + +data fin-less { n : ℕ } { A : Set } (fa : FiniteSet A ) (n<m : n < FiniteSet.finite fa ) : Set where + elm1 : (elm : A ) → toℕ (FiniteSet.F←Q fa elm ) < n → fin-less fa n<m + +get-elm : { n : ℕ } { A : Set } {fa : FiniteSet A } {n<m : n < FiniteSet.finite fa } → fin-less fa n<m → A +get-elm (elm1 a _ ) = a + +get-< : { n : ℕ } { A : Set } {fa : FiniteSet A } {n<m : n < FiniteSet.finite fa }→ (f : fin-less fa n<m ) → toℕ (FiniteSet.F←Q fa (get-elm f )) < n +get-< (elm1 _ b ) = b + +fin-less-cong : { n : ℕ } { A : Set } (fa : FiniteSet A ) (n<m : n < FiniteSet.finite fa ) + → (x y : fin-less fa n<m ) → get-elm {n} {A} {fa} x ≡ get-elm {n} {A} {fa} y → get-< x ≅ get-< y → x ≡ y +fin-less-cong fa n<m (elm1 elm x) (elm1 elm x) refl HE.refl = refl + +fin-< : {A : Set} → { n : ℕ } → (fa : FiniteSet A ) → (n<m : n < FiniteSet.finite fa ) → FiniteSet (fin-less fa n<m ) +fin-< {A} {n} fa n<m = iso-fin (Fin2Finite n) iso where + m = FiniteSet.finite fa + iso : ISO (Fin n) (fin-less fa n<m ) + lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n + lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl + lemma8 {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8 {i} {i} refl ) + lemma10 : {n i j : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → fromℕ< i<n ≡ fromℕ< j<n + lemma10 refl = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8 refl )) + lemma3 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c + lemma3 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl) + lemma11 : {n : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x + lemma11 {n} {x} n<m = begin + toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) + ≡⟨ toℕ-fromℕ< _ ⟩ + toℕ x + ∎ where + open ≡-Reasoning + ISO.A←B iso (elm1 elm x) = fromℕ< x + ISO.B←A iso x = elm1 (FiniteSet.Q←F fa (fromℕ< (NatP.<-trans x<n n<m ))) to<n where + x<n : toℕ x < n + x<n = toℕ<n x + to<n : toℕ (FiniteSet.F←Q fa (FiniteSet.Q←F fa (fromℕ< (NatP.<-trans x<n n<m)))) < n + to<n = subst (λ k → toℕ k < n ) (sym (FiniteSet.finiso← fa _ )) (subst (λ k → k < n ) (sym ( toℕ-fromℕ< (NatP.<-trans x<n n<m) )) x<n ) + ISO.iso← iso x = lemma2 where + lemma2 : fromℕ< (subst (λ k → toℕ k < n) (sym + (FiniteSet.finiso← fa (fromℕ< (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n) + (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) ≡ x + lemma2 = begin + fromℕ< (subst (λ k → toℕ k < n) (sym + (FiniteSet.finiso← fa (fromℕ< (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n) + (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) + ≡⟨⟩ + fromℕ< ( subst (λ k → toℕ ( k ) < n ) (sym (FiniteSet.finiso← fa _ )) lemma6 ) + ≡⟨ lemma10 (cong (λ k → toℕ k) (FiniteSet.finiso← fa _ ) ) ⟩ + fromℕ< lemma6 + ≡⟨ lemma10 (lemma11 n<m ) ⟩ + fromℕ< ( toℕ<n x ) + ≡⟨ fromℕ<-toℕ _ _ ⟩ + x + ∎ where + open ≡-Reasoning + lemma6 : toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) < n + lemma6 = subst ( λ k → k < n ) (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x ) + ISO.iso→ iso (elm1 elm x) = fin-less-cong fa n<m _ _ lemma (lemma8 (cong (λ k → toℕ (FiniteSet.F←Q fa k) ) lemma ) ) where + lemma13 : toℕ (fromℕ< x) ≡ toℕ (FiniteSet.F←Q fa elm) + lemma13 = begin + toℕ (fromℕ< x) + ≡⟨ toℕ-fromℕ< _ ⟩ + toℕ (FiniteSet.F←Q fa elm) + ∎ where open ≡-Reasoning + lemma : FiniteSet.Q←F fa (fromℕ< (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m)) ≡ elm + lemma = begin + FiniteSet.Q←F fa (fromℕ< (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m)) + ≡⟨⟩ + FiniteSet.Q←F fa (fromℕ< ( NatP.<-trans (toℕ<n ( fromℕ< x ) ) n<m)) + ≡⟨ cong (λ k → FiniteSet.Q←F fa k) (lemma10 lemma13 ) ⟩ + FiniteSet.Q←F fa (fromℕ< ( NatP.<-trans x n<m)) + ≡⟨ cong (λ k → FiniteSet.Q←F fa (fromℕ< k )) lemma3 ⟩ + FiniteSet.Q←F fa (fromℕ< ( toℕ<n (FiniteSet.F←Q fa elm))) + ≡⟨ cong (λ k → FiniteSet.Q←F fa k ) ( fromℕ<-toℕ _ _ ) ⟩ + FiniteSet.Q←F fa (FiniteSet.F←Q fa elm ) + ≡⟨ FiniteSet.finiso→ fa _ ⟩ + elm + ∎ where open ≡-Reasoning + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/automaton-ex.agda Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,83 @@ +module automaton-ex where + +open import Data.Nat +open import Data.List +open import Data.Maybe +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import logic + +open import automaton +open Automaton + +data StatesQ : Set where + q1 : StatesQ + q2 : StatesQ + q3 : StatesQ + +data In2 : Set where + i0 : In2 + i1 : In2 +transitionQ : StatesQ → In2 → StatesQ +transitionQ q1 i0 = q1 +transitionQ q1 i1 = q2 +transitionQ q2 i0 = q3 +transitionQ q2 i1 = q2 +transitionQ q3 i0 = q2 +transitionQ q3 i1 = q2 + +aendQ : StatesQ → Bool +aendQ q2 = true +aendQ _ = false + +a1 : Automaton StatesQ In2 +a1 = record { + δ = transitionQ + ; aend = aendQ + } + +test1 : accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ [] ) ≡ false +test1 = refl +test2 = accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) + +data States1 : Set where + sr : States1 + ss : States1 + st : States1 + +transition1 : States1 → In2 → States1 +transition1 sr i0 = sr +transition1 sr i1 = ss +transition1 ss i0 = sr +transition1 ss i1 = st +transition1 st i0 = sr +transition1 st i1 = st + +fin1 : States1 → Bool +fin1 st = true +fin1 ss = false +fin1 sr = false + +am1 : Automaton States1 In2 +am1 = record { δ = transition1 ; aend = fin1 } + + +example1-1 = accept am1 sr ( i0 ∷ i1 ∷ i0 ∷ [] ) +example1-2 = accept am1 sr ( i1 ∷ i1 ∷ i1 ∷ [] ) +trace-2 = trace am1 sr ( i1 ∷ i1 ∷ i1 ∷ [] ) + +example1-3 = reachable am1 sr st ( i1 ∷ i1 ∷ i1 ∷ [] ) + +ieq : (i i' : In2 ) → Dec ( i ≡ i' ) +ieq i0 i0 = yes refl +ieq i1 i1 = yes refl +ieq i0 i1 = no ( λ () ) +ieq i1 i0 = no ( λ () ) + +inputnn : { n : ℕ } → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ +inputnn {zero} {_} _ _ s = s +inputnn {suc n} x y s = x ∷ ( inputnn {n} x y ( y ∷ s ) ) + +-- lemmaNN : { Q : Set } { Σ : Set } → (M : Automaton Q Σ) → ¬ accept M ( inputnn {n} x y [] ) +-- lemmaNN = ? +
--- a/agda/automaton-text.agda Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,109 +0,0 @@ -module automaton-text where - --- open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.Vec -open import Data.Maybe --- open import Data.Bool using ( Bool ; true ; false ; _∧_ ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) -open import logic --- open import Data.Bool renaming ( _∧_ to _and_ ; _∨_ to _or ) - -open import automaton -open import Data.Vec - -open Automaton - - -lemma4 : {i n : ℕ } → i < n → i < suc n -lemma4 {0} {0} () -lemma4 {0} {suc n} lt = s≤s z≤n -lemma4 {suc i} {0} () -lemma4 {suc i} {suc n} (s≤s lt) = s≤s (lemma4 lt) - -lemma5 : {n : ℕ } → n < suc n -lemma5 {zero} = s≤s z≤n -lemma5 {suc n} = s≤s lemma5 - -length : {S : Set} {n : ℕ} → Vec S n → ℕ -length {_} {n} _ = n - -record accept-n { Q : Set } { Σ : Set } (M : Automaton Q Σ ) (astart : Q ) (n : ℕ ) (s : {i : ℕ } → (i < n) → Σ ) : Set where - field - r : (i : ℕ ) → i < suc n → Q - accept-1 : r 0 (s≤s z≤n) ≡ astart - accept-2 : (i : ℕ ) → (i<n : i < n ) → δ M (r i (lemma4 i<n)) (s i<n) ≡ r (suc i) (s≤s i<n) - accept-3 : aend M (r n lemma5 ) ≡ true - -get : { Σ : Set } {n : ℕ} → (x : Vec Σ n ) → { i : ℕ } → i < n → Σ -get [] () -get (h ∷ t) {0} (s≤s lt) = h -get (h ∷ t) {suc i} (s≤s lt) = get t lt - -accept-v : { Q : Set } { Σ : Set } {n : ℕ } - → Automaton Q Σ - → (astart : Q) - → Vec Σ n → Bool -accept-v {Q} { Σ} M q [] = aend M q -accept-v {Q} { Σ} M q ( H ∷ T ) = accept-v M ( (δ M) q H ) T - -lemma7 : { Q : Set } { Σ : Set } {n : ℕ} (M : Automaton Q Σ ) (q : Q ) → (h : Σ) → (t : Vec Σ n ) - → accept-v M q (h ∷ t) ≡ true → accept-v M (δ M q h) t ≡ true -lemma7 M q h t eq with accept-v M (δ M q h) t -lemma7 M q h t refl | true = refl -lemma7 M q h t () | false - -open accept-n - -lemma→ : { Q : Set } { Σ : Set } {n : ℕ} (M : Automaton Q Σ ) (q : Q ) → (x : Vec Σ n ) → accept-v M q x ≡ true → accept-n M q (length x) (get x ) -lemma→ {Q} {Σ} M q [] eq = record { r = λ i lt → get [ q ] {i} lt ; accept-1 = refl ; accept-2 = λ _ () ; accept-3 = eq } -lemma→ {Q} {Σ} {n} M q (h ∷ t) eq with lemma→ M (δ M q h) t (lemma7 M q h t eq) -... | an = record { r = seq ; accept-1 = refl ; accept-2 = acc2 ; accept-3 = accept-3 an } where - seq : (i : ℕ) → i < suc n → Q - seq 0 lt = q - seq (suc i) (s≤s lt) = r an i lt - acc2 : (i : ℕ) (i<n : i < n) → δ M (seq i (lemma4 i<n)) (get (h ∷ t) i<n) ≡ seq (suc i) (s≤s i<n) - acc2 zero (s≤s z≤n) = begin - δ M (seq zero (lemma4 (s≤s z≤n))) (get (h ∷ t) (s≤s z≤n)) - ≡⟨⟩ - δ M q h - ≡⟨ sym ( accept-1 an) ⟩ - seq 1 (s≤s (s≤s z≤n)) - ∎ where open ≡-Reasoning - acc2 (suc i) (s≤s lt) = accept-2 an i lt - -an-1 : { Q : Set } { Σ : Set } {n : ℕ} (M : Automaton Q Σ ) (q : Q ) → (h : Σ ) → (t : Vec Σ n ) - → accept-n M q (length (h ∷ t)) (get (h ∷ t) ) - → accept-n M (δ M q h) (length t) (get t ) -an-1 {Q} {Σ} M q h t an = record { - r = seq - ; accept-1 = acc1 - ; accept-2 = acc2 - ; accept-3 = accept-3 an - } where - seq : (i : ℕ) → i < suc (length t) → Q - seq i lt = r an (suc i) ( s≤s lt) - acc1 : seq 0 (s≤s z≤n) ≡ δ M q h - acc1 = begin - seq 0 (s≤s z≤n) - ≡⟨⟩ - r an 1 (s≤s (s≤s z≤n)) - ≡⟨ sym (accept-2 an 0 (s≤s z≤n)) ⟩ - δ M (r an 0 (s≤s z≤n)) h - ≡⟨ cong (λ k → δ M k h) (accept-1 an) ⟩ - δ M q h - ∎ where open ≡-Reasoning - acc2 : (i : ℕ) (i<n : i < length t) → δ M (seq i (lemma4 i<n)) (get t i<n) ≡ seq (suc i) (s≤s i<n) - acc2 i lt = accept-2 an (suc i) (s≤s lt) - -lemma← : { Q : Set } { Σ : Set } {n : ℕ} (M : Automaton Q Σ ) (q : Q ) → (x : Vec Σ n ) → accept-n M q (length x) (get x ) → accept-v M q x ≡ true -lemma← {Q} {Σ} M q [] an with accept-1 an | accept-3 an -... | eq1 | eq3 = begin - aend M q - ≡⟨ cong ( λ k → aend M k ) (sym (accept-1 an)) ⟩ - aend M (r an 0 lemma5) - ≡⟨ accept-3 an ⟩ - true - ∎ where open ≡-Reasoning -lemma← {Q} {Σ} M q (h ∷ t) an = lemma← M (δ M q h) t ( an-1 M q h t an )
--- a/agda/automaton.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/automaton.agda Sun Dec 27 13:26:44 2020 +0900 @@ -1,14 +1,9 @@ module automaton where --- open import Level renaming ( suc to succ ; zero to Zero ) open import Data.Nat open import Data.List -open import Data.Maybe --- open import Data.Bool using ( Bool ; true ; false ; _∧_ ) open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) open import logic --- open import Data.Bool renaming ( _∧_ to _and_ ; _∨_ to _or ) record Automaton ( Q : Set ) ( Σ : Set ) : Set where @@ -18,33 +13,6 @@ open Automaton -data StatesQ : Set where - q1 : StatesQ - q2 : StatesQ - q3 : StatesQ - -data In2 : Set where - i0 : In2 - i1 : In2 - -transitionQ : StatesQ → In2 → StatesQ -transitionQ q1 i0 = q1 -transitionQ q1 i1 = q2 -transitionQ q2 i0 = q3 -transitionQ q2 i1 = q2 -transitionQ q3 i0 = q2 -transitionQ q3 i1 = q2 - -aendQ : StatesQ → Bool -aendQ q2 = true -aendQ _ = false - -a1 : Automaton StatesQ In2 -a1 = record { - δ = transitionQ - ; aend = aendQ - } - accept : { Q : Set } { Σ : Set } → Automaton Q Σ → (astart : Q) @@ -52,43 +20,17 @@ accept {Q} { Σ} M q [] = aend M q accept {Q} { Σ} M q ( H ∷ T ) = accept M ( (δ M) q H ) T -test1 : accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ [] ) ≡ false -test1 = refl -test2 = accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) - -data States1 : Set where - sr : States1 - ss : States1 - st : States1 - moves : { Q : Set } { Σ : Set } → Automaton Q Σ → Q → List Σ → Q -moves {Q} { Σ} M q L = move q L - where - move : (q : Q ) ( L : List Σ ) → Q - move q [] = q - move q ( H ∷ T ) = move ( δ M q H) T +moves {Q} { Σ} M q [] = q +moves {Q} { Σ} M q ( H ∷ T ) = moves M ( δ M q H) T -transition1 : States1 → In2 → States1 -transition1 sr i0 = sr -transition1 sr i1 = ss -transition1 ss i0 = sr -transition1 ss i1 = st -transition1 st i0 = sr -transition1 st i1 = st - -fin1 : States1 → Bool -fin1 st = true -fin1 ss = false -fin1 sr = false - -am1 : Automaton States1 In2 -am1 = record { δ = transition1 ; aend = fin1 } - - -example1-1 = accept am1 sr ( i0 ∷ i1 ∷ i0 ∷ [] ) -example1-2 = accept am1 sr ( i1 ∷ i1 ∷ i1 ∷ [] ) +trace : { Q : Set } { Σ : Set } + → Automaton Q Σ + → Q → List Σ → List Q +trace {Q} { Σ} M q [] = q ∷ [] +trace {Q} { Σ} M q ( H ∷ T ) = q ∷ trace M ( (δ M) q H ) T reachable : { Q : Set } { Σ : Set } → (M : Automaton Q Σ ) @@ -96,18 +38,3 @@ → (L : List Σ ) → Set reachable M astart q L = moves M astart L ≡ q -example1-3 = reachable am1 sr st ( i1 ∷ i1 ∷ i1 ∷ [] ) - -ieq : (i i' : In2 ) → Dec ( i ≡ i' ) -ieq i0 i0 = yes refl -ieq i1 i1 = yes refl -ieq i0 i1 = no ( λ () ) -ieq i1 i0 = no ( λ () ) - -inputnn : { n : ℕ } → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ -inputnn {zero} {_} _ _ s = s -inputnn {suc n} x y s = x ∷ ( inputnn {n} x y ( y ∷ s ) ) - --- lemmaNN : { Q : Set } { Σ : Set } → (M : Automaton Q Σ) → ¬ accept M ( inputnn {n} x y [] ) --- lemmaNN = ? -
--- a/agda/derive.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/derive.agda Sun Dec 27 13:26:44 2020 +0900 @@ -1,37 +1,126 @@ -module derive where +{-# OPTIONS --allow-unsolved-metas #-} -open import nfa -open import Data.Nat hiding ( _<_ ; _>_ ) -open import Data.Fin hiding ( _<_ ) -open import Data.List hiding ( [_] ) -open import Data.Maybe - -open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) open import Relation.Binary.PropositionalEquality hiding ( [_] ) open import Relation.Nullary using (¬_; Dec; yes; no) +open import Data.List hiding ( [_] ) + +module derive ( Σ : Set) ( eq? : (x y : Σ) → Dec (x ≡ y)) where + +-- open import nfa +open import Data.Nat +-- open import Data.Nat hiding ( _<_ ; _>_ ) +-- open import Data.Fin hiding ( _<_ ) open import finiteSet +open import FSetUtil open import automaton +open import logic +open import regex + +empty? : Regex Σ → Bool +empty? ε = true +empty? φ = false +empty? (x *) = true +empty? (x & y) = empty? x /\ empty? y +empty? (x || y) = empty? x \/ empty? y +empty? < x > = false + +derivative0 : Regex Σ → Σ → Regex Σ +derivative0 ε s = φ +derivative0 φ s = φ +derivative0 (x *) s = derivative0 x s & (x *) +derivative0 (x & y) s with empty? x +... | true = (derivative0 x s & y) || derivative0 y s +... | false = derivative0 x s & y +derivative0 (x || y) s = derivative0 x s || derivative0 y s +derivative0 < x > s with eq? x s +... | yes _ = ε +... | no _ = φ -data Regex ( Σ : Set ) : Set where - _* : Regex Σ → Regex Σ - _&_ : Regex Σ → Regex Σ → Regex Σ - _||_ : Regex Σ → Regex Σ → Regex Σ - <_> : Σ → Regex Σ +derivative : Regex Σ → Σ → Regex Σ +derivative ε s = φ +derivative φ s = φ +derivative (x *) s with derivative x s +... | ε = x * +... | φ = φ +... | t = t & (x *) +derivative (x & y) s with empty? x +... | true with derivative x s | derivative y s +... | ε | φ = φ +... | ε | t = y || t +... | φ | t = t +... | x1 | φ = x1 & y +... | x1 | y1 = (x1 & y) || y1 +derivative (x & y) s | false with derivative x s +... | ε = y +... | φ = φ +... | t = t & y +derivative (x || y) s with derivative x s | derivative y s +... | φ | y1 = y1 +... | x1 | φ = x1 +... | x1 | y1 = x1 || y1 +derivative < x > s with eq? x s +... | yes _ = ε +... | no _ = φ -derivation : { Σ : Set } → Regex Σ → Regex Σ → Bool -derivation = {!!} +data regex-states (x : Regex Σ ) : Regex Σ → Set where + unit : regex-states x x + derive : { y : Regex Σ } → regex-states x y → (s : Σ) → regex-states x ( derivative y s ) -derivation-step : { Σ : Set } → Regex Σ → Σ → Maybe (Regex Σ) -derivation-step {Σ} (r *) s with derivation-step r s -... | just ex = just ( ex & (r *) ) -... | nothing = nothing -derivation-step {Σ} (r & r₁) s with derivation-step r s -... | just ex = just ( ex & r₁ ) -... | nothing = nothing -derivation-step {Σ} (r || r₁) s with derivation-step r s | derivation-step r₁ s -... | just e | just e1 = just ( e || e1 ) -... | nothing | just e1 = just e1 -... | just e | nothing = just e -... | nothing | nothing = nothing -derivation-step {Σ} < x > s = {!!} +record Derivative (x : Regex Σ ) : Set where + field + state : Regex Σ + is-derived : regex-states x state + +open Derivative + +open import Data.Fin + +-- derivative generates (x & y) || ... form. y and x part is a substerm of original regex +-- since subterm is finite, only finite number of state is negerated, if we normalize ||-list. + +data subterm (r : Regex Σ) : Regex Σ → Set where + sε : subterm r ε + sφ : subterm r φ + orig : subterm r r + x& : {x y : Regex Σ } → subterm r (x & y) → subterm r x + &y : {x y : Regex Σ } → subterm r (x & y) → subterm r y + x| : {x y : Regex Σ } → subterm r (x || y) → subterm r x + |y : {x y : Regex Σ } → subterm r (x || y) → subterm r y + s* : {x : Regex Σ } → subterm r (x *) → subterm r x + s<_> : (s : Σ) → subterm r < s > → subterm r < s > + +record Subterm (r : Regex Σ) : Set where + field + subt : Regex Σ + is-subt : subterm r subt + +finsub : (r : Regex Σ ) → FiniteSet (Subterm r) +finsub ε = {!!} +finsub φ = {!!} +finsub (r *) = {!!} +finsub (r & r₁) = {!!} +finsub (r || r₁) = {!!} +finsub < x > = {!!} + +finsubList : (r : Regex Σ ) → FiniteSet (Subterm r ∧ Subterm r → Bool ) +finsubList r = fin→ ( fin-∧ (finsub r) (finsub r) ) + +-- derivative is subset of Subterm r → Subterm r → Bool + +der2ssb : {r : Regex Σ } → Derivative r → Subterm r ∧ Subterm r → Bool +der2ssb = {!!} + +-- we cannot say this, because Derivative is redundant +-- der2inject : {r : Regex Σ } → (x y : Derivative r ) → ( ( s t : Subterm r ∧ Subterm r ) → der2ssb x s ≡ der2ssb y t ) → x ≡ y + +-- this does not work, becuase it depends on input sequences +-- finite-derivative : (r : Regex Σ) → FiniteSet Σ → FiniteSet (Derivative r) + +-- in case of automaton, number of derivative is limited by iteration of input length, so it is finite. + +regex→automaton : (r : Regex Σ) → Automaton (Derivative r) Σ +regex→automaton r = record { δ = λ d s → record { state = derivative (state d) s ; is-derived = derive-step d s} ; aend = λ d → empty? (state d) } where + derive-step : (d0 : Derivative r) → (s : Σ) → regex-states r (derivative (state d0) s) + derive-step d0 s = derive (is-derived d0) s +
--- a/agda/epautomaton.agda Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,121 +0,0 @@ -module epautomaton where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.List -open import Data.Maybe -open import Data.Bool using ( Bool ; true ; false ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) - -open import automaton -open import nfa-list - -nth : {S : Set } → ℕ → List S → Maybe S -nth _ [] = nothing -nth 0 ( x ∷ _ ) = just x -nth (suc n) ( _ ∷ t ) = nth n t - -member : ℕ → List ℕ → Bool -member _ [] = false -member n ( x ∷ t ) with n ≟ x -... | yes _ = true -... | no _ = member n t - - -data STree (S E : Set ) : Set where - empty : STree S E - leaf : S → E → STree S E - node : S → E → STree S E → STree S E → STree S E - -Tree : Set → Set -Tree E = STree ℕ E - -insertT : {E : Set} → ℕ → E → Tree E → Tree E -insertT {E} n e empty = leaf n e -insertT {E} n e (leaf n1 e1 ) with n ≟ n1 | n ≤? n1 -... | yes _ | _ = leaf n e -... | no _ | yes _ = node n e ( leaf n1 e1 ) empty -... | no _ | no _ = node n e empty ( leaf n1 e1 ) -insertT {E} n e (node n1 e1 left right ) with n ≟ n1 | n ≤? n1 -... | yes _ | _ = node n e left right -... | no _ | yes _ = node n1 e1 ( insertT n e left ) right -... | no _ | no _ = node n1 e1 left ( insertT n e right ) - -memberT : {E : Set } → ℕ → Tree E → Maybe E -memberT _ empty = nothing -memberT n (leaf n1 e) with n ≟ n1 -... | yes _ = just e -... | no _ = nothing -memberT n (node n1 e1 left right) with n ≟ n1 | n ≤? n1 -... | yes _ | _ = just e1 -memberT n (node n1 e1 left right) | no ¬p | (yes p) = memberT n left -memberT n (node n1 e1 left right) | no ¬p | (no ¬p₁) = memberT n right - -open import Data.Product - -record εAutomaton ( Q : Set ) ( Σ : Set ) - : Set where - field - εδ : Q → Maybe Σ → Tree Q - all-εδ : Q → Tree ( Maybe Σ × Tree Q ) - εid : Q → ℕ - Σid : Σ → ℕ - allState : Tree Q - εstart : Q - εend : Q → Bool - -open εAutomaton - --- --- find ε connected state by following ε transition --- keep track state list in C --- if already tracked, skip it -εclosure : { Q : Set } { Σ : Set } - → ( allState : Tree Q ) - → ( εδ : Q → Maybe Σ → Tree Q ) - → Tree ( Tree Q ) -εclosure {Q} { Σ} allState εδ = closure ( allState ) - where - closure2 : Tree Q → Tree Q → Tree Q - closure2 empty C = C - closure2 ( leaf n1 q ) C with memberT n1 C - ... | just _ = C - ... | nothing = insertT n1 q C - closure2 ( node n1 q left right ) C with memberT n1 C - ... | just _ = closure2 left ( closure2 right C ) - ... | nothing = insertT n1 q (closure2 left ( closure2 right C )) - closure1 : ℕ → Tree Q - closure1 n with memberT n (allState ) - ... | nothing = empty - ... | just q = closure2 (εδ q nothing) ( leaf n q ) - closure : Tree Q → Tree ( Tree Q ) - closure empty = empty - closure (leaf n e) = (leaf n (closure1 n) ) - closure (node n e left right) = - node n (closure1 n) ( closure left ) ( closure right ) - - -εAutomaton2U : { Q : Set } { Σ : Set } - → εAutomaton Q Σ → NAutomaton Q Σ -εAutomaton2U {Q} { Σ} M = record { - nδ = nδ' ; - sid = εid M ; - nstart = εstart M ; - nend = εend M - } where - MTree : Tree ( Tree Q ) - MTree = εclosure (allState M ) ( εδ M ) - flatten : Tree Q → List Q - flatten empty = [] - flatten (leaf x q) = [ q ] - flatten (node x q left right) = flatten left ++ [ q ] ++ flatten right - nδ1 : Tree Q → Σ → List Q - nδ1 empty i = [] - nδ1 (leaf n q) i = flatten (εδ M q (just i)) - nδ1 (node n q left right) i = nδ1 left i ++ ( flatten (εδ M q (just i) )) ++ nδ1 right i - nδ' : Q → Σ → List Q - nδ' q i with memberT ( εid M q ) MTree - ... | nothing = [] - ... | just x = nδ1 x i -
--- a/agda/finiteSet.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/finiteSet.agda Sun Dec 27 13:26:44 2020 +0900 @@ -3,512 +3,40 @@ open import Data.Nat hiding ( _≟_ ) open import Data.Fin renaming ( _<_ to _<<_ ) hiding (_≤_) -open import Data.Fin.Properties +-- open import Data.Fin.Properties open import Data.Empty open import Relation.Nullary -open import Relation.Binary.Core +open import Relation.Binary.Definitions open import Relation.Binary.PropositionalEquality open import logic open import nat -open import Data.Nat.Properties as NatP hiding ( _≟_ ) +open import Data.Nat.Properties hiding ( _≟_ ) open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) -record Found ( Q : Set ) (p : Q → Bool ) : Set where +record FiniteSet ( Q : Set ) : Set where field - found-q : Q - found-p : p found-q ≡ true - -lt0 : (n : ℕ) → n Data.Nat.≤ n -lt0 zero = z≤n -lt0 (suc n) = s≤s (lt0 n) -lt2 : {m n : ℕ} → m < n → m Data.Nat.≤ n -lt2 {zero} lt = z≤n -lt2 {suc m} {zero} () -lt2 {suc m} {suc n} (s≤s lt) = s≤s (lt2 lt) - -record FiniteSet ( Q : Set ) { n : ℕ } : Set where - field - Q←F : Fin n → Q - F←Q : Q → Fin n + finite : ℕ + Q←F : Fin finite → Q + F←Q : Q → Fin finite finiso→ : (q : Q) → Q←F ( F←Q q ) ≡ q - finiso← : (f : Fin n ) → F←Q ( Q←F f ) ≡ f - finℕ : ℕ - finℕ = n - exists1 : (m : ℕ ) → m Data.Nat.≤ n → (Q → Bool) → Bool + finiso← : (f : Fin finite ) → F←Q ( Q←F f ) ≡ f + exists1 : (m : ℕ ) → m Data.Nat.≤ finite → (Q → Bool) → Bool exists1 zero _ _ = false - exists1 ( suc m ) m<n p = p (Q←F (fromℕ≤ {m} {n} m<n)) \/ exists1 m (lt2 m<n) p + exists1 ( suc m ) m<n p = p (Q←F (fromℕ< {m} {finite} m<n)) \/ exists1 m (≤to< m<n) p exists : ( Q → Bool ) → Bool - exists p = exists1 n (lt0 n) p + exists p = exists1 finite ≤-refl p open import Data.List - list1 : (m : ℕ ) → m Data.Nat.≤ n → (Q → Bool) → List Q + list1 : (m : ℕ ) → m Data.Nat.≤ finite → (Q → Bool) → List Q list1 zero _ _ = [] - list1 ( suc m ) m<n p with bool-≡-? (p (Q←F (fromℕ≤ {m} {n} m<n))) true - ... | yes _ = Q←F (fromℕ≤ {m} {n} m<n) ∷ list1 m (lt2 m<n) p - ... | no _ = list1 m (lt2 m<n) p + list1 ( suc m ) m<n p with bool-≡-? (p (Q←F (fromℕ< {m} {finite} m<n))) true + ... | yes _ = Q←F (fromℕ< {m} {finite} m<n) ∷ list1 m (≤to< m<n) p + ... | no _ = list1 m (≤to< m<n) p to-list : ( Q → Bool ) → List Q - to-list p = list1 n (lt0 n) p + to-list p = list1 finite ≤-refl p equal? : Q → Q → Bool equal? q0 q1 with F←Q q0 ≟ F←Q q1 ... | yes p = true ... | no ¬p = false - equal→refl : { x y : Q } → equal? x y ≡ true → x ≡ y - equal→refl {q0} {q1} eq with F←Q q0 ≟ F←Q q1 - equal→refl {q0} {q1} refl | yes eq = begin - q0 - ≡⟨ sym ( finiso→ q0) ⟩ - Q←F (F←Q q0) - ≡⟨ cong (λ k → Q←F k ) eq ⟩ - Q←F (F←Q q1) - ≡⟨ finiso→ q1 ⟩ - q1 - ∎ where open ≡-Reasoning - equal→refl {q0} {q1} () | no ne - equal?-refl : {q : Q} → equal? q q ≡ true - equal?-refl {q} with F←Q q ≟ F←Q q - ... | yes p = refl - ... | no ne = ⊥-elim (ne refl) - fin<n : {n : ℕ} {f : Fin n} → toℕ f < n - fin<n {_} {zero} = s≤s z≤n - fin<n {suc n} {suc f} = s≤s (fin<n {n} {f}) - i=j : {n : ℕ} (i j : Fin n) → toℕ i ≡ toℕ j → i ≡ j - i=j {suc n} zero zero refl = refl - i=j {suc n} (suc i) (suc j) eq = cong ( λ k → suc k ) ( i=j i j (cong ( λ k → Data.Nat.pred k ) eq) ) - -- ¬∀⟶∃¬ : ∀ n {p} (P : Pred (Fin n) p) → Decidable P → ¬ (∀ i → P i) → (∃ λ i → ¬ P i) - End : (m : ℕ ) → (p : Q → Bool ) → Set - End m p = (i : Fin n) → m ≤ toℕ i → p (Q←F i ) ≡ false - next-end : {m : ℕ } → ( p : Q → Bool ) → End (suc m) p - → (m<n : m < n ) → p (Q←F (fromℕ≤ m<n )) ≡ false - → End m p - next-end {m} p prev m<n np i m<i with NatP.<-cmp m (toℕ i) - next-end p prev m<n np i m<i | tri< a ¬b ¬c = prev i a - next-end p prev m<n np i m<i | tri> ¬a ¬b c = ⊥-elim ( nat-≤> m<i c ) - next-end {m} p prev m<n np i m<i | tri≈ ¬a b ¬c = subst ( λ k → p (Q←F k) ≡ false) (m<n=i i b m<n ) np where - m<n=i : {n : ℕ } (i : Fin n) {m : ℕ } → m ≡ (toℕ i) → (m<n : m < n ) → fromℕ≤ m<n ≡ i - m<n=i i eq m<n = i=j (fromℕ≤ m<n) i (subst (λ k → k ≡ toℕ i) (sym (toℕ-fromℕ≤ m<n)) eq ) - first-end : ( p : Q → Bool ) → End n p - first-end p i i>n = ⊥-elim (nat-≤> i>n (fin<n {n} {i}) ) - found : { p : Q → Bool } → (q : Q ) → p q ≡ true → exists p ≡ true - found {p} q pt = found1 n (lt0 n) ( first-end p ) where - found1 : (m : ℕ ) (m<n : m Data.Nat.≤ n ) → ((i : Fin n) → m ≤ toℕ i → p (Q←F i ) ≡ false ) → exists1 m m<n p ≡ true - found1 0 m<n end = ⊥-elim ( ¬-bool (subst (λ k → k ≡ false ) (cong (λ k → p k) (finiso→ q) ) (end (F←Q q) z≤n )) pt ) - found1 (suc m) m<n end with bool-≡-? (p (Q←F (fromℕ≤ m<n))) true - found1 (suc m) m<n end | yes eq = subst (λ k → k \/ exists1 m (lt2 m<n) p ≡ true ) (sym eq) (bool-or-4 {exists1 m (lt2 m<n) p} ) - found1 (suc m) m<n end | no np = begin - p (Q←F (fromℕ≤ m<n)) \/ exists1 m (lt2 m<n) p - ≡⟨ bool-or-1 (¬-bool-t np ) ⟩ - exists1 m (lt2 m<n) p - ≡⟨ found1 m (lt2 m<n) (next-end p end m<n (¬-bool-t np )) ⟩ - true - ∎ where open ≡-Reasoning - not-found : { p : Q → Bool } → ( (q : Q ) → p q ≡ false ) → exists p ≡ false - not-found {p} pn = not-found2 n (lt0 n) where - not-found2 : (m : ℕ ) → (m<n : m Data.Nat.≤ n ) → exists1 m m<n p ≡ false - not-found2 zero _ = refl - not-found2 ( suc m ) m<n with pn (Q←F (fromℕ≤ {m} {n} m<n)) - not-found2 (suc m) m<n | eq = begin - p (Q←F (fromℕ≤ m<n)) \/ exists1 m (lt2 m<n) p - ≡⟨ bool-or-1 eq ⟩ - exists1 m (lt2 m<n) p - ≡⟨ not-found2 m (lt2 m<n) ⟩ - false - ∎ where open ≡-Reasoning - open import Level - postulate f-extensionality : { n : Level} → Relation.Binary.PropositionalEquality.Extensionality n n -- (Level.suc n) - found← : { p : Q → Bool } → exists p ≡ true → Found Q p - found← {p} exst = found2 n (lt0 n) (first-end p ) where - found2 : (m : ℕ ) (m<n : m Data.Nat.≤ n ) → End m p → Found Q p - found2 0 m<n end = ⊥-elim ( ¬-bool (not-found (λ q → end (F←Q q) z≤n ) ) (subst (λ k → exists k ≡ true) (sym lemma) exst ) ) where - lemma : (λ z → p (Q←F (F←Q z))) ≡ p - lemma = f-extensionality ( λ q → subst (λ k → p k ≡ p q ) (sym (finiso→ q)) refl ) - found2 (suc m) m<n end with bool-≡-? (p (Q←F (fromℕ≤ m<n))) true - found2 (suc m) m<n end | yes eq = record { found-q = Q←F (fromℕ≤ m<n) ; found-p = eq } - found2 (suc m) m<n end | no np = - found2 m (lt2 m<n) (next-end p end m<n (¬-bool-t np )) - not-found← : { p : Q → Bool } → exists p ≡ false → (q : Q ) → p q ≡ false - not-found← {p} np q = ¬-bool-t ( contra-position {_} {_} {_} {exists p ≡ true} (found q) (λ ep → ¬-bool np ep ) ) - -record ISO (A B : Set) : Set where - field - A←B : B → A - B←A : A → B - iso← : (q : A) → A←B ( B←A q ) ≡ q - iso→ : (f : B) → B←A ( A←B f ) ≡ f - -iso-fin : {A B : Set} → {n : ℕ } → FiniteSet A {n} → ISO A B → FiniteSet B {n} -iso-fin {A} {B} {n} fin iso = record { - Q←F = λ f → ISO.B←A iso ( FiniteSet.Q←F fin f ) - ; F←Q = λ b → FiniteSet.F←Q fin ( ISO.A←B iso b ) - ; finiso→ = finiso→ - ; finiso← = finiso← - } where - finiso→ : (q : B) → ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) ≡ q - finiso→ q = begin - ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) - ≡⟨ cong (λ k → ISO.B←A iso k ) (FiniteSet.finiso→ fin _ ) ⟩ - ISO.B←A iso (ISO.A←B iso q) - ≡⟨ ISO.iso→ iso _ ⟩ - q - ∎ where - open ≡-Reasoning - finiso← : (f : Fin n) → FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) ≡ f - finiso← f = begin - FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) - ≡⟨ cong (λ k → FiniteSet.F←Q fin k ) (ISO.iso← iso _) ⟩ - FiniteSet.F←Q fin (FiniteSet.Q←F fin f) - ≡⟨ FiniteSet.finiso← fin _ ⟩ - f - ∎ where - open ≡-Reasoning - -data One : Set where - one : One - -fin-∨1 : {B : Set} → { b : ℕ } → FiniteSet B {b} → FiniteSet (One ∨ B) {suc b} -fin-∨1 {B} {b} fb = record { - Q←F = Q←F - ; F←Q = F←Q - ; finiso→ = finiso→ - ; finiso← = finiso← - } where - Q←F : Fin (suc b) → One ∨ B - Q←F zero = case1 one - Q←F (suc f) = case2 (FiniteSet.Q←F fb f) - F←Q : One ∨ B → Fin (suc b) - F←Q (case1 one) = zero - F←Q (case2 f ) = suc (FiniteSet.F←Q fb f) - finiso→ : (q : One ∨ B) → Q←F (F←Q q) ≡ q - finiso→ (case1 one) = refl - finiso→ (case2 b) = cong (λ k → case2 k ) (FiniteSet.finiso→ fb b) - finiso← : (q : Fin (suc b)) → F←Q (Q←F q) ≡ q - finiso← zero = refl - finiso← (suc f) = cong ( λ k → suc k ) (FiniteSet.finiso← fb f) - - -fin-∨2 : {B : Set} → ( a : ℕ ) → { b : ℕ } → FiniteSet B {b} → FiniteSet (Fin a ∨ B) {a Data.Nat.+ b} -fin-∨2 {B} zero {b} fb = iso-fin fb iso where - iso : ISO B (Fin zero ∨ B) - iso = record { - A←B = A←B - ; B←A = λ b → case2 b - ; iso→ = iso→ - ; iso← = λ _ → refl - } where - A←B : Fin zero ∨ B → B - A←B (case2 x) = x - iso→ : (f : Fin zero ∨ B ) → case2 (A←B f) ≡ f - iso→ (case2 x) = refl -fin-∨2 {B} (suc a) {b} fb = iso-fin (fin-∨1 (fin-∨2 a fb) ) iso - where - iso : ISO (One ∨ (Fin a ∨ B) ) (Fin (suc a) ∨ B) - ISO.A←B iso (case1 zero) = case1 one - ISO.A←B iso (case1 (suc f)) = case2 (case1 f) - ISO.A←B iso (case2 b) = case2 (case2 b) - ISO.B←A iso (case1 one) = case1 zero - ISO.B←A iso (case2 (case1 f)) = case1 (suc f) - ISO.B←A iso (case2 (case2 b)) = case2 b - ISO.iso← iso (case1 one) = refl - ISO.iso← iso (case2 (case1 x)) = refl - ISO.iso← iso (case2 (case2 x)) = refl - ISO.iso→ iso (case1 zero) = refl - ISO.iso→ iso (case1 (suc x)) = refl - ISO.iso→ iso (case2 x) = refl - - -FiniteSet→Fin : {A : Set} → { a : ℕ } → (fin : FiniteSet A {a} ) → ISO (Fin a) A -ISO.A←B (FiniteSet→Fin fin) f = FiniteSet.F←Q fin f -ISO.B←A (FiniteSet→Fin fin) f = FiniteSet.Q←F fin f -ISO.iso← (FiniteSet→Fin fin) = FiniteSet.finiso← fin -ISO.iso→ (FiniteSet→Fin fin) = FiniteSet.finiso→ fin - - -fin-∨ : {A B : Set} → { a b : ℕ } → FiniteSet A {a} → FiniteSet B {b} → FiniteSet (A ∨ B) {a Data.Nat.+ b} -fin-∨ {A} {B} {a} {b} fa fb = iso-fin (fin-∨2 a fb ) iso2 where - ia = FiniteSet→Fin fa - iso2 : ISO (Fin a ∨ B ) (A ∨ B) - ISO.A←B iso2 (case1 x) = case1 ( ISO.A←B ia x ) - ISO.A←B iso2 (case2 x) = case2 x - ISO.B←A iso2 (case1 x) = case1 ( ISO.B←A ia x ) - ISO.B←A iso2 (case2 x) = case2 x - ISO.iso← iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso← ia x) - ISO.iso← iso2 (case2 x) = refl - ISO.iso→ iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso→ ia x) - ISO.iso→ iso2 (case2 x) = refl - -open import Data.Product - -fin-× : {A B : Set} → { a b : ℕ } → FiniteSet A {a} → FiniteSet B {b} → FiniteSet (A × B) {a * b} -fin-× {A} {B} {a} {b} fa fb with FiniteSet→Fin fa -... | a=f = iso-fin (fin-×-f a ) iso-1 where - iso-1 : ISO (Fin a × B) ( A × B ) - ISO.A←B iso-1 x = ( FiniteSet.F←Q fa (proj₁ x) , proj₂ x) - ISO.B←A iso-1 x = ( FiniteSet.Q←F fa (proj₁ x) , proj₂ x) - ISO.iso← iso-1 x = lemma where - lemma : (FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj₁ x)) , proj₂ x) ≡ ( proj₁ x , proj₂ x ) - lemma = cong ( λ k → ( k , proj₂ x ) ) (FiniteSet.finiso← fa _ ) - ISO.iso→ iso-1 x = cong ( λ k → ( k , proj₂ x ) ) (FiniteSet.finiso→ fa _ ) - - iso-2 : {a : ℕ } → ISO (B ∨ (Fin a × B)) (Fin (suc a) × B) - ISO.A←B iso-2 (zero , b ) = case1 b - ISO.A←B iso-2 (suc fst , b ) = case2 ( fst , b ) - ISO.B←A iso-2 (case1 b) = ( zero , b ) - ISO.B←A iso-2 (case2 (a , b )) = ( suc a , b ) - ISO.iso← iso-2 (case1 x) = refl - ISO.iso← iso-2 (case2 x) = refl - ISO.iso→ iso-2 (zero , b ) = refl - ISO.iso→ iso-2 (suc a , b ) = refl - - fin-×-f : ( a : ℕ ) → FiniteSet ((Fin a) × B) {a * b} - fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () } - fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2 - -open _∧_ - -fin-∧ : {A B : Set} → { a b : ℕ } → FiniteSet A {a} → FiniteSet B {b} → FiniteSet (A ∧ B) {a * b} -fin-∧ {A} {B} {a} {b} fa fb with FiniteSet→Fin fa -- same thing for our tool -... | a=f = iso-fin (fin-×-f a ) iso-1 where - iso-1 : ISO (Fin a ∧ B) ( A ∧ B ) - ISO.A←B iso-1 x = record { proj1 = FiniteSet.F←Q fa (proj1 x) ; proj2 = proj2 x} - ISO.B←A iso-1 x = record { proj1 = FiniteSet.Q←F fa (proj1 x) ; proj2 = proj2 x} - ISO.iso← iso-1 x = lemma where - lemma : record { proj1 = FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj1 x)) ; proj2 = proj2 x} ≡ record {proj1 = proj1 x ; proj2 = proj2 x } - lemma = cong ( λ k → record {proj1 = k ; proj2 = proj2 x } ) (FiniteSet.finiso← fa _ ) - ISO.iso→ iso-1 x = cong ( λ k → record {proj1 = k ; proj2 = proj2 x } ) (FiniteSet.finiso→ fa _ ) - - iso-2 : {a : ℕ } → ISO (B ∨ (Fin a ∧ B)) (Fin (suc a) ∧ B) - ISO.A←B iso-2 (record { proj1 = zero ; proj2 = b }) = case1 b - ISO.A←B iso-2 (record { proj1 = suc fst ; proj2 = b }) = case2 ( record { proj1 = fst ; proj2 = b } ) - ISO.B←A iso-2 (case1 b) = record {proj1 = zero ; proj2 = b } - ISO.B←A iso-2 (case2 (record { proj1 = a ; proj2 = b })) = record { proj1 = suc a ; proj2 = b } - ISO.iso← iso-2 (case1 x) = refl - ISO.iso← iso-2 (case2 x) = refl - ISO.iso→ iso-2 (record { proj1 = zero ; proj2 = b }) = refl - ISO.iso→ iso-2 (record { proj1 = suc a ; proj2 = b }) = refl - - fin-×-f : ( a : ℕ ) → FiniteSet ((Fin a) ∧ B) {a * b} - fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () } - fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2 - -import Data.Nat.DivMod - -open import Data.Vec -import Data.Product - -exp2 : (n : ℕ ) → exp 2 (suc n) ≡ exp 2 n Data.Nat.+ exp 2 n -exp2 n = begin - exp 2 (suc n) - ≡⟨⟩ - 2 * ( exp 2 n ) - ≡⟨ *-comm 2 (exp 2 n) ⟩ - ( exp 2 n ) * 2 - ≡⟨ +-*-suc ( exp 2 n ) 1 ⟩ - (exp 2 n ) Data.Nat.+ ( exp 2 n ) * 1 - ≡⟨ cong ( λ k → (exp 2 n ) Data.Nat.+ k ) (proj₂ *-identity (exp 2 n) ) ⟩ - exp 2 n Data.Nat.+ exp 2 n - ∎ where - open ≡-Reasoning - open Data.Product - -cast-iso : {n m : ℕ } → (eq : n ≡ m ) → (f : Fin m ) → cast eq ( cast (sym eq ) f) ≡ f -cast-iso refl zero = refl -cast-iso refl (suc f) = cong ( λ k → suc k ) ( cast-iso refl f ) - - -fin2List : {n : ℕ } → FiniteSet (Vec Bool n) {exp 2 n } -fin2List {zero} = record { - Q←F = λ _ → Vec.[] - ; F←Q = λ _ → # 0 - ; finiso→ = finiso→ - ; finiso← = finiso← - } where - Q = Vec Bool zero - finiso→ : (q : Q) → [] ≡ q - finiso→ [] = refl - finiso← : (f : Fin (exp 2 zero)) → # 0 ≡ f - finiso← zero = refl -fin2List {suc n} = subst (λ k → FiniteSet (Vec Bool (suc n)) {k} ) (sym (exp2 n)) ( iso-fin (fin-∨ (fin2List {n}) (fin2List {n})) iso ) - where - QtoR : Vec Bool (suc n) → Vec Bool n ∨ Vec Bool n - QtoR ( true ∷ x ) = case1 x - QtoR ( false ∷ x ) = case2 x - RtoQ : Vec Bool n ∨ Vec Bool n → Vec Bool (suc n) - RtoQ ( case1 x ) = true ∷ x - RtoQ ( case2 x ) = false ∷ x - isoRQ : (x : Vec Bool (suc n) ) → RtoQ ( QtoR x ) ≡ x - isoRQ (true ∷ _ ) = refl - isoRQ (false ∷ _ ) = refl - isoQR : (x : Vec Bool n ∨ Vec Bool n ) → QtoR ( RtoQ x ) ≡ x - isoQR (case1 x) = refl - isoQR (case2 x) = refl - iso : ISO (Vec Bool n ∨ Vec Bool n) (Vec Bool (suc n)) - iso = record { A←B = QtoR ; B←A = RtoQ ; iso← = isoQR ; iso→ = isoRQ } - -F2L : {Q : Set } {n m : ℕ } → n < suc m → (fin : FiniteSet Q {m} ) → ( (q : Q) → toℕ (FiniteSet.F←Q fin q ) < n → Bool ) → Vec Bool n -F2L {Q} {zero} fin _ Q→B = [] -F2L {Q} {suc n} (s≤s n<m) fin Q→B = Q→B (FiniteSet.Q←F fin (fromℕ≤ n<m)) lemma6 ∷ F2L {Q} {n} (NatP.<-trans n<m a<sa ) fin qb1 where - lemma6 : toℕ (FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ≤ n<m))) < suc n - lemma6 = subst (λ k → toℕ k < suc n ) (sym (FiniteSet.finiso← fin _ )) (subst (λ k → k < suc n) (sym (toℕ-fromℕ≤ n<m )) a<sa ) - qb1 : (q : Q) → toℕ (FiniteSet.F←Q fin q) < n → Bool - qb1 q q<n = Q→B q (NatP.<-trans q<n a<sa) - -List2Func : { Q : Set } → {n m : ℕ } → n < suc m → FiniteSet Q {m} → Vec Bool n → Q → Bool -List2Func {Q} {zero} (s≤s z≤n) fin [] q = false -List2Func {Q} {suc n} {m} (s≤s n<m) fin (h ∷ t) q with FiniteSet.F←Q fin q ≟ fromℕ≤ n<m -... | yes _ = h -... | no _ = List2Func {Q} {n} {m} (NatP.<-trans n<m a<sa ) fin t q - -F2L-iso : { Q : Set } → {n : ℕ } → (fin : FiniteSet Q {n}) → (x : Vec Bool n ) → F2L a<sa fin (λ q _ → List2Func a<sa fin x q ) ≡ x -F2L-iso {Q} {m} fin x = f2l m a<sa x where - f2l : (n : ℕ ) → (n<m : n < suc m )→ (x : Vec Bool n ) → F2L n<m fin (λ q q<n → List2Func n<m fin x q ) ≡ x - f2l zero (s≤s z≤n) [] = refl - f2l (suc n) (s≤s n<m) (h ∷ t ) = lemma1 lemma2 lemma3 where - lemma1 : {n : ℕ } → {h h1 : Bool } → {t t1 : Vec Bool n } → h ≡ h1 → t ≡ t1 → h ∷ t ≡ h1 ∷ t1 - lemma1 refl refl = refl - lemma2 : List2Func (s≤s n<m) fin (h ∷ t) (FiniteSet.Q←F fin (fromℕ≤ n<m)) ≡ h - lemma2 with FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ≤ n<m)) ≟ fromℕ≤ n<m - lemma2 | yes p = refl - lemma2 | no ¬p = ⊥-elim ( ¬p (FiniteSet.finiso← fin _) ) - lemma4 : (q : Q ) → toℕ (FiniteSet.F←Q fin q ) < n → List2Func (s≤s n<m) fin (h ∷ t) q ≡ List2Func (NatP.<-trans n<m a<sa) fin t q - lemma4 q _ with FiniteSet.F←Q fin q ≟ fromℕ≤ n<m - lemma4 q lt | yes p = ⊥-elim ( nat-≡< (toℕ-fromℕ≤ n<m) (lemma5 n lt (cong (λ k → toℕ k) p))) where - lemma5 : {j k : ℕ } → ( n : ℕ) → suc j ≤ n → j ≡ k → k < n - lemma5 {zero} (suc n) (s≤s z≤n) refl = s≤s z≤n - lemma5 {suc j} (suc n) (s≤s lt) refl = s≤s (lemma5 {j} n lt refl) - lemma4 q _ | no ¬p = refl - lemma3 : F2L (NatP.<-trans n<m a<sa) fin (λ q q<n → List2Func (s≤s n<m) fin (h ∷ t) q ) ≡ t - lemma3 = begin - F2L (NatP.<-trans n<m a<sa) fin (λ q q<n → List2Func (s≤s n<m) fin (h ∷ t) q ) - ≡⟨ cong (λ k → F2L (NatP.<-trans n<m a<sa) fin ( λ q q<n → k q q<n )) - (FiniteSet.f-extensionality fin ( λ q → - (FiniteSet.f-extensionality fin ( λ q<n → lemma4 q q<n )))) ⟩ - F2L (NatP.<-trans n<m a<sa) fin (λ q q<n → List2Func (NatP.<-trans n<m a<sa) fin t q ) - ≡⟨ f2l n (NatP.<-trans n<m a<sa ) t ⟩ - t - ∎ where - open ≡-Reasoning - - -L2F : {Q : Set } {n m : ℕ } → n < suc m → (fin : FiniteSet Q {m} ) → Vec Bool n → (q : Q ) → toℕ (FiniteSet.F←Q fin q ) < n → Bool -L2F n<m fin x q q<n = List2Func n<m fin x q - -L2F-iso : { Q : Set } → {n : ℕ } → (fin : FiniteSet Q {n}) → (f : Q → Bool ) → (q : Q ) → (L2F a<sa fin (F2L a<sa fin (λ q _ → f q) )) q (toℕ<n _) ≡ f q -L2F-iso {Q} {m} fin f q = l2f m a<sa (toℕ<n _) where - lemma11 : {n : ℕ } → (n<m : n < m ) → ¬ ( FiniteSet.F←Q fin q ≡ fromℕ≤ n<m ) → toℕ (FiniteSet.F←Q fin q) ≤ n → toℕ (FiniteSet.F←Q fin q) < n - lemma11 {n} n<m ¬q=n q≤n = lemma13 n<m (contra-position (lemma12 n<m _) ¬q=n ) q≤n where - lemma13 : {n nq : ℕ } → (n<m : n < m ) → ¬ ( nq ≡ n ) → nq ≤ n → nq < n - lemma13 {0} {0} (s≤s z≤n) nt z≤n = ⊥-elim ( nt refl ) - lemma13 {suc _} {0} (s≤s (s≤s n<m)) nt z≤n = s≤s z≤n - lemma13 {suc n} {suc nq} n<m nt (s≤s nq≤n) = s≤s (lemma13 {n} {nq} (NatP.<-trans a<sa n<m ) (λ eq → nt ( cong ( λ k → suc k ) eq )) nq≤n) - lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ≤ (s≤s lt) ≡ suc (fromℕ≤ lt) - lemma3 (s≤s lt) = refl - lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m ) → toℕ f ≡ n → f ≡ fromℕ≤ n<m - lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl - lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl = subst ( λ k → suc f ≡ k ) (sym (lemma3 n<m) ) ( cong ( λ k → suc k ) ( lemma12 {n} {m} n<m f refl ) ) - l2f : (n : ℕ ) → (n<m : n < suc m ) → (q<n : toℕ (FiniteSet.F←Q fin q ) < n ) → (L2F n<m fin (F2L n<m fin (λ q _ → f q))) q q<n ≡ f q - l2f zero (s≤s z≤n) () - l2f (suc n) (s≤s n<m) (s≤s n<q) with FiniteSet.F←Q fin q ≟ fromℕ≤ n<m - l2f (suc n) (s≤s n<m) (s≤s n<q) | yes p = begin - f (FiniteSet.Q←F fin (fromℕ≤ n<m)) - ≡⟨ cong ( λ k → f (FiniteSet.Q←F fin k )) (sym p) ⟩ - f (FiniteSet.Q←F fin ( FiniteSet.F←Q fin q )) - ≡⟨ cong ( λ k → f k ) (FiniteSet.finiso→ fin _ ) ⟩ - f q - ∎ where - open ≡-Reasoning - l2f (suc n) (s≤s n<m) (s≤s n<q) | no ¬p = l2f n (NatP.<-trans n<m a<sa) (lemma11 n<m ¬p n<q) - -fin→ : {A : Set} → { a : ℕ } → FiniteSet A {a} → FiniteSet (A → Bool ) {exp 2 a} -fin→ {A} {a} fin = iso-fin fin2List iso where - iso : ISO (Vec Bool a ) (A → Bool) - ISO.A←B iso x = F2L a<sa fin ( λ q _ → x q ) - ISO.B←A iso x = List2Func a<sa fin x - ISO.iso← iso x = F2L-iso fin x - ISO.iso→ iso x = lemma where - lemma : List2Func a<sa fin (F2L a<sa fin (λ q _ → x q)) ≡ x - lemma = FiniteSet.f-extensionality fin ( λ q → L2F-iso fin x q ) - - -Fin2Finite : ( n : ℕ ) → FiniteSet (Fin n) {n} -Fin2Finite n = record { F←Q = λ x → x ; Q←F = λ x → x ; finiso← = λ q → refl ; finiso→ = λ q → refl } - -data fin-less { n m : ℕ } { A : Set } (n<m : n < m ) (fa : FiniteSet A {m}) : Set where - elm1 : (elm : A ) → toℕ (FiniteSet.F←Q fa elm ) < n → fin-less n<m fa - -get-elm : { n m : ℕ } {n<m : n < m } { A : Set } {fa : FiniteSet A {m}} → fin-less n<m fa → A -get-elm (elm1 a _ ) = a - -get-< : { n m : ℕ } {n<m : n < m } { A : Set } {fa : FiniteSet A {m}} → (f : fin-less n<m fa ) → toℕ (FiniteSet.F←Q fa (get-elm f )) < n -get-< (elm1 _ b ) = b - -fin-less-cong : { n m : ℕ } (n<m : n < m ) { A : Set } (fa : FiniteSet A {m}) - → (x y : fin-less n<m fa ) → get-elm {n} {m} {n<m} {A} {fa} x ≡ get-elm {n} {m} {n<m} {A} {fa} y → get-< x ≅ get-< y → x ≡ y -fin-less-cong n<m fa (elm1 elm x) (elm1 elm x) refl HE.refl = refl - -fin-< : {A : Set} → { n m : ℕ } → (n<m : n < m ) → (fa : FiniteSet A {m}) → FiniteSet (fin-less n<m fa) {n} -fin-< {A} {n} {m} n<m fa = iso-fin (Fin2Finite n) iso where - iso : ISO (Fin n) (fin-less n<m fa) - lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n - lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl - lemma8 {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8 {i} {i} {n} refl ) - lemma10 : {n i j : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → fromℕ≤ i<n ≡ fromℕ≤ j<n - lemma10 {n} refl = HE.≅-to-≡ (HE.cong (λ k → fromℕ≤ k ) (lemma8 refl )) - lemma3 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c - lemma3 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl) - lemma11 : {n m : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ≤ (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x - lemma11 {n} {m} {x} n<m = begin - toℕ (fromℕ≤ (NatP.<-trans (toℕ<n x) n<m)) - ≡⟨ toℕ-fromℕ≤ _ ⟩ - toℕ x - ∎ where - open ≡-Reasoning - ISO.A←B iso (elm1 elm x) = fromℕ≤ x - ISO.B←A iso x = elm1 (FiniteSet.Q←F fa (fromℕ≤ (NatP.<-trans x<n n<m ))) to<n where - x<n : toℕ x < n - x<n = toℕ<n x - to<n : toℕ (FiniteSet.F←Q fa (FiniteSet.Q←F fa (fromℕ≤ (NatP.<-trans x<n n<m)))) < n - to<n = subst (λ k → toℕ k < n ) (sym (FiniteSet.finiso← fa _ )) (subst (λ k → k < n ) (sym ( toℕ-fromℕ≤ (NatP.<-trans x<n n<m) )) x<n ) - ISO.iso← iso x = lemma2 where - lemma2 : fromℕ≤ (subst (λ k → toℕ k < n) (sym - (FiniteSet.finiso← fa (fromℕ≤ (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n) - (sym (toℕ-fromℕ≤ (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) ≡ x - lemma2 = begin - fromℕ≤ (subst (λ k → toℕ k < n) (sym - (FiniteSet.finiso← fa (fromℕ≤ (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n) - (sym (toℕ-fromℕ≤ (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) - ≡⟨⟩ - fromℕ≤ ( subst (λ k → toℕ ( k ) < n ) (sym (FiniteSet.finiso← fa _ )) lemma6 ) - ≡⟨ lemma10 (cong (λ k → toℕ k) (FiniteSet.finiso← fa _ ) ) ⟩ - fromℕ≤ lemma6 - ≡⟨ lemma10 (lemma11 n<m ) ⟩ - fromℕ≤ ( toℕ<n x ) - ≡⟨ fromℕ≤-toℕ _ _ ⟩ - x - ∎ where - open ≡-Reasoning - lemma6 : toℕ (fromℕ≤ (NatP.<-trans (toℕ<n x) n<m)) < n - lemma6 = subst ( λ k → k < n ) (sym (toℕ-fromℕ≤ (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x ) - ISO.iso→ iso (elm1 elm x) = fin-less-cong n<m fa _ _ lemma (lemma8 (cong (λ k → toℕ (FiniteSet.F←Q fa k) ) lemma ) ) where - lemma13 : toℕ (fromℕ≤ x) ≡ toℕ (FiniteSet.F←Q fa elm) - lemma13 = begin - toℕ (fromℕ≤ x) - ≡⟨ toℕ-fromℕ≤ _ ⟩ - toℕ (FiniteSet.F←Q fa elm) - ∎ where open ≡-Reasoning - lemma : FiniteSet.Q←F fa (fromℕ≤ (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m)) ≡ elm - lemma = begin - FiniteSet.Q←F fa (fromℕ≤ (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m)) - ≡⟨⟩ - FiniteSet.Q←F fa (fromℕ≤ ( NatP.<-trans (toℕ<n ( fromℕ≤ x ) ) n<m)) - ≡⟨ cong (λ k → FiniteSet.Q←F fa k) (lemma10 lemma13 ) ⟩ - FiniteSet.Q←F fa (fromℕ≤ ( NatP.<-trans x n<m)) - ≡⟨ cong (λ k → FiniteSet.Q←F fa (fromℕ≤ k )) lemma3 ⟩ - FiniteSet.Q←F fa (fromℕ≤ ( toℕ<n (FiniteSet.F←Q fa elm))) - ≡⟨ cong (λ k → FiniteSet.Q←F fa k ) ( fromℕ≤-toℕ _ _ ) ⟩ - FiniteSet.Q←F fa (FiniteSet.F←Q fa elm ) - ≡⟨ FiniteSet.finiso→ fa _ ⟩ - elm - ∎ where open ≡-Reasoning - -
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/halt.agda Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,102 @@ +module halt where + +open import Level renaming ( zero to Zero ; suc to Suc ) +open import Data.Nat +open import Data.List hiding ([_]) +open import Data.Nat.Properties +open import Relation.Nullary +open import Data.Empty +open import Data.Unit +open import Relation.Binary.Core +open import Relation.Binary.Definitions +open import Relation.Binary.PropositionalEquality + +open import logic + +record Bijection {n m : Level} (R : Set n) (S : Set m) : Set (n Level.⊔ m) where + field + fun← : S → R + fun→ : R → S + fiso← : (x : R) → fun← ( fun→ x ) ≡ x + fiso→ : (x : S ) → fun→ ( fun← x ) ≡ x + +open Bijection + +diagonal : ¬ Bijection ( ℕ → Bool ) ℕ +diagonal b = diagn1 (fun→ b diag) refl where + diag : ℕ → Bool + diag n = not (fun← b n n) + diagn1 : (n : ℕ ) → ¬ (fun→ b diag ≡ n ) + diagn1 n dn = ¬t=f (diag n ) ( begin + not diag n + ≡⟨⟩ + not (not fun← b n n) + ≡⟨ cong (λ k → not (k n) ) (sym (fiso← b _)) ⟩ + not (fun← b (fun→ b diag) n) + ≡⟨ cong (λ k → not (fun← b k n) ) dn ⟩ + not (fun← b n n) + ≡⟨⟩ + diag n + ∎ ) where open ≡-Reasoning + +to1 : {n : Level} {R : Set n} → Bijection ℕ R → Bijection ℕ (⊤ ∨ R ) +to1 {n} {R} b = record { + fun← = to11 + ; fun→ = to12 + ; fiso← = to13 + ; fiso→ = to14 + } where + to11 : ⊤ ∨ R → ℕ + to11 (case1 tt) = 0 + to11 (case2 x) = suc ( fun← b x ) + to12 : ℕ → ⊤ ∨ R + to12 zero = case1 tt + to12 (suc n) = case2 ( fun→ b n) + to13 : (x : ℕ) → to11 (to12 x) ≡ x + to13 zero = refl + to13 (suc x) = cong suc (fiso← b x) + to14 : (x : ⊤ ∨ R) → to12 (to11 x) ≡ x + to14 (case1 x) = refl + to14 (case2 x) = cong case2 (fiso→ b x) + +open _∧_ + +-- [] case1 +-- 0 → case2 10 +-- 0111 → case2 10111 +-- +LBℕ : Bijection ( List Bool ) ℕ +LBℕ = {!!} + +postulate + utm : List Bool → List Bool → Bool + +open import Axiom.Extensionality.Propositional +postulate f-extensionality : { n : Level} → Axiom.Extensionality.Propositional.Extensionality n n +open import Relation.Binary.HeterogeneousEquality as HE using (_≅_;refl ) renaming ( sym to ≅-sym ; trans to ≅-trans ; cong to ≅-cong ) + +record TM : Set where + field + tm : List Bool → Bool + encode : List Bool + is-tm : utm encode ≡ tm + +open TM + +tm-cong : {x y : TM} → tm x ≡ tm y → encode x ≡ encode y → is-tm x ≅ is-tm y → x ≡ y +tm-cong refl refl refl = refl + +tm-bij : Bijection TM (List Bool) +tm-bij = record { + fun← = λ x → record { tm = utm x ; encode = x ; is-tm = refl } + ; fun→ = λ tm → encode tm + ; fiso← = tmb1 + ; fiso→ = λ x → refl + } where + tmb1 : (x : TM ) → record { tm = utm (encode x) ; encode = encode x ; is-tm = refl } ≡ x + tmb1 x with is-tm x | inspect is-tm x + ... | refl | record { eq = refl } = tm-cong (is-tm x) refl refl + +halting : (halt : TM → List Bool → Bool ) → (z : TM) → ¬ ((x : TM) → tm z ≡ (λ y → halt x y ) ) +halting halt z halting = {!!} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/index.ind Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,29 @@ +<a href="automaton-text.agda"> automaton-text.agda </a><br> +<a href="automaton.agda"> automaton.agda </a><br> +<a href="cfg.agda"> cfg.agda </a><br> +<a href="cfg1.agda"> cfg1.agda </a><br> +<a href="chap0.agda"> chap0.agda </a><br> +<a href="derive.agda"> derive.agda </a><br> +<a href="epautomaton.agda"> epautomaton.agda </a><br> +<a href="finiteSet.agda"> finiteSet.agda </a><br> +<a href="flcagl.agda"> flcagl.agda </a><br> +<a href="induction-ex.agda"> induction-ex.agda </a><br> +<a href="lang-text.agda"> lang-text.agda </a><br> +<a href="logic.agda"> logic.agda </a><br> +<a href="nat.agda"> nat.agda </a><br> +<a href="nfa-list.agda"> nfa-list.agda </a><br> +<a href="nfa.agda"> nfa.agda </a><br> +<a href="nfa136.agda"> nfa136.agda </a><br> +<a href="omega-automaton.agda"> omega-automaton.agda </a><br> +<a href="pushdown.agda"> pushdown.agda </a><br> +<a href="puzzle.agda"> puzzle.agda </a><br> +<a href="regex.agda"> regex.agda </a><br> +<a href="regex1.agda"> regex1.agda </a><br> +<a href="regop.agda"> regop.agda </a><br> +<a href="regular-language.agda"> regular-language.agda </a><br> +<a href="root2.agda"> root2.agda </a><br> +<a href="sbconst.agda"> sbconst.agda </a><br> +<a href="sbconst1.agda"> sbconst1.agda </a><br> +<a href="sbconst2.agda"> sbconst2.agda </a><br> +<a href="turing.agda"> turing.agda </a><br> +<a href="utm.agda"> utm.agda </a><br>
--- a/agda/induction.agda Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -module induction where
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/lang-text.agda Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,54 @@ +module lang-text where + +open import Data.List +open import Data.String +open import Data.Char +open import Data.Char.Unsafe +open import Relation.Binary.PropositionalEquality +open import Relation.Nullary +open import logic + +split : {Σ : Set} → (List Σ → Bool) + → ( List Σ → Bool) → List Σ → Bool +split x y [] = x [] /\ y [] +split x y (h ∷ t) = (x [] /\ y (h ∷ t)) \/ + split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t + +contains : String → String → Bool +contains x y = contains1 (toList x ) ( toList y ) where + contains1 : List Char → List Char → Bool + contains1 [] [] = false + contains1 [] ( cx ∷ ly ) = false + contains1 (cx ∷ lx) [] = true + contains1 (cx ∷ lx ) ( cy ∷ ly ) with cx ≟ cy + ... | yes refl = contains1 lx ly + ... | no n = false + +-- w does not contain the substring ab +ex15a : Set +ex15a = (w : String ) → ¬ (contains w "ab" ≡ true ) + +-- w does not contains substring baba +ex15b : Set +ex15b = (w : String ) → ¬ (contains w "baba" ≡ true ) + +-- w contains neither the substing ab nor ba +ex15c : Set + +-- w is any string not in a*b* +ex15c = (w : String ) → ( ¬ (contains w "ab" ≡ true ) /\ ( ¬ (contains w "ba" ≡ true ) + +ex15d : {!!} +ex15d = {!!} + +ex15e : {!!} +ex15e = {!!} + +ex15f : {!!} +ex15f = {!!} + +ex15g : {!!} +ex15g = {!!} + +ex15h : {!!} +ex15h = {!!}
--- a/agda/logic.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/logic.agda Sun Dec 27 13:26:44 2020 +0900 @@ -2,7 +2,7 @@ open import Level open import Relation.Nullary -open import Relation.Binary +open import Relation.Binary hiding (_⇔_ ) open import Data.Empty @@ -11,6 +11,7 @@ false : Bool record _∧_ {n m : Level} (A : Set n) ( B : Set m ) : Set (n ⊔ m) where + constructor ⟪_,_⟫ field proj1 : A proj2 : B @@ -65,11 +66,15 @@ false <=> false = true _ <=> _ = false +open import Relation.Binary.PropositionalEquality + +¬t=f : (t : Bool ) → ¬ ( not t ≡ t) +¬t=f true () +¬t=f false () + infixr 130 _\/_ infixr 140 _/\_ -open import Relation.Binary.PropositionalEquality - ≡-Bool-func : {A B : Bool } → ( A ≡ true → B ≡ true ) → ( B ≡ true → A ≡ true ) → A ≡ B ≡-Bool-func {true} {true} a→b b→a = refl ≡-Bool-func {false} {true} a→b b→a with b→a refl
--- a/agda/nat.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/nat.agda Sun Dec 27 13:26:44 2020 +0900 @@ -180,6 +180,8 @@ minus>0 {zero} {suc _} (s≤s z≤n) = s≤s z≤n minus>0 {suc x} {suc y} (s≤s lt) = minus>0 {x} {y} lt +open import Relation.Binary.Definitions + distr-minus-* : {x y z : ℕ } → (minus x y) * z ≡ minus (x * z) (y * z) distr-minus-* {x} {zero} {z} = refl distr-minus-* {x} {suc y} {z} with <-cmp x y
--- a/agda/nfa-list.agda Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,95 +0,0 @@ -module nfa-list where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.List -open import Data.Maybe -open import Data.Bool using ( Bool ; true ; false ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) - -data States1 : Set where - sr : States1 - ss : States1 - st : States1 - -data In2 : Set where - i0 : In2 - i1 : In2 - -transition1 : States1 → In2 → States1 -transition1 sr i0 = sr -transition1 sr i1 = ss -transition1 ss i0 = sr -transition1 ss i1 = st -transition1 st i0 = sr -transition1 st i1 = st - -fin1 : States1 → Bool -fin1 st = true -fin1 _ = false - -s1id : States1 → ℕ -s1id sr = 0 -s1id ss = 1 -s1id st = 2 - -record NAutomaton ( Q : Set ) ( Σ : Set ) - : Set where - field - nδ : Q → Σ → List Q - sid : Q → ℕ - nstart : Q - nend : Q → Bool - -open NAutomaton - -insert : { Q : Set } { Σ : Set } → ( NAutomaton Q Σ ) → List Q → Q → List Q -insert M [] q = q ∷ [] -insert M ( q ∷ T ) q' with (sid M q ) ≟ (sid M q') -... | yes _ = insert M T q' -... | no _ = q ∷ (insert M T q' ) - -merge : { Q : Set } { Σ : Set } → ( NAutomaton Q Σ ) → List Q → List Q → List Q -merge M L1 [] = L1 -merge M L1 ( H ∷ L ) = insert M (merge M L1 L ) H - -Nmoves : { Q : Set } { Σ : Set } - → NAutomaton Q Σ - → List Q → List Σ → List Q -Nmoves {Q} { Σ} M q L = Nmoves1 q L [] - where - Nmoves1 : (q : List Q ) ( L : List Σ ) → List Q → List Q - Nmoves1 q [] _ = q - Nmoves1 [] (_ ∷ L) LQ = Nmoves1 LQ L [] - Nmoves1 (q ∷ T ) (H ∷ L) LQ = Nmoves1 T (H ∷ L) ( merge M ( nδ M q H ) LQ ) - - -Naccept : { Q : Set } { Σ : Set } - → NAutomaton Q Σ - → List Σ → Bool -Naccept {Q} { Σ} M L = - checkAccept ( Nmoves M ((nstart M) ∷ [] ) L ) - where - checkAccept : (q : List Q ) → Bool - checkAccept [] = false - checkAccept ( H ∷ L ) with (nend M) H - ... | true = true - ... | false = checkAccept L - - -transition2 : States1 → In2 → List States1 -transition2 sr i0 = (sr ∷ []) -transition2 sr i1 = (ss ∷ sr ∷ [] ) -transition2 ss i0 = (sr ∷ []) -transition2 ss i1 = (st ∷ []) -transition2 st i0 = (sr ∷ []) -transition2 st i1 = (st ∷ []) - -am2 : NAutomaton States1 In2 -am2 = record { nδ = transition2 ; sid = s1id ; nstart = sr ; nend = fin1} - - -example2-1 = Naccept am2 ( i0 ∷ i1 ∷ i0 ∷ [] ) -example2-2 = Naccept am2 ( i1 ∷ i1 ∷ i1 ∷ [] ) -
--- a/agda/nfa.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/nfa.agda Sun Dec 27 13:26:44 2020 +0900 @@ -1,3 +1,4 @@ +{-# OPTIONS --allow-unsolved-metas #-} module nfa where -- open import Level renaming ( suc to succ ; zero to Zero ) @@ -10,7 +11,6 @@ -- open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) open import Relation.Binary.PropositionalEquality hiding ( [_] ) open import Relation.Nullary using (¬_; Dec; yes; no) -open import finiteSet open import logic data States1 : Set where @@ -31,48 +31,45 @@ open NAutomaton -finState1 : FiniteSet States1 -finState1 = record { - Q←F = Q←F - ; F←Q = F←Q - ; finiso→ = finiso→ - ; finiso← = finiso← - } where - Q←F : Fin 3 → States1 - Q←F zero = sr - Q←F (suc zero) = ss - Q←F (suc (suc zero)) = st - F←Q : States1 → Fin 3 - F←Q sr = zero - F←Q ss = suc zero - F←Q st = suc (suc zero) - finiso→ : (q : States1) → Q←F (F←Q q) ≡ q - finiso→ sr = refl - finiso→ ss = refl - finiso→ st = refl - finiso← : (f : Fin 3) → F←Q (Q←F f) ≡ f - finiso← zero = refl - finiso← (suc zero) = refl - finiso← (suc (suc zero)) = refl - finiso← (suc (suc (suc ()))) +LStates1 : List States1 +LStates1 = sr ∷ ss ∷ st ∷ [] + +-- one of qs q is true +existsS1 : ( States1 → Bool ) → Bool +existsS1 qs = qs sr \/ qs ss \/ qs st - -open FiniteSet +-- extract list of q which qs q is true +to-listS1 : ( States1 → Bool ) → List States1 +to-listS1 qs = ss1 LStates1 where + ss1 : List States1 → List States1 + ss1 [] = [] + ss1 (x ∷ t) with qs x + ... | true = x ∷ ss1 t + ... | false = ss1 t Nmoves : { Q : Set } { Σ : Set } → NAutomaton Q Σ - → {n : ℕ } → FiniteSet Q {n} + → (exists : ( Q → Bool ) → Bool) → ( Qs : Q → Bool ) → (s : Σ ) → Q → Bool -Nmoves {Q} { Σ} M fin Qs s q = - exists fin ( λ qn → (Qs qn /\ ( Nδ M qn s q ) )) - +Nmoves {Q} { Σ} M exists Qs s q = + exists ( λ qn → (Qs qn /\ ( Nδ M qn s q ) )) Naccept : { Q : Set } { Σ : Set } → NAutomaton Q Σ - → {n : ℕ } → FiniteSet Q {n} + → (exists : ( Q → Bool ) → Bool) → (Nstart : Q → Bool) → List Σ → Bool -Naccept M fin sb [] = exists fin ( λ q → sb q /\ Nend M q ) -Naccept M fin sb (i ∷ t ) = Naccept M fin ( Nmoves M fin sb i ) t +Naccept M exists sb [] = exists ( λ q → sb q /\ Nend M q ) +Naccept M exists sb (i ∷ t ) = Naccept M exists (λ q → exists ( λ qn → (sb qn /\ ( Nδ M qn i q ) ))) t + +Ntrace : { Q : Set } { Σ : Set } + → NAutomaton Q Σ + → (exists : ( Q → Bool ) → Bool) + → (to-list : ( Q → Bool ) → List Q ) + → (Nstart : Q → Bool) → List Σ → List (List Q) +Ntrace M exists to-list sb [] = to-list ( λ q → sb q /\ Nend M q ) ∷ [] +Ntrace M exists to-list sb (i ∷ t ) = + to-list (λ q → sb q ) ∷ + Ntrace M exists to-list (λ q → exists ( λ qn → (sb qn /\ ( Nδ M qn i q ) ))) t transition3 : States1 → In2 → States1 → Bool @@ -90,6 +87,9 @@ fin1 ss = false fin1 sr = false +test5 = existsS1 (λ q → fin1 q ) +test6 = to-listS1 (λ q → fin1 q ) + start1 : States1 → Bool start1 sr = true start1 _ = false @@ -97,8 +97,12 @@ am2 : NAutomaton States1 In2 am2 = record { Nδ = transition3 ; Nend = fin1} -example2-1 = Naccept am2 finState1 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) -example2-2 = Naccept am2 finState1 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) +example2-1 = Naccept am2 existsS1 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) +example2-2 = Naccept am2 existsS1 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) + +t-1 : List ( List States1 ) +t-1 = Ntrace am2 existsS1 to-listS1 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) +t-2 = Ntrace am2 existsS1 to-listS1 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) transition4 : States1 → In2 → States1 → Bool transition4 sr i0 sr = true @@ -121,8 +125,8 @@ am4 : NAutomaton States1 In2 am4 = record { Nδ = transition4 ; Nend = fin4} -example4-1 = Naccept am4 finState1 start4 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) -example4-2 = Naccept am4 finState1 start4 ( i0 ∷ i1 ∷ i1 ∷ i1 ∷ [] ) +example4-1 = Naccept am4 existsS1 start4 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) +example4-2 = Naccept am4 existsS1 start4 ( i0 ∷ i1 ∷ i1 ∷ i1 ∷ [] ) fin0 : States1 → Bool fin0 st = false @@ -130,27 +134,19 @@ fin0 sr = false test0 : Bool -test0 = exists finState1 fin0 +test0 = existsS1 fin0 test1 : Bool -test1 = exists finState1 fin1 - -test2 = Nmoves am2 finState1 start1 +test1 = existsS1 fin1 --- test4 : Fin 2 → Bool --- test4 zero = {!!} --- test4 (suc zero) = {!!} --- test4 (suc (suc ())) +test2 = Nmoves am2 existsS1 start1 + +open import automaton --- 0011 --- 00000111111 -inputnn : { n : ℕ } → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ -inputnn {zero} {_} _ _ s = s -inputnn {suc n} x y s = x ∷ ( inputnn {n} x y ( y ∷ s ) ) +am2def : Automaton (States1 → Bool ) In2 +am2def = record { δ = λ qs s q → existsS1 (λ qn → qs q /\ Nδ am2 q s qn ) + ; aend = λ qs → existsS1 (λ q → qs q /\ Nend am2 q) } --- lemmaNN : { Q : Set } { Σ : Set } → ( x y : Σ ) → (M : NAutomaton Q Σ) --- → ( n : ℕ ) → (fin : FiniteSet Q {n} ) --- → Naccept M fin ( inputnn {n} x y [] ) ≡ true --- → Naccept M fin ( inputnn {suc n} x y [] ) ≡ false --- lemmaNN {Q} {Σ} x y M n fin nac = {!!} +dexample4-1 = accept am2def start1 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) +texample4-1 = trace am2def start1 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] )
--- a/agda/nfa136.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/nfa136.agda Sun Dec 27 13:26:44 2020 +0900 @@ -2,7 +2,7 @@ open import logic open import nfa -open import automaton hiding ( StatesQ ) +open import automaton open import Data.List open import finiteSet open import Data.Fin @@ -59,35 +59,55 @@ start136 q1 = true start136 _ = false +exists136 : (StatesQ → Bool) → Bool +exists136 f = f q1 \/ f q2 \/ f q3 + +to-list-136 : (StatesQ → Bool) → List StatesQ +to-list-136 f = tl1 where + tl3 : List StatesQ + tl3 with f q3 + ... | true = q3 ∷ [] + ... | false = [] + tl2 : List StatesQ + tl2 with f q2 + ... | true = q2 ∷ tl3 + ... | false = tl3 + tl1 : List StatesQ + tl1 with f q1 + ... | true = q1 ∷ tl2 + ... | false = tl2 + nfa136 : NAutomaton StatesQ A2 nfa136 = record { Nδ = transition136; Nend = end136 } -example136-1 = Naccept nfa136 finStateQ start136( a0 ∷ b0 ∷ a0 ∷ a0 ∷ [] ) +example136-1 = Naccept nfa136 exists136 start136( a0 ∷ b0 ∷ a0 ∷ a0 ∷ [] ) + +t146-1 = Ntrace nfa136 exists136 to-list-136 start136( a0 ∷ b0 ∷ a0 ∷ a0 ∷ [] ) -example136-0 = Naccept nfa136 finStateQ start136( a0 ∷ [] ) +example136-0 = Naccept nfa136 exists136 start136( a0 ∷ [] ) -example136-2 = Naccept nfa136 finStateQ start136( b0 ∷ a0 ∷ b0 ∷ a0 ∷ b0 ∷ [] ) +example136-2 = Naccept nfa136 exists136 start136( b0 ∷ a0 ∷ b0 ∷ a0 ∷ b0 ∷ [] ) +t146-2 = Ntrace nfa136 exists136 to-list-136 start136( b0 ∷ a0 ∷ b0 ∷ a0 ∷ b0 ∷ [] ) open FiniteSet nx : (StatesQ → Bool) → (List A2 ) → StatesQ → Bool nx now [] = now -nx now ( i ∷ ni ) = (Nmoves nfa136 finStateQ (nx now ni) i ) +nx now ( i ∷ ni ) = (Nmoves nfa136 exists136 (nx now ni) i ) -example136-3 = to-list finStateQ start136 -example136-4 = to-list finStateQ (nx start136 ( a0 ∷ b0 ∷ a0 ∷ [] )) +example136-3 = to-list-136 start136 +example136-4 = to-list-136 (nx start136 ( a0 ∷ b0 ∷ a0 ∷ [] )) open import sbconst2 fm136 : Automaton ( StatesQ → Bool ) A2 --- fm136 = record { δ = λ qs q → transition136 {!!} {!!} ; aend = λ qs → exists finStateQ end136 } -fm136 = subset-construction finStateQ nfa136 q1 +fm136 = subset-construction exists136 nfa136 open NAutomaton -lemma136 : ( x : List A2 ) → Naccept nfa136 finStateQ start136 x ≡ accept fm136 start136 x +lemma136 : ( x : List A2 ) → Naccept nfa136 exists136 start136 x ≡ accept fm136 start136 x lemma136 x = lemma136-1 x start136 where lemma136-1 : ( x : List A2 ) → ( states : StatesQ → Bool ) - → Naccept nfa136 finStateQ states x ≡ accept fm136 states x + → Naccept nfa136 exists136 states x ≡ accept fm136 states x lemma136-1 [] _ = refl - lemma136-1 (h ∷ t) states = lemma136-1 t (δconv finStateQ (Nδ nfa136) states h) + lemma136-1 (h ∷ t) states = lemma136-1 t (δconv exists136 (Nδ nfa136) states h)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/non-regular.agda Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,20 @@ +module non-regular where + +open import Data.Nat +open import Data.List +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import logic +open import automaton +open import finiteSet +open import Relation.Nullary + +inputnn : ( n : ℕ ) → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ +inputnn zero {_} _ _ s = s +inputnn (suc n) x y s = x ∷ ( inputnn n x y ( y ∷ s ) ) + +lemmaNN : { Q : Set } { Σ : Set } → ( x y : Σ ) → ¬ (x ≡ y) + → FiniteSet Q + → (M : Automaton Q Σ) (q : Q) + → ¬ ( (n : ℕ) → accept M q ( inputnn n x y [] ) ≡ true ) +lemmaNN = {!!} +
--- a/agda/omega-automaton.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/omega-automaton.agda Sun Dec 27 13:26:44 2020 +0900 @@ -6,7 +6,7 @@ open import Data.Maybe -- open import Data.Bool using ( Bool ; true ; false ; _∧_ ) renaming ( not to negate ) open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (not_; Dec; yes; no) +open import Relation.Nullary -- using (not_; Dec; yes; no) open import Data.Empty open import logic @@ -102,7 +102,7 @@ record flipProperty : Set where field - flipP : (n : ℕ) → ω-run ωa2 (suc (suc n)) flip-seq ≡ ω-run ωa2 n flip-seq + flipP : (n : ℕ) → ω-run ωa2 ? flip-seq ≡ ω-run ωa2 n flip-seq lemma2 : Muller ωa2 flip-seq lemma2 = record {
--- a/agda/pushdown.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/pushdown.agda Sun Dec 27 13:26:44 2020 +0900 @@ -93,3 +93,12 @@ test5 = PushDownAutomaton.paccept pn1 ss ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ [] ) [] test6 = PushDownAutomaton.paccept pn1 ss ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) [] + +test7 : (n : ℕ ) → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 []) [] ≡ true +test7 zero = refl +test7 (suc n) with test7 n +... | t = test7lem [] t where + test7lem : (x : List States0) → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 []) x ≡ true + → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 (i1 ∷ [])) (sr ∷ x) ≡ true + test7lem x with PushDownAutomaton.paccept pnn sr (inputnn (suc n) i0 i1 []) (sr ∷ x) + ... | t2 = {!!}
--- a/agda/regex.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/regex.agda Sun Dec 27 13:26:44 2020 +0900 @@ -1,147 +1,14 @@ module regex where -open import Level renaming ( suc to succ ; zero to Zero ) --- open import Data.Fin -open import Data.Nat -open import Data.Product --- open import Data.List -open import Data.Maybe -open import Data.Bool using ( Bool ; true ; false ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) - - -data Regex ( Σ : Set ) : Set where - _* : Regex Σ → Regex Σ - _&_ : Regex Σ → Regex Σ → Regex Σ - _||_ : Regex Σ → Regex Σ → Regex Σ - <_> : Σ → Regex Σ - - --- data In2 : Set where --- a : In2 --- b : In2 - -open import automaton -open import epautomaton - +data Regex ( Σ : Set) : Set where + ε : Regex Σ -- empty + φ : Regex Σ -- fail + _* : Regex Σ → Regex Σ + _&_ : Regex Σ → Regex Σ → Regex Σ + _||_ : Regex Σ → Regex Σ → Regex Σ + <_> : Σ → Regex Σ -record RST ( Σ : Set ) - : Set where - inductive - field - state : ℕ - move : Maybe Σ → Tree (RST Σ) - cond : Maybe Σ - RSTend : Bool - -open RST - -record RNFA ( Σ : Set ) - : Set where - field - Rstates : Tree ( RST Σ ) - Rstart : RST Σ - Rend : RST Σ - Rnum : ℕ - -open RNFA - -[_] : { Σ : Set} → RST Σ → Tree (RST Σ ) -[ x ] = leaf ( state x ) x - -[] : { Σ : Set} → Tree (RST Σ ) -[] = empty +infixr 40 _&_ _||_ -infixr 5 _++_ -_++_ : { Q : Set} → Tree Q → Tree Q → Tree Q -empty ++ t = t -leaf n e ++ t = insertT n e t -node n e left right ++ t = - left ++ ( insertT n e (right ++ t ) ) - -generateRNFA : { Σ : Set } → ( Regex Σ ) → (_≟_ : ( q q' : Σ ) → Dec ( q ≡ q' ) ) → RNFA Σ -generateRNFA {Σ} regex _≟_ = generate regex ( - record { Rstates = [] ; Rstart = record { state = 0 ; move = λ q → [] ; cond = nothing ; RSTend = true } ; - Rend = record { state = 0 ; move = λ q → [] ; cond = nothing ; RSTend = true } ; Rnum = 1 } ) - where - literal : Maybe Σ → Σ → ℕ → Tree (RST Σ) - literal nothing q' n = [] - literal (just q) q' n with q ≟ q' - ... | yes _ = [ record { state = n ; move = λ i → empty ; cond = nothing ; RSTend = true } ] - ... | no _ = [] - generate : ( Regex Σ ) → RNFA Σ → RNFA Σ - generate (x *) R = record R' { Rstart = record (Rstart R') { move = move0 } ; - Rend = record (Rend R') { move = move1 } } - where - R' : RNFA Σ - R' = generate x R - move0 : Maybe Σ → Tree (RST Σ) - move0 (just x) = move (Rstart R') (just x ) - move0 nothing = move (Rstart R') nothing ++ [ Rend R' ] - move1 : Maybe Σ → Tree (RST Σ) - move1 (just x) = move (Rstart R') (just x ) - move1 nothing = move (Rstart R') nothing ++ [ Rstart R' ] ++ [ Rend R' ] - generate (x & y) R = record R1 { Rend = Rend R2 ; - Rstates = Rstates R1 ++ [ Rend R1 ] ++ [ Rstart R2 ] ++ Rstates R2 } - where - R2 : RNFA Σ - R2 = generate y R - R1 : RNFA Σ - R1 = generate x ( record R2 { Rstart = Rstart R2 ; Rend = Rstart R2 } ) - generate (x || y) R = record R1 { Rstart = Rstart R1 ; Rend = Rend R2 ; - Rstates = [ Rstart R1 ] ++ Rstates R1 ++ [ Rend R1 ] ++ [ Rstart R2 ] ++ Rstates R2 ++ [ Rend R2 ] } - where - R1 : RNFA Σ - R1 = generate x ( record R { Rnum = Rnum R + 1 } ) - S1 : RST Σ - S1 = record { state = Rnum R ; RSTend = RSTend (Rend R) ; move = λ q → [] ; cond = nothing } - R2 : RNFA Σ - R2 = generate y ( record R1 { Rstart = S1 ; Rend = S1 } ) - move0 : Maybe Σ → Tree (RST Σ) - move0 (just x) = move (Rstart R1) (just x ) - move0 nothing = move (Rstart R1) nothing ++ [ Rstart R2 ] - move1 : Maybe Σ → Tree (RST Σ) - move1 (just x) = move (Rend R1) (just x ) - move1 nothing = move (Rend R1) nothing ++ [ Rend R2 ] - generate < x > R = record R { - Rnum = Rnum R + 1 ; - Rstart = record { - state = Rnum R - ; move = λ q → literal q x ( state (Rstart R) ) - ; cond = just x - ; RSTend = false - } ; - Rstates = [ Rstart R ] ++ Rstates R - } - -In2toℕ : In2 → ℕ -In2toℕ i1 = zero -In2toℕ i2 = 1 - - -regex2nfa : (regex : Regex In2 ) → εAutomaton (RST In2) In2 -regex2nfa regex = record { - εδ = move - ; all-εδ = cond1 - ; εid = λ s → state s - ; Σid = λ s → In2toℕ s - ; allState = Rstates G - ; εstart = Rstart G - ; εend = λ s → RSTend s } - where - G : RNFA In2 - G = generateRNFA regex ieq - GTree : Tree ( Tree (RST In2) ) - GTree = εclosure (Rstates G) move - cond2 : Maybe (Tree (RST In2) ) → Tree (Maybe In2 × Tree (RST In2)) - cond2 nothing = empty - cond2 (just empty) = empty - cond2 (just (leaf n r)) = leaf n ( cond r , move r ( cond r ) ) - cond2 (just (node n r left right )) = cond2 (just left ) ++ leaf n ( cond r , move r ( cond r ) ) ++ cond2 (just right ) - cond1 : RST In2 → Tree (Maybe In2 × Tree (RST In2)) - cond1 s = cond2 ( memberT ( state s ) GTree ) - -
--- a/agda/regex1.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/regex1.agda Sun Dec 27 13:26:44 2020 +0900 @@ -9,107 +9,120 @@ open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) open import Relation.Binary.PropositionalEquality as RBF hiding ( [_] ) open import Relation.Nullary using (¬_; Dec; yes; no) - - -data Regex ( Σ : Set ) : Set where - _* : Regex Σ → Regex Σ - _&_ : Regex Σ → Regex Σ → Regex Σ - _||_ : Regex Σ → Regex Σ → Regex Σ - <_> : Σ → Regex Σ +open import regex -- postulate a b c d : Set -data hoge : Set where - a : hoge - b : hoge - c : hoge - d : hoge +data In : Set where + a : In + b : In + c : In + d : In -infixr 40 _&_ _||_ +cmpi : (x y : In ) → Dec (x ≡ y) +cmpi a a = yes refl +cmpi b b = yes refl +cmpi c c = yes refl +cmpi d d = yes refl +cmpi a b = no (λ ()) +cmpi a c = no (λ ()) +cmpi a d = no (λ ()) +cmpi b a = no (λ ()) +cmpi b c = no (λ ()) +cmpi b d = no (λ ()) +cmpi c a = no (λ ()) +cmpi c b = no (λ ()) +cmpi c d = no (λ ()) +cmpi d a = no (λ ()) +cmpi d b = no (λ ()) +cmpi d c = no (λ ()) -r1' = (< a > & < b >) & < c > -r1 = < a > & < b > & < c > -any = < a > || < b > || < c > -r2 = ( any * ) & ( < a > & < b > & < c > ) +-- infixr 40 _&_ _||_ + +r1' = (< a > & < b >) & < c > --- abc +r1 = < a > & < b > & < c > --- abc +any = < a > || < b > || < c > --- a|b|c +r2 = ( any * ) & ( < a > & < b > & < c > ) -- .*abc r3 = ( any * ) & ( < a > & < b > & < c > & < a > & < b > & < c > ) r4 = ( < a > & < b > & < c > ) || ( < b > & < c > & < d > ) r5 = ( any * ) & ( < a > & < b > & < c > || < b > & < c > & < d > ) open import nfa -split : {Σ : Set} → (List Σ → Bool) - → ( List Σ → Bool) → List Σ → Bool +-- former ++ later ≡ x +split : {Σ : Set} → ((former : List Σ) → Bool) → ((later : List Σ) → Bool) → (x : List Σ ) → Bool split x y [] = x [] ∧ y [] split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t +-- tt1 : {Σ : Set} → ( P Q : List In → Bool ) → split P Q ( a ∷ b ∷ c ∷ [] ) +-- tt1 P Q = ? + {-# TERMINATING #-} repeat : {Σ : Set} → (List Σ → Bool) → List Σ → Bool repeat x [] = true repeat {Σ} x ( h ∷ t ) = split x (repeat {Σ} x) ( h ∷ t ) -open import finiteSet - -fin : FiniteSet hoge -fin = record { - Q←F = Q←F - ; F←Q = F←Q - ; finiso→ = finiso→ - ; finiso← = finiso← - } where - Q←F : Fin 4 → hoge - Q←F zero = a - Q←F (suc zero) = b - Q←F (suc (suc zero)) = c - Q←F (suc (suc (suc zero))) = d - F←Q : hoge → Fin 4 - F←Q a = zero - F←Q b = suc zero - F←Q c = suc (suc zero) - F←Q d = suc (suc (suc zero)) - finiso→ : (q : hoge) → Q←F (F←Q q) ≡ q - finiso→ a = refl - finiso→ b = refl - finiso→ c = refl - finiso→ d = refl - finiso← : (f : Fin 4) → F←Q (Q←F f) ≡ f - finiso← zero = refl - finiso← (suc zero) = refl - finiso← (suc (suc zero)) = refl - finiso← (suc (suc (suc zero))) = refl - finiso← (suc (suc (suc (suc ())))) - -open FiniteSet - -cmpi : {Σ : Set} → {n : ℕ } (fin : FiniteSet Σ {n}) → (x y : Σ ) → Dec (F←Q fin x ≡ F←Q fin y) -cmpi fin x y = F←Q fin x ≟ F←Q fin y - -regular-language : {Σ : Set} → Regex Σ → {n : ℕ } (fin : FiniteSet Σ {n}) → List Σ → Bool -regular-language (x *) f = repeat ( regular-language x f ) -regular-language (x & y) f = split ( regular-language x f ) ( regular-language y f ) -regular-language (x || y) f = λ s → ( regular-language x f s ) ∨ ( regular-language y f s) -regular-language < h > f [] = false -regular-language < h > f (h1 ∷ [] ) with cmpi f h h1 +regular-language : {Σ : Set} → Regex Σ → ((x y : Σ ) → Dec (x ≡ y)) → List Σ → Bool +regular-language φ cmp _ = false +regular-language ε cmp [] = true +regular-language ε cmp (_ ∷ _) = false +regular-language (x *) cmp = repeat ( regular-language x cmp ) +regular-language (x & y) cmp = split ( λ z → (regular-language x cmp) z ) (λ z → regular-language y cmp z ) +regular-language (x || y) cmp = λ s → ( regular-language x cmp s ) ∨ ( regular-language y cmp s) +regular-language < h > cmp [] = false +regular-language < h > cmp (h1 ∷ [] ) with cmp h h1 ... | yes _ = true ... | no _ = false -regular-language < h > f _ = false +regular-language < h > _ (_ ∷ _ ∷ _) = false -1r1' = (< a > & < b >) & < c > -1r1 = < a > & < b > & < c > -1any = < a > || < b > || < c > || < d > -1r2 = ( any * ) & ( < a > & < b > & < c > ) -1r3 = ( any * ) & ( < a > & < b > & < c > & < a > & < b > & < c > ) -1r4 = ( < a > & < b > & < c > ) || ( < b > & < c > & < d > ) -1r5 = ( any * ) & ( < a > & < b > & < c > || < b > & < c > & < d > ) - -test-regex : regular-language 1r1' fin ( a ∷ [] ) ≡ false +test-regex : regular-language r1' cmpi ( a ∷ [] ) ≡ false test-regex = refl -test-regex1 : regular-language 1r1' fin ( a ∷ b ∷ c ∷ [] ) ≡ true +test-regex1 : regular-language r2 cmpi ( a ∷ a ∷ b ∷ c ∷ [] ) ≡ true test-regex1 = refl + +test-AB→split : {Σ : Set} → {A B : List In → Bool} → split A B ( a ∷ b ∷ a ∷ [] ) ≡ ( + ( A [] ∧ B ( a ∷ b ∷ a ∷ [] ) ) ∨ + ( A ( a ∷ [] ) ∧ B ( b ∷ a ∷ [] ) ) ∨ + ( A ( a ∷ b ∷ [] ) ∧ B ( a ∷ [] ) ) ∨ + ( A ( a ∷ b ∷ a ∷ [] ) ∧ B [] ) + ) +test-AB→split {_} {A} {B} = refl -open import Data.Nat.DivMod +-- from example 1.53 1 + +ex53-1 : Set +ex53-1 = (s : List In ) → regular-language ( (< a > *) & < b > & (< a > *) ) cmpi s ≡ true → {!!} -- contains exact one b + +ex53-2 : Set +ex53-2 = (s : List In ) → regular-language ( (any * ) & < b > & (any *) ) cmpi s ≡ true → {!!} -- contains at lease one b + +evenp : {Σ : Set} → List Σ → Bool +oddp : {Σ : Set} → List Σ → Bool +oddp [] = false +oddp (_ ∷ t) = evenp t -test-regex-even : Set -test-regex-even = (s : List hoge ) → regular-language ( ( 1any || 1any ) * ) fin s ≡ true → (length s) mod 2 ≡ zero +evenp [] = true +evenp (_ ∷ t) = oddp t + +-- from example 1.53 5 +egex-even : Set +egex-even = (s : List In ) → regular-language ( ( any & any ) * ) cmpi s ≡ true → evenp s ≡ true + +test11 = regular-language ( ( any & any ) * ) cmpi (a ∷ []) +test12 = regular-language ( ( any & any ) * ) cmpi (a ∷ b ∷ []) + +-- proof-egex-even : egex-even +-- proof-egex-even [] _ = refl +-- proof-egex-even (a ∷ []) () +-- proof-egex-even (b ∷ []) () +-- proof-egex-even (c ∷ []) () +-- proof-egex-even (x ∷ x₁ ∷ s) y = proof-egex-even s {!!} + +open import derive In cmpi +open import automaton + +ra-ex = trace (regex→automaton r2) (record { state = r2 ; is-derived = unit }) ( a ∷ b ∷ c ∷ []) +
--- a/agda/regop.agda Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -module regop where - -open import automaton - --- open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.List -open import Data.Maybe -open import Data.Product -open import Data.Bool using ( Bool ; true ; false ; _∧_ ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) - - -union : {Q1 Q2 Σ : Set } → ( M1 : Automaton Q1 Σ) ( M2 : Automaton Q2 Σ) → Automaton (Q1 × Q2) Σ -union {Q1} {Q2} {Σ} M1 M2 = record { - δ = δ - ; astart = astart - ; aend = aend - } where - δ : (Q1 × Q2) → Σ → (Q1 × Q2) - δ = {!!} - astart : (Q1 × Q2) - astart = {!!} - aend : (Q1 × Q2) → Bool - aend = {!!} - -data _∨_ (A B : Set) : Set where - p1 : A → A ∨ B - p2 : B → A ∨ B - -union← : {Q1 Q2 Σ : Set } → ( M1 : Automaton Q1 Σ) ( M2 : Automaton Q2 Σ) → - ∀ ( s : List Σ ) → accept ( union M1 M2 ) s ≡ true → ( ( accept M1 s ≡ true ) ∨ ( accept M2 s ≡ true) ) -union← {Q1} {Q2} {Σ} M1 M2 s eq = {!!}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/agda/regular-concat.agda Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,201 @@ +module regular-concat where + +open import Level renaming ( suc to Suc ; zero to Zero ) +open import Data.List +open import Data.Nat hiding ( _≟_ ) +open import Data.Fin hiding ( _+_ ) +open import Data.Empty +open import Data.Unit +open import Data.Product +-- open import Data.Maybe +open import Relation.Nullary +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import logic +open import nat +open import automaton +open import regular-language + +open import nfa +open import sbconst2 + +open RegularLanguage +open Automaton + +Concat-NFA : {Σ : Set} → (A B : RegularLanguage Σ ) → ((x y : states A )→ Dec (x ≡ y)) → ((x y : states B )→ Dec (x ≡ y)) + → NAutomaton (states A ∨ states B) Σ +Concat-NFA {Σ} A B equal?A equal?B = record { Nδ = δnfa ; Nend = nend } + module Concat-NFA where + δnfa : states A ∨ states B → Σ → states A ∨ states B → Bool + δnfa (case1 q) i (case1 q₁) with equal?A (δ (automaton A) q i) q₁ + ... | yes _ = true + ... | no _ = false + δnfa (case1 qa) i (case2 qb) with equal?B qb (δ (automaton B) (astart B) i) + ... | yes _ = aend (automaton A) qa + ... | no _ = false + δnfa (case2 q) i (case2 q₁) with equal?B (δ (automaton B) q i) q₁ + ... | yes _ = true + ... | no _ = false + δnfa _ i _ = false + nend : states A ∨ states B → Bool + nend (case2 q) = aend (automaton B) q + nend (case1 q) = aend (automaton A) q /\ aend (automaton B) (astart B) -- empty B case + +Concat-NFA-start : {Σ : Set} → (A B : RegularLanguage Σ ) → states A ∨ states B → ((x y : states A )→ Dec (x ≡ y)) → Bool +Concat-NFA-start A B (case1 a) equal?A with equal?A a (astart A) +... | yes _ = true +... | no _ = false +Concat-NFA-start A B (case2 b) equal?A = false + +M-Concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ((states A → Bool) → Bool) → ((states B → Bool) → Bool) → RegularLanguage Σ +M-Concat {Σ} A B existsA existsB = record { + states = states A ∨ states B → Bool + ; astart = λ ab → Concat-NFA-start A B ab {!!} + ; automaton = subset-construction sbexists (Concat-NFA A B {!!} {!!} ) + } where + sbexists : (states A ∨ states B → Bool) → Bool + sbexists P = existsA ( λ a → existsB ( λ b → P (case1 a) \/ P (case2 b))) + +record Split {Σ : Set} (A : List Σ → Bool ) ( B : List Σ → Bool ) (x : List Σ ) : Set where + field + sp0 : List Σ + sp1 : List Σ + sp-concat : sp0 ++ sp1 ≡ x + prop0 : A sp0 ≡ true + prop1 : B sp1 ≡ true + +open Split + +list-empty++ : {Σ : Set} → (x y : List Σ) → x ++ y ≡ [] → (x ≡ [] ) ∧ (y ≡ [] ) +list-empty++ [] [] refl = record { proj1 = refl ; proj2 = refl } +list-empty++ [] (x ∷ y) () +list-empty++ (x ∷ x₁) y () + +open _∧_ + +open import Relation.Binary.PropositionalEquality hiding ( [_] ) + +c-split-lemma : {Σ : Set} → (A B : List Σ → Bool ) → (h : Σ) → ( t : List Σ ) → split A B (h ∷ t ) ≡ true + → ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) + → split (λ t1 → A (h ∷ t1)) B t ≡ true +c-split-lemma {Σ} A B h t eq p = sym ( begin + true + ≡⟨ sym eq ⟩ + split A B (h ∷ t ) + ≡⟨⟩ + A [] /\ B (h ∷ t) \/ split (λ t1 → A (h ∷ t1)) B t + ≡⟨ cong ( λ k → k \/ split (λ t1 → A (h ∷ t1)) B t ) (lemma-p p ) ⟩ + false \/ split (λ t1 → A (h ∷ t1)) B t + ≡⟨ bool-or-1 refl ⟩ + split (λ t1 → A (h ∷ t1)) B t + ∎ ) where + open ≡-Reasoning + lemma-p : ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) → A [] /\ B (h ∷ t) ≡ false + lemma-p (case1 ¬A ) = bool-and-1 ( ¬-bool-t ¬A ) + lemma-p (case2 ¬B ) = bool-and-2 ( ¬-bool-t ¬B ) + +split→AB : {Σ : Set} → (A B : List Σ → Bool ) → ( x : List Σ ) → split A B x ≡ true → Split A B x +split→AB {Σ} A B [] eq with bool-≡-? (A []) true | bool-≡-? (B []) true +split→AB {Σ} A B [] eq | yes eqa | yes eqb = + record { sp0 = [] ; sp1 = [] ; sp-concat = refl ; prop0 = eqa ; prop1 = eqb } +split→AB {Σ} A B [] eq | yes p | no ¬p = ⊥-elim (lemma-∧-1 eq (¬-bool-t ¬p )) +split→AB {Σ} A B [] eq | no ¬p | t = ⊥-elim (lemma-∧-0 eq (¬-bool-t ¬p )) +split→AB {Σ} A B (h ∷ t ) eq with bool-≡-? (A []) true | bool-≡-? (B (h ∷ t )) true +... | yes px | yes py = record { sp0 = [] ; sp1 = h ∷ t ; sp-concat = refl ; prop0 = px ; prop1 = py } +... | no px | _ with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case1 px) ) +... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } +split→AB {Σ} A B (h ∷ t ) eq | _ | no px with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case2 px) ) +... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } + +AB→split : {Σ : Set} → (A B : List Σ → Bool ) → ( x y : List Σ ) → A x ≡ true → B y ≡ true → split A B (x ++ y ) ≡ true +AB→split {Σ} A B [] [] eqa eqb = begin + split A B [] + ≡⟨⟩ + A [] /\ B [] + ≡⟨ cong₂ (λ j k → j /\ k ) eqa eqb ⟩ + true + ∎ where open ≡-Reasoning +AB→split {Σ} A B [] (h ∷ y ) eqa eqb = begin + split A B (h ∷ y ) + ≡⟨⟩ + A [] /\ B (h ∷ y) \/ split (λ t1 → A (h ∷ t1)) B y + ≡⟨ cong₂ (λ j k → j /\ k \/ split (λ t1 → A (h ∷ t1)) B y ) eqa eqb ⟩ + true /\ true \/ split (λ t1 → A (h ∷ t1)) B y + ≡⟨⟩ + true \/ split (λ t1 → A (h ∷ t1)) B y + ≡⟨⟩ + true + ∎ where open ≡-Reasoning +AB→split {Σ} A B (h ∷ t) y eqa eqb = begin + split A B ((h ∷ t) ++ y) + ≡⟨⟩ + A [] /\ B (h ∷ t ++ y) \/ split (λ t1 → A (h ∷ t1)) B (t ++ y) + ≡⟨ cong ( λ k → A [] /\ B (h ∷ t ++ y) \/ k ) (AB→split {Σ} (λ t1 → A (h ∷ t1)) B t y eqa eqb ) ⟩ + A [] /\ B (h ∷ t ++ y) \/ true + ≡⟨ bool-or-3 ⟩ + true + ∎ where open ≡-Reasoning + +open NAutomaton +open import Data.List.Properties + +closed-in-concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Concat (contain A) (contain B)) x ( M-Concat A B {!!} {!!} ) +closed-in-concat {Σ} A B x = ≡-Bool-func closed-in-concat→ closed-in-concat← where + finab = {!!} -- (fin-∨ (afin A) (afin B)) + NFA = (Concat-NFA A B {!!} {!!} ) + abmove : (q : states A ∨ states B) → (h : Σ ) → states A ∨ states B + abmove (case1 q) h = case1 (δ (automaton A) q h) + abmove (case2 q) h = case2 (δ (automaton B) q h) + lemma-nmove-ab : (q : states A ∨ states B) → (h : Σ ) → Nδ NFA q h (abmove q h) ≡ true + lemma-nmove-ab (case1 q) _ = {!!} -- equal?-refl (afin A) + lemma-nmove-ab (case2 q) _ = {!!} -- equal?-refl (afin B) + nmove : (q : states A ∨ states B) (nq : states A ∨ states B → Bool ) → (nq q ≡ true) → ( h : Σ ) → + {!!} -- exists finab (λ qn → nq qn /\ Nδ NFA qn h (abmove q h)) ≡ true + nmove (case1 q) nq nqt h = {!!} -- found finab (case1 q) ( bool-and-tt nqt (lemma-nmove-ab (case1 q) h) ) + nmove (case2 q) nq nqt h = {!!} -- found finab (case2 q) ( bool-and-tt nqt (lemma-nmove-ab (case2 q) h) ) + acceptB : (z : List Σ) → (q : states B) → (nq : states A ∨ states B → Bool ) → (nq (case2 q) ≡ true) → ( accept (automaton B) q z ≡ true ) + → Naccept NFA finab nq z ≡ true + acceptB [] q nq nqt fb = lemma8 where + lemma8 : {!!} -- exists finab ( λ q → nq q /\ Nend NFA q ) ≡ true + lemma8 = {!!} -- found finab (case2 q) ( bool-and-tt nqt fb ) + acceptB (h ∷ t ) q nq nq=q fb = acceptB t (δ (automaton B) q h) (Nmoves NFA finab nq h) (nmove (case2 q) nq nq=q h) fb + + acceptA : (y z : List Σ) → (q : states A) → (nq : states A ∨ states B → Bool ) → (nq (case1 q) ≡ true) + → ( accept (automaton A) q y ≡ true ) → ( accept (automaton B) (astart B) z ≡ true ) + → Naccept NFA finab nq (y ++ z) ≡ true + acceptA [] [] q nq nqt fa fb = {!!} -- found finab (case1 q) (bool-and-tt nqt (bool-and-tt fa fb )) + acceptA [] (h ∷ z) q nq nq=q fa fb = acceptB z nextb (Nmoves NFA finab nq h) lemma70 fb where + nextb : states B + nextb = δ (automaton B) (astart B) h + lemma70 : {!!} -- exists finab (λ qn → nq qn /\ Nδ NFA qn h (case2 nextb)) ≡ true + lemma70 = {!!} -- found finab (case1 q) ( bool-and-tt nq=q (bool-and-tt fa (lemma-nmove-ab (case2 (astart B)) h) )) + acceptA (h ∷ t) z q nq nq=q fa fb = acceptA t z (δ (automaton A) q h) (Nmoves NFA finab nq h) (nmove (case1 q) nq nq=q h) fa fb where + + acceptAB : Split (contain A) (contain B) x + → {!!} -- Naccept NFA finab (equal? finab (case1 (astart A))) x ≡ true + acceptAB S = {!!} -- subst ( λ k → Naccept NFA finab (equal? finab (case1 (astart A))) k ≡ true ) ( sp-concat S ) + -- (acceptA (sp0 S) (sp1 S) (astart A) (equal? finab (case1 (astart A))) (equal?-refl finab) (prop0 S) (prop1 S) ) + + closed-in-concat→ : Concat (contain A) (contain B) x ≡ true → contain (M-Concat A B {!!} {!!} ) x ≡ true + closed-in-concat→ concat = {!!} + + ab-case : (q : states A ∨ states B ) → (qa : states A ) → (x : List Σ ) → Set + ab-case (case1 qa') qa x = qa' ≡ qa + ab-case (case2 qb) qa x = ¬ ( accept (automaton B) qb x ≡ true ) + + contain-A : (x : List Σ) → (nq : states A ∨ states B → Bool ) → (fn : Naccept NFA finab nq x ≡ true ) + → (qa : states A ) → ( (q : states A ∨ states B) → nq q ≡ true → ab-case q qa x ) + → split (accept (automaton A) qa ) (contain B) x ≡ true + contain-A [] nq fn qa cond = {!!} + + lemma10 : Naccept NFA finab {!!} x ≡ true → split (contain A) (contain B) x ≡ true + lemma10 CC = contain-A x {!!} CC (astart A) lemma15 where + lemma15 : (q : states A ∨ states B) → Concat-NFA-start A B q {!!} ≡ true → ab-case q (astart A) x + lemma15 q nq=t = {!!} + + closed-in-concat← : contain (M-Concat A B {!!} {!!}) x ≡ true → Concat (contain A) (contain B) x ≡ true + closed-in-concat← C with subset-construction-lemma← finab NFA + ... | CC = {!!} + + + +
--- a/agda/regular-language.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/regular-language.agda Sun Dec 27 13:26:44 2020 +0900 @@ -13,7 +13,6 @@ open import logic open import nat open import automaton -open import finiteSet language : { Σ : Set } → Set language {Σ} = List Σ → Bool @@ -27,8 +26,6 @@ field states : Set astart : states - aℕ : ℕ - afin : FiniteSet states {aℕ} automaton : Automaton states Σ contain : List Σ → Bool contain x = accept automaton astart x @@ -49,6 +46,8 @@ Star : {Σ : Set} → ( A : language {Σ} ) → language {Σ} Star {Σ} A = split A ( Star {Σ} A ) +open import automaton-ex + test-AB→split : {Σ : Set} → {A B : List In2 → Bool} → split A B ( i0 ∷ i1 ∷ i0 ∷ [] ) ≡ ( ( A [] /\ B ( i0 ∷ i1 ∷ i0 ∷ [] ) ) \/ ( A ( i0 ∷ [] ) /\ B ( i1 ∷ i0 ∷ [] ) ) \/ @@ -68,13 +67,11 @@ M-Union {Σ} A B = record { states = states A × states B ; astart = ( astart A , astart B ) - ; aℕ = aℕ A * aℕ B - ; afin = fin-× (afin A) (afin B) ; automaton = record { δ = λ q x → ( δ (automaton A) (proj₁ q) x , δ (automaton B) (proj₂ q) x ) ; aend = λ q → ( aend (automaton A) (proj₁ q) \/ aend (automaton B) (proj₂ q) ) } - } + } closed-in-union : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Union (contain A) (contain B)) x ( M-Union A B ) closed-in-union A B [] = lemma where @@ -88,232 +85,3 @@ lemma1 [] qa qb = refl lemma1 (h ∷ t ) qa qb = lemma1 t ((δ (automaton A) qa h)) ((δ (automaton B) qb h)) --- M-Concat : {Σ : Set} → (A B : RegularLanguage Σ ) → RegularLanguage Σ --- M-Concat {Σ} A B = record { --- states = states A ∨ states B --- ; astart = case1 (astart A ) --- ; automaton = record { --- δ = {!!} --- ; aend = {!!} --- } --- } --- --- closed-in-concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Concat (contain A) (contain B)) x ( M-Concat A B ) --- closed-in-concat = {!!} - -open import nfa -open import sbconst2 -open FiniteSet -open import Data.Nat.Properties hiding ( _≟_ ) -open import Relation.Binary as B hiding (Decidable) - ---postulate - -- fin-∨ : {A B : Set} → { a b : ℕ } → FiniteSet A {a} → FiniteSet B {b} → FiniteSet (A ∨ B) {a + b} - --fin→ : {A : Set} → { a : ℕ } → FiniteSet A {a} → FiniteSet (A → Bool ) {exp 2 a} - -Concat-NFA : {Σ : Set} → (A B : RegularLanguage Σ ) → NAutomaton (states A ∨ states B) Σ -Concat-NFA {Σ} A B = record { Nδ = δnfa ; Nend = nend } - module Concat-NFA where - δnfa : states A ∨ states B → Σ → states A ∨ states B → Bool - δnfa (case1 q) i (case1 q₁) = equal? (afin A) (δ (automaton A) q i) q₁ - δnfa (case1 qa) i (case2 qb) = (aend (automaton A) qa ) /\ - (equal? (afin B) qb (δ (automaton B) (astart B) i) ) - δnfa (case2 q) i (case2 q₁) = equal? (afin B) (δ (automaton B) q i) q₁ - δnfa _ i _ = false - nend : states A ∨ states B → Bool - nend (case2 q) = aend (automaton B) q - nend (case1 q) = aend (automaton A) q /\ aend (automaton B) (astart B) -- empty B case - -Concat-NFA-start : {Σ : Set} → (A B : RegularLanguage Σ ) → states A ∨ states B → Bool -Concat-NFA-start A B q = equal? (fin-∨ (afin A) (afin B)) (case1 (astart A)) q - -M-Concat : {Σ : Set} → (A B : RegularLanguage Σ ) → RegularLanguage Σ -M-Concat {Σ} A B = record { - states = states A ∨ states B → Bool - ; astart = Concat-NFA-start A B - ; aℕ = finℕ finf - ; afin = finf - ; automaton = subset-construction fin (Concat-NFA A B) (case1 (astart A)) - } where - fin : FiniteSet (states A ∨ states B ) {aℕ A + aℕ B} - fin = fin-∨ (afin A) (afin B) - finf : FiniteSet (states A ∨ states B → Bool ) - finf = fin→ fin - -record Split {Σ : Set} (A : List Σ → Bool ) ( B : List Σ → Bool ) (x : List Σ ) : Set where - field - sp0 : List Σ - sp1 : List Σ - sp-concat : sp0 ++ sp1 ≡ x - prop0 : A sp0 ≡ true - prop1 : B sp1 ≡ true - -open Split - -list-empty++ : {Σ : Set} → (x y : List Σ) → x ++ y ≡ [] → (x ≡ [] ) ∧ (y ≡ [] ) -list-empty++ [] [] refl = record { proj1 = refl ; proj2 = refl } -list-empty++ [] (x ∷ y) () -list-empty++ (x ∷ x₁) y () - -open _∧_ - -open import Relation.Binary.PropositionalEquality hiding ( [_] ) - -c-split-lemma : {Σ : Set} → (A B : List Σ → Bool ) → (h : Σ) → ( t : List Σ ) → split A B (h ∷ t ) ≡ true - → ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) - → split (λ t1 → A (h ∷ t1)) B t ≡ true -c-split-lemma {Σ} A B h t eq p = sym ( begin - true - ≡⟨ sym eq ⟩ - split A B (h ∷ t ) - ≡⟨⟩ - A [] /\ B (h ∷ t) \/ split (λ t1 → A (h ∷ t1)) B t - ≡⟨ cong ( λ k → k \/ split (λ t1 → A (h ∷ t1)) B t ) (lemma-p p ) ⟩ - false \/ split (λ t1 → A (h ∷ t1)) B t - ≡⟨ bool-or-1 refl ⟩ - split (λ t1 → A (h ∷ t1)) B t - ∎ ) where - open ≡-Reasoning - lemma-p : ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) → A [] /\ B (h ∷ t) ≡ false - lemma-p (case1 ¬A ) = bool-and-1 ( ¬-bool-t ¬A ) - lemma-p (case2 ¬B ) = bool-and-2 ( ¬-bool-t ¬B ) - -split→AB : {Σ : Set} → (A B : List Σ → Bool ) → ( x : List Σ ) → split A B x ≡ true → Split A B x -split→AB {Σ} A B [] eq with bool-≡-? (A []) true | bool-≡-? (B []) true -split→AB {Σ} A B [] eq | yes eqa | yes eqb = - record { sp0 = [] ; sp1 = [] ; sp-concat = refl ; prop0 = eqa ; prop1 = eqb } -split→AB {Σ} A B [] eq | yes p | no ¬p = ⊥-elim (lemma-∧-1 eq (¬-bool-t ¬p )) -split→AB {Σ} A B [] eq | no ¬p | t = ⊥-elim (lemma-∧-0 eq (¬-bool-t ¬p )) -split→AB {Σ} A B (h ∷ t ) eq with bool-≡-? (A []) true | bool-≡-? (B (h ∷ t )) true -... | yes px | yes py = record { sp0 = [] ; sp1 = h ∷ t ; sp-concat = refl ; prop0 = px ; prop1 = py } -... | no px | _ with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case1 px) ) -... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } -split→AB {Σ} A B (h ∷ t ) eq | _ | no px with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case2 px) ) -... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } - -AB→split : {Σ : Set} → (A B : List Σ → Bool ) → ( x y : List Σ ) → A x ≡ true → B y ≡ true → split A B (x ++ y ) ≡ true -AB→split {Σ} A B [] [] eqa eqb = begin - split A B [] - ≡⟨⟩ - A [] /\ B [] - ≡⟨ cong₂ (λ j k → j /\ k ) eqa eqb ⟩ - true - ∎ where open ≡-Reasoning -AB→split {Σ} A B [] (h ∷ y ) eqa eqb = begin - split A B (h ∷ y ) - ≡⟨⟩ - A [] /\ B (h ∷ y) \/ split (λ t1 → A (h ∷ t1)) B y - ≡⟨ cong₂ (λ j k → j /\ k \/ split (λ t1 → A (h ∷ t1)) B y ) eqa eqb ⟩ - true /\ true \/ split (λ t1 → A (h ∷ t1)) B y - ≡⟨⟩ - true \/ split (λ t1 → A (h ∷ t1)) B y - ≡⟨⟩ - true - ∎ where open ≡-Reasoning -AB→split {Σ} A B (h ∷ t) y eqa eqb = begin - split A B ((h ∷ t) ++ y) - ≡⟨⟩ - A [] /\ B (h ∷ t ++ y) \/ split (λ t1 → A (h ∷ t1)) B (t ++ y) - ≡⟨ cong ( λ k → A [] /\ B (h ∷ t ++ y) \/ k ) (AB→split {Σ} (λ t1 → A (h ∷ t1)) B t y eqa eqb ) ⟩ - A [] /\ B (h ∷ t ++ y) \/ true - ≡⟨ bool-or-3 ⟩ - true - ∎ where open ≡-Reasoning - -open NAutomaton -open import Data.List.Properties - -closed-in-concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Concat (contain A) (contain B)) x ( M-Concat A B ) -closed-in-concat {Σ} A B x = ≡-Bool-func closed-in-concat→ closed-in-concat← where - finab = (fin-∨ (afin A) (afin B)) - NFA = (Concat-NFA A B) - abmove : (q : states A ∨ states B) → (h : Σ ) → states A ∨ states B - abmove (case1 q) h = case1 (δ (automaton A) q h) - abmove (case2 q) h = case2 (δ (automaton B) q h) - lemma-nmove-ab : (q : states A ∨ states B) → (h : Σ ) → Nδ NFA q h (abmove q h) ≡ true - lemma-nmove-ab (case1 q) _ = equal?-refl (afin A) - lemma-nmove-ab (case2 q) _ = equal?-refl (afin B) - nmove : (q : states A ∨ states B) (nq : states A ∨ states B → Bool ) → (nq q ≡ true) → ( h : Σ ) → - exists finab (λ qn → nq qn /\ Nδ NFA qn h (abmove q h)) ≡ true - nmove (case1 q) nq nqt h = found finab (case1 q) ( bool-and-tt nqt (lemma-nmove-ab (case1 q) h) ) - nmove (case2 q) nq nqt h = found finab (case2 q) ( bool-and-tt nqt (lemma-nmove-ab (case2 q) h) ) - acceptB : (z : List Σ) → (q : states B) → (nq : states A ∨ states B → Bool ) → (nq (case2 q) ≡ true) → ( accept (automaton B) q z ≡ true ) - → Naccept NFA finab nq z ≡ true - acceptB [] q nq nqt fb = lemma8 where - lemma8 : exists finab ( λ q → nq q /\ Nend NFA q ) ≡ true - lemma8 = found finab (case2 q) ( bool-and-tt nqt fb ) - acceptB (h ∷ t ) q nq nq=q fb = acceptB t (δ (automaton B) q h) (Nmoves NFA finab nq h) (nmove (case2 q) nq nq=q h) fb - - acceptA : (y z : List Σ) → (q : states A) → (nq : states A ∨ states B → Bool ) → (nq (case1 q) ≡ true) - → ( accept (automaton A) q y ≡ true ) → ( accept (automaton B) (astart B) z ≡ true ) - → Naccept NFA finab nq (y ++ z) ≡ true - acceptA [] [] q nq nqt fa fb = found finab (case1 q) (bool-and-tt nqt (bool-and-tt fa fb )) - acceptA [] (h ∷ z) q nq nq=q fa fb = acceptB z nextb (Nmoves NFA finab nq h) lemma70 fb where - nextb : states B - nextb = δ (automaton B) (astart B) h - lemma70 : exists finab (λ qn → nq qn /\ Nδ NFA qn h (case2 nextb)) ≡ true - lemma70 = found finab (case1 q) ( bool-and-tt nq=q (bool-and-tt fa (lemma-nmove-ab (case2 (astart B)) h) )) - acceptA (h ∷ t) z q nq nq=q fa fb = acceptA t z (δ (automaton A) q h) (Nmoves NFA finab nq h) (nmove (case1 q) nq nq=q h) fa fb where - - acceptAB : Split (contain A) (contain B) x - → Naccept NFA finab (equal? finab (case1 (astart A))) x ≡ true - acceptAB S = subst ( λ k → Naccept NFA finab (equal? finab (case1 (astart A))) k ≡ true ) ( sp-concat S ) - (acceptA (sp0 S) (sp1 S) (astart A) (equal? finab (case1 (astart A))) (equal?-refl finab) (prop0 S) (prop1 S) ) - - closed-in-concat→ : Concat (contain A) (contain B) x ≡ true → contain (M-Concat A B) x ≡ true - closed-in-concat→ concat with split→AB (contain A) (contain B) x concat - ... | S = begin - accept (subset-construction finab NFA (case1 (astart A))) (Concat-NFA-start A B ) x - ≡⟨ ≡-Bool-func (subset-construction-lemma← finab NFA (case1 (astart A)) x ) - (subset-construction-lemma→ finab NFA (case1 (astart A)) x ) ⟩ - Naccept NFA finab (equal? finab (case1 (astart A))) x - ≡⟨ acceptAB S ⟩ - true - ∎ where open ≡-Reasoning - - open Found - - ab-case : (q : states A ∨ states B ) → (qa : states A ) → (x : List Σ ) → Set - ab-case (case1 qa') qa x = qa' ≡ qa - ab-case (case2 qb) qa x = ¬ ( accept (automaton B) qb x ≡ true ) - - contain-A : (x : List Σ) → (nq : states A ∨ states B → Bool ) → (fn : Naccept NFA finab nq x ≡ true ) - → (qa : states A ) → ( (q : states A ∨ states B) → nq q ≡ true → ab-case q qa x ) - → split (accept (automaton A) qa ) (contain B) x ≡ true - contain-A [] nq fn qa cond with found← finab fn -- at this stage, A and B must be satisfied with [] (ab-case cond forces it) - ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) - ... | case1 qa' | record { eq = refl } | refl = bool-∧→tt-1 (found-p S) - ... | case2 qb | record { eq = refl } | ab = ⊥-elim ( ab (bool-∧→tt-1 (found-p S))) - contain-A (h ∷ t) nq fn qa cond with bool-≡-? ((aend (automaton A) qa) /\ accept (automaton B) (δ (automaton B) (astart B) h) t ) true - ... | yes eq = bool-or-41 eq -- found A ++ B all end - ... | no ne = bool-or-31 (contain-A t (Nmoves NFA finab nq h) fn (δ (automaton A) qa h) lemma11 ) where -- B failed continue with ab-base condtion - --- prove ab-ase condition (we haven't checked but case2 b may happen) - lemma11 : (q : states A ∨ states B) → exists finab (λ qn → nq qn /\ Nδ NFA qn h q) ≡ true → ab-case q (δ (automaton A) qa h) t - lemma11 (case1 qa') ex with found← finab ex - ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) - ... | case1 qa | record { eq = refl } | refl = sym ( equal→refl (afin A) ( bool-∧→tt-1 (found-p S) )) -- continued A case - ... | case2 qb | record { eq = refl } | nb with bool-∧→tt-1 (found-p S) -- δnfa (case2 q) i (case1 q₁) is false - ... | () - lemma11 (case2 qb) ex with found← finab ex - ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) - lemma11 (case2 qb) ex | S | case2 qb' | record { eq = refl } | nb = contra-position lemma13 nb where -- continued B case should fail - lemma13 : accept (automaton B) qb t ≡ true → accept (automaton B) qb' (h ∷ t) ≡ true - lemma13 fb = subst (λ k → accept (automaton B) k t ≡ true ) (sym (equal→refl (afin B) (bool-∧→tt-1 (found-p S)))) fb - lemma11 (case2 qb) ex | S | case1 qa | record { eq = refl } | refl with bool-∧→tt-1 (found-p S) - ... | eee = contra-position lemma12 ne where -- starting B case should fail - lemma12 : accept (automaton B) qb t ≡ true → aend (automaton A) qa /\ accept (automaton B) (δ (automaton B) (astart B) h) t ≡ true - lemma12 fb = bool-and-tt (bool-∧→tt-0 eee) (subst ( λ k → accept (automaton B) k t ≡ true ) (equal→refl (afin B) (bool-∧→tt-1 eee) ) fb ) - - lemma10 : Naccept NFA finab (equal? finab (case1 (astart A))) x ≡ true → split (contain A) (contain B) x ≡ true - lemma10 CC = contain-A x (Concat-NFA-start A B ) CC (astart A) lemma15 where - lemma15 : (q : states A ∨ states B) → Concat-NFA-start A B q ≡ true → ab-case q (astart A) x - lemma15 q nq=t with equal→refl finab nq=t - ... | refl = refl - - closed-in-concat← : contain (M-Concat A B) x ≡ true → Concat (contain A) (contain B) x ≡ true - closed-in-concat← C with subset-construction-lemma← finab NFA (case1 (astart A)) x C - ... | CC = lemma10 CC - - - -
--- a/agda/root2.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/root2.agda Sun Dec 27 13:26:44 2020 +0900 @@ -1,34 +1,160 @@ module root2 where -open import Data.Nat +open import Data.Nat +open import Data.Nat.Properties open import Data.Empty +open import Data.Unit using (⊤ ; tt) open import Relation.Nullary open import Relation.Binary.PropositionalEquality -open import Data.Nat.DivMod +open import Relation.Binary.Definitions even : (n : ℕ ) → Set -even n = n % 2 ≡ 0 +even zero = ⊤ +even (suc zero) = ⊥ +even (suc (suc n)) = even n even? : (n : ℕ ) → Dec ( even n ) -even? n with n % 2 -even? n | zero = yes refl -even? n | suc k = no ( λ () ) +even? zero = yes tt +even? (suc zero) = no (λ ()) +even? (suc (suc n)) = even? n + +n+even : {n m : ℕ } → even n → even m → even ( n + m ) +n+even {zero} {zero} tt tt = tt +n+even {zero} {suc m} tt em = em +n+even {suc (suc n)} {m} en em = n+even {n} {m} en em + +n*even : {m n : ℕ } → even n → even ( m * n ) +n*even {zero} {n} en = tt +n*even {suc m} {n} en = n+even {n} {m * n} en (n*even {m} {n} en) + +even*n : {n m : ℕ } → even n → even ( n * m ) +even*n {n} {m} en = subst even (*-comm m n) (n*even {m} {n} en) + +gcd1 : ( i i0 j j0 : ℕ ) → ℕ +gcd1 zero i0 zero j0 = i0 +gcd1 zero i0 (suc zero) j0 = 1 +gcd1 zero zero (suc (suc j)) j0 = j0 +gcd1 zero (suc i0) (suc (suc j)) j0 = gcd1 i0 (suc i0) (suc j) (suc (suc j)) +gcd1 (suc zero) i0 zero j0 = 1 +gcd1 (suc (suc i)) i0 zero zero = i0 +gcd1 (suc (suc i)) i0 zero (suc j0) = gcd1 (suc i) (suc (suc i)) j0 (suc j0) +gcd1 (suc i) i0 (suc j) j0 = gcd1 i i0 j j0 + +gcd : ( i j : ℕ ) → ℕ +gcd i j = gcd1 i i j j -nn-even : {n : ℕ } → even n → even ( n * n ) -nn-even {n} eq = {!!} +even→gcd=2 : {n : ℕ} → even n → n > 0 → gcd n 2 ≡ 2 +even→gcd=2 {suc (suc zero)} en (s≤s z≤n) = refl +even→gcd=2 {suc (suc (suc (suc n)))} en (s≤s z≤n) = begin + gcd (suc (suc (suc (suc n)))) 2 + ≡⟨⟩ + gcd (suc (suc n)) 2 + ≡⟨ even→gcd=2 {suc (suc n)} en (s≤s z≤n) ⟩ + 2 + ∎ where open ≡-Reasoning -2-even : {n : ℕ } → even ( 2 * n ) -2-even {n} = {!!} +gcd22 : { n m : ℕ} → gcd n 2 ≡ 2 → gcd m 2 ≡ 2 → ¬ ( gcd n m ≡ 1 ) +gcd22 {zero} {suc zero} gn () gnm +gcd22 {zero} {suc (suc m)} refl gm () +gcd22 {suc zero} {zero} () gm gnm +gcd22 {suc (suc n)} {zero} gn refl () +gcd22 {suc (suc n)} {suc (suc m)} gn gm gnm = gcd23 (suc n) (suc m) 0 {!!} gn gm gnm where + gcd12 : (n i : ℕ) → gcd1 n (suc n) (suc i) 2 ≡ 2 → gcd1 n (suc n) (suc i) 2 ≡ 2 + gcd12 = ? + gcd23 : (n m i : ℕ ) → i ≤ 2 → (gn : gcd1 n (suc n) (suc i) 2 ≡ 2) → (gm : gcd1 m (suc m) (suc i) 2 ≡ 2) → + (gnm : gcd1 n (suc n) m (suc m) ≡ 1 ) → ⊥ + gcd23 = {!!} + + +record Even (i : ℕ) : Set where + field + j : ℕ + is-twice : i ≡ 2 * j + +e2 : (i : ℕ) → even i → Even i +e2 zero en = record { j = 0 ; is-twice = refl } +e2 (suc (suc i)) en = record { j = suc (Even.j (e2 i en )) ; is-twice = e21 } where + e21 : suc (suc i) ≡ 2 * suc (Even.j (e2 i en)) + e21 = begin + suc (suc i) ≡⟨ cong (λ k → suc (suc k)) (Even.is-twice (e2 i en)) ⟩ + suc (suc (2 * Even.j (e2 i en))) ≡⟨ sym (*-distribˡ-+ 2 1 _) ⟩ + 2 * suc (Even.j (e2 i en)) ∎ where open ≡-Reasoning + +record Odd (i : ℕ) : Set where + field + j : ℕ + is-twice : i ≡ suc (2 * j ) -even-2 : (n : ℕ ) → (n + 2) % 2 ≡ 0 → n % 2 ≡ 0 -even-2 0 refl = refl -even-2 1 () -even-2 (suc (suc n)) eq = {!!} -- trans ([a+n]%n≡a%n (suc (suc n)) _ ) eq -- [a+n]%n≡a%n : ∀ a n → (a + suc n) % suc n ≡ a % suc n +odd2 : (i : ℕ) → ¬ even i → even (suc i) +odd2 zero ne = ⊥-elim ( ne tt ) +odd2 (suc zero) ne = tt +odd2 (suc (suc i)) ne = odd2 i ne + +odd3 : (i : ℕ) → ¬ even i → Odd i +odd3 zero ne = ⊥-elim ( ne tt ) +odd3 (suc zero) ne = record { j = 0 ; is-twice = refl } +odd3 (suc (suc i)) ne = record { j = Even.j (e2 (suc i) (odd2 i ne)) ; is-twice = odd31 } where + odd31 : suc (suc i) ≡ suc (2 * Even.j (e2 (suc i) (odd2 i ne))) + odd31 = begin + suc (suc i) ≡⟨ cong suc (Even.is-twice (e2 (suc i) (odd2 i ne))) ⟩ + suc (2 * (Even.j (e2 (suc i) (odd2 i ne)))) ∎ where open ≡-Reasoning + +odd4 : (i : ℕ) → even i → ¬ even ( suc i ) +odd4 (suc (suc i)) en en1 = odd4 i en en1 + +even^2 : {n : ℕ} → even ( n * n ) → even n +even^2 {n} en with even? n +... | yes y = y +... | no ne = ⊥-elim ( odd4 ((2 * m) + 2 * m * suc (2 * m)) (n+even {2 * m} {2 * m * suc (2 * m)} ee3 ee4) (subst (λ k → even k) ee2 en )) where + m : ℕ + m = Odd.j ( odd3 n ne ) + ee3 : even (2 * m) + ee3 = subst (λ k → even k ) (*-comm m 2) (n*even {m} {2} tt ) + ee4 : even ((2 * m) * suc (2 * m)) + ee4 = even*n {(2 * m)} {suc (2 * m)} (even*n {2} {m} tt ) + ee2 : n * n ≡ suc (2 * m) + ((2 * m) * (suc (2 * m) )) + ee2 = begin n * n ≡⟨ cong ( λ k → k * k) (Odd.is-twice (odd3 n ne)) ⟩ + suc (2 * m) * suc (2 * m) ≡⟨ *-distribʳ-+ (suc (2 * m)) 1 ((2 * m) ) ⟩ + (1 * suc (2 * m)) + 2 * m * suc (2 * m) ≡⟨ cong (λ k → k + 2 * m * suc (2 * m)) (begin + suc m + 1 * m + 0 * (suc m + 1 * m ) ≡⟨ +-comm (suc m + 1 * m) 0 ⟩ + suc m + 1 * m ≡⟨⟩ + suc (2 * m) + ∎) ⟩ suc (2 * m) + 2 * m * suc (2 * m) ∎ where open ≡-Reasoning -even-half : (n : ℕ ) → even n → ℕ -even-half zero _ = zero -even-half (suc (suc n)) ev = {!!} -- 1 + even-half n (subst (λ k → k ≡ 0 ) {!!} {!!} ) +open import nat + +e3 : {i j : ℕ } → 2 * i ≡ 2 * j → i ≡ j +e3 {zero} {zero} refl = refl +e3 {suc x} {suc y} eq with <-cmp x y +... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< eq (s≤s (<-trans (<-plus a) (<-plus-0 (s≤s (<-plus a )))))) +... | tri≈ ¬a b ¬c = cong suc b +... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (s≤s (<-trans (<-plus c) (<-plus-0 (s≤s (<-plus c )))))) + +record Rational : Set where + field + i j : ℕ + coprime : gcd i j ≡ 1 -root2-irrational : ( n m : ℕ ) → ¬ ( 2 * n * n ≡ m * m ) -root2-irrational n m eq = {!!} +root2-irrational : ( n m : ℕ ) → n > 0 → m > 0 → 2 * n * n ≡ m * m → ¬ (gcd n m ≡ 1) +root2-irrational n m n>0 m>0 2nm = gcd22 {n} {m} (even→gcd=2 rot7 n>0 ) (even→gcd=2 ( even^2 {m} ( rot1)) m>0) where + rot1 : even ( m * m ) + rot1 = subst (λ k → even k ) rot4 (n*even {n * n} {2} tt ) where + rot4 : (n * n) * 2 ≡ m * m + rot4 = begin + (n * n) * 2 ≡⟨ *-comm (n * n) 2 ⟩ + 2 * ( n * n ) ≡⟨ sym (*-assoc 2 n n) ⟩ + 2 * n * n ≡⟨ 2nm ⟩ + m * m ∎ where open ≡-Reasoning + E : Even m + E = e2 m ( even^2 {m} ( rot1 )) + rot2 : 2 * n * n ≡ 2 * Even.j E * m + rot2 = subst (λ k → 2 * n * n ≡ k * m ) (Even.is-twice E) 2nm + rot3 : n * n ≡ Even.j E * m + rot3 = e3 ( begin + 2 * (n * n) ≡⟨ sym (*-assoc 2 n _) ⟩ + 2 * n * n ≡⟨ rot2 ⟩ + 2 * Even.j E * m ≡⟨ *-assoc 2 (Even.j E) m ⟩ + 2 * (Even.j E * m) ∎ ) where open ≡-Reasoning + rot7 : even n + rot7 = even^2 {n} (subst (λ k → even k) (sym rot3) ((n*even {Even.j E} {m} ( even^2 {m} ( rot1 )))))
--- a/agda/sbconst.agda Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,164 +0,0 @@ -module sbconst where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.List -open import Data.Maybe -open import Data.Product -open import Data.Bool using ( Bool ; true ; false ; _∨_ ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) - -open import automaton -open import epautomaton - - --- all primitive state has id --- Tree Q is sorted by id and is contents are unique - -flatten : { Q : Set} → Tree Q → List ℕ -flatten empty = [] -flatten (leaf x x₁) = [ x ] -flatten (node x x₁ x₂ x₃) = flatten x₂ ++ [ x ] ++ flatten x₃ - -listEq : List ℕ → List ℕ → Bool -listEq [] [] = true -listEq [] ( _ ∷ _ ) = false -listEq ( _ ∷ _ ) [] = false -listEq ( h1 ∷ t1 ) ( h2 ∷ t2 ) with h1 ≟ h2 -... | yes _ = listEq t1 t2 -... | no _ = false - -infixr 7 _==_ -_==_ : { Q : Set} → Tree Q → Tree Q → Bool -x == y = listEq ( flatten x ) ( flatten y ) - -memberTT : { Q : Set} → Tree Q → Tree ( Tree Q ) → Bool -memberTT t empty = false -memberTT t (leaf x x₁) = t == x₁ -memberTT t (node x x₁ x₂ x₃) with t == x₁ -... | true = true -... | false = memberTT t x₂ ∨ memberTT t x₃ - -lengthT : { Q : Set} → Tree Q → ℕ -lengthT t = length ( flatten t ) - -findT : { Q : Set} → Tree Q → Tree ( Tree Q ) → Maybe ( Tree Q ) -findT t empty = nothing -findT t (leaf x x₁) = just x₁ -findT t (node x x₁ x₂ x₃) with t == x₁ -... | true = just x₁ -... | false with findT t x₂ -... | (just y) = just y -... | nothing = findT t x₃ - -mergeT : { Q : Set} → Tree Q → Tree Q → Tree Q -mergeT empty t = t -mergeT (leaf x t0) t = insertT x t0 t -mergeT (node x t0 left right ) t = - mergeT left ( insertT x t0 (mergeT right t )) - -open εAutomaton - --- all inputs are exclusive each other ( only one input can happen ) - --- merge Tree ( Maybe Σ × Tree Q ) -merge-itεδ : { Σ Q : Set } → εAutomaton Q Σ → Σ → Tree Q → Tree ( Maybe Σ × Tree Q ) → Tree ( Maybe Σ × Tree Q ) -merge-itεδ NFA i t empty = leaf (Σid NFA i) ( just i , t ) -merge-itεδ NFA i t (leaf x (i' , t1 )) with (Σid NFA i) ≟ x -... | no _ = leaf x (i' , t1) -... | yes _ = leaf x (just i , mergeT t t1 ) -merge-itεδ NFA i t (node x (i' , t1) left right ) with (Σid NFA i) ≟ x -... | no _ = node x (i' , t1) ( merge-itεδ NFA i t left ) ( merge-itεδ NFA i t right ) -... | yes _ = node x (just i , mergeT t t1 ) - ( merge-itεδ NFA i t left ) ( merge-itεδ NFA i t right ) - -merge-iεδ : { Σ Q : Set } → εAutomaton Q Σ → Maybe Σ → Tree Q → Tree ( Maybe Σ × Tree Q ) → Tree ( Maybe Σ × Tree Q ) -merge-iεδ NFA nothing _ t = t -merge-iεδ NFA (just i) q t = merge-itεδ NFA i q t - -merge-εδ : { Σ Q : Set } → εAutomaton Q Σ → Tree ( Maybe Σ × Tree Q ) → Tree ( Maybe Σ × Tree Q ) → Tree ( Maybe Σ × Tree Q ) -merge-εδ NFA empty t = t -merge-εδ NFA (leaf x (i , t1) ) t = merge-iεδ NFA i t1 t -merge-εδ NFA (node x (i , t1) left right) t = - merge-εδ NFA left ( merge-iεδ NFA i t1 ( merge-εδ NFA right t ) ) - --- merge and find new state from newly created Tree ( Maybe Σ × Tree Q ) -sbconst13 : { Σ Q : Set } → εAutomaton Q Σ → Tree ( Maybe Σ × Tree Q ) → Tree ( Tree Q ) → Tree ( Tree Q ) → ℕ → ( Tree ( Tree Q ) × Tree ( Tree Q ) × ℕ ) -sbconst13 NFA empty nt t n = (nt , t , n) -sbconst13 NFA (leaf x (p , q)) nt t n with memberTT q t -... | true = ( nt , t , n) -... | false = ( insertT n q nt , insertT n q t , n + 1 ) -sbconst13 NFA (node x (_ , q) left right) nt t n with memberTT q t -sbconst13 NFA (node x (_ , q) left right) nt t n | true = ( nt , t , n ) -sbconst13 NFA (node x (_ , q) left right) nt t n | false = p2 - where - p1 = sbconst13 NFA left nt t n - n1 = proj₂ ( proj₂ p1 ) - p2 = sbconst13 NFA right (insertT n1 q ( proj₁ p1 )) (insertT n1 q ( proj₁ (proj₂ p1))) (n1 + 1 ) --- expand state to Tree ( Maybe Σ × Tree Q ) -sbconst12 : { Σ Q : Set } → εAutomaton Q Σ → Tree Q → Tree ( Maybe Σ × Tree Q ) → Tree ( Maybe Σ × Tree Q ) -sbconst12 NFA empty s = s -sbconst12 NFA (leaf x q) s = merge-εδ NFA s (all-εδ NFA q) -sbconst12 NFA (node x q left right) s = sbconst12 NFA right (merge-εδ NFA (all-εδ NFA q) (sbconst12 NFA left s)) --- loop on state tree -sbconst11 : { Σ Q : Set } → εAutomaton Q Σ → Tree ( Tree Q ) → Tree ( Tree Q ) → Tree ( Tree Q ) → ℕ → ( Tree ( Tree Q ) × Tree ( Tree Q ) × ℕ ) -sbconst11 NFA empty nt t n = (nt , t , n ) -sbconst11 NFA (leaf x q) nt t n = sbconst13 NFA (sbconst12 NFA q empty ) nt t n -sbconst11 NFA (node x q left right ) nt t n = p3 - where - p1 = sbconst11 NFA left nt t n - p2 = sbconst13 NFA (sbconst12 NFA q empty ) ( proj₁ p1 ) ( proj₁ ( proj₂ p1 ) ) ( proj₂ ( proj₂ p1 ) ) - p3 = sbconst11 NFA right ( proj₁ p2 ) ( proj₁ ( proj₂ p2 )) ( proj₂ ( proj₂ p2 )) - -{-# TERMINATING #-} -sbconst0 : { Σ Q : Set } → εAutomaton Q Σ → Tree ( Tree Q ) → Tree ( Tree Q ) → ℕ → ( Tree ( Tree Q ) × ℕ ) -sbconst0 NFA t t1 n0 with sbconst11 NFA t t1 empty n0 -... | t2 , empty , n = (t2 , n ) -... | t2 , leaf x y , n = sbconst0 NFA ( proj₁ ( proj₂ p1 )) (leaf x y) ( proj₂ ( proj₂ p1 ) ) - where - p1 = sbconst11 NFA (leaf x y) t1 empty n -... | t2 , node x y left right , n = p4 - where - p1 = sbconst0 NFA left t2 n - p2 = sbconst11 NFA (leaf x y) ( proj₁ p1 ) empty ( proj₂ p1 ) - p3 = sbconst0 NFA right ( proj₁ p2 ) ( proj₂ ( proj₂ p2 )) - p4 = sbconst0 NFA ( proj₁ ( proj₂ p2 )) ( proj₁ p3) ( proj₂ p3 ) - -nfa2dfa : { Σ Q : Set } → εAutomaton Q Σ → Automaton (Tree Q) Σ -nfa2dfa {Σ} {Q} NFA = record { - δ = δ' - ; astart = astart' - ; aend = aend' - } - where - MTree : { Σ Q : Set } → (x : εAutomaton Q Σ) → Tree ( Tree Q ) - MTree {Σ} {Q} NFA = εclosure (allState NFA ) ( εδ NFA ) - sbconst : { Σ Q : Set } → εAutomaton Q Σ → Tree ( Tree Q ) - sbconst NFA = proj₁ (sbconst0 NFA ( MTree NFA ) (MTree NFA) zero) - δ0 : Σ → Tree ( Maybe Σ × Tree Q ) → Tree Q - δ0 x empty = empty - δ0 x (leaf x₁ q) with Σid NFA x ≟ x₁ - ... | no ¬p = empty - ... | yes p with proj₁ q - ... | nothing = empty - ... | just _ = proj₂ q - δ0 x (node x₁ q left right) with Σid NFA x ≟ x₁ - ... | no ¬p with δ0 x left - ... | empty = δ0 x right - ... | q1 = q1 - δ0 x (node x₁ q left right) | yes p with proj₁ q - ... | nothing = empty - ... | just _ = proj₂ q - δ' : Tree Q → Σ → Tree Q - δ' t x with findT t ( MTree NFA ) - ... | nothing = leaf zero ( εstart NFA ) -- can't happen - ... | just q = δ0 x (sbconst12 NFA q empty) - astart' : Tree Q - astart' = leaf zero ( εstart NFA ) - aend' : Tree Q → Bool - aend' empty = false - aend' (leaf _ x) = εend NFA x - aend' (node _ x left right ) = - aend' left ∨ εend NFA x ∨ aend' right -
--- a/agda/sbconst1.agda Sat Mar 14 19:42:27 2020 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,42 +0,0 @@ -module sbconst1 where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat hiding ( _≟_ ) -open import Data.Fin -open import Data.List -open import Data.Maybe -open import Data.Bool using ( Bool ; true ; false ; _∧_ ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) -open import Data.Product -open import finiteSet - -open import automaton -open import nfa-list -open Automaton -open NAutomaton - -open FiniteSet - -list2sbst : {Q : Set} { n : ℕ } → FiniteSet Q {n} → List Q → Q → Bool -list2sbst N [] _ = false -list2sbst N ( h ∷ t ) q with F←Q N q ≟ F←Q N h -... | yes _ = true -... | no _ = list2sbst N t q - - -δconv : { Q : Set } { Σ : Set } { n : ℕ } → FiniteSet Q {n} → ( nδ : Q → Σ → List Q ) → (Q → Bool) → Σ → (Q → Bool) -δconv {Q} { Σ} { n} N nδ f i q = exists N ( λ r → f r ∧ list2sbst N (nδ r i) q ) - -subset-construction : { Q : Set } { Σ : Set } { n : ℕ } → FiniteSet Q {n} → - (NAutomaton Q Σ ) → (Automaton (Q → Bool) Σ ) -subset-construction {Q} { Σ} {n} N NFA = record { - δ = λ q x → δconv N ( nδ NFA ) q x - ; astart = astart1 - ; aend = aend1 - } where - astart1 : Q → Bool - astart1 = list2sbst N [ nstart NFA ] - aend1 : (Q → Bool) → Bool - aend1 f = exists N f -
--- a/agda/sbconst2.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/sbconst2.agda Sun Dec 27 13:26:44 2020 +0900 @@ -10,52 +10,46 @@ open import logic open NAutomaton open Automaton -open import finiteSet -open FiniteSet open import Relation.Binary.PropositionalEquality hiding ( [_] ) - open Bool -δconv : { Q : Set } { Σ : Set } { n : ℕ } → FiniteSet Q {n} → ( nδ : Q → Σ → Q → Bool ) → (f : Q → Bool) → (i : Σ) → (Q → Bool) -δconv {Q} { Σ} { n} N nδ f i q = exists N ( λ r → f r /\ nδ r i q ) - -open FiniteSet +δconv : { Q : Set } { Σ : Set } → ( ( Q → Bool ) → Bool ) → ( nδ : Q → Σ → Q → Bool ) → (f : Q → Bool) → (i : Σ) → (Q → Bool) +δconv {Q} { Σ} exists nδ f i q = exists ( λ r → f r /\ nδ r i q ) -subset-construction : { Q : Set } { Σ : Set } { n : ℕ } → FiniteSet Q {n} → - (NAutomaton Q Σ ) → (astart : Q ) → (Automaton (Q → Bool) Σ ) -subset-construction {Q} { Σ} {n} fin NFA astart = record { - δ = λ q x → δconv fin ( Nδ NFA ) q x - ; aend = λ f → exists fin ( λ q → f q /\ Nend NFA q ) +subset-construction : { Q : Set } { Σ : Set } → + ( ( Q → Bool ) → Bool ) → + (NAutomaton Q Σ ) → (Automaton (Q → Bool) Σ ) +subset-construction {Q} { Σ} exists NFA = record { + δ = λ q x → δconv exists ( Nδ NFA ) q x + ; aend = λ f → exists ( λ q → f q /\ Nend NFA q ) } -am2start = λ q1 → equal? finState1 ss q1 +test4 = subset-construction existsS1 am2 -test4 = subset-construction finState1 am2 ss - -test5 = accept test4 ( λ q1 → equal? finState1 ss q1) ( i0 ∷ i1 ∷ i0 ∷ [] ) -test6 = accept test4 ( λ q1 → equal? finState1 ss q1) ( i1 ∷ i1 ∷ i1 ∷ [] ) +test51 = accept test4 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) +test61 = accept test4 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) -subset-construction-lemma→ : { Q : Set } { Σ : Set } { n : ℕ } → (fin : FiniteSet Q {n} ) → - (NFA : NAutomaton Q Σ ) → (astart : Q ) +subset-construction-lemma→ : { Q : Set } { Σ : Set } { n : ℕ } → (exists : ( Q → Bool ) → Bool ) → + (NFA : NAutomaton Q Σ ) → (astart : Q → Bool ) → (x : List Σ) - → Naccept NFA fin ( λ q1 → equal? fin astart q1) x ≡ true - → accept ( subset-construction fin NFA astart ) ( λ q1 → equal? fin astart q1) x ≡ true -subset-construction-lemma→ {Q} {Σ} {n} fin NFA astart x naccept = lemma1 x ( λ q1 → equal? fin astart q1) naccept where + → Naccept NFA exists astart x ≡ true + → accept ( subset-construction exists NFA ) astart x ≡ true +subset-construction-lemma→ {Q} {Σ} {n} exists NFA astart x naccept = lemma1 x astart naccept where lemma1 : (x : List Σ) → ( states : Q → Bool ) - → Naccept NFA fin states x ≡ true - → accept ( subset-construction fin NFA astart ) states x ≡ true + → Naccept NFA exists states x ≡ true + → accept ( subset-construction exists NFA ) states x ≡ true lemma1 [] states naccept = naccept - lemma1 (h ∷ t ) states naccept = lemma1 t (δconv fin (Nδ NFA) states h) naccept + lemma1 (h ∷ t ) states naccept = lemma1 t (δconv exists (Nδ NFA) states h) naccept -subset-construction-lemma← : { Q : Set } { Σ : Set } { n : ℕ } → (fin : FiniteSet Q {n} ) → - (NFA : NAutomaton Q Σ ) → (astart : Q ) +subset-construction-lemma← : { Q : Set } { Σ : Set } { n : ℕ } → (exists : ( Q → Bool ) → Bool ) → + (NFA : NAutomaton Q Σ ) → (astart : Q → Bool ) → (x : List Σ) - → accept ( subset-construction fin NFA astart ) ( λ q1 → equal? fin astart q1) x ≡ true - → Naccept NFA fin ( λ q1 → equal? fin astart q1) x ≡ true -subset-construction-lemma← {Q} {Σ} {n} fin NFA astart x saccept = lemma2 x ( λ q1 → equal? fin astart q1) saccept where + → accept ( subset-construction exists NFA ) astart x ≡ true + → Naccept NFA exists astart x ≡ true +subset-construction-lemma← {Q} {Σ} {n} exists NFA astart x saccept = lemma2 x astart saccept where lemma2 : (x : List Σ) → ( states : Q → Bool ) - → accept ( subset-construction fin NFA astart ) states x ≡ true - → Naccept NFA fin states x ≡ true + → accept ( subset-construction exists NFA ) states x ≡ true + → Naccept NFA exists states x ≡ true lemma2 [] states saccept = saccept - lemma2 (h ∷ t ) states saccept = lemma2 t (δconv fin (Nδ NFA) states h) saccept + lemma2 (h ∷ t ) states saccept = lemma2 t (δconv exists (Nδ NFA) states h) saccept
--- a/agda/turing.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/turing.agda Sun Dec 27 13:26:44 2020 +0900 @@ -121,77 +121,3 @@ where t1 = move {CopyStates} {ℕ} {0} {Copyδ} q L R - ---- --- utm char --- head head position --- send state description end --- del state delimitor --- sstart state description start --- 0 --- 1 --- utm state description --- state-num ℕ ( 0 accept, 1 reject ) --- print 0 write 0, 1 write 1, 2 none --- move 0 left , 1 none 2 write --- utm state --- head-value : ℕ --- current-state : ℕ --- direction : ℕ --- head-dir : ℕ --- --- --------------- head sstart ( state description ) * send input -------------- --- --- loop search sstart ( depend on head position ) --- if state description end reject --- if state-num eq current state --- if accept end --- set current-state, direction and head-value by utm state description --- goto exec --- else goto loop --- exec --- if head-dir = left --- search head towrards letf --- else --- search head towards write --- put head-value --- move head ( considering state description ) --- back to sstart --- goto loop - - - -postulate UTM : Turing ℕ ℕ -postulate encode-for-utm : Turing ℕ ℕ → List ℕ -postulate enumerate-tm : Turing ℕ ℕ → ℕ -postulate utm-simulate : ( tm : Turing ℕ ℕ ) → ( In : List ℕ ) → Turing.taccept UTM ((encode-for-utm tm) ++ In) ≡ Turing.taccept tm In - -record Halt : Set where - field - halt : List ℕ → Bool - TM : Turing ℕ ℕ - -open Halt - -record NotHalt ( H : Halt ) : Set where - field - nothalt : List ℕ → Bool - NegTM : Turing ℕ ℕ - neg : (n : List ℕ ) → nothalt n ≡ negate ( halt H n ) - -open NotHalt - --- neg : ( tm : Turing ℕ ℕ ) → ( h : Halt ) → Bool --- neg tm h = negate ( halt h ( encode-for-utm tm ) ) - -open import Data.Empty - -lemma1 : (H : Halt ) → (NH : NotHalt H ) → nothalt NH (encode-for-utm ( NegTM NH )) ≡ true → ⊥ -lemma1 h nh negneg=1 with halt h (encode-for-utm ( NegTM nh )) | nothalt nh (encode-for-utm ( NegTM nh )) | neg nh (encode-for-utm ( NegTM nh )) -... | true | false | refl = {!!} -... | false | true | refl = {!!} - -lemma2 : (H : Halt ) → (NH : NotHalt H ) → nothalt NH (encode-for-utm ( NegTM NH )) ≡ false → ⊥ -lemma2 h nh negneg=1 with halt h (encode-for-utm ( NegTM nh )) | nothalt nh (encode-for-utm ( NegTM nh )) | neg nh (encode-for-utm ( NegTM nh )) -... | true | false | refl = {!!} -... | false | true | refl = {!!}
--- a/agda/utm.agda Sat Mar 14 19:42:27 2020 +0900 +++ b/agda/utm.agda Sun Dec 27 13:26:44 2020 +0900 @@ -170,7 +170,7 @@ utmδ tidy1 X = tidy1 , write ０ , left utmδ tidy1 Y = tidy1 , write １ , left utmδ tidy1 Z = tidy1 , write B , left -utmδ tidy1 $ = read0 , write $ , right +utmδ tidy1 $ = reads , write $ , right utmδ tidy1 x = tidy1 , write x , left utmδ _ x = halt , write x , mnone @@ -246,4 +246,5 @@ t1 = utm-test2 20 short-input t : (n : ℕ) → utmStates × ( List utmΣ ) × ( List utmΣ ) -t n = utm-test2 n short-input +-- t n = utm-test2 n input+Copyδ +t n = utm-test2 n short-input
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/exercise/003.ind Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,12 @@ +---非決定性オートマトンを決定性オートマトンへ変換 + +以下の NFA をDFAに変換したものを Agda で記述せよ。 + +--1 + +<center><img src="fig/nfa01.svg"></center> + +--2 + +<center><img src="fig/nfa01.svg"></center> +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/exercise/004.ind Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,20 @@ +-title: push down automaton + +以下のCFGを PDA に変換せよ + +小文字と記号は terminal であるとする。 + +各要素を含む例題を作成し、PDAに受け付けられることを示せ。 + +--1 + + + EXPR : '(' EXPR ')' | EXPR '+' EXPR | EXPR '=' EXPR' | x | y | z ; + +--2 + + STATEMENT : + : if EXPR then STATEMENT + | if EXPR then STATEMENT else STATEMENT + | while EXPR '{' STATEMENT '}' + | s | t | u ;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/exercise/005.ind Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,11 @@ +-title: 正規表現の決定性オートマトンへの変換 + +以下の正規表現をDFAに変換せよ。 + +(1) (a*|b*)c + +(2) (a|b)*c + +(3) (a*|b*)c(a|b)*c + +(4) ((a*|b*)c)|((a|b)*c)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/exercise/fig/nfa01.svg Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,139 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> +<svg xmlns:dc="http://purl.org/dc/elements/1.1/" version="1.1" xmlns:xl="http://www.w3.org/1999/xlink" xmlns="http://www.w3.org/2000/svg" viewBox="215 77 767 557" width="767" height="557"> + <defs> + <font-face font-family="Helvetica Neue" font-size="16" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" stroke-linejoin="miter" stroke-miterlimit="10" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"> + <g> + <path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/> + </g> + </marker> + <marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker_2" stroke-linejoin="miter" stroke-miterlimit="10" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"> + <g> + <path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/> + </g> + </marker> + </defs> + <metadata> Produced by OmniGraffle 7.9.1 + <dc:date>2019-01-23 03:51:06 +0000</dc:date> + </metadata> + <g id="Canvas_1" stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"> + <title>Canvas 1</title> + <g id="Canvas_1: Layer 1"> + <title>Layer 1</title> + <g id="Graphic_4"> + <circle cx="226" cy="280.5" r="10.000015979019" fill="black"/> + <circle cx="226" cy="280.5" r="10.000015979019" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_5"> + <circle cx="430.25" cy="236.75" r="53.7500858872269" fill="white"/> + <circle cx="430.25" cy="236.75" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(392.25 227.526)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="29.552" y="15">s0</tspan> + </text> + </g> + <g id="Graphic_9"> + <circle cx="430.25" cy="431.75" r="53.7500858872269" fill="white"/> + <circle cx="430.25" cy="431.75" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(392.25 422.526)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="29.552" y="15">s1</tspan> + </text> + </g> + <g id="Line_10"> + <line x1="235.60428" y1="277.70806" x2="366.9935" y2="239.5135" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_11"> + <line x1="234.26618" y1="286.13084" x2="384.061" y2="388.16953" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_13"> + <path d="M 468.25695 469.75695 C 468.25695 469.75695 551.0758 492.0032 535.8672 534.207 C 520.6586 576.4109 479.06816 612.2216 414.5742 618.72656 C 350.08028 625.2315 314.54528 599.3718 308.21875 557.168 C 303.11057 523.09167 361.02927 487.0574 383.52647 474.44233" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_17"> + <path d="M 392.24305 198.74305 C 392.24305 198.74305 342.92384 175.24084 351 145 C 359.07616 114.75916 377.68764 92.84992 420.75 92 C 463.81236 91.15008 489.54104 111.75916 503 142 C 512.834 164.0959 489.749 184.19585 476.6004 193.42025" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_18"> + <line x1="430.25" y1="290.50003" x2="430.25" y2="368.09997" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_19"> + <line x1="484" y1="236.75" x2="580.6166" y2="242.3558" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_21"> + <rect x="301.71014" y="240.7296" width="19" height="30" fill="white"/> + <text transform="translate(306.71014 246.5056)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + <g id="Graphic_22"> + <rect x="306.02023" y="326.48026" width="19" height="30" fill="white"/> + <text transform="translate(311.02023 332.25626)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Graphic_23"> + <rect x="423.6427" y="77.37604" width="19" height="30" fill="white"/> + <text transform="translate(428.6427 83.15204)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Graphic_24"> + <rect x="408.7233" y="603.3245" width="19" height="30" fill="white"/> + <text transform="translate(413.7233 609.1005)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + <g id="Graphic_25"> + <rect x="514.0533" y="224.04492" width="19" height="30" fill="white"/> + <text transform="translate(519.0533 229.82092)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + <g id="Graphic_27"> + <rect x="420.75" y="317.17157" width="19" height="30" fill="white"/> + <text transform="translate(425.75 322.94757)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Graphic_28"> + <circle cx="644.25" cy="242.92924" r="53.7500858872269" fill="white"/> + <circle cx="644.25" cy="242.92924" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(606.25 233.70524)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="29.552" y="15">s2</tspan> + </text> + </g> + <g id="Line_33"> + <line x1="698" y1="242.92924" x2="879.9298" y2="322.5126" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_35"> + <rect x="740.5101" y="250.68053" width="19" height="30" fill="white"/> + <text transform="translate(745.5101 256.45653)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Group_39"> + <g id="Graphic_41"> + <circle cx="927.75" cy="354.25" r="53.7500858872269" fill="white"/> + <circle cx="927.75" cy="354.25" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_40"> + <circle cx="927.75" cy="354.25" r="49.2500786966684" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(893.35 345.026)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="25.952" y="15">s3</tspan> + </text> + </g> + </g> + <g id="Line_42"> + <line x1="484" y1="431.75" x2="869.4779" y2="364.4271" marker-end="url(#FilledArrow_Marker_2)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_43"> + <rect x="645.3432" y="386.9126" width="19" height="30" fill="white"/> + <text transform="translate(650.3432 392.6886)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + </g> + </g> +</svg>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/exercise/fig/nfa02.svg Sun Dec 27 13:26:44 2020 +0900 @@ -0,0 +1,159 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> +<svg xmlns:dc="http://purl.org/dc/elements/1.1/" version="1.1" xmlns:xl="http://www.w3.org/1999/xlink" xmlns="http://www.w3.org/2000/svg" viewBox="215 77 732 557" width="732" height="557"> + <defs> + <font-face font-family="Helvetica Neue" font-size="16" panose-1="2 0 5 3 0 0 0 2 0 4" units-per-em="1000" underline-position="-100" underline-thickness="50" slope="0" x-height="517" cap-height="714" ascent="951.9958" descent="-212.99744" font-weight="400"> + <font-face-src> + <font-face-name name="HelveticaNeue"/> + </font-face-src> + </font-face> + <marker orient="auto" overflow="visible" markerUnits="strokeWidth" id="FilledArrow_Marker" stroke-linejoin="miter" stroke-miterlimit="10" viewBox="-1 -4 10 8" markerWidth="10" markerHeight="8" color="black"> + <g> + <path d="M 8 0 L 0 -3 L 0 3 Z" fill="currentColor" stroke="currentColor" stroke-width="1"/> + </g> + </marker> + </defs> + <metadata> Produced by OmniGraffle 7.9.1 + <dc:date>2019-01-23 03:48:38 +0000</dc:date> + </metadata> + <g id="Canvas_1" stroke="none" stroke-opacity="1" stroke-dasharray="none" fill="none" fill-opacity="1"> + <title>Canvas 1</title> + <g id="Canvas_1: Layer 1"> + <title>Layer 1</title> + <g id="Graphic_4"> + <circle cx="226" cy="280.5" r="10.000015979019" fill="black"/> + <circle cx="226" cy="280.5" r="10.000015979019" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_5"> + <circle cx="430.25" cy="236.75" r="53.7500858872269" fill="white"/> + <circle cx="430.25" cy="236.75" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(392.25 227.526)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="29.552" y="15">s0</tspan> + </text> + </g> + <g id="Group_39"> + <g id="Graphic_6"> + <circle cx="892.75" cy="242.92924" r="53.7500858872269" fill="white"/> + <circle cx="892.75" cy="242.92924" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_7"> + <circle cx="892.75" cy="242.92924" r="49.2500786966683" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(858.35 233.70524)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="25.952" y="15">s4</tspan> + </text> + </g> + </g> + <g id="Graphic_9"> + <circle cx="430.25" cy="431.75" r="53.7500858872269" fill="white"/> + <circle cx="430.25" cy="431.75" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(392.25 422.526)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="29.552" y="15">s1</tspan> + </text> + </g> + <g id="Line_10"> + <line x1="235.60428" y1="277.70806" x2="366.9935" y2="239.5135" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_11"> + <line x1="234.26618" y1="286.13084" x2="384.061" y2="388.16953" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_13"> + <path d="M 468.25695 469.75695 C 468.25695 469.75695 551.0758 492.0032 535.8672 534.207 C 520.6586 576.4109 479.06816 612.2216 414.5742 618.72656 C 350.08028 625.2315 314.54528 599.3718 308.21875 557.168 C 303.11057 523.09167 361.02927 487.0574 383.52647 474.44233" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_17"> + <path d="M 392.24305 198.74305 C 392.24305 198.74305 342.92384 175.24084 351 145 C 359.07616 114.75916 377.68764 92.84992 420.75 92 C 463.81236 91.15008 489.54104 111.75916 503 142 C 512.834 164.0959 489.749 184.19585 476.6004 193.42025" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_18"> + <line x1="430.25" y1="290.50003" x2="430.25" y2="368.09997" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_19"> + <line x1="484" y1="236.75" x2="580.6166" y2="242.3558" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_21"> + <rect x="301.71014" y="240.7296" width="19" height="30" fill="white"/> + <text transform="translate(306.71014 246.5056)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + <g id="Graphic_22"> + <rect x="306.02023" y="326.48026" width="19" height="30" fill="white"/> + <text transform="translate(311.02023 332.25626)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Graphic_23"> + <rect x="423.6427" y="77.37604" width="19" height="30" fill="white"/> + <text transform="translate(428.6427 83.15204)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Graphic_24"> + <rect x="408.7233" y="603.3245" width="19" height="30" fill="white"/> + <text transform="translate(413.7233 609.1005)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + <g id="Graphic_25"> + <rect x="514.0533" y="224.04492" width="19" height="30" fill="white"/> + <text transform="translate(519.0533 229.82092)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + <g id="Graphic_27"> + <rect x="420.75" y="317.17157" width="19" height="30" fill="white"/> + <text transform="translate(425.75 322.94757)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Graphic_28"> + <circle cx="644.25" cy="242.92924" r="53.7500858872269" fill="white"/> + <circle cx="644.25" cy="242.92924" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(606.25 233.70524)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="29.552" y="15">s2</tspan> + </text> + </g> + <g id="Graphic_29"> + <circle cx="654.25" cy="436.75" r="53.7500858872269" fill="white"/> + <circle cx="654.25" cy="436.75" r="53.7500858872269" stroke="gray" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + <text transform="translate(616.25 427.526)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x="29.552" y="15">s3</tspan> + </text> + </g> + <g id="Line_30"> + <line x1="484" y1="431.75" x2="590.6091" y2="436.3255" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_31"> + <rect x="522.8177" y="418.8237" width="19" height="30" fill="white"/> + <text transform="translate(527.8177 424.5997)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Line_33"> + <line x1="698" y1="242.92924" x2="833.6" y2="242.92924" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Line_34"> + <line x1="692.25695" y1="398.74305" x2="851.5637" y2="285.17644" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_35"> + <rect x="728.1203" y="227.92924" width="19" height="30" fill="white"/> + <text transform="translate(733.1203 233.70524)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">1</tspan> + </text> + </g> + <g id="Graphic_36"> + <rect x="766.7511" y="323.8653" width="19" height="30" fill="white"/> + <text transform="translate(771.7511 329.6413)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + <g id="Line_37"> + <line x1="654.25" y1="382.99997" x2="645.3893" y2="306.5135" marker-end="url(#FilledArrow_Marker)" stroke="black" stroke-linecap="round" stroke-linejoin="round" stroke-width="1"/> + </g> + <g id="Graphic_38"> + <rect x="640.4211" y="330.63285" width="19" height="30" fill="white"/> + <text transform="translate(645.4211 336.40885)" fill="black"> + <tspan font-family="Helvetica Neue" font-size="16" font-weight="400" fill="black" x=".052" y="15">0</tspan> + </text> + </g> + </g> + </g> +</svg>