<<>> <> <> <> <> <> <> <> <> <> <> 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 that is at both links of z z: Node]; -- This is a dummy node used as the child of leaf (external) nodes <> <<>> 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; c ¬ private.compare[insertKey, x.data]; IF c = equal THEN {keyAlreadyPresent ¬ TRUE; EXIT}; x ¬ IF c = 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] = { link: Node ¬ node.rbLLink; IF link # z AND VisitSubtree[link] THEN RETURN [TRUE]; IF procToApply[node.data] THEN RETURN [TRUE]; link ¬ node.rbRLink; IF link # z THEN RETURN [VisitSubtree[link]]; }; IF root = NIL OR 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] = { link: Node ¬ node.rbRLink; IF link # z AND VisitSubtree[link] THEN RETURN [TRUE]; IF procToApply[node.data] THEN RETURN [TRUE]; link ¬ node.rbLLink; IF link # z THEN RETURN [VisitSubtree[link]]; }; IF root = NIL OR root.rbRLink = z 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]; }; count: INT ¬ 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 <> <<>> <> <> <> <> <<>>