# A Simple Hylomorphism Example

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 `Functor`s.

``````> 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
>           (<\$\$>) = 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. 