aboutsummaryrefslogtreecommitdiff
path: root/2024/16
diff options
context:
space:
mode:
authorThomas Voss <mail@thomasvoss.com> 2024-12-18 13:09:53 +0100
committerThomas Voss <mail@thomasvoss.com> 2024-12-18 13:09:53 +0100
commitfc496c42e51671ede4d5d2ddee1ad285741dee04 (patch)
treeda1552a3d8cf26f24dc077b610e31dacc4ccbd6d /2024/16
parent14f9c394cc233bdcda23e601a210082701e8d606 (diff)
Move heap.lisp up
Diffstat (limited to '2024/16')
-rw-r--r--2024/16/heap.lisp59
-rw-r--r--2024/16/puzzles.lisp2
2 files changed, 1 insertions, 60 deletions
diff --git a/2024/16/heap.lisp b/2024/16/heap.lisp
deleted file mode 100644
index 62d36fb..0000000
--- a/2024/16/heap.lisp
+++ /dev/null
@@ -1,59 +0,0 @@
-(defpackage #:heap
- (:use :cl)
- (:export :dequeue :emptyp :enqueue :make-heap))
-
-(in-package #:heap)
-
-(defun make-heap (&key (priority-function #'identity))
- (cons (make-array 0 :fill-pointer t) priority-function))
-
-(defun enqueue (item heap)
- (let ((heap-vec (car heap)))
- (vector-push-extend item heap-vec)
- (%sift-down heap 0 (1- (length heap-vec)))))
-
-(defun dequeue (heap)
- (let* ((heap-vec (car heap))
- (last-item (vector-pop heap-vec)))
- (if (zerop (length heap-vec))
- last-item
- (prog1
- (aref heap-vec 0)
- (setf (aref heap-vec 0) last-item)
- (%sift-up heap 0)))))
-
-(defun emptyp (heap)
- (zerop (length (car heap))))
-
-(defun %sift-down (heap start-pos pos)
- (let* ((heap-vec (car heap))
- (heap-fn (cdr heap))
- (new-item (aref heap-vec pos)))
- (loop while (> pos start-pos) do
- (let* ((parent-pos (ash (1- pos) -1))
- (parent (aref heap-vec parent-pos)))
- (unless (< (funcall heap-fn new-item)
- (funcall heap-fn parent))
- (loop-finish))
- (setf (aref heap-vec pos) parent)
- (setq pos parent-pos)))
- (setf (aref heap-vec pos) new-item)))
-
-(defun %sift-up (heap pos)
- (let* ((heap-vec (car heap))
- (heap-fn (cdr heap))
- (end-pos (length heap-vec))
- (start-pos pos)
- (new-item (aref heap-vec pos))
- (child-pos (1+ (* 2 pos))))
- (loop while (< child-pos end-pos) do
- (let ((right-pos (1+ child-pos)))
- (when (and (< right-pos end-pos)
- (>= (funcall heap-fn (aref heap-vec child-pos))
- (funcall heap-fn (aref heap-vec right-pos))))
- (setq child-pos right-pos))
- (setf (aref heap-vec pos) (aref heap-vec child-pos))
- (setq pos child-pos
- child-pos (1+ (* 2 pos)))))
- (setf (aref heap-vec pos) new-item)
- (%sift-down heap start-pos pos))) \ No newline at end of file
diff --git a/2024/16/puzzles.lisp b/2024/16/puzzles.lisp
index 91e6117..17a49f8 100644
--- a/2024/16/puzzles.lisp
+++ b/2024/16/puzzles.lisp
@@ -1,6 +1,6 @@
#!/usr/bin/sbcl --script
-(load "heap.lisp")
+(load "../heap.lisp")
(defstruct dnode
(x nil :type integer)