day13.scm - advent-of-code - Perserverance, or the lack thereof

day13.scm (2859B)

    1 (use-modules (ice-9 popen))
    2 (use-modules (ice-9 rdelim))
    3 (use-modules (ice-9 format))
    4 (use-modules (srfi srfi-1))
    5 
    6 (define (parse-input filename)
    7   (let ((file (open-input-file filename))
    8         (maps '())
    9         (curr '()))
   10     (while #t
   11            (let ((line (car (%read-line file))))
   12              (if (eof-object? line)
   13                  (break)
   14                  (if (equal? line "")
   15                      (begin
   16                        (set! maps (cons (reverse curr) maps))
   17                        (set! curr '()))
   18                      (set! curr (cons (string->list line) curr))))))
   19     (if (> (length curr) 0)
   20         (set! maps (cons (reverse curr) maps)))
   21     (reverse maps)))
   22 
   23 (define (diff-col map a b)
   24   (let ((diff 0))
   25     (do ((i 0 (1+ i))) ((>= i (length map)))
   26       (if (not (equal? (list-ref (list-ref map i) a)
   27                        (list-ref (list-ref map i) b)))
   28           (set! diff (1+ diff))))
   29     diff))
   30 
   31 (define (diff-row map a b)
   32   (let ((diff 0))
   33     (do ((i 0 (1+ i))) ((>= i (length (car map))))
   34       (if (not (equal? (list-ref (list-ref map a) i)
   35                        (list-ref (list-ref map b) i)))
   36           (set! diff (1+ diff))))
   37     diff))
   38 
   39 (define (has-mirror-col map a tol)
   40   (let ((diff-tot 0)
   41         (left a)
   42         (right (1+ a))
   43         (x-min 0)
   44         (x-max (1- (length (car map)))))
   45     (do ((left a (1- left))
   46          (right (1+ a) (1+ right)))
   47         ((or (> diff-tot tol) (< left x-min) (> right x-max))
   48          #t)
   49       (set! diff-tot (+ diff-tot (diff-col map left right))))
   50     (= diff-tot tol)))
   51 
   52 (define (has-mirror-row map a tol)
   53   (let ((diff-tot 0)
   54         (up a)
   55         (down (1+ a))
   56         (y-min 0)
   57         (y-max (1- (length map))))
   58     (do ((up a (1- up))
   59          (down (1+ a) (1+ down)))
   60         ((or (> diff-tot tol) (< up y-min) (> down y-max))
   61          #t)
   62       (set! diff-tot (+ diff-tot (diff-row map up down))))
   63     (= diff-tot tol)))
   64 
   65 (define (find-reflection map tol)
   66   (let ((mirror-col #nil)
   67         (mirror-row #nil)
   68         (col-max (- (length (car map)) 2))
   69         (row-max (- (length map) 2)))
   70     (do ((i 0 (1+ i)))
   71         ((or (not (null? mirror-col)) (> i col-max)))
   72       (if (has-mirror-col map i tol)
   73           (set! mirror-col i)))
   74     (if (null? mirror-col)
   75         (begin
   76           (do ((i 0 (1+ i)))
   77               ((or (not (null? mirror-row)) (> i row-max)))
   78             (if (has-mirror-row map i tol)
   79                 (set! mirror-row i)))
   80           (* 100 (1+ mirror-row)))
   81         (1+ mirror-col))))
   82 
   83 (let* ((maps (parse-input "input.txt"))
   84        (scores-1 (map (lambda (x) (find-reflection x 0)) maps))
   85        (tot-1 (fold + 0 scores-1))
   86        (scores-2 (map (lambda (x) (find-reflection x 1)) maps))
   87        (tot-2 (fold + 0 scores-2)))
   88   ;; 40006
   89   (format #t "Part 1: ~d" tot-1)
   90   (newline)
   91   ;; 28627
   92   (format #t "Part 2: ~d" tot-2)
   93   (newline))