TCV 2009-03-18 In Programming Pearls, Jon Bentley argues that binary search is one of the most important searches because it is conceptually easy to understand, yet is deceptively difficult to get right the first time. Here's some code that does a binary search on numbers, returning the position in the list or -1 if not found:
# <lst> - A presorted list of numbers to search through.
# <x> - The item to search for in the list.
proc binSrch {lst x} {
set len [llength $lst]
if {$len == 0} {
return -1
} else {
set pivotIndex [expr {$len / 2}]
set pivotValue [lindex $lst $pivotIndex]
if {$pivotValue == $x} {
return $pivotIndex
} elseif {$pivotValue < $x} {
set recursive [binSrch [lrange $lst $pivotIndex+1 end] $x]
return [expr {$recursive > -1 ? $recursive + $pivotIndex + 1 : -1}]
} elseif {$pivotValue > $x} {
set recursive [binSrch [lrange $lst 0 $pivotIndex-1] $x]
return [expr {$recursive > -1 ? $recursive : -1}]
}
}
}A potential problem with binSrch is that it returns the first position of x that it finds, which is not necessarily the earliest position that it appears in the list. A complete searching function which returns the position of the first occurrence of x in the list is:
# <lst> - A presorted list of numbers to search through.
# <x> - The item to search for in the list.
proc firstBinSrch {lst x} {
set len [llength $lst]
if {$len == 0} {
return -1
} else {
set pivotIndex [expr {$len / 2}]
set pivotValue [lindex $lst $pivotIndex]
if {$pivotValue == $x} {
set recursive [firstBinSrch [lrange $lst 0 $pivotIndex-1] $x]
return [expr {$recursive > -1 ? $recursive : $pivotIndex}]
} elseif {$pivotValue < $x} {
set recursive [firstBinSrch [lrange $lst $pivotIndex+1 end] $x]
return [expr {$recursive > -1 ? $recursive + $pivotIndex + 1 : -1}]
} elseif {$pivotValue > $x} {
set recursive [firstBinSrch [lrange $lst 0 $pivotIndex-1] $x]
return [expr {$recursive > -1 ? $recursive : -1}]
}
}
}PYK 2016-01-14:
Given a command like string is integer, which is true for all integers within some range, and false for all other integers, here are some procedures to find the endpoints of such a range:
proc around {integer test} {
set first [until $integer - $test]
set last [until $integer + $test]
return [list $first $last]
}
proc until {integer direction test} {
set lb $integer
set ub $integer
while {[{*}$test $ub]} {
set newub [expr $ub $direction ( abs($ub) * 2 ** [incr pwr])]
# Deal with 0
if {$newub == $ub} {
incr newub ${direction}1
}
set ub $newub
}
while 1 {
set num [expr {($lb + $ub) / 2}]
if {[{*}$test $num]} {
if {$num == $lb} {
break
}
set lb $num
} else {
if {$num == $ub} {
break
}
set ub $num
}
}
return $lb
}Example:
around 1 [list string is integer] ;# -> [list -4294967295 4294967295]