DNA. wyrm-assoc-splay Version. 2.0.9 Language. c Manpage. prioq (1WY) Testbase. Test Script Test Report Import. Interface. wyrmwif wyrm-assoc Export. Implementation. wyrm-assoc-splay.c Interface. wyrm-assoc-splay.h Object. wyrm-assoc-splay.o	Associative Map in a Splay Tree
Sections. Compile Files Data Structures Splay Tree Operations Assoc Type Implementation Priority Queue Test Base
Make. Object. compile -c -o [export object] [export implementation] -- -list [import interface] [export interface]

1 :: Implement sorted associative maps with splay trees.

Wyrmwif Tcl extensions. For non-profit uses only, provided this copyright is preserved on all copies, this work may be freely copied, modified, redistributed, compiled, and incorporated in other works. This work is distributed with no warranty of any kind; no author or distributor accepts any responsibility for the consequences of using it, or for whether it serves any particular purpose or works at all, unless he or she says so in writing.

2 wyrm-assoc-splay.h

3 wyrm-assoc-splay.c

4 Splay initialisation

Compile Files

2. wyrm-assoc-splay.h :: Besides the generic interface, a specialised priority queue is also defined in a separate command.


#ifndef WYRM_ASSOC_SPLAY_H
#define WYRM_ASSOC_SPLAY_H

	//	wyrm-assoc-splay.dna - Copyright (C) 2002 SM Ryan.  All rights reserved.'

	#include "wyrmwif.h"
	
	int wyrm_assocSplayInit(Intr intr);

#endif

3. wyrm-assoc-splay.c ::


static const char COPYRIGHT[] = "wyrm-assoc-splay.dna - Copyright (C) 2002 SM Ryan.  All rights reserved.";

#define WYRM_ASSOC_H_IMPLEMENTORS
#include "wyrm-assoc.h"
#include "wyrm-assoc-splay.h"
#include "wyrm-huff.h"
#include "wyrm-io.h"

<Typedef declarations>
<Static declarations>
<Splay tree WyrmAssocMapType>
<Splay tree node representation>
<Tcl type operators>
<Node deallocation>
<New splay tree>
<Dump splay tree>
<Mapping inquiries>
<Key comparison>
<Splay tree seek>
<Splay tree traversal>
<Create node as top of the tree>
<Node content operators>
<prioq (1WY)>
<Internal testing command>
<Splay initialisation>

4. Splay initialisation ::

proc int wyrm_assocSplayInit—Declare splay tree maps to the interface; returns TCL_OK or TCL_ERROR.

input WyrmAssocSplayType—Splay map type.

output Intr intr—Receives error messages; may be NULL.

output wyrm-assoc—Splay tree mapping declared.


int wyrm_assocSplayInit(Intr intr) {
	char package[] =
		"namespace eval ::wyrm {\n"
		"	namespace export prioq vprioq\n"
		"}\n";
	Tcl_CreateObjCommand(intr,"::wyrm::prioq",prioqCommand,0,0);
	Tcl_CreateObjCommand(intr,"::wyrm::vprioq",prioqCommand,"vprioq",0);
	#ifdef TESTING
		Tcl_CreateObjCommand(intr,"::wyrm::wif::qsplay",qsplayCommand,0,0);
	#endif
	if (Tcl_Eval(intr,package)!=TCL_OK) return TCL_ERROR;
	Tcl_RegisterObjType((Tcl_ObjType*)(&WyrmAssocSplayType));
	return TCL_OK;
}

5 Splay tree node representation

6 Typedef declarations

7 Static declarations

8 Node deallocation

Data Structures

5. Splay tree node representation :: Splay tree consists of splay nodes, which have less and greater subtrees, a key and data object, and some control flags

type struct Splay

Obj key—Mapped key.

Obj data—Mapped to data.

int flags—Flags on that data.


struct Splay {
	Obj key;
	Obj data;
	<Priority queue flags>
	int flags:16;
	pSplay lt,gt;
};

6. Typedef declarations ::

typedef struct Splay Splay,*pSplay;

7. Static declarations :: These routines are only called from the interface after ensuring the type of the object is set correctly (mostly because they vector through the type). This means type checks are superfluous, and thus jump right to the heart of the matter.

#define pSplay lvalue internal—The splay tree internal representation.

input Obj mapping—The object with the representation.

	
#define top(mapping) (*((pSplay*)(&((mapping)->internalRep.otherValuePtr))))

8. Node deallocation ::

proc void deletenode—Free a node.

io pSplay node—Deleted node.

Memory. Node deleted; subtrees are untouched.

	
static void deletenode(pSplay node) {
	if (node) {
		decr(node->key);
		decr(node->data);
		dispose(node);
	}
}

9. Static declarations ::

static void deletenode(pSplay node);

11 Raise the lesser node of a subtree

12 Raise the least node of a subtree

13 Raise the greater node of a subtree

14 Raise the greatest node of a subtree

15 Raise a greater-greater chain

16 Raise a greater-lesser chain

17 Raise a lesser-greater chain

18 Raise a lesser-lesser chain

19 Splay tree seek

20 Descent stack

21 Descend the tree looking for the key

22 Reascend the tree and splay the selected node to the top

23 Clear the stack

24 Final position of the collection

25 Static declarations

26 Splay tree traversal

