# 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
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.

(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

(values sn #f))

((cons l r)

(if (= depth 5)

(let*

(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.

(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))))))

; 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.

(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))

(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 tail (linked-leaf 0 0 0))

(define (copy-leaf e)

; Return a copy of the given leaf.

(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-left  car)
(define sn-node  cons)
(define sn-node? pair?)
(define sn-right cdr)

(define (splice pred succ)

; Splice the leafs so pred is the immediate predecessor to
; succ, and succ is the immediate successor to 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)))))

(if (> v 9)

(let*

((v (/ v 2))
(left (linked-leaf 0 0 (floor 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 tail (linked-leaf 0 0 0))

(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

(let loop ((sn sn))
(cond

((pair? sn)
(loop (f 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
"[[[[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 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?
'(("[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))))))

'(("[[[[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))))))

'(("[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?
(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

\$
```