solved day 9

aoc.asd

@@ -33,6 +33,7 @@
 		 (:file "2024/day06")
 		 (:file "2024/day07")
 		 (:file "2024/day08")
+		 (:file "2024/day09")
 		 )))
   :description "Advent of Code challenges and solutions."
   :long-description "Solutions for the AOC challenges."
@@ -57,6 +58,7 @@
 		 (:file "2024/day06-test")
 		 (:file "2024/day07-test")
 		 (:file "2024/day08-test")
+		 (:file "2024/day09-test")
 		 )))
   :description "Test system for aoc"
   :perform (test-op (op c) (symbol-call :parachute :test :aoc/tests)))

src/2024/day09.lisp

@@ -0,0 +1,158 @@
+(defpackage :aoc/2024/09
+  (:use :cl :aoc :alexandria :trivia :lla)
+  (:export
+   #:sample-data
+   #:sample-data2
+   #:part1
+   #:part2
+   #:blocks-to-fs
+   #:make-freespace
+   #:make-inode
+   #:fs-compact-step
+   #:max-file-id
+   ))
+
+(in-package :aoc/2024/09)
+
+
+
+
+(defstruct inode id start length)
+(defstruct freespace start length)
+
+(defun blocks-to-fs (blocks)
+  (loop
+    for block in blocks
+    for id from 0  
+    for use = (if (eq use :free) :file :free)
+    for node = (if (eq use :free)
+		   (make-inode :id (floor (/ id 2)) :start pos :length block)
+		   (make-freespace :start pos :length block))
+    with    pos = 0
+    until (emptyp blocks)
+    collect node
+    do (incf pos block))
+  )
+
+(defun parse-input (line)
+  (blocks-to-fs (mapcar #'digit-char-p (coerce line 'list))))
+
+(defparameter input-text (first (test-input 2024 9)))
+(defparameter input-data (parse-input input-text))
+
+(defparameter sample-text "2333133121414131402")
+(defparameter sample-data 
+  (parse-input sample-text))
+
+(defun strip-freespace-at-end (fs)
+  (if (or (emptyp fs) (inode-p (first (last fs))))
+      fs
+      (strip-freespace-at-end (subseq fs 0 (1- (length fs))))))
+
+(defun coalesce-last-inodes (fs)
+  (let ((last2 (last fs 2)))
+    (if (and
+	 (= 2 (length last2))
+	 (every #'inode-p last2)
+	 (reduce #'(lambda (a b) (and a b)) (mapcar #'inode-id last2)))
+	(append
+	 (subseq fs 0 (- (length fs) 2))
+	 (list (make-inode
+		:id (inode-id (first last2))
+		:start (inode-start (first last2))
+		:length (reduce #'+ (mapcar #'inode-length last2)))))
+	fs)))
+
+(defun max-file-id (fs)
+  (loop
+    for n in fs
+    if (inode-p n)
+      maximize (inode-id n)))
+
+(defun fs-compact-step (fs)
+  (let* ((first-free (find-if #'freespace-p fs))
+	 (free-pos (position first-free fs))
+	 (last-inode (find-if #'inode-p (reverse fs)))
+	 (inode-pos (position last-inode fs)))
+    (if first-free
+	(strip-freespace-at-end
+	 (append
+	  (subseq fs 0 free-pos)
+	  (list (make-inode
+		 :id (inode-id last-inode)
+		 :start (freespace-start first-free)
+		 :length (min (freespace-length first-free) (inode-length last-inode))))
+	  (if (> (freespace-length first-free) (inode-length last-inode))
+	      (list (make-freespace
+		     :length (- (freespace-length first-free) (inode-length last-inode))
+		     :start (+ (freespace-start first-free) (inode-length last-inode)))))
+	  (subseq fs (1+ free-pos) inode-pos)
+	  (if (<  (freespace-length first-free) (inode-length last-inode))
+	      (list (make-inode
+		     :id (inode-id last-inode)
+		     :start (inode-start last-inode)
+		     :length (- (inode-length last-inode) (freespace-length first-free)))))))
+	fs)))
+
+(defun fs-compact (fs)
+  (loop while (some #'freespace-p fs)
+	do (setf fs (fs-compact-step fs)))
+  (coalesce-last-inodes fs))
+
+
+(defun fs-checksum (fs)
+  (loop
+    for inode in fs
+    if (inode-p inode)
+      sum (* (inode-length inode)
+	     (inode-id inode)
+	     (/ (+ (* 2 (inode-start inode)) (inode-length inode) -1) 2))))
+
+
+(defun fs-optimize-file (fs id)
+  (let* ((inode (find-if
+		 (lambda (n)
+		   (and
+		    (inode-p n)
+		    (= (inode-id n) id)))
+		 fs))
+	 (inode-pos (position inode fs))
+	 (freespace (find-if
+		     (lambda (n)
+		       (and
+			(freespace-p n)
+			(>= (freespace-length n) (inode-length inode))))
+		     fs))
+	 (freespace-pos (position freespace fs))
+	 )
+    (if (and freespace (> inode-pos freespace-pos))
+	(append
+	 (subseq fs 0 freespace-pos)
+	 (list (make-inode
+		:id id
+		:start (freespace-start freespace)
+		:length (inode-length inode)))
+	 (if (> (freespace-length freespace) (inode-length inode))
+	     (list (make-freespace
+		    :start (+ (freespace-start freespace) (inode-length inode))
+		    :length (- (freespace-length freespace) (inode-length inode)))))
+	 (subseq fs (1+ freespace-pos) inode-pos)
+	 (subseq fs (1+ inode-pos)))
+	fs)))
+
+(defun fs-optimize (fs)
+  (let ((ids (reverse (mapcar #'inode-id (remove-if-not #'inode-p fs)))))
+    (reduce #'fs-optimize-file ids :initial-value fs)))
+
+
+(defun part1 (data)
+  (let ((cfs (fs-compact data)))
+    (format nil "~A" (fs-checksum cfs))))
+
+(defun part2 (data)
+  (let ((ofs (fs-optimize data)))
+    (format nil "~A" (fs-checksum ofs))))
+
+(defun solve-day ()
+  (format t "part1: ~A~%" (part1 input-data))
+  (format t "part2: ~A~%" (part2 input-data)))

tests/2024/day09-test.lisp

@@ -0,0 +1,80 @@
+(defpackage :aoc/2024/09/tests
+  (:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/09))
+
+(in-package :aoc/2024/09/tests)
+
+(define-test suite-2024-09
+					;:parent suite-2024
+  )
+
+(define-test test-blocks-to-fs
+  :parent suite-2024-09
+  (let ((fs (blocks-to-fs sample-data)))
+    (is equalp (make-inode :id 0 :start 0 :length 2) (nth 0 fs))
+    (is equalp (make-freespace :start 2 :length 3) (nth 1 fs))
+    (is equalp (make-inode :id 1 :start 5 :length 3) (nth 2 fs))
+    (is equalp (make-freespace :start 8 :length 3) (nth 3 fs)))) 
+
+
+(define-test test-compact-fs
+  :parent suite-2024-09
+  ;; last block fits exactly in first free space
+  (is equalp
+      (list
+       (make-inode :id 0 :start 0 :length 2)
+       (make-inode :id 1 :start 2 :length 2))
+      (fs-compact-step (list
+			(make-inode :id 0 :start 0 :length 2)
+			(make-freespace :start 2 :length 2)
+			(make-inode :id 1 :start 4 :length 2)
+			)))
+  ;; last block bigger than first free space
+  (is equalp
+      (list
+       (make-inode :id 0 :start 0 :length 2)
+       (make-inode :id 2 :start 2 :length 2)
+       (make-inode :id 1 :start 4 :length 2)
+       (make-freespace :start 6 :length 2)
+       (make-inode :id 2 :start 8 :length 2))
+      (fs-compact-step (list
+			(make-inode :id 0 :start 0 :length 2)
+			(make-freespace :start 2 :length 2)
+			(make-inode :id 1 :start 4 :length 2)
+			(make-freespace :start 6 :length 2)
+			(make-inode :id 2 :start 8 :length 4)
+			
+			)))
+  ;; last block smaller than first free space
+  (is equalp
+      (list
+       (make-inode :id 0 :start 0 :length 2)
+       (make-inode :id 2 :start 2 :length 2)
+       (make-freespace :start 4 :length 2)
+       (make-inode :id 1 :start 6 :length 2)
+       )
+      (fs-compact-step (list
+			(make-inode :id 0 :start 0 :length 2)
+			(make-freespace :start 2 :length 4)
+			(make-inode :id 1 :start 6 :length 2)
+			(make-freespace :start 8 :length 2)
+			(make-inode :id 2 :start 10 :length 2)
+			
+			)))
+  )
+
+
+
+(define-test+run test-part1
+  :parent suite-2024-09
+  (true (equal "1928" (part1 sample-data))))
+
+(define-test+run test-part2
+  :parent suite-2024-09
+  (true (equal "2858" (part2 sample-data))))
+
+
+
+
+
+
+