19-1: bfs instead of dfs... now works

1 files changed, 9 insertions, 15 deletions

diff --git a/19-1.hs b/19-1.hs
index 9a602f8..1156b32 100644
--- a/19-1.hs
+++ b/19-1.hs
@@ -1,11 +1,8 @@
 import Control.Monad.ST
-import Data.Foldable (foldrM)
 import Data.HashTable.ST.Basic as H
 import Data.List (nub)
 import Data.Maybe (mapMaybe)
 
-import Debug.Trace
-
 type S s = H.HashTable s String [String]
 
 -- Return Nothing if no match; unmatched remainder (can be []) if
@@ -24,17 +21,14 @@ matchAny s yss xs = do
                in H.insert s xs r >> return r
     Just x -> return x
 
-check :: S s -> [String] -> String -> ST s Bool
-check s yss xs = do
-  zss <- nub <$> matchAny s yss xs
-  if [] `elem` zss
-    then return True
-    else anyM (check s yss) zss
-
-anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
-anyM p = foldrM f False
-  where
-    f a b = (b ||) <$> p a
+check :: S s -> [String] -> [String] -> ST s Bool
+check s yss xss = do
+  zss <- nub . concat <$> mapM (matchAny s yss) xss
+  if null zss
+    then return False
+    else if [] `elem` zss
+         then return True
+         else check s yss zss
 
 parseTowels :: String -> [String]
 parseTowels = map init . words
@@ -47,7 +41,7 @@ parse s = let yss = filter (not . null) . drop 2 $ lines s
 run :: [String] -> [String] -> ST s Int
 run xss yss = do
   ht <- H.new :: ST s (S s)
-  length . filter id <$> traverse (check ht yss) xss
+  length . filter id <$> traverse (check ht yss . pure) xss
 
 main :: IO ()
 main = do