Advent of Code 2019: Day 6 (with Trees)

Question

I've been going through some 2019 AoC challenges and decided to solve Day 6 in Haskell with the help of Data.Tree.

In summary, the puzzle provides a list of orbits (edges) as input, resembling:

COM)B
B)C
C)D
D)E
E)F
B)G
G)H
D)I
E)J
J)K
K)L
K)YOU
I)SAN

where COM is supposedly the centre of all orbits (i.e. the root). We are tasked with parsing this and...

• for Part 1: Find the total number of direct and indirect orbits. In the example,
  • B directly orbits COM
  • C directly orbits B (hence, indirectly orbiting COM)
  • D directly orbits C (hence, indirectly orbiting B and COM)
  • and so on...
• for Part 2: Find the minimum number of orbital transfers. Basically, the number of traversals needed to get from the orbit of YOU to the orbit of SAN. In the example, the traversals are K -> J -> E -> D -> I. Hence, the minimum number of transfers is 4.

Here is my solution to both parts:

import Data.Tree

type Satellite = String
type STree = Tree Satellite
type Orbit = (Satellite, Satellite)

--  Part 1
main :: IO ()
main = interact $ show . countOrbits . fromOrbits . map parseOrbit . lines

--  Part 2
-- main :: IO ()
-- main = interact $ show . findMinimumTransfers "YOU" "SAN" . fromOrbits . map parseOrbit . lines

parseOrbit :: String -> Orbit
parseOrbit s = (takeWhile (/= ')') s, tail $ dropWhile (/= ')') s)

fromOrbits :: [Orbit] -> STree
fromOrbits orbits = construct "COM"
    where construct :: Satellite -> STree
          construct root = Node { rootLabel = root, subForest = map construct $ children root }

          children :: Satellite -> [Satellite]
          children sat = map snd $ filter ((== sat) . fst) orbits

countOrbits :: STree -> Integer
countOrbits = countOrbitsImpl 0
    where countOrbitsImpl :: Integer -> STree -> Integer
          countOrbitsImpl depth (Node rootLabel subForest)
                | length subForest == 0 = depth
                | otherwise = depth + (sum $ map (countOrbitsImpl (depth + 1)) subForest)

-- finds the minimum number of orbital transfers required between two targets
findMinimumTransfers :: Satellite -> Satellite -> STree -> Int
findMinimumTransfers tar tar' = findImpl 0
    where -- find the common node where targets are (possibly indirect) children
          findImpl :: Int -> STree -> Int
          findImpl depth (Node rootLabel subForest)
                | rootLabel == tar || rootLabel == tar' = depth - 1
                | length subForest == 0 = 0
                | otherwise = 
                    let childResults = filter (/= 0) $ map (findImpl (depth + 1)) subForest
                    in  if length childResults == 2
                        then sum childResults - (depth * length childResults)   --  found common node
                        else sum childResults   --  propagate results

I'm itching for feedback on the recursion. I use it mainly to keep track of a node's depth and later return it as part of the result... but is there a "better" way to write this? Maybe with folds or applicatives?

I did think about keeping depth as part of a node's data (so that we might have type STree = Tree (Satellite, Int)), then maybe we could fold over that, but I didn't want to "bloat" the structure with redundant information.

Other feedback is also welcome. Thanks!

_{N.B. this is not a duplicate of AdventOfCode 2019 day 6 in Haskell as the implementation is different.}

Answer 1

break and span

When we try to split a string in Haskell, we're a little bit out of luck if we only use the trusty Prelude and base. Handy functions like split or splitOn are in the adaptly named split package, and parser combinators are completely other beasts and an oribtal (heh) laser cannon on this problem.

However, there are two functions that provide almost exactly what parseOrbit is trying to achieve: splitting a string on a single character:

span, break :: (a -> Bool) -> [a] -> ([a], [a])
span  f xs = (takeWhile f xs, dropWhile f xs)
break f xs = span (not . f)

We can simplify parseOrbit therefore to

parseOrbit :: String -> Orbit
parseOrbit s = let (a, _:b) = break (==')') s in (a, b)

However, you seem to prefer where, so let's use a where clause instead:

parseOrbit :: String -> Orbit
parseOrbit s = (a, b)
    where (a, _:b) = break (==')') s

Type signatures in where clauses

As we have seen above, (a, _:b) had no type signature. Type signatures in where clasues are usually omitted. There is some controversy about that, however there are some things to keep in mind:

• GHC never warns about missing type signatures in where clauses
• functions with type parameters cannot have a type without ScopedTypeSignatures (see this SO question for an example)
• a change in the top level type signature might need a lot of changes in where clauses
• if a function is complex enough to need a type, it might be reasonable to promote it into a top-level function. That way it can also be tested.

I personally therefore omit type signatures in where clauses (ST shenengians aside).

Answer 2

countOrbits

Let's take a look at what your algorithm is doing. Suppose you are at a root node r with subtree s at depth d0. You return the sum of d0 and all of the depths of the nodes in s.

Nitpicks

sum [] = 0, so you could just write countOrbitsImpl as its otherwise clause. Not checking the length also makes your code slightly faster. length is O(n) in the list it acts on. So if length subForest /= 0, you'll iterate over the whole subforest before knowing that.

In this case, you can eliminate the unnecessary guard, but where it is necessary to check the subforest, you should prefer null subForest to length subForest == 0 because of the aforementioned reason.

You should either put an _ in front of a variable you don't use (_rootLabel) or replace the variable name with an _. Otherwise, if you turn on -Wall you'll get a warning about an unused variable.

Rewriting

You asked about an alternative to your recursive function using a fold or applicative. Here's a way to restate your algorithm: imagine that each node in the tree had a depth associated with it. You want the sum of that.

So instead of recursing over the tree, you can make a tree of depths and then sum that tree. We'll get to how you can sum it in a moment, but let's first make that tree.

mkDepthTree :: Integer -> STree -> Tree Integer
mkDepthTree depth (Node _ subForest) = Node depth (map (mkDepthTree (depth+1)) subForest)

This doesn't look very different from countOrbitsImpl, it just isn't adding anything up.

Once we have the tree of depths, we want to sum it. Fortunately, Tree has a Foldable instance. Which means it's a valid input to sum. Thus, you can write countOrbits as

countOrbits :: STree -> Integer
countOrbits = sum . mkDepthTree 0
    where mkDepthTree depth (Node _ subForest) = Node depth (map (mkDepthTree (depth+1)) subForest)

I used your indentation, although I personally prefer using 2 spaces, putting a newline after where and then indenting the line after by 2 more.

Which to prefer?

In a function that is this simple, I wouldn't say either version is necessarily better. Converting to a tree of depths then summing feels more elegant (it can almost be written as a foldMap if you didn't need the depth information), but it's also slightly harder to understand. Recursing directly is slightly clunkier, but IMO easier to understand.

So it's your decision.

More to come?

It got kind of late so I'm stopping this review. I'll see if I can edit in a review of findMinimumTransfers later.