From 4431d59e01af847a1325f7e7b96f311e5553efaf Mon Sep 17 00:00:00 2001
From: Benjamin <benjamin.nutter@gmail.com>
Date: Fri, 26 Aug 2016 13:00:20 -0400
Subject: [PATCH] add the `logical_rows` argument.

Closes Issue #67
---
 R/sprinkle.R                               | 38 ++++++++++++++++++++--
 man/sprinkle.Rd                            | 12 +++++--
 tests/testthat/test-sprinkle_logical_row.R |  8 +++++
 3 files changed, 52 insertions(+), 6 deletions(-)
 create mode 100644 tests/testthat/test-sprinkle_logical_row.R

diff --git a/R/sprinkle.R b/R/sprinkle.R
index 0c2729b..9bee17d 100644
--- a/R/sprinkle.R
+++ b/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)
 
diff --git a/man/sprinkle.Rd b/man/sprinkle.Rd
index fab5a18..7bbf57e 100644
--- a/man/sprinkle.Rd
+++ b/man/sprinkle.Rd
@@ -25,9 +25,9 @@ http://tex.stackexchange.com/questions/40666/how-to-change-line-color-in-tabular
 sprinkle(x, rows = NULL, cols = NULL, ..., part = c("body", "head",
   "foot", "interfoot", "table"))
 
-\method{sprinkle}{default}(x, rows = NULL, cols = NULL, ...,
-  part = c("body", "head", "foot", "interfoot", "table"), fixed = FALSE,
-  recycle = c("none", "rows", "cols", "columns"))
+\method{sprinkle}{default}(x, rows = NULL, cols = NULL,
+  logical_rows = NULL, ..., part = c("body", "head", "foot", "interfoot",
+  "table"), fixed = FALSE, recycle = c("none", "rows", "cols", "columns"))
 
 \method{sprinkle}{dust_list}(x, rows = NULL, cols = NULL, ...,
   part = c("body", "head", "foot", "interfoot", "table"))
@@ -61,6 +61,12 @@ for the given cells.  See "Sprinkles" for a listing of these arguments.}
 
 \item{part}{A character string denoting which part of the table to modify.}
 
+\item{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)}.}
+
 \item{fixed}{\code{logical(1)} indicating if the values in \code{rows} 
 and \code{cols} should be read as fixed coordinate pairs.  By default, 
 sprinkles are applied at the intersection of \code{rows} and \code{cols}, 
diff --git a/tests/testthat/test-sprinkle_logical_row.R b/tests/testthat/test-sprinkle_logical_row.R
new file mode 100644
index 0000000..b3ba446
--- /dev/null
+++ b/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"))
+})
+