diff options
Diffstat (limited to '2024')
| -rw-r--r-- | 2024/14/.gitignore | 2 | ||||
| -rw-r--r-- | 2024/14/Makefile | 1 | ||||
| -rw-r--r-- | 2024/14/puzzles.lisp | 141 |
3 files changed, 144 insertions, 0 deletions
diff --git a/2024/14/.gitignore b/2024/14/.gitignore new file mode 100644 index 0000000..284d255 --- /dev/null +++ b/2024/14/.gitignore @@ -0,0 +1,2 @@ +charts/ +puzzle-[12].lisp diff --git a/2024/14/Makefile b/2024/14/Makefile new file mode 100644 index 0000000..b3994c0 --- /dev/null +++ b/2024/14/Makefile @@ -0,0 +1 @@ +include ../../Makefiles/lisp.mk diff --git a/2024/14/puzzles.lisp b/2024/14/puzzles.lisp new file mode 100644 index 0000000..68f06a1 --- /dev/null +++ b/2024/14/puzzles.lisp @@ -0,0 +1,141 @@ +#!/usr/bin/sbcl --script + +;; START PART 2 +(require :sb-posix) +;; END PART 2 + +(defconstant +width+ 101) +(defconstant +height+ 103) + +(defconstant +quadrant-bounds+ + (make-array '(4 4) :initial-contents + (let* ((x +width+) + (y +height+) + (x/2 (floor x 2)) + (y/2 (floor y 2))) + `((0 0 ,x/2 ,y/2) + (,(1+ x/2) 0 ,x ,y/2) + (0 ,(1+ y/2) ,x/2 ,y) + (,(1+ x/2) ,(1+ y/2) ,x ,y))))) + +(defparameter *chart* + (make-array (list +height+ +width+))) + +(defstruct robot + (position nil :type (cons integer integer)) + (velocity nil :type (cons integer integer))) + +(defun main (filename) + (let ((robots (parse-robots filename))) + ;; START PART 1 + (loop for robot in robots + do (plot-on-chart (location-after-n-seconds 100 robot)) + finally (return (* (sum-for-quadrant 0) + (sum-for-quadrant 1) + (sum-for-quadrant 2) + (sum-for-quadrant 3)))) + ;; END PART 1 START PART 2 + (handler-case (sb-posix:mkdir "charts" #o755) + (sb-posix:syscall-error ())) ; EEXIST + (loop for i from 0 below 10000 + do (setq *chart* (make-array (list +height+ +width+))) + (loop for robot in robots + do (plot-on-chart (location-after-n-seconds i robot)) + finally (save-chart-to-bmp i))) + ;; END PART 2 + )) + +(defun parse-robots (filename) + (with-open-file (stream filename) + (loop for line = (read-line stream nil) + while line + for numbers = (extract-numbers-from-string line) + collect (make-robot :position (cons (aref numbers 0) + (aref numbers 1)) + :velocity (cons (aref numbers 2) + (aref numbers 3)))))) + +(defun extract-numbers-from-string (string) + (loop with number-count = 4 + with numbers = (make-array number-count) + for i from 0 below number-count + for start = (position-if #'integer-char-p string) + for end = (position-if-not #'integer-char-p string :start start) + do (setf (aref numbers i) (parse-integer (subseq string start end)) + string (subseq string (or end (length string)))) + finally (return numbers))) + +(defun location-after-n-seconds (seconds robot) + (cons (mod (+ (car (robot-position robot)) + (* seconds (car (robot-velocity robot)))) + +width+) + (mod (+ (cdr (robot-position robot)) + (* seconds (cdr (robot-velocity robot)))) + +height+))) + +(defun plot-on-chart (position) + (incf (aref *chart* (cdr position) (car position)))) + +(defun sum-for-quadrant (quadrant) + (loop with q1 = (aref +quadrant-bounds+ quadrant 0) + with q2 = (aref +quadrant-bounds+ quadrant 1) + with q3 = (aref +quadrant-bounds+ quadrant 2) + with q4 = (aref +quadrant-bounds+ quadrant 3) + for x from q1 below q3 + sum (loop for y from q2 below q4 + sum (aref *chart* y x)))) + +(defun integer-char-p (char) + (or (digit-char-p char) (char= char #\-))) + +;; START PART 2 +(defun save-chart-to-bmp (i) + (with-open-file (stream (format nil "charts/~4,'0d.bmp" i) + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)) + (let* ((row-size (ceiling +width+ 8)) + (padding (mod (- 4 (mod row-size 4)) 4)) + (pixel-data-size (* +height+ (+ row-size padding))) + (pixel-data-offset (+ 14 12 6)) + (file-size (+ pixel-data-offset pixel-data-size))) + ;; Bitmap file header + (write-sequence '(#x42 #x4D) stream) ; ‘BM’ + (write-uint file-size 4 stream) + (write-uint 0 4 stream) ; Reserved bytes + (write-uint pixel-data-offset 4 stream) + + ;; Bitmap information header (BITMAPCOREHEADER) + (write-uint 12 4 stream) + (write-uint +width+ 2 stream) + (write-uint +height+ 2 stream) + (write-uint 1 2 stream) ; Number of color panes + (write-uint 1 2 stream) ; Bits per pixel + + ;; Color table + (write-sequence '(#x00 #x00 #x00) stream) ; Black + (write-sequence '(#xFF #xFF #xFF) stream) ; White + + ;; Pixel data + (dotimes (y +height+) + (let ((row-data (make-array row-size :element-type '(unsigned-byte 8)))) + (dotimes (x +width+) + (let ((bit (min (aref *chart* y x) 1))) + (multiple-value-bind (q r) (floor x 8) + (setf (aref row-data q) + (logior (aref row-data q) + (ash bit (- 7 r))))))) + (write-sequence row-data stream)) + (dotimes (_ padding) + (write-byte 0 stream)))))) + +(defun write-uint (number size stream) + (dotimes (i size) + (write-byte (ldb (byte 8 (* 8 i)) number) stream))) +;; END PART 2 + +;; START PART 1 +(format t "~d~%" (main "input")) +;; END PART 1 START PART 2 +(main "input") +;; END PART 2
\ No newline at end of file |