AoC '21, Day 14, first problem, rvc

Given a polymer, repeatedly expand it by inserting a third monomer between two adjacent monomers. The solution doesn't require the expanded polymer, it requires the difference between the most frequently occurring monomer and the least frequently occurring monomer in the expanded polymer.

 $ cat 14a.rkt 
 #lang racket 
  
  
 (provide 
   census:new 
   census:spread 
   census:tally 
   example-input 
   example-input-results 
   read-input 
   ) 
  
  
 (require "aoc.rkt" "../scheme/utl.rkt") 
  
  
 (define (aoc14a) 
  
   ; Return the answer to the first half of the fourteenth 
   ; advent-of-code '21 problem. 
  
   (let-values (((polymer expansion-table) (read-input))) 
     (spread (repeated-expansions polymer expansion-table 10)))) 
  
  
 (define (expand polymer expansions) 
  
   ; Return the result of applying the given expansions to the given 
   ; polymer. 
  
  
   (define (look-up fst snd) 
     (hash-ref expansions (string-append fst snd))) 
  
   ; This is brute-force: run through the polymer expanding adjacent monomers. 
   ; Fortunately the polymer and number of expansions is small enough to make 
   ; such a dumb solution acceptable. 
  
   (define (exp fst rst xpd) 
     (if (null? rst) 
       (reverse (cons fst xpd)) 
       (let ((snd (car rst))) 
         (exp snd (cdr rst) (cons (look-up fst snd) (cons fst xpd)))))) 
  
  
   (if (null? polymer) 
     polymer 
     (exp (car polymer) (cdr polymer) '()))) 
  
  
  
 (define (repeated-expansions polymer expansions n) 
  
   ; Return the result of expanding the given polymer the given number 
   ; of times using the given expansion table. 
    
   (let loop ((p polymer) (n n)) 
     (if (< n 1) 
         p 
         (loop (expand p expansions) (- n 1))))) 
  
  
  
 (define (census:new polymer) 
  
   ; Return a monomer census for the given polymer 
  
   (let ((census (make-hash))) 
     (for-each 
      (lambda (m) (census:tally census m)) 
      polymer) 
     census)) 
  
  
 (define (census:spread census) 
    
   ; Return the positive difference between the most-frequently 
   ; occuring monomer and the least-frequently occuring monomer in the 
   ; given census. 
    
   (define ht (make-hash)) 
    
   (let* 
       ((hash-pairs (hash->list census)) 
        (min-max (foldr (lambda (hash-pair min-max) 
                          (let ((c (cdr hash-pair))) 
                            (cons (min (car min-max) c) (max (cdr min-max) c)))) 
                        (let ((c (cdar hash-pairs))) (cons c c)) 
                        (cdr hash-pairs)))) 
     (- (cdr min-max) (car min-max)))) 
  
  
 (define (census:tally census member) 
  
   ; Increase the given census to account for the given member; 
   ; return the census. 
    
   (hash-set! census member (+ (hash-ref census member 0) 1)) 
   census) 
  
  
 (define read-input (lambda arg? 
  
   ; Return the values (polynomial expansions) from problem input.  If 
   ; no argument is given, use the official problem input; otherwise 
   ; assume the argument is the string representation of a problem 
   ; input. 
  
   (define (read-expansions inp) 
     (let ((ht (make-hash))) 
       (for-each 
        (lambda (l) 
          (hash-set! ht (car l) (caddr l))) 
        inp) 
       ht)) 
  
   (let ((inp (aoc-read-input (if (null? arg?) 14 (car arg?))))) 
     (values 
       (string->string-list (caaar inp)) 
       (read-expansions (cadr inp)))))) 
  
  
 (define (spread polymer) 
    
   ; Return the positive difference between the most-frequently 
   ; occuring monomer and the least-frequently occuring monomer in the 
   ; given polynomial. 
    
   (census:spread (census:new polymer))) 
  
  
 (define example-input 
   (string-join 
    '("nncb" 
      "" 
      "ch -> b" 
      "hh -> n" 
      "cb -> h" 
      "nh -> c" 
      "hb -> c" 
      "hc -> b" 
      "hn -> c" 
      "nn -> c" 
      "bh -> h" 
      "nc -> b" 
      "nb -> b" 
      "bn -> b" 
      "bb -> n" 
      "bc -> b" 
      "cc -> n" 
      "cn -> c") "\n")) 
  
 (define example-input-results 
   '((1 . "ncnbchb") 
     (2 . "nbccnbbbcbhcb") 
     (3 . "nbbbcnccnbbnbnbbchbhhbchb") 
     (4 . "nbbnbnbbccnbcnccnbbnbbnbbbnbbnbbcbhcbhhnhcbbcbhcb"))) 
  
  
 (module+ main 
  
   (aoc14a)) 
  
  
 (module+ test 
    
   (require rackunit "../scheme/utl.rkt") 
  
   (let-values (((polymer expansions) (read-input "aa\n\naa -> b\n"))) 
     (for-each 
  
      (lambda (p) 
        (check-equal? (expand (string->string-list (car p)) expansions) 
                              (string->string-list (cdr p))))        
  
      '(("" . "") 
        ("a" . "a") 
        ("aa" . "aba") 
        ("aaa" . "ababa")))) 
  
   (let-values (((polymer expansions) (read-input example-input))) 
  
     (for-each 
  
        (lambda (p) 
          (check-equal? (repeated-expansions polymer expansions (car p)) 
                        (string->string-list (cdr p)))) 
  
        example-input-results) 
  
     (check-equal? (spread (repeated-expansions polymer expansions 10)) 1588)) 
    
   (for-each 
  
    (lambda (p) 
      (check-equal? (spread (car p)) (cdr p))) 
  
    '((("a" "b" "c") . 0) 
      (("a" "b" "c" "a") . 1) 
      (("a" "b" "a" "c" "a") . 2))) 
    
   (check-equal? (aoc14a) 2621) 
   ) 
  
 $ raco test 14a.rkt  
 raco test: (submod "14a.rkt" test) 
 13 tests passed 
  
 $ 
 }}}