AoC '21, Day 11, first problem, rvc

 $ cat 11a.rkt  
 #lang racket 
  
 (require srfi/25) 
  
  
 (provide 
    example-input 
    new-octopus-garden 
    problem-input 
    step 
    ) 
  
  
 ; When an octopus has an energy level greater than 
 ; flash-threshold, it should flash. 
  
   (define flash-threshold 9) 
  
 ; When an octopus flashes, its energy level is set to the 
 ; energy floor. 
  
   (define energy-floor 0) 
  
  
 (define (aoc-11a input) 
  
   ; Read the octopus garden read from the given input and 
   ; return the number of octopus flashes occuring in the 
   ; first 100 steps. 
  
   (let ((octopuses (new-octopus-garden input))) 
     (let loop ((i 0) (flashes 0)) 
       (if (= i 100) 
         flashes 
         (loop (+ i 1) (+ flashes (step octopuses))))))) 
  
  
 (define (flash-octopuses octopuses) 
  
   ; Flash every octopus that is able to flash; return the 
   ; number of octopus flashes. 
  
  
   (define (flash)  
  
     ; Make one pass through the octopuses, flashing every 
     ; octopus ready to flash; return the number of octopus 
     ; flashes. 
  
     (let ((flash-count 0)) 
  
       (octopuses 'for-each-octopus 
         (lambda (r c v) 
           (when (and (not (octopuses 'flashed? r c)) 
                      (> v flash-threshold)) 
  
             (octopuses 'flashed-set! r c #t) 
             (octopuses 'for-each-neighbor r c 
               (lambda (r c v) 
                 (octopuses 'energy-set! r c (+ v 1)))) 
             (set! flash-count (+ flash-count 1))))) 
  
       flash-count)) 
  
  
   (let loop ((flash-count 0)) 
     (let ((flashes (flash))) 
       (if (zero? flashes) 
         flash-count 
         (loop (+ flash-count flashes)))))) 
  
  
 (define (increase-energy-levels octopuses) 
  
   ; Increase by one the energy level of every octopus. 
    
   (octopuses 'for-each-octopus 
     (lambda (r c v) 
       (octopuses 'energy-set! r c (+ v 1))))) 
  
  
 (define (new-octopus-garden input) 
  
   ; Return a new octopus garden described by the given 
   ; string. 
    
  
   (define (read-input input) 
  
     (let* ((zero (char->integer #\0)) 
            (ord (lambda (c) (- (char->integer c) zero))) 
            (digify (lambda (s) (map ord (string->list s)))) 
            (data (map digify (string-split input))) 
            (rows (length data))) 
  
       (values 
         rows 
         (if (zero? rows) 0 (length (car data))) data))) 
  
  
   (let-values (((rows cols data) (read-input input))) 
  
     (define (all-valid-neighbors r c neighbors) 
  
       ; Return a list of all the neighbors of the given 
       ; cell; the neighbors may be out of bounds, and 
       ; include the cell itself. 
  
       (define (valid-neighbor nbr) 
  
         ; Return true iff the given neighbor coordinate is 
         ; valid; that is, in bounds and not equal to the 
         ; generating cell. 
  
         (let ((nr (car nbr)) 
               (nc (cdr nbr))) 
           (and (<= 0 nr) (< nr rows) 
                (<= 0 nc) (< nc cols) 
                (or (not (= nr r)) (not (= nc c)))))) 
  
       (filter (lambda (nbr) (valid-neighbor nbr)) neighbors)) 
  
  
     (define (all-neighbors r c) 
  
       ; Return a list of all the neighbors of the given 
       ; cell; the neighbors may be out of bounds, and 
       ; include the cell itself. 
  
       (let r-loop ((delta-r -1) (neighbors '())) 
  
         (if (> delta-r 1) 
  
             neighbors 
  
             (let ((new-r (+ r delta-r))) 
               (let c-loop ((delta-c -1) (nbrs neighbors)) 
                 (if (> delta-c 1) 
                     (r-loop (+ delta-r 1) nbrs) 
                     (c-loop (+ delta-c 1) 
                             (cons 
                               (cons new-r (+ c delta-c)) 
                               nbrs)))))))) 
  
  
     (let* 
  
         ((ranges (shape 0 rows 0 cols)) 
          (energy (apply array (cons ranges (flatten data)))) 
          (flashed (make-array ranges #f)) 
  
          (call-f 
           (lambda (f r c) (f r c (array-ref energy r c)))) 
  
          (set-array-value 
            (lambda (array args) 
              (apply array-set! (cons array args)))) 
          (ref-array-value 
            (lambda (array args) 
              (apply array-ref (cons array args)))) 
  
          (error 
            (lambda args 
              (apply raise-user-error (cons 'octopus-garden args))))) 
  
       (lambda (cmd . args) 
         (case (list 'quote cmd) 
  
           (('energy-set!) 
              (set-array-value energy args)) 
            
           (('flashed?) 
              (ref-array-value flashed args)) 
            
           (('flashed-set!) 
              (set-array-value flashed args)) 
  
           (('for-each-neighbor) 
            (let ((r (car args)) 
                  (c (cadr args)) 
                  (f (caddr args))) 
              (map (lambda (c) (call-f f (car c) (cdr c))) 
                   (all-valid-neighbors r c (all-neighbors r c))))) 
  
           (('for-each-octopus) 
              (let ((f (car args))) 
                (do ((r 0 (+ r 1))) ((= r rows) (void)) 
                  (do ((c 0 (+ c 1))) ((= c cols) (void)) 
                    (call-f f r c))))) 
  
           (('population) 
              (* rows cols)) 
  
           (else 
            (error "Unrecognized command ~a" cmd))))))) 
  
  
 (define (reset-flashed-octopuses octopuses) 
  
   ; If an octopus flashed during this step, reset its energy 
   ; level to the floor. 
    
   (octopuses 'for-each-octopus 
     (lambda (r c v) 
       (when (octopuses 'flashed? r c) 
         (octopuses 'energy-set! r c energy-floor) 
         (octopuses 'flashed-set! r c #f))))) 
  
  
 (define (step octopuses) 
  
   ; Run the octopuses through a single step; return the 
   ; number of octopuses flashed during the step. 
  
   (increase-energy-levels octopuses) 
   (let ((flashes (flash-octopuses octopuses))) 
     (unless (zero? flashes) 
       (reset-flashed-octopuses octopuses)) 
     flashes)) 
  
  
 (define problem-input 
   (string-join '( 
     "4871252763" 
     "8533428173" 
     "7182186813" 
     "2128441541" 
     "3722272272" 
     "8751683443" 
     "3135571153" 
     "5816321572" 
     "2651347271" 
     "7788154252" 
     ) 
     "\n")) 
  
 (module+ main 
   (aoc-11a problem-input)) 
  
  
 (define example-input 
   (string-join '( 
     "5483143223" 
     "2745854711" 
     "5264556173" 
     "6141336146" 
     "6357385478" 
     "4167524645" 
     "2176841721" 
     "6882881134" 
     "4846848554" 
     "5283751526" 
     ) 
     "\n")) 
  
 (module+ test 
  
   (require rackunit) 
    
   (check-eq? (aoc-11a "") 0) 
   (check-eq? (aoc-11a "0") 10) 
   (check-eq? (aoc-11a "000\n000\n000") 90) 
  
   (check-eq? (aoc-11a example-input) 1656) 
   (check-eq? (aoc-11a problem-input) 1747)) 
  
 $ raco test 11a.rkt  
 raco test: (submod "11a.rkt" test) 
 5 tests passed 
  
 $