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

day10.scm (6367B)

    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         (tiles '()))
   12     (while #t
   13            (let ((line (car (%read-line file))))
   14              (if (eof-object? line)
   15                  (break)
   16                  (set! tiles (cons (string->list line) tiles)))))
   17     (reverse tiles)))
   18 
   19 (define (parse-pipes tiles)
   20   (let ((connections (make-hash-table))
   21         (double-connections (make-hash-table))
   22         (start '())
   23         (y-max (length tiles))
   24         (x-max (length (car tiles))))
   25     (do ((y 0 (1+ y))) ((>= y y-max))
   26       (do ((x 0 (1+ x))) ((>= x x-max))
   27         (let ((c (list-ref (list-ref tiles y) x)))
   28           (case c
   29             ((#\|)
   30              (begin (hash-set! connections (list (cons x y) (cons x (1- y))) #t)
   31                     (hash-set! connections (list (cons x y) (cons x (1+ y))) #t)))
   32             ((#\-)
   33              (begin (hash-set! connections (list (cons x y) (cons (1+ x) y)) #t)
   34                     (hash-set! connections (list (cons x y) (cons (1- x) y)) #t)))
   35             ((#\L)
   36              (begin (hash-set! connections (list (cons x y) (cons x (1- y))) #t)
   37                     (hash-set! connections (list (cons x y) (cons (1+ x) y)) #t)))
   38             ((#\J)
   39              (begin (hash-set! connections (list (cons x y) (cons x (1- y))) #t)
   40                     (hash-set! connections (list (cons x y) (cons (1- x) y)) #t)))
   41             ((#\7)
   42              (begin (hash-set! connections (list (cons x y) (cons x (1+ y))) #t)
   43                     (hash-set! connections (list (cons x y) (cons (1- x) y)) #t)))
   44             ((#\F)
   45              (begin (hash-set! connections (list (cons x y) (cons x (1+ y))) #t)
   46                     (hash-set! connections (list (cons x y) (cons (1+ x) y)) #t)))
   47             ((#\S) (set! start (cons x y)))
   48             (else '())))))
   49     (hash-for-each
   50      (lambda (k v)
   51        (let ((a (car k))
   52              (b (car (cdr k))))
   53          (if (or (hash-ref connections (list b a)) (equal? b start))
   54              (begin (hash-set! double-connections a (cons b (hash-ref double-connections a '())))
   55                     (if (equal? b start)
   56                         (hash-set! double-connections b (cons a (hash-ref double-connections b '()))))))))
   57      connections)
   58     (for-each
   59      (lambda (x) (hash-set! connections (list start x) #t))
   60      (hash-ref double-connections start))
   61     (let* ((up-conn (hash-ref connections (list start (cons (+ (car start) 0) (+ (cdr start) -1)))))
   62            (down-conn (hash-ref connections (list start (cons (+ (car start) 0) (+ (cdr start) 1)))))
   63            (left-conn (hash-ref connections (list start (cons (+ (car start) -1) (+ (cdr start) 0)))))
   64            (right-conn (hash-ref connections (list start (cons (+ (car start) 1) (+ (cdr start) 0)))))
   65            (conns (list up-conn down-conn left-conn right-conn))
   66            (start-tile (cond
   67                         ((equal? conns (list #t #t #f #f)) #\|)
   68                         ((equal? conns (list #t #f #t #f)) #\J)
   69                         ((equal? conns (list #t #f #f #t)) #\L)
   70                         ((equal? conns (list #f #t #t #f)) #\7)
   71                         ((equal? conns (list #f #t #f #t)) #\F)
   72                         ((equal? conns (list #f #f #t #t)) #\-))))
   73       (list-set! (list-ref tiles (cdr start)) (car start) start-tile))
   74     (values start double-connections tiles)))
   75 
   76 (define (find-furthest start double-connections)
   77   (let ((dist (make-hash-table))
   78         (queue (list start))
   79         (steps 0))
   80     (hash-set! dist start steps)
   81     (let ((queue-next '()))
   82       (while #t
   83              (set! steps (1+ steps))
   84              (for-each
   85               (lambda (curr)
   86                 (for-each
   87                  (lambda (next)
   88                    (if (not (hash-ref dist next))
   89                        (begin (hash-set! dist next steps)
   90                               (set! queue-next (cons next queue-next)))))
   91                  (hash-ref double-connections curr)))
   92               queue)
   93              (if (null? queue-next)
   94                  (break))
   95              (set! queue queue-next)
   96              (set! queue-next '())))
   97     (let ((max-steps (1- steps)))
   98       (values max-steps dist))))
   99 
  100 (define (count-wall-to-edge tiles dist curr count)
  101   (let* ((y-max (length tiles))
  102          (x-max (length (car tiles)))
  103          (dx 0)
  104          (dy 1)
  105          (next (cons (+ (car curr) dx) (+ (cdr curr) dy)))
  106          (in-range (and (and (>= (car next) 0) (< (car next) x-max))
  107                         (and (>= (cdr next) 0) (< (cdr next) y-max))))
  108          (in-loop (hash-ref dist next)))
  109     (if in-range
  110         (begin
  111           (if in-loop
  112               (let ((next-pipe (list-ref (list-ref tiles (cdr next)) (car next))))
  113                 (set! count
  114                       (+ count (case next-pipe
  115                                  ((#\J) 1)
  116                                  ((#\F) 0)
  117                                  ((#\7) 1)
  118                                  ((#\L) 0)
  119                                  ((#\-) 1)
  120                                  ((#\|) 0))))))
  121           (count-wall-to-edge tiles dist next count))
  122         count)))
  123 
  124 (define (in-nest tiles dist curr)
  125   (let ((wall-count (count-wall-to-edge tiles dist curr 0)))
  126     (= (floor-remainder wall-count 2) 1)))
  127 
  128 (define (get-candidates dist tiles)
  129   (let ((y-max (length tiles))
  130         (x-max (length (car tiles)))
  131         (candidates '()))
  132     (do ((y 0 (1+ y))) ((>= y y-max))
  133       (do ((x 0 (1+ x))) ((>= x x-max))
  134         (if (not (hash-ref dist (cons x y)))
  135             (set! candidates (cons (cons x y) candidates)))))
  136     candidates))
  137 
  138 (let* ((tiles (parse-input "input.txt")))
  139   (receive (start double-connections tiles-patched) (parse-pipes tiles)
  140     (receive (max-dist dist) (find-furthest start double-connections)
  141       ;; 6856
  142       (format #t "Part 1: ~d" max-dist)
  143       (newline)
  144       (let* ((candidates (get-candidates dist tiles-patched))
  145              (nest-tiles (filter
  146                           (lambda (curr) (in-nest tiles-patched dist curr))
  147                           candidates)))
  148         ;; 501
  149         (format #t "Part 2: ~d" (length nest-tiles))
  150         (newline)))))