71 lines
2.2 KiB
Haskell
71 lines
2.2 KiB
Haskell
import Text.Parsec
|
|
import Text.Parsec.Char
|
|
import Data.List
|
|
|
|
contain
|
|
= do { num <- many1 digit;
|
|
many1 space;
|
|
x <- many1 letter;
|
|
many1 space;
|
|
y <- many1 letter;
|
|
many1 space;
|
|
if num == "1" then
|
|
string "bag"
|
|
else
|
|
string "bags";
|
|
return (x ++ " " ++ y, read num :: Integer);
|
|
}
|
|
|
|
line
|
|
= do { x <- many1 letter;
|
|
many1 space;
|
|
y <- many1 letter;
|
|
many1 space;
|
|
string "bags contain";
|
|
many1 space;
|
|
z <- do { rcar <- contain;
|
|
rcdr <- many $ (string "," >> many space >> contain);
|
|
return $ rcar:rcdr;
|
|
} <|> (string "no other bags" >> return []);
|
|
char '.';
|
|
return (x ++ " " ++ y, z)
|
|
}
|
|
|
|
p
|
|
= many1 $ line >>= \x -> many1 space >> return x
|
|
|
|
search :: Integer
|
|
-> [(String, [(String, Integer)])]
|
|
-> String
|
|
-> [String]
|
|
-> [String]
|
|
-> Integer
|
|
search sum dict target seen lst
|
|
= case lookup target dict of
|
|
Just lst' -> case (filter (\x -> find ((==) x) (target:seen ++ lst) == Nothing) (fst $ unzip lst')) ++ lst of
|
|
x:xs -> search (sum + 1) dict x (target:seen) xs
|
|
[] -> sum
|
|
Nothing -> case lst of
|
|
[] -> sum + 1
|
|
x:xs -> search (sum + 1) dict x (target:seen) xs
|
|
|
|
-- AxDependents -> AxDependancies
|
|
transform :: [(String, [(String, Integer)])]
|
|
-> [(String, [(String, Integer)])]
|
|
transform dict = foldl f [] dict
|
|
where
|
|
f prev (s, kids)
|
|
= foldl (g s) prev kids
|
|
g parent prev (name, i)
|
|
= case lookup name prev of
|
|
Just _ -> map (\(x, parents) -> if x == name then
|
|
(x, (parent, i):parents)
|
|
else
|
|
(x, parents)) prev
|
|
Nothing -> (name, [(parent, i)]):prev
|
|
|
|
main
|
|
= readFile "7" >>= \x -> putStrLn $ case runParser p () "7" x of
|
|
Left err -> show err
|
|
Right x -> show $ search 0 (transform x) "shiny gold" [] [] - 1
|