day8.hs (3556B)
1 -- AOC 2023: Day 8 - Haunted Wasteland 2 -- 3 -- Suppose you have a graph where each node contains two edges and 4 -- a list of instructions telling you how to navigate the graph. Find 5 -- the number of steps necessary to get from node "AAA" to node 6 -- "ZZZ". If after following all the instructions you are not at node 7 -- "ZZZ" loop back to the first instruction and continue until 8 -- reaching "ZZZ" 9 -- Example input: 10 -- 11 -- RL 12 -- 13 -- AAA = (BBB, CCC) 14 -- BBB = (DDD, EEE) 15 -- CCC = (ZZZ, GGG) 16 -- DDD = (DDD, DDD) 17 -- EEE = (EEE, EEE) 18 -- GGG = (GGG, GGG) 19 -- ZZZ = (ZZZ, ZZZ) 20 -- 21 -- Test Output: 2 22 -- 23 -- Task 2: Suppose instead that you want to start at all nodes 24 -- "**A" and want to find the _shortest_ length necessay until all 25 -- paths end on "**Z" simultaneously. (No reasonable test input for 26 -- this part that works with the actual input). 27 -- 28 import Data.Char 29 import System.Environment 30 31 readb26 :: String -> Int 32 readb26 = foldl (\a n -> a * 26 + (ord n - ord 'A')) 0 . map toUpper 33 34 qsort :: Ord a => [a] -> [a] 35 qsort [] = [] 36 qsort (x:xs) = qsort lhs ++ [x] ++ qsort rhs 37 where 38 lhs = filter (< x) xs 39 rhs = filter (>= x) xs 40 41 splitOn :: Char -> String -> [String] 42 splitOn c "" = [] 43 splitOn c s = 44 if skipfirst 45 then [] ++ (splitOn c $ tail s) 46 else [f] ++ splitOn c r 47 where 48 skipfirst = c == head s 49 (f, r) = span (/= c) s 50 51 pathfind :: Ord a => a -> [(a, (a, a))] -> Int -> Int -> (a, a) 52 pathfind i ps l h 53 | i == midv = midp 54 | i < midv = pathfind i ps l (midpoint - 1) 55 | i > midv = pathfind i ps (midpoint + 1) h 56 where 57 midpoint = div (l + h) 2 58 (midv, midp) = ps !! midpoint 59 60 tokeyval :: String -> (Int, (Int, Int)) 61 tokeyval s = (k, val) 62 where 63 (ks, vals) = span (/= '=') s 64 k = readb26 ks 65 val = 66 (\(l, r) -> (readb26 l, readb26 $ tail r)) $ 67 break (== ',') $ drop 2 $ init vals 68 69 toflist :: String -> [((a, a) -> a)] 70 toflist "" = [] 71 toflist (x:xs) 72 | x == 'L' = [fst] ++ toflist xs 73 | x == 'R' = [snd] ++ toflist xs 74 75 traversenet :: Int -> Int -> [((Int, Int) -> Int)] -> [(Int, (Int, Int))] -> Int 76 traversenet loc dest (p1:pr) network 77 | loc == dest = 0 78 | otherwise = 1 + traversenet nextloc dest (pr ++ [p1]) network 79 where 80 nextloc = p1 $ pathfind loc network 0 (length network - 1) 81 82 -- hardcoded to look for last char == 'Z' 83 travnet2 :: Int -> [((Int, Int) -> Int)] -> [(Int, (Int, Int))] -> Int 84 travnet2 loc (p1:pr) network 85 | done = 0 86 | otherwise = 1 + travnet2 nextloc (pr ++ [p1]) network 87 where 88 done = mod loc 26 == readb26 "Z" 89 nextloc = p1 $ pathfind loc network 0 (length network - 1) 90 91 -- In this problem instruction length is a factor of all paths; 92 -- this doesn't have to be so but is for this specific input. 93 -- Should technically verify that plens[n] / ilen is prime 94 -- and that ilen and ilen^2 aren't in plens but this is 95 -- all satisfied for this input 96 getlcm :: Int -> [Int] -> Int 97 getlcm ilen plens = foldl (*) ilen $ map (\x -> div x ilen) plens 98 99 parse [] = getContents 100 parse fs = concat `fmap` mapM readFile fs 101 102 main = do 103 fs <- getArgs >>= parse 104 let (path, net) = 105 (\(a, b) -> (a, splitOn '\n' b)) $ 106 span (/= '\n') $ filter (/= ' ') fs 107 let nmap = qsort $ map tokeyval net 108 let pmap = toflist path 109 let plen = traversenet (readb26 "AAA") (readb26 "ZZZ") pmap nmap 110 let slocs = filter (\x -> mod x 26 == readb26 "A") $ map fst nmap 111 let pplen = getlcm (length pmap) $ map (\x -> travnet2 x pmap nmap) slocs 112 putStrLn $ "Task 1: " ++ show plen 113 putStrLn $ "Task 2: " ++ show pplen