day7
This commit is contained in:
parent
13663cdea4
commit
26eca87c9e
2 changed files with 102 additions and 4 deletions
94
src/Day7.hs
94
src/Day7.hs
|
@ -71,6 +71,36 @@ in front of you is much larger.)
|
||||||
Before you're ready to help them, you need to make sure your information is
|
Before you're ready to help them, you need to make sure your information is
|
||||||
correct. What is the name of the bottom program?
|
correct. What is the name of the bottom program?
|
||||||
|
|
||||||
|
--- Part Two ---
|
||||||
|
|
||||||
|
The programs explain the situation: they can't get down. Rather, they could get
|
||||||
|
down, if they weren't expending all of their energy trying to keep the tower
|
||||||
|
balanced. Apparently, one program has the wrong weight, and until it's fixed,
|
||||||
|
they're stuck here.
|
||||||
|
|
||||||
|
For any program holding a disc, each program standing on that disc forms a
|
||||||
|
sub-tower. Each of those sub-towers are supposed to be the same weight, or the
|
||||||
|
disc itself isn't balanced. The weight of a tower is the sum of the weights of
|
||||||
|
the programs in that tower.
|
||||||
|
|
||||||
|
In the example above, this means that for ugml's disc to be balanced, gyxo,
|
||||||
|
ebii, and jptl must all have the same weight, and they do: 61.
|
||||||
|
|
||||||
|
However, for tknk to be balanced, each of the programs standing on its disc and
|
||||||
|
all programs above it must each match. This means that the following sums must
|
||||||
|
all be the same:
|
||||||
|
|
||||||
|
ugml + (gyxo + ebii + jptl) = 68 + (61 + 61 + 61) = 251
|
||||||
|
padx + (pbga + havc + qoyq) = 45 + (66 + 66 + 66) = 243
|
||||||
|
fwft + (ktlj + cntj + xhth) = 72 + (57 + 57 + 57) = 243
|
||||||
|
|
||||||
|
As you can see, tknk's disc is unbalanced: ugml's stack is heavier than the
|
||||||
|
other two. Even though the nodes above ugml are balanced, ugml itself is too
|
||||||
|
heavy: it needs to be 8 units lighter for its stack to weigh 243 and keep the
|
||||||
|
towers balanced. If this change were made, its weight would be 60.
|
||||||
|
|
||||||
|
Given that exactly one program is the wrong weight, what would its weight need
|
||||||
|
to be to balance the entire tower?
|
||||||
|
|
||||||
|
|
||||||
|-}
|
|-}
|
||||||
|
@ -78,25 +108,26 @@ module Day7 where
|
||||||
|
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Map.Strict as Map
|
||||||
import Text.Parsec
|
import Text.Parsec
|
||||||
|
|
||||||
data Node = Node { name :: Text
|
data Node = Node { name :: Text
|
||||||
, weight :: Int
|
, weight :: Int
|
||||||
, sons :: [Text]
|
, sons :: [Text]
|
||||||
} deriving (Eq, Ord,Show)
|
} deriving (Eq, Ord,Show)
|
||||||
type Nodes = [Node]
|
type Nodes = Map Text Node
|
||||||
|
|
||||||
parseInput :: IO Nodes
|
parseInput :: IO Nodes
|
||||||
parseInput = do
|
parseInput = do
|
||||||
str <- readFile "inputs/day7.txt"
|
str <- readFile "inputs/day7.txt"
|
||||||
return $ either (const empty) identity (parseNodes str)
|
return $ either (const Map.empty) identity (parseNodes str)
|
||||||
|
|
||||||
parseNodes :: Text -> Either ParseError Nodes
|
parseNodes :: Text -> Either ParseError Nodes
|
||||||
parseNodes = parse nodes "Nodes"
|
parseNodes = parse nodes "Nodes"
|
||||||
|
|
||||||
nodes :: Parsec Text () Nodes
|
nodes :: Parsec Text () Nodes
|
||||||
nodes = many1 parseNode
|
nodes = many1 parseNode
|
||||||
|
& fmap (Map.fromList . map (\n -> (name n,n)))
|
||||||
|
|
||||||
int :: Parsec Text () Int
|
int :: Parsec Text () Int
|
||||||
int = do
|
int = do
|
||||||
|
@ -132,3 +163,60 @@ testInput = "pbga (66)\n\
|
||||||
\ugml (68) -> gyxo, ebii, jptl\n\
|
\ugml (68) -> gyxo, ebii, jptl\n\
|
||||||
\gyxo (61)\n\
|
\gyxo (61)\n\
|
||||||
\cntj (57)\n"
|
\cntj (57)\n"
|
||||||
|
|
||||||
|
testNodes :: Nodes
|
||||||
|
testNodes = either (const Map.empty) identity (parseNodes testInput)
|
||||||
|
|
||||||
|
fatherOf :: Nodes -> Text -> Maybe Node
|
||||||
|
fatherOf nodes nodeName = Map.elems nodes
|
||||||
|
& filter (\n -> nodeName `elem` sons n)
|
||||||
|
& head
|
||||||
|
|
||||||
|
rootOf :: Nodes -> Maybe Node
|
||||||
|
rootOf nodes = go nodes (head (Map.elems nodes))
|
||||||
|
where
|
||||||
|
go :: Nodes -> Maybe Node -> Maybe Node
|
||||||
|
go nodes (Just node) = case fatherOf nodes (name node) of
|
||||||
|
Just n -> go nodes (Just n)
|
||||||
|
Nothing -> Just node
|
||||||
|
go _ _ = Nothing
|
||||||
|
|
||||||
|
data Tree a = TNode a [Tree a] deriving (Eq,Ord,Show)
|
||||||
|
|
||||||
|
totalWeight :: Tree (a,Int) -> Int
|
||||||
|
totalWeight (TNode (_,i) _) = i
|
||||||
|
|
||||||
|
weightedNodes :: Nodes -> Maybe (Tree (Node,Int))
|
||||||
|
weightedNodes nodes = fmap go (rootOf nodes)
|
||||||
|
where
|
||||||
|
go :: Node -> Tree (Node,Int)
|
||||||
|
go node =
|
||||||
|
let subtrees :: [Tree (Node,Int)]
|
||||||
|
subtrees = sons node
|
||||||
|
& map (`Map.lookup` nodes)
|
||||||
|
& sequenceA
|
||||||
|
& maybe [] (map go)
|
||||||
|
sonweights = map totalWeight subtrees
|
||||||
|
in TNode (node,foldl' (+) (weight node) sonweights)
|
||||||
|
subtrees
|
||||||
|
|
||||||
|
histogram :: Ord a => [a] -> Map.Map a Int
|
||||||
|
histogram xs = Map.fromListWith (+) $ zip xs (repeat 1)
|
||||||
|
|
||||||
|
solution2 :: Nodes -> Maybe (Text,Int)
|
||||||
|
solution2 nodes = do
|
||||||
|
tree <- weightedNodes nodes
|
||||||
|
go 0 tree
|
||||||
|
where
|
||||||
|
go :: Int -> Tree (Node,Int) -> Maybe (Text,Int)
|
||||||
|
go expectedWeight (TNode (n,nw) subtrees) =
|
||||||
|
let groupedSubWeight = histogram (map totalWeight subtrees)
|
||||||
|
in if Map.size groupedSubWeight /= 1
|
||||||
|
then do
|
||||||
|
expW <- groupedSubWeight
|
||||||
|
& Map.filter (/= 1)
|
||||||
|
& Map.keys
|
||||||
|
& head
|
||||||
|
badSubtree <- filter ((/= expW) . totalWeight) subtrees & head
|
||||||
|
go expW badSubtree
|
||||||
|
else return (name n, weight n - (nw - expectedWeight))
|
||||||
|
|
10
test/Spec.hs
10
test/Spec.hs
|
@ -1,3 +1,5 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.HUnit
|
import Test.Tasty.HUnit
|
||||||
|
|
||||||
|
@ -60,4 +62,12 @@ main = defaultMain $
|
||||||
sol2 <- Day6.solution2 input
|
sol2 <- Day6.solution2 input
|
||||||
when (sol2 /= 4) (assertFailure "Day 6 solution 2 on the example should be 4")
|
when (sol2 /= 4) (assertFailure "Day 6 solution 2 on the example should be 4")
|
||||||
]
|
]
|
||||||
|
, testGroup "Day 7"
|
||||||
|
[ testCaseSteps "example problem 1" $ \step -> do
|
||||||
|
step "Loading test input"
|
||||||
|
input <- Day7.testNodes
|
||||||
|
step "Running solution 1"
|
||||||
|
sol1 <- Day7.rootOf input
|
||||||
|
when (sol1 /= "tknk") (assertFailure "The root should be tknk")
|
||||||
|
]
|
||||||
]
|
]
|
||||||
|
|
Loading…
Reference in a new issue