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

day03.scm (4878B)

    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 (is-valid-loc schematic loc)
    8   (let ((x (car loc))
    9         (y (car (cdr loc)))
   10         (max-x (car (array-dimensions schematic)))
   11         (max-y (car (cdr (array-dimensions schematic)))))
   12     (and (and (>= x 0) (< x max-x))
   13          (and (>= y 0) (< y max-y)))))
   14 
   15 (define (is-adjacent-to-symbol schematic x y)
   16   (let ((found #f))
   17     (do ((dx -1 (1+ dx))) ((or (> dx 1) found))
   18       (do ((dy -1 (1+ dy))) ((or (> dy 1) found))
   19         (if (is-valid-loc schematic (list (+ x dx) (+ y dy)))
   20             (let ((cc (array-ref schematic (+ x dx) (+ y dy))))
   21               (if (not (or (eq? cc #\.) (char-numeric? cc)))
   22                   (set! found #t))))))
   23     found))
   24 
   25 (define (find-part-number schematic)
   26   (let ((part-numbers '())
   27         (curr-has-num #f)
   28         (curr-num 0)
   29         (curr-num-adjacent-to-symbol #f)
   30         (max-x (car (array-dimensions schematic)))
   31         (max-y (car (cdr (array-dimensions schematic)))))
   32     (do ((x 0 (1+ x))) ((>= x max-x))
   33       (do ((y 0 (1+ y))) ((>= y max-y))
   34         (let* ((c (array-ref schematic x y))
   35                (in-num (char-numeric? c)))
   36           (if in-num
   37               (let ((cc (- (char->integer c) (char->integer #\0))))
   38                 (if (not curr-has-num) (set! curr-has-num #t))
   39                 (set! curr-num (+ (* curr-num 10) cc))
   40                 (if (not curr-num-adjacent-to-symbol)
   41                     (set! curr-num-adjacent-to-symbol
   42                           (is-adjacent-to-symbol schematic x y)))))
   43           (if (or (not in-num) (= (1+ y) max-y))
   44               (if curr-has-num
   45                   (begin (if curr-num-adjacent-to-symbol
   46                              (set! part-numbers (cons curr-num part-numbers)))
   47                          (set! curr-has-num #f)
   48                          (set! curr-num 0)
   49                          (set! curr-num-adjacent-to-symbol #f)))))))
   50     (reverse part-numbers)))
   51 
   52 (let ((file (open-input-file "input.txt")) (schematic '()) (ans 0))
   53   (while #t
   54          (let ((line (car (%read-line file))))
   55            (if (eof-object? line)
   56                (break)
   57                (set! schematic (cons (string->list line) schematic)))))
   58   (set! schematic (list->array '(0 0) (reverse schematic)))
   59   (set! ans (fold + 0 (find-part-number schematic)))
   60   ;; 514969
   61   (format #t "Part 1: ~d" ans)
   62   (newline))
   63 
   64 (define (find-adjacent-protogear schematic x y)
   65   (let ((protogears '()))
   66     (do ((dx -1 (1+ dx))) ((> dx 1))
   67       (do ((dy -1 (1+ dy))) ((> dy 1))
   68         (if (is-valid-loc schematic (list (+ x dx) (+ y dy)))
   69             (let ((cc (array-ref schematic (+ x dx) (+ y dy))))
   70               (if (eq? cc #\*)
   71                   (set! protogears (cons (list (+ x dx) (+ y dy)) protogears)))))))
   72     protogears))
   73 
   74 (define (find-gear-ratio schematic)
   75   (let ((part-numbers '())
   76         (curr-has-num #f)
   77         (curr-num 0)
   78         (curr-protogear (make-hash-table))
   79         (protogear-specs (make-hash-table))
   80         (max-x (car (array-dimensions schematic)))
   81         (max-y (car (cdr (array-dimensions schematic)))))
   82     (do ((x 0 (1+ x))) ((>= x max-x))
   83       (do ((y 0 (1+ y))) ((>= y max-y))
   84         (let* ((c (array-ref schematic x y))
   85                (in-num (char-numeric? c)))
   86           (if in-num
   87               (let* ((cc (- (char->integer c) (char->integer #\0))))
   88                 (if (not curr-has-num) (set! curr-has-num #t))
   89                 (set! curr-num (+ (* curr-num 10) cc))
   90                 (fold (lambda (loc res) (hash-set! res loc #t))
   91                       curr-protogear
   92                       (find-adjacent-protogear schematic x y))))
   93           (if (or (not in-num) (= (1+ y) max-y))
   94               (if curr-has-num
   95                   (begin (hash-for-each
   96                           (lambda (k v)
   97                             (if (hash-ref protogear-specs k)
   98                                 (hash-set! protogear-specs k (cons curr-num (hash-ref protogear-specs k)))
   99                                 (hash-set! protogear-specs k (list curr-num))))
  100                           curr-protogear)
  101                          (hash-clear! curr-protogear)
  102                          (set! curr-has-num #f)
  103                          (set! curr-num 0)))))))
  104     (hash-map->list
  105      (lambda (k v)
  106        (if (= (length v) 2)
  107            (fold * 1 v)
  108            0))
  109      protogear-specs)))
  110 
  111 (let ((file (open-input-file "input.txt")) (schematic '()) (ans 0))
  112   (while #t
  113          (let ((line (car (%read-line file))))
  114            (if (eof-object? line)
  115                (break)
  116                (set! schematic (cons (string->list line) schematic)))))
  117   (set! schematic (list->array '(0 0) (reverse schematic)))
  118   (set! ans (fold + 0 (find-gear-ratio schematic)))
  119   ;; 78915902
  120   (format #t "Part 2: ~d" ans)
  121   (newline))