Add WBTREE-CORRELATE and WBTREE-TEST

Author: deterministic-arts

.gitignore

@@ -0,0 +1 @@
+.DS_Store

README.md

@@ -109,6 +109,12 @@ a specialized comparison predicate for the actual key type.
   - **Function** `wbtreep object` => `boolean` 
 
     Answers true, if `object` is a `wbtree` instance, and false otherwise
+    
+  - **Function** `wbtree-test` => `function`
+  
+    Answers the binary predicate function that controls the tree structure. The result
+    is a function value and matches whatever was specified as the tree type's `:test`
+    function when it was defined
 
   - **Function** `wbtree-empty-p tree` => `boolean` 
 
@@ -274,6 +280,8 @@ a specialized comparison predicate for the actual key type.
     or less than value `start`, and will stop before reaching any node, 
     whose key is equal to or less than the given `end`. If no `end` is 
     supplied, the traversal stops after all nodes have been visited.
+    
+  - **Function** `wbtree-correlate function tree1 tree2 &key test direction` => unspecific 
 
   - **Function** `wbtree-difference tree1 tree2` => `new-tree` 
   - **Function** `wbtree-union tree1 tree2 &key combiner` => `new-tree` 

src/wbtree/implementation.lisp

@@ -84,6 +84,8 @@
   "Answers the number of valid key/value pairs contained in `tree'"
   (node-count node))
 
+(defgeneric wbtree-test (object))
+
 (defun wbtree-node-value (node)
   "Obtains the value associated with `node'. If `node' is the empty
    tree, raises a condition of type `simple-error'."
@@ -1011,6 +1013,9 @@
            (defmethod wbtree-rebalance ((,tree-var ,name))
              (wbtree-rebalance-1 ,tree-var #',node-constructor ,empty-node))
 
+           (defmethod wbtree-test ((,tree-var ,name))
+             (declare (ignore ,tree-var)) #',lessp-function)
+
            (defmethod make-load-form ((,tree-var ,name) &optional environment)
              (declare (ignore environment))
              (wbtree-load-form ,tree-var ',node-constructor ',empty-node))
@@ -1054,3 +1059,43 @@
                      ,setter
                      ,value-temp)
                   `(wbtree-find ,key-temp ,getter ,@(when have-default (list default-temp))))))))
+
+
+(defun wbtree-correlate (function tree1 tree2
+                         &key test (direction :forward))
+  (let* ((predicate (or test (wbtree-test tree1)))
+         (test (if (eq direction :forward) predicate (lambda (o1 o2) (funcall predicate o2 o1))))
+         (iter1 (wbtree-iterator tree1 :direction direction))
+         (iter2 (wbtree-iterator tree2 :direction direction))
+         (node1 (funcall iter1))
+         (node2 (funcall iter2)))
+    (loop
+      while (and node1 node2)
+      do (let ((key1 (wbtree-node-key node1))
+               (key2 (wbtree-node-key node2)))
+           (cond
+             ((funcall test key1 key2)
+              (funcall function node1 nil)
+              (setf node1 (funcall iter1)))
+             ((funcall test key2 key1)
+              (funcall function nil node2)
+              (setf node2 (funcall iter2)))
+             (t
+              (funcall function node1 node2)
+              (setf node1 (funcall iter1))
+              (setf node2 (funcall iter2))))))
+    (loop
+      while node1
+      do (funcall function node1 nil)
+         (setf node1 (funcall iter1)))
+    (loop
+      while node2
+      do (funcall function nil node2)
+         (setf node2 (funcall iter2)))))
+
+(defmacro do-correlated-wbtree-nodes (((bind1 tree1) (bind2 tree2) &rest options) &body body)
+  `(block nil
+     (wbtree-correlate (lambda (,bind1 ,bind2) ,@body)
+                         ,tree1 ,tree2
+                         ,@options)))
+                                             

src/wbtree/package.lisp

@@ -30,7 +30,8 @@
            #:wbtree-iterator #:wbtree-equal #:define-wbtree #:wbtree-lower-boundary-node
            #:wbtree-upper-boundary-node #:wbtree-check-invariants #:wbtree-rebalance
            #:wbtree-fold #:wbtree-minimum-node #:wbtree-maximum-node #:wbtree-ceiling-node
-           #:wbtree-floor-node #:do-wbtree)
+           #:wbtree-floor-node #:do-wbtree #:wbtree-test #:wbtree-correlate
+           #:do-correlated-wbtree-nodes)
   (:documentation "Generalized weight-balanced binary search trees. This
 package provides a variant of the weight-balanced binary trees implemented
 in package DARTS.LIB.PTREE. The variant exposed here can be used with arbitrary