[R-gregmisc-users] SF.net SVN: r-gregmisc:[1767] trunk/gtools

[<wa...@us...>]

Revision: 1767
          http://sourceforge.net/p/r-gregmisc/code/1767
Author:   warnes
Date:     2014-01-14 19:37:16 +0000 (Tue, 14 Jan 2014)
Log Message:
-----------
Add test file for binsearch() function.

Added Paths:
-----------
    trunk/gtools/tests/
    trunk/gtools/tests/test_binsearch.R

Added: trunk/gtools/tests/test_binsearch.R
===================================================================
--- trunk/gtools/tests/test_binsearch.R	                        (rev 0)
+++ trunk/gtools/tests/test_binsearch.R	2014-01-14 19:37:16 UTC (rev 1767)
@@ -0,0 +1,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" ) )
+
+
+
+
+
+

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.