PrioritySearchRefImpl:
CEDAR
PROGRAM
IMPORTS Basics, SafeStorage
EXPORTS PrioritySearchRef =
BEGIN OPEN PrioritySearchRef;
systemZone: ZONE = SafeStorage.GetSystemZone[];
Priority search trees are a one-and-a-half-dimensional search structure discovered by your humble servant and described in the SIAM Journal on Computing, volume 14, number 2, (May, 1985), pp 257-276. This module implements the simpler radix form of priority search trees, and uses Cedar's runtime type machinery to maintain trees containing different types of items.
Tree: TYPE = REF TreeObject ← NIL;
TreeObject:
PUBLIC
TYPE =
RECORD [
zone: ZONE,
prefix: PROC [ Item, Item ] RETURNS[ RadixIndex ],
treeHalf: PROC [ Item, RadixIndex ] RETURNS [ Half ],
depth: PROC [ Item, Item ] RETURNS [ Basics.Comparison ],
count: INT ← 0,
root: REF Internal
];
Internal:
TYPE =
RECORD [
This priority search tree is a kind of Patricia tree (see Knuth v. 3 p. 490). treeHalf[0..prefix) of all Items in this subtree must match each other and that of item. lower vs upper half is determined by treeHalf[prefix]. Of all Items meeting these criteria, a minimum under the depth order appears in item.
item: Item ← NIL,
prefix: RadixIndex,
halves: ARRAY Half OF REF ← ALL[NIL] -- {Item or REF Internal}
];
Create:
PUBLIC
PROC [ prefix:
PROC [ Item, Item ]
RETURNS [ RadixIndex ],
treeHalf: PROC [ Item, RadixIndex ] RETURNS [ Half ],
depth: PROC [ Item, Item ] RETURNS [ Basics.Comparison ],
nodeZone, treeZone: ZONE ← NIL ] RETURNS [ Tree ] =
BEGIN
IF nodeZone=NIL THEN nodeZone ← systemZone;
IF treeZone=NIL THEN treeZone ← systemZone;
RETURN[treeZone.
NEW[TreeObject ←
[prefix: prefix,
treeHalf: treeHalf,
depth: depth,
zone: nodeZone,
root: nodeZone.NEW[Internal ← [prefix: 0]]]]];
END;
Destroy:
PUBLIC
PROC [ tree: Tree ]
RETURNS [ Tree ] =
BEGIN
t: REF TreeObject = NARROW[tree];
RETURN[NIL];
END; -- of Destroy
Size:
PUBLIC
PROC [ tree: Tree ]
RETURNS [
INT ] =
BEGIN
t: REF TreeObject = NARROW[tree];
RETURN[t.count];
END;
Insert:
PUBLIC
PROC [ tree: Tree, item: Item ]
RETURNS [ rejectedDuplicate:
BOOL ] =
BEGIN
t: REF TreeObject = NARROW[tree];
prior: REF Internal ← t.root;
half: Half ← lower;
p: REF ← prior.halves[half];
IF checkTree THEN Check[tree];
WHILE p#
NIL
DO
prefix: RadixIndex;
WITH p
SELECT
FROM
internal:
REF Internal =>
BEGIN
prefix ← t.prefix[item, internal.item];
IF prefix<internal.prefix
THEN
a new internal node must be placed above internal
BEGIN
prior.halves[half] ← t.zone.
NEW[Internal ←
[prefix: prefix,
halves: (
IF t.treeHalf[item, prefix]=lower
THEN [lower: item, upper: internal]
ELSE [lower: internal, upper: item])]];
RefillItem[t, prior, half];
EXIT;
END
ELSE
-- item and internal.item match in first internal.prefix bits
BEGIN
IF prefix=equal THEN RETURN[TRUE]; -- duplicate
IF t.depth[item, internal.item]=less
THEN
BEGIN -- exchange item with internal.item
t: Item ← internal.item; internal.item ← item; item ← t;
END;
prior ← internal;
half ← t.treeHalf[item, internal.prefix];
p ← internal.halves[half];
END;
END;
ENDCASE =>
-- must be an Item
BEGIN
prefix ← t.prefix[item, p];
IF prefix=equal THEN RETURN[TRUE]; -- duplicate
IF t.depth[item, p]=less
THEN
BEGIN -- exchange p with internal.item
t: Item ← p; p ← item; item ← t;
END;
prior.halves[half] ← t.zone.
NEW[Internal ←
[item: p,
prefix: prefix,
halves: (
IF t.treeHalf[item, prefix]=lower
THEN [lower: item, upper:
NIL]
ELSE [lower: NIL, upper: item])]];
EXIT;
END;
REPEAT
FINISHED => prior.halves[half] ← item;
ENDLOOP;
t.count ← t.count+1;
IF checkTree THEN Check[tree];
RETURN[FALSE];
END; -- of Insert
CouldntDelete: PUBLIC ERROR = CODE;
Delete:
PUBLIC
PROC [ tree: Tree, item: Item ] =
BEGIN
t: REF TreeObject ← NARROW[tree];
prior: REF Internal ← t.root;
half: Half ← lower;
p: REF ← prior.halves[half];
IF checkTree THEN CheckPST[p];
WHILE p#
NIL
DO
WITH p
SELECT
FROM
internal:
REF Internal =>
BEGIN
IF item=internal.item
THEN
BEGIN
RefillItem[t, prior, half];
EXIT;
END
ELSE
BEGIN
prior ← internal;
half ← t.treeHalf[item, internal.prefix];
p ← internal.halves[half];
END;
END;
ENDCASE =>
IF item=p
THEN
BEGIN
prior.halves[half] ← NIL;
EXIT;
END
ELSE ERROR CouldntDelete;
REPEAT
FINISHED => ERROR CouldntDelete;
ENDLOOP;
t.count ← t.count-1;
IF checkTree THEN CheckPST[p];
END; -- of Delete
RefillItem:
PROC [ t:
REF TreeObject, prior:
REF Internal, half: Half ] =
BEGIN -- assumes prior#NIL
p: REF ← prior.halves[half];
DO
WITH p
SELECT
FROM
internal:
REF Internal =>
SELECT
TRUE
FROM
internal.halves[lower]=NIL => {prior.halves[half] ← internal.halves[upper]; EXIT};
internal.halves[upper]=NIL => {prior.halves[half] ← internal.halves[lower]; EXIT};
ENDCASE =>
BEGIN
lowerItem: Item ←
(
WITH internal.halves[lower]
SELECT
FROM
lowerInternal: REF Internal => lowerInternal.item,
ENDCASE => internal.halves[lower]);
upperItem: Item ←
(
WITH internal.halves[upper]
SELECT
FROM
upperInternal: REF Internal => upperInternal.item,
ENDCASE => internal.halves[upper]);
IF t.depth[lowerItem, upperItem]=less
THEN
BEGIN
internal.item ← lowerItem;
half ← lower;
END
ELSE
BEGIN
internal.item ← upperItem;
half ← upper;
END;
prior ← internal;
p ← internal.halves[half];
END;
ENDCASE => {prior.halves[half] ← NIL; EXIT};
ENDLOOP;
END; -- of RefillItem
Check:
PUBLIC
PROC [ tree: Tree, itemProc:
UNSAFE
PROC[Item] ←
NIL ] =
TRUSTED BEGIN
InternalCheck:
PROC [ p:
REF, half: Half, item: Item, prefix:
INT ] =
TRUSTED BEGIN
IF p#
NIL
THEN
BEGIN
count ← count+1;
WITH p
SELECT
FROM
internal:
REF Internal =>
BEGIN
IF internal.prefix<=prefix
OR
(0<=prefix
AND
(t.prefix[internal.item, item]<prefix OR
t.treeHalf[internal.item, prefix]#half)) THEN ERROR Malformed;
IF itemProc#NIL THEN itemProc[internal.item];
InternalCheck[internal.halves[lower], lower, internal.item, internal.prefix];
InternalCheck[internal.halves[upper], upper, internal.item, internal.prefix];
END;
ENDCASE =>
BEGIN
IF 0<=prefix
AND
(t.prefix[p, item]<prefix OR t.treeHalf[p, prefix]#half) THEN
ERROR Malformed;
IF itemProc#NIL THEN itemProc[p];
END;
END;
END; -- of InternalCheck
t: REF TreeObject = NARROW[tree];
count: INT ← 0;
InternalCheck[t.root.halves[lower], lower, NIL, -1];
IF t.count#count THEN ERROR Malformed;
END; -- of Check
Malformed: PUBLIC ERROR = CODE;
Search:
PUBLIC
PROC [ tree: Tree, deepestItem, lowermostItem, uppermostItem: Item, touch:
UNSAFE
PROC [ Item ] ] =
BEGIN
enumerates in arbitrary order those items i in the tree such that
a) depth[i, deepestItem]#greater, and
b) treeHalf[i, prefix[lowermostItem, i]]=upper
c) treeHalf[i, prefix[uppermostItem, i]]=lower
InternalSearch:
PROC [ p:
REF ] =
TRUSTED BEGIN
WHILE p#
NIL
DO
WITH p
SELECT
FROM
internal:
REF Internal =>
IF t.depth[internal.item, deepestItem]#greater
THEN
BEGIN
i: Item = internal.item;
lPrefix, uPrefix: RadixIndex;
IF ((lPrefix ← t.prefix[i, lowermostItem])<internal.prefix AND t.treeHalf[i, lPrefix]=lower) OR
((uPrefix ← t.prefix[i, uppermostItem])<internal.prefix AND t.treeHalf[i, uPrefix]=upper) THEN EXIT
ELSE
BEGIN
IF t.treeHalf[i, t.prefix[i, lowermostItem]]=upper
AND
t.treeHalf[i, t.prefix[i, uppermostItem]]=lower
THEN
touch[i];
IF (lPrefix<internal.prefix
-- AND t.treeHalf[
lowermostItem
, prefix]=lower -- )
OR
t.treeHalf[lowermostItem, internal.prefix]=lower THEN
InternalSearch[internal.halves[lower]];
p ← internal.halves[upper];
END;
END
ELSE EXIT;
ENDCASE =>
-- an Item
BEGIN
IF t.depth[p, deepestItem]#greater
AND
t.treeHalf[p, t.prefix[p, lowermostItem]]=upper AND
t.treeHalf[p, t.prefix[p, uppermostItem]]=lower THEN touch[p];
EXIT;
END;
ENDLOOP;
END; -- of InternalSearch
t: REF TreeObject ← NARROW[tree];
InternalSearch[t.root.halves[lower]];
END; -- of Search
Concrete implementations of useful subroutines for computing all or part of
the prefix and treeHalf functions required by Create.
TreeHalfImpl:
PUBLIC
PROC [ value:
LONG
UNSPECIFIED, i: RadixIndex ]
RETURNS[ Half ] =
TRUSTED BEGIN
OPEN Basics;
RETURN[
IF (
IF i<bitsPerWord
THEN
BITAND[
BITSHIFT[HighHalf[value], i], 08000h]
ELSE BITAND[BITSHIFT[LowHalf[value], i-bitsPerWord], 08000h])#0 THEN upper ELSE lower];
END; -- of TreeHalfImpl;
PrefixImpl:
PUBLIC
PROC [ a:
LONG
UNSPECIFIED, b:
LONG
UNSPECIFIED ]
RETURNS[ RadixIndex ] =
TRUSTED BEGIN
OPEN Basics;
r: RadixIndex;
t: WORD;
dif: WORD ← BITXOR[HighHalf[a], HighHalf[b]];
IF dif=0
THEN
BEGIN
r ← bitsPerWord;
dif ← BITXOR[LowHalf[a], LowHalf[b]];
IF dif=0 THEN RETURN[2*bitsPerWord];
END
ELSE r ← 0;
IF (t ← BITAND[dif, 0ff00h])=0 THEN r ← r+8 ELSE dif ← t;
IF (t ← BITAND[dif, 0f0f0h])=0 THEN r ← r+4 ELSE dif ← t;
IF (t ← BITAND[dif, 0cccch])=0 THEN r ← r+2 ELSE dif ← t;
IF BITAND[dif, 0aaaah]=0 THEN r ← r+1;
RETURN[r];
END; -- of PrefixImpl;
END. -- of PrioritySearchRefImpl