fix lambda expression handling in list.all (closes #105)

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rlist
 Type: Package
 Title: A Toolbox for Non-Tabular Data Manipulation
-Version: 0.4.3
+Version: 0.4.4
 Author: Kun Ren <ken@renkun.me>
 Maintainer: Kun Ren <ken@renkun.me>
 Description: Provides a set of functions for data manipulation with
@@ -11,7 +11,7 @@ Description: Provides a set of functions for data manipulation with
     lists can be chained.
 Depends:
     R (>= 2.15)
-Date: 2015-08-04
+Date: 2015-09-04
 Suggests:
     testthat,
     stringdist,

R/internal.R

@@ -21,8 +21,7 @@ list.map.fun <- function(.data, ., .i, .name) {
 }
 
 list.map.internal <- function(.data, expr, envir, fun = list.map.fun, args = NULL) {
-  if (is.empty(.data))
-    return(list())
+  if (is.empty(.data)) return(list())
   l <- lambda(expr)
   xnames <- getnames(.data, character(1L))
   environment(fun) <- args_env(.expr = l$expr, .args = args, .evalwith = .evalwith,

R/lambda.R

@@ -1,13 +1,14 @@
 lambda_symbols <- c(".", ".i", ".name")
+lambda_class <- "lambda_expression"
 
 lambda <- function(expr) {
+  if (inherits(expr, lambda_class)) return(expr)
   if (is.formula(expr)) {
-    if (length(expr) == 2L) 
-      return(Recall(expr[[2L]]))
+    if (length(expr) == 2L) return(Recall(expr[[2L]]))
     lhs <- expr[[2L]]
     expr <- expr[[3L]]
     lhs_symbols <- as.character(if (is.symbol(lhs)) lhs else lhs[-1L])
     lambda_symbols[which(nzchar(lhs_symbols))] <- lhs_symbols
   }
-  list(expr = expr, symbols = lambda_symbols)
-} 
+  structure(list(expr = expr, symbols = lambda_symbols), class = lambda_class)
+}

R/list.all.R

@@ -17,11 +17,13 @@
 #' list.all(x, score$c2 > 8 || score$c3 > 5, na.rm = TRUE)
 #' list.all(x, score$c2 > 8 || score$c3 > 5, na.rm = FALSE)
 list.all <- function(.data, cond, na.rm = FALSE) {
-  if (missing(.data)) 
+  if (missing(.data))
     return(all(na.rm = na.rm))
-  if (is.empty(.data) || missing(cond)) 
+  if (is.empty(.data) || missing(cond))
     return(all(.data, na.rm = na.rm))
-  res <- list.first.internal(.data, substitute(!cond), parent.frame(), na.rm = na.rm)
+  l <- lambda(substitute(cond))
+  l$expr <- as.call(list(quote(`!`), l$expr))
+  res <- list.first.internal(.data, l, parent.frame(), na.rm = na.rm)
   !res$state
 }
 
@@ -44,10 +46,10 @@ list.all <- function(.data, cond, na.rm = FALSE) {
 #' list.any(x, score$c2 > 8 || score$c3 > 5, na.rm = TRUE)
 #' list.any(x, score$c2 > 8 || score$c3 > 5, na.rm = FALSE)
 list.any <- function(.data, cond, na.rm = FALSE) {
-  if (missing(.data)) 
+  if (missing(.data))
     return(any(na.rm = na.rm))
-  if (is.empty(.data) || missing(cond)) 
+  if (is.empty(.data) || missing(cond))
     return(any(.data, na.rm = na.rm))
   res <- list.first.internal(.data, substitute(cond), parent.frame(), na.rm = na.rm)
   res$state
-} 
+}

tests/testthat/test-basic.R

@@ -224,7 +224,7 @@ test_that("list.all", {
     c2 = 7)))
   expect_equal(list.all(x, type == "B"), FALSE)
   expect_equal(list.all(x, mean(unlist(score)) >= 6), TRUE)
-  expect_equal(sapply(8:10, function(i) list.all(x, score$c1 >= i)), c(T, T, F))
+  expect_equal(sapply(8:10, function(i) list.all(x, score$c1 >= i)), c(TRUE, TRUE, FALSE))
   expect_equal(list.all(logical()), all())
   expect_equal(list.all(logical(), na.rm = TRUE), all(na.rm = TRUE))
   expect_equal(list.all(c(TRUE, NA, TRUE)), all(c(TRUE, NA, TRUE)))
@@ -234,6 +234,8 @@ test_that("list.all", {
   expect_equal(list.all(c(TRUE, NA, FALSE), na.rm = TRUE), all(c(TRUE, NA, FALSE),
     na.rm = TRUE))
   expect_equal(list.all(list(c(1,2,3),c(2,3,4)), . <= 3, na.rm = FALSE), NA)
+  expect_equal(list.all(list(1,-2,10), x ~ x > 0), FALSE)
+  expect_equal(list.all(list(1,-2,10), x ~ x + 10 > 0), TRUE)
 })
 
 test_that("list.any", {
@@ -251,6 +253,8 @@ test_that("list.any", {
     na.rm = TRUE))
   expect_equal(list.any(c(TRUE, NA, FALSE), na.rm = TRUE), any(c(TRUE, NA, FALSE),
     na.rm = TRUE))
+  expect_equal(list.any(list(1,-2,10), x ~ x > 0), TRUE)
+  expect_equal(list.any(list(1,-2,10), x ~ x - 10 > 0), FALSE)
 })
 
 test_that("list.first", {