aoc2023-day3.scm

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

;; Part 1

(define (char-is-part? ch)
  (and (not (char-numeric? ch))
       (not (char=? ch #\.))))

(define (%find-parts input filter)
  (let ([width (length (car input))]
	[height (length input)])
    (let next-line ([y 0])
      (let next-char ([x 0])
	(cons
	 (if (filter (list-ref (list-ref input y) x))
	     (cons x y)
	     #f)
	 (if (= (1+ x) width)
	     (if (= (1+ y) height)
		 '()
		 (next-line (1+ y)))
	     (next-char (1+ x))))))))

(define (%adjecent-digits input x y dx)
  (if (or (< x 0)
	  (>= x (length (car input)))
	  (< y 0)
	  (>= y (length input)))
      '()
      (if (char-numeric? (list-ref (list-ref input y) x))
	  (cons (cons x y) (%adjecent-digits input (+ x dx) y dx))
	  '())))

(define (%find-part-numbers input parts-alist)
  (concatenate
   (map (λ (part)
	  (concatenate
	   (map (λ (pos)
		  (append (%adjecent-digits input (car pos) (cdr pos) -1)
			  (%adjecent-digits input (car pos) (cdr pos) 1)))
		(map (λ (offset)
		       (cons (+ (car offset) (car part))
			     (+ (cdr offset) (cdr part))))
		     '((-1 . -1)
		       (-1 . 0)
		       (-1 . 1)
		       (0 . -1)
		       (0 . 1)
		       (1 . -1)
		       (1 . 0)
		       (1 . 1))))))
	    parts-alist)))

(define (find-part-numbers input parts-alist)
  (delete-duplicates (%find-part-numbers input parts-alist)))

(define (find-parts input)
  (filter identity (%find-parts input char-is-part?)))

(define (list-of-adj-numbers input part-numbers)
  ((compose (cut map string->number <>) (cut string-tokenize <> char-set:digit) list->string concatenate)
   (map (λ (y)
	  (map (λ (x)
		 (cond
		  [(member (cons x y) part-numbers) (list-ref (list-ref input y) x)]
		  [else #\.]))
	       (iota (length (car input)))))
	(iota (length input)))))

(define (part1 input)
  (let* ([parts (find-parts input)]
	 [part-numbers (find-part-numbers input parts)])
    (fold + 0 (list-of-adj-numbers input part-numbers))))

;; Part 2

(define (char-is-gear? ch)
  (char=? #\* ch))

(define (find-potential-gears input)
  (filter identity (%find-parts input char-is-gear?)))

(define (%find-gear-numbers input gears-alist)
  (map (λ (gear)
	 (let* ([nums (find-part-numbers input (list gear))]
		[adj (list-of-adj-numbers input nums)])
	   (if (equal? 2 (length adj))
	       adj
	       #f)))
       gears-alist))

(define (find-gear-numbers input gears-alist)
  (filter identity (%find-gear-numbers input gears-alist)))

(define (part2 input)
  (let* ([maybe-gears (find-potential-gears input)]
	 [gears (find-gear-numbers input maybe-gears)])
    (fold + 0 (map (cut apply * <>) gears))))

;; ...

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

(define (vis input parts part-numbers)
  (for-each (λ (y)
	      (for-each (λ (x)
			  (format #t "~a~c\x1B[0m"
				  (cond
				   [(member (cons x y) parts) "\x1B[31m"]
				   [(member (cons x y) part-numbers) "\x1B[32m"]
				   [else ""])
				  (list-ref (list-ref input y) x)))
			(iota (length (car input))))
	      (newline))
	    (iota (length input)))
  (newline))

(let ([input (read-input)])
  (format #t "Part 1: ~a~%" (part1 input))
  (format #t "Part 2: ~a~%" (part2 input)))