First try:a skiplist implementation
"Márton Sasvári (IJ/ETH)"
Marton.Sasvari at ericsson.com
Tue Jan 11 06:29:09 PST 2005
Hi,
I was starting to study Slate recently. As an exercise I've implemented
a skiplist as there wasn't one in the collection library. Naming
(SkipListNode) came from the Squeak implementation but as I developped
it test-first there should not be too much resemblance with it.
Unit test are at the end of the file.
I would appreciate any comments on style, language use, etc.
Tested on Slate-0.3.1 but if I followed the list thoroughly there was no
laguage spec change in the basic features besides delegation what I did
not use in that depth.
Thanks,
Marton
-------------- next part --------------
addPrototype: #SkipListNode derivedFrom: {Cloneable}.
SkipListNode addSlot: #pointers.
SkipListNode addSlot: #object.
sln@(SkipListNode traits) next
[
sln pointers first
].
sln@(SkipListNode traits) forward: level
[
sln pointers at: level
].
addPrototype: #SkipList derivedFrom: {Collection}.
SkipList traits addSlot: #random valued: RandomStream.
SkipList traits random seed: 5.
SkipList addSlot: #pointers valued: {}.
SkipList addSlot: #maxLevel.
SkipList addSlot: #numElements.
sl@(SkipList traits) clear
[
0 below: sl maxLevel do: [| :i | sl pointers at: i put: Nil].
sl numElements: 0.
].
sl@(SkipList traits) isEmpty
[
sl pointers first isNil
].
sl@(SkipList traits) newEmpty
[| newSL |
newSL: sl clone.
newSL pointers: (Array newSize: 5).
newSL maxLevel: 5.
newSL numElements: 0.
newSL
].
sl@(SkipList traits) newSize: _
[
sl newEmpty
].
sl@(SkipList traits) newEmptyWithLevel: level
[| newSL |
newSL: sl clone.
newSL pointers (Array newSize: level).
newSL maxLevel: level.
newSL numElements: 0.
newSL
].
sl@(SkipList traits) size
[
sl numElements
].
sl@(SkipList traits) newPointerLength
"Determines the number of non-Nil elements in the node pointers."
[
(((sl random next) / 16rFFFFFFFF) * (sl maxLevel)) truncated
].
sl@(SkipList traits) neighboursFor: anObject
"Helper method to create the pointers to the (new) node."
[| node nextptrs |
nextptrs: (Array newSize: sl maxLevel).
sl maxLevel - 1 downTo: 0 do:
[| :level |
node ifNil: [ node: (sl pointers at: level)].
node isNotNil ifTrue: [
node object < anObject
ifTrue: [
[(node forward: level) isNotNil /\
[(node forward: level) object < anObject]]
whileTrue: [
node: (node forward: level)].
nextptrs at: level put: node]
ifFalse: [
node: Nil.
nextptrs at: level put: Nil]]].
nextptrs
].
sl@(SkipList traits) add: anObject
[
sl isEmpty
ifTrue:
[| newNode |
newNode: SkipListNode clone.
newNode object: anObject.
newNode pointers: (Array newSize: sl maxLevel).
0 below: sl maxLevel do: [| :i |
sl pointers at: i put: newNode.
newNode pointers at: i put: Nil]]
ifFalse:
[| nextptrs newNode |
nextptrs: (sl neighboursFor: anObject).
newNode: SkipListNode clone.
newNode object: anObject.
newNode pointers: (Array newSize: sl maxLevel).
0 upTo: sl newPointerLength do:
[| :level |
(nextptrs at: level)
ifNil:
[newNode pointers at: level put: (sl pointers at: level).
sl pointers at: level put: newNode]
ifNotNil:
[| nodePtr |
nodePtr: (nextptrs at: level) pointers.
newNode pointers at: level put: (nodePtr at: level).
nodePtr at: level put: newNode]]].
sl numElements: sl numElements + 1.
anObject
].
sl@(SkipList traits) includes: anObject
[| nextptrs newNode |
sl isEmpty ifTrue: [^ False].
nextptrs: (sl neighboursFor: anObject).
(nextptrs first)
ifNil: [^ (sl pointers first object = anObject)]
ifNotNil: [
(nextptrs first pointers first)
ifNil: [^ False]
ifNotNilDo: [| :node | ^ (node object = anObject)]].
].
sl@(SkipList traits) add: anObject ifPresent: block
[
(sl includes: anObject)
ifTrue: [block do]
ifFalse: [sl add: anObject]
].
sl@(SkipList traits) remove: anObject
[
sl isEmpty ifFalse: [| nextptrs |
nextptrs: (sl neighboursFor: anObject).
nextptrs first
ifNil: [| node |
node: sl pointers first.
node object = anObject ifTrue: [
0 below: sl maxLevel do: [| :i |
sl pointers at: i put: (node pointers at: i)].
sl numElements: sl numElements - 1]]
ifNotNilDo: [| :neighbour |
neighbour pointers first
ifNotNilDo: [| :candidate |
candidate object = anObject ifTrue: [
0 below: sl maxLevel do: [| :i |
(nextptrs at: i)
ifNotNilDo: [| :node |
node pointers at: i put:
(candidate pointers at: i)]].
sl numElements: sl numElements - 1]]]]
].
sl@(SkipList traits) remove: anObject ifAbsent: block
[
(sl includes: anObject)
ifTrue: [sl remove: anObject]
ifFalse: [block do]
].
sl@(SkipList traits) do: block
[| elem |
"Console ; 'do started'."
elem: sl pointers first.
[elem isNotNil]
whileTrue: [
block applyWith: elem object.
elem: elem pointers first]
].
sl@(SkipList traits) reverseDo: block
[| obj elements index |
obj: sl pointers first.
elements: (Array newSize: sl size).
index: sl size - 1.
[obj isNotNil]
whileTrue: [
elements at: index put: obj object.
index: index - 1.
obj: obj pointers first].
elements do: block.
].
UnitTests addPrototype: #SkipList derivedFrom: {TestCase}.
tc@(UnitTests SkipList traits) isEmpty
[| sl |
sl: SkipList newEmpty.
tc assert: sl isEmpty description: 'new SkipList states that it is empty'.
].
tc@(UnitTests SkipList traits) size
[| sl |
sl: SkipList newEmpty.
tc assert: sl size = 0 description: 'empty SkipList has non-zero size'.
].
tc@(UnitTests SkipList traits) newPointerLength
[| sl sum |
sl: SkipList newEmpty.
sum: 0.
10 timesRepeat: [ sum: sum + sl newPointerLength ].
tc assert: (sum between: 15 and: 25) description:
'pointerlength average is incorrect'.
].
tc@(UnitTests SkipList traits) forward
[| sln |
sln: SkipListNode clone.
sln pointers: (Array newSize: 5).
0 upTo: 4 do: [| :i | sln pointers at: i put: i].
0 upTo: 4 do: [| :i |
tc assert: (sln forward: i) = i description: 'forward answers wrong value'.].
].
tc@(UnitTests SkipList traits) add
[| sl |
sl: SkipList newEmpty.
sl add: 2.
tc assert: (sl size) = 1 description: 'added one item but size is not one'.
sl add: 5.
tc assert: (sl size) = 2 description: 'could not add item at last place'.
sl add: 1.
tc assert: (sl size) = 3 description: 'added as first does not increase size'.
].
tc@(UnitTests SkipList traits) includes
[| sl |
sl: SkipList newEmpty.
sl add: 2.
tc assert: (sl includes: 2) description: 'first added object is not included'.
sl add: 5.
tc assert: (sl includes: 5) description: 'second added object is not included'.
sl add: 1.
tc assert: (sl includes: 1) description: 'added as first not included'.
sl add: 3.
tc assert: (sl includes: 3) description: 'inserted not included'.
tc assert: (sl includes: 4) not description: 'includes unadded object'.
].
tc@(UnitTests SkipList traits) remove
[| sl |
sl: SkipList newEmpty.
sl add: 4.
sl remove: 4.
tc assert: sl isEmpty description: 'not empty after add-remove'.
0 upTo: 10 do: [| :i | sl add: i].
tc assert: (sl size) = 11 description: 'pre-test check'.
sl remove: 3.
tc assert: (sl size) = 10 description: 'remove does not decrease size'.
tc assert: (sl includes: 3) not description: 'found after removal'.
].
tc@(UnitTests SkipList traits) do
[| sl sum counter |
sl: SkipList newEmpty.
0 upTo: 9 do: [| :i | sl add: i].
sum: 0.
sl do: [| :obj | obj < 5 ifTrue: [sum: sum + obj]].
tc assert: sum = 10 description: 'do on first elements failed'.
sum: 0.
sl do: [| :obj | obj > 4 ifTrue: [sum: sum + obj]].
tc assert: sum = 35 description: 'do on last elements failed'.
sum: 0.
counter: 0.
sl do: [| :obj |
obj < 5 /\ [counter < 5]
ifTrue: [sum: sum + obj. counter: counter + 1]].
tc assert: sum = 10 description: 'summed incorrect elements'.
].
tc@(UnitTests SkipList traits) reverseDoAndSequence
"Test reverseDo and sequence of elements."
[| sl sum counter |
sl: SkipList newEmpty.
0 upTo: 9 do: [| :i | sl add: i].
sum: 0.
counter: 0.
sl reverseDo: [| :obj |
counter < 5 ifTrue: [
counter: counter + 1.
obj < 8 ifTrue: [sum: sum + obj]]].
tc assert: sum = 18 description: 'reverse do on selected from first half failed'.
sum: 0.
counter: 0.
sl reverseDo: [| :obj |
counter < 8 ifTrue: [
counter: counter + 1.
obj < 5 ifTrue: [sum: sum + obj]]].
tc assert: sum = 9 description: 'reverse do on selection failed'.
].
tc@(UnitTests SkipList traits) addIfPresent
[| sl counter |
sl: SkipList newEmpty.
0 upTo: 9 do: [| :i | sl add: i].
counter: 0.
0 upTo: 9 do: [| :i | sl add: i ifPresent: [counter: counter + 1]].
tc assert: counter = 10 description: 'added object when present'.
].
tc@(UnitTests SkipList traits) removeIfAbsent
[| sl counter |
sl: SkipList newEmpty.
counter: 0.
0 upTo: 9 do: [| :i |
sl remove: i ifAbsent: [
counter: counter + 1.
sl add: i]].
0 upTo: 9 do: [| :i | sl remove: i ifAbsent: [counter: counter - 1]].
tc assert: counter = 10 description: 'removing absent object?'.
].
tc@(UnitTests SkipList traits) suite
[| suite |
suite: TestSuite newEmpty.
suite tests addAll:
{
tc newForSelector: #size.
tc newForSelector: #newPointerLength.
tc newForSelector: #isEmpty.
tc newForSelector: #forward.
tc newForSelector: #add.
tc newForSelector: #includes.
tc newForSelector: #remove.
tc newForSelector: #do.
tc newForSelector: #reverseDoAndSequence.
tc newForSelector: #addIfPresent.
tc newForSelector: #removeIfAbsent.
}.
suite
].
More information about the Slate
mailing list