~mht/advent-of-cl

aae7fb166d49cba08064d96174228f344d27bf2f — Martin Hafskjold Thoresen 1 year, 9 months ago e35062f master
Day 12-14
6 files changed, 356 insertions(+), 48 deletions(-)

M day12.cl
A day13.cl
A day14.cl
M day9.cl
A test-13-2.input
A test-13.input
M day12.cl => day12.cl +44 -24
@@ 14,16 14,17 @@
    (princ (if (eq c 0) #\. #\#)))
  (princ #\newline))

(defparameter state-padding 100)
(defparameter rule-length 5)
(defparameter current-pre-padding 2)

(defun read-state (string)
  (let ((vec (make-array 0 :adjustable t :fill-pointer t)))
    (loop for i from 1 to state-padding do (vector-push-extend 0 vec))
    (loop for i below 2  do (vector-push-extend 0 vec))
    (loop for c across string do
      (vector-push-extend
       (case c (#\# 1) (#\. 0) (other (error "lol")))
       vec))
    (loop for i from 1 to state-padding do (vector-push-extend 0 vec))
    (loop for i below 2 do (vector-push-extend 0 vec))
    vec))




@@ 63,12 64,17 @@

(defun rule-c (rule) (aref rule 2))

(defun get-padding (state)
  (let* ((first-nz (position 1 (subseq state 0 rule-length)))
         (to-pad-front (- 5 (or first-nz 5)))
         (n0 (- (length state) rule-length))
         (last-nz (position 1 (subseq state n0) :from-end t))
         (to-pad-back (+ 1 (or last-nz -1))))
    (values (max 2 to-pad-front) (max 2 to-pad-back))))

(defun state-iter (state rules)
  (let ((n (length state))
        (new-state (make-array 0 :adjustable t :fill-pointer t)))
    (vector-push-extend 0 new-state)
    (vector-push-extend 0 new-state)
    (loop for i from 2 below (- n 2) do
      (block outer
        (loop for rule in rules


@@ 77,38 83,52 @@
                  (vector-push-extend 1 new-state)
                  (return-from outer)))
        (vector-push-extend 0 new-state)))
    (vector-push-extend 0 new-state)
    (vector-push-extend 0 new-state)
    new-state))
    (multiple-value-bind (pf pb) (get-padding new-state)
      (let ((newer-state
              (make-array 0 :adjustable t :fill-pointer t)))
        (incf current-pre-padding (- pf 2))
        (loop for i below pf do
          (vector-push-extend 0 newer-state))
        (loop for e across new-state do
          (vector-push-extend e newer-state))
        (loop for i below pb do
          (vector-push-extend 0 newer-state))
      newer-state))))


(defun day-12/1 (input)
  (let* ((tuple (read-input input))
         (state (car tuple))
         (rules (cdr tuple)))
    (setf current-pre-padding 2)
    (print-state state)
    (loop for i from 0 below 20
          do (progn
               (setf state (state-iter state rules))
               (print-state state)
               ))
    (loop for j from 0 upto (length state)
          when (eq 1 (aref state j))
            sum (- j state-padding) into sum
          finally (return sum))))
    (loop for i from 1 to 130
          do (progn (setf state (state-iter state rules))
                    (print-state state)))
    (score state)))


(defun score (state)
  (loop for j from 0 below (length state)
        when (eq 1 (aref state j))
          sum (- j current-pre-padding) into sum
        finally (return sum)))

(defun day-12/2 (input)
  (let* ((tuple (read-input input))
         (state (car tuple))
         (rules (cdr tuple)))
    (setf current-pre-padding 2)
    (print-state state)
    (loop for i from 0 below 200
    (loop for i below 120
          do (progn
               (setf state (state-iter state rules))
               (print-state state)
               ))
    (loop for j from 0 upto (length state)
          when (eq 1 (aref state j))
            sum (- j state-padding) into sum
          finally (return sum))))
               (print-state state)))
    (let* ((score-1 (score state))
           (score-2 (score (state-iter state rules)))
           (diff (- score-2 score-1))
           (remaining-gens (- 50000000000 121))
           (current-score score-2)
           (final-score (+ current-score (* diff remaining-gens)))
           )
      (print final-score))))

