aoc2024-day10.scm

(use-modules (srfi srfi-1) (srfi srfi-26) (ice-9 pretty-print) (ice-9 textual-ports) (ice-9 match))

(define (char->digit ch)
  (match ch
    [#\0 0]
    [#\1 1]
    [#\2 2]
    [#\3 3]
    [#\4 4]
    [#\5 5]
    [#\6 6]
    [#\7 7]
    [#\8 8]
    [#\9 9]))

(define (%read-input)
  (let ([line (get-line (current-input-port))])
    (if (eof-object? line)
	'()
	(cons (map char->digit (string->list line)) (%read-input)))))

(define (read-input)
  (list->array 2 (%read-input)))


(define (find-starting-positions input)
  (let ([unrolled (array-contents input)]
	[width (cadr (array-dimensions input))])
    (let next ([i 0]
	       [acc '()])
      (if (array-in-bounds? unrolled i)
	  (next (1+ i)
		(if (eqv? (array-ref unrolled i) 0)
		    (cons (cons (quotient  i width)
				(remainder i width))
			  acc)
		    acc))
	  acc))))


(define (valid-paths input from)
  (concatenate!
   (map (λ (dy dx)
	  (if (and (array-in-bounds? input
				     (+ (car from) dy)
				     (+ (cdr from) dx))
		   (eqv? 1 (- (array-ref input
					 (+ (car from) dy)
					 (+ (cdr from) dx))
			      (array-ref input (car from) (cdr from)))))
	      (list (cons (+ (car from) dy)
			  (+ (cdr from) dx)))
	      '()))
	'(-1  1  0  0)
	'( 0  0 -1  1))))


(define (count-paths-from input from)
  (let ([target-set (make-hash-table)])
    (let next ([queue (valid-paths input from)])
      (if (null? queue)
	  (hash-count (const #t) target-set)
	  (let ([cur (car queue)]
		[rest (cdr queue)])
	    (if (eqv? (array-ref input (car cur) (cdr cur)) 9)
		(hash-set! target-set cur #t))
	    (next (append-reverse! (valid-paths input cur) rest)))))))


(define (starting-position-ranking input from)
  (let next ([queue (valid-paths input from)]
	     [finished-ctr 0])
    (if (null? queue)
	finished-ctr
	(let ([cur (car queue)]
	      [rest (cdr queue)])

	  (next (append-reverse! (valid-paths input cur) rest)
		(if (eqv? (array-ref input (car cur) (cdr cur)) 9)
		    (1+ finished-ctr)
		    finished-ctr))))))


(let* ([input (read-input)]
       [starting-positions (find-starting-positions input)])
  (pretty-print
   (fold + 0 (map (cut count-paths-from input <>) starting-positions)))
  (pretty-print
   (fold + 0 (map (cut starting-position-ranking input <>) starting-positions))))