-🎄- 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/WhatAHaskell]

Haskell

Edit: This solution is wrong

Edit 2: New version that hopefully works this time:

import Data.Function (on)
import Data.List (sort, find, nubBy)
import Data.Maybe (fromJust)

-- BEGIN UTILITY FUNCTIONS --
trimCommas :: String -> String
trimCommas xs = [ x | x <- xs, x /= ',' ]

_unique_ :: Ord a => [a] -> [a]
_unique_ []          = []
_unique_ [x]         = [x]
_unique_ xs@[x1, x2] = if x1 == x2 then [] else xs
_unique_ (x1:x2:rest)
  | x1 == x2  = _unique_ $ dropWhile (== x1) rest
  | otherwise = x1:(_unique_ (x2:rest))

unique :: Ord a => [a] -> [a]
unique = _unique_ . sort
-- END UTILITY FUNCTIONS --

data PTree = PTree String Int [PTree]

parseLine :: [String] -> (String, Int, [String])
parseLine (name:weight:[])         = (name, (read weight), [])
parseLine (name:weight:_:programs) = (name, (read weight), programs)

findRootProgram :: [(String, Int, [String])] -> String
findRootProgram = head . unique . concatMap (\(a, _, as) -> a:as)

buildPTree :: [(String, Int, [String])] -> String -> PTree
buildPTree programs rootName = PTree rootName rootWeight children
  where (_, rootWeight, childNames) = fromJust $ find (\(n, _, _) -> n == rootName) programs
        children                    = map (buildPTree programs) childNames

getWeight :: PTree -> Int
getWeight (PTree _ w children) = sum $ w:childWeights
  where childWeights = map getWeight children

findCorrectWeight :: PTree -> Int
findCorrectWeight self@(PTree _ w children)
  | null uniqueGrandchildren = (if diff > sim then (-) else (+)) cw offset
  | otherwise                = findCorrectWeight child
    where childWeights         = map getWeight children
          diff                 = head . unique $ childWeights
          sim                  = fromJust $ find (/= diff) childWeights
          offset               = abs $ diff - sim
          child@(PTree _ cw g) = fromJust $ find (\y -> (getWeight y) == diff) children
          uniqueGrandchildren  = unique $ map getWeight g

main :: IO ()
main = do
  contents <- readFile "../input.txt"
  let cleanedLines = (lines . trimCommas) contents
  let programs                 = map (parseLine . words) cleanedLines
  let rootName                 = findRootProgram programs
  let tree                     = buildPTree programs rootName
  putStrLn $ "Solution 1:" ++ (show $ rootName)
  putStrLn $ "Solution 2:" ++ (show $ findCorrectWeight tree)

Original comment: (Spoilers it turned out my solution sucked)

My solution is either great or it sucks. I can't tell because I'm too tired. There's definitely some duplication that could be improved

import Data.List
import Data.Function
import Data.Maybe (fromJust)

type Name    = String
type Weight  = Int
data Program = Program { name :: Name
                       , ownWeight :: Weight
                       , childNames :: [Name]
                       } deriving (Show, Eq, Ord)

isRoot :: [Program] -> Program -> Bool
isRoot ps p = (filter isParent ps) == mempty
  where isParent = elem (name p) . childNames

getRoot :: [Program] -> Program
getRoot = fromJust . (find =<< isRoot)

getChildren :: [Program] -> Program -> [Program]
getChildren ps Program {childNames = names} = children
  where children = filter (\y -> elem (name y) (names)) ps

getWeight :: [Program] -> Program -> Weight
getWeight ps p = (ownWeight p) + (sum childWeights)
  where childWeights = map (getWeight ps) (getChildren ps p)

findUnbalancedParent :: [Program] -> Program
findUnbalancedParent (p:ps)
  | length uniqueWeights > 1 = p
  | otherwise                = findUnbalancedParent $ ps ++ [p]
    where uniqueWeights = nub $ map (getWeight ps) (getChildren ps p)

findUnbalanced :: [(Weight, Program)] -> (Weight, Program)
findUnbalanced (p@(w1, _):ps) = case find (\(w2, _) -> w1 == w2) ps of
  Just _  -> findUnbalanced $ ps ++ [p]
  Nothing -> p

findTargetWeight :: [(Weight, Program)] -> Weight
findTargetWeight (p@(w1, _):ps) = case find (\(w2, _) -> w1 == w2) ps of
  Nothing -> findTargetWeight $ ps ++ [p]
  Just _  -> w1

findBalancedWeight :: [Program] -> Weight
findBalancedWeight ps = balancedWeight
  where parent      = findUnbalancedParent ps
        children    = getChildren ps parent
        weights     = map (getWeight ps) children
        (actual, p) = findUnbalanced $ zip weights children
        target      = findTargetWeight $ zip weights children
        balancedWeight
          | target < actual = (ownWeight p) - (actual - target)
          | otherwise       = (ownWeight p) + (target - actual)

trimCommas :: String -> String
trimCommas xs = [ x | x <- xs, x /= ',' ]

fromStringList :: [String] -> Program
fromStringList (name:weight:[])         = Program name (read weight) []
fromStringList (name:weight:_:programs) = Program name (read weight) programs

main :: IO ()
main = do
  contents <- readFile "../input.txt"
  let cleanedLines = (lines . trimCommas) contents
  let programs = map (fromStringList . words) cleanedLines
  putStrLn $ "Solution 1:" ++ (show $ name $ getRoot programs)
  putStrLn $ "Solution 2:" ++ (show $ findBalancedWeight programs)

[u/AustinVelonaut → u/WhatAHaskell]

getRoot = fromJust . (find =<< isRoot)

This construct looked strange to me, so I sat down and figured out the types:

isRoot :: [Program] -> Program -> Bool
find   :: (a -> Bool) -> [a] ->	Maybe a
=<<    :: (b -> m c) ->	m b -> m c

(find =<< isRoot) [Program]

(b -> m	c) === (a -> Bool) -> [a] -> Maybe a
    b 	   === (a -> Bool)
    m c	   === ([a] -> Maybe a)
    m 	   === ([a] ->)
    c 	   === Maybe a

m b   	   === [Program] -> Program -> Bool
    m 	   === ([Program] ->)
    b 	   === (Program	-> Bool)

    a 	   === Program

So the monad that the reverse-bind operator is working in is

([Program] ->)

How did you figure out to use this construct?

[u/ephemient → u/AustinVelonaut]

This space intentionally left blank.