28 Create node as top of the tree

29 Node content operators

Splay Tree Operations

10 :: For a detailed explanation of splay trees: Self-adjusting binary search trees by Daniel Dominic Sleator and Robert Endre Tarjan .

11. Raise the lesser node of a subtree :: Raise the lesser subtree over the top.


pSplay c = X->gt;
Y->lt = c;
X->gt = Y;
T = X;

12. Raise the least node of a subtree :: Keep rotating the subtree clockwise until its lt field becomes empty. This finds the least element of the subtree and makes it the top of the subtree.


while (T->lt) {
	pSplay Y = T;
	pSplay X = Y->lt;
	<Raise the lesser node of a subtree>
}

13. Raise the greater node of a subtree :: Raise the greater subtree over the top.


pSplay c = X->lt;
Y->gt = c;
X->lt = Y;
T = X;

14. Raise the greatest node of a subtree :: Keep rotating the subtree counterclockwise until its gt field becomes empty. This finds the greatest element of the subtree and makes it the top of the subtree.


while (T->gt) {
	pSplay Y = T;
	pSplay X = Y->gt;
	<Raise the greater node of a subtree>
}

15. Raise a greater-greater chain :: Rotate the tree counterclockwise if X>Y>Z.


pSplay b = Y->lt;
pSplay c = X->lt;
X->lt = Y;
Y->lt = Z;
Y->gt = c;
Z->gt = b;
T = X;

16. Raise a greater-lesser chain :: Flatten the tree if X<Y and Y>Z.


pSplay b = X->lt;
pSplay c = X->gt;
X->lt = Z;
X->gt = Y;
Z->gt = b;
Y->lt = c;
T = X;

17. Raise a lesser-greater chain :: Flatten the tree if X>Y and Y<Z.


pSplay b = X->lt;
pSplay c = X->gt;
X->lt = Y;
X->gt = Z;
Y->gt = b;
Z->lt = c;
T = X;

18. Raise a lesser-lesser chain :: Rotate the tree clockwise if X<Y<Z.


pSplay c = Y->gt;
pSplay b = X->gt;
X->gt = Y;
Y->gt = Z;
Y->lt = b;
Z->lt = c;
T = X;

19. Splay tree seek :: Finding a node is fairly simple: descend down lt and gt subtrees until a key is found that matches the current key or it runs out of tree. But this is splay tree which means the tree has to rearranged to bring the found node to the top, and that gets more complicated.

proc Seek—Find a key in a tree; returns the new top.

io node—The top node, the found node (or somewhere near it) is brought to the top.

input key—The sought key if not NULL.

input int pos—Priority or key.

output exact—If the key matches exactly.


static pSplay seek(pSplay node,Obj key,int pos,bool *exact) {
	if (node) {
		bool retreat;
		<Descent stack>
		<Descend the tree looking for the key>
		<Reascend the tree and splay the selected node to the top>
		<Clear the stack>
		<Final position of the collection>
		return node;
	}else {
		if (exact) *exact = false;
		return 0;
	}
}

20. Descent stack :: The stack keeps track of the path followed while descending down the tree. The stack elements are popped two at time while ascending to determine which particular splay is used to bring the sought node to the top. During the ascent, the new local top is stored in the stack, so that at the end, one entry remains and it contains the new top.


typedef struct Stack Stack,*pStack;
struct Stack {
	pSplay elem;
	int cc;
	pStack under;
};
pStack t = 0,w;

21. Descend the tree looking for the key ::


while (node) {
	w = heap(Stack); w->elem = node; w->under = t; t = w;	
	t->cc = keycmp(key,pos,node);
	node = t->cc>0 ? node->gt : t->cc<0 ? node->lt : 0;
}

22. Reascend the tree and splay the selected node to the top :: Based on the next one or two entries of the stack, select the splay that brings the sought node to the top of the subtree.

If just below the top, rotate the top node.


while (t->under) {
	pStack u = t->under;
	pStack v = u->under;
	pSplay T;
	pSplay Z = v ? v->elem : 0;
	pSplay Y = u->elem;
	pSplay X = t->elem;
	if (!v && u->cc<0) {
		<Raise the lesser node of a subtree>
	}else if (!v && u->cc>0) {
		<Raise the greater node of a subtree>
	}else if (v->cc>0 && u->cc>0) {
		<Raise a greater-greater chain>
	}else if (v->cc>0 && u->cc<0) {
		<Raise a greater-lesser chain>
	}else if (v->cc<0 && u->cc>0) {
		<Raise a lesser-greater chain>
	}else if (v->cc<0 && u->cc<0) {
		<Raise a lesser-lesser chain>
	}
	t->under = v ? v->under : 0;
	dispose(u); dispose(v);
	t->elem = T;
}

23. Clear the stack :: Pop the last entry off the stack which contains the new top. If the sought key is in the collection, that node will be the new top. If not, the collection will preferably be set to the greatest lesser key, if it exists (if not at the first of the collection). If the top cc is greater than zero, then the top key is less than sought key.


if (exact) *exact = t->cc==0;
node = t->elem; retreat = t->cc<0; dispose(t);

24. Final position of the collection :: If the top key is greater than the sought key and previous element exists, retreat to it.


