Copyright	(c) Eric Mertens 2017
License	ISC
Maintainer	emertens@gmail.com
Safe Haskell	None
Language	Haskell2010

Main

Contents

Types
Computation
Change tracking

Description

http://adventofcode.com/2017/day/7

This task asks us to balance a nearly balanced tree. Each node has its own weight and a balanced tree is one where each node's children must all have the same total weight.

This solution uses a Node type parameterized over the types of the children so that it can be reused at multiple stages of the computation.

Most solutions don't handle the case of a node with only two children correctly, but fortunately for those solutions AoC doesn't test solutions on this more challenging case.

Synopsis

main :: IO ()
data Node a = Node !Int [a]
data Summary = Summary !Int !Int
topName :: Ord name => Map name (Node name) -> name
summarize :: Fix Node -> OneChangeT Int [] Summary
computeCorrection :: Fix Node -> Maybe Int
corrections :: [Summary] -> [Summary]
newtype OneChangeT c (m :: Type -> Type) a = OCT (m (Maybe c, a))
change :: forall (m :: Type -> Type) c. Monad m => c -> OneChangeT c m ()

Documentation

Example tree from the problem description

               gyxo
              /
         ugml - ebii
       /      \
      |         jptl
      |
      |         pbga
     /        /
tknk --- padx - havc
     \        \
      |         qoyq
      |
      |         ktlj
       \      /
         fwft - cntj
              \
                xhth

>>> :{
let example :: Map String (Node String)
    example = Map.fromList
      [ ("pbga", Node 66 [])
      , ("xhth", Node 57 [])
      , ("ebii", Node 61 [])
      , ("havc", Node 66 [])
      , ("ktlj", Node 57 [])
      , ("fwft", Node 72 ["ktlj","cntj","xhth"])
      , ("qoyq", Node 66 [])
      , ("padx", Node 45 ["pbga","havc","qoyq"])
      , ("tknk", Node 41 ["ugml","padx","fwft"])
      , ("jptl", Node 61 [])
      , ("ugml", Node 68 ["gyxo","ebii","jptl"])
      , ("gyxo", Node 61 [])
      , ("cntj", Node 57 [])]
:}

There are trickier tree problems when the unbalanced nodes have exactly two children. In these cases you might need information from the parent about which choice to make. See the documentation for summarize to see where the ambiguities arise and are resolved.

Note that locally node b could be fixed by adjusting either of d or e but globally, only adjusting d will work.

            d (1)
           /
      b (4)
     /     \
a (1)       e (2)
     \
      c (8)

>>> :{
let trickier :: Map String (Node String)
    trickier = Map.fromList
      [ ("a", Node 1 ["b","c"])
      , ("b", Node 4 ["d","e"])
      , ("c", Node 8 [])
      , ("d", Node 1 [])
      , ("e", Node 2 [])]
:}

main :: IO () Source #

Print the solutions to both parts of the task. The input file can be overridden via command-line arguments.

Types

data Node a Source #

Representation of a node in the tree.

This type is parameterized so that we can either have the list of children be a list of names of the children, or a list of actual child nodes, or a list of weight summaries of the children.

Constructors

Node !Int [a]

Node weight and children

Instances

Instances details

Foldable Node Source #
Instance details Defined in Main Methods fold :: Monoid m => Node m -> m # foldMap :: Monoid m => (a -> m) -> Node a -> m # foldMap' :: Monoid m => (a -> m) -> Node a -> m # foldr :: (a -> b -> b) -> b -> Node a -> b # foldr' :: (a -> b -> b) -> b -> Node a -> b # foldl :: (b -> a -> b) -> b -> Node a -> b # foldl' :: (b -> a -> b) -> b -> Node a -> b # foldr1 :: (a -> a -> a) -> Node a -> a # foldl1 :: (a -> a -> a) -> Node a -> a # toList :: Node a -> [a] # null :: Node a -> Bool # length :: Node a -> Int # elem :: Eq a => a -> Node a -> Bool # maximum :: Ord a => Node a -> a # minimum :: Ord a => Node a -> a # sum :: Num a => Node a -> a # product :: Num a => Node a -> a #
Show1 Node Source #	This instance is useful for showing the type `Fix Node`
Instance details Defined in Main Methods liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Node a -> ShowS # liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Node a] -> ShowS #
Traversable Node Source #
Instance details Defined in Main Methods traverse :: Applicative f => (a -> f b) -> Node a -> f (Node b) # sequenceA :: Applicative f => Node (f a) -> f (Node a) # mapM :: Monad m => (a -> m b) -> Node a -> m (Node b) # sequence :: Monad m => Node (m a) -> m (Node a) #
Functor Node Source #
Instance details Defined in Main Methods fmap :: (a -> b) -> Node a -> Node b # (<$) :: a -> Node b -> Node a #
Show a => Show (Node a) Source #
Instance details Defined in Main Methods showsPrec :: Int -> Node a -> ShowS # show :: Node a -> String # showList :: [Node a] -> ShowS #

data Summary Source #

Summary of a tree containing the root node's weight and the whole tree's weight.

Constructors

Summary !Int !Int

top node weight, total weight

Instances

Instances details

