1# skiplist.tcl -- 2# 3# Implementation of a skiplist data structure for Tcl. 4# 5# To quote the inventor of skip lists, William Pugh: 6# Skip lists are a probabilistic data structure that seem likely 7# to supplant balanced trees as the implementation method of 8# choice for many applications. Skip list algorithms have the 9# same asymptotic expected time bounds as balanced trees and are 10# simpler, faster and use less space. 11# 12# For more details on how skip lists work, see Pugh, William. Skip 13# lists: a probabilistic alternative to balanced trees in 14# Communications of the ACM, June 1990, 33(6) 668-676. Also, see 15# ftp://ftp.cs.umd.edu/pub/skipLists/ 16# 17# Copyright (c) 2000 by Keith Vetter 18# This software is licensed under a BSD license as described in tcl/tk 19# license.txt file but with the copyright held by Keith Vetter. 20# 21# TODO: 22# customize key comparison to a user supplied routine 23 24namespace eval ::struct {} 25 26namespace eval ::struct::skiplist { 27 # Data storage in the skiplist module 28 # ------------------------------- 29 # 30 # For each skiplist, we have the following arrays 31 # state - holds the current level plus some magic constants 32 # nodes - all the nodes in the skiplist, including a dummy header node 33 34 # counter is used to give a unique name for unnamed skiplists 35 variable counter 0 36 37 # Internal constants 38 variable MAXLEVEL 16 39 variable PROB .5 40 variable MAXINT [expr {0x7FFFFFFF}] 41 42 # commands is the list of subcommands recognized by the skiplist 43 variable commands [list \ 44 "destroy" \ 45 "delete" \ 46 "insert" \ 47 "search" \ 48 "size" \ 49 "walk" \ 50 ] 51 52 # State variables that can be set in the instantiation 53 variable vars [list maxlevel probability] 54 55 # Only export one command, the one used to instantiate a new skiplist 56 namespace export skiplist 57} 58 59# ::struct::skiplist::skiplist -- 60# 61# Create a new skiplist with a given name; if no name is given, use 62# skiplistX, where X is a number. 63# 64# Arguments: 65# name name of the skiplist; if null, generate one. 66# 67# Results: 68# name name of the skiplist created 69 70proc ::struct::skiplist::skiplist {{name ""} args} { 71 set usage "skiplist name ?-maxlevel ##? ?-probability ##?" 72 variable counter 73 74 if { [llength [info level 0]] == 1 } { 75 incr counter 76 set name "skiplist${counter}" 77 } 78 79 if { ![string equal [info commands ::$name] ""] } { 80 error "command \"$name\" already exists, unable to create skiplist" 81 } 82 83 # Handle the optional arguments 84 set more_eval "" 85 for {set i 0} {$i < [llength $args]} {incr i} { 86 set flag [lindex $args $i] 87 incr i 88 if { $i >= [llength $args] } { 89 error "value for \"$flag\" missing: should be \"$usage\"" 90 } 91 set value [lindex $args $i] 92 switch -glob -- $flag { 93 "-maxl*" { 94 set n [catch {set value [expr $value]}] 95 if {$n || $value <= 0} { 96 error "value for the maxlevel option must be greater than 0" 97 } 98 append more_eval "; set state(maxlevel) $value" 99 } 100 "-prob*" { 101 set n [catch {set value [expr $value]}] 102 if {$n || $value <= 0 || $value >= 1} { 103 error "probability must be between 0 and 1" 104 } 105 append more_eval "; set state(prob) $value" 106 } 107 default { 108 error "unknown option \"$flag\": should be \"$usage\"" 109 } 110 } 111 } 112 113 # Set up the namespace for this skiplist 114 namespace eval ::struct::skiplist::skiplist$name { 115 variable state 116 variable nodes 117 118 # NB. maxlevel and prob may be overridden by $more_eval at the end 119 set state(maxlevel) $::struct::skiplist::MAXLEVEL 120 set state(prob) $::struct::skiplist::PROB 121 set state(level) 1 122 set state(cnt) 0 123 set state(size) 0 124 125 set nodes(nil,key) $::struct::skiplist::MAXINT 126 set nodes(header,key) "---" 127 set nodes(header,value) "---" 128 129 for {set i 1} {$i < $state(maxlevel)} {incr i} { 130 set nodes(header,$i) nil 131 } 132 } $more_eval 133 134 # Create the command to manipulate the skiplist 135 interp alias {} ::$name {} ::struct::skiplist::SkiplistProc $name 136 137 return $name 138} 139 140########################### 141# Private functions follow 142 143# ::struct::skiplist::SkiplistProc -- 144# 145# Command that processes all skiplist object commands. 146# 147# Arguments: 148# name name of the skiplist object to manipulate. 149# args command name and args for the command 150# 151# Results: 152# Varies based on command to perform 153 154proc ::struct::skiplist::SkiplistProc {name {cmd ""} args} { 155 # Do minimal args checks here 156 if { [llength [info level 0]] == 2 } { 157 error "wrong # args: should be \"$name option ?arg arg ...?\"" 158 } 159 160 # Split the args into command and args components 161 if { [llength [info commands ::struct::skiplist::_$cmd]] == 0 } { 162 variable commands 163 set optlist [join $commands ", "] 164 set optlist [linsert $optlist "end-1" "or"] 165 error "bad option \"$cmd\": must be $optlist" 166 } 167 eval [linsert $args 0 ::struct::skiplist::_$cmd $name] 168} 169 170## ::struct::skiplist::_destroy -- 171# 172# Destroy a skiplist, including its associated command and data storage. 173# 174# Arguments: 175# name name of the skiplist. 176# 177# Results: 178# None. 179 180proc ::struct::skiplist::_destroy {name} { 181 namespace delete ::struct::skiplist::skiplist$name 182 interp alias {} ::$name {} 183} 184 185# ::struct::skiplist::_search -- 186# 187# Searches for a key in a skiplist 188# 189# Arguments: 190# name name of the skiplist. 191# key key for the node to search for 192# 193# Results: 194# 0 if not found 195# [list 1 node_value] if found 196 197proc ::struct::skiplist::_search {name key} { 198 upvar ::struct::skiplist::skiplist${name}::state state 199 upvar ::struct::skiplist::skiplist${name}::nodes nodes 200 201 set x header 202 for {set i $state(level)} {$i >= 1} {incr i -1} { 203 while {1} { 204 set fwd $nodes($x,$i) 205 if {$nodes($fwd,key) == $::struct::skiplist::MAXINT} break 206 if {$nodes($fwd,key) >= $key} break 207 set x $fwd 208 } 209 } 210 set x $nodes($x,1) 211 if {$nodes($x,key) == $key} { 212 return [list 1 $nodes($x,value)] 213 } 214 return 0 215} 216 217# ::struct::skiplist::_insert -- 218# 219# Add a node to a skiplist. 220# 221# Arguments: 222# name name of the skiplist. 223# key key for the node to insert 224# value value of the node to insert 225# 226# Results: 227# 0 if new node was created 228# level if existing node was updated 229 230proc ::struct::skiplist::_insert {name key value} { 231 upvar ::struct::skiplist::skiplist${name}::state state 232 upvar ::struct::skiplist::skiplist${name}::nodes nodes 233 234 set x header 235 for {set i $state(level)} {$i >= 1} {incr i -1} { 236 while {1} { 237 set fwd $nodes($x,$i) 238 if {$nodes($fwd,key) == $::struct::skiplist::MAXINT} break 239 if {$nodes($fwd,key) >= $key} break 240 set x $fwd 241 } 242 set update($i) $x 243 } 244 set x $nodes($x,1) 245 246 # Does the node already exist? 247 if {$nodes($x,key) == $key} { 248 set nodes($x,value) $value 249 return 0 250 } 251 252 # Here to insert item 253 incr state(size) 254 set lvl [randomLevel $state(prob) $state(level) $state(maxlevel)] 255 256 # Did the skip list level increase??? 257 if {$lvl > $state(level)} { 258 for {set i [expr {$state(level) + 1}]} {$i <= $lvl} {incr i} { 259 set update($i) header 260 } 261 set state(level) $lvl 262 } 263 264 # Create a unique new node name and fill in the key, value parts 265 set x [incr state(cnt)] 266 set nodes($x,key) $key 267 set nodes($x,value) $value 268 269 for {set i 1} {$i <= $lvl} {incr i} { 270 set nodes($x,$i) $nodes($update($i),$i) 271 set nodes($update($i),$i) $x 272 } 273 274 return $lvl 275} 276 277# ::struct::skiplist::_delete -- 278# 279# Deletes a node from a skiplist 280# 281# Arguments: 282# name name of the skiplist. 283# key key for the node to delete 284# 285# Results: 286# 1 if we deleted a node 287# 0 otherwise 288 289proc ::struct::skiplist::_delete {name key} { 290 upvar ::struct::skiplist::skiplist${name}::state state 291 upvar ::struct::skiplist::skiplist${name}::nodes nodes 292 293 set x header 294 for {set i $state(level)} {$i >= 1} {incr i -1} { 295 while {1} { 296 set fwd $nodes($x,$i) 297 if {$nodes($fwd,key) >= $key} break 298 set x $fwd 299 } 300 set update($i) $x 301 } 302 set x $nodes($x,1) 303 304 # Did we find a node to delete? 305 if {$nodes($x,key) != $key} { 306 return 0 307 } 308 309 # Here when we found a node to delete 310 incr state(size) -1 311 312 # Unlink this node from all the linked lists that include to it 313 for {set i 1} {$i <= $state(level)} {incr i} { 314 set fwd $nodes($update($i),$i) 315 if {$nodes($fwd,key) != $key} break 316 set nodes($update($i),$i) $nodes($x,$i) 317 } 318 319 # Delete all traces of this node 320 foreach v [array names nodes($x,*)] { 321 unset nodes($v) 322 } 323 324 # Fix up the level in case it went down 325 while {$state(level) > 1} { 326 if {! [string equal "nil" $nodes(header,$state(level))]} break 327 incr state(level) -1 328 } 329 330 return 1 331} 332 333# ::struct::skiplist::_size -- 334# 335# Returns how many nodes are in the skiplist 336# 337# Arguments: 338# name name of the skiplist. 339# 340# Results: 341# number of nodes in the skiplist 342 343proc ::struct::skiplist::_size {name} { 344 upvar ::struct::skiplist::skiplist${name}::state state 345 346 return $state(size) 347} 348 349# ::struct::skiplist::_walk -- 350# 351# Walks a skiplist performing a specified command on each node. 352# Command is executed at the global level with the actual command 353# executed is: command key value 354# 355# Arguments: 356# name name of the skiplist. 357# cmd command to run on each node 358# 359# Results: 360# none. 361 362proc ::struct::skiplist::_walk {name cmd} { 363 upvar ::struct::skiplist::skiplist${name}::nodes nodes 364 365 for {set x $nodes(header,1)} {$x != "nil"} {set x $nodes($x,1)} { 366 # Evaluate the command at this node 367 set cmdcpy $cmd 368 lappend cmdcpy $nodes($x,key) $nodes($x,value) 369 uplevel 2 $cmdcpy 370 } 371} 372 373# ::struct::skiplist::randomLevel -- 374# 375# Generates a random level for a new node. We limit it to 1 greater 376# than the current level. 377# 378# Arguments: 379# prob probability to use in generating level 380# level current biggest level 381# maxlevel biggest possible level 382# 383# Results: 384# an integer between 1 and $maxlevel 385 386proc ::struct::skiplist::randomLevel {prob level maxlevel} { 387 388 set lvl 1 389 while {(rand() < $prob) && ($lvl < $maxlevel)} { 390 incr lvl 391 } 392 393 if {$lvl > $level} { 394 set lvl [expr {$level + 1}] 395 } 396 397 return $lvl 398} 399 400# ::struct::skiplist::_dump -- 401# 402# Dumps out a skip list. Useful for debugging. 403# 404# Arguments: 405# name name of the skiplist. 406# 407# Results: 408# none. 409 410proc ::struct::skiplist::_dump {name} { 411 upvar ::struct::skiplist::skiplist${name}::state state 412 upvar ::struct::skiplist::skiplist${name}::nodes nodes 413 414 415 puts "Current level $state(level)" 416 puts "Maxlevel: $state(maxlevel)" 417 puts "Probability: $state(prob)" 418 puts "" 419 puts "NODE KEY FORWARD" 420 for {set x header} {$x != "nil"} {set x $nodes($x,1)} { 421 puts -nonewline [format "%-6s %3s %4s" $x $nodes($x,key) $nodes($x,1)] 422 for {set i 2} {[info exists nodes($x,$i)]} {incr i} { 423 puts -nonewline [format %4s $nodes($x,$i)] 424 } 425 puts "" 426 } 427} 428 429# ### ### ### ######### ######### ######### 430## Ready 431 432namespace eval ::struct { 433 # Get 'skiplist::skiplist' into the general structure namespace. 434 namespace import -force skiplist::skiplist 435 namespace export skiplist 436} 437package provide struct::skiplist 1.3 438