From 87c005e7577ddc214b604e28b27f5c46a9d9edec Mon Sep 17 00:00:00 2001
From: Yuchen Pei <me@ypei.me>
Date: Wed, 13 Dec 2017 13:27:55 +0100
Subject: finished day 7

---
 Puzzle7.hs | 106 ++++++++++++++++++++++++++++++-------------------------------
 1 file changed, 53 insertions(+), 53 deletions(-)

diff --git a/Puzzle7.hs b/Puzzle7.hs
index 00dae27..4a1352b 100644
--- a/Puzzle7.hs
+++ b/Puzzle7.hs
@@ -2,6 +2,7 @@ import Data.Set (toList, (\\), fromList)
 import Data.List.Split (splitOn, splitOneOf)
 import Data.Map (Map)
 import qualified Data.Map as Map
+import Data.Maybe (fromJust)
 
 parseInput :: [Char] -> [[Char]]
 parseInput xs = filter (elem '>') (splitOn "\n" xs)
@@ -11,7 +12,6 @@ parseInput xs = filter (elem '>') (splitOn "\n" xs)
 f :: [[Char]] -> [[[Char]]]
 f xs = filter (not . null) <$> splitOneOf (['0' .. '9'] ++ ",()-> ") <$> xs
 
--- 
 g :: [[[Char]]] -> ([[Char]], [[Char]])
 g xs = (head <$> xs, mconcat (tail <$> xs))
 
@@ -21,58 +21,58 @@ solve1FromPair (xs, ys) = head $ toList $ (fromList xs) \\ (fromList ys)
 solve1 :: [Char] -> [Char]
 solve1 = solve1FromPair . g . f . parseInput
 
-parseLine xs = (node, (weight, children))
-  where node:weight:children = splitOneOf ",()-> " xs
-
-parseInput' xs = Map.fromList . (fmap parseLine) . (splitOn "\n") xs
-
-update nodes weights node
-  | null children = Map.insert node weight weights
-  | otherwise = fromJust . Map.lookup $ foldl (newWeights nodes) weights children
-    where (weight, children) = fromJust . Map.lookup node nodes
-
-newWeights nodes weights node = 
-  if member node weights 
-    then weights
-    else update nodes weights node
-
-findAnomaly xs 
-  | null ys  = Nothing
-  | length ys > 1 = Just $ fst $ head xs
-  | otherwise = Just $ fst $ head ys
-    where ys = filter (\z -> snd z /= snd head xs) xs
-
-
-solve2' nodes node weight
-  fst $ until (isNothing . snd) badChild (root, Just root)
-  where 
-    root = solve1 input
-    badChild x
-      | isNothing $ snd x = x
-      | otherwise = findAnomaly (\z -> (z, fromJust $ Map.lookup z weights)) <$> (snd . fromJust . Map.lookup y) nodes
-        where y = fromJust . snd x
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+parseLine :: [Char] -> ([Char], (Int, [[Char]]))
+parseLine xs = (node, (read weight, children))
+  where node:weight:children = filter (not . null) $ splitOneOf ",()-> " xs
+
+parseInput' :: [Char] -> Map [Char] (Int, [[Char]])
+parseInput' = Map.fromList . (fmap parseLine) . (splitOn "\n")
+
+getWeights :: Map [Char] (Int, [[Char]]) -> [Char] -> Map [Char] Int
+getWeights tree node = 
+  if null children
+     then Map.singleton node weight
+     else Map.insert node (weight + (sum $ lookups children childrenWeights)) childrenWeights
+     where (weight, children) = fromJust $ Map.lookup node tree 
+           childrenWeights = Map.unions $ getWeights tree <$> children
+
+findAnomaly :: Map [Char] (Int, [[Char]]) -> Map [Char] Int -> [Char] -> [Char]
+findAnomaly tree weights node
+  | null children = node
+  | maximum cWeights == minimum cWeights = node
+  | otherwise = findAnomaly tree weights $ badChild childrenWithWeights
+    where children = snd $ fromJust $ Map.lookup node tree
+          cWeights = lookups children weights
+          childrenWithWeights = zipWith (,) children cWeights
+          
+lookups :: [[Char]] -> Map [Char] a -> [a]
+lookups xs ys = (\x -> fromJust $ Map.lookup x ys) <$> xs
+
+badChild :: [([Char], Int)] -> [Char]
+badChild (x:y:z:xs) =
+  if (snd x) /= (snd y)
+     then if (snd y) == (snd z)
+             then fst x
+             else fst y
+     else fst $ head $ filter ((/= snd x) . snd) (z:xs)
+
+weightDiff :: [Int] -> Int
+weightDiff (x:y:z:xs) =
+  if x /= y
+     then if y == z
+             then z - x
+             else z - y
+     else head (filter (/= x) (z:xs)) - x
+
+solve2 :: [Char] -> Int
+solve2 xs = 
+  wd + (fst $ fromJust $ Map.lookup node tree)
+    where tree = parseInput' xs
+          root = solve1 xs
+          rootChildren = snd $ fromJust $ Map.lookup root tree
+          weights = getWeights tree root
+          wd = weightDiff $ lookups rootChildren weights
+          node = findAnomaly tree weights root
 
 
 input0 = "pbga (66)\nxhth (57)\nebii (61)\nhavc (66)\nktlj (57)\nfwft (72) -> ktlj, cntj, xhth\nqoyq (66)\npadx (45) -> pbga, havc, qoyq\ntknk (41) -> ugml, padx, fwft\njptl (61)\nugml (68) -> gyxo, ebii, jptl\ngyxo (61)\ncntj (57)"
-- 
cgit v1.2.3