if (retreat && node->lt) {
	pSplay T = node->lt,X,Y;
	<Raise the greatest node of a subtree>
	node->lt = T;
	T = node;
	Y = T;
	X = Y->lt;
	{<Raise the lesser node of a subtree>}
	node = T;
}

25. Static declarations ::

static pSplay seek(pSplay node,Obj key,int pos,bool *exact);

26. Splay tree traversal :: Splay trees are traversed by rotating around the top. The mapping can be traversed in sequential increasing or decreasing keys. The collection can be set at or near a specific key; it can be set to the first node, and to the last node. It is traversed sequentially in increasing key order and decreasing key order.


static bool advance(Obj mapping) {
	if (top(mapping)->gt) {
		pSplay T = top(mapping)->gt,X,Y;
		<Raise the least node of a subtree>
		top(mapping)->gt = T;
		T = top(mapping);
		Y = T;
		X = Y->gt;
		{<Raise the greater node of a subtree>}
		top(mapping) = T;
		return true;
	}else {
		return false;
	}
}

static Obj firstSplayScan(Intr intr,Obj mapping) {
	pSplay T = top(mapping);
	if (T) {
		<Raise the least node of a subtree>
		top(mapping) = T;
		while (top(mapping)->priorityQueue) {
			if (!advance(mapping)) {
				rprintf(intr,"empty mapping");
				return 0;
			}
		}
		return incr(top(mapping)->key);
	}else {
		rprintf(intr,"empty mapping");
		return 0;
	}
}

static Obj lastSplayScan(Intr intr,Obj mapping) {
	pSplay T = top(mapping);
	if (T) {
		<Raise the greatest node of a subtree>
		top(mapping) = T;
		return incr(T->key);
	}else
		rprintf(intr,"empty mapping");
		return 0;
}

static Obj nextSplayScan(Intr intr,Obj mapping,Obj key) {
	if (!top(mapping)) {
		rprintf(intr,"empty mapping");
		return 0;
	}else {
		top(mapping) = seek(top(mapping),key,mapkey,0);
		if (strcmp(Tcl_GetString(key),Tcl_GetString(top(mapping)->key))<0) {
			return incr(top(mapping)->key);
		}else if (!top(mapping)->gt) {
			rprintf(intr,"no next key");
			return 0;
		}else {
			pSplay T = top(mapping)->gt,X,Y;
			<Raise the least node of a subtree>
			top(mapping)->gt = T;
			T = top(mapping);
			Y = T;
			X = Y->gt;
			{<Raise the greater node of a subtree>}
			top(mapping) = T;
			return incr(T->key);
		}
	}
}

static Obj previousSplayScan(Intr intr,Obj mapping,Obj key) {
	if (!top(mapping)) {
		rprintf(intr,"empty mapping");
		return 0;
	}else {
		top(mapping) = seek(top(mapping),key,mapkey,0);
		if (strcmp(Tcl_GetString(key),Tcl_GetString(top(mapping)->key))>0) {
			return incr(top(mapping)->key);
		}else if (!top(mapping)->lt) {
			rprintf(intr,"no previous key");
			return 0;
		}else {
			pSplay T = top(mapping)->lt,X,Y;
			<Raise the greatest node of a subtree>
			top(mapping)->lt = T;
			T = top(mapping);
			Y = T;
			X = Y->lt;
			{<Raise the lesser node of a subtree>}
			top(mapping) = T;
			if (top(mapping)->priorityQueue) {
				rprintf(intr,"no previous key");
			}else {
				return incr(T->key);
			}
		}
	}
}
	
static ptr beginScan(Intr intr,Obj mapping,Obj firstHint,bool *sorted) {
	bool *more = heap(bool); *more = top(mapping)!=0;
	if (*more) {
		pSplay T = top(mapping);
		if (firstHint) {
			T = seek(T,firstHint,mapkey,0);
		}else {
			<Raise the least node of a subtree>
		}
		top(mapping) = T;
		while (top(mapping)->priorityQueue) {
			if (!advance(mapping)) {
				*more = false;
				break;
			}
		}
	}
	*sorted = true;
	return more;	
}

static int continueScan(Intr intr,Obj mapping,ptr cookie,Obj *key,Obj *data,int *flags) {
	bool *more = cookie;
	if (!top(mapping) || !*more) {
		return TCL_BREAK;
	}else {
		top(mapping);
		*key = incr(top(mapping)->key);
		*data = incr(top(mapping)->data);
		*flags = top(mapping)->flags;
		*more = advance(mapping);
		return TCL_OK;
	}
}

static int endScan(Intr intr,Obj mapping,ptr cookie) {
	dispose(cookie); return TCL_OK;
}

27. Static declarations ::

static Obj firstSplayScan(Intr intr,Obj mapping);
static Obj lastSplayScan(Intr intr,Obj mapping);
static Obj nextSplayScan(Intr intr,Obj mapping,Obj key);
static Obj previousSplayScan(Intr intr,Obj mapping,Obj key);

static ptr beginScan(Intr intr,Obj mapping,Obj firstHint,bool *sorted);
static int continueScan(Intr intr,Obj mapping,ptr cookie,Obj *key,Obj *data,int *flags);
static int endScan(Intr intr,Obj mapping,ptr cookie);

28. Create node as top of the tree :: If this key is already in the tree, its data and flags are replaced. Otherwise, a newly created node is always the new top node. The old top is placed below to the left or right.


