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