AoC'21, day 9, second problem rvc


Define a basin as a maximal, connected area of the map in which all numbers are less than 9; the size of a basin is the number of coordinates it encompasses. Find the product of the three largest basin sizes.

 $ cat 09b.rkt  
 #lang racket 
  
  
 (require 
   (prefix-in aoc09: "09a.rkt") 
   (prefix-in array: "array.rkt") 
   ) 
  
  
 (define (aoc09b . args) 
  
   ; Return the product of the three largest basin sizes in the 
   ; given seabed map.  If no map is given, use the contest 
   ; problem input; otherwise assume the argument is the string 
   ; representation of a problem input. 
  
   (basin-products (apply aoc09:read-input args))) 
  
  
 (define (basin-products map) 
  
   ; Return the product of the three largest basin sizes in the 
   ; given seabed map. 
  
   (apply * (take (sort (basin-sizes! map) >) 3))) 
  
  
 (define (basin-sizes! map) 
  
   ; Return a list of all basin sizes in the given seabed map. 
   ; The list is in no particular order.  The basins are removed 
   ; from the map as they're found. 
  
  
   (define (add-neighbors-to-pending x y pending) 
  
     ; Add to the given list of pending coordinates all neighbors 
     ; of the given seabed coordinate that are part of the 
     ; same basin as the given coordinate; return the 
     ; augmented list. 
  
     (let loop 
        
       ((deltas '((0 . -1) (-1 . 0) (1 . 0) (0 . 1))) 
        (pending pending)) 
        
       (let* 
            
         ((x (+ x (caar deltas))) 
          (y (+ y (cdar deltas))) 
          (deltas (cdr deltas)) 
          (pending 
            (if (low-enough? x y) 
              (cons (cons x y) pending) 
              pending))) 
               
          (if (null? deltas) 
           pending 
           (loop deltas pending))))) 
  
  
   (define (basin-size x y) 
  
     ; Return the size of the basin containing the given seabed 
     ; coordinate. 
  
     (let loop ((pending (list (cons x y))) (basin-size 0)) 
       (if (null? pending) 
           basin-size 
           (let ((x (caar pending)) 
                 (y (cdar pending)) 
                 (pending (cdr pending))) 
             (if (low-enough? x y) 
                 (begin 
                   (array:set! map x y 9) 
                   (loop 
                     (add-neighbors-to-pending x y pending) 
                     (+ basin-size 1))) 
                 (loop pending basin-size)))))) 
  
  
   (define (low-enough? x y) 
  
     ; Return #t iff the seabed at the given coordinate is low 
     ; enough to be part of a basin. 
      
     (< (array:ref map x y) 9)) 
  
  
   (let across-the-row 
  
      ((x (- (array:cols map) 1)) 
       (basin-sizes '())) 
  
     (if (< x 0) 
  
         basin-sizes 
  
         (let down-the-column 
  
           ((y (- (array:rows map) 1)) 
            (basin-sizes basin-sizes)) 
  
           (if (< y 0) 
  
               (across-the-row (- x 1) basin-sizes) 
  
               (down-the-column (- y 1) 
                 (if (low-enough? x y) 
                   (cons (basin-size x y) basin-sizes) 
                   basin-sizes))))))) 
  
  
 (module+ main 
   (aoc09b) 
   ) 
  
  
 (module+ test 
  
   (require rackunit) 
  
   (for-each 
  
     (lambda (p) 
       (check-equal? 
         (basin-sizes! (aoc09:read-input (car p))) (cdr p))) 
  
     '(("09009000" . (1 2 3)) 
       ("000\n090\n000" . (8)) 
       ("090\n090\n090" . (3 3)) 
       ("000\n999\n000" . (3 3)))) 
  
   (check-equal? (aoc09b aoc09:example-input) 1134) 
   (check-equal? (aoc09b) 1110780) 
   ) 
  
 $ raco test 09b.rkt  
 raco test: (submod "09b.rkt" test) 
 6 tests passed 
  
 $