static pSplay addSplay(pSplay tree,Obj key,int pos,Obj data,int flags) {
	bool exact;
	flags &= ~(wyrm_assocFlagCompressKey|wyrm_assocFlagCompressData);
	tree = seek(tree,key,pos,&exact);
	if (exact) {
		if (flags>=0) tree->flags = flags;
		if (data) {
			incr(data);
			decr(tree->data); tree->data = data;
		}
		return tree;
	}else {
		pSplay X = tree;
		pSplay S = heap(Splay); zero(1,Splay,S);
		S->key = incr(key?key:Tcl_NewObj());
		S->data = incr(data?data:Tcl_NewObj());
		S->priorityQueue = pos!=mapkey;
		S->flags = flags<0 ? 0 : flags;
		if (X) {
			if (keycmp(key,pos,X)<0) {
				S->lt = X->lt; S->gt = X; X->lt = 0;
			} else {
				S->gt = X->gt; S->lt = X; X->gt = 0;
			}
		}
		return S;
	}
}

29. Node content operators ::


static int getSplay(Intr intr,Obj mapping,Obj seeking,Obj *key,Obj *data,int *flags) {
	if (top(mapping)) {
		pSplay T = seek(top(mapping),seeking,mapkey,0);
		if (key) *key = incr(T->key);
		if (data) *data = incr(T->data);
		if (flags) *flags = T->flags;
		top(mapping) = T;
		return TCL_OK;
	}else {
		if (key) *key = 0;
		if (data) *data = 0;
		if (flags) *flags = -1;
		rprintf(intr,"empty mapping");
		return TCL_ERROR;
	}
}

static int putSplay(Intr intr,Obj mapping,Obj key,Obj data,int flags) {
	top(mapping) = addSplay(top(mapping),key,mapkey,data,flags);
	Tcl_InvalidateStringRep(mapping);
	return TCL_OK;
}

30. Node content operators :: Delete the top, and then paste its lt and gt subtrees back together. If one is empty, the other is the entire remaining collection.

Otherwise raise the least of the greater subtree so that its lt field is empty. Then just paste the left subtree into the now empty ltfield. (Or raise the greatest on the lesser subtree. The decision to modify the greater subtree instead is arbitrary.)


static int deleteSplay(Intr intr,Obj mapping,Obj key) {
	if (top(mapping)) {
		bool exact; pSplay X = seek(top(mapping),key,mapkey,&exact);
		if (!exact) {
			rprintf(intr,"missing: %{y}s",key);
			return TCL_ERROR;
		}	
		if (X->lt==0) {
			top(mapping) = X->gt;
		}else if (X->gt==0) {
			top(mapping) = X->lt;
		}else {
			pSplay T = X->gt;
			<Raise the least node of a subtree>
			T->lt = X->lt; top(mapping) = T;
		}
		Tcl_InvalidateStringRep(mapping);
		deletenode(X);
		return TCL_OK;
	}else {
		rprintf(intr,"empty mapping");
		return 0;
	}
}

31. Static declarations ::

static int getSplay(Intr intr,Obj mapping,Obj seeking,Obj *key,Obj *data,int *flags);
static pSplay addSplay(pSplay tree,Obj key,int pos,Obj data,int flags);
static int putSplay(Intr intr,Obj mapping,Obj key,Obj data,int flags);
static int deleteSplay(Intr intr,Obj mapping,Obj key);

32 Splay tree WyrmAssocMapType

33 Tcl type operators

37 Static declarations

38 New splay tree

40 Dump splay tree

42 Mapping inquiries

Assoc Type Implementation

32. Splay tree WyrmAssocMapType :: Define the splay tree mapping to the generic interface. For more information, see the associative mapping generic interface.


static WyrmAssocMapType WyrmAssocSplayType = {
	{
		"wyrm.assoc.splay",
		freeSplay,
		duplicateSplay,
		wyrm_assocUpdate,
		setSplayInternalRepresentation
	},
	updateSplay,
	internalSplay,
	dumpSplay,
	0,
	newSplay,
	isSplayEmpty,
	firstSplayScan,
	lastSplayScan,
	nextSplayScan,
	previousSplayScan,
	beginScan,
	continueScan,
	endScan,
	getSplay,
	putSplay,
	deleteSplay,
};

33. Tcl type operators :: Free splay tree nodes; references to the keys and data are decremented so they will be collected when no longer used.


static void freeSplay(Obj mapping) {
	freeSplayRcr(top(mapping));
	top(mapping) = 0;
	mapping->typePtr = 0;
}

static void freeSplayRcr(pSplay tree) {
	if (tree) {
		pSplay lt = tree->lt;
		pSplay gt = tree->gt;
		deletenode(tree);
		freeSplayRcr(lt);
		freeSplayRcr(gt);
	}
}

34. Tcl type operators :: Duplicate splay tree nodes; the keys and data are not duplicated; their reference counts are incremented.


static void duplicateSplay(Obj mapping,Obj newmapping) {
	if ((newmapping)->typePtr && (newmapping)->typePtr->freeIntRepProc)
		(newmapping)->typePtr->freeIntRepProc((newmapping));
	(newmapping)->typePtr = (Tcl_ObjType*)(&WyrmAssocSplayType);
	top(newmapping) = duplicateRcr(top(mapping));
}

