#111 fix recycling

R/as.data.frame.dust.R

@@ -16,7 +16,7 @@
 #'   data frame (or tidied output from \code{broom::tidy} 
 #'   originally given to \code{dust}.
 #' 
-#' @details In its current state, this can be a fairly ineffcient function
+#' @details In its current state, this can be a fairly inefficient function
 #'   as the table, if the longtable option is in use, will be built in 
 #'   a \code{for} loop and bound together using \code{rbind}.  This isn't 
 #'   really intended for large tables, but may be of assistance when 

R/dust.R

@@ -13,7 +13,7 @@
 #'   \code{data.frame} class, the default behavior is to assume that the 
 #'   object itself is the basis of the table.  If the summarized table is 
 #'   desired, set to \code{TRUE}.
-#' @param keep_rownames Whe \code{tidy_df} is \code{FALSE}, setting 
+#' @param keep_rownames When \code{tidy_df} is \code{FALSE}, setting 
 #'   \code{keep_rownames} binds the row names to the data frame as the first
 #'   column, allowing them to be preserved in the tabulated output.  This 
 #'   is only to data frame like objects, as the \code{broom::tidy.matrix} method 

R/index_to_sprinkle.R

@@ -152,7 +152,7 @@ index_to_sprinkle <- function(x, rows = NULL, cols = NULL, fixed = FALSE,
   if (length(invalid_row))
   {
     coll$push(sprintf("The following rows given are not valid row indices: %s",
-                      paste0(invalid_row, collapse = ", ")))
+                      paste0(rows[invalid_row], collapse = ", ")))
   }
 
   if (is.null(cols))
@@ -182,11 +182,15 @@ index_to_sprinkle <- function(x, rows = NULL, cols = NULL, fixed = FALSE,
   if (length(invalid_col))
   {
     coll$push(sprintf("The following columns given are not valid columns: %s",
-                      paste0(invalid_col, collapse = ", ")))
+                      paste0(cols[invalid_col], collapse = ", ")))
   }
 
   if (report_here) checkmate::reportAssertions(coll)
 
+  # There's no point in continuing if there are any errors by now
+  # We return a full vector of indices just to maintain the same input.
+  if (!coll$isEmpty()) return(1)
+
 # Functional Code ---------------------------------------------------
 
   # Determine the index order for recycling
