diff options
| author |  Peter McGoron
| 2025-02-15 19:08:42 -0500 |
|---|---|---|
| committer | Peter McGoron
| 2025-02-15 19:08:42 -0500 |
| commit | a76207a6735f03e1ae5cb5746b38b6321a9c5788 (patch) | |
| tree | 132b2a10b4ab1092357cd1f13b3197bca52c969a | |
| parent | generator->node (diff) | |
node->in-order-generator
| -rw-r--r-- | doc/mcgoron.weight-balanced-trees.internal.scm | 8 | ||||
| -rw-r--r-- | mcgoron/weight-balanced-trees/internal.scm | 5 | ||||
| -rw-r--r-- | mcgoron/weight-balanced-trees/internal.sld | 2 | ||||
| -rw-r--r-- | tests/run.scm | 10 |
4 files changed, 22 insertions, 3 deletions
diff --git a/doc/mcgoron.weight-balanced-trees.internal.scm b/doc/mcgoron.weight-balanced-trees.internal.scm index ac3b921..e3293c0 100644 --- a/doc/mcgoron.weight-balanced-trees.internal.scm +++ b/doc/mcgoron.weight-balanced-trees.internal.scm @@ -170,4 +170,10 @@ in arbitrary order.")) by `cmp`. Returns a weight balanced tree whose elements are all of the elements -of `generator`.")))
\ No newline at end of file +of `generator`.")) + ((name . "node->in-order-generator") + (signature + 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 diff --git a/mcgoron/weight-balanced-trees/internal.scm b/mcgoron/weight-balanced-trees/internal.scm index ffbe6b4..e479649 100644 --- a/mcgoron/weight-balanced-trees/internal.scm +++ b/mcgoron/weight-balanced-trees/internal.scm @@ -413,6 +413,7 @@ ;;; Generators ;;; ;;;;;;;;;;;;;;;;;;; +(: node->generator (node-type -> (-> *))) (define (node->generator node) (let ((queue (list-queue))) (define (add-when-not-null! node) @@ -427,6 +428,7 @@ (add-when-not-null! (get-right current-node)) (get-data current-node)))))) +(: generator->node (* (-> *) -> node-type)) (define (generator->node comparator gen) (let loop ((node '())) (let ((value (gen))) @@ -434,11 +436,12 @@ node (loop (insert comparator node value)))))) +(: node->in-order-generator (node-type -> (-> *))) (define (node->in-order-generator node) (let ((queue (list-queue))) (define (traverse-left! node) (when (not (null? node)) - (list-queue-add-front! node) + (list-queue-add-front! queue node) (traverse-left! (get-left node)))) (traverse-left! node) (lambda () diff --git a/mcgoron/weight-balanced-trees/internal.sld b/mcgoron/weight-balanced-trees/internal.sld index 0676e81..930daf9 100644 --- a/mcgoron/weight-balanced-trees/internal.sld +++ b/mcgoron/weight-balanced-trees/internal.sld @@ -37,6 +37,6 @@ union intersection difference xor update insert delete every - node->generator generator->node) + node->generator generator->node node->in-order-generator) (include "internal.scm")) diff --git a/tests/run.scm b/tests/run.scm index 81c5a86..a06f98d 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -555,3 +555,13 @@ (test-property generator->node-works (list (list-generator-of (exact-integer-generator))))) +(test-group "node->in-order-generator" + (define (node->in-order-generator-works lst) + (let* ((node (fold insert '() lst)) + (result-lst (generator->list + (node->in-order-generator node)))) + (and (lset= = lst result-lst) + (list-sorted? < result-lst)))) + (test-property node->in-order-generator-works + (list (list-generator-of (exact-integer-generator))))) + |