static pSplay duplicateRcr(pSplay node) {
	if (node) {
		pSplay new = heap(Splay);
		*new = *node;
		incr(new->key); incr(new->data);
		new->flags = node->flags;
		new->lt = duplicateRcr(node->lt);
		new->gt = duplicateRcr(node->gt);
		return new;
	}else
		return 0;
}

35. Tcl type operators :: Update the string representation with the mapping's data method. This will display the mapping as an orderred key/value pairs list.

proc updateSplayStringRepresentation—String representation of a collection.

io mapping—Object with updated string representation.


static void updateSplay(Obj mapping,Tcl_DString *D) {
	updateStringRcr(top(mapping),D);
}

static void updateStringRcr(pSplay node,Tcl_DString *D) {
	if (node) {
		updateStringRcr(node->lt,D);
		wyrm_assocUpdateEntry(D,Tcl_GetString(node->key),node->data,node->flags);
		updateStringRcr(node->gt,D);
	}
}

36. Tcl type operators :: If obj is already refers to a mapping, that collection is returned. Otherwise the string representation of obj is taken as a key/value pairs list, and that is used to create a new splay collection.

proc setSplayInternalRepresentation—Create the mapping representation from an object.

ouput intr—Receives error message; may be NULL.

io mapping—Object with mapping internal representation.


static int setSplayInternalRepresentation(Intr intr,Obj mapping) {
	return wyrm_assocInternal(intr,mapping,(Tcl_ObjType*)&WyrmAssocSplayType);
}

static int internalSplay(Intr intr,Obj obj,ptr cookie,ptr *x) {
	Obj key,data; int flags; pSplay map = 0;
	while (wyrm_assocInternalEntry(cookie,&key,&data,&flags)) {
		map = addSplay(map,key,mapkey,data,flags);
		decr(key); decr(data);
	}
	*x = map;
	return TCL_OK;
}

37. Static declarations ::

static void freeSplay(Obj mapping);
static void freeSplayRcr(pSplay tree);
static void duplicateSplay(Obj mapping,Obj newmapping);
static pSplay duplicateRcr(pSplay node);
static void updateSplay(Obj obj,Tcl_DString *D);
static int setSplayInternalRepresentation(Intr intr,Obj mapping);
static int internalSplay(Intr intr,Obj obj,ptr cookie,ptr*);
static void updateStringRcr(pSplay node,Tcl_DString *D);

38. New splay tree :: The splay tree mapping new makes a map from a key-value pair list. It accepts no parameters.


static Obj newSplay(Intr intr,Obj base,int N,Obj *P) {
	if (N>0) {
		rprintf(intr,"splay associative mapping new: no parameters allowed");
		return 0;
	}else if (Tcl_ConvertToType(intr,base,(Tcl_ObjType*)&WyrmAssocSplayType)==TCL_OK) {
		return incr(base);
	}else {
		return 0;
	}
}

39. Static declarations ::

static Obj newSplay(Intr intr,Obj base,int N,Obj *P);

40. Dump splay tree :: The splay tree mapping dump lists the keys, data, and flags in an ordered list.

If the parameter -indent is given, each entry is given on a separate line, indented by the depth in the tree.


static Obj dumpSplay(Intr intr,Obj mapping,int N,Obj *P) {
	Tcl_DString D; bool indent = N>=1 && streq(Tcl_GetString(*P),"-indent"); Obj r;
	Tcl_DStringInit(&D);
	dumpRcr(top(mapping),0,indent,&D);
	r = incr(Tcl_NewStringObj(Tcl_DStringValue(&D),Tcl_DStringLength(&D)));
	Tcl_DStringFree(&D); return r;
}
static Obj internalDumpSplay(pSplay node,int N,Obj *P) {
	Tcl_DString D; bool indent = N>=1 && streq(Tcl_GetString(*P),"-indent"); Obj r;
	Tcl_DStringInit(&D);
	dumpRcr(node,0,indent,&D);
	r = incr(Tcl_NewStringObj(Tcl_DStringValue(&D),Tcl_DStringLength(&D)));
	Tcl_DStringFree(&D); return r;
}

static void dumpRcr(pSplay node,int depth,bool indent,Tcl_DString *D) {
	if (node) {
		Obj key,data; char B[20];
		dumpRcr(node->lt,depth+1,indent,D);
		if (indent) {
			int i; for (i=1; i<=depth; i++) Tcl_DStringAppend(D,i%10==0 ? "|" : ":",1);
		}
		key = incr(node->key);
		Tcl_DStringAppendElement(D,Tcl_GetString(key));
		decr(key);
		data = incr(node->data);
		Tcl_DStringAppendElement(D,Tcl_GetString(data));
		decr(data);
		sprintf(B,"%d:",node->flags); Tcl_DStringAppendElement(D,B);
		Tcl_DStringAppend(D,node->priorityQueue?"Q":"q",-1);
		if (indent) {
			Tcl_DStringAppend(D,"\n",1);
		}
		dumpRcr(node->gt,depth+1,indent,D);
	}
}

41. Static declarations ::

static Obj dumpSplay(Intr intr,Obj mapping,int N,Obj *P);
static Obj internalDumpSplay(pSplay node,int N,Obj *P);
static void dumpRcr(pSplay node,int depth,bool indent,Tcl_DString *D);

