Changeset 3980 for branches/f4grobner
- Timestamp:
- 2016-05-30T20:45:29-07:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/heap.lisp
r3979 r3980 34 34 (defparameter +heap-allocation-size+ 16) 35 35 36 (defun priority-queue-make-heap (&key (element-type 'fixnum))36 (defun make-heap (&key (element-type 'fixnum)) 37 37 (make-array *priority-queue-allocation-size* :element-type element-type :fill-pointer 1 38 38 :adjustable t)) 39 39 40 (defstruct (priority-queue (:constructor priority-queue-construct)) 41 (heap (priority-queue-make-heap)) 42 test) 43 44 (defun make-priority-queue (&key (element-type 'fixnum) 45 (test #'<=) 46 (element-key #'identity)) 47 (priority-queue-construct 48 :heap (priority-queue-make-heap :element-type element-type) 49 :test #'(lambda (x y) (funcall test (funcall element-key y) (funcall element-key x))))) 50 51 (defun priority-queue-insert (pq item) 52 (priority-queue-heap-insert (priority-queue-heap pq) item (priority-queue-test pq))) 53 54 (defun priority-queue-remove (pq) 55 (priority-queue-heap-remove (priority-queue-heap pq) (priority-queue-test pq))) 56 57 (defun priority-queue-empty-p (pq) 58 (priority-queue-heap-empty-p (priority-queue-heap pq))) 59 60 (defun priority-queue-size (pq) 40 (defun heap-size (pq) 61 41 (fill-pointer (priority-queue-heap pq))) 62 42 63 (defun priority-queue-upheap (a k43 (defun heap-upheap (a k 64 44 &optional 65 45 (test #'<=) … … 78 58 79 59 80 (defun priority-queue-heap-insert (a item &optional (test #'<=))60 (defun heap-insert (a item &optional (test #'<=)) 81 61 (vector-push-extend item a) 82 ( priority-queue-upheap a (1- (fill-pointer a)) test))62 (heap-upheap a (1- (fill-pointer a)) test)) 83 63 84 (defun priority-queue-downheap (a k64 (defun heap-downheap (a k 85 65 &optional 86 66 (test #'<=) … … 100 80 a) 101 81 102 (defun priority-queue-heap-remove (a &optional (test #'<=) &aux (v (aref a 1)))82 (defun heap-remove (a &optional (test #'<=) &aux (v (aref a 1))) 103 83 (when (<= (fill-pointer a) 1) (error "Empty queue.")) 104 84 (setf (aref a 1) (vector-pop a)) … … 106 86 (values v a)) 107 87 108 (defun priority-queue-heap-empty-p (a)88 (defun heap-empty-p (a) 109 89 (<= (fill-pointer a) 1))
Note:
See TracChangeset
for help on using the changeset viewer.