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

[abaine at common-lisp.net]

Author: abaine
Date: Mon Aug 20 12:58:18 2007
New Revision: 198

Modified:
   trunk/funds/src/f-array.lisp
Log:
Added f-array-count, f-array-count-if, map-f-array, and f-array-as-list; also added initial-element keyword to make-f-array.

Modified: trunk/funds/src/f-array.lisp
==============================================================================
--- trunk/funds/src/f-array.lisp	(original)
+++ trunk/funds/src/f-array.lisp	Mon Aug 20 12:58:18 2007
@@ -1,7 +1,7 @@
 
 (in-package :funds)
 
-(defun make-f-array (size &key (initial-contents nil))
+(defun make-f-array (size &key (initial-contents nil) (initial-element nil))
   "A functional array of the given size with the given initial contents."
   (let ((length (length initial-contents)))
    (labels ((f (start end)
@@ -11,7 +11,7 @@
 		    (make-instance 'binary-tree 
 				   :key midpoint :value (if (< start length)
 							 (elt initial-contents midpoint)
-							 nil)
+							 initial-element)
 				   :left (f start midpoint)
 				   :right (f (1+ midpoint) end))))))
      (f 0 size))))
@@ -32,3 +32,22 @@
 		 amount
 		 (f (bt-right tree) (1+ (bt-key tree))))))
     (f array 0)))
+
+(defun f-array-count (item f-array &key (key #'identity) (test #'eql))
+  (tree-count item f-array 
+	      :key #'(lambda (tree)
+		       (funcall key (bt-value tree))) 
+	      :test test))
+
+(defun f-array-count-if (pred f-array &key (key #'identity))
+  (tree-count-if pred f-array 
+		 :key #'(lambda (tree)
+			  (funcall key (bt-value tree)))))
+
+(defun map-f-array (function f-array)
+  (map-tree #'(lambda (tree)
+		(funcall function (bt-value tree)))
+	    f-array))
+
+(defun f-array-as-list (f-array)
+  (mapcar #'cdr (tree-as-alist f-array)))