improved 12

code/src/12/Main.hs

@@ -3,25 +3,79 @@ module Main where
 import Data.Char
 import Data.List
 import qualified Data.Map as M
-import Debug.Trace
 
 type Db = M.Map String Node
-
+data Path =
+    Simple [String]
+  | Extra [String]
+    deriving Show
 data Node = Node {
     big :: Bool
   , nbs :: [String]
   } deriving Show
 
-type Path = [String]
-
 main :: IO ()
 main = do
   raw <- getContents
-  let input = mkDb $ map splitInp $ lines raw
+  let input = findPaths [ Simple ["start"] ] [] $ mkDb $ map splitInp $ lines raw
     in do
       putStrLn $ "day12a: " ++ (show $ solveA input)
       putStrLn $ "day12b: " ++ (show $ solveB input)
 
+solveA :: [Path] -> Int
+solveA ps = length $ [ x | Simple x <- ps ]
+
+solveB :: [Path] -> Int
+solveB = length
+
+findPaths :: [Path] -> [Path] -> Db -> [Path]
+findPaths [] comp _ = comp
+findPaths (k:ks) comp db =
+  if rec k == "end"
+  then findPaths ks (k:comp) db
+  else case k of
+    (Extra ps) -> go stepExtra ps
+    (Simple ps) -> go stepSimple ps
+  where
+    rec (Extra (k:_)) = k
+    rec (Simple (k:_)) = k
+    rec _ = error "empty path"
+    go f ps =  findPaths ((f db ps) ++ ks) comp db
+
+stepExtra :: Db -> [String] -> [Path]
+stepExtra _ [] = error "empty list"
+stepExtra db ps = map (Extra . (flip (:) ps)) (l (head ps) db)
+  where
+    isBig s = isUpper $ head s
+    l k db = filter (\n -> (n /= "start") && ((isBig n) || not (n `elem` ps))) $ nbs $ db M.! k
+
+stepSimple :: Db -> [String] -> [Path]
+stepSimple _ [] = error "empty list"
+stepSimple db ps = map (\p -> (c (p:ps))) (l (head ps) db)
+  where
+    isBig s = isUpper $ head s
+    c ps = if isBig (head ps)
+      then Simple ps
+      else
+        let smalls = filter (not . isBig) ps
+        in if any (== (head smalls)) (tail smalls)
+           then Extra ps
+           else Simple ps
+    l k db = filter (/= "start") $ nbs $ db M.! k
+
+-- io and parsing
+
+splitInp :: String -> (String,String)
+splitInp s = (\(a,b) -> (a, drop 1 b)) $ splitAt n s
+  where
+    n = findIn '-' s
+
+findIn :: Char -> String -> Int
+findIn c s = go 0 c s
+  where
+    go n c (s:ss) = if c == s then n else go (n+1) c ss
+    go n c [] = error "bad parse"
+
 mkDb :: [(String,String)] -> Db
 mkDb adjs = foldl f (M.fromList $ (map mkInitDb $ getUniques adjs)) adjs
   where
@@ -36,49 +90,3 @@ mkInitDb s = (,) s
 
 getUniques :: [(String,String)] -> [String]
 getUniques is = nub $ foldl (\t (a,b) -> (a:b:t)) [] is
-
-findPaths :: (Db -> [String] -> [[String]]) -> [[String]] -> [[String]] -> Db -> [[String]]
-findPaths f [] comp _ = comp
-findPaths f (k:ks) comp db = findPaths f (ks ++ new) (nk comp) db
-  where
-    nk = if (head k) == "end"
-         then (k:)
-         else id
-    new = if (head k) /= "end"
-          then f db k
-          else []
-
-nextSteps :: Db -> [String] -> [[String]]
-nextSteps db me = filter f $ map (\n -> (n:me)) nobs
-  where
-    f ss = (isUpper $ (head . head) ss)
-         || not (any (\n -> n == (head ss)) (tail ss))
-    nobs = (nbs $ db M.! (head me))
-
-nextSteps' :: Db -> [String] -> [[String]]
-nextSteps' db me = filter f $ map (\n -> (n:me)) nobs
-  where
-    f ss = (isUpper $ (head . head) ss)
-         || length (g ss) == length (nub (g ss))+1
-         || not (any (\n -> n == (head ss)) (tail ss))
-    nobs = filter (/= "start") (nbs $ db M.! (head me))
-    g ss = filter (\s -> not $ isUpper (head s)) ss
-
-solveA :: Db -> Int
-solveA db = length $ findPaths nextSteps [["start"]] [] db
-
-solveB :: Db -> Int
-solveB db = length $ findPaths nextSteps' [["start"]] [] db
-
--- io and parsing
-
-splitInp :: String -> (String,String)
-splitInp s = (\(a,b) -> (a, drop 1 b)) $ splitAt n s
-  where
-    n = findIn '-' s
-
-findIn :: Char -> String -> Int
-findIn c s = go 0 c s
-  where
-    go n c (s:ss) = if c == s then n else go (n+1) c ss
-    go n c [] = error "bad parse"

code/src/12/test.txt

@@ -0,0 +1,7 @@
+start-A
+start-b
+A-c
+A-b
+b-d
+A-end
+b-end