在 Haskell 中表示非确定性有限状态机模拟器

Question

我在 Udacity 上关注“编程语言”，并尝试在 Haskell 中表示问题集。答案是用 Python 写的：

edges = {(1,"a") : [2,3]
        ,(2,"a") : [2]
        ,(3,"b") : [3,4]
        ,(4,"c") : [5]}

accepting = [2,5]

def nfsmSim(string, current, edges, accepting):
    if string == "":
        return current in accepting
    else:
        letter = string[0]
        key = (current, letter)
        if key in edges:
            rest = string[1:]
            states = edges[key]
            for state in states:
                if nfsmSim(rest, state, edges, accepting):
                    return True
         return False

起始状态始终是第一个状态，即current = 1。

"aaa" 或 "abc" 等字符串被接受，而 "abb" 或 "aabc" 或被拒绝。

我尝试使用 Haskell 重写：

nfsmSim [] c _  = [c]
nfsmSim xs c es = [concat $ nfsmSim (tail xs) s es | (k,ss) <- es, s <- ss, x <- xs, k==(c,x)]

我想返回一个整数列表，这些整数表示输入字符串末尾的最后一个状态，然后filter 这些与接受状态相对应，并使用any 得到最终的True 或False。

我意识到这可能不是 Haskell 执行此操作的方法，并且可能有更好的 wholemeal 解决方案。然而，作为一个初学者，我正在与 mondadic 机制作斗争，而且很可能是这个问题的递归性质。

请可能使用do 表示法而不是列表理解为我指出正确的方向。

Answer 1

让我们首先考虑类型。您的 Python 函数或多或少具有以下类型：

type State   = Int
type Map k v = [(k,v)]

nfsmSim :: String -> State -> Map (Int, Char) [State] -> [State] -> Bool
nfsmSim string current edges accepting = …

我们可以对空字符串大小写使用模式匹配：

nfsmSim :: String -> State -> Map (Int, Char) [State] -> [State] -> Bool
nfsmSim "" current _ accepting = current `elem` accepting

对于非空的情况，我们和你的 Python 代码一样：

nfsmSim (x:xs) current edges accepting =
    let rest   = xs
        states = [s | (k,v) <- edges, k == (current,x), s <- v]
    in or [nfsmSim rest state edges accepting | state <- states]

但是，这并不容易使用。相反，让我们将nfsmSim 写成高阶函数并改变参数的顺序：

nfsmSim :: (State -> Char -> [State])
        -> (State -> Bool)
        -> String
        -> State
        -> Bool

现在，我们必须提供一个函数来返回给定状态和字符的状态列表（可能为空），而不是接受状态列表，而不是边列表，我们提供返回的函数True 在这些州。

对于空字符串的情况，不用太多改动：

nfsmSim advance accept "" current = accept current

我们只需使用我们的State -> Bool 来检查我们当前的状态是否可以接受。

但是，既然我们的State 是nfsmSim 的最后一个参数，我们可以使用currying 来使用您的any 方法：

nfsmSim advance accept (x:xs) current = 
    any (nfsmSim advance accept xs) (advance current x)

请注意，携带所有参数有点笨拙。你通常会为此写一个工人：

nfsmSim :: (a -> b -> [a]) -> (a -> Bool) -> [b] -> a -> Bool
nfsmSim advance accept string current = go string current
  where
    go []     c = accept c
    go (x:xs) c = any (go xs) (advance c x)

顺便说一句，你仍然可以在最后一个变体中使用“edges”和“accepting”，

nfsmSimAccept string current edges accepting =
   let accept  c   = c `elem` accepting
       advance c x = [s | (k,v) <- edges, k == (c,x), s <- v]
   in nfsmSim advance accept string current

这表明高阶函数更灵活。

Answer 2

这是我的 Haskell-ish 方法：

我们可以使用 haskell 的 Data.Set 和 Data.Map 库来表示我们的状态机。

import qualified Data.Map as M
import qualified Data.Set as S

让我们为状态机定义一些数据类型：

type State = Int
type Edge = (State, Char)
type Machine = (M.Map Edge (S.Set State), S.Set State)

我们这样定义机器：

myMachine :: Machine
myMachine = (M.fromList
    [ ((1, 'a'), S.fromList [2, 3])
    , ((2, 'a'), S.fromList [2   ])
    , ((3, 'b'), S.fromList [3, 4])
    , ((4, 'c'), S.fromList [5   ])
    ] , S.fromList [2, 5])

我们可以这样运行机器：

runMachine :: String -> Machine -> State -> Bool
runMachine "" (_, acceptingStates) currentState =
    S.member currentState acceptingStates
runMachine (ch:rest) machine@(edges, _) currentState =
    case M.lookup (currentState, ch) edges of
        Nothing -> False
        Just nextStates ->
            or $ S.map (runMachine rest machine) nextStates

由于该函数返回一个Bool，所以没有很好的理由使用monad 或do-notation。然而，如果我们使用类型 Maybe () 代替 Bool，这样的解决方案是可能的，其中 Just () 代表 True，Nothing 代表 False。

Answer 3

首先，据我所知，没有“非有限状态机”之类的东西。从你写的来看，我意识到这是关于“非确定性有限自动机（NFA）”。

第一个变体。

nfa :: String -> Int -> [((Int, Char), [Int])] -> [Int] -> Bool
nfa       [] cur     _ acc = cur `elem` acc
nfa (c:rest) cur edges acc
    | Just states <- lookup (cur, c) edges = any (\state -> nfa rest state edges acc) states
    | otherwise                            = False

edges =
    [ ((1, 'a'), [2, 3])
    , ((2, 'a'), [2])
    , ((3, 'b'), [3, 4])
    , ((4, 'c'), [5])
    ]

accepting = [2, 5]

main = do
    print $ nfa "aaa" 1 edges accepting
    print $ nfa "abc" 1 edges accepting
    print $ nfa "abb" 1 edges accepting
    print $ nfa "aabc" 1 edges accepting

输出将是：

True
True
False
False

第二种变体：

import Control.Monad
import Data.Maybe

nfa2 :: String -> Int -> [((Int, Char), [Int])] -> [Int] -> [Int]
nfa2       [] cur     _ acc = guard (cur `elem` acc) >> return cur
nfa2 (c:rest) cur edges acc = do
    state <- fromMaybe mzero $ lookup (cur, c) edges
    nfa2 rest state edges acc

edges =
    [ ((1, 'a'), [2, 3])
    , ((2, 'a'), [2])
    , ((3, 'b'), [3, 4])
    , ((4, 'c'), [5])
    ]

accepting = [2, 5]

main = do
    print $ nfa2 "aaa" 1 edges accepting
    print $ nfa2 "abc" 1 edges accepting
    print $ nfa2 "abb" 1 edges accepting
    print $ nfa2 "aabc" 1 edges accepting

输出将是：

[2]
[5]
[]
[]