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

day16.scm (4289B)

    1 (use-modules (ice-9 popen))
    2 (use-modules (ice-9 rdelim))
    3 (use-modules (ice-9 format))
    4 (use-modules (ice-9 hash-table))
    5 (use-modules (srfi srfi-1))
    6 
    7 (define (parse-input filename)
    8   (let ((file (open-input-file filename))
    9         (contraption '()))
   10     (while #t
   11            (let ((line (car (%read-line file))))
   12              (if (eof-object? line)
   13                  (break)
   14                  (set! contraption (cons (string->list line) contraption)))))
   15     (reverse contraption)))
   16 
   17 (define (dir-to-dxdy dir)
   18   (case dir
   19     ((#\L) (cons -1 0))
   20     ((#\R) (cons 1 0))
   21     ((#\U) (cons 0 -1))
   22     ((#\D) (cons 0 1))))
   23 
   24 (define (reflect-or-split dir target)
   25   (case target
   26     ((#\\) (case dir
   27              ((#\L) (list #\U))
   28              ((#\R) (list #\D))
   29              ((#\U) (list #\L))
   30              ((#\D) (list #\R))))
   31     ((#\/) (case dir
   32              ((#\L) (list #\D))
   33              ((#\R) (list #\U))
   34              ((#\U) (list #\R))
   35              ((#\D) (list #\L))))
   36     ((#\-) (case dir
   37              ((#\L) (list #\L))
   38              ((#\R) (list #\R))
   39              ((#\U) (list #\L #\R))
   40              ((#\D) (list #\L #\R))))
   41     ((#\|) (case dir
   42              ((#\L) (list #\U #\D))
   43              ((#\R) (list #\U #\D))
   44              ((#\U) (list #\U))
   45              ((#\D) (list #\D))))))
   46 
   47 (define (between x a b)
   48   (and (>= x a) (<= x b)))
   49 
   50 (define (count-energized contraption init-x init-y init-dir)
   51   (let* ((x-max (1- (length (car contraption))))
   52          (y-max (1- (length contraption)))
   53          (beams (list (list init-x init-y init-dir)))
   54          (hist-beams (make-hash-table))
   55          (tile-state (make-hash-table)))
   56     (hash-set! hist-beams (car beams) #t)
   57     (while (> (length beams) 0)
   58            (let* ((curr-beam (car beams))
   59                   (curr-x (list-ref curr-beam 0))
   60                   (curr-y (list-ref curr-beam 1))
   61                   (curr-dir (list-ref curr-beam 2))
   62                   (curr-dx (car (dir-to-dxdy curr-dir)))
   63                   (curr-dy (cdr (dir-to-dxdy curr-dir))))
   64              (set! beams (cdr beams))
   65              (while #t
   66                     (let ((next-x (+ curr-x curr-dx))
   67                           (next-y (+ curr-y curr-dy)))
   68                       (if (not (and (between next-x 0 x-max) (between next-y 0 y-max)))
   69                           (break))
   70                       (hash-set! tile-state (cons next-x next-y) #t)
   71                       (let ((target (list-ref (list-ref contraption next-y) next-x)))
   72                         (if (equal? target #\.)
   73                             (begin (set! curr-x next-x) (set! curr-y next-y))
   74                             (begin
   75                               (map (lambda (next-dir)
   76                                      (let ((next-beam (list next-x next-y next-dir)))
   77                                        (if (not (hash-ref hist-beams next-beam))
   78                                            (begin
   79                                              (set! beams (cons (list next-x next-y next-dir) beams))
   80                                              (hash-set! hist-beams next-beam #t)))))
   81                                    (reflect-or-split curr-dir target))
   82                               (break))))))))
   83     (hash-count (const #t) tile-state)))
   84 
   85 (let* ((contraption (parse-input "input.txt"))
   86        ;; start from impossible location in case 0 0 has mirror/splitter.
   87        (energeized (count-energized contraption -1 0 #\R)))
   88   ;; 7111
   89   (format #t "Part 1: ~d" energeized)
   90   (newline))
   91 
   92 (let* ((contraption (parse-input "input.txt"))
   93        (y-max (1- (length contraption)))
   94        (x-max (1- (length (car contraption))))
   95        (max-energized-tiles 0))
   96   (do ((y 0 (1+ y))) ((> y y-max))
   97     (set! max-energized-tiles
   98           (max max-energized-tiles
   99                (count-energized contraption -1 y #\R)))
  100     (set! max-energized-tiles
  101           (max max-energized-tiles
  102                (count-energized contraption (1+ x-max) y #\L))))
  103   (do ((x 0 (1+ x))) ((> x x-max))
  104     (set! max-energized-tiles
  105           (max max-energized-tiles
  106                (count-energized contraption x -1 #\D)))
  107     (set! max-energized-tiles
  108           (max max-energized-tiles
  109                (count-energized contraption x (1+ y-max) #\U))))
  110   ;; 7831
  111   (format #t "Part 2: ~d" max-energized-tiles)
  112   (newline))