A day13.cl => day13.cl +178 -0
@@ 0,0 1,178 @@
(load "~/quicklisp/setup.lisp")
(ql:quickload "uiop")
(ql:quickload "cl-ppcre")
(ql:quickload "split-sequence")

(defparameter *input-13* (uiop:read-file-lines "13.input"))
(defparameter *test-input-13* (uiop:read-file-lines "test-13.input"))
(declaim (optimize (speed 3)))
(declaim (optimize (speed 0) (safety 3) (debug 3)))


(defstruct point x y)
(defun point-add (pa pb)
  (make-point
   :x (+ (point-x pa)
         (point-x pb))
   :y (+ (point-y pa)
         (point-y pb))))

(defun point< (a b)
  (let (
        (ax (point-x a))
        (ay (point-y a))
        (bx (point-x b))
        (by (point-y b)))
      (if (= ax bx)
          (< ay by)
          (< ax bx))))



(defstruct cart pos dir num-turns)
(defun next-position (cart)
  (case (cart-dir cart)
    (#\^ (point-add (cart-pos cart) (make-point :x 0 :y -1)))
    (#\v (point-add (cart-pos cart) (make-point :x 0 :y 1)))
    (#\< (point-add (cart-pos cart) (make-point :x -1 :y 0)))
    (#\> (point-add (cart-pos cart) (make-point :x 1 :y 0)))
    (other (error "(cart-dir cart) is illegal"))))


(defun char-is-cart (c)
  (case c
    (#\^ t)
    (#\v t)
    (#\< t)
    (#\> t)
    (other nil)))

(defun read-input (input)
  (let ((carts (list)))
    (loop for line in input
      sum 1 into y
      do (loop for c across line
               sum 1 into x
               when (char-is-cart c) do
                 (progn
                   (push (make-cart :pos (make-point :x (- x 1)
                                                     :y (- y 1))
                                    :dir c
                                    :num-turns 0)
                         carts)
                 (let ((replacement (if (or (char= c #\v)
                                            (char= c #\^))
                                        #\|
                                        #\-)))
                   (setf (elt (nth (- y 1) input) (- x 1)) replacement))))
          )
    (reverse carts)))

(defun world-at (world point)
  (let ((x (point-x point))
        (y (point-y point)))
    (if (or (> 0 x ) (> 0 y))
        nil
        (elt (nth y world) x))))

(defun world-print (world)
  (loop for l in world do (format t "~A~%" l)))

(defun is-turn (c) (or (char= c #\\) (char= c #\/)))
(defun is-cross (c) (char= c #\+))

(defun corner-dir-to-next-dir (corner dir)
  (case dir
    (#\^ (if (char= corner #\\) #\< #\>))
    (#\v (if (char= corner #\\) #\> #\<))
    (#\< (if (char= corner #\\) #\^ #\v))
    (#\> (if (char= corner #\\) #\v #\^))
    (other (error "illegal direction"))))


(defun turn-left (dir)
  (case dir
    (#\^ #\<)
    (#\< #\v)
    (#\v #\>)
    (#\> #\^)
    (other (error "Illegal direction"))))


(defun turn-right (dir)
  (case dir
    (#\^ #\>)
    (#\< #\^)
    (#\v #\<)
    (#\> #\v)
    (other (error "Illegal direction"))))


(defun get-and-update-cross-dir (cart)
  (case (mod (incf (cart-num-turns cart) 1) 3)
    (0 (setf (cart-dir cart) (turn-right (cart-dir cart))))
    (1 (setf (cart-dir cart) (turn-left (cart-dir cart))))
    (2 (cart-dir cart))))


(defun move-cart (world cart)
  (let* ((next-pos (next-position cart))
         (next-char (world-at world next-pos)))
    (cond ((is-turn next-char)
           (setf (cart-dir cart) (corner-dir-to-next-dir
                                  next-char
                                  (cart-dir cart))))
          ((is-cross next-char)
           (get-and-update-cross-dir cart)))
    (setf (cart-pos cart) next-pos)))


(defun any-carts-collide (carts)
  (let ((hm (make-hash-table :test #'equalp)))
    (block outer
      (loop for cart in carts
            for p = (cart-pos cart)
            when (gethash p hm) do (return-from outer p)
              do (setf (gethash p hm) t)))))


(defun day-13/1 (world)
  (let ((carts (read-input world)))
    (block outer
      (loop for _iter from 0 do
        (if (position _iter '(174 175))
            (print-with-carts world carts))
        (format t "~%~S" _iter)
        (loop for cart in carts
              do (move-cart world cart)
              when (any-carts-collide carts) do
                (return-from outer (any-carts-collide2 carts)))))))


(defun day-13/2 (world)
  (let ((carts (read-input world))
        (done))
    (block outer
      (loop for _iter from 0
            for carts-len = (length carts) do
              (loop for cart in carts
                    do (move-cart world cart)
                    when (any-carts-collide2 carts) do
                      (let ((coll (any-carts-collide2 carts)))
                        (setf carts (remove-if
                                     #'(lambda (c) (equalp (cart-pos c) coll))
                                     carts))
                        (when (= 3 carts-len)
                          (setf done t)))
                    summing 1 into cart-index)
              (setf carts (sort carts #'point< :key #'cart-pos))
              (when done
                (return-from outer (cart-pos (car carts))))))))


(defun print-with-carts (original-world carts)
  (let ((world (mapcar #'copy-seq original-world)))
    (loop for cart in carts do
      (setf (elt (nth (point-y (cart-pos cart)) world) (point-x (cart-pos cart)))
            (cart-dir cart)))
    (world-print world)))

A day14.cl => day14.cl +77 -0
@@ 0,0 1,77 @@
(load "~/quicklisp/setup.lisp")
(ql:quickload "uiop")
(ql:quickload "cl-ppcre")

; (defparameter *input-14* (uiop:read-file-lines "10.input"))
(defparameter *input-14* 110201)
(declaim (optimize (speed 0) (safety 3) (debug 3)))

(declaim (optimize (speed 3) (safety 0) (debug 0)))

(defun digits-of (n)
  (if (< n 10)
      (list n)
      (let ((lsd (mod n 10)))
        (append (digits-of (floor n 10)) (list lsd)))))

(defun print-nums (nums)
  (loop for d across nums do (format t "~S" d))
  (format t "~%"))

(defun day-14/1 (input)
  (let ((recipes (make-array 0 :adjustable t :fill-pointer t))
        (a 0)
        (b 1))
    (vector-push-extend 3 recipes)
    (vector-push-extend 7 recipes)
    (block main
      (loop do
        (let ((new-recipe (+ (elt recipes a) (elt recipes b))))
        (loop for d in (digits-of new-recipe) do
          (vector-push-extend d recipes)))
        (let ((len (length recipes)))
          (setf a (mod (+ a 1 (elt recipes a)) len))
          (setf b (mod (+ b 1 (elt recipes b)) len))
          (when (<= (+ 10 input) len)
              (print-nums (subseq recipes input (+ input 10)))
              (return-from main)))))))


(defun matches (vec i lst)
  (if (not lst) t
    (if (= (car lst) (elt vec i))
        (matches vec (+ 1 i) (cdr lst))
        nil)))


(defun day-14/2 (input)
  (let* ((recipes (make-array 0 :adjustable t :fill-pointer t))
         (a 0)
         (b 1)
         (digits (digits-of input))
         (num-digits (length digits))
         (ind 0))
    (vector-push-extend 3 recipes)
    (vector-push-extend 7 recipes)
    (block main
      (loop for i to 10 do
        (let* ((new-recipe (+ (elt recipes a) (elt recipes b)))
               (new-digits (digits-of new-recipe)))
          (loop for d in new-digits do
            (vector-push-extend d recipes))
          (let ((len (length recipes)))
            (setf a (mod (+ a 1 (elt recipes a)) len))
            (setf b (mod (+ b 1 (elt recipes b)) len)))))
      (loop for i from 0 to (- (length recipes) num-digits 1) do
        (when (matches recipes (incf ind 1) digits)
          (return-from main ind)))
      (loop do
        (let* ((new-recipe (+ (elt recipes a) (elt recipes b)))
               (new-digits (digits-of new-recipe)))
          (loop for d in new-digits do
            (vector-push-extend d recipes)
            (when (matches recipes (incf ind 1) digits)
              (return-from main ind)))
          (let ((len (length recipes)))
            (setf a (mod (+ a 1 (elt recipes a)) len))
            (setf b (mod (+ b 1 (elt recipes b)) len))))))))

M day9.cl => day9.cl +44 -24
@@ 2,33 2,44 @@
(ql:quickload "uiop")
(ql:quickload "cl-ppcre")

(declaim (optimize (speed 3)))

(defparameter *input-9* (car (uiop:read-file-lines "9.input")))
(defparameter *test-input-9* (car (uiop:read-file-lines "test-9.input")))

(defstruct node b e f)

(defun make-circular (e)
  (let* ((l (list e)))
    (setf (cdr l) l)
    l))
  (let ((n (make-node :f nil :e e :b nil)))
    (setf (node-f n) n)
    (setf (node-b n) n)
    n))

(defun insert-circular (e circ)
  (setf (cdr circ) (cons e (cdr circ)))
  t)
(defun insert-circular (e node)
  (let ((n (make-node :b node :e e :f (node-f node))))
    (setf (node-b (node-f node)) n)
    (setf (node-f node) n)
    t))

(defun remove-circular (circ)
  (setf (cdr circ) (cddr circ))
  t)

;; Not used
(defun map-circular (f node)
  (let* ((head (node-e node))
         (result (list (funcall f head))))
    (loop do (setf node (node-f node))
          when (eq (node-e node) head) return (reverse result)
          do (push (funcall f (node-e node)) result))))

(defun map-circular (f circ)
  (let* ((head (first circ))
        (result (list (funcall f head))))
    (loop for e in (cdr circ)
          when (eq e head) return (reverse result)
          do (push (funcall f e) result))))

(defun length-circular (circ)
  (length (map-circular #'(lambda (x) x) circ)))
(defun remove-circular (node)
  (setf (node-f node) (node-f (node-f node)))
  (setf (node-b (node-f node)) node)
  t)


(defun n-back (n node)
  (if (eq n 0) node
      (n-back (- n 1) (node-b node))))


(defun play-game (num-marbles players)


@@ 37,18 48,27 @@
         (player 0)
         (scores (make-array players)))
    (insert-circular 1 circle)
    (setf current (cdr circle))
    (setf current (node-f circle))
    (loop for marble from 2 to num-marbles do
      (progn
        (setf player (mod (1+ player) players))
        (if (eq (mod marble 23) 0)
            (let* ((len (length-circular circle))
                   (to-remove (nthcdr (- len 8) current)))
              (incf (aref scores player) (+ marble (second to-remove)))
            (let* ((to-remove (n-back 8 current)))
              (incf (aref scores player) (+ marble (node-e (node-f to-remove))))
              (remove-circular to-remove)
              (setf current (cdr to-remove)))
              (setf current (node-f to-remove)))
            (progn
              (insert-circular marble (cdr current))
              (setf current (cddr current))))))
              (insert-circular marble (node-f current))
              (setf current (node-f (node-f current)))))))
    (loop for s across scores maximizing s into m finally (return m))))


(defun day-9/1 ()
  (let ((players 425)
        (marbles 70848))
    (play-game marbles players)))

(defun day-9/2 ()
  (let ((players 425)
        (marbles (* 100 70848)))
    (play-game marbles players)))

A test-13-2.input => test-13-2.input +7 -0
@@ 0,0 1,7 @@
/>-<\  
|   |  
| /<+-\
| | | v
\>+</ |
  |   ^
  \<->/
\ No newline at end of file

A test-13.input => test-13.input +6 -0
@@ 0,0 1,6 @@
/->-\        
|   |  /----\
| /-+--+-\  |
| | |  | v  |
\-+-/  \-+--/
  \------/   
\ No newline at end of file