Splay.ns

Newspeak3
'Benchmarks'
class Splay usingPlatform: p = (
(*This benchmark is based on a JavaScript log processing module used by the V8 profiler to generate execution time profiles for runs of JavaScript applications, and it effectively measures how fast the JavaScript engine is at allocating nodes and reclaiming the memory used for old nodes. Because of the way splay trees work, the engine also has to deal with a lot of changes to the large tree object graph.

Copyright (c) 2012 Google Inc.
Copyright (c) 2011, the Dart project authors.  Please see the AUTHORS file for details. All rights reserved. Use of this source code is governed by a BSD-style license that can be found in the LICENSE file.*)
|
List = p collections List.

kTreeSize = 8000.
kTreeModifications = 80.
kTreePayloadDepth = 5.

seed ::= 49734321.

tree <SplayTree>
|mysetup) (
class Leaf withTag: tag = (|
	string ::= 'String for key ',tag,' in leaf node'.
	array ::= {0. 1. 2. 3. 4. 5. 6. 7. 8. 9}.
|) (
) : (
)
class Node key: k value: v = (|
public key = k.
public value = v.
public left
public right
|) (
public traverse: f <[:Node]> = (
	(*Performs an ordered traversal of the subtree starting here.*)
	| current ::= self. |
	[nil = current] whileFalse:
		[ | left = current left. |
		nil = left ifFalse: [left traverse: f].
		f value: current.
		current: current right].
)
) : (
)
class Payload left: l right: r = (|
	left ::= l.
	right ::= r.
|) (
) : (
public generate: depth with: tag = (
	depth = 0 ifTrue: [^Leaf withTag: tag].
	^Payload
		left: (generate: depth - 1 with: tag)
		right: (generate: depth - 1 with: tag)
)
)
class SplayTree = (
(*A splay tree is a self-balancing binary search tree with the additional property that recently accessed elements are quick to access again. It performs basic operations such as insertion, look-up and removal in O(log(n)) amortized time.*)
|
root <Node>
|) (
public at: key <Number> ^<Node> = (
	(*Returns the node having the specified [key] or null if the tree doesn't contain a node with the specified [key].*)

	isEmpty ifTrue: [^nil].
	splay: key.
	^root key = key ifTrue: [root] ifFalse: [nil]
)
public at: key <Number> put: value = (
	(*Inserts a node into the tree with the specified [key] and value if the tree does not already contain a node with the specified key. If the value is inserted, it becomes the root of the tree.*)
	| node |

	isEmpty ifTrue: [root:: Node key: key value: value. ^self].

	(*Splay on the key to move the last node on the search path for the key to the root of the tree.*)
	splay: key.

	root key = key ifTrue: [^self].
	node:: Node key: key value: value.
	key > root key
		ifTrue:
			[node left: root.
			node right: root right.
			root right: nil]
		ifFalse:
			[node right: root.
			node left: root left.
			root left: nil].
	root:: node.
)
public exportKeys ^<List[Number]> = (
	(* Returns a list with all the keys of the tree. *)
	| result = List new. |
	isEmpty ifFalse: [root traverse: [:node | result add: node key]].
	^result
)
public findGreatestLessThan: key <Number> ^<Node> = (
	(*Returns the Node having the maximum key value that is less than the specified [key].*)
	isEmpty ifTrue: [^nil].

	(*Splay on the key to move the node with the given key or the last node on the search path to the top of the tree.*)
	splay: key.
	(*Now the result is either the root node or the greatest node in the left subtree.*)
	root key < key ifTrue: [^root].
	nil = root left ifFalse: [^findMax: root left].
	^nil
)
findMax ^<Node> = (
	^findMax: root
)
findMax: start <Node> ^<Node> = (
	| current |
	isEmpty ifTrue: [^nil].
	current: start.
	[nil = current right] whileFalse: [current:: current right].
	^current
)
isEmpty = (
	^nil = root
)
public removeKey: key <Number> ^<Node> = (
	(*Removes a node with the specified key from the tree if the tree contains a node with this key. The removed node is returned. If [key] is not found, an exception is thrown.*)
	| removed |

	isEmpty ifTrue: [error: 'Key not found: ', key printString].
	splay: key.
	root key = key ifFalse: [error: 'Key not found: ', key printString].
	removed:: root.
	nil = root left
		ifTrue:
			[root: root right]
		ifFalse:
			[ | right = root right. |
			root:: root left.
			(*Splay to make sure that the new root has an empty right child.*)
			splay: key.
			(*Insert the original right child as the right child of the new root.*)
			root right: right].
	^removed
)
splay: key <Number> = (
	(*Perform the splay operation for the given key. Moves the node with the given key to the top of the tree.  If no node has the given key, the last node on the search path is moved to the top of the tree. This is the simplified top-down splaying algorithm from: ''Self-adjusting Binary Search Trees'' by Sleator and Tarjan*)
	| dummy left right current break |

	isEmpty ifTrue: [^self].
	dummy:: Node key: nil value: nil.
	left:: right:: dummy.
	current:: root.

	break::
		[left right: current left.
		right left: current right.
		current left: dummy right.
		current right: dummy left.
		root: current].

	[
		key < current key ifTrue: [
			nil = current left ifTrue: [^break value].
			key < current left key ifTrue: [
				(*Rotate right*)
				| tmp = current left. |
				current left: tmp right.
				tmp right: current.
				current: tmp.
				nil = current left ifTrue: [^break value].
			].
			(*Link right*)
			right left: current.
			right: current.
			current: current left.
		] ifFalse: [key > current key ifTrue: [
			nil = current right ifTrue: [^break value].
			key > current right key ifTrue: [
				(*Rotate left*)
				| tmp = current right. |
				current right: tmp left.
				tmp left: current.
				current: tmp.
				nil = current right ifTrue: [^break value].
			].
			(*Link left*)
			left right: current.
			left: current.
			current: current right.
		] ifFalse: [
			^break value
		]].
	] repeat.
)
) : (
)
public bench = (
	exercise.
)
exercise = (
	(*Replace a few nodes in the splay tree.*)
	kTreeModifications timesRepeat:
		[ | key greatest |
		key:: insertNewNode.
		greatest:: tree findGreatestLessThan: key.
		nil = greatest
			ifTrue: [tree removeKey: key]
			ifFalse: [tree removeKey: greatest key]].
)
insertNewNode ^<Number> = (
	| key <Number> payload |
	[key: nextRandom.
	nil = (tree at: key)] whileFalse.
	payload:: Payload generate: kTreePayloadDepth with: key printString.
	tree at: key put: payload.
	^key
)
mysetup = (
	tree: SplayTree new.
	kTreeSize timesRepeat: [insertNewNode].
)
nextRandom = (
	(*Robert Jenkins' 32 bit integer hash function.*)
	seed:: ((seed + 16r7ED55D16) + (seed << 12)) bitAnd: 16rFFFFFFFF.
	seed:: ((seed bitXor: 16rC761C23C) bitXor: (seed >> 19)) bitAnd: 16rFFFFFFFF.
	seed:: ((seed + 16r165667B1) + (seed << 5)) bitAnd: 16rFFFFFFFF.
	seed:: ((seed + 16rD3A2646C) bitXor: (seed << 9)) bitAnd: 16rFFFFFFFF.
	seed:: ((seed + 16rFD7046C5) + (seed << 3)) bitAnd: 16rFFFFFFFF.
	seed:: ((seed bitXor: 16rB55A4F09) bitXor: (seed >> 16)) bitAnd: 16rFFFFFFFF.
	^(seed bitAnd: 16rFFFFFFF) asFloat / 16r10000000
)
tearDown = (
	(*Allow the garbage collector to reclaim the memory used by the splay tree no matter how we exit the tear down function.*)
	| keys length |
	keys:: tree exportKeys.
	tree:: nil.

	(*Verify that the splay tree has the right size.*)
	length:: keys size.
	length = kTreeSize ifFalse: [error: 'Splay tree has wrong size'].

 	(*Verify that the splay tree has sorted, unique keys.*)
	1 to: length - 1 do: [:i |
		(keys at: i) >= (keys at: i+1) ifTrue: [error: 'Splay tree not sorted', i printString].
		].
)
) : (
)