[Keith Vetter] 2003-11-21 : [http://en.wikipedia.org/wiki/Skip_list%|%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].)




<<categories>> Algorithm