Currently working on The 2nd part of the 8th day of 2023's Advent of Code. I'm attempting the following solution:
main = readFile "8.txt" >>= print . proc . lines
proc (ds:_:xs) = step 1 ds m as ds where
m = (foldl' parse) M.empty xs
as = map (\x -> ((m ! x), False)) $ filter (\x -> (last x) == 'A') $ M.keys m
parse m s = M.insert n (l,r) m where
(n, ns) = splitAt 3 s
(l, ls) = splitAt 3 $ drop 4 ns
r = take 3 $ drop 2 ls
step !i dds m !xs [] = step i dds m xs dds
step !i dds m !xs (d:ds) = if clear xs' then (i + 1) else step (i + 1) dds m xs' ds where
!xs' = map (move m d) xs
clear !cs = all (\(_,t) -> t) cs
move m 'L' ((!x,_),_) = ((m ! x), (last x) == 'Z')
move m 'R' ((_,!x),_) = ((m ! x), (last x) == 'Z')
I'm not sure whether this is the correct solution, or whether it's the most efficient solution, or anything of that matter, I'll end up finding that out on my own, the problem is I can't get this to run, as it just runs out of stack space, and I have no idea why. It seems to me like the step function should be tail recursive (I think?) which would lead me to believe there's a buildup of thunks somewhere, and you can see the liberal application of bang patterns I threw about at random to try and fix that, to no avail.
Hoping someone can explain to me what I've done to cause this predicament so that I can move forward with the problem.
The map:
!xs' = map (move m d) xs
produces a large structure of unevaluated thunks.
Note that the bang (!) only forces the constructor of the list, so the "strict" value stored in xs' is just:
<unevaluated thunk> : <unevaluated thunk>
and everything else gets forced only when it's evaluated.
As far as evaluation is concerned, the primary driver is your clear test, but this only forces list elements until the first False, leaving the rest of the list unevaluated. As a result, you can end up with a large tree of in-process chains of map (move ...) calls.
I think the only way to get this to run in constant space is to do a "deepseq" on the map. Using Control.DeepSeq.force from the deepseq package, you can take out all the strictness annotations and force the map:
xs' = force $ map (move m d) xs
and that should run in constant space. I don't think it's efficient enough to run in reasonable time on the official input data.
Here's the full, constant space program:
import Control.DeepSeq (force)
import Data.Foldable
import Data.Map.Strict ((!))
import qualified Data.Map.Strict as M
main = readFile "8.txt" >>= print . proc . lines
proc (ds:_:xs) = step 1 ds m as ds where
m = (foldl' parse) M.empty xs
as = map (\x -> ((m ! x), False)) $ filter (\x -> (last x) == 'A') $ M.keys m
parse m s = M.insert n (l,r) m where
(n, ns) = splitAt 3 s
(l, ls) = splitAt 3 $ drop 4 ns
r = take 3 $ drop 2 ls
step i dds m xs [] = step i dds m xs dds
step i dds m xs (d:ds) = if clear xs' then (i + 1) else step (i + 1) dds m xs' ds where
xs' = force $ map (move m d) xs
clear cs = all (\(_,t) -> t) cs
move m 'L' ((x,_),_) = ((m ! x), (last x) == 'Z')
move m 'R' ((_,x),_) = ((m ! x), (last x) == 'Z')