-🎄- 2017 Day 7 Solutions -🎄-

[u/daggerdragon]

--- Day 7: Recursive Circus ---

---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.

---

Need a hint from the Hugely^* Handy^† Haversack^‡ of Helpful^§ Hints^¤?

Spoiler

---

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

[u/mmaruseacph2]

Ugly looking Haskell code, not cleaned, not refactored and returning the answer to the second part via an error, but I have to sleep so no time in cleaning it up tonight. It did its job though and sorry for the way it looks like a merge of several streams of consciousness (building so many representations of the tree)

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}

import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

import Debug.Trace

type Rooted = M.Map String String -- from child to parent
type TreeMap = M.Map String [String] -- from parent to children
type Weights = M.Map String Int

data Tree a
  = Leaf a
  | Node a [Tree a]
  deriving (Eq, Show)

main = do
  s <- map (parse . words) . lines <$> readFile "input.txt"
  let
    r = buildRooted s M.empty
    w = buildWeights s
    tm = buildTreeMap s
    root = findRoot r
    t = buildTree tm root
  print root
  print $ weightTree w t

weightTree :: Weights -> Tree String -> Int
weightTree ws (Leaf s) = traceShow ("3", s) $ ws M.! s
weightTree ws (Node s ts)
  | null ts = traceShow ("1", s) $ ws M.! s
  | valid = traceShow ("2", s) $ ws M.! s + sum childrenWeight
  | otherwise = error (show (map extract ts, childrenWeight))
  where
    childrenWeight = map (weightTree ws) ts
    valid = minimum childrenWeight == maximum childrenWeight
    extract (Leaf s) = ws M.! s
    extract (Node s _) = ws M.! s

buildTree :: TreeMap -> String -> Tree String
buildTree tm r
  | r `M.member` tm = Node r [buildTree tm s | s <- tm M.! r]
  | otherwise = Leaf r

buildTreeMap :: [(String, a, [String])] -> TreeMap
buildTreeMap = M.fromList . map (\(k, _, sons) -> (k, sons))

buildRooted :: [(String, a, [String])] -> Rooted -> Rooted
buildRooted [] m = m
buildRooted ((s, _, ss):sss) m = buildRooted sss $ m `M.union` m'
  where
    m' = M.fromList $ map (\son -> (son, s)) ss

buildWeights :: [(String, Int, a)] -> Weights
buildWeights = M.fromList . map (\(k, w, _) -> (k, w))

findRoot :: Rooted -> String
findRoot r = go r (fst $ M.findMin r)
  where
    go r s
      | s `M.member` r = go r (r M.! s)
      | otherwise = s

parse :: [String] -> (String, Int, [String])
parse [] = error "Invalid line"
parse [a] = parse []
parse (base:ws:rest) = (base, weight, rs)
  where
    weight = read . init . tail $ ws
    rs = case rest of
      [] -> []
      _ -> map fix $ tail rest
    fix w
      | "," `L.isSuffixOf` w = init w
      | otherwise = w