2014-11-15 4 views
6

그래서 패턴과 일치하는 문제는 다음과 같습니다. 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를 반환합니다.

다음 패턴이 새로운 경우 새 패턴을 문자열의 모든 단일 접두사에 매핑하고 다시 반복 해보십시오.

답변

6

이것은 구문 분석 문제와 매우 유사합니다, 그래서 파서 모나드에서 힌트를 보자 :

  • match
  • 이 일치가 실패하면 해석의 가능성 연속성을 모든 목록을 반환해야 빈 목록을 반환해야
  • 과제의 현재 세트는

우리가 향하고 곳의 스와하게 볼 수있는 계산을 통해 수행에이 상태가 될 것입니다 우리는이 마법의 모나드를 가지고 있습니다. 그것은이 모나드는리스트 모나드를 통해 국가 모나드입니다 밝혀

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

test = runMatch matchAbba "redbluebluered" 

: 같은 문자열에 대해 "아바"을 일치하려고하면 찾을 것입니다. List 모나드는 backtracking을 제공하고 State 모나드는 현재 할당과 입력을 전달합니다.

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")]] 

지적하는 또 다른 것은 모나드 값을 "아바"와 같은 문자열을 변환하는 코드가 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 
+0

일반적인 파서 문제와 마찬가지로 여기서 입력을 완전히 구문 분석해야합니다. 마지막 두 줄 수정 :'(assigns, r) <- get; 가드 $ r == []; return은 ' –

+0

'시퀀스를 할당합니다. map f는'mapM f'입니다. – Cactus

1

서명을 수정하고 Bool 이상을 보내고 싶습니다. 귀하의 솔루션은 다음이된다 :

match :: (Eq a, Ord k) => [k] -> [a] -> Maybe (M.Map k [a]) 
match = m M.empty where 
    m kvs (k:ks) [email protected](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

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 

있는 Map과 복용 기능을 생산하기 위해 모든 키를 접는 기능 문자열은 a이며 키의 일치 항목 중 Map을 부분 문자열에 반환합니다. 문자열 a의 전체 일치 조건은 foldr-end에 의해 마지막으로 적용된 함수에 의해 추적됩니다. end에지도가 제공되고 a의 빈 문자열이면 일치가 성공한 것입니다.

네 개의 인자가되는 함수 f를 사용 절첩 키 목록 : 현재 키 (즉, 어느 접혀 f 또는 end) 키 목록, 이미 키 맵의 나머지와 일치하는 기능 g 일치하고 나머지 문자열은 a입니다. 키가 이미지도에서 발견되면 접두사를 제거하고지도를 입력하고 나머지는 g으로 보내십시오. 그렇지 않은 경우 수정 된지도와 나머지 분할 조합에 대해 a의 나머지 부분을 입력하십시오. gNothing 인 경우 지연 조합을 시도하면 h이됩니다.

0

은 다른 솔루션과 같은 더 읽기, 내가 생각하고 비효율적 인 또 다른 솔루션입니다 :

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을 반환합니다.

관련 문제