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 orbitsCOM
C
directly orbitsB
(hence, indirectly orbitingCOM
)D
directly orbitsC
(hence, indirectly orbitingB
andCOM
)- 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 ofSAN
. In the example, the traversals areK -> J -> E -> D -> I
. Hence, the minimum number of transfers is4
.
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.