SkipList Demo

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.)

Category Algorithm