Fix bug in keep/except with zero-length vectors

gdemin · Oct 18, 2016 · 0b91ac0 · 0b91ac0
1 parent 8653524
commit 0b91ac0
Show file tree

Hide file tree

Showing 4 changed files with 48 additions and 1 deletion.
diff --git a/R/keep.R b/R/keep.R
@@ -83,6 +83,9 @@ except = function(data, ...){
 except.default = function(data, ...){
     vars = names(data)
     new_vars = -unique(keep_helper(vars, ...))
+    if(length(new_vars)==0){
+        return(data)
+    }
     res = data[new_vars]
     names(res) = vars[new_vars] # prevents names correction
     res
@@ -92,6 +95,9 @@ except.default = function(data, ...){
 except.data.frame = function(data, ...){
     vars = colnames(data)
     new_vars = -unique(keep_helper(vars, ...))
+    if(length(new_vars)==0){
+        return(data)
+    }
     res = data[ , new_vars, drop = FALSE]
     colnames(res) = vars[new_vars] # prevents names correction
     res
@@ -102,6 +108,9 @@ except.data.frame = function(data, ...){
 except.matrix = function(data, ...){
     vars = colnames(data)
     new_vars = -unique(keep_helper(vars, ...))
+    if(length(new_vars)==0){
+        return(data)
+    }
     res = data[ , new_vars, drop = FALSE]
     colnames(res) = vars[new_vars] # prevents names correction
     res
@@ -111,7 +120,14 @@ except.matrix = function(data, ...){
 
 keep_helper = function(old_names, ...){
     keep_names = numeric(0)
-    new_names = c(list(...), recursive = TRUE)
+    new_names = rapply(list(...), function(each){
+        if(!is.function(each) && !is.character(each)){
+            as.character(each)
+        } else {
+            each
+        }
+    }, how = "unlist")
+    # new_names = c(args, recursive = TRUE)
     characters_names = character(0) # for checking non-existing names
     for (each in new_names){
         if(is.character(each)){

diff --git a/R/vec_ops.R b/R/vec_ops.R
@@ -82,6 +82,7 @@
 #' @export
 #' @rdname vectors
 '%d%' = function(e1, e2){
+    if(is.null(e2)) return(e1)
     if (is.function(e2)){
         e1[!e2(e1)]
     } else {
@@ -120,6 +121,7 @@
 #' @export
 #' @rdname vectors
 '%n_d%' = function(e1, e2){
+    if(length(e2)==0) return(e1)
     n_d(e1, e2)
 }
 
@@ -149,10 +151,12 @@ n_i.matrix = function(e1, e2){
 }
 
 n_d = function(e1, e2){
+
     UseMethod("n_d")
 }
 
 n_d.default = function(e1, e2){
+
     e1[names(e1) %in% (names(e1) %d% e2)]    
 }
 

diff --git a/tests/testthat/test_keep.R b/tests/testthat/test_keep.R
@@ -69,4 +69,17 @@ expect_identical(ex_iris %except% "a", ex_iris[, FALSE, drop = FALSE])
 
 
 
+context("keep edge cases")
+
+expect_identical(iris %keep% NULL, iris[, FALSE, drop = FALSE])
+expect_identical(iris %except% NULL, iris)
+expect_identical(as.matrix(iris) %except% NULL, as.matrix(iris))
+expect_identical(1:5 %except% NULL, 1:5)
+expect_identical(1:5 %keep% NULL, integer(0))
+
+expect_identical(iris %keep% factor("Species"), iris[, 5, drop = FALSE])
+expect_identical(iris %except% factor("Species"), iris[,-5])
+
+
+
 
diff --git a/tests/testthat/test_vec_ops.R b/tests/testthat/test_vec_ops.R
@@ -89,3 +89,17 @@ if(suppressWarnings(require(dplyr, quietly = TRUE))){
 }
 
 expect_error(5 %r% 1:2)
+
+context("edge cases")
+expect_identical(iris %n_i% NULL, iris[, FALSE, drop = FALSE])
+expect_identical(iris %n_d% NULL, iris)
+expect_identical(as.matrix(iris) %n_d% NULL, as.matrix(iris))
+expect_identical(1:5 %n_d% NULL, 1:5)
+expect_identical(1:5 %d% NULL, 1:5)
+expect_identical(1:5 %n_i% NULL, integer(0))
+
+expect_identical(iris %n_i% factor("Species"), iris[, 5, drop = FALSE])
+expect_identical(iris %n_d% factor("Species"), iris[,-5])
+
+
+