42. Mapping inquiries :: isSplayEmptydetermines if a mapping is empty, if the top is null.


static int isSplayEmpty(Intr intr,Obj mapping) {
	return top(mapping)==0 ? TCL_OK : TCL_BREAK;
}

43. Static declarations ::

static int isSplayEmpty(Intr intr,Obj mapping);

44 prioq (1WY)

45 Priority queue flags

46 Static declarations

53 Dequeue a task syntax

54 Dequeue a task

55 New priority queue syntax

56 New priority queue

57 Is queue empty syntax

58 Is queue empty

59 Return a list of all queued tasks and their priorities

60 Positionned at task

Priority Queue

44. prioq (1WY) ::

NAME

prioq — Priority queue.

synopsis

description

Splay trees are the most efficient way to implement priority queues as well as a general self-organising tree. To simplify using a splay tree as a priority queue, these additional interfaces are added to sort on priorities and to allow multiple nodes with the same priority. These splay trees are associative maps and priority queues. The prioq manipulates them as queues, and assoc as mappings. The enqueued task is a string which is interpretted by the caller; it is the same as the mapping data.

The priorities are recorded as keys but they are marked such that tasks cannot be sought. A list of all queued tasks can be is returned by prioq task.

Task are queued according to their priority. If the priority is not specified, it is assumed to be zero; priorities can be any integer, positive, negative or zero. A task can be added before or after all other tasks with the same priority.

A task can also be given an id; only one task with a particular id will be added to the queue; subsequent attempts to enqueue the same task id will be silently ignored: these are do once (with respect to the queue) tasks. A task does not have to have an id, in which case in can be enqueued as often as desired. The task id is any string which is unique for each task.

prioq will not modify the given queue, but return a new queue for prioq enqueue, prioq enqueuebefore, and prioq dequeue. vprioq is given the name of a variable holding the queue, and it will modify the variable value, whether it shared or not.


static int prioqCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	bool vprioq = streq(clientData,"vprioq");
	static chars operator[] = {
			"new","empty","task",
			"enqueue","enqueuebefore","dequeue",
			0
	};
	enum {
			new,empty,task,
			enqueue,enqueuebefore,dequeue
	};
	int operatorx;
	if (N<2) {
		Tcl_WrongNumArgs(intr,N,P,"operation ...");
		return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(intr,P[1],(CONST char**)operator,"prioq operation",0,&operatorx)!=TCL_OK) return TCL_ERROR;
	switch (operatorx) {
		case new: {
			<New priority queue>
		}
		case empty: {
			<Is queue empty>
		}
		case task: {
			<Positionned at task>
		}
		case enqueue: {
			<Enqueue after>
		}
		case enqueuebefore: {
			<Enqueue before>
		}
		case dequeue: {
			<Dequeue a task>
		}	
	}
}

45. Priority queue flags ::

type struct Splay

bool priorityQueue—Sort on the priority instead of the key.


unsigned priorityQueue:1;

46. Static declarations ::


enum {mapkey,enqueueAfter,enqueueBefore};

47. Key comparison :: Compare a string in a object or a priority to the key or priority of a splay node, which might be an object key or an integer priority. To simplify issues, any priority is less than any object; these are consider different kinds of keys, so their relative order is arbitrary.

Duplicate keys are not permitted; putting the data of an existing key overwrites the previous data. Duplicate priorities are allowed. Actually, the keycmp never finds the same priority no matter how often it is really there. If pos is enqueueBefore, the priority is treated as less than all existing nodes with that priority; if enqueueAfter, its treated as greater.

proc int keycmp—Compare the node key to an object; returns negative, zero, or positive if the given key is less, equal, or greater the node key.

input Obj key—Key to compare if not NULL.

int int pos—Priority or key.

input pSplay node—Node with key or priority.


static int keycmp(Obj key,int pos,pSplay node) {
	if (pos==mapkey && node->priorityQueue) {
		return 1;
	}else if (pos!=mapkey && !node->priorityQueue) {
		return -1;
	}else if (pos==mapkey) {
		return strcmp(Tcl_GetString(key),Tcl_GetString(node->key));
	}else {
		int nprio,sprio,cc;
		if (Tcl_GetIntFromObj(0,node->key,&nprio)!=TCL_OK) nprio = 0;
		if (Tcl_GetIntFromObj(0,key,&sprio)!=TCL_OK) sprio = 0;
		cc = sprio!=nprio ? sprio-nprio : pos==enqueueBefore ? -1 : 1;
		return cc;
	}
}

48. Static declarations ::

static int keycmp(Obj key,int pos,pSplay node);

49. Enqueue a task :: ::wyrm::prioq enqueue|enqueuebefore queue [ -id task-id ] [ priority ] task

::wyrm::vprioq enqueue|enqueuebefore queue-variable [ -id task-id ] [ priority ] task


