Is there a way not to use explicit recursion in this algorithm?

Question

So, the problem is that I'm working on matching a template with a list, for example: match "abba" "redbluebluered" -> True or match "abba" "redblueblue" -> False , etc. I wrote an algorithm that works, and I think it is reasonably clear, but I'm not sure if there is a better way to do this without explicit recursion.

 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) sm = case M.lookup pm of Just v -> case stripPrefix vs 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) 

I would call it match "abba" "redbluebluered" empty . The actual algorithm is simple. The map contains templates already matched. At the end it is [a → "red", b → "blue"]. If the next template is the one we saw before, just try matching it and set it aside if you can. Otherwise, failure and return false.

If the next pattern is new, just try matching the new pattern with each prefix in the line and recursive down.

Answer 1

This is very similar to a parsing problem, so let's take a hint from the parsing monad:

• match should return a list of all possible parsing continuations
• If the match fails, it should return an empty list.
• the current set of assignments will consist of the state that must be executed when calculating

To see where we are heading, suppose we have this magic monad. Trying to match "abba" with a string would look like this:

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

It turns out that this monad is the state monad over the List Monad. The list monad provides a countdown, and the state monad carries the current assignment and input.

Here is the code:

 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 pa 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 

Try for example:

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

One more note: code that converts a string of type abba to the monadic value 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' , simply:

 sequence $ map var "abba" 

Update. As @Sassa NF points out, to match the end of the input, you must define:

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

and then paste it into the monad:

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

Answer 2

I would like to change your signature and return more than Bool . Then your solution will look like this:

 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 

Using the famous bending trick to create a function, we can get:

 match ks vs = foldr f end ks M.empty vs where end m [] = Just m end _ _ = Nothing splits xs = zip (inits xs) (tails xs) fkg 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 

Here match is a function that adds all the keys to create a function with Map and a string a , which returns a Map matches of keys with substrings. The matching condition for string a is fully traced by the last function used by foldr - end . If end is supplied with a map and an empty string a , then the match is successful.

The list of keys is added using the function f , which has four arguments: the current key, the function g corresponding to the rest of the list of keys (i.e., either f or end ), a map of the keys already mapped, and the rest of the line a . If the key is already found on the card, simply split the prefix and submit the card, and the remainder - by g . Otherwise, try submitting the modified card and the remainder a for different split combinations. Combinations are checked lazily while g creates Nothing at h .

Answer 3

Here is another solution, more readable, I think, and as inefficient as other solutions:

 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 ] 

The idea is simple: instead of Map , keep both patterns and substrings in a list. Therefore, when we encounter a pattern ( Left p ), we substitute all occurrences of this pattern with a substring and call match' recursively if this substring is striped, and repeat this for each substring that belongs inits processed string. If we encounter an already matched substring ( Right s ), then we just try to split this substring and call match' recursively on a sequential attempt or return False otherwise.