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

day11.scm (3190B)

    1 (use-modules (ice-9 popen))
    2 (use-modules (ice-9 rdelim))
    3 (use-modules (ice-9 format))
    4 (use-modules (ice-9 receive))
    5 (use-modules (ice-9 hash-table))
    6 (use-modules (ice-9 match))
    7 (use-modules (srfi srfi-1))
    8 
    9 (define (parse-input filename)
   10   (let ((file (open-input-file filename))
   11         (image '()))
   12     (while #t
   13            (let ((line (car (%read-line file))))
   14              (if (eof-object? line)
   15                  (break)
   16                  (set! image (cons (string->list line) image)))))
   17     (reverse image)))
   18 
   19 (define (find-galaxies image)
   20   (let ((galaxies '())
   21         (y-max (length image))
   22         (x-max (length (car image))))
   23     (do ((y 0 (1+ y))) ((>= y y-max))
   24       (do ((x 0 (1+ x))) ((>= x x-max))
   25         (case (list-ref (list-ref image y) x)
   26           ((#\#) (set! galaxies (cons (cons x y) galaxies))))))
   27     (reverse galaxies)))
   28 
   29 (define (get-column image x)
   30   (let ((y-max (length image))
   31         (x-max (length (car image)))
   32         (column '()))
   33     (do ((y 0 (1+ y))) ((>= y y-max))
   34       (set! column (cons (list-ref (list-ref image y) x) column)))
   35     (reverse column)))
   36 
   37 (define (no-galaxy line)
   38   (if (null? line)
   39       #t
   40       (and (equal? (car line) #\.) (no-galaxy (cdr line)))))
   41 
   42 (define (find-expansion image)
   43   (let ((y-max (length image))
   44         (x-max (length (car image)))
   45         (expand-x '())
   46         (expand-y '()))
   47     (do ((y 0 (1+ y))) ((>= y y-max))
   48       (if (no-galaxy (list-ref image y))
   49           (set! expand-y (cons y expand-y))))
   50     (do ((x 0 (1+ x))) ((>= x x-max))
   51       (if (no-galaxy (get-column image x))
   52           (set! expand-x (cons x expand-x))))
   53     (list (reverse expand-x) (reverse expand-y))))
   54 
   55 (define (between a b c)
   56   (if (> b c)
   57       (between a c b)
   58       (and (>= a b) (<= a c))))
   59 
   60 (define (calc-dist expansion curr next mult)
   61   (let* ((x-a (car curr))
   62          (y-a (cdr curr))
   63          (x-b (car next))
   64          (y-b (cdr next))
   65          (x-expand (car expansion))
   66          (y-expand (car (cdr expansion)))
   67          (dist (+ (abs (- y-b y-a)) (abs (- x-b x-a)))))
   68     (do ((i 0 (1+ i))) ((>= i (length x-expand)))
   69       (if (between (list-ref x-expand i) x-a x-b)
   70           (set! dist (+ dist (1- mult)))))
   71     (do ((i 0 (1+ i))) ((>= i (length y-expand)))
   72       (if (between (list-ref y-expand i) y-a y-b)
   73           (set! dist (+ dist (1- mult)))))
   74     dist))
   75 
   76 (define (calc-dist-all expansion curr other-galaxies mult)
   77   (if (null? other-galaxies)
   78       0
   79       (let ((dist-sum 0))
   80         (do ((i 0 (1+ i))) ((>= i (length other-galaxies)))
   81           (set! dist-sum
   82                 (+ dist-sum
   83                    (calc-dist expansion curr (list-ref other-galaxies i) mult))))
   84         (+ dist-sum
   85            (calc-dist-all expansion (car other-galaxies) (cdr other-galaxies) mult)))))
   86 
   87 (let* ((image (parse-input "input.txt"))
   88        (galaxies (find-galaxies image))
   89        (expansion (find-expansion image))
   90        (total-dist-1 (calc-dist-all expansion (car galaxies) (cdr galaxies) 2))
   91        (total-dist-2 (calc-dist-all expansion (car galaxies) (cdr galaxies) 1000000)))
   92   ;; 10289334
   93   (format #t "Part 1: ~d" total-dist-1)
   94   (newline)
   95   ;; 649862989626
   96   (format #t "Part 2: ~d" total-dist-2)
   97   (newline))