Czy istnieje sposób, aby nie używać jawnej rekurencji w tym algorytmie?

Question

Więc problem, nad którym pracuję, polega na dopasowaniu wzorca do listy, takiej jak ta: match "abba" "redbluebluered" -> True lub match "abba" "redblueblue" -> False itp. Napisałem algorytm, który działa, i myślę, że jest to rozsądne zrozumiałe, ale nie jestem pewien jeśli jest lepszy sposób na to bez wyraźnej rekursji.

import Data.HashMap.Strict as M 
match :: (Eq a, Eq k, Hashable k) => [k] -> [a] -> HashMap k [a] -> Bool 
match []  [] _ = True 
match []  _ _ = False 
match _  [] _ = False 
match (p:ps) s m = 
    case M.lookup p m of 
    Just v -> 
     case stripPrefix v s of 
     Just post -> match ps post m 
     Nothing -> False 
    Nothing -> any f . tail . splits $ s 
     where f (pre, post) = match ps post $ M.insert p pre m 
      splits xs = zip (inits xs) (tails xs) 

Nazwałbym to tak jak match "abba" "redbluebluered" empty. Rzeczywisty algorytm jest prosty. Mapa zawiera wzory już dopasowane. Na końcu jest [a -> "czerwony", b -> "niebieski"]. Jeśli następny wzór jest taki, jaki widzieliśmy wcześniej, po prostu spróbuj go dopasować i przerwij, jeśli to możliwe. W przeciwnym razie przestaw i zwróć wartość false.

Jeśli następny wzorzec jest nowy, po prostu spróbuj odwzorować nowy wzorzec na każdy przedrostek w łańcuchu i ponowić.

Answer 1

ten jest bardzo podobny do problemu analizowania, więc rzućmy podpowiedź z monady parsera:

• match powinny zwróci listę wszystkich możliwych kontynuacje parse
• jeśli dopasowanie zawodzi należy zwrócić pustą listę
• obecny zestaw zadań będzie państwo, które ma być przewożone przez obliczeń

aby zobaczyć, gdzie jesteśmy na czele, niech su ppose mamy magiczną monadę. Próbując dopasować: „Abba” przeciw ciąg będzie wyglądać następująco:

matchAbba = do 
    var 'a' 
    var 'b' 
    var 'b' 
    var 'a' 
    return() -- or whatever you want to return 

test = runMatch matchAbba "redbluebluered" 

Okazuje się to monada jest monada państwa nad monady listy. Monada List przewiduje backtracking, a monada stanów przenosi aktualne zadania i wprowadzanie.

Oto kod:

import Data.List 
import Control.Monad 
import Control.Monad.State 
import Control.Monad.Trans 
import Data.Maybe 
import qualified Data.Map as M 
import Data.Monoid 

type Assigns = M.Map Char String 

splits xs = tail $ zip (inits xs) (tails xs) 