Show Summary Source #
Instance details Defined in Main Methods showsPrec :: Int -> Summary -> ShowS # show :: Summary -> String # showList :: [Summary] -> ShowS #

Computation

topName :: Ord name => Map name (Node name) -> name Source #

Find the top-most name in the map of entries.

>>> topName example
"tknk"
>>> topName trickier
"a"

summarize :: Fix Node -> OneChangeT Int [] Summary Source #

Given a tree, compute the Summary for that tree and record the new value of any node needed to balance the tree along the way.

This implementation uses a bottom-up fold of the tree. It computes weight summaries of the tree while tracking the new value of any nodes that needed to be changed to ensure that each node along the way has equally weighted child trees.

>>> let summarizeExample = mapM_ print . runOneChangeT . summarize . anaFromMap example

>>> summarizeExample "ugml"
(Nothing,Summary 68 251)

>>> summarizeExample "padx"
(Nothing,Summary 45 243)

>>> summarizeExample "fwft"
(Nothing,Summary 72 243)

>>> summarizeExample "tknk"
(Just 60,Summary 41 770)

These next examples show how ambiguity can arise in a child node and then be resolved in a parent.

>>> let summarizeTrickier = mapM_ print . runOneChangeT . summarize . anaFromMap trickier

>>> summarizeTrickier "b"
(Just 2,Summary 4 8)
(Just 1,Summary 4 6)

>>> summarizeTrickier "a"
(Just 2,Summary 1 17)

computeCorrection :: Fix Node -> Maybe Int Source #

Given a tree, compute the corrected weight to balance the whole tree. If there are multiple possibilities this returns the one of them.

>>> computeCorrection (anaFromMap example "tknk")
Just 60
>>> computeCorrection (anaFromMap trickier "a")
Just 2

corrections Source #

Arguments

:: [Summary]	all child summaries
-> [Summary]	possible fixed child summaries

Given a list of child node summaries, generate the possible corrected child node weights and the resulting total child weight after that change. It doesn't matter which node is changed, so that isn't tracked.

With two children either might need to be fixed.

>>> corrections [Summary 3 6, Summary 4 8]
[Summary 5 8,Summary 2 6]

With more than two children it will be clear which is wrong.

>>> corrections [Summary 1 4, Summary 2 7, Summary 3 7 ]
[Summary 4 7]

If no corrections are needed, none are offered.

>>> corrections (replicate 2 (Summary 1 6))
[]
>>> corrections [Summary 1 6]
[]
>>> corrections []
[]

Change tracking

newtype OneChangeT c (m :: Type -> Type) a Source #

A variant of the writer monad-transformer that "fails" when more than one write is recorded.

Constructors

OCT (m (Maybe c, a))

Instances

Instances details

MonadPlus m => Alternative (OneChangeT c m) Source #	Inherit `Alternative` from underlying type `m`
Instance details Defined in Main Methods empty :: OneChangeT c m a # (<\|>) :: OneChangeT c m a -> OneChangeT c m a -> OneChangeT c m a # some :: OneChangeT c m a -> OneChangeT c m [a] # many :: OneChangeT c m a -> OneChangeT c m [a] #
MonadPlus m => Applicative (OneChangeT c m) Source #	`pure` returns the given value with no change recorded.
Instance details Defined in Main Methods pure :: a -> OneChangeT c m a # (<>) :: OneChangeT c m (a -> b) -> OneChangeT c m a -> OneChangeT c m b # liftA2 :: (a -> b -> c0) -> OneChangeT c m a -> OneChangeT c m b -> OneChangeT c m c0 # (>) :: OneChangeT c m a -> OneChangeT c m b -> OneChangeT c m b # (<*) :: OneChangeT c m a -> OneChangeT c m b -> OneChangeT c m a #
MonadPlus m => Functor (OneChangeT c m) Source #	Inherit `Functor` from `Monad` implementation
Instance details Defined in Main Methods fmap :: (a -> b) -> OneChangeT c m a -> OneChangeT c m b # (<$) :: a -> OneChangeT c m b -> OneChangeT c m a #
MonadPlus m => Monad (OneChangeT c m) Source #	Sequencing of two values fails if both have recorded a change.
Instance details Defined in Main Methods (>>=) :: OneChangeT c m a -> (a -> OneChangeT c m b) -> OneChangeT c m b # (>>) :: OneChangeT c m a -> OneChangeT c m b -> OneChangeT c m b # return :: a -> OneChangeT c m a #
MonadPlus m => MonadPlus (OneChangeT c m) Source #	Inherit `MonadPlus` from underlying type `m`
Instance details Defined in Main Methods mzero :: OneChangeT c m a # mplus :: OneChangeT c m a -> OneChangeT c m a -> OneChangeT c m a #

change :: forall (m :: Type -> Type) c. Monad m => c -> OneChangeT c m () Source #

Record a change. Changes will collide even if they have the same value.

>>> runOneChangeT (pure ()) :: [(Maybe Bool, ())]
[(Nothing,())]
>>> runOneChangeT (change True) :: [(Maybe Bool, ())]
[(Just True,())]
>>> runOneChangeT (change True >> change True) :: [(Maybe Bool, ())]
[]
>>> runOneChangeT (change True >> change False) :: [(Maybe Bool, ())]
[]