@@ -208,26 +212,27 @@ index_to_sprinkle <- function(x, rows = NULL, cols = NULL, fixed = FALSE,
 
   # Determine and arrange the indices
 
-  if (fixed)
+  if (!fixed)
   {
-    indices <- data.frame(rows = rows,
+    indices <- expand.grid(rows = rows,
                           cols = cols)
-      indices <- dplyr::mutate(indices, 
-                               i = TRUE)
-      indices <- dplyr::left_join(x[[part]],
-                                  indices,
-                                  by = c("row" = "rows", 
-                                         "col" = "cols")) 
-      indices <- dplyr::arrange_(indices, 
-                                 recycle_arrange)
-      indices <- indices[["i"]]
-    indices[is.na(indices)] <- FALSE
+    indices <- dplyr::mutate(indices, 
+                             i = TRUE)
+    indices <- dplyr::left_join(x[[part]][c("row", "col")],
+                                indices,
+                                by = c("row" = "rows", 
+                                       "col" = "cols")) 
+    indices[["index"]] <- seq_len(nrow(indices))
+    indices <- dplyr::arrange_(indices,
+                               recycle_arrange)
+    indices[["i"]][is.na(indices[["i"]])] <- FALSE
+    indices <- indices[["index"]][indices[["i"]]]
   }
   else
   {
     indices <- 
-      x[[part]][["row"]] %in% rows & 
-      x[[part]][["col"]] %in% cols
+      which(x[[part]][["row"]] %in% rows & 
+              x[[part]][["col"]] %in% cols)
   }
 
   indices

R/pixiedust-pkg.R

@@ -2,7 +2,7 @@
 #' 
 #' The \code{pixiedust} mission is to provide a user friendly 
 #' and flexible interface by which report-quality tables may 
-#' be rendered in multiple output formats.  Intially, 
+#' be rendered in multiple output formats.  Initially, 
 #' \code{pixiedust} will support markdown, HTML, and LaTeX
 #' formats, as well as methods for console output.
 #' 

R/print.dust.R

@@ -19,7 +19,7 @@
 #'   
 #'   The markdown, html, and latex output is returned via \code{\link[knitr]{asis_output}},
 #'   which forces the output into the 'asis' environment.  It is intended to work 
-#'   with Rmarkdown, and the tables will be rended regardless of the 
+#'   with Rmarkdown, and the tables will be rendered regardless of the 
 #'   chunk's \code{results} argument.  Currently, there is no way to to capture
 #'   the code for additional post processing.
 #'   

R/sprinkle.R

@@ -558,12 +558,12 @@
 #' @section Colors:
 #' Colors may be declared as any of the color names in \code{colors()}, 
 #' as rgb character strings such as \code{"rgb(rrr,ggg,bbb)"} or as 
-#' hexidecimal character strings such as \code{"#rrggbb"}.  
+#' hexadecimal character strings such as \code{"#rrggbb"}.  
 #' 
 #' Transparency is also recognized by HTML output, and may be indicated 
 #' in the rgba format \code{"rgba(rrr,ggg,bbb,aa)"}, where \code{aa} is a 
 #' number between 0 and 1, inclusive.  Alternative, transparency may be 
-#' given as \code{"#rrggbbAA"}, where \code{AA} is a hexidecimal 
+#' given as \code{"#rrggbbAA"}, where \code{AA} is a hexadecimal 
 #' representation of transparency with "00" being completely transparent 
 #' and "FF" being completely opaque.
 #' 
@@ -725,14 +725,17 @@ sprinkle.default <- function(x, rows = NULL, cols = NULL, ...,
                                part = part,
                                recycle = recycle,
                                coll = coll)
+
+  recycle <- recycle[1]
 
   for (i in seq_along(sprinkle_groups))
   {
     if (any(sprinkle_groups[[i]] %in% names(sprinkles)))
     {
-      sprinkle_arg <- sprinkles[sprinkle_groups[[i]]]
+      sprinkle_arg <- c(sprinkles[sprinkle_groups[[i]]], "recycle" = recycle)
+      sprinkle_arg <- sprinkle_arg[names(sprinkle_arg) %in% sprinkle_groups[[i]]]
       sprinkle_arg <- sprinkle_arg[!vapply(sprinkle_arg, is.null, logical(1))]
-      
+
       if (!"fn" %in% names(sprinkle_arg))
       {
         args_list <- 
@@ -745,7 +748,7 @@ sprinkle.default <- function(x, rows = NULL, cols = NULL, ...,
           {
             list(coll = coll)
           }
-        
+
         do.call(what = sprintf("sprinkle_%s_index_assert",
                                names(sprinkle_groups)[[i]]),
                 args = c(sprinkle_arg,
@@ -820,12 +823,12 @@ sprinkle.dust_list <- function(x, rows = NULL, cols = NULL, ...,
 
 sprinkle_groups <-  
   list(
-    align = c("halign", "valign"),
-    bg = "bg",
+    align = c("halign", "valign", "recycle"),
+    bg = c("bg", "recycle"),
     bg_pattern = c("bg_pattern", "bg_pattern_by"),
     bookdown = "bookdown",
     border = c("border", "border_color", "border_style", 
-               "border_thickness", "border_units"),
+               "border_thickness", "border_units", "recycle"),
     border_collapse = "border_collapse",
     caption = "caption", 
     caption_number = "caption_number",
@@ -838,23 +841,23 @@ sprinkle_groups <-
                      "fixed_header_text_height", "fixed_header_text_height_units",
                      "fixed_header_background_color"),
     float = "float",
-    fn = "fn",
+    fn = c("fn"),
     font = c("bold", "italic", "font_size", "font_size_units",
-             "font_color", "font_family"),
+             "font_color", "font_family", "recycle"),
     gradient = c("gradient", "gradient_colors", "gradient_cut",
                  "gradient_n", "gradient_na"),
-    height = c("height", "height_units"),
+    height = c("height", "height_units", "recycle"),
     hhline = "hhline",
     justify = "justify",
     label = "label",
     longtable = "longtable",
     merge = c("merge", "merge_rowval", "merge_colval"),
-    na_string = "na_string",
-    pad = "pad",
+    na_string = c("na_string", "recycle"),
+    pad = c("pad", "recycle"),
     replace = "replace",
-    rotate_degree = "rotate_degree",
-    round = "round",
+    rotate_degree = c("rotate_degree"),#, "recycle"),
+    round = c("round"),#, "recycle"),
     sanitize = c("sanitize", "sanitize_args"),
     tabcolsep = "tabcolsep",
-    width = c("width", "width_units")
+    width = c("width", "width_units", "recycle")
   )