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)))