aoc2023-day13.scm

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

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

(define (%read-input lines)
  (receive (this rest)
      (span (negate string-null?) lines)
    (cons (list->vector (map (compose list->vector string->list) this))
	  (if (null? rest)
	      '()
	      (%read-input (cdr rest))))))

(define (read-input) (%read-input (read-lines)))

(define (%get-column input x)
  (let next ([y 0]
	     [items '()])
    (if (eqv? y (vector-length input))
	items
	(next (1+ y)
	      (cons (vector-ref (vector-ref input y) x)
		    items)))))

(define (%get-row input y)
  (vector->list (vector-ref input y)))

(define (count-differences l1 l2)
  (length (filter not (map char=? l1 l2))))

(define (%symmetry-at? input p0 pmax line-accessor check-smudge?)
  (let next ([p 0]
	     [check-smudge? check-smudge?])
    (if (or (>= (+ p p0 1) pmax)
	    (< (- p0 p) 0))
	(not check-smudge?)
	(let* ([l0 (line-accessor input (- p0 p))]
	       [l1 (line-accessor input (+ p0 p 1))]
	       [d (count-differences l0 l1)])
	  (and (<= d (if check-smudge? 1 0))
	       (next (1+ p)
		     (and check-smudge?
			  (< d 1))))))))

(define (vertical-symmetry-at? input x0 check-smudge?)
  (%symmetry-at? input x0
		 (vector-length (vector-ref input 0))
		 %get-column
		 check-smudge?))

(define (horizontal-symmetry-at? input y0 check-smudge?)
  (%symmetry-at? input y0
		 (vector-length input)
		 %get-row
		 check-smudge?))

(define (%find-symmetry input pmax symmetry-at? line-accessor mul check-smudge?)
  (let next ([p 0])
    (cond
     [(eqv? p (1- pmax)) #f]
     [(and (<= (count-differences
		(line-accessor input p)
		(line-accessor input (1+ p)))
	       1)
	   (symmetry-at? input p check-smudge?))
      (* mul (1+ p))]
     [else (next (1+ p))])))

(define (find-vertical-symmetry input check-smudge?)
  (%find-symmetry input
		  (vector-length (vector-ref input 0))
		  vertical-symmetry-at?
		  %get-column
		  1
		  check-smudge?))

(define (find-horizontal-symmetry input check-smudge?)
  (%find-symmetry input
		  (vector-length input)
		  horizontal-symmetry-at?
		  %get-row
		  100
		  check-smudge?))

(define (part-common input check-smudge?)
  (fold + 0
	(map (λ (v h)
	       (or v h))
	     (map (cut find-vertical-symmetry <> check-smudge?) input)
	     (map (cut find-horizontal-symmetry <> check-smudge?) input))))

(let ([input (read-input)])
  (format #t "Part 1: ~a~%" (part-common input #f))
  (format #t "Part 2: ~a~%" (part-common input #t)))