<> <> <> <> <> <> <> <> <> DIRECTORY Basics USING [Comparison], RedBlackTree; RedBlackTreeImpl: CEDAR MONITOR LOCKS self USING self: Table EXPORTS RedBlackTree SHARES RedBlackTree = BEGIN OPEN RedBlackTree; Comparison: TYPE = Basics.Comparison; RedBlack: TYPE = BOOL; Red: BOOL = TRUE; Black: BOOL = FALSE; DuplicateKey: PUBLIC ERROR = CODE; BadTable: PUBLIC ERROR = CODE; doChecking: BOOL = TRUE; <> <<>> Private: TYPE = REF PrivateRep; PrivateRep: TYPE = RECORD [ size: INT, getKey: GetKey, compare: Compare, y: Node, -- This is a dummy node considered to be less than the least real node z: Node]; -- This is a dummy node considered to be greater than the greatest real node <> <<>> InnerProc: TYPE = PROC [private: Private, y: Node, z: Node, root: Node]; DoInner: ENTRY PROC [self: Table, inner: InnerProc] = TRUSTED { ENABLE UNWIND => NULL; private: Private _ LOOPHOLE[self.private]; root: Node _ self.root; IF root = NIL OR root.rbLLink # NIL THEN RETURN WITH ERROR BadTable; inner[private, private.y, private.z, root]; }; <> Create: PUBLIC PROC [getKey: GetKey, compare: Compare] RETURNS [table: Table] = { private: Private _ NEW[PrivateRep _ [size: 0, getKey: getKey, compare: compare, y: NEW[NodeRep], z: NEW[NodeRep]]]; root: Node _ NEW[NodeRep]; y: Node _ private.y; z: Node _ private.z; table _ NEW[TableRep]; table.root _ root; table.private _ private; root.rbColor _ Black; root.rbLLink _ NIL; root.rbRLink _ z; y.rbColor _ Red; y.rbLLink _ y.rbRLink _ NIL; z.rbColor _ Black; z.rbLLink _ z.rbRLink _ y; }; Size: PUBLIC PROC [self: Table] RETURNS [size: INT _ 0] = { inner: InnerProc = { size _ private.size; }; IF self # NIL THEN DoInner[self, inner]; }; Insert: PUBLIC PROC [self: Table, dataToInsert: UserData, insertKey: Key] = { node: Node _ NEW[NodeRep _ [data: dataToInsert]]; InsertNode[self, node, insertKey]; }; InsertNode: PUBLIC PROC [self: Table, nodeToInsert: Node, insertKey: Key] = { <> keyAlreadyPresent: BOOL _ FALSE; inner: InnerProc = { x, gg, g, f: Node; c: Comparison _ greater; --since actual tree sits in right subtree of header node... <> f _ root; x _ f.rbRLink; DO IF (x.rbLLink.rbColor=Red) AND (x.rbRLink.rbColor=Red) THEN { IF x=z THEN { <> IF c = equal THEN {keyAlreadyPresent _ TRUE; EXIT}; <> x _ nodeToInsert; x.rbLLink _ z; x.rbRLink _ z; IF c = less THEN f.rbLLink _ x ELSE f.rbRLink _ x; c _ equal; private.size _ private.size + 1; }; <> x.rbLLink.rbColor _ Black; x.rbRLink.rbColor _ Black; x.rbColor _ Red; IF f.rbColor=Red THEN { <> g _ Balance[gg, g, f, x]; x _ g; }; }; IF c = equal THEN EXIT; gg _ g; g _ f; f _ x; x _ IF (c _ private.compare[insertKey, x.data]) = less THEN x.rbLLink ELSE x.rbRLink; ENDLOOP; root.rbRLink.rbColor _ Black; --root is always black }; DoInner[self, inner]; IF keyAlreadyPresent THEN ERROR DuplicateKey; }; Delete: PUBLIC PROC[self: Table, deleteKey: Key] RETURNS [deletedNode: Node _ NIL] = { inner: InnerProc = { f, result, parentOfResult: Node; x, g, b: Node; c: Comparison; result _ NIL; f _ root; x _ f.rbRLink; IF x = z THEN RETURN; y.rbColor _ Black; --children of external nodes have no red to contribute to rebalancing. <> IF (x.rbLLink.rbColor = Black) AND (x.rbRLink.rbColor = Black) THEN x.rbColor _ Red; IF (c _ private.compare[deleteKey, x.data]) = equal THEN { result _ x; parentOfResult _ f; }; <> <<(or the node itself if its RLink is z)>> DO { g _ f; f _ x; IF c = less THEN {b _ x.rbRLink; x _ x.rbLLink} ELSE {b _ x.rbLLink; x _ x.rbRLink}; <> IF x # z AND (c _ private.compare[deleteKey, x.data]) = equal THEN { result _ x; parentOfResult _ f; }; <> IF x.rbColor=Red OR x.rbLLink.rbColor=Red OR x.rbRLink.rbColor=Red THEN LOOP; IF b.rbColor=Red THEN { <> IF b = f.rbLLink THEN { f.rbLLink _ b.rbRLink; b.rbRLink _ f; } ELSE { f.rbRLink _ b.rbLLink; b.rbLLink _ f; }; f.rbColor _ Red; b.rbColor _ Black; IF f = g.rbLLink THEN g.rbLLink _ b ELSE g.rbRLink _ b; <> x _ b; GOTO FixCompare; };--IF b.rbColor=Red IF x=z THEN EXIT; <> x.rbColor _ Red; IF b.rbLLink.rbColor = Red THEN { b.rbLLink.rbColor _ Black; x _ Balance[g, f, b, b.rbLLink]; GOTO FixCompare; }; IF b.rbRLink.rbColor = Red THEN { b.rbRLink.rbColor _ Black; x _ Balance[g, f, b, b.rbRLink]; GOTO FixCompare; }; <<"Color flip">> f.rbColor _ Black; b.rbColor _ Red; EXITS FixCompare => c _ private.compare[deleteKey, x.data]; }; ENDLOOP; root.rbRLink.rbColor _ Black; z.rbColor _ Black; y.rbColor _ Red;--undo the color mess <> IF result # NIL THEN { <> IF g.rbLLink = f THEN g.rbLLink _ z ELSE g.rbRLink _ z; <> IF f # result THEN { IF parentOfResult.rbLLink = result THEN parentOfResult.rbLLink _ f ELSE parentOfResult.rbRLink _ f; f.rbLLink _ result.rbLLink; f.rbRLink _ result.rbRLink; f.rbColor _ result.rbColor; }; private.size _ private.size - 1; }; deletedNode _ result; }; DoInner[self, inner]; }; LookupNode: PUBLIC PROC[self: Table, lookupKey: Key] RETURNS [node: Node _ NIL] = { inner: InnerProc = { node _ root.rbRLink; DO IF node = z THEN {node _ NIL; EXIT}; SELECT private.compare[lookupKey, node.data] FROM equal => EXIT; less => node _ node.rbLLink; greater => node _ node.rbRLink; ENDCASE => ERROR; ENDLOOP; }; DoInner[self, inner]; }; Lookup: PUBLIC PROC[self: Table, lookupKey: Key] RETURNS [data: UserData _ NIL] = { inner: InnerProc = { equalNode: Node _ root.rbRLink; DO IF equalNode = z THEN RETURN; SELECT private.compare[lookupKey, equalNode.data] FROM equal => EXIT; less => equalNode _ equalNode.rbLLink; greater => equalNode _ equalNode.rbRLink; ENDCASE => ERROR; ENDLOOP; data _ equalNode.data; }; DoInner[self, inner]; }; Lookup3: PUBLIC PROC[self: Table, lookupKey: Key] RETURNS[leftData, equalData, rightData: UserData _ NIL] = { inner: InnerProc = { equalNode: Node _ root.rbRLink; leftNode: Node _ NIL; rightNode: Node _ NIL; DO IF equalNode = z THEN {equalNode _ NIL; EXIT}; SELECT private.compare[lookupKey, equalNode.data] FROM equal => { IF equalNode.rbLLink # z THEN { leftNode _ equalNode.rbLLink; WHILE leftNode.rbRLink # z DO leftNode _ leftNode.rbRLink ENDLOOP; }; IF equalNode.rbRLink # z THEN { rightNode _ equalNode.rbRLink; WHILE rightNode.rbLLink # z DO rightNode _ rightNode.rbLLink ENDLOOP; }; EXIT; }; less => {rightNode _ equalNode; equalNode _ equalNode.rbLLink}; greater => {leftNode _ equalNode; equalNode _ equalNode.rbRLink;}; ENDCASE => ERROR; ENDLOOP; IF equalNode # NIL THEN equalData _ equalNode.data; IF leftNode # NIL THEN leftData _ leftNode.data; IF rightNode # NIL THEN rightData _ rightNode.data; }; DoInner[self, inner]; }; LookupSmallest: PUBLIC PROC [self: Table] RETURNS [data: UserData _ NIL] = { inner: InnerProc = { smallestNode: Node _ root.rbRLink; IF smallestNode=z THEN RETURN; UNTIL smallestNode.rbLLink=z DO smallestNode _ smallestNode.rbLLink ENDLOOP; data _ smallestNode.data; }; DoInner[self, inner]; }; LookupNextLarger: PUBLIC PROC [self: Table, lookupKey: Key] RETURNS [data: UserData _ NIL] = { inner: InnerProc = { largerNode: Node _ NIL; x: Node _ root.rbRLink; UNTIL x=z DO IF private.compare[lookupKey, x.data] = less THEN {largerNode _ x; x _ x.rbLLink} ELSE x _ x.rbRLink; ENDLOOP; IF largerNode # NIL THEN data _ largerNode.data; }; DoInner[self, inner]; }; LookupLargest: PUBLIC PROC[self: Table] RETURNS [data: UserData _ NIL] = { inner: InnerProc = { largestNode: Node _ root.rbRLink; IF largestNode=z THEN {largestNode _ NIL; RETURN}; UNTIL largestNode.rbRLink=z DO largestNode _ largestNode.rbRLink ENDLOOP; data _ largestNode.data; }; DoInner[self, inner]; }; LookupNextSmaller: PUBLIC PROC [self: Table, lookupKey: Key] RETURNS [data: UserData _ NIL] = { inner: InnerProc = { smallerNode: Node _ NIL; x: Node _ root.rbRLink; UNTIL x=z DO IF private.compare[lookupKey, x.data] = greater THEN { smallerNode _ x; x _ x.rbRLink } ELSE x _ x.rbLLink; ENDLOOP; IF smallerNode # NIL THEN data _ smallerNode.data; }; DoInner[self, inner]; }; DestroyTable: PUBLIC PROC [self: Table] = { inner: InnerProc = { new: Table _ Create[private.getKey, private.compare]; self.private _ new.private; self.root _ new.root; }; DoInner[self, inner]; }; EnumerateIncreasing: PUBLIC PROC [self: Table, procToApply: EachNode] = { <> inner: InnerProc = { VisitSubtree: PROC [node: Node] RETURNS [stop: BOOL _ FALSE] = { <> IF node.rbLLink # z AND VisitSubtree[node.rbLLink] THEN RETURN [TRUE]; IF procToApply[node.data] THEN RETURN [TRUE]; IF node.rbRLink # z THEN RETURN [VisitSubtree[node.rbRLink]]; }; IF root = NIL THEN RETURN; IF root.rbRLink = z THEN RETURN; [] _ VisitSubtree[root.rbRLink]; }; DoInner[self, inner]; }; EnumerateDecreasing: PUBLIC PROC [self: Table, procToApply: EachNode] = { <> inner: InnerProc = { VisitSubtree: PROC [node: Node] RETURNS [stop: BOOL _ FALSE] = { <> IF node.rbRLink # y AND VisitSubtree[node.rbRLink] THEN RETURN [TRUE]; IF procToApply[node.data] THEN RETURN [TRUE]; IF node.rbLLink # y THEN RETURN [VisitSubtree[node.rbLLink]]; }; IF root = NIL THEN RETURN; IF root.rbRLink = y THEN RETURN; [] _ VisitSubtree[root.rbRLink]; }; DoInner[self, inner]; }; CheckTable: PUBLIC PROC [self: Table] = { <> inner: InnerProc = { Assert: PROC [p: BOOL] = {IF NOT p THEN ERROR BadTable }; Check1: PROC [x: Node, maxKey: Key] RETURNS [Key, INTEGER, BOOL] = { <> dl, dr: INTEGER; redChild: BOOL; IF x = z THEN RETURN[maxKey, 0, FALSE]; [maxKey, dl, redChild] _ Check1[x.rbLLink, maxKey]; Assert[~(redChild AND (x.rbColor=Red))]; Assert[private.compare[maxKey,x.data] = (IF count=0 THEN equal ELSE less)]; count _ count + 1; [maxKey, dr, redChild] _ Check1[x.rbRLink, private.getKey[x.data]]; Assert[~(redChild AND (x.rbColor=Red))]; Assert[dl=dr]; RETURN[maxKey, dl+(IF x.rbColor=Black THEN 1 ELSE 0), x.rbColor=Red]; };--Check1 count: LONG INTEGER _ 0; <> Assert[z.rbLLink=y]; Assert[z.rbRLink=y]; <> IF root.rbRLink # z THEN { smallest: Node _ root.rbRLink; UNTIL smallest.rbLLink=z DO smallest _ smallest.rbLLink ENDLOOP; [] _ Check1[root.rbRLink, private.getKey[smallest.data]]; }; }; DoInner[self, inner]; }; <> Balance: PROC [gg, g, f, x: Node] RETURNS [Node] = { <> <> < f -rlink-> x, or x <-llink- f <-llink- g, then only a single rotation is needed; otherwise two rotations are used. when called from insert, g is black and both f and x are red. after rebalancing, the new g is black, and is the parent of both the new f and the new x, which are both red.>> t: Node; tc: RedBlack; <> IF f=g.rbLLink THEN { IF x=f.rbRLink THEN { f.rbRLink _ x.rbLLink; x.rbLLink _ f; t _ f; f _ x; x _ t; }; } ELSE { IF x=f.rbLLink THEN { f.rbLLink _ x.rbRLink; x.rbRLink _ f; t _ f; f _ x; x _ t; }; }; <> IF x=f.rbLLink THEN { g.rbLLink _ f.rbRLink; f.rbRLink _ g; } ELSE { g.rbRLink _ f.rbLLink; f.rbLLink _ g; }; <> IF g = gg.rbRLink THEN gg.rbRLink _ f ELSE gg.rbLLink _ f; <> tc _ g.rbColor; g.rbColor _ f.rbColor; f.rbColor _ tc; <> RETURN[f] }; END. CHANGE LOG Created by MBrown on January 18, 1980 10:58 AM <> Changed by MBrown on January 19, 1980 8:50 PM <> <> <> Changed by MBrown on 20-Jan-80 13:28 <> <<"swap g and f" since only g is returned from Balance.>> Changed by MBrown on March 4, 1980 2:17 PM <> Changed by MBrown on April 13, 1980 4:21 PM <> <> Changed by MBrown on April 13, 1980 6:01 PM <> <> <> Changed by MBrown on May 1, 1980 10:03 PM <> <> <> Changed by MBrown on May 7, 1980 6:36 PM <> <> Changed by MBrown on August 11, 1980 10:17 PM <> <> <> <> <> <> <> <> <> <> <> <> Changed by MBrown on October 29, 1980 8:42 PM <> Changed by MBrown on January 7, 1981 9:47 PM <> Changed by MBrown on March 1, 1982 3:30 pm <> <> <> <> <> <<(1) use < and = instead of 3-way compares.>> <<(2) use object monitor (requires replicating z and y per-table), or no monitor.>> <<(3) Table and Node are different types (this is required for object monitor, to hold y and z.)>> Changed by MBrown on March 2, 1982 4:20 pm <> Changed by MBrown on June 28, 1982 11:12 am <> Changed by MBrown on August 26, 1982 11:11 pm <> Changed by MBrown on November 10, 1982 6:34 pm <> Changed by MBrown on October 20, 1983 11:38 pm <> <<>> <> <> <<>>