有沒有辦法在這個算法中不使用顯式遞歸？

Question

所以我正在努力將模式與列表匹配，例如： match "abba" "redbluebluered" -> True或match "abba" "redblueblue" -> False等我編寫了一個有效的算法，我認為這是合理可以理解的，但我不確定如果沒有明確的遞歸，是否有更好的方法可以做到這一點。

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)

我會稱之為match "abba" "redbluebluered" empty 。 實際的算法很簡單。 地圖包含已匹配的模式。 最后是[a - >“red”，b - >“blue”]。 如果下一個模式是我們之前看到過的模式，那么只需嘗試匹配它，如果可以的話，可以向下遞減。 否則失敗並返回false。

如果下一個模式是新的，只需嘗試將新模式映射到字符串中的每個前綴並遞歸。

Answer 1

這與解析問題非常相似，所以讓我們從解析器monad中獲取提示：

• match應返回解析的所有可能延續的列表
• 如果匹配失敗，則應返回空列表
• 當前的分配集將是必須通過計算進行的狀態

為了了解我們的目標，讓我們假設我們有這個神奇的單子。 嘗試將“abba”與字符串匹配將如下所示：

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

test = runMatch matchAbba "redbluebluered"

事實證明，這個monad是List Monad上的State monad。 List monad提供回溯，State monad包含當前的賦值和輸入。

這是代碼：

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

試試，例如：

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

另一點需要指出的是，將像“abba”這樣的字符串轉換為do var'a'; var'b'; var 'b'; var 'a'值的代碼do var'a'; var'b'; var 'b'; var 'a' do var'a'; var'b'; var 'b'; var 'a' do var'a'; var'b'; var 'b'; var 'a'簡單地說：

sequence $ map var "abba"

更新：正如@Sassa NF指出的那樣，要匹配您要定義的輸入結束：

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

然后將其插入monad：

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

Answer 2

我想修改你的簽名並返回超過Bool 。 您的解決方案將成為：

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

使用已知的折疊技巧來生成函數，我們可以獲得：

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

在這里match是一種折疊所有密鑰產生函數取功能Map和串a ，它返回一個Map的鑰匙串的匹配。 為的字符串匹配的條件a以其全文通過由施加的最后功能跟蹤foldr - end 。 如果end與地圖和一個空字符串供給a ，則匹配成功。

使用函數f折疊鍵列表，函數f有四個參數：當前鍵，與鍵列表的其余部分匹配的函數g （即f折疊或end ），已匹配的鍵映射，以及的字符串的其余a 。 如果已在地圖中找到該鍵，則只需刪除前綴並將地圖和剩余部分提供給g 。 否則，嘗試進料的改性地圖和其余a S代表不同分裂組合。 只要g在h產生Nothing ，就可以懶惰地嘗試這些組合。

Answer 3

這是另一個解決方案，我認為更具可讀性，並且與其他解決方案一樣效率低下：

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
    ]

這個想法很簡單：不是使用Map ，而是將模式和匹配的子串存儲在列表中。 所以，當我們遇到一個模式（ Left p ），那么我們就代替這個模式所有出現的子串並調用match'這一子被條紋遞歸，並重復這一過程，每個子，屬於inits一個處理字符串。 如果我們遇到已匹配的子字符串（ Right s ），那么我們只是嘗試去除這個子字符串，並在連續嘗試時遞歸調用match'否則返回False 。