aoc2024-day12.scm

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


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

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


(define (discover-region input visited-set start-y start-x)
  (let ([start-tile (array-ref input start-y start-x)])
    (let next ([queue (list (cons start-y start-x))]
	       [region '()])
      (if (null? queue)
	  region
	  (let* ([cur (car queue)]
		 [rest (cdr queue)]
		 [cur-y (car cur)]
		 [cur-x (cdr cur)])
	    (if (or (not (array-in-bounds? input cur-y cur-x))
		    (hash-ref visited-set cur)
		    (not (eqv? (array-ref input cur-y cur-x) start-tile)))
		(next rest region)
		(begin
		  (hash-set! visited-set cur #t)
		  (next (append-reverse (map (λ (dy dx)
					       (cons (+ cur-y dy)
						     (+ cur-x dx)))
					     '(-1  1  0  0)
					     '( 0  0 -1  1))
					rest)
			(cons cur region)))))))))

(define (discover-all-regions input)
  (let ([unrolled (array-contents input)]
	[width (cadr (array-dimensions input))]
	[visited-set (make-hash-table)])
    (let next ([i 0]
	       [acc '()])
      (if (array-in-bounds? unrolled i)
	  (next (1+ i)
		(cons (discover-region input visited-set
				       (quotient  i width)
				       (remainder i width))
		      acc))
	  (filter (λ (lst) (not (null? lst)))
		  acc)))))


(define (region-area input region)
  (length region))


(define (tile-perimeter input y x)
  (fold + 0
	(map (λ (dy dx)
	       (if (or (not (array-in-bounds? input (+ y dy) (+ x dx)))
		       (not (eqv? (array-ref  input (+ y dy) (+ x dx))
				  (array-ref  input    y        x))))
		   1 0))
	     '(-1  1  0  0)
	     '( 0  0 -1  1))))

(define (region-perimeter input region)
  (fold + 0 (map (λ (v) (tile-perimeter input (car v) (cdr v))) region)))


(define (merge-spans lst)
  (if (null? lst)
      '()
      (let next ([prev  (car lst)]
		 [rest  (cdr lst)]
		 [acc '()]
		 [len 0])
	(if (null? rest)
	    (cons (1+ len) acc)
	    (if (eqv? -1 (- (car rest) prev))
		(next (car rest)
		      (cdr rest)
		      acc
		      (1+ len))
		(next (car rest)
		      (cdr rest)
		      (cons (1+ len) acc)
		      0))))))

(define (count-edges-along-x-line input region y)
  (let ([width (cadr (array-dimensions input))])
    (let next ([x -1]
	       [top '()]
	       [bottom '()])
      (if (<= x width)
	  (if (hash-ref region (cons y x))
	      (next (1+ x)
		    (if (hash-ref region (cons (1- y) x))
			top
			(cons x top))
		    (if (hash-ref region (cons (1+ y) x))
			bottom
			(cons x bottom)))
	      (next (1+ x) top bottom))
	  (+ (length (merge-spans top))
	     (length (merge-spans bottom)))))))

(define (count-edges-along-y-line input region x)
  (let ([height (car (array-dimensions input))])
    (let next ([y -1]
	       [left '()]
	       [right '()])
      (if (<= y height)
	  (if (hash-ref region (cons y x))
	      (next (1+ y)
		    (if (hash-ref region (cons y (1- x)))
			left
			(cons y left))
		    (if (hash-ref region (cons y (1+ x)))
			right
			(cons y right)))
	      (next (1+ y) left right))
	  (+ (length (merge-spans left))
	     (length (merge-spans right)))))))

(define (list->hash-set lst)
  (alist->hash-table (map (cut cons <> #t) lst)))

(define (region-sides input region)
  (let ([region-set (list->hash-set region)])
    (+
     (fold + 0 (map
		(cut count-edges-along-x-line input region-set <>)
		(iota (car (array-dimensions input)))))
     (fold + 0 (map
		(cut count-edges-along-y-line input region-set <>)
		(iota (cadr (array-dimensions input))))))))


(define (part1-region-price input region)
  (* (region-area input region)
     (region-perimeter input region)))

(define (part2-region-price input region)
  (* (region-area input region)
     (region-sides input region)))


(define (total-price input regions compute-price)
  (fold + 0 (map (cut compute-price input <>) regions)))

(let* ([input (read-input)]
       [regions (discover-all-regions input)])
  (pretty-print (total-price input regions part1-region-price))
  (pretty-print (total-price input regions part2-region-price)))