int priority = 0; Obj queue,id=0,task=0,pr=0; bool changed = false; int rc = TCL_OK;
if (N<4 || N>7) {
	Tcl_WrongNumArgs(intr,2,P,"queue [-id taskid] [priority] task");
	return TCL_ERROR;
}else if (vprioq) {
	queue = Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG);
	if (!queue) return TCL_ERROR;
	changed = Tcl_IsShared(queue);
	queue = incr(changed ? Tcl_DuplicateObj(queue) : queue);
}else {
	queue = incr(Tcl_IsShared(P[2]) ? Tcl_DuplicateObj(P[2]) : P[2]);
}
switch (N) {
	case 4:	task = P[3]; break;
	case 5: pr = P[3]; task = P[4]; break;
	case 7: pr = P[5];
	case 6: id = P[4]; task = P[N-1];
		if (!streq(Tcl_GetString(P[3]),"-id")) {
			Tcl_SetResult(intr,"usage: prioq enqueue queue [-id taskid] [priority] task",TCL_STATIC);
			rc = TCL_ERROR;
		}
		break;
}
if (rc==TCL_OK && Tcl_ConvertToType(intr,queue,(Tcl_ObjType*)&WyrmAssocSplayType)!=TCL_OK) {
	rc = TCL_ERROR;
}
if (rc==TCL_OK) {
	<Enqueue magic>
}
if (rc==TCL_OK) {
	Tcl_SetObjResult(intr,queue);
	if (changed && !Tcl_ObjSetVar2(intr,P[2],0,queue,TCL_LEAVE_ERR_MSG)) {
		rc = TCL_ERROR;
	}
}
decr(queue);
return rc;

50. Enqueue magic ::


if (pr && Tcl_GetIntFromObj(intr,pr,&priority)!=TCL_OK) {
	rc = TCL_ERROR;
}else {
	bool store;
	if (pr) incr(pr); else pr = incr(Tcl_NewIntObj(0));
	if (id) {
		bool exact;
		top(queue) = seek(top(queue),id,mapkey,&exact);
		store = !exact;
		if (store) top(queue) = addSplay(top(queue),id,mapkey,Tcl_NewIntObj(1),0);
	}else {
		store = true;
	}
	if (store) top(queue) = addSplay(top(queue),pr,pos,task,0);
	Tcl_InvalidateStringRep(queue);
	decr(pr);
}

51. Enqueue after ::

wyrm::prioq enqueue: Add the task to the queue. If the priority is omitted, the priority is zero. If the task-id is given and a previous task had used the same id, the enqueue is ignored: the task is not added again, whether it has yet been dequeued or no. The new queue is returned.


int pos = enqueueAfter;
<Enqueue a task>

52. Enqueue before ::

wyrm::prioq enqueuebefore: Add the task to the queue. If the priority is omitted, the priority is zero. The task is added before all other tasks queued with the same priority. If the task-id is given and a previous task had used the same id, the enqueue is ignored: the task is not added again, whether it has yet been dequeued or no. The new queue is returned.


int pos = enqueueBefore;
<Enqueue a task>

53. Dequeue a task syntax :: ::wyrm::prioq dequeue queue task-variable [ existsvar ]

::wyrm::vprioq dequeue queue-variable task-variable [ existsvar ]

54. Dequeue a task ::

wyrm::prioq dequeue: Return the queue with the least priority task removed; if the queue is empty, and the existsvar is omitted, an error is returned. If the existsvar is specified, it is set to whether the queue existed (was nonempty) when called; dequeueing an empty queue with existsvar is not an error. The task with the least priority is assigned to task-variable and removed from the queue. Non-queue mappings are ignored.


Obj task,queue; pSplay T; int rc; bool changed = false;
if (N!=4 && N!=5) {
	Tcl_WrongNumArgs(intr,2,P,"queue task");
	return TCL_ERROR;
}else if (vprioq) {
	queue = incr(Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG));
	if (!queue) return TCL_ERROR;
	changed = Tcl_IsShared(queue);
	queue = incr(changed ? Tcl_DuplicateObj(queue) : queue);
}else {
	queue = incr(Tcl_IsShared(P[2]) ? Tcl_DuplicateObj(P[2]) : P[2]);
}
if (Tcl_ConvertToType(intr,queue,(Tcl_ObjType*)&WyrmAssocSplayType)!=TCL_OK) return TCL_ERROR;
T = top(queue);
if (!T) {
	task = 0;
}else {
	<Raise the least node of a subtree>
	top(queue) = T;
	if (T->priorityQueue) {
		task = incr(T->data);
		top(queue) = T->gt;
		deletenode(T);
	}else {
		task = 0;
	}
}
if (!task) {
	if (N==5) {
		Obj p = incr(Tcl_NewBooleanObj(false));
		rc = Tcl_ObjSetVar2(intr,P[4],0,p,TCL_LEAVE_ERR_MSG) ? TCL_OK : TCL_ERROR;
		decr(p);
	}else {
		Tcl_SetResult(intr,"queue empty",TCL_STATIC);
		rc = TCL_ERROR;
	}
}else {
	rc = TCL_OK;
	Tcl_SetObjResult(intr,queue);
	if (!Tcl_ObjSetVar2(intr,P[3],0,task,TCL_LEAVE_ERR_MSG)) {
		rc = TCL_ERROR;
	}else if (changed && !Tcl_ObjSetVar2(intr,P[2],0,queue,TCL_LEAVE_ERR_MSG)) {
		rc = TCL_ERROR;
	}
	if (rc==TCL_OK && N==5) {
		Obj p = incr(Tcl_NewBooleanObj(true));
		rc = Tcl_ObjSetVar2(intr,P[4],0,p,TCL_LEAVE_ERR_MSG) ? TCL_OK : TCL_ERROR;
		decr(p);
	}
}
Tcl_InvalidateStringRep(queue);
decr(task); decr(queue);
return rc;

