aoc-2021/day15.rkt

#lang racket
(require "lib/common.rkt"
         fancy-app
         graph
         threading)

(struct posn (x y) #:transparent)

(define (posn+ p1 p2)
  (posn (+ (posn-x p1) (posn-x p2))
        (+ (posn-y p1) (posn-y p2))))

(define (1norm x y)
  (+ (abs x) (abs y)))

(define ((repeat fn n) val)
  (for/fold ([acc val])
            ([_ (in-range n)])
    (fn acc)))

(define (explode str)
  (map string (string->list str)))

(define (parse lines)
  (~>> lines
       (map explode)
       (map (λ~>> (map string->number)
                  (apply vector)))
       (apply vector)))

(define (board-dim board)
  (cons (vector-length (vector-ref board 0))
        (vector-length board)))
(define (board-ref board x y)
  (vector-ref (vector-ref board y) x))

(define (adjacents board p)
  (match-define (cons m n) (board-dim board))

  (define (valid? p)
    (match-define (posn x y) p)
    (not (or (< x 0) (< y 0) (>= x m) (>= y n))))

  (for/list ([path (in-list (list (posn 0 1) (posn 1 0) (posn 0 -1) (posn -1 0)))]
             #:when (valid? (posn+ path p)))
    (posn+ path p)))

(define (generate-graph board)
  (match-define (cons m n) (board-dim board))
  (define edges
    (for*/list ([i (in-range 0 m)]
                [j (in-range 0 n)]
                [adj (in-list (adjacents board (posn i j)))])
      (list (board-ref board (posn-x adj) (posn-y adj))
            (posn i j) adj)))
  (weighted-graph/directed edges))

(define (day15a board)
  (match-define (cons m n) (board-dim board))
  (define G (generate-graph board))
  (define-values (distances _) (dijkstra G (posn 0 0)))

  (hash-ref distances (posn (sub1 m) (sub1 n))))

(define (tesselate starting-board)
  (match-define (cons m n) (board-dim starting-board))

  (define (increment board)
    ;; annoyingly not modulo
    (vector-map (vector-map (λ (x) (if (= (add1 x) 10) 1 (add1 x))) _) board))

  (define boards
    (for*/vector ([i (in-range 5)]
                  [j (in-range 5)])
      ((repeat increment (1norm i j)) starting-board)))

  (define (bboard-ref vec i j)
    (~> vec
        (vector-ref (+ (floor (/ j n)) (* 5 (floor (/ i m)))))
        (board-ref (modulo i m) (modulo j n))))

  (for/vector ([j (in-range (* 5 n))])
    (for/vector ([i (in-range (* 5 m))])
      (bboard-ref boards i j))))

(define (day15b board)
  (day15a (tesselate board)))

(module+ main
  (call-with-input-file "data/day15.txt"
    (λ (prt)
      (define board (parse (port->lines prt)))
      (answer 15 1 (time (day15a board)))
      (answer 15 2 (time (day15b board))))))

(module+ test
  (require rackunit)

  (define test-input #<<EOD
1163751742
1381373672
2136511328
3694931569
7463417111
1319128137
1359912421
3125421639
1293138521
2311944581
EOD
    )

  (define board (parse (string-split test-input)))
  (check-equal? (day15a board) 40)
  (check-equal? (day15b board) 315))