[Keith Vetter] 2003-11-21 : Skip lists are really cool. They're
''a probabilistic data structure that seem likely to supplant balanced trees''.
They implement all of balanced trees major
operations like search, insert, delete, merge, etc. with the
same time bounds of '''O(log n)''', but with a smaller constant
factor.
I just noticed that there is now a [skiplist] module as part
of the [struct] module of [tcllib]. This is code I wrote a while
ago and completely forgot about--thanks to whoever picked up the ball
and got it into tcllib.
Skip lists have a ''probabilistic'' time bound meaning that the worst
case behavior can be bad but, due to using randomness, the probability
of this happening can be bounded. This is much like quicksort which
pivots on a random element. In comparison, AVL trees, 2-3 trees and
red-black trees have a deterministic bound and splay trees have an
amortized bound.
Here's a little demo illustrating how skip lists work. It exploits
inner knowledge of how the tcllib skiplist module works. More more
details of this cool data structure see the reference on the tcllib
[skiplist] page.
----======
##+##########################################################################
#
# skiplist.tcl - Demos for how skiplists work
# by Keith Vetter, November 21, 2003
#
# NB. uses internal knowledge of tcllib's ::struct::skiplist package
#
package require Tk 8.2
package require struct 1.3
set S(title) "Skip Lists"
array set S {lm 20 bm 20 box,x 30 box,y 15 box,dy 0 box,dx 20 MaxKey 1000}
array set S {bg antiquewhite2 c,link cyan c,value yellow c,nil lightgreen}
proc DoDisplay {} {
global S
wm title . $S(title)
wm geom . +10+10
pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
-side bottom -fill x -ipadx 5
pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1
set w [expr {[winfo screenwidth .] - 100}]
if {$w > 900} {set w 900}
canvas .c -relief raised -bd 0 -height 200 -width $w \
-xscrollcommand {.sb set} -bg $S(bg) -highlightthickness 0
.c create text -100 -100 -tag txt
eval font create bfont "[font actual [.c itemcget txt -font]] -weight bold"
.c delete txt
label .msg -font {Times 24} -text "Skip List Demo" -bg $S(bg)
scrollbar .sb -orient horizontal -command {.c xview}
pack .msg -in .screen -side top -fill x
pack .c -in .screen -side top -fill both -expand 1
pack .sb -in .screen -side bottom -fill x
bind all <Key-F2> {console show}
DoCtrlFrame
trace variable S(key) w tracer
set S(key) ""
update
focus .key
}
proc DoCtrlFrame {} {
global S
frame .row2
button .insert -text "Insert" -bd 4 -command DoInsert
.insert configure -font "[font actual [.insert cget -font]] -weight bold"
option add *Button.font [.insert cget -font]
option add *Label.font [.insert cget -font]
button .search -text "Search" -bd 4 -command DoSearch
button .delete -text "Delete" -bd 4 -command DoDelete
button .reset -text "Reset" -bd 4 -command Reset
button .random -text "Insert Random" -bd 4 -command DoInsertRandom
label .lkey -text "Key:"
entry .key -textvariable S(key) -width 6 -justify center
label .lvalue -text "Value:"
entry .value -textvariable S(value) -width 6 -justify center
label .lresult -text "Result:"
label .result -textvariable S(result) -bd 2 -bg white -width 30 \
-relief ridge
button .about -text About -bd 4 -command \
[list tk_messageBox -message "$S(title)\nby Keith Vetter, November 2003"]
grid .lkey .key .lvalue .value .search .insert .delete .lresult .result \
-in .ctrl -row 0 -sticky news
grid .row2 -columnspan 20 -in .ctrl -row 1 -sticky ew -pady 5
grid .reset .random .about -in .row2 -row 1 -sticky news -padx 5
grid config .search .insert .delete -padx 5
grid columnconfigure .ctrl 50 -weight 1
grid columnconfigure .row2 50 -weight 1
grid rowconfigure .row2 0 -minsize 10
}
proc tracer {var1 var2 op} {
global S
set state disabled
if {[string is integer -strict $S(key)]} {set state normal}
foreach w [list .search .insert .delete] {
$w config -state $state
}
}
proc Pos2XY {lvl nth} {
global S
set xy {}
set cx [expr {$S(lm) + ($nth+.5) * ($S(box,x) + $S(box,dx))}]
set cy [winfo height .c]
set cy [expr {$cy - $S(bm) - ($lvl+.5) * ($S(box,y) + $S(box,dy))}]
if {$lvl > 0} {set cy [expr {$cy - 5}]}
set l [expr {$cx - $S(box,x) / 2.0}]
set t [expr {$cy - $S(box,y) / 2.0}]
set r [expr {$l + $S(box,x)}]
set b [expr {$t + $S(box,y)}]
return [list $cx $cy $l $t $r $b]
}
proc DrawSkiplist {} {
global S nodes state nid2pos key2pos
.c delete all
set S(msg) "Skiplist: Level: $state(level) Probability: $state(prob)"
catch {unset nid2pos}
for {set x header; set cnt 0} {$x != "nil"} {set x $nodes($x,1); incr cnt} {
set nid2pos($x) $cnt
set key2pos($nodes($x,key)) $cnt
}
for {set x header; set cnt 0} {$x != "nil"} {set x $nodes($x,1); incr cnt} {
DrawNode $x
}
foreach {x0 y0 x1 y1} [.c bbox all] break
incr x1 $S(lm)
.c config -scrollregion [list 0 $y0 $x1 $y1]
}
proc DrawNode {nid} {
global state nodes nid2pos S
set lvls [llength [array names nodes $nid,*]]
incr lvls -1
if {$lvls > $state(level)+1} { set lvls [expr {$state(level) + 2}] }
for {set lvl 0} {$lvl < $lvls} {incr lvl} {
set xy [Pos2XY $lvl $nid2pos($nid)]
foreach {cx cy x0 y0 x1 y1} $xy break
set n [.c create rect $x0 $y0 $x1 $y1]
if {$lvl == 0} {
.c itemconfig $n -width 2 -fill $S(c,value)
.c create text $cx $cy -anchor c -text $nodes($nid,key) -font bfont
if {1} {
set xy [Pos2XY -1 $nid2pos($nid)]
foreach {cx2 cy2} $xy break
.c create text $cx2 $cy2 -text $nid -font bfont
}
} elseif {$nodes($nid,$lvl) == "nil"} {
.c itemconfig $n -fill $S(c,nil)
.c create text $cx $cy -anchor c -text \u03a9 -tag nil -font bfont
} else {
.c itemconfig $n -fill $S(c,link)
set xy [Pos2XY $lvl $nid2pos($nodes($nid,$lvl))]
foreach {cx2 cy2 x3 y3} $xy break
.c create oval [Box $cx $cy 3] -fill black
.c create line $cx $cy $x3 $cy2 -arrow last -width 2
}
}
}
proc Box {x y d} {
return [list [expr {$x-$d}] [expr {$y-$d}] [expr {$x+$d}] [expr {$y+$d}]]
}
proc DoInsert {} {
global S
set n [mySList insert $S(key) $S(value)]
DrawSkiplist
if {$n} {
set S(result) "Inserted: node (key=$S(key) value=$S(value))"
} else {
set S(result) "Updated: node (key=$S(key) value=$S(value))"
}
}
proc DoDelete {} {
global S
foreach {k v} [mySList search $S(key)] break
if {$k == 0} {
set S(result) "Cannot find node with key '$S(key)'"
return
}
mySList delete $S(key)
DrawSkiplist
set S(result) "Deleted: node (key=$S(key) value=$S(value))"
}
proc DoInsertRandom {{draw 1}} {
global S
for {set i 0} {$i < $S(MaxKey)} {incr i} {
set S(key) [expr {int(rand() * $S(MaxKey))}]
if {[llength [mySList search $S(key)]] == 1} break
}
set S(value) V$S(key)
mySList insert $S(key) $S(value)
if {$draw} {
DrawSkiplist
set S(result) "Random: node (key=$S(key) value=$S(value))"
}
}
proc Reset {{draw 1}} {
uplevel \#0 {
set name mySList
catch {$name destroy}
::struct::skiplist $name
upvar \#0 ::struct::skiplist::skiplist${name}::state state
upvar \#0 ::struct::skiplist::skiplist${name}::nodes nodes
}
if {$draw} DrawSkiplist
set S(key) [set S(value) ""]
set S(result) ""
}
proc DoSearch {} {
global S nid2pos nodes
.c delete search
foreach {found path} [SkipSearch $S(key)] break
set x -1
foreach {nid lvl} $path {
if {$nid == "nil"} continue
set xy [Pos2XY $lvl $nid2pos($nid)]
foreach {cx cy x0 y0 x1 y1} $xy break
if {$x != -1} {
set xy [MakeArc $x $y $cx $y0]
.c create line $xy -tag search -fill red -width 2 -arrow last \
-smooth 1
}
set x $cx
set y $y0
}
if {$found == 0} {
set S(value) ""
set S(result) "Not found: node with key $S(key)"
} else {
set S(value) $nodes($nid,value)
set S(result) "Found: node (key=$S(key) value=$S(value))"
}
}
proc SkipSearch {key} {
global S nodes state
set look {}
set x header
for {set i $state(level)} {$i >= 1} {incr i -1} {
lappend look $x $i
while {1} {
set fwd $nodes($x,$i)
lappend look $fwd $i
if {$nodes($fwd,key) == $::struct::skiplist::MAXINT} break
if {$nodes($fwd,key) >= $key} break
set x $fwd
}
}
set x $nodes($x,1)
if {$nodes($x,key) == $key} {
return [list 1 $look]
}
return [list 0 $look]
}
proc MakeArc {x0 y0 x1 y1} {
if {$x0 == $x1} {return [list $x0 $y0 $x1 $y1]}
set cx [expr {($x0 + $x1) / 2}]
if {abs($x0 - $x1) < 100} {
set cy [expr {$y0 - 20}]
} else {
set cy [expr {$y0 - 50}]
}
return [list $x0 $y0 $cx $cy $x1 $y1]
}
################################################################
DoDisplay
Reset 0
for {set i 0} {$i < 15} {incr i} {
DoInsertRandom 0
}
DrawSkiplist======
----
frame appears not to support the options -padx and -pady (in Tcl 8.3).
----
(Deleted some code that seemed to have crept in from [A tiny input manager].)
----
[C
<<categoryies>> Algorithm]