diff --git a/DESCRIPTION b/DESCRIPTION index 7e8d44b..88d5c95 100644 --- a/DESCRIPTION +++ b/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 Maintainer: Kun Ren 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, diff --git a/R/internal.R b/R/internal.R index 7f805d4..477d417 100644 --- a/R/internal.R +++ b/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, diff --git a/R/lambda.R b/R/lambda.R index e7b2887..a51db60 100644 --- a/R/lambda.R +++ b/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) +} diff --git a/R/list.all.R b/R/list.all.R index 1eae7fc..b53fca2 100644 --- a/R/list.all.R +++ b/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 -} +} diff --git a/tests/testthat/test-basic.R b/tests/testthat/test-basic.R index dd63849..4c51943 100644 --- a/tests/testthat/test-basic.R +++ b/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", {