Same as the first problem, except the map is five times larger along the x and y axes.
$ cat 15b.rkt #lang racket (require "15a.rkt" (prefix-in array: "array.rkt") (prefix-in pq: "pq.rkt")) (define (aoc15b) ; Return the risk of the minimal risk path for the second half of ; the fifteenth AoC '21 problem. (find-minimal-path (read-input))) (define (find-minimal-path rmap-data) ; Return the risk associated with the minimal-risk path from the ; start state to the goal state using the given risk-map data. (define path-map (path-map:new rmap-data)) (define pending (pq:new less-risky)) (let loop ((p (path-map:start-state))) (if (path-map:goal-state? path-map p) (path-map:goal-risk path-map) (begin (for-each (lambda (p) (pq:nq! pending p)) (path-map:extend-path path-map p)) (if (pq:mt? pending) (error 'find-minimal-path "no path to goal state") (loop (pq:dq! pending))))))) (define (less-risky rp1 rp2) ; Return #t iff rp1 is less risky than rp2. (< (risk-path-risk rp1) (risk-path-risk rp2))) ; The second half of the problem takes the original risk-map and ; replicates it four times along the x and y axes; however, each ; replication increases the risks being replicated by one, with 9 ; wrapping around to 1. ; Call the original, unreplicated risk map the tile. The final risk ; map is a 5x5 array of risk-shifted tiles ; ; 0 1 2 3 4 ; 1 2 3 4 5 ; 2 3 4 5 6 ; 3 4 5 6 7 ; 4 5 6 7 8 ; ; where each element is the amount the risk in the associated tile is ; shifted. The original tile is in the upper-left corner at index (0, ; 0). (struct array-5x5 (tile rows cols tile-rows tile-cols)) ; If r is a shifted but unwrapped-around risk, wrapped-around-risks[r - 2] is ; the assoiacted wrapped-around risk. Because 0 or 1 can never be a shifted, ; unwrapped-around risk, the vector starts at 2, and vectors are zero-origin ; indexed, the index requires a left-shift by two to align properly. (define wrapped-around-risks #(2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8)) (define (array-5x5:cols a5x5) ; Return the number of columns in the given array. (array-5x5-cols a5x5)) (define (array-5x5:new a-data) ; Return a new array initialized to the given data. (let* ((tile (array:new a-data)) (tile-cols (array:cols tile)) (tile-rows (array:rows tile))) (array-5x5 tile (* tile-cols 5) (* tile-rows 5) tile-cols tile-rows))) (define (array-5x5:ref a5x5 x y) ; Return the element in the given array at the given coordinate. (cond ((or (< x -1) (< y -1) (> x (array-5x5-cols a5x5)) (> y (array-5x5-rows a5x5))) (raise-arguments-error 'ref "index (~a, ~a) out of bounds" x y)) ((or (= x -1) (= y -1) (= x (array-5x5-cols a5x5)) (= y (array-5x5-rows a5x5))) +inf.0) (#t (let-values (((tile-x risk-x) (quotient/remainder x (array-5x5-tile-cols a5x5))) ((tile-y risk-y) (quotient/remainder y (array-5x5-tile-cols a5x5)))) (let ((original-risk (array:ref (array-5x5-tile a5x5) risk-x risk-y)) (shift (+ tile-x tile-y))) (if (zero? shift) original-risk (vector-ref wrapped-around-risks (+ original-risk shift -2)))))))) (define (array-5x5:rows a5x5) ; Return the number of rows in the given array. (array-5x5-rows a5x5)) (define (path-map:extend-path path-map path) ; Return a list of valid paths one step away from the given path ; according to the given path map (which is changed to reflect ; the valid path extensions). (foldr (lambda (deltas new-paths) (let* ((pmap (path-map-path-map path-map)) (new-x (+ (risk-path-x path) (car deltas))) (new-y (+ (risk-path-y path) (cdr deltas))) (new-risk (+ (risk-path-risk path) (array-5x5:ref (path-map-risk-map path-map) new-x new-y)))) (if (> (array:ref pmap new-x new-y) new-risk) (begin (array:set! pmap new-x new-y new-risk) (cons (risk-path new-x new-y new-risk) new-paths)) new-paths))) '() '((0 . -1) (-1 . 0) (1 . 0) (0 . 1)))) (define (path-map:goal-risk path-map) ; Return the current goal-state risk, which represents the minimal risk ; of a path from the start state to the goal state. Note that such a ; path may not exists when this function is called, in which case +inf.0 ; is returned. (let ((pm (path-map-path-map path-map))) (array:ref pm (- (array:cols pm) 1) (- (array:rows pm) 1)))) (define (path-map:goal-state? path-map path) ; Return #t iff the given path ends at the goal state. (let ((rmap (path-map-risk-map path-map))) (and (= (risk-path-y path) (- (array-5x5:cols rmap) 1)) (= (risk-path-x path) (- (array-5x5:rows rmap) 1))))) (define (path-map:new rmap-data) ; Return a new path map based on the given risk-map data. (let* ((rmap (array-5x5:new rmap-data)) (pmap-data (vector->list (make-vector (array-5x5:rows rmap) (vector->list (make-vector (array-5x5:cols rmap) +inf.0)))))) (path-map rmap (array:new pmap-data)))) (module+ main (aoc15b)) (module+ test (require rackunit) (let ((a (array-5x5:new '((1))))) (check-equal? (array-5x5:cols a) 5) (check-equal? (array-5x5:rows a) 5) (do ((x 0 (+ x 1))) ((= x 5) (void)) (do ((y 0 (+ y 1))) ((= y 5) (void)) (check-equal? (array-5x5:ref a x y) (+ x y 1))))) (let ((a1 (array-5x5:new (read-input example-a-input))) (a2 (array:new (read-input example-b-input)))) (check-equal? (array-5x5:cols a1) (array:cols a2)) (check-equal? (array-5x5:rows a1) (array:rows a2)) (do ((x (- (array-5x5:cols a1) 1) (- x 1))) ((= x -1) (void)) (do ((y (- (array-5x5:rows a1) 1) (- y 1))) ((= y -1) (void)) (check-equal? (array-5x5:ref a1 x y) (array:ref a2 x y))))) (check-equal? (find-minimal-path (read-input example-a-input)) example-b-input-result) (check-equal? (find-minimal-path (read-input "1")) 44) ) $ raco test 15b.rkt raco test: (submod "15b.rkt" test) 2531 tests passed $