diff options
| author |  Peter McGoron
| 2025-02-15 19:19:23 -0500 |
|---|---|---|
| committer | Peter McGoron
| 2025-02-15 19:19:23 -0500 |
| commit | 219b161b96bcca708ee5e431c14fb453c0b593a2 (patch) | |
| tree | 90a1034690b387ad9332086f56cd90a03a802d70 | |
| parent | node->in-order-generator (diff) | |
node->reverse-order-generator
| -rw-r--r-- | doc/mcgoron.weight-balanced-trees.internal.scm | 8 | ||||
| -rw-r--r-- | mcgoron/weight-balanced-trees/internal.scm | 24 | ||||
| -rw-r--r-- | mcgoron/weight-balanced-trees/internal.sld | 3 | ||||
| -rw-r--r-- | tests/run.scm | 10 |
4 files changed, 37 insertions, 8 deletions
diff --git a/doc/mcgoron.weight-balanced-trees.internal.scm b/doc/mcgoron.weight-balanced-trees.internal.scm index e3293c0..07eacc1 100644 --- a/doc/mcgoron.weight-balanced-trees.internal.scm +++ b/doc/mcgoron.weight-balanced-trees.internal.scm @@ -176,4 +176,10 @@ of `generator`.")) lambda ((balanced? node)) generator?) (desc " Returns a generator (see SRFI-158) that generates the elements of `node` -in increasing order.")))
\ No newline at end of file +in increasing order.")) + ((name . "node->reverse-order-generator") + (signature + lambda ((balanced? node)) generator?) + (desc " +Returns a generator (see SRFI-158) that generates the elements of `node` +in decreasing order.")))
\ No newline at end of file diff --git a/mcgoron/weight-balanced-trees/internal.scm b/mcgoron/weight-balanced-trees/internal.scm index e479649..35a25bb 100644 --- a/mcgoron/weight-balanced-trees/internal.scm +++ b/mcgoron/weight-balanced-trees/internal.scm @@ -436,17 +436,29 @@ node (loop (insert comparator node value)))))) -(: node->in-order-generator (node-type -> (-> *))) -(define (node->in-order-generator node) +(: node->directed-generator (node-type + ((struct <wb-tree>) -> node-type) + ((struct <wb-tree>) -> node-type) + -> + (-> *))) +(define (node->directed-generator node direction inverse-direction) (let ((queue (list-queue))) - (define (traverse-left! node) + (define (traverse! node) (when (not (null? node)) (list-queue-add-front! queue node) - (traverse-left! (get-left node)))) - (traverse-left! node) + (traverse! (direction node)))) + (traverse! node) (lambda () (if (list-queue-empty? queue) (eof-object) (let ((current (list-queue-remove-front! queue))) - (traverse-left! (get-right current)) + (traverse! (inverse-direction current)) (get-data current)))))) + +(: node->in-order-generator (node-type -> (-> *))) +(define (node->in-order-generator node) + (node->directed-generator node get-left get-right)) + +(: node->reverse-order-generator (node-type -> (-> *))) +(define (node->reverse-order-generator node) + (node->directed-generator node get-right get-left)) diff --git a/mcgoron/weight-balanced-trees/internal.sld b/mcgoron/weight-balanced-trees/internal.sld index 930daf9..5d99d0c 100644 --- a/mcgoron/weight-balanced-trees/internal.sld +++ b/mcgoron/weight-balanced-trees/internal.sld @@ -37,6 +37,7 @@ union intersection difference xor update insert delete every - node->generator generator->node node->in-order-generator) + node->generator generator->node + node->in-order-generator node->reverse-order-generator) (include "internal.scm")) diff --git a/tests/run.scm b/tests/run.scm index a06f98d..6aabe8e 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -565,3 +565,13 @@ (test-property node->in-order-generator-works (list (list-generator-of (exact-integer-generator))))) +(test-group "node->reverse-order-generator" + (define (node->reverse-order-generator-works lst) + (let* ((node (fold insert '() lst)) + (result-lst (generator->list + (node->reverse-order-generator node)))) + (and (lset= = lst result-lst) + (list-sorted? > result-lst)))) + (test-property node->reverse-order-generator-works + (list (list-generator-of (exact-integer-generator))))) + |