add the logical_rows argument.

Closes Issue #67

R/sprinkle.R

@@ -10,6 +10,11 @@
 #' @param x A dust object
 #' @param rows A numeric vector specifying the rows of the table to sprinkle.
 #'   See details for more about sprinkling.
+#' @param logical_rows An object with class `call` generated as `quote([expr])` where
+#'   the expression resolves to a logical vector based equal in length to the
+#'   number of rows in the table.  This is used to dynamically identify rows
+#'   in the table that will be sprinkled.  An example of input would be 
+#'   \code{quote(col_name == value)}.
 #' @param cols A numeric (or character) vector specifying the columns (or 
 #'   column names) to sprinkle.  See details for more about sprinkling.
 #' @param part A character string denoting which part of the table to modify.
@@ -569,7 +574,7 @@ sprinkle <- function(x, rows = NULL, cols = NULL, ...,
 #' @rdname sprinkle
 #' @export
 
-sprinkle.default <- function(x, rows = NULL, cols = NULL, ...,
+sprinkle.default <- function(x, rows = NULL, cols = NULL, logical_rows = NULL, ...,
                              part = c("body", "head", "foot", "interfoot", "table"),
                              fixed = FALSE, 
                              recycle = c("none", "rows", "cols", "columns"))
@@ -621,9 +626,32 @@ sprinkle.default <- function(x, rows = NULL, cols = NULL, ...,
       cols <- cols[!is.na(cols)]
     }
 
+    if (!is.null(logical_rows))
+    {
+      valid_row_logic <- 
+        checkmate::check_class(x = logical_rows,
+                               classes = "call")
+      checkmate::makeAssertion(x = logical_rows,
+                               res = valid_row_logic,
+                               collection = coll)
+
+      if (valid_row_logic)
+      {
+        rows_by_logic <- 
+          which(
+            with(
+              as.data.frame(x), 
+              eval(logical_rows)
+            )
+          )
+
+        rows <- unique(c(rows, rows_by_logic))
+      }
+    }
+
     #* If rows or cols isn't given, assume the sprinkle should be applied
     #* across the entire dimension.
-    if (is.null(rows) | length(rows) == 0)
+    if (is.null(rows))
     {
       rows <- 1:max(x[[part]][["row"]])
     }
@@ -658,7 +686,6 @@ sprinkle.default <- function(x, rows = NULL, cols = NULL, ...,
   checkmate::assertNumeric(x = rows,
                            add = coll)
 
-
   sprinkles <- list(...)
 
   if (!length(sprinkles))
@@ -727,6 +754,11 @@ sprinkle.default <- function(x, rows = NULL, cols = NULL, ...,
                       coll = coll)
   }
 
+
+
+
+
+
   #* Return any errors found.
   checkmate::reportAssertions(coll)
 

tests/testthat/test-sprinkle_logical_row.R

@@ -0,0 +1,8 @@
+context("sprinkle_logical_row")
+
+test_that("sprinkle: select rows using the logical_row argument",
+{
+  x <- dust(mtcars)
+  expect_silent(sprinkle(x, logical_rows = quote(mpg > 20), bg = "lightblue"))
+})
+