From: Chris Hanson Date: Mon, 4 May 1998 18:43:39 +0000 (+0000) Subject: Add operations to read or delete the min/max elements of a tree. X-Git-Tag: 20090517-FFI~4799 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=639c190035227421724fb863f90850874c7f7ac4;p=mit-scheme.git Add operations to read or delete the min/max elements of a tree. --- diff --git a/v7/src/runtime/rbtree.scm b/v7/src/runtime/rbtree.scm index 557fac073..197093d95 100644 --- a/v7/src/runtime/rbtree.scm +++ b/v7/src/runtime/rbtree.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rbtree.scm,v 1.4 1993/10/08 09:03:43 cph Exp $ +$Id: rbtree.scm,v 1.5 1998/05/04 18:43:25 cph Exp $ -Copyright (c) 1993 Massachusetts Institute of Technology +Copyright (c) 1993-98 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -309,7 +309,7 @@ MIT in each case. |# (guarantee-rb-tree y 'RB-TREE/EQUAL?) (let ((key=? (tree-key=? x))) (and (eq? key=? (tree-key=? y)) - (let loop ((nx (first-node x)) (ny (first-node y))) + (let loop ((nx (min-node x)) (ny (min-node y))) (if (not nx) (not ny) (and ny @@ -319,7 +319,7 @@ MIT in each case. |# (define (rb-tree->alist tree) (guarantee-rb-tree tree 'RB-TREE->ALIST) - (let ((node (first-node tree))) + (let ((node (min-node tree))) (if node (let ((result (list (cons (node-key node) (node-datum node))))) (let loop ((node (next-node node)) (prev result)) @@ -332,7 +332,7 @@ MIT in each case. |# (define (rb-tree/key-list tree) (guarantee-rb-tree tree 'RB-TREE/KEY-LIST) - (let ((node (first-node tree))) + (let ((node (min-node tree))) (if node (let ((result (list (node-key node)))) (let loop ((node (next-node node)) (prev result)) @@ -345,7 +345,7 @@ MIT in each case. |# (define (rb-tree/datum-list tree) (guarantee-rb-tree tree 'RB-TREE/DATUM-LIST) - (let ((node (first-node tree))) + (let ((node (min-node tree))) (if node (let ((result (list (node-datum node)))) (let loop ((node (next-node node)) (prev result)) @@ -355,14 +355,113 @@ MIT in each case. |# (loop (next-node node) pair)))) result) '()))) + +(define (rb-tree/min tree default) + (guarantee-rb-tree tree 'RB-TREE/MIN) + (let ((node (min-node tree))) + (if node + (node-key node) + default))) -(define (first-node tree) +(define (rb-tree/min-datum tree default) + (guarantee-rb-tree tree 'RB-TREE/MIN-DATUM) + (let ((node (min-node tree))) + (if node + (node-datum node) + default))) + +(define (rb-tree/min-pair tree) + (guarantee-rb-tree tree 'RB-TREE/MIN-PAIR) + (let ((node (min-node tree))) + (and node + (node-pair node)))) + +(define (rb-tree/delete-min! tree default) + (guarantee-rb-tree tree 'RB-TREE/DELETE-MIN!) + (let ((node (min-node tree))) + (if node + (let ((key (node-key node))) + (delete-node! tree node) + key) + default))) + +(define (rb-tree/delete-min-datum! tree default) + (guarantee-rb-tree tree 'RB-TREE/DELETE-MIN-DATUM!) + (let ((node (min-node tree))) + (if node + (let ((datum (node-datum node))) + (delete-node! tree node) + datum) + default))) + +(define (rb-tree/delete-min-pair! tree) + (guarantee-rb-tree tree 'RB-TREE/DELETE-MIN-PAIR!) + (let ((node (min-node tree))) + (and node + (let ((pair (node-pair node))) + (delete-node! tree node) + pair)))) + +(define (rb-tree/max tree default) + (guarantee-rb-tree tree 'RB-TREE/MAX) + (let ((node (max-node tree))) + (if node + (node-key node) + default))) + +(define (rb-tree/max-datum tree default) + (guarantee-rb-tree tree 'RB-TREE/MAX-DATUM) + (let ((node (max-node tree))) + (if node + (node-datum node) + default))) + +(define (rb-tree/max-pair tree) + (guarantee-rb-tree tree 'RB-TREE/MAX-PAIR) + (let ((node (max-node tree))) + (and node + (node-pair node)))) + +(define (rb-tree/delete-max! tree default) + (guarantee-rb-tree tree 'RB-TREE/DELETE-MAX!) + (let ((node (max-node tree))) + (if node + (let ((key (node-key node))) + (delete-node! tree node) + key) + default))) + +(define (rb-tree/delete-max-datum! tree default) + (guarantee-rb-tree tree 'RB-TREE/DELETE-MAX-DATUM!) + (let ((node (max-node tree))) + (if node + (let ((datum (node-datum node))) + (delete-node! tree node) + datum) + default))) + +(define (rb-tree/delete-max-pair! tree) + (guarantee-rb-tree tree 'RB-TREE/DELETE-MAX-PAIR!) + (let ((node (max-node tree))) + (and node + (let ((pair (node-pair node))) + (delete-node! tree node) + pair)))) + +(define (min-node tree) (and (tree-root tree) (let loop ((x (tree-root tree))) (if (node-left x) (loop (node-left x)) x)))) +(define (max-node tree) + (and (tree-root tree) + (let loop ((x (tree-root tree))) + (if (node-right x) + (loop (node-right x)) + x)))) + (define (next-node x) (if (node-right x) (let loop ((x (node-right x))) @@ -373,4 +472,7 @@ MIT in each case. |# (let ((y (node-up x))) (if (and y (eq? x (node-right y))) (loop y) - y))))) \ No newline at end of file + y))))) + +(define-integrable (node-pair node) + (cons (node-key node) (node-datum node))) \ No newline at end of file diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index ff50d5ad0..38a6d6aae 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.298 1998/04/30 21:28:17 cph Exp $ +$Id: runtime.pkg,v 14.299 1998/05/04 18:43:39 cph Exp $ Copyright (c) 1988-98 Massachusetts Institute of Technology @@ -3262,19 +3262,31 @@ MIT in each case. |# (parent ()) (export () alist->rb-tree + make-rb-tree rb-tree->alist rb-tree/copy rb-tree/datum-list rb-tree/delete! + rb-tree/delete-max! + rb-tree/delete-max-datum! + rb-tree/delete-max-pair! + rb-tree/delete-min! + rb-tree/delete-min-datum! + rb-tree/delete-min-pair! rb-tree/empty? rb-tree/equal? rb-tree/height rb-tree/insert! rb-tree/key-list rb-tree/lookup + rb-tree/max + rb-tree/max-datum + rb-tree/max-pair + rb-tree/min + rb-tree/min-datum + rb-tree/min-pair rb-tree/size - rb-tree? - make-rb-tree)) + rb-tree?)) (define-package (runtime wt-tree) (file-case options diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 0e21ce033..11c458b2e 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.304 1998/04/30 21:28:23 cph Exp $ +$Id: runtime.pkg,v 14.305 1998/05/04 18:43:32 cph Exp $ Copyright (c) 1988-98 Massachusetts Institute of Technology @@ -3266,19 +3266,31 @@ MIT in each case. |# (parent ()) (export () alist->rb-tree + make-rb-tree rb-tree->alist rb-tree/copy rb-tree/datum-list rb-tree/delete! + rb-tree/delete-max! + rb-tree/delete-max-datum! + rb-tree/delete-max-pair! + rb-tree/delete-min! + rb-tree/delete-min-datum! + rb-tree/delete-min-pair! rb-tree/empty? rb-tree/equal? rb-tree/height rb-tree/insert! rb-tree/key-list rb-tree/lookup + rb-tree/max + rb-tree/max-datum + rb-tree/max-pair + rb-tree/min + rb-tree/min-datum + rb-tree/min-pair rb-tree/size - rb-tree? - make-rb-tree)) + rb-tree?)) (define-package (runtime wt-tree) (file-case options