aoc2024-day14.scm

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

(define-peg-string-patterns
  "top <-- (entry NL)* !.
entry <-- var SPACE var
var <-- ('p'/'v') EQUAL number COMMA number
number <-- '-'? [0-9]+
EQUAL < '='
COMMA < ','
SPACE < ' '
NL < '\n'
")


(define (parse-number num)
  (string->number (second num)))

(define (parse-var var)
  (cons (parse-number (third var))
	(parse-number (fourth var))))

(define (parse-entry entry)
  (list (parse-var (second entry))
	(parse-var (third entry))))


(define (vec2+ a b)
  (cons (+ (car a) (car b))
	(+ (cdr a) (cdr b))))

(define (vec2* a scalar)
  (cons (* (car a) scalar)
	(* (cdr a) scalar)))

(define (vec2% a m)
  (cons (euclidean-remainder (car a) (car m))
	(euclidean-remainder (cdr a) (cdr m))))


(define (simulate-robot width height steps initial velocity)
  (vec2% (vec2+ initial (vec2* velocity steps)) (cons width height)))

(define (simulate-robots width height steps robots)
  (map (cut apply
	    simulate-robot
	    width height steps
	    <>)
       robots))


(define (quadrant width height position)
  (if (or (eqv? (car position) (quotient width  2))
	  (eqv? (cdr position) (quotient height 2)))
      #f
      (+ (if (> (car position) (/ width 2))
	     1 0)
	 (if (> (cdr position) (/ height 2))
	     2 0))))

(define (count-quadrants quadrants)
  (let next ([rest quadrants]
	     [q0 0] [q1 0]
	     [q2 0] [q3 0])
    (if (null? rest)
	(list q0 q1 q2 q3)
	(match (car rest)
	  [0 (next (cdr rest) (1+ q0) q1 q2 q3)]
	  [1 (next (cdr rest) q0 (1+ q1) q2 q3)]
	  [2 (next (cdr rest) q0 q1 (1+ q2) q3)]
	  [3 (next (cdr rest) q0 q1 q2 (1+ q3))]
	  [_ (next (cdr rest) q0 q1 q2 q3)]))))

(define (part1 width height entries)
  (let* ([final (simulate-robots width height 100 entries)]
	 [quadrants (map (cut quadrant width height <>) final)]
	 [counts (count-quadrants quadrants)])
    (fold * 1 counts)))


(define (max-vspan-length arr x height)
  (let next ([y 1]
	     [cur-len 1]
	     [max-len 1])
    (if (eqv? y height)
	max-len
	(let ([new-len (if (and (array-ref arr (1- y) x)
				(array-ref arr     y  x))
			   (1+ cur-len)
			   1)])
	  (next (1+ y)
		new-len
		(max max-len new-len))))))

(define (part2-solution? width height positions)
  (let ([arr (make-array #f height width)])
    (for-each
     (λ (pos)
       (array-set! arr #t (cdr pos) (car pos)))
     positions)

    (> (fold max 0
	     (map (cut max-vspan-length arr <> height)
		  (iota width)))
       30)))

(define (%part2 width height initial-step step-jump cancel? entries)
  (let next ([steps initial-step])
    (let ([final (simulate-robots width height steps entries)])
      (if (atomic-box-ref cancel?)
	  #f
	  (if (part2-solution? width height final)
	      (begin
	        (atomic-box-set! cancel? #t)
	        steps)
	      (next (+ steps step-jump)))))))

(define (part2 threads width height entries)
  (let ([cancel? (make-atomic-box #f)])
    (car
     (filter
      identity
      (n-par-map threads
		 (cut %part2 width height <> threads cancel? entries)
		 (iota threads))))))


(let* ([input (get-string-all (current-input-port))]
       [peg-tree (peg:tree (match-pattern top input))]
       [entries (map parse-entry (cdr peg-tree))])
  (pretty-print (part1 101 103 entries))
  (pretty-print (part2 6 101 103 entries)))