aoc2024-day9.scm

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

(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 (un-rle input)
  (let next ([i (1- (string-length input))]
	     [acc '()])
    (if (>= i 0)
	(next (1- i)
	      (cons (make-list (char->digit (string-ref input i))
			       (if (eqv? (remainder i 2) 0)
				   (quotient i 2)
				   #f))
		    acc))
	(list->vector (concatenate! acc)))))


(define (contiguous-size input start)
  (let next ([i start])
    (if (or (eqv? i (vector-length input))
	    (not (eqv? (vector-ref input i)
		       (vector-ref input start))))
	(- i start)
	(next (1+ i)))))

(define (find-first-hole input target-size)
  (let next ([i 0])
    (cond
     [(eqv? i (vector-length input)) #f]
     [(vector-ref input i) (next (1+ i))]
     [else
      (let ([size (contiguous-size input i)])
	(if (>= size target-size)
	    i
	    (next (+ i size))))])))


(define (move-blocks! input)
  (let next ([i 0]
	     [j (1- (vector-length input))])
    (cond
     [(eqv? i j) #f]
     [(vector-ref input i) (next (1+ i) j)]
     [(not (vector-ref input j)) (next i (1- j))]
     [else (begin
	     (vector-swap! input i j)
	     (next (1+ i) (1- j)))])))

(define (move-files! input)
  (let next ([i (1- (vector-length input))])
    (if (> i 0)
	(begin
	  (if (and (vector-ref input i)
		   (not (eqv? (vector-ref input (1- i))
			      (vector-ref input i))))
	      (let* ([file-size (contiguous-size input i)]
		     [hole (find-first-hole input file-size)])
		(if (and hole (< hole i))
		    (begin
		      (vector-fill! input
				    (vector-ref input i)
				    hole (+ hole file-size))
		      (vector-fill! input
				    #f
				    i (+ i file-size))))))
	  (next (1- i))))))


(define (checksum input)
  (vector-fold
   (λ (i prev block)
     (+ prev
	(if block
	    (* i block)
	    0)))
   0 input))


(define (part1 input)
  (let ([copy (vector-copy input)])
    (move-blocks! copy)
    (checksum copy)))

(define (part2 input)
  (let ([copy (vector-copy input)])
    (move-files! copy)
    (checksum copy)))


(let* ([raw-input (get-line (current-input-port))]
       [input (un-rle raw-input)])
  (pretty-print (part1 input))
  (pretty-print (part2 input)))