~mht/advent-of-cl

b21271a2d2c07be7a8e9a9785b96cd22d06f4d98 — Martin Hafskjold Thoresen 1 year, 6 months ago 80db490
Add 5-8 and 9/1
8 files changed, 370 insertions(+), 0 deletions(-)

A day5.cl
A day6.cl
A day7.lisp
A day8.cl
A day9.cl
A test-6.input
A test-7.input
A test-8.input
A day5.cl => day5.cl +67 -0
@@ 0,0 1,67 @@
(load "~/quicklisp/setup.lisp")
(ql:quickload "uiop")

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

(defun reducable (a b)
  (and (eq (char-downcase a) (char-downcase b))
       (not (eq a b))))

(defun reduce-chars (chars)
  (loop for i from 0
        for end = (- (length chars) 2)
        when (or (> 0 i) (< end i)) return chars
          when (reducable (char chars i) (char chars (+ i 1)))
            do (progn
                 (setf chars (remove-if #'(lambda (_x) t) chars :start i :end (+ i 2)))
                 (setf i (max -1 (- i 2))))
        finally (return chars)))

(defun reduce-chars-d (chars)
  (loop for i from 0
        for end = (- (length chars) 2)
        when (or (> 0 i) (< end i)) return chars
          when (reducable (char chars i) (char chars (+ i 1)))
            do (progn
                 (setf chars (delete-if #'(lambda (_x) t) chars :start i :end (+ i 2)))
                 (setf i (max -1 (- i 2))))
        finally (return chars)))

;; Make sure to prepend some element to the front of the list.
(defun reduce-chars-list (list did-remove)
  (let ((a (second list))
        (b (third list)))
    (if (and list a b)
      (if (reducable a b)
          (progn
            (setf (cdr list) (cdddr list))
            (reduce-chars-list list t))
          (reduce-chars-list (cdr list) did-remove))
      did-remove)))


(defun day-5/1-list (input)
  (let ((l (append (list #\null) (coerce input 'list))))
    (loop
          when (not (reduce-chars-list l nil))
            return (- (length l) 1))))


(defun day-5/2 (input)
  (let ((all-chars (remove-duplicates (loop for c across input collect (char-downcase c)))))
    (loop for c in all-chars
          for inp = (remove c input :key #'char-downcase)
          minimizing (length (reduce-chars inp)) into l
          finally (return l))))


(defun day-5/2-list (input)
  (let ((all-chars (remove-duplicates (loop for c across input collect (char-downcase c)))))
    (loop for c in all-chars
          for inp = (remove c input :key #'char-downcase)
          minimizing (day-5/1-list inp) into l
          finally (return l))))


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

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


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


(defstruct point x y id)

(defparameter *point-count* 0)
(defun pt (x y) (make-point :x x :y y :id (incf *point-count*)))

(defun parse-points (lines)
  (loop for line in lines
        for i = (search ", " line)
        collect (pt (parse-integer (subseq line 0 i))
                    (parse-integer (subseq line (+ 2 i))))))

(defun make-grid (points)
  (let* ((max-x (+ 1 (reduce #'max (mapcar #'point-x points))))
         (max-y (+ 1 (reduce #'max (mapcar #'point-y points))))
         (grid (make-array max-y)))
    (loop for y from 0 below max-y do
      (setf (aref grid y) (make-array max-x)))
    grid))


(defun manhattan (a b)
  (+ (abs (- (point-x a) (point-x b)))
     (abs (- (point-y a) (point-y b)))))


(defun mark-closest (grid points)
  (let ((mx (length (aref grid 0)))
        (my (length grid)))
    (loop for y from 0 below my do
      (loop for x from 0 below mx
        for c = (make-point :x x :y y)
            do (let* ((dists (loop for p in points collect (list (manhattan c p) p)))
                      (sorted (sort dists #'< :key #'car ))
                      (best (car sorted))
                      (tie (eq (first (first sorted)) (first (second sorted)))))
                 (setf (aref (aref grid y) x)
                       (if tie 0 (point-id (second best)))))))
    grid))

(defun get-border-areas (grid)
  (let ((mx (length (aref grid 0)))
        (my (length grid)))
    (remove-duplicates (append
                        (loop for y from 0 below my collect (aref (aref grid y) 0))
                        (loop for y from 0 below my collect (aref (aref grid y) (- mx 1)))
                        (loop for x from 0 below mx collect (aref (aref grid 0) x))
                        (loop for x from 0 below mx collect (aref (aref grid (- my 1)) x))))))

(defun count-area-sizes (grid num-areas)
  (let ((arr (make-array num-areas))
        (mx (length (aref grid 0)))
        (my (length grid)))
    (loop for y from 0 below my do
      (loop for x from 0 below mx
        for area = (aref (aref grid y) x)
        do (incf (aref arr area))))
    (loop for i from 0 below num-areas
          when (< 0 (aref arr i)) collect (list i (aref arr i)))))

(defun exclude-infinities (area-sizes infinities)
  (remove-if #'(lambda (l) (find (car l) infinities)) area-sizes))

(defun day-6/1 (input)
  (setf *point-count* 0)
  (let* ((points (parse-points input))
         (num-areas (1+ (length points)))
         (grid (make-grid points)))
    (mark-closest grid points)
    (let* ((infinites (get-border-areas grid))
           (area-sizes (count-area-sizes grid num-areas))
           (valids (exclude-infinities area-sizes infinites))
           (max-area (car (sort valids #'> :key #'second))))
      (second max-area))))

(defun day-6/2 (input)
  (setf *point-count* 0)
  (let* ((points (parse-points input))
         (max-x (+ 1 (reduce #'max (mapcar #'point-x points))))
         (max-y (+ 1 (reduce #'max (mapcar #'point-y points))))
         (count 0))
    (loop for y from 0 below max-y do
      (loop for x from 0 below max-x
            for point = (pt x y)
            when (< (reduce #'+ (mapcar #'(lambda (p) (manhattan p point)) points)) 10000)
              do (incf count)))
    count))

A day7.lisp => day7.lisp +96 -0
@@ 0,0 1,96 @@
(load "~/quicklisp/setup.lisp")
(ql:quickload "uiop")

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

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

(defun line-to-pair (line)
  (let ((a (subseq line 5 6))
        (b (subseq line 36 37)))
    (list a b)))

(defun get-next (nodes edges)
  (let ((hm (make-hash-table :test #'equalp)))
    (loop for node in nodes do (setf (gethash node hm) 0))
    (let ((available (loop for e in edges
                           do (incf (gethash (second e) hm))
                           finally (return (zero-keys hm)))))
      (when available (reduce #'(lambda (a e) (if (string< a e) a e)) available)))))

(defun day-7/1 (input)
  (let* ((output)
         (edges (mapcar #'line-to-pair input))
         (nodes (remove-duplicates (flatten edges) :test #'string=)))
    (loop when (not (car nodes)) return output
            do (let ((next (get-next nodes edges)))
                 (setf edges (delete-if #'(lambda (edge) (string= (first edge) next)) edges))
                 (setf nodes (delete next nodes))
                 (setf output (cons next output))))
    (reduce #'(lambda (a b) (concatenate 'string a b)) (reverse output))))


(defun flatten (obj)
  (do* ((result (list obj))
        (node result))
       ((null node) (delete nil result))
    (cond ((consp (car node))
           (when (cdar node) (push (cdar node) (cdr node)))
           (setf (car node) (caar node)))
          (t (setf node (cdr node))))))


(defstruct task id done worker)
(defun task-cost (id)
  (+ 60 (- (char-int (char id 0)) 64)))

(defun zero-keys (hm)
  (loop for k being the hash-keys of hm
        when (eq 0 (gethash k hm)) collect k))

(defun random-el (list)
  (let ((i (random (length list))))
    (nth i list)))

(defun get-next/2 (nodes edges)
  (let ((hm (make-hash-table :test #'equalp)))
    (loop for node in nodes do (setf (gethash node hm) 0))
    (let ((available (loop for e in edges
                           do (incf (gethash (second e) hm))
                           finally (return (zero-keys hm)))))
      ; (when available (random-el available)))))
      (when available (progn
                        ; (format t "~S~%" (length available))
                        ; (reduce #'(lambda (a e) (if (string> a e) a e)) available)
                        (random-el available)
                        )))))
      ; (when available (reduce #'(lambda (a e) (if (string> a e) a e)) available)))))


(defun day-7/2 (input num-workers)
  (let* ((edges (mapcar #'line-to-pair input))
         (nodes (remove-duplicates (flatten edges) :test #'string=))
         (available-workers (loop for i from 1 to num-workers collect i))
         (in-flight-tasks))
    (loop for time from 0
          when in-flight-tasks do
            (loop while in-flight-tasks
                  when (< time (task-done (car in-flight-tasks))) return nil
                    do (let ((task (pop in-flight-tasks)))
                         ; (format t "Time ~S and we're done with ~S~%" time (task-id task))
                         (setf edges (delete-if #'(lambda (edge) (string= (first edge) (task-id task))) edges))
                         (push (task-worker task) available-workers)))
          when available-workers do
            (loop for next = (get-next nodes edges)
                  when (not available-workers) return nil
                  if next do (progn
                               (setf nodes (delete next nodes))
                               ; (format t "Time ~S and ~S start with ~S~%" time (car available-workers) next)
                               (push (make-task :id next
                                                :done (+ time (task-cost next))
                                                :worker (pop available-workers))
                                     in-flight-tasks)
                               (setf in-flight-tasks (sort in-flight-tasks #'< :key #'task-done)))
                  else return nil)
          when (and (not nodes) (not in-flight-tasks)) return time)))

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


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


(defun line-to-numbers (line)
  (mapcar #'parse-integer (ppcre:split " " line)))

(defun parse-tree (items)
  (let* ((num-children (first items))
         (num-metadata (second items))
         (rest (cddr items))
         (children
           (loop for i from 0 below num-children
                 collect
                 (multiple-value-bind (node new-rest) (parse-tree rest)
                   (setf rest new-rest)
                   node)))
         (metadata (subseq rest 0 num-metadata)))
    (values (list children metadata) (subseq rest num-metadata))))


(defun metadata-sum (tree)
  (+ (reduce #'+ (second tree))
     (reduce #'+ (mapcar #'metadata-sum (first tree)))))


(defun day-8/1 (input)
  (metadata-sum (parse-tree (line-to-numbers input))))


(defun node-value (node)
  (if (first node)
    (loop for data in (second node)
          summing (node-value (nth (- data 1) (first node))) into sum
          finally (return sum))
    (reduce #'+ (second node))))


(defun day-8/2 (input)
  (node-value (parse-tree (line-to-numbers input))))

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

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

(defun make-circular (e)
  (let* ((l (list e)))
    (setf (cdr l) l)
    l))

(defun insert-circular (e circ)
  (setf (cdr circ) (cons e (cdr circ)))
  t)

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


(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 play-game (num-marbles players)
  (let* ((circle (make-circular 0))
         (current circle)
         (player 0)
         (scores (make-array players)))
    (insert-circular 1 circle)
    (setf current (cdr 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)))
              (remove-circular to-remove)
              (setf current (cdr to-remove)))
            (progn
              (insert-circular marble (cdr current))
              (setf current (cddr current))))))
    (loop for s across scores maximizing s into m finally (return m))))


A test-6.input => test-6.input +6 -0
@@ 0,0 1,6 @@
1, 1
1, 6
8, 3
3, 4
5, 5
8, 9
\ No newline at end of file

A test-7.input => test-7.input +7 -0
@@ 0,0 1,7 @@
Step C must be finished before step A can begin.
Step C must be finished before step F can begin.
Step A must be finished before step B can begin.
Step A must be finished before step D can begin.
Step B must be finished before step E can begin.
Step D must be finished before step E can begin.
Step F must be finished before step E can begin.
\ No newline at end of file

A test-8.input => test-8.input +1 -0
@@ 0,0 1,1 @@
2 3 0 3 10 11 12 1 1 0 1 99 2 1 1 2
\ No newline at end of file