better argument checks for seq_dist and seq_distmatrix

markvanderloo · Aug 7, 2015 · 21d7375 · 21d7375
1 parent 1b70511
commit 21d7375
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 12 deletions.
diff --git a/pkg/R/seqdist.R b/pkg/R/seqdist.R
@@ -49,12 +49,11 @@ seq_dist <- function(a, b
   , q=1, p=0
   , nthread = getOption("sd_num_thread")
 ){
+  stopifnot(is.list(a),is.list(b))
   stopifnot(all_int(a), all_int(b))
 
   stopifnot(
-    is.list(a)
-    , is.list(b)
-    , all(is.finite(weight))
+     all(is.finite(weight))
     , all(weight > 0)
     , all(weight <=1)
     , q >= 0
@@ -96,6 +95,7 @@ seq_distmatrix <- function(a, b
   method <- match.arg(method)
   nthread <- as.integer(nthread)
   if (method == 'jw') weight <- weight[c(2,1,3)]
+  stopifnot(is.list(a))
   stopifnot(all_int(a))
 
   # if b is missing, generate a 'dist' object.  
@@ -107,7 +107,8 @@ seq_distmatrix <- function(a, b
         , nthread=nthread)
     )
   }
-  stopifnot(is.list(b),all_int(b))
+  stopifnot(is.list(b))
+  stopifnot(all_int(b))
   if (length(a) == 0 || length(b) == 0){ 
     return(matrix(numeric(0)))
   }
@@ -118,8 +119,13 @@ seq_distmatrix <- function(a, b
   }
 
 
-  x <- vapply(b, do_dist, USE.NAMES=FALSE, FUN.VALUE=numeric(length(a))
-        , b=a, method=method, weight=weight, q=q, p=p, nthread)
+  #x <- vapply(b, do_dist, USE.NAMES=FALSE, FUN.VALUE=numeric(length(a))
+  #      , b=a, method=method, weight=weight, q=q, p=p, nthread=nthread)
+
+  x <- vapply(b
+      , function(src) do_dist(list(src), b=a, method=method, weight=weight, q=q, p=p, nthread=nthread)
+      , USE.NAMES=FALSE, FUN.VALUE=numeric(length(a))
+    )
 
   if (useNames == "names" ){  
     structure(matrix(x,nrow=length(a),ncol=length(b), dimnames=list(rowns,colns)))

diff --git a/pkg/src/Rstringdist.c b/pkg/src/Rstringdist.c
@@ -330,20 +330,20 @@ SEXP R_lower_tri(SEXP a, SEXP method
 
 SEXP R_all_int(SEXP X){
   PROTECT(X);
-  SEXP all_char;
-  all_char = PROTECT(allocVector(LGLSXP,1L));
+  SEXP all_int;
+  all_int = PROTECT(allocVector(LGLSXP,1L));
 
   int n = length(X);
-  LOGICAL(all_char)[0] =  1L;
+  LOGICAL(all_int)[0] =  1L;
   for (int i=0; i<n; i++){
     if (TYPEOF(VECTOR_ELT(X,i)) != INTSXP){
-      LOGICAL(all_char)[0] = 0L;
+      LOGICAL(all_int)[0] = 0L;
       break;
     }
   }
 
   UNPROTECT(2);
-  return all_char;
+  return all_int;
 
 }
 

diff --git a/pkg/tests/testthat/testSeqDist.R b/pkg/tests/testthat/testSeqDist.R
@@ -39,14 +39,21 @@ test_that("Some edge cases",{
 })
 
 test_that("Elementary tests on seq_distmatrix",{
+  expect_error(seq_distmatrix(1:10))
+  expect_error(seq_distmatrix(1:10,list(1:10)))
+  expect_error(seq_distmatrix(list(1:10),1:10))
   expect_equivalent(
     as.matrix(seq_distmatrix(list(1:3,2:4)) )
     , matrix(c(0,2,2,0),nrow=2)
   )
-  expect_equivalent(
+  expect_equal(
     as.matrix(seq_distmatrix(list(x=1:3,y=2:4),useNames="names") )
     , matrix(c(0,2,2,0),nrow=2,dimnames=list(c('x','y'),c('x','y')))
   )
+  expect_equal(
+    seq_distmatrix(list(x=1:3,y=2:4),list(x=1:3,y=2:4),useNames="names")
+    , matrix(c(0,2,2,0),nrow=2,dimnames=list(c('x','y'),c('x','y')))
+  )
   expect_equal(class(seq_distmatrix(list(1:3,2:4))),"dist")
   expect_equivalent(
     as.matrix(seq_distmatrix(list(1:3,2:4)),seq_distmatrix(list(1:3,2:4),list(1:3,2:4)) )