var p = do 
    (assigns,input) <- get 
    guard $ (not . null) input 
    case M.lookup p assigns of 
    Nothing -> do (a,b) <- lift $ splits input 
        let assigns' = M.insert p a assigns 
        put (assigns', b) 
        return a 
    Just t -> do guard $ isPrefixOf t input 
        let inp' = drop (length t) input 
        put (assigns, inp') 
        return t 

matchAbba :: StateT (Assigns, String) [] Assigns 
matchAbba = do 
    var 'a' 
    var 'b' 
    var 'b' 
    var 'a' 
    (assigns,_) <- get 
    return assigns 

test1 = evalStateT matchAbba (M.empty, "xyyx") 
test2 = evalStateT matchAbba (M.empty, "xyy") 
test3 = evalStateT matchAbba (M.empty, "redbluebluered") 

matches :: String -> String -> [Assigns] 
matches pattern input = evalStateT monad (M.empty,input) 
    where monad :: StateT (Assigns, String) [] Assigns 
     monad = do sequence $ map var pattern 
        (assigns,_) <- get 
        return assigns 

Spróbuj na przykład:

matches "ab" "xyz" 
-- [fromList [('a',"x"),('b',"y")],fromList [('a',"x"),('b',"yz")],fromList [('a',"xy"),('b',"z")]] 

Inną rzeczą, aby zwrócić uwagę na to, że kod, który przekształca ciąg jak "abba" do wartości monadycznej do var'a'; var'b'; var 'b'; var 'a' jest po prostu :

sequence $ map var "abba" 

Aktualizacja: As @Sassa NF wskazuje, aby dopasować koniec umieścić będziemy chcieli, aby określić:

matchEnd :: StateT (Assigns,String) []() 
matchEnd = do 
    (assigns,input) <- get 
    guard $ null input 

a następnie włóż ją do monady:

 monad = do sequence $ map var pattern 
        matchEnd 
        (assigns,_) <- get 
        return assigns 

Answer 2

Chciałbym zmienić swój podpis i zwrócić więcej niż Bool. Rozwiązanie staje się:

match :: (Eq a, Ord k) => [k] -> [a] -> Maybe (M.Map k [a]) 
match = m M.empty where 
    m kvs (k:ks) vs@(v:_) = let splits xs = zip (inits xs) (tails xs) 
          f (pre, post) t = 
           case m (M.insert k pre kvs) ks post of 
           Nothing -> t 
           x  -> x 
          in case M.lookup k kvs of 
           Nothing -> foldr f Nothing . tail . splits $ vs 
           Just p -> stripPrefix p vs >>= m kvs ks 
    m kvs [] [] = Just kvs 
    m _ _ _ = Nothing 

Stosując znany trick składane w celu uzyskania funkcji możemy uzyskać:

match ks vs = foldr f end ks M.empty vs where 
    end m [] = Just m 
    end _ _ = Nothing 
    splits xs = zip (inits xs) (tails xs) 
    f k g kvs vs = let h (pre, post) = (g (M.insert k pre kvs) post <|>) 
       in case M.lookup k kvs of 
        Nothing -> foldr h Nothing $ tail $ splits vs 
        Just p -> stripPrefix p vs >>= g kvs 

Tutaj match jest funkcja składanych wszystkie klucze do produkcji funkcję robienia Map oraz ciąg znaków a, który zwraca Map dopasowań kluczy do podciągów. Warunek dopasowania ciągu znaków a w całości jest śledzony przez ostatnią funkcję zastosowaną przez foldr - end. Jeśli end jest dostarczany z mapą i pustym łańcuchem a, to mecz się powiódł.

lista kluczy jest składany za pomocą funkcji f, co jest podane cztery argumenty: bieżący klucz, funkcja g dopasowanie pozostałą część listy kluczy (tj albo f pozaginane lub end), już mapą klawiszy dopasowany, a pozostała część ciągu a. Jeśli klucz już znajduje się na mapie, po prostu usuń prefiks i podaj mapę, a resztę do g. W przeciwnym razie spróbuj przesłać zmodyfikowaną mapę i resztę z a s dla różnych kombinacji podziału. Kombinacje są testowane leniwie, o ile g wytwarza Nothing w h.

Answer 3

Oto inne rozwiązanie, bardziej czytelny, myślę, jak i nieefektywne innych rozwiązań:

import Data.Either 
import Data.List 
import Data.Maybe 
import Data.Functor 

splits xs = zip (inits xs) (tails xs) 

subst :: Char -> String -> Either Char String -> Either Char String 
subst p xs (Left q) | p == q = Right xs 
subst p xs  q   = q 

match' :: [Either Char String] -> String -> Bool 
match'   [] [] = True 
match' (Left p : ps) xs = or [ match' (map (subst p ixs) ps) txs 
           | (ixs, txs) <- tail $ splits xs] 
match' (Right s : ps) xs = fromMaybe False $ match' ps <$> stripPrefix s xs 
match'   _ _ = False 

match = match' . map Left 

main = mapM_ (print . uncurry match) 
    [ ("abba" , "redbluebluered"     ) -- True 
    , ("abba" , "redblueblue"      ) -- False 
    , ("abb"  , "redblueblue"      ) -- True 
    , ("aab"  , "redblueblue"      ) -- False 
    , ("cbccadbd", "greenredgreengreenwhiteblueredblue") -- True 
    ] 

Pomysł jest prosty: zamiast mieć Map, przechowuj oba wzory i dopasowane podciągi na liście. Więc gdy napotkamy wzór (Left p), wówczas zastępujemy wszystkie wystąpienia tego wzorca podciąganiem i wywołujemy rekurencyjnie rekurencyjnie z tym podciągiem i powtarzamy to dla każdego podłańcucha, które należy do inits przetworzonego łańcucha. Jeśli natkniemy się na już dopasowany podciąg (Right s), wówczas po prostu próbujemy usunąć ten podciąg i wywołać rekurencyjnie match' przy kolejnej próbie lub w inny sposób zwrócić False.