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

Question

So the problem I'm working on matching a pattern to a list, such like this: match "abba" "redbluebluered" -> True or match "abba" "redblueblue" -> False, etc. I wrote up an algorithm that works, and I think it's reasonable understandable, but I'm not sure if there's 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) 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)

I would call this like match "abba" "redbluebluered" empty. The actual algorithm is simple. The map contains the patterns already matched. At the end it is [a - > "red", b -> "blue"]. If the next pattern is one we've seen before, just try matching it and recurse down if we can. Otherwise fail and return false.

If the next pattern is new, just try mapping the new pattern to every single prefix in the string and recursing down.

Answer 1

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

• match should return a list of all of the possible continuations of the parse
• if matching fails it should return the empty list
• the current set of assignments will be state that has to carried through the computation

To see where we are headed, let's suppose we have this magic monad. Attempting to match "abba" against a string will look like:

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

test = runMatch matchAbba "redbluebluered"

It turns out this monad is the State monad over the List monad. The List monad provides for backtracking and the State monad carries the current assignments and input around.

Here's 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 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

Try, for instance:

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

Another thing to point out is that code which transforms a string like "abba" to the monadic value do var'a'; var'b'; var 'b'; var 'a' is simply:

sequence $ map var "abba"

Update: As @Sassa NF points out, to match the end of input you'll want to define:

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

and then insert it into the monad:

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