Автоматы Pushdown в Haskell с использованием списка Monad - PullRequest
Новая
       30

Автоматы Pushdown в Haskell с использованием списка Monad

0 голосов
/ 14 февраля 2019

Я пытаюсь реализовать автоматы Pushdown (как описано в разделе Введение в теорию вычислений Sipser) в Haskell.У меня есть рабочее определение: 

import Data.List
import Data.Maybe(fromMaybe)

-- A Pushdown Automaton with states of type q,
-- inputs of type s, and a stack of type g
data PDA q s g = P { state :: [q]
                   , start :: q
                   , delta :: [Rule q s g]
                   -- the transition function is list of relations
                   , final :: [q]  -- list of accept states
                   }

-- rules are mappings from a (state, Maybe input, Maybe stack) to
-- a list of (state, Maybe stack)
-- Nothing represents the empty element ε
type Rule q s g = ((q, Maybe s, Maybe g), [(q, Maybe g)])

push :: Maybe a -> [a] -> [a]
push (Just x) xs = x:xs
push Nothing  xs = xs

-- returns the popped element and the stack without that element
pop :: [a] -> (Maybe a, [a])
pop (x:xs) = (Just x, xs)
pop [] = (Nothing, [])

lookup' :: Eq a => a -> [(a, [b])] -> [b]
lookup' a xs = fromMaybe [] (lookup a xs)

-- calls deltaStar with the start state and an empty stack,
-- and checks if any of the resulting states are accept states
accepts :: (Eq q, Eq s, Eq g) => PDA g s q -> [s] -> Bool
accepts p xs = any ((`elem` final p). fst) $ deltaStar (start p) (delta p) xs []

deltaStar :: (Eq q, Eq s, Eq g)
          => q  -- the current state
          -> [Rule q s g] -- delta
          -> [s] -- inputs
          -> [g] -- the stack
          -> [(q, Maybe g)]
deltaStar q rs (x:xs) st = nub . concat $
  map (\(a, b) -> deltaStar a rs xs $ push b stack)
    (lookup' (q, Just x, fst $ pop st) rs) ++
  map (\(a, b) -> deltaStar a rs (x:xs) $ push b stack)
    (lookup' (q, Nothing, fst $ pop st) rs) ++
  map (\(a, b) -> deltaStar a rs xs $ push b st)
    (lookup' (q, Just x, Nothing) rs) ++
  map (\(a, b) -> deltaStar a rs (x:xs) $ push b st)
    (lookup' (q, Nothing, Nothing) rs)
  where stack = snd $ pop st
deltaStar q rs [] st = nub $ (q, Nothing)
                           : lookup' (q, Nothing, fst $ pop st) rs
                           ++ lookup' (q, Nothing, Nothing) rs

, которое дает мне ожидаемые результаты.Однако, глядя на мою deltaStar функцию, я не могу не чувствовать, что должен быть более элегантный способ ее написания.Я вручную проверяю для переходов, которые имеют ε во входных данных или в стеке, что я не думаю, что смогу обойти, но этот вид недетерминизма с использованием concat и map мне кажется монадой List.Я хотел бы иметь возможность написать что-то вроде 

deltaStar q rs (x:xs) st = do
(a, b) <- lookup' (q, Just x, fst $ pop st) rs
(c, d) <- lookup' (q, Nothing, fst $ pop st) rs
(e, f) <- lookup' (q, Just x, Nothing) rs
(g, h) <- lookup' (q, Nothing, Nothing) rs
concat [ deltaStar a rs xs $ push b stack
      , deltaStar c rs (x:xs) $ push d stack
      , deltaStar e rs xs $ push f st
      , deltaStar g rs (x:xs) $ push h st]
where stack = snd $ pop st
deltaStar q rs [] st = nub $ (q, Nothing)
                           : lookup' (q, Nothing, fst $ pop st) rs
                           ++ lookup' (q, Nothing, Nothing) rs

Но это deltaStar почти всегда будет возвращать [], так как, когда любой из шаблонов связывается неудачно, все вычисления возвращают [].Есть ли решение для этого или я должен придерживаться своего определения?

Я проверил свою первоначальную функцию с языком True^n False^n, определенным так: 

langA :: PDA Int Bool Char
langA = P [1,2,3,4]
          1
          delta
          [1,4]
  where delta = [ ((1, Nothing, Nothing), [(2, Just '$')])
                , ((2, Just False, Nothing),[(2, Just '0')])
                , ((2, Just True, Just '0'), [(3, Nothing)])
                , ((3, Just True, Just '0'), [(3, Nothing)])
                , ((3, Nothing, Just '$'), [(4, Nothing)])]

Ответы [ 2 ]

0 голосов
/ 14 февраля 2019

Ответ Ли-Яо Ся показывает, как использовать более полиморфные операции класса типов, но не устраняет дублирование кода.В этом ответе я покажу, как решить эту проблему.Основная идея такова: есть только две вещи, которые различаются, и они различаются независимо друг от друга, а именно: потребляем ли мы букву и потребляем ли мы из стека.Так что давайте недетерминированно выберем для каждого!

(Предупреждение: непроверенный код следует.) 

deltaStar q rs (x:xs) st = do
    (stackSymbol, st') <- [pop st, (Nothing, st)]
    (stringSymbol, xs') <- [(Just x, xs), (Nothing, x:xs)]
    (a, b) <- lookup' (q, stringSymbol, stackSymbol) rs
    deltaStar a rs xs' (push b st')
0 голосов
/ 14 февраля 2019

В исходном определении (++) разделяет поиски, что соответствует выбору (<|>) в недетерминированной интерпретации []. 

deltaStar q rs (x:xs) st = nub . asum $
  [ do (a, b) <- lookup' (q, Just x, fst $ pop st) rs
       deltaStar a rs xs $ push b stack
  , do (a, b) <- lookup' (q, Nothing, fst $ pop st) rs
       deltaStar a rs (x:xs) $ push b stack
  , do (a, b) <- lookup' (q, Just x, Nothing) rs
       deltaStar a rs xs $ push b st
  , do (a, b) <- lookup' (q, Nothing, Nothing) rs
       deltaStar a rs (x:xs) $ push b st
  ] where stack = snd $ pop st
-- asum [a, b, c d] = a <|> b <|> c <|> d = a ++ b ++ c ++ d
--                  = concat [a, b, c, d]
...