Haskellでオートマトン
いろいろ昔作ったコードを漁っていると, 半年前に作ったオートマトンのコードがあったのでここに供養.
作成の動機
オートマトンの講義があって, その復習というのもあったと思いますが, Haskellの勉強が主だった思います. Haskellは代数構造を扱いやすいので, オートマトンのような構造と相性が良いと思ったのもあります.
作成したもの
DFA , NFA, ε-NFAを動作させることができるプログラムをそれぞれ作成し, さらにオプションとして機能を少し付け足しました. どのオートマトンもHaskell内ではレコードとして保持しています. オートマトンを作成するには, それぞれの構造にあったレコード型を宣言し, 構築する必要があります.
実現した機能
NFA
- NFAの実行
- テスト関数
- テストオートマトン
ε-NFA
- ε-NFA
- テスト関数
- テストオートマトン
その他
遷移関数と呼ぶぐらいなので遷移関数は関数で実現したかったですが, 入力された文字と現状態の組の場合の数だけ場合分けする面倒な関数になるので, それをすべて入力するぐらいなら最初から表の形で持っておいたほうがシンプルになると思ったからです.
DFAの状態遷移は
基底
DFAのコード
import Control.Monad import Data.List data Status = Number Int deriving (Show,Eq) data DFA = DFA{state::[Status],alpha::[Char],transit::[(Status,Char,Status)],initial::Status,end::[Status],maxnum::Int} deriving (Show,Eq) --タプルの３番目を取り出す third (_,_,z) = z -- --DFAの最小化...judgediff..0入力の際に受理状態とそうでない組に遷移するかを調べる judgediff end (state1,state2) = if (state1 `elem` end) && (not (state2 `elem` end)) || (state2 `elem` end) && (not (state1 `elem` end)) then True else False --diffstate...ある状態の組が1入力の際に区別可能であるか調べる(基礎段階) diffstatebase dfa (state1,state2) = let s1 =map (searchtrans dfa state1) (alpha dfa) s2 =map (searchtrans dfa state2) (alpha dfa) dd = zip s1 s2 in if foldl (||) False (map (judgediff (end dfa)) dd) then True else False --diffstate..ある状態の組が1入力の際に区別可能であるか調べる(区別可能状態のリストを用いる帰納段階) judgediffduct dfa list (state1,state2) = let s1 =map (searchtrans dfa state1) (alpha dfa) s2 =map (searchtrans dfa state2) (alpha dfa) dd = zip s1 s2 in if foldl (||) False (map (`elem` list) dd) then True else False --区別可能でない状態の組を求める mkdfagraph dfa = let statelist = equvalentprc 0 (maxnum dfa) initlist = map (\(x,y) -> ((x,y),diffstatebase dfa (x,y))) statelist xlist = map (\((x,y),_) -> (x,y)) (filter (\((x,y),z) -> if z then True else False) initlist) initlist2 = map (\(x,y) -> ((x,y),judgediff (end dfa) (x,y))) statelist jd = map (\((x,y),_) -> (x,y)) (filter (\((x,y),z) -> if z then True else False) initlist2) judgeduct [] list n = if length list == n then list else judgeduct statelist list (length list) judgeduct (x:xs) list n = if not (x `elem` list) && judgediffduct dfa list x then judgeduct xs (x:list) n else judgeduct xs list n in rmlist statelist (judgeduct statelist (nub (xlist++jd)) (length xlist)) searchtrans dfa q a = let trans = transit dfa dsd = filter (\(x,y,z) -> x == q && y == a) trans in third $ head dsd operation dfa q [] = if q `elem` (end dfa) then True else False operation dfa q (x:xs) = operation dfa (searchtrans dfa q x) xs executedfa dfa xs = operation dfa (initial dfa) xs gusuzero = DFA{initial=Number 0,state=[Number 0,Number 1],alpha="01",transit = [(Number 0,'0',Number 1), (Number 0,'1',Number 0), (Number 1,'0',Number 0), (Number 1,'1',Number 1)],end = [Number 0],maxnum=1} notzero = DFA{initial=Number 0,state=[Number 0,Number 1],alpha="01",transit = [(Number 0,'0',Number 1), (Number 0,'1',Number 0), (Number 1,'0',Number 1), (Number 1,'1',Number 1)],end = [Number 0],maxnum=1} kbtest = DFA{initial = Number 0,state=[Number 0,Number 1,Number 2,Number 3,Number 4],alpha="01",transit= [(Number 0,'0',Number 0), (Number 0,'1',Number 1), (Number 1,'0',Number 2), (Number 1,'1',Number 4), (Number 2,'0',Number 1), (Number 2,'1',Number 3), (Number 3,'0',Number 4), (Number 3,'1',Number 0), (Number 4,'0',Number 4), (Number 4,'1',Number 0)],end = [Number 0],maxnum=4} kbtest2 = DFA{initial = Number 0,state=[Number 0,Number 1,Number 2,Number 3,Number 4,Number 5,Number 6,Number 7],alpha="01",transit= [(Number 0,'0',Number 1), (Number 0,'1',Number 4), (Number 1,'0',Number 2), (Number 1,'1',Number 7), (Number 2,'0',Number 3), (Number 2,'1',Number 1), (Number 3,'0',Number 3), (Number 3,'1',Number 0), (Number 4,'0',Number 5), (Number 4,'1',Number 4), (Number 5,'0',Number 6), (Number 5,'1',Number 3), (Number 6,'0',Number 7), (Number 6,'1',Number 1), (Number 7,'0',Number 3), (Number 7,'1',Number 4)],end = [Number 0,Number 4],maxnum=7} equvalentprc min max = [(Number x,Number y) | x <- [min..max],y <- [x..max]] rmlist [] ys = [] rmlist (x:xs) ys = if x `elem` ys then rmlist xs ys else x:(rmlist xs ys) getsearchtl x [] = [] getsearchtl x ((k,l):ys) = if x == k || x == l then (k,l):(getsearchtl x ys) else getsearchtl x ys searchequ [] = [] searchequ (x:xs) = let g = map snd $ getsearchtl (fst x) (x:xs) getl arr [] = [] getl arr (b:bb) = (getsearchtl b arr):(getl arr bb) d = join $ getl (x:xs) g in g:(searchequ (rmlist xs d)) getNumb (Number x) = x equsearch [] x = 0 equsearch (y:ys) x = if x `elem` y then 0 else 1 + equsearch ys x mkmindfa dfa = let equ = searchequ $ mkdfagraph dfa old = [Number x | x<- [0..maxnum dfa]] news = [Number x | x <- [0..(length equ - 1)] ] fff = map (equsearch equ) old seni = [(Number c,b,Number y) | c <- [0..(length equ -1)] ,b <- alpha dfa, y <- [fff !! (getNumb (searchtrans dfa (head (equ !! c)) b))] ] newe = nub $ map (\x -> Number (fff !! (getNumb x)) ) (end dfa) in DFA{initial = Number (fff !! (getNumb $ initial dfa)),state=news,alpha=alpha dfa,transit=seni,end=newe,maxnum=length news - 1} isMin dfa = let new = mkmindfa dfa in if maxnum new == maxnum dfa then True else False
NFAのコード
import Data.List import Control.Monad data Status = Number Int deriving (Show,Eq,Ord) data NFA = NFA{state::[Status],alpha::[Char],transit::[(Status,Char,[Status])],initial::Status,end::[Status],maxnum::Int} deriving (Show) --third...３要素タプルの３番めを取得 third (_,_,z) = z --unionlist...2リストの積集合を計算 unionlist [] ys = [] unionlist (x:xs) ys = if x `elem` ys then x:(unionlist xs ys) else unionlist xs ys --flatten list--リスト内のリストを平坦化 flatten [] = [] flatten (x:xs) = x++(flatten xs) --searchtrans...nfaの現状態と残りの文字を取得して次状態を返す searchtrans nfa q a = let trans = transit nfa dsd = filter (\(x,y,_) -> x `elem` q && y == a) trans getthird [] = [] getthird (x:xs) = (third x):(getthird xs) in flatten $ getthird dsd --operation...遷移関数を展開し、オートマトンを動かす operation nfa q [] = if (unionlist q (end nfa)) /= [] then True else False operation nfa q (x:xs) = operation nfa (searchtrans nfa q x) xs --executenfa...オートマトンを実行する executenfa nfa xs = operation nfa ([initial nfa]) xs --binalytrans,binaly...１０進値を２進値の文字列に変換する binalytrans 0 = "0" binalytrans 1 = "1" binalytrans n = head (show (n`mod`2)) : binalytrans (n`div`2) binaly n = reverse $ binalytrans n --より一般のテスト shownfa nfa text = do putStrLn $ text++"\t:\t"++(show $ executenfa nfa text) testnfa nfa n = testnfasub nfa n 0 testnfasub nfa n c = do sequence $ map (shownfa nfa) (replicateM c (alpha nfa)) if n > c then testnfasub nfa n (c+1) else return () searchsubset x [] = 0 searchsubset x (y:ys) = if x == y then 0 else 1 + searchsubset x ys washugo xs ys = nub $ xs++ys mkset nfa bb = let ddd = washugo bb [sort $ nub $ searchtrans nfa sst a | a <- alpha nfa,sst<-bb ] in if bb == ddd then ddd else mkset nfa ddd package [] = [] package (x:xs) = [x]:package xs mksubset nfa = let subset = mkset nfa $ [[initial nfa]] news = [Number x | x <- [0..length subset-1]] seni = [(Number x,a,Number y) | x <- [0..length subset-1],a <- alpha nfa ,y <- [searchsubset (searchtrans nfa (subset !! x) a) subset]] newe = map (\x ->Number $ searchsubset x subset) [x | x <- subset, unionlist (end nfa) x /= []] in newe --オートマトン gusuzero = NFA{initial=Number 0,state=[Number 0,Number 1],alpha="01",transit = [(Number 0,'0',[Number 1]), (Number 0,'1',[Number 0]), (Number 1,'0',[Number 0]), (Number 1,'1',[Number 1])],end = [Number 0],maxnum=1} notzero = NFA{initial=Number 0,state=[Number 0,Number 1],alpha="01",transit = [(Number 0,'0',[Number 1]), (Number 0,'1',[Number 0]), (Number 1,'0',[Number 1]), (Number 1,'1',[Number 1])],end = [Number 0],maxnum=1} multthree = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2],alpha="01",transit= [(Number 0,'0',[Number 0]), (Number 0,'1',[Number 1]), (Number 1,'0',[Number 2]), (Number 1,'1',[Number 0]), (Number 2,'0',[Number 1]), (Number 2,'1',[Number 2])],end = [Number 0],maxnum=2} startab = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2],alpha="ab",transit= [(Number 0,'a',[Number 1]), (Number 1,'b',[Number 2]), (Number 2,'a',[Number 2]), (Number 2,'b',[Number 2])],end = [Number 2],maxnum = 2} abstara = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2],alpha="ab",transit= [(Number 0,'a',[Number 1,Number 2]), (Number 1,'b',[Number 0])],end = [Number 2],maxnum = 2} matsubi = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2,Number 3],alpha="ab",transit= [(Number 0,'a',[Number 0,Number 1]), (Number 0,'b',[Number 0,Number 2]), (Number 1,'a',[Number 1,Number 3]), (Number 1,'b',[Number 1]), (Number 2,'b',[Number 2,Number 3]), (Number 2,'a',[Number 2])],end = [Number 3],maxnum = 3}
ε-NFAのコード
import Data.List import Control.Monad data Status = Number Int deriving (Show,Eq) data NFA = NFA{state::[Status],alpha::[Char],transit::[(Status,Char,[Status])],initial::Status,end::[Status],maxnum::Int} deriving (Show) --third...３要素タプルの３番めを取得 third (_,_,z) = z getthird [] = [] getthird (x:xs) = (third x):(getthird xs) --unionlist...2リストの和集合を計算 --intersectlis...2リストの積集合を計算 intersectlist [] ys = [] intersectlist (x:xs) ys = if x `elem` ys then x:(intersectlist xs ys) else intersectlist xs ys unionlist xs ys = nub $ xs++ys --flatten list--リスト内のリストを平坦化 flatten [] = [] flatten (x:xs) = x++(flatten xs) --searche...現在の状態集合に一歩で行けるε遷移を付け足す searche nfa q = let trans = transit nfa dsd = filter (\(x,y,_) -> (q == x) && y == 'ε') trans in unionlist ([q]) (flatten $ getthird dsd) --eclosesub...ECLOSEを求める eclosesub nfa q = let dsd = nub $ flatten $ map (searche nfa) q in if length q == length dsd then q else eclosesub nfa dsd --searchtrans...nfaの現状態と残りの文字を取得して次状態を返す searchtrans nfa q a = let trans = transit nfa eq = eclosesub nfa q dsd = filter (\(x,y,_) -> x `elem` eq && y == a) trans in (eclosesub nfa) (flatten $ getthird dsd) --operation...遷移関数を展開し、オートマトンを動かす operation nfa q [] = if (intersectlist (eclosesub nfa q) (end nfa)) /= [] then True else False operation nfa q (x:xs) = operation nfa (searchtrans nfa q x) xs --executenfa...オートマトンを実行する executenfa nfa xs = operation nfa ([initial nfa]) xs --nfaに文字列を読ませて結果を表示する shownfa nfa text = do putStrLn $ text++"\t:\t"++(show $ executenfa nfa text) --より一般のテスト関数 testnfa nfa n = testnfasub nfa n 0 testnfasub nfa n c = do sequence $ map (shownfa nfa) (replicateM c (alpha nfa)) if n > c then testnfasub nfa n (c+1) else return () --オートマトン gusuzero = NFA{initial=Number 0,state=[Number 0,Number 1],alpha="01",transit = [(Number 0,'0',[Number 1]), (Number 0,'1',[Number 0]), (Number 1,'0',[Number 0]), (Number 1,'1',[Number 1])],end = [Number 0],maxnum=1} notzero = NFA{initial=Number 0,state=[Number 0,Number 1],alpha="01",transit = [(Number 0,'0',[Number 1]), (Number 0,'1',[Number 0]), (Number 1,'0',[Number 1]), (Number 1,'1',[Number 1])],end = [Number 0],maxnum=1} multthree = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2],alpha="01",transit= [(Number 0,'0',[Number 0]), (Number 0,'1',[Number 1]), (Number 1,'0',[Number 2]), (Number 1,'1',[Number 0]), (Number 2,'0',[Number 1]), (Number 2,'1',[Number 2])],end = [Number 0],maxnum=2} startab = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2],alpha="ab",transit= [(Number 0,'a',[Number 1]), (Number 1,'b',[Number 2]), (Number 2,'a',[Number 2]), (Number 2,'b',[Number 2])],end = [Number 2],maxnum = 2} abstara = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2],alpha="ab",transit= [(Number 0,'a',[Number 1,Number 2]), (Number 1,'b',[Number 0])],end = [Number 2],maxnum = 2} matsubi = NFA{initial=Number 0,state=[Number 0,Number 1,Number 2,Number 3],alpha="ab",transit= [(Number 0,'a',[Number 0,Number 1]), (Number 0,'b',[Number 0,Number 2]), (Number 1,'a',[Number 1,Number 3]), (Number 1,'b',[Number 1]), (Number 2,'b',[Number 2,Number 3]), (Number 2,'a',[Number 2])],end = [Number 3],maxnum = 3} aauto = NFA{initial = Number 0,state=[Number 0,Number 1],alpha="ab",transit= [(Number 0,'a',[Number 0]), (Number 0,'b',[Number 1]), (Number 1,'a',[Number 1]), (Number 1,'b',[Number 1]), (Number 1,'ε',[Number 0])],end = [Number 1],maxnum = 3} abc = NFA{initial = Number 0,state=[Number 0,Number 1],alpha="abc",transit= [(Number 0,'a',[Number 0]), (Number 0,'ε',[Number 1]), (Number 1,'b',[Number 1]), (Number 2,'c',[Number 2]), (Number 1,'ε',[Number 2])],end = [Number 2],maxnum = 3} matsubifive = NFA{initial = Number 0,state=[Number 0,Number 1,Number 2,Number 3,Number 4,Number 5],alpha="01",transit= [(Number 0,'0',[Number 0]), (Number 0,'1',[Number 0,Number 1]), (Number 1,'ε',[Number 2]), (Number 1,'0',[Number 2]), (Number 1,'1',[Number 2]), (Number 2,'ε',[Number 3]), (Number 2,'0',[Number 3]), (Number 2,'1',[Number 3]), (Number 3,'ε',[Number 4]), (Number 3,'0',[Number 4]), (Number 3,'1',[Number 4]), (Number 4,'ε',[Number 5]), (Number 4,'0',[Number 5]), (Number 4,'1',[Number 5])],end = [Number 5],maxnum = 5}
