From a69c9fb665459e2bfdbda1bf80741a0af31a7faf Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:06:40 -0800 Subject: New upstream version 3b5 --- wttree.scm | 170 +++++++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 110 insertions(+), 60 deletions(-) mode change 100644 => 100755 wttree.scm (limited to 'wttree.scm') diff --git a/wttree.scm b/wttree.scm old mode 100644 new mode 100755 index 43620d6..60f25c3 --- a/wttree.scm +++ b/wttree.scm @@ -1,45 +1,32 @@ ;;; "wttree.scm" Weight balanced trees -*-Scheme-*- -;;; Copyright (c) 1993-1994 Stephen Adams ;;; -;;; References: +;;; $ I d : wttree.scm,v 1.10 1999/01/02 06:19:10 cph Exp $ ;;; -;;; Stephen Adams, Implemeting Sets Efficiently in a Functional -;;; Language, CSTR 92-10, Department of Electronics and Computer -;;; Science, University of Southampton, 1992 +;;; Copyright (c) 1993-1999 Massachusetts Institute of Technology ;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or (at +;;; your option) any later version. ;;; -;;; Copyright (c) 1993-94 Massachusetts Institute of Technology +;;; This program is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. ;;; -;;; This material was developed by the Scheme project at the -;;; Massachusetts Institute of Technology, Department of Electrical -;;; Engineering and Computer Science. Permission to copy and modify -;;; this software, to redistribute either the original software or a -;;; modified version, and to use this software for any purpose is -;;; granted, subject to the following restrictions and understandings. +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; -;;; 1. Any copy made of this software must include this copyright -;;; notice in full. +;;; Copyright (c) 1993-1994 Stephen Adams ;;; -;;; 2. Users of this software agree to make their best efforts (a) to -;;; return to the MIT Scheme project any improvements or extensions -;;; that they make, so that these may be included in future releases; -;;; and (b) to inform MIT of noteworthy uses of this software. +;;; References: ;;; -;;; 3. All materials developed as a consequence of the use of this -;;; software shall duly acknowledge such use, in accordance with the -;;; usual standards of acknowledging credit in academic research. +;;; Stephen Adams, Implemeting Sets Efficiently in a Functional +;;; Language, CSTR 92-10, Department of Electronics and Computer +;;; Science, University of Southampton, 1992 ;;; -;;; 4. MIT has made no warranty or representation that the operation -;;; of this software will be error-free, and MIT is under no -;;; obligation to provide any services, by way of maintenance, update, -;;; or otherwise. ;;; -;;; 5. In conjunction with products arising from the use of this -;;; material, there shall be no use of the name of the Massachusetts -;;; Institute of Technology nor of any adaptation thereof in any -;;; advertising, promotional, or sales literature without prior -;;; written consent from MIT in each case. - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Weight Balanced Binary Trees @@ -88,6 +75,7 @@ (define wt-tree/split< #f) (define wt-tree/split> #f) (define wt-tree/union #f) +(define wt-tree/union-merge #f) (define wt-tree/intersection #f) (define wt-tree/difference #f) (define wt-tree/subset? #f) @@ -103,7 +91,7 @@ (define wt-tree/min-pair #f) (define wt-tree/delete-min #f) (define wt-tree/delete-min! #f) - +(define wt-tree/valid? #f) ;; This LET sets all of the above variables. @@ -141,6 +129,7 @@ ;; (split-lt #F read-only true) ;; (split-gt #F read-only true) ;; (union #F read-only true) + ;; (union-merge #F read-only true) ;; (intersection #F read-only true) ;; (difference #F read-only true) ;; (subset? #F read-only true) @@ -159,14 +148,14 @@ delete delete! member? lookup split-lt split-gt - union intersection - difference subset? - rank ) + union union-merge + intersection difference + subset? rank ) (vector tag:tree-type keytree add insert! delete delete! member? lookup - split-lt split-gt union intersection - difference subset? rank )) + split-lt split-gt union union-merge + intersection difference subset? rank )) (define (tree-type? tt) (and (vector? tt) @@ -183,10 +172,11 @@ (define (tree-type/split-lt tt) (vector-ref tt 9)) (define (tree-type/split-gt tt) (vector-ref tt 10)) (define (tree-type/union tt) (vector-ref tt 11)) - (define (tree-type/intersection tt) (vector-ref tt 12)) - (define (tree-type/difference tt) (vector-ref tt 13)) - (define (tree-type/subset? tt) (vector-ref tt 14)) - (define (tree-type/rank tt) (vector-ref tt 15)) + (define (tree-type/union-merge tt) (vector-ref tt 12)) + (define (tree-type/intersection tt) (vector-ref tt 13)) + (define (tree-type/difference tt) (vector-ref tt 14)) + (define (tree-type/subset? tt) (vector-ref tt 15)) + (define (tree-type/rank tt) (vector-ref tt 16)) ;; User level tree representation. ;; @@ -273,30 +263,31 @@ (n-join a_k a_v x y1) (n-join c_k c_v y2 z))))))) - ;; (define-integrable wt-tree-ratio 5) - (define wt-tree-ratio 5) + ;; (define-integrable wt-tree-delta 3) + (define wt-tree-delta 3) + (define wt-tree-gamma 2) (define (t-join k v l r) (define (simple-join) (n-join k v l r)) - (let ((l_n (node/size l)) - (r_n (node/size r))) - (cond ((fix:< (fix:+ l_n r_n) 2) (simple-join)) - ((fix:> r_n (fix:* wt-tree-ratio l_n)) + (let ((l_n (fix:+ (node/size l) 1)) + (r_n (fix:+ (node/size r) 1))) + (cond ((fix:> r_n (fix:* wt-tree-delta l_n)) ;; right is too big - (let ((r_l_n (node/size (node/l r))) - (r_r_n (node/size (node/r r)))) - (if (fix:< r_l_n r_r_n) + (let ((r_l_n (fix:+ (node/size (node/l r)) 1)) + (r_r_n (fix:+ (node/size (node/r r)) 1))) + (if (fix:< r_l_n (fix:* wt-tree-gamma r_r_n)) (single-l k v l r) (double-l k v l r)))) - ((fix:> l_n (fix:* wt-tree-ratio r_n)) + ((fix:> l_n (fix:* wt-tree-delta r_n)) ;; left is too big - (let ((l_l_n (node/size (node/l l))) - (l_r_n (node/size (node/r l)))) - (if (fix:< l_r_n l_l_n) + (let ((l_l_n (fix:+ (node/size (node/l l)) 1)) + (l_r_n (fix:+ (node/size (node/r l)) 1))) + (if (fix:< l_r_n (fix:* wt-tree-gamma l_l_n)) (single-r k v l r) (double-r k v l r)))) (else (simple-join))))) + ;; ;; Node tree procedures that are independent of key