| [1201] | 1 | ;;; -*-  Mode: Lisp -*- 
 | 
|---|
| [83] | 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
|---|
 | 3 | ;;;                                                                              
 | 
|---|
 | 4 | ;;;  Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>          
 | 
|---|
 | 5 | ;;;                                                                              
 | 
|---|
 | 6 | ;;;  This program is free software; you can redistribute it and/or modify        
 | 
|---|
 | 7 | ;;;  it under the terms of the GNU General Public License as published by        
 | 
|---|
 | 8 | ;;;  the Free Software Foundation; either version 2 of the License, or           
 | 
|---|
 | 9 | ;;;  (at your option) any later version.                                         
 | 
|---|
 | 10 | ;;;                                                                              
 | 
|---|
 | 11 | ;;;  This program is distributed in the hope that it will be useful,             
 | 
|---|
 | 12 | ;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of              
 | 
|---|
 | 13 | ;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               
 | 
|---|
 | 14 | ;;;  GNU General Public License for more details.                                
 | 
|---|
 | 15 | ;;;                                                                              
 | 
|---|
 | 16 | ;;;  You should have received a copy of the GNU General Public License           
 | 
|---|
 | 17 | ;;;  along with this program; if not, write to the Free Software                 
 | 
|---|
 | 18 | ;;;  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
 | 
|---|
 | 19 | ;;;                                                                              
 | 
|---|
 | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
|---|
 | 21 | 
 | 
|---|
| [446] | 22 | (defpackage "PRIORITY-QUEUE"
 | 
|---|
| [3984] | 23 |   (:use :cl :heap)
 | 
|---|
| [3985] | 24 |   (:export "PRIORITY-QUEUE"
 | 
|---|
| [446] | 25 |            "MAKE-PRIORITY-QUEUE"
 | 
|---|
 | 26 |            "PRIORITY-QUEUE-INSERT"
 | 
|---|
 | 27 |            "PRIORITY-QUEUE-REMOVE"
 | 
|---|
 | 28 |            "PRIORITY-QUEUE-EMPTY-P"
 | 
|---|
| [448] | 29 |            "PRIORITY-QUEUE-SIZE"
 | 
|---|
| [3991] | 30 |            )
 | 
|---|
 | 31 |   (:documentation "Implements a priority queue."))
 | 
|---|
| [83] | 32 | 
 | 
|---|
| [447] | 33 | (in-package :priority-queue)
 | 
|---|
| [50] | 34 | 
 | 
|---|
| [3989] | 35 | (defclass priority-queue ()
 | 
|---|
 | 36 |   ((heap :initarg :heap :accessor priority-queue-heap)
 | 
|---|
 | 37 |    (test :initarg :ters :accessor priority-queue-test))
 | 
|---|
 | 38 |   (:documentation "Representa a priority queue."))
 | 
|---|
| [50] | 39 | 
 | 
|---|
| [3989] | 40 | (defmethod initialize-instance ((self priority-queue) 
 | 
|---|
 | 41 |                                 &key 
 | 
|---|
 | 42 |                                   (element-type 'fixnum)
 | 
|---|
 | 43 |                                   (test #'<=)
 | 
|---|
 | 44 |                                   (element-key #'identity))
 | 
|---|
 | 45 |   (with-slots (heap test)
 | 
|---|
 | 46 |       self
 | 
|---|
 | 47 |     (setf heap (make-heap :element-type element-type)
 | 
|---|
 | 48 |           test #'(lambda (x y) (funcall test (funcall element-key y) (funcall element-key x))))))
 | 
|---|
| [50] | 49 |   
 | 
|---|
| [3989] | 50 | (defgeneric enqueue (self item)
 | 
|---|
 | 51 |   (:method ((self priority-queue) (item t))
 | 
|---|
 | 52 |     (with-slots (heap test)
 | 
|---|
 | 53 |         self
 | 
|---|
 | 54 |     (heap-insert heap item test))))
 | 
|---|
| [50] | 55 | 
 | 
|---|
| [3990] | 56 | (defgeneric dequeue (self)
 | 
|---|
 | 57 |   (:method ((self priority-queue))
 | 
|---|
 | 58 |     (with-slots (heap test)
 | 
|---|
 | 59 |         self
 | 
|---|
 | 60 |       (heap-remove heap test))))
 | 
|---|
| [50] | 61 | 
 | 
|---|
| [3990] | 62 | (defgeneric queue-empty-p (self)
 | 
|---|
 | 63 |   (:method ((self priority-queue))
 | 
|---|
 | 64 |     (with-slots (heap)
 | 
|---|
 | 65 |         self
 | 
|---|
 | 66 |       (heap-empty-p heap))))
 | 
|---|
| [50] | 67 | 
 | 
|---|
| [3992] | 68 | (defgeneric queue-size (self)
 | 
|---|
 | 69 |   (:method ((self priority-queue))
 | 
|---|
 | 70 |     (with-slots (heap)
 | 
|---|
 | 71 |         self
 | 
|---|
 | 72 |     (heap-size heap))))
 | 
|---|