close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 3980 for branches


Ignore:
Timestamp:
2016-05-30T20:45:29-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/heap.lisp

    r3979 r3980  
    3434(defparameter +heap-allocation-size+ 16)
    3535
    36 (defun priority-queue-make-heap (&key (element-type 'fixnum))
     36(defun make-heap (&key (element-type 'fixnum))
    3737  (make-array *priority-queue-allocation-size* :element-type element-type :fill-pointer 1
    3838              :adjustable t))
    3939
    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)
    6141  (fill-pointer (priority-queue-heap pq)))
    6242
    63 (defun priority-queue-upheap (a k
     43(defun heap-upheap (a k
    6444               &optional
    6545               (test #'<=)
     
    7858
    7959   
    80 (defun priority-queue-heap-insert (a item &optional (test #'<=))
     60(defun heap-insert (a item &optional (test #'<=))
    8161  (vector-push-extend item a)
    82   (priority-queue-upheap a (1- (fill-pointer a)) test))
     62  (heap-upheap a (1- (fill-pointer a)) test))
    8363
    84 (defun priority-queue-downheap (a k
     64(defun heap-downheap (a k
    8565                 &optional
    8666                 (test #'<=)
     
    10080  a)
    10181
    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)))
    10383  (when (<= (fill-pointer a) 1) (error "Empty queue."))
    10484  (setf (aref a 1) (vector-pop a))
     
    10686  (values v a))
    10787
    108 (defun priority-queue-heap-empty-p (a)
     88(defun heap-empty-p (a)
    10989  (<= (fill-pointer a) 1))
Note: See TracChangeset for help on using the changeset viewer.