55. New priority queue syntax :: ::wyrm::prioq new [ [ -id task-id ] priority task ] ...

::wyrm::vprioq new queue-variable [ [ -id task-id ] priority task ] ...

56. New priority queue ::

wyrm::prioq new: Create a new priority queue and initialise it with some tasks, their priorities, and optional ids. (Actually to initialize an empty queue, it suffices to start with an empty list.)


Obj queue = incr(Tcl_NewObj()),queuevar = 0,id=0; int rc = TCL_OK;
if (vprioq) {
	queuevar = P[2]; P++,N--;
}
if (N%2!=0) {
	Tcl_WrongNumArgs(intr,N,P,"[-id taskid] priority task ...");
	return TCL_ERROR;
}
if (Tcl_ConvertToType(intr,queue,(Tcl_ObjType*)&WyrmAssocSplayType)!=TCL_OK) return TCL_ERROR;
for (N-=2,P+=2; rc==TCL_OK && N>0; N-=2,P+=2) {
	int pos = enqueueAfter;
	int priority; Obj pr = P[0],task = P[1];
	if (streq(Tcl_GetString(P[0]),"-id")) {
		id = P[1]; continue;
	}
	<Enqueue magic>
	id = 0;
}
if (rc==TCL_OK) {
	Tcl_SetObjResult(intr,queue);
	if (queuevar && !Tcl_ObjSetVar2(intr,queuevar,0,queue,TCL_LEAVE_ERR_MSG)) {
		rc = TCL_ERROR;
	}
}
decr(queue);
return rc;

57. Is queue empty syntax :: ::wyrm::prioq empty queue

::wyrm::vprioq empty queue-variable

58. Is queue empty ::

wyrm::prioq empty: Return true if the queue has no more tasks. It may still have some other mappings.


pSplay T; Obj queue;
if (N!=3) {
	Tcl_WrongNumArgs(intr,N,P,"queue");
	return TCL_ERROR;
}else if (vprioq) {
	queue = Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG);
	if (!queue) return TCL_ERROR;
}else {
	queue = P[2];
}
if (Tcl_ConvertToType(intr,queue,(Tcl_ObjType*)&WyrmAssocSplayType)!=TCL_OK) return TCL_ERROR;
T = top(queue);
if (!T) {
	Tcl_SetObjResult(intr,Tcl_NewBooleanObj(true));
}else if (T->priorityQueue) {
	Tcl_SetObjResult(intr,Tcl_NewBooleanObj(false));
}else {
	<Raise the least node of a subtree>
	top(queue) = T;
	Tcl_SetObjResult(intr,Tcl_NewBooleanObj(!T->priorityQueue));
}
return TCL_OK;

59. Return a list of all queued tasks and their priorities :: ::wyrm::prioq task queue

::wyrm::vprioq task queue-variable

60. Positionned at task ::

wyrm::prioq task: Return a list of each queued task proceeded by its priority.


Obj queue; Obj result = 0; pSplay T;
if (N!=3) {
	Tcl_WrongNumArgs(intr,N,P,"queue");
	return TCL_ERROR;
}else if (vprioq) {
	queue = Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG);
	if (!queue) return TCL_ERROR;
}else {
	queue = P[2];
}
if (Tcl_ConvertToType(intr,queue,(Tcl_ObjType*)&WyrmAssocSplayType)!=TCL_OK) return TCL_ERROR;
result = incr(Tcl_NewObj());
T = top(queue);
if (T) {
	<Raise the least node of a subtree>
	top(queue) = T;
	while (top(queue)->priorityQueue) {
		Tcl_ListObjAppendElement(0,result,top(queue)->key);
		Tcl_ListObjAppendElement(0,result,top(queue)->data);
		if (!advance(queue)) break;
	}
}
Tcl_SetObjResult(intr,result);
return TCL_OK;

61 Internal testing command

62 Test base

Test Base

61. Internal testing command ::


#ifdef TESTING
	static void skeleton(Intr intr,pSplay x) {
		if (x) {
			Tcl_AppendElement(intr,Tcl_GetString(x->key));
			skeleton(intr,x->lt);
			skeleton(intr,x->gt);
		}else {
			Tcl_AppendElement(intr,"-");
			Tcl_AppendElement(intr,"-");
		}
	}

	static int qsplayCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
		static chars operator[] = {
				"skeleton",
				0
		};
		int operatorx;
		if (N<2) {
			Tcl_WrongNumArgs(intr,N,P,"operation");
			return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(intr,P[1],(CONST char**)operator,"qsplay operation",0,&operatorx)!=TCL_OK)
			return TCL_ERROR;
		switch (operatorx) {
			case 0:
				if (N!=3) {
					Tcl_WrongNumArgs(intr,2,P,"skeleton splaytree");
					return TCL_ERROR;
				}else {
					Obj mapping = P[2];
					if (mapping->typePtr && streq(mapping->typePtr->name,"wyrm.assoc.splay")) {
						Tcl_ResetResult(intr);
						skeleton(intr,top(mapping));
					}else {
						Tcl_SetResult(intr,"not a splay tree",TCL_STATIC);
					}
					return TCL_OK;
				}
		}
	}
#endif