tests/test_binsearch.R

In gtools: Various R Programming Tools

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