AoC '21, Day 18, first problem, rvc


Sum up a list of snailfish numbers and return their magnitude.

 $ cat 18bpt.rkt 
 #lang racket 
  
  
 (provide 
   example-input 
   magnitude 
   read-input 
   sum 
   ) 
  
  
 (require 
   (prefix-in aoc: "aoc.rkt") 
   (prefix-in utl: "../scheme/utl.rkt")) 
  
 ; The trick to this problem is a snailfish number needs to be 
 ; treated both as a binary tree (for splitting and addition) and  
 ; a list (for exploding).  The problem can be solved by sticking 
 ; with binary trees, but it's tricky (try it).  The easiest solution 
 ; is probably to flip between a binary tree and a list representation, 
 ; a relatively straightforward transformation.  This solution has 
 ; difficulty somewhere between pure binary trees and tranforming  
 ; back and forth.  It uses a modified b-plus tree to get a linked- 
 ; list of leaves in a binary tree (it's modified because the  
 ; leaves aren't required to all be at the same height). 
  
 (struct linked-leaf (prv nxt val) #:mutable) 
  
  
 (define (aoc18a . arg) 
  
   ; Return the magnitude of the sum of the given list of sailfish 
   ; numbers.  If no numbers are given, use the problem input. 
   ; The argument, if given is assumed to be a string 
   ; representation of the input. 
  
   (magnitude (total (apply read-input arg)))) 
  
  
  
 (define (explode sn) 
  
   ; Return the values (sn' b) where sn' is the given snailfish 
   ; number with the left-most over-nested component exploded and 
   ; b is #t iff there was an explosion. 
  
   (let loop ((sn sn) (depth 1)) 
  
     (match sn 
  
       (n #:when (linked-leaf? n) 
  
          (values sn #f)) 
  
       ((cons l r) 
  
        (if (= depth 5) 
  
            (let* 
  
                ((lp (linked-leaf-prv l)) 
                 (lpv (linked-leaf-val lp)) 
                 (rnv (linked-leaf-val (linked-leaf-nxt r)))) 
  
              (set-linked-leaf-val! lp (+ lpv (linked-leaf-val l))) 
              (set-linked-leaf-val! (linked-leaf-nxt r) (+ rnv (linked-leaf-val r))) 
              (set-linked-leaf-val! r 0) 
  
              (splice lp r) 
               
              (values r #t)) 
  
            (let ((depth (+ depth 1))) 
  
              (let-values (((new-l xpld) (loop l depth))) 
  
                (if xpld 
  
                    (values (cons new-l r) xpld) 
  
                    (let-values (((new-r xpld) (loop r depth))) 
  
                      (values (if xpld (cons l new-r) sn) xpld)))))))))) 
  
  
 (define (insert-before new old) 
  
   ; Insert the given new leaf before the given old leaf. 
    
   (set-linked-leaf-nxt! new old) 
   (set-linked-leaf-prv! new (linked-leaf-prv old)) 
  
   (set-linked-leaf-nxt! (linked-leaf-prv old) new) 
   (set-linked-leaf-prv! old new)) 
  
  
 (define (magnitude sn) 
  
   ; Return the magnitude of the given snailfish number. 
    
   (if (sn-leaf? sn) 
     (sn-val sn) 
     (+ (* 3 (magnitude (sn-left sn))) (* 2 (magnitude (sn-right sn)))))) 
  
  
 (define (read-input . arg) 
  
   ; Return the given list of snailfish numbers.  If no numbers 
   ; are given, use the problem input.  The argument, if given is 
   ; assumed to be a string representation of the input. 
  
   (map 
     (lambda (s) (string->sn s)) 
     (flatten (aoc:aoc-read-input (if (null? arg) 18 (car arg)))))) 
  
  
  
 (define (reduce sn) 
  
   ; Return the given snailfish number in reduced form (in which 
   ; there are no opportunites for exploding or splitting). 
  
   (let loop ((sn sn)) 
  
     (let-values 
  
       (((sn exploded) (explode sn))) 
  
       (let-values 
  
         (((sn splitted) (if exploded (values sn #f) (split sn)))) 
  
         (if (or exploded splitted) 
  
           (loop sn) 
  
           sn))))) 
  
  
 (define (sn->string sn) 
  
   ; Return a string representation of the given snailfish number. 
  
  
   (define (unparse-number ll ocl) 
  
     ; Unparse the given leaf, prepending the digit characters 
     ; to the given output character list; return the augmented 
     ; list. 
  
     (let ((n (linked-leaf-val ll))) 
  
       (if (zero? n) 
  
         (cons (utl:chr 0) ocl) 
  
         (let loop ((n n) (ocl ocl)) 
           (let-values (((q r) (quotient/remainder n 10))) 
             (cons (utl:chr r) 
                   (if (zero? q) ocl (loop q ocl)))))))) 
    
  
   (define (unparse-pair p ocl) 
  
     ; Unparse the given pair, prepending the characters on the 
     ; given output character list; return the augmented list. 
  
     (cons #\] 
       (unparse-thing (sn-right p) 
     (cons #\, 
       (unparse-thing (sn-left p) 
     (cons #\[ ocl)))))) 
  
  
   (define (unparse-thing t cl) 
  
     ; Unparse the given thing (which will be either a pair or a 
     ; number), prepending the characters on the given output 
     ; character list; return the augmented list. 
  
     (cond 
  
       ((pair? t) 
          (unparse-pair t cl)) 
  
       ((linked-leaf? t) 
          (unparse-number t cl)) 
  
       (#t 
          (error "unrecognized snailfish-number component")))) 
  
  
   (list->string (reverse (unparse-thing sn '())))) 
  
  
 (define (sn-copy sn) 
  
   ; Return a copy of the given the snailfish number. 
  
   (define head (linked-leaf 0 0 0)) 
   (define tail (linked-leaf 0 0 0)) 
   (splice head tail) 
  
  
   (define (copy-leaf e) 
  
     ; Return a copy of the given leaf. 
  
     (let ((leaf (linked-leaf 
                   (linked-leaf-nxt e) 
                   (linked-leaf-prv e) 
                   (linked-leaf-val e)))) 
  
       (insert-before leaf tail) 
  
       leaf)) 
    
  
   (define (copy-node n) 
  
     ; Return a deep copy of the given node. 
  
     (sn-node 
      (copy-thing (sn-left n)) 
      (copy-thing (sn-right n)))) 
  
  
   (define (copy-thing t) 
  
     ; Return a deep copy of whatever it was that was passed in 
     ; (either a node or a leaf). 
      
     (cond 
  
      ((sn-node? t) 
         (copy-node t)) 
  
      ((sn-leaf? t) 
         (copy-leaf t)) 
  
      (#t 
         (error "unrecognized character")))) 
  
  
   (copy-node sn)) 
  
  
 (define sn-leaf?  linked-leaf?) 
 (define sn-left  car) 
 (define sn-node  cons) 
 (define sn-node? pair?) 
 (define sn-right cdr) 
 (define sn-val   linked-leaf-val) 
  
  
 (define (splice pred succ) 
  
   ; Splice the leafs so pred is the immediate predecessor to 
   ; succ, and succ is the immediate successor to pred. 
  
   (set-linked-leaf-nxt! pred succ) 
   (set-linked-leaf-prv! succ pred)) 
  
  
 (define (split sn) 
  
   ; Return the values (sn' b) where sn' is the given snailfish 
   ; number with the left-most over-sized number split and b is #t 
   ; iff there was a split. 
  
   (let loop ((sn sn)) 
  
     (match sn 
  
       ((cons l r) 
  
          (let-values (((sn s) (loop l))) 
  
            (if s 
  
              (values (cons sn r) s) 
  
              (let-values (((sn s) (loop r))) 
                (values (cons l sn) s))))) 
  
       (n #:when (linked-leaf? n) 
  
          (let ((v (linked-leaf-val n))) 
  
            (if (> v 9) 
                 
                (let* 
  
                  ((v (/ v 2)) 
                   (left (linked-leaf 0 0 (floor v)))) 
  
                  (set-linked-leaf-val! n (ceiling v)) 
                  (insert-before left n) 
  
                  (values (cons left n) #t)) 
  
                (values n #f))))))) 
  
  
 (define (string->sn str) 
  
   ; Return the snailfish number represented by the given string. 
  
   (define n (string-length str)) 
   (define s (list->vector (string->list str))) 
   (define (expecting i c) 
     (let ((c2 (vector-ref s i))) 
       (unless (char=? c2 c) 
         (error (format "expecting ~a, got ~a" c c2))))) 
  
  
   (define head (linked-leaf 0 0 0)) 
   (define tail (linked-leaf 0 0 0)) 
   (set-linked-leaf-prv! tail head) 
   (set-linked-leaf-nxt! head tail) 
  
  
   (define (parse-number i) 
  
     (if (char-numeric? (vector-ref s i)) 
  
         (let loop ((i (+ i 1)) (n (utl:ord (vector-ref s i)))) 
  
           (if (char-numeric? (vector-ref s i)) 
  
             (loop (+ i 1) (+ (* n 10) (utl:ord (vector-ref s i)))) 
  
             (let ((leaf (linked-leaf 0 0 n))) 
               (insert-before leaf tail) 
               (values leaf i)))) 
  
         (values #f -1))) 
    
  
   (define (parse-pair i) 
  
     (if (char=? (vector-ref s i) #\[) 
  
         (let-values (((l i) (parse-thing (+ i 1)))) 
           (expecting i #\,) 
           (let-values (((r i) (parse-thing (+ i 1)))) 
             (expecting i #\]) 
             (values (cons l r) (+ i 1)))) 
  
         (values #f -1))) 
  
  
   (define (parse-thing i) 
  
     (let-values (((thing next-i) (parse-pair i))) 
       (if (> next-i -1) 
         (values thing next-i) 
         (let-values (((thing i) (parse-number i))) 
           (if (> i -1) 
             (values thing i) 
             (error "unrecognized character")))))) 
  
  
   (let-values (((pair i) (parse-pair 0))) 
     (cond 
      ((< i 0) 
       (error "pair expected")) 
      ((not (= i n)) 
       (error "unhandled input")) 
      (#t 
       pair)))) 
  
  
 (define (sum sn1 sn2) 
  
   ; Return the sum of the two given snailfish numbers. 
  
  
   (define (dive sn f) 
  
     ; Return the leaf at the end of the right or left spine of 
     ; the given snailfish number; f is the function (i.e., car or 
     ; cdr) that acceps a node in the spine and returns the next 
     ; link in the spine. 
  
     (let loop ((sn sn)) 
       (cond 
  
         ((pair? sn) 
            (loop (f sn))) 
  
         ((linked-leaf? sn) 
            sn) 
  
         (#t 
            (error "unrecognized snailfish-number component"))))) 
  
  
   (let ((sn1 (sn-copy sn1)) 
         (sn2 (sn-copy sn2))) 
  
     (splice (dive sn1 sn-right) (dive sn2 sn-left)) 
     (reduce (sn-node sn1 sn2)))) 
  
  
 (define (total sns) 
  
   ; Return the sum of the given list of snailfish numbers. 
  
   (foldl 
     (lambda (sn t) (sum t sn)) 
     (car sns) 
     (cdr sns))) 
  
  
 (aoc:define-string example-input 
   "[[[0,[5,8]],[[1,7],[9,6]]],[[4,[1,2]],[[1,4],2]]]" 
   "[[[5,[2,8]],4],[5,[[9,9],0]]]" 
   "[6,[[[6,2],[5,6]],[[7,6],[4,7]]]]" 
   "[[[6,[0,7]],[0,9]],[4,[9,[9,0]]]]" 
   "[[[7,[6,4]],[3,[1,3]]],[[[5,5],1],9]]" 
   "[[6,[[7,3],[3,2]]],[[[3,8],[5,7]],4]]" 
   "[[[[5,4],[7,7]],8],[[8,3],8]]" 
   "[[9,3],[[9,9],[6,[4,9]]]]" 
   "[[2,[[7,7],7]],[[5,8],[[9,3],[0,2]]]]" 
   "[[[[5,2],5],[8,[3,7]]],[[5,[7,5]],[4,4]]]") 
  
 (define example-sum 
   (car (read-input 
     "[[[[6,6],[7,6]],[[7,7],[7,0]]],[[[7,7],[7,7]],[[7,8],[9,9]]]]"))) 
  
 (define example-magnitude 4140) 
  
  
 (module+ main 
  
   (aoc18a)) 
  
  
 (module+ test 
  
   (require rackunit) 
    
   (define (check-sn? sna sne) 
     (check-equal? (sn->string sna) sne) 
     ) 
  
   (define (rt-test data) 
  
     (define original-data (flatten (aoc:aoc-read-input data))) 
  
     (define rt-data 
       (map (lambda (sn) (sn->string sn)) 
            (map (lambda (s) (string->sn s)) 
                 original-data))) 
  
     (for-each 
       (lambda (td od) (check-equal? td od)) 
       rt-data 
       original-data)) 
  
   (rt-test "[1,2]\n[[1,2],[3,4]]\n[[12,34],[56,78]]") 
   (rt-test example-input) 
  
   (for-each 
     (lambda (args) 
       (check-sn? 
         (sum (car (read-input (car args))) (car (read-input (cadr args)))) 
         (caddr args))) 
     '(("[1,2]" "[3,4]" "[[1,2],[3,4]]")) 
     ) 
    
   (for-each 
  
     (lambda (p) (check-equal? (magnitude (car (read-input (car p)))) (cdr p))) 
  
     '(("[9,1]" . 29) 
       ("[[9,1],[1,9]]" . 129) 
       ("[[1,2],[[3,4],5]]" . 143) 
       ("[[[[0,7],4],[[7,8],[6,0]]],[8,1]]" . 1384) 
       ("[[[[1,1],[2,2]],[3,3]],[4,4]]" . 445) 
       ("[[[[3,0],[5,3]],[4,4]],[5,5]]" . 791) 
       ("[[[[5,0],[7,4]],[5,5]],[6,6]]" . 1137) 
       ("[[[[8,7],[7,7]],[[8,6],[7,7]]],[[[0,7],[6,6]],[8,7]]]" . 3488))) 
  
   (for-each 
  
     (lambda (p) 
       (let-values (((sn s) (split (car (read-input (car p))))))  
         (check-equal? (sn->string sn) (cadr p)) 
         (check-equal? s (caddr p)))) 
  
     '(("[[[[0,7],4],[15,[0,13]]],[1,1]]" 
        . ("[[[[0,7],4],[[7,8],[0,13]]],[1,1]]" #t)) 
       ("[[[[0,7],4],[[7,8],[0,13]]],[1,1]]" 
        . ("[[[[0,7],4],[[7,8],[0,[6,7]]]],[1,1]]" #t)) 
       ("[[[[0,7],4],[[7,8],[0,[6,7]]]],[1,1]]" 
        . ("[[[[0,7],4],[[7,8],[0,[6,7]]]],[1,1]]" #f)))) 
  
  
   (for-each 
  
     (lambda (l) 
       (let-values (((sn s) (explode (car (read-input (car l))))))  
         (check-equal? (sn->string sn) (cadr l)) 
         (check-equal? s (caddr l)))) 
  
     '(("[1,2]" "[1,2]" #f) 
       ("[[[[[9,8],1],2],3],4]" "[[[[0,9],2],3],4]" #t) 
       ("[7,[6,[5,[4,[3,2]]]]]" "[7,[6,[5,[7,0]]]]" #t) 
       ("[[6,[5,[4,[3,2]]]],1]" "[[6,[5,[7,0]]],3]" #t) 
       ("[[3,[2,[1,[7,3]]]],[6,[5,[4,[3,2]]]]]" 
        "[[3,[2,[8,0]]],[9,[5,[4,[3,2]]]]]" #t) 
       ("[[3,[2,[8,0]]],[9,[5,[4,[3,2]]]]]" "[[3,[2,[8,0]]],[9,[5,[7,0]]]]" #t) 
       ("[[[[[4,3],4],4],[7,[[8,4],9]]],[1,1]]" 
        "[[[[0,7],4],[7,[[8,4],9]]],[1,1]]" #t) 
       ("[[[[0,7],4],[7,[[8,4],9]]],[1,1]]" "[[[[0,7],4],[15,[0,13]]],[1,1]]" #t) 
       ("[[[[0,7],4],[15,[0,13]]],[1,1]]" "[[[[0,7],4],[15,[0,13]]],[1,1]]" #f) 
       ("[[[[0,7],4],[[7,8],[0,[6,7]]]],[1,1]]" 
        "[[[[0,7],4],[[7,8],[6,0]]],[8,1]]" #t) 
       )) 
  
   (for-each 
  
     (lambda (p) 
       (check-equal? 
         (sn->string (total (read-input (car p)))) 
         (cdr p))) 
  
     '(("[1,1]\n[2,2]\n[3,3]\n[4,4]" . "[[[[1,1],[2,2]],[3,3]],[4,4]]") 
       ("[1,1]\n[2,2]\n[3,3]\n[4,4]\n[5,5]" . "[[[[3,0],[5,3]],[4,4]],[5,5]]")     
       ("[1,1]\n[2,2]\n[3,3]\n[4,4]\n[5,5]\n[6,6]" 
        . "[[[[5,0],[7,4]],[5,5]],[6,6]]") 
       ("[[[0,[4,5]],[0,0]],[[[4,5],[2,6]],[9,5]]]\n[7,[[[3,7],[4,3]],[[6,3],[8,8]]]]" 
        . "[[[[4,0],[5,4]],[[7,7],[6,0]]],[[8,[7,7]],[[7,9],[5,0]]]]") 
       ("[[[[4,0],[5,4]],[[7,7],[6,0]]],[[8,[7,7]],[[7,9],[5,0]]]]\n[[2,[[0,8],[3,4]]],[[[6,7],1],[7,[1,6]]]]" 
        . "[[[[6,7],[6,7]],[[7,7],[0,7]]],[[[8,7],[7,7]],[[8,8],[8,0]]]]") 
       ("[[[[6,7],[6,7]],[[7,7],[0,7]]],[[[8,7],[7,7]],[[8,8],[8,0]]]]\n[[[[2,4],7],[6,[0,5]]],[[[6,8],[2,8]],[[2,1],[4,5]]]]" 
        . "[[[[7,0],[7,7]],[[7,7],[7,8]]],[[[7,7],[8,8]],[[7,7],[8,7]]]]") 
       ("[[[[7,0],[7,7]],[[7,7],[7,8]]],[[[7,7],[8,8]],[[7,7],[8,7]]]]\n[7,[5,[[3,8],[1,4]]]]" 
        . "[[[[7,7],[7,8]],[[9,5],[8,7]]],[[[6,8],[0,8]],[[9,9],[9,0]]]]") 
       ("[[[[7,7],[7,8]],[[9,5],[8,7]]],[[[6,8],[0,8]],[[9,9],[9,0]]]]\n[[2,[2,2]],[8,[8,1]]]" 
        . "[[[[6,6],[6,6]],[[6,0],[6,7]]],[[[7,7],[8,9]],[8,[8,1]]]]") 
       ("[[[[6,6],[6,6]],[[6,0],[6,7]]],[[[7,7],[8,9]],[8,[8,1]]]]\n[2,9]" 
        . "[[[[6,6],[7,7]],[[0,7],[7,7]]],[[[5,5],[5,6]],9]]") 
       ("[[[[6,6],[7,7]],[[0,7],[7,7]]],[[[5,5],[5,6]],9]]\n[1,[[[9,3],9],[[9,0],[0,7]]]]" 
        . "[[[[7,8],[6,7]],[[6,8],[0,8]]],[[[7,7],[5,0]],[[5,5],[5,6]]]]") 
       ("[[[[7,8],[6,7]],[[6,8],[0,8]]],[[[7,7],[5,0]],[[5,5],[5,6]]]]\n[[[5,[7,4]],7],1]" 
        . "[[[[7,7],[7,7]],[[8,7],[8,7]]],[[[7,0],[7,7]],9]]") 
       ("[[[[7,7],[7,7]],[[8,7],[8,7]]],[[[7,0],[7,7]],9]]\n[[[[4,2],2],6],[8,7]]" 
        . "[[[[8,7],[7,7]],[[8,6],[7,7]]],[[[0,7],[6,6]],[8,7]]]") 
       )) 
  
   (check-equal? (aoc18a example-input) example-magnitude) 
   (check-equal? (aoc18a) 4017) 
   ) 
  
 $ raco test 18bpt.rkt 
 raco test: (submod "18bpt.rkt" test) 
 62 tests passed 
  
 $