# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1544411726 18000
# Node ID a331ef75f8089907d20f6b935cff195d2fa0bcd9
# Parent  8ffd80cd99aab89e85402dbd709bb064408613ba
Day 9

diff -r 8ffd80cd99aa -r a331ef75f808 src/2018/main.lisp
--- a/src/2018/main.lisp	Sun Dec 09 20:59:39 2018 -0500
+++ b/src/2018/main.lisp	Sun Dec 09 22:15:26 2018 -0500
@@ -263,3 +263,47 @@
           (+ (summation (metadata node))
              (summation (children node) :key #'recur)))
         (node-value root)))))
+
+
+(defstruct dcons data prev next)
+
+(define-problem (2018 9) (data read-file-into-string)
+  (ppcre:register-groups-bind
+      ((#'parse-integer players marbles))
+      (#?/(\d+) players\D*(\d+) points/ data)
+    (labels
+        ((kill (dcons)
+           (let ((p (dcons-prev dcons))
+                 (n (dcons-next dcons)))
+             (when p (setf (dcons-next p) n))
+             (when n (setf (dcons-prev n) p))))
+         (insert-after (dcons data)
+           (let* ((n (dcons-next dcons))
+                  (new (make-dcons :data data :prev dcons :next n)))
+             (setf (dcons-next dcons) new)
+             (when n (setf (dcons-prev n) new))
+             new))
+         (play (players marbles)
+           (let ((circle (make-dcons :data 0))
+                 (elves (make-array players :initial-element 0)))
+             (setf (dcons-prev circle) circle
+                   (dcons-next circle) circle) ; splice into a circular dll
+             (flet ((clockwise (n)
+                      (do-repeat n (callf circle #'dcons-next)))
+                    (counterclockwise (n)
+                      (do-repeat n (callf circle #'dcons-prev))))
+               (iterate
+                 (for elf :first 0 :then (mod (1+ elf) players))
+                 (for marble :from 1 :to marbles)
+                 (if (dividesp marble 23)
+                   (progn (incf (aref elves elf) marble)
+                          (counterclockwise 7)
+                          (incf (aref elves elf) (dcons-data circle))
+                          (setf circle (prog1 (dcons-next circle)
+                                         (kill circle))))
+                   (progn (clockwise 1)
+                          (setf circle (insert-after circle marble)))))
+               (extremum elves '>)))))
+      #+sbcl (sb-ext:gc :full t)
+      (values (play players marbles)
+              (play players (* marbles 100))))))