new feature raster

NAMESPACE

@@ -26,6 +26,7 @@ export(replace_html)
 export(tableHTML)
 export(tableHTML_output)
 export(tableHTML_to_image)
+export(tableHTML_to_raster)
 export(write_tableHTML)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,colorRampPalette)

R/tableHTML2image.R

@@ -14,8 +14,8 @@
 #'
 #' When working on rmarkdown and you want to knit as pdf, use this function.
 #' Works with microsoft word as well.
-#' 
-#' To use this function you need phantomjs installed. Please use \code{webshot::install_phantomjs()} 
+#'
+#' To use this function you need phantomjs installed. Please use \code{webshot::install_phantomjs()}
 #' to install if it is not installed already.
 #'
 #' @param tableHTML A tableHTML object created by the tableHTML function.
@@ -40,7 +40,7 @@
 #'   tableHTML() %>%
 #'   tableHTML_to_image()
 #' }
-#' 
+#'
 #' @importFrom graphics par plot.new
 #'
 #' @export
@@ -58,11 +58,11 @@ tableHTML_to_image <- function(tableHTML,
  if (!is.logical(add)) {
   stop("add must be TRUE or FALSE")
  }
- 
+
  #check if phantom_js is installed
  jsinstalled <- suppressMessages(find_phantom())
  if (is.null(jsinstalled)) {
-   stop('To use this function, phantomjs needs to be installed. 
+   stop('To use this function, phantomjs needs to be installed.
         You can install it with webshot::install_phantomjs')
  }
 
@@ -101,6 +101,7 @@ tableHTML_to_image <- function(tableHTML,
 
  #read
  img <- readfunc(image)
+ class(img) <- c('tableHTML_image', class(img))
 
  #delete temp files
  file.remove(temp_file)
@@ -115,10 +116,11 @@ tableHTML_to_image <- function(tableHTML,
 
  #export the image
  if (is.null(file)) {
-  return(grid::grid.raster(img))
+  grid::grid.raster(img)
+  return(img)
  } else {
   writefunc(img, file)
-  return(invisible(NULL))
+  return(invisible(img))
  }
 
 }

R/tableHTML2raster.R

@@ -0,0 +1,51 @@
+#' Convert a tableHTML image into a raster object
+#'
+#' \code{tableHTML_to_raster} converts the tableHTML image into a raster object.
+#'
+#' The main rational behind this function is to convert the image into a raster object in
+#' order to use alongside ggplot. Check the examples.
+#'
+#' @param tableHTML_image A tableHTML_image object created from the \code{tableHTML_to_image}
+#' function or a 3D numeric array representing an image.
+#'
+#' @param ... Arguments to pass to \link[grid]{rasterGrob}.
+#'
+#' @return A raster object
+#'
+#' @examples
+#' \dontrun{
+#' #create the raster object
+#' raster_object <- iris %>%
+#'  head() %>%
+#'  tableHTML(widths = c(rep(120, 5)), rownames = FALSE) %>%
+#'  add_theme('scientific') %>%
+#'  tableHTML_to_image() %>%
+#'  tableHTML_to_raster()
+#'
+#' #plot as part of ggplot
+#' library(ggplot2)
+#' ggplot() +
+#'  theme_void() +
+#'  annotation_custom(raster_object, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf)
+#'
+#' #combine in a grid
+#' library(grid)
+#' library(cowplot)
+#' library(dplyr)
+#' gg1 <- ggplot(iris, aes(Sepal.Length, Petal.Length, color = Species)) + geom_point()
+#' gg2 <- ggplot() +
+#'  theme_void() +
+#'  annotation_custom(raster_object, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf)
+#'
+#' cowplot::plot_grid(gg1, gg2, nrow = 2, ncol = 1, rel_heights = c(3, 1))
+#' }
+#'
+#' @export
+tableHTML_to_raster <- function(tableHTML_image, ...) {
+
+ if (!any(class(tableHTML_image) %in% c('tableHTML_image', 'array', 'matrix'))) {
+  stop('tableHTML_image needs to be of class tableHTML_image (generated by tableHTML_to_image)
+       or a numeric array')
+ }
+ grid::rasterGrob(tableHTML_image, ...)
+}

tests/testthat/test_tableHTML2raster.R

@@ -0,0 +1,25 @@
+context("tableHTML_to_raster testing")
+
+test_that("Function fails for wrong inputs", {
+ #no tableHTML
+ expect_error(tableHTML_to_raster(c('a', 'b')),
+              'tableHTML_image needs to be of class')
+
+ #all checks ok
+ expect_error(mtcars %>%
+               head() %>%
+               tableHTML(widths = c(120, rep(60, 11))) %>%
+               add_theme('scientific') %>%
+               tableHTML_to_image() %>%
+               tableHTML_to_raster(),
+              NA)
+
+ #all checks ok
+ expect_true('rastergrob' %in% class(mtcars %>%
+                                      head() %>%
+                                      tableHTML(widths = c(120, rep(60, 11))) %>%
+                                      add_theme('scientific') %>%
+                                      tableHTML_to_image() %>%
+                                      tableHTML_to_raster()))
+
+})