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