[funds-cvs] r193 - trunk/funds/src

[abaine at common-lisp.net]

Author: abaine
Date: Mon Aug 20 12:30:56 2007
New Revision: 193

Modified:
   trunk/funds/src/package.lisp
   trunk/funds/src/queue.lisp
Log:
Substituted alternative version of queue using CLOS; I had been developing this in parallel and it makes more sense, I thirk.

Modified: trunk/funds/src/package.lisp
==============================================================================
--- trunk/funds/src/package.lisp	(original)
+++ trunk/funds/src/package.lisp	Mon Aug 20 12:30:56 2007
@@ -49,7 +49,8 @@
 	   :queue-first
 	   :queue-size
 	   :queue-as-list
-	   :queue-from-list
+	   :queue-count
+	   :queue-count-if
 	   :map-queue
 
 	   :make-stack
@@ -59,6 +60,8 @@
 	   :stack-size
 	   :stack-from-list
 	   :stack-as-list
+	   :stack-count
+	   :stack-count-if
 	   :map-stack
 
 	   :make-dictionary

Modified: trunk/funds/src/queue.lisp
==============================================================================
--- trunk/funds/src/queue.lisp	(original)
+++ trunk/funds/src/queue.lisp	Mon Aug 20 12:30:56 2007
@@ -17,10 +17,19 @@
 
 (in-package :funds)
 
-(defstruct queue
-  "A FIFO queue."
-  (next-priority 0)
-  (heap (make-heap)))
+(defclass queue ()
+  ((next-priority :initarg :next-priority
+		  :initform 0
+		  :reader queue-next-priority)
+   (heap :initarg :heap
+	 :initform (make-heap)
+	 :reader queue-heap)))
+
+(defun make-queue (&key (initial-contents nil))
+  (reduce #'(lambda (q n)
+	      (enqueue q n))
+	  initial-contents
+	  :initial-value (make-instance 'queue)))
 
 (defun queue-first (q)
   "The value at the head of the given queue."
@@ -28,15 +37,15 @@
 
 (defun enqueue (q item)
   "The queue that results when the given item is equeued on the given queue."
-  (make-queue :next-priority (1+ (queue-next-priority q))
-	      :heap (heap-insert (queue-heap q) item (queue-next-priority q))))
+  (make-instance 'queue :next-priority (1+ (queue-next-priority q))
+		 :heap (heap-insert (queue-heap q) item (queue-next-priority q))))
 
 (defun dequeue (q)
   "The queue that results when the first item is removed from the given queue."
   (if (queue-empty-p q)
       q
-      (make-queue :next-priority (1- (queue-next-priority q))
-		  :heap (heap-remove (queue-heap q)))))
+      (make-instance 'queue  :next-priority (1- (queue-next-priority q))
+		     :heap (heap-remove (queue-heap q)))))
 
 (defun queue-size (q)
   "The number of items in the given queue."
@@ -49,8 +58,8 @@
 (defun map-queue (function q)
   "A queue containing items that are the result of applying function to
 the items in the given queue."
-  (make-queue :next-priority (queue-next-priority q)
-	      :heap (map-tree #'(lambda (tree)
+  (make-instance 'queue :next-priority (queue-next-priority q)
+		 :heap (map-tree #'(lambda (tree)
 				  (funcall function (bt-value tree)))
 			      (queue-heap q))))
 
@@ -60,9 +69,13 @@
   (mapcar #'cdr (sort (tree-as-alist (queue-heap q))
 		      #'< :key #'car)))
 
-(defun queue-from-list (list)
-  "A queue whose elements are in the same order as the given list."
-  (reduce #'(lambda (q n)
-	      (enqueue q n))
-	  list 
-	  :initial-value (make-queue)))
+(defun queue-count (item q &key (key #'identity) (test #'eql))
+  (tree-count item (queue-heap q) 
+	      :key #'(lambda (tree)
+		       (funcall key (bt-value tree)))
+	      :test test))
+
+(defun queue-count-if (predicate q &key (key #'identity))
+  (tree-count-if predicate (queue-heap q)
+		 :key #'(lambda (tree)
+			  (funcall key (bt-value tree)))))