Commit: 149724fd0a0ac682929edc8b45bc106847a0fc0a
Parent: d5e65a3b0c1b8b21ac553ae455c25060d80a147a
Author: Randy Palamar
Date: Thu, 21 Dec 2023 08:28:43 -0700
day 8
Day 8 started out as a nice problem with some interesting
solutions but quickly grew frustrating with part 2 (partly because
of Haskell and partly because of the problem itself).
To start with I immediately compressed the input by ~33% by
converting all the nodes to base 26 integers (3 ASCII digits
require at least 24 bits, but converting to base 26 requires 26^3
values which fits in 16 bits). The instructions were converted
into a list of functions the head of which is applied to the
current node to get to the next node. Then the path is easily
traversed.
Part 2 is also fairly trivial to implement the, correct, general
solution but the inputs were chosen such that the runtime would be
much too long (apparently some people did it in reasonable runtime
using more efficient languages). As it turns out however, the
inputs were also chosen such that you could just find the LCM of
all the paths. Its just that this was not indicated anywhere (I
had originally considered this approach but discarded it before
writing because it would not be correct in general). After
struggling for a while not knowing if my general algorithm was
correct (it is) I learned that people were just using LCM. I would
have found out this solution would work sooner if Haskell had any
reasonable way of printing out intermediate values because I would
have noticed the cyclic nature of each path. But alas my long
lived frustration with this aspect of Haskell continues.
Even using the LCM approach the solution is relatively slow. I
reckon I could write a much faster version in C but I'm not sure I
care enough about this specific problem to do so. Runtime:
avgtime -n 64 ./day8 input
real 1.390469
user 1.372344
sys 0.000469
(I realized that my avgtime script doesn't play nice with data
from stdin. I will fix later or replace with a simple C program)
Diffstat:
3 files changed, 123 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -2,3 +2,4 @@
*/day[0-9][0-9]
*.hi
*.o
+**/input
diff --git a/day8/day8.hs b/day8/day8.hs
@@ -0,0 +1,113 @@
+-- AOC 2023: Day 8 - Haunted Wasteland
+--
+-- Suppose you have a graph where each node contains two edges and
+-- a list of instructions telling you how to navigate the graph. Find
+-- the number of steps necessary to get from node "AAA" to node
+-- "ZZZ". If after following all the instructions you are not at node
+-- "ZZZ" loop back to the first instruction and continue until
+-- reaching "ZZZ"
+-- Example input:
+--
+-- RL
+--
+-- AAA = (BBB, CCC)
+-- BBB = (DDD, EEE)
+-- CCC = (ZZZ, GGG)
+-- DDD = (DDD, DDD)
+-- EEE = (EEE, EEE)
+-- GGG = (GGG, GGG)
+-- ZZZ = (ZZZ, ZZZ)
+--
+-- Test Output: 2
+--
+-- Task 2: Suppose instead that you want to start at all nodes
+-- "**A" and want to find the _shortest_ length necessay until all
+-- paths end on "**Z" simultaneously. (No reasonable test input for
+-- this part that works with the actual input).
+--
+import Data.Char
+import System.Environment
+
+readb26 :: String -> Int
+readb26 = foldl (\a n -> a * 26 + (ord n - ord 'A')) 0 . map toUpper
+
+qsort :: Ord a => [a] -> [a]
+qsort [] = []
+qsort (x:xs) = qsort lhs ++ [x] ++ qsort rhs
+ where
+ lhs = filter (< x) xs
+ rhs = filter (>= x) xs
+
+splitOn :: Char -> String -> [String]
+splitOn c "" = []
+splitOn c s =
+ if skipfirst
+ then [] ++ (splitOn c $ tail s)
+ else [f] ++ splitOn c r
+ where
+ skipfirst = c == head s
+ (f, r) = span (/= c) s
+
+pathfind :: Ord a => a -> [(a, (a, a))] -> Int -> Int -> (a, a)
+pathfind i ps l h
+ | i == midv = midp
+ | i < midv = pathfind i ps l (midpoint - 1)
+ | i > midv = pathfind i ps (midpoint + 1) h
+ where
+ midpoint = div (l + h) 2
+ (midv, midp) = ps !! midpoint
+
+tokeyval :: String -> (Int, (Int, Int))
+tokeyval s = (k, val)
+ where
+ (ks, vals) = span (/= '=') s
+ k = readb26 ks
+ val =
+ (\(l, r) -> (readb26 l, readb26 $ tail r)) $
+ break (== ',') $ drop 2 $ init vals
+
+toflist :: String -> [((a, a) -> a)]
+toflist "" = []
+toflist (x:xs)
+ | x == 'L' = [fst] ++ toflist xs
+ | x == 'R' = [snd] ++ toflist xs
+
+traversenet :: Int -> Int -> [((Int, Int) -> Int)] -> [(Int, (Int, Int))] -> Int
+traversenet loc dest (p1:pr) network
+ | loc == dest = 0
+ | otherwise = 1 + traversenet nextloc dest (pr ++ [p1]) network
+ where
+ nextloc = p1 $ pathfind loc network 0 (length network - 1)
+
+-- hardcoded to look for last char == 'Z'
+travnet2 :: Int -> [((Int, Int) -> Int)] -> [(Int, (Int, Int))] -> Int
+travnet2 loc (p1:pr) network
+ | done = 0
+ | otherwise = 1 + travnet2 nextloc (pr ++ [p1]) network
+ where
+ done = mod loc 26 == readb26 "Z"
+ nextloc = p1 $ pathfind loc network 0 (length network - 1)
+
+-- In this problem instruction length is a factor of all paths;
+-- this doesn't have to be so but is for this specific input.
+-- Should technically verify that plens[n] / ilen is prime
+-- and that ilen and ilen^2 aren't in plens but this is
+-- all satisfied for this input
+getlcm :: Int -> [Int] -> Int
+getlcm ilen plens = foldl (*) ilen $ map (\x -> div x ilen) plens
+
+parse [] = getContents
+parse fs = concat `fmap` mapM readFile fs
+
+main = do
+ fs <- getArgs >>= parse
+ let (path, net) =
+ (\(a, b) -> (a, splitOn '\n' b)) $
+ span (/= '\n') $ filter (/= ' ') fs
+ let nmap = qsort $ map tokeyval net
+ let pmap = toflist path
+ let plen = traversenet (readb26 "AAA") (readb26 "ZZZ") pmap nmap
+ let slocs = filter (\x -> mod x 26 == readb26 "A") $ map fst nmap
+ let pplen = getlcm (length pmap) $ map (\x -> travnet2 x pmap nmap) slocs
+ putStrLn $ "Task 1: " ++ show plen
+ putStrLn $ "Task 2: " ++ show pplen
diff --git a/day8/test b/day8/test
@@ -0,0 +1,9 @@
+RL
+
+AAA = (BBB, CCC)
+CCC = (ZZZ, GGG)
+DDD = (DDD, DDD)
+BBB = (DDD, EEE)
+GGG = (GGG, GGG)
+EEE = (EEE, EEE)
+ZZZ = (ZZZ, ZZZ)