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 $