1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
library(gtools)
##############################
### Examples from man page ###
##############################
### Toy examples
# search for x=10
s <- binsearch( function(x) x-10, range=c(0,20) )
stopifnot(s$where==10)
# search for x=10.1
s <- binsearch( function(x) x-10.1, range=c(0,20) )
stopifnot( s$where==c(10,11) )
### Classical toy example
# binary search for the index of 'M' among the sorted letters
fun <- function(X) ifelse(LETTERS[X] > 'M', 1,
ifelse(LETTERS[X] < 'M', -1, 0 ) )
s = binsearch( fun, range=1:26 )
stopifnot( LETTERS[s$where]=="M")
##################################
### Test boundary contiditions ###
##################################
s = binsearch(fun = function(x) x-10, range=c(1,10) )
with(s, stopifnot(where==10, value==0, flag=="Found") )
s = binsearch(fun = function(x) x-1, range=c(1,10) )
with(s, stopifnot(where==1, value==0, flag=="Found") )
checkWarning <- function( expr )
{
myEnv <- environment()
catchWarning <- function(w) {
assign("warningValue", w, pos=myEnv)
invokeRestart("muffleWarning")
}
retval <- withCallingHandlers(expr = expr,
warning = catchWarning)
if( !exists("warningValue", where=myEnv, inherits=FALSE) )
stop("Expected a warning message")
}
checkWarning( s <- binsearch(fun = function(x) x-10, range=c(1,9) ) )
with(s, stopifnot(where==9, value==-1, flag=="Upper Boundary" ) )
checkWarning( s <- binsearch(fun = function(x) x-1, range=c(2,10) ) )
with(s, stopifnot(where==2, value==1, flag=="Lower Boundary" ) )
|
