I remarked last time that I’d wanted to write up a good example of using the recursion-schemes library to solve a computational problem in Advent of Code. However, as previously discussed, I found a more appropriate way of solving Day 7. However, it turns out that Day 24 has an elegant solution with a hylomorphism and judicious application of two ordered monoids.

Let’s get started.

> {-# LANGUAGE DeriveFunctor #-}

If you’re dealing with the recursion-schemes library, you’re going to be deriving Functors.

> module Day24blog where 

> import qualified Data.Set as S 

> import Data.Foldable (foldMap, toList)
> import Data.List.Split (splitOn)
> import Data.Monoid ((<>), Sum(Sum), mempty, mappend)
> -- import Data.Functor.Foldable (hylo)

I haven’t actually included Data.Functor.Foldable because in this case we need so little functionality it’s more clear if we just recreate the function in the text.

To restate the problem, we have a list of “components” that have two values, one for each end. The components can be reversed. The task is to find the “best” chain that can be built under a certain metric. Both parts a and b conform to this design.

The data input is sufficiently simple I didn’t bother reaching for my trusty MegaParsec.

> newtype Component = Component (Int,Int) deriving (Eq, Ord, Show)

> components :: IO (S.Set Component) -- luckily, all Components are distinct, so Set is OK.
> components = foldMap (S.singleton . c) <$> day24text
>     where c [x,y] = Component (read x, read y)
>           day24text = splitOn "/" <$$> lines <$> readFile "c:\\users\\me\\advent\\day24.txt"
>           (<$$>) = fmap . fmap

So, having established that we need to build chains, the first thing we need to do is establish whether a particular component can be added to a chain and if so, what the new value at the end of the chain would be.

> match :: Int -> Component -> Maybe (Int)
> match v (Component (x,y)) | x == v = Just y
> match v (Component (x,y)) | y == v = Just x
> match _ _ = Nothing

Introducing hylo

A hylomorphism is a refold, that is an expansion (anamorphism) followed by a contraction (catamorphism). The obvious examples of these are unfoldr and foldr, but recursion-schemes is more general and, in particular, can handle the branching structure we’re going to need to solve this problem.

> hylo :: Functor f => (f r -> r) -> (i -> f i) -> i -> r 
> hylo collapse expand = fp where fp = collapse . fmap fp . expand

One nice thing about hylo is that its type is relatively simple. Comprehending cata and ana, which are theoretically simpler functions, involves significantly more type dependencies.

You might be wondering how this self-recursive definition ever actually gets from an input to a result. It helps to remember that

• [a] can be mapped to [b] pretty easily when the list is empty.
• A lot of the work is, in practice, done by the Functor itself.

Exactly how it works requires someone with more experience than me.

The rest of this is an exercise is satifying hylo’s type requirements. First off, we need an input type.

> data Day24Precondition v = Day24Precondition {
>   valueToMatch :: Int,
>   componentsToUse :: S.Set Component,
>   componentMetric :: v
> } deriving (Show)

Strictly speaking the v is part of the output, but it works pretty well for our purposes. We can easily define the start state:

> start :: (Monoid v) => IO (Day24Precondition v)
> start = f <$> components
>     where f c = Day24Precondition {
>               valueToMatch = 0,
>               componentsToUse = c,
>               componentMetric = mempty
>           }

Collapsing the intermediate data structure

We then need something to capture the range of possibilities. This is going to be the f in our call to hylo.

> data Day24State v a = Day24State {
>   precondition :: Day24Precondition v,
>   alternatives :: [a]     
> } deriving (Functor, Show)

Having defined our f, we can define our collapse, which needs to be f result -> result.

> best :: (Monoid v, Ord v) => Day24State v v -> v
> best st = (componentMetric $ precondition st) <> bestAlternative
>     where bestAlternative = foldr max mempty $ alternatives st

So, we take the bestAlternative and add it to the value of the component. Note that this is not generic in the type of the Functor.

Creating the intermediate data structure

expand is a bit trickier than collapse. Given a precondition, get the list of subsequent preconditions (and compute the component values, since we stuck the component value on the input). First we expand upon the match function we defined earlier to work with Day24Precondition.

> matchToPrecondition :: (Component -> v) -> Day24Precondition x 
>        -> Component -> Maybe (Day24Precondition v)
> matchToPrecondition calculateMetric input c = f <$> m
>     where m = match (valueToMatch input) c
>           f x = Day24Precondition {
>               valueToMatch = x,
>               componentsToUse = S.delete c (componentsToUse input),
>               componentMetric = calculateMetric c
>           }

Then we use it to get a list of next states:

> choices :: (Component -> v) -> Day24Precondition v 
>         -> Day24State v (Day24Precondition v)
> choices calculateMetric input = Day24State {
>     precondition = input,
>     alternatives = foldMap toInput $ componentsToUse input 
> } where toInput = toList . matchToPrecondition calculateMetric input

Putting it all together

So, the first part of the Day 24 problem asked for the heaviest weight possible.

> weight :: Component -> Sum Int
> weight (Component (x,y)) = Sum $ x + y

> day24a = hylo best (choices weight) <$> start

The second part asked for the longest bridge, with weight as a secondary metric. For that, we just need a different ordered monoid.

> newtype LengthAndWeight = LengthAndWeight (Int, Int) 
>        deriving (Ord, Eq, Show)

> instance Monoid LengthAndWeight where
>     mappend (LengthAndWeight (x0,y0)) (LengthAndWeight (x1,y1)) = LengthAndWeight (x0+x1,y0+y1) 
>     mempty = LengthAndWeight (0,0)

> lengthAndWeight :: Component -> LengthAndWeight
> lengthAndWeight (Component (x,y)) = LengthAndWeight (1, x+y)

> day24b = hylo best (choices lengthAndWeight) <$> start

Hopefully this has shown how useful hylo can be. If you’re into Clojure, I gave a talk a few years ago about ana, cata and hylo implemented in pure Clojure for those of you who are interested. If people have examples of the more sophisticated recursion schemes or how to use the dist versions I’d be very happy to hear from you.