这个算法中有没有不使用显式递归的方法？

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。

如果下一个模式是新的，则尝试将新模式映射到字符串中的每个前缀并递归向下。

- Ramith Jayatilleka

Answer 1

这与解析问题非常相似，所以让我们借鉴解析器单子的提示:

• 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'的代码非常简单：

sequence $ map var "abba"

更新：正如 @Sassa NF 指出的那样，为了匹配输入的结尾，您需要定义：

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

然后将其插入到单子中：

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

- ErikR

---

就像一个常见的解析器问题一样，您需要检查输入是否已完全解析。修改最后两行：(assigns, r) <- get; guard $ r == []; return assigns。 - Sassa NF

sequence . map f 就是 mapM f。 - Cactus

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来折叠键列表，它给出四个参数：当前键、匹配剩余键列表的函数g(即f折叠或end)，已匹配的键的映射和字符串a的剩余部分。如果在映射中已经找到该键，则只需去掉前缀并将映射和剩余部分提供给g。否则，尝试为不同的拆分组合提供修改后的映射和a的剩余部分。只要g在h中产生Nothing，就会惰性地尝试这些组合。

- Sassa NF

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。

- effectfully