Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
Wowee, I took some wrong turns solving today's puzzle! After fixing some really inefficient pruning I ended up with a Dijkstra search that runs in 2.971s (for a less-than-impressive 124.782 l-s).
Solution
import Control.Monad
import Data.Array.Unboxed (UArray)
import qualified Data.Array.Unboxed as Array
import Data.Char
import qualified Data.HashSet as Set
import qualified Data.PQueue.Prio.Min as PQ
readInput :: String -> UArray (Int, Int) Int
readInput s =
let rows = lines s
in Array.amap digitToInt
. Array.listArray ((1, 1), (length rows, length $ head rows))
$ concat rows
walk :: (Int, Int) -> UArray (Int, Int) Int -> Int
walk (minStraight, maxStraight) grid = go Set.empty initPaths
where
initPaths = PQ.fromList [(0, ((1, 1), (d, 0))) | d <- [(0, 1), (1, 0)]]
goal = snd $ Array.bounds grid
go done paths =
case PQ.minViewWithKey paths of
Nothing -> error "no route"
Just ((n, (p@(y, x), hist@((dy, dx), k))), rest)
| p == goal && k >= minStraight -> n
| (p, hist) `Set.member` done -> go done rest
| otherwise ->
let next = do
h'@((dy', dx'), _) <-
join
[ guard (k >= minStraight) >> [((dx, dy), 1), ((-dx, -dy), 1)],
guard (k < maxStraight) >> [((dy, dx), k + 1)]
]
let p' = (y + dy', x + dx')
guard $ Array.inRange (Array.bounds grid) p'
return (n + grid Array.! p', (p', h'))
in go (Set.insert (p, hist) done) $
(PQ.union rest . PQ.fromList) next
main = do
input <- readInput <$> readFile "input17"
print $ walk (0, 3) input
print $ walk (4, 10) input