Components extension: Sidebar and layout templates

.gitignore

@@ -3,3 +3,4 @@
 .RData
 .Ruserdata
 .DS_store
+*.html

DESCRIPTION

@@ -15,4 +15,5 @@ RoxygenNote: 6.1.1
 Imports: 
     knitr,
     flexdashboard,
-    yaml
+    yaml,
+    assertive.sets

R/assemble.R

@@ -29,13 +29,13 @@ setMethod("assemble", "i2dashboard", function(object, output_file, pages, ...) {
   cat(header_string,
       file = tmp_document,
       append = FALSE,
-      sep='')
+      sep="")
 
   # Add i2dash global setup
   cat(readLines(system.file("templates", "i2dash-global-setup.Rmd", package = "i2dash")),
       file = tmp_document,
-      append = T,
-      sep = "")
+      append = TRUE,
+      sep = "\n")
 
   # write page to tempfile
   for (pagename in pages){
@@ -48,20 +48,9 @@ setMethod("assemble", "i2dashboard", function(object, output_file, pages, ...) {
       title <- object@pages[[name]]$title
       menu <- object@pages[[name]]$menu
       layout <- object@pages[[name]]$layout
-      # Check menu argument
-      if (is.null(menu)){
-        menu <- ""
-      }
-      # Check layout argument
-      if (any(layout == "storyboard")){
-        layout <- ".storyboard"
-      } else {
-        if(!is.null(layout)) warning("layout argument is not known.")
-        layout <- ""
-      }
-      layout_with_menu <- sprintf('{%s data-navmenu="%s"}', layout, menu)
-      timestamp <- Sys.time()
-      full_content <- knitr::knit_expand(file = system.file("templates", "page_template.Rmd", package = "i2dash"), title = title, layout_with_menu = layout_with_menu, components = components, date = timestamp)
+      sidebar <- object@pages[[name]]$sidebar
+
+      full_content <- .render_page(title = title, components = components, layout = layout,  menu = menu, sidebar = sidebar)
       cat(full_content, file = tmp_document, append = TRUE, sep='')
     } else {
       warning(sprintf("i2dashboard object does not contain a page named '%s'", pagename))
@@ -69,4 +58,38 @@ setMethod("assemble", "i2dashboard", function(object, output_file, pages, ...) {
   }
   # copy tempfile to final_document
   file.copy(from = tmp_document, to = final_document, overwrite = TRUE)
-})
+
\ No newline at end of file
+  invisible(object)
+})
+
+
+#' Method for rendering a page with a given layout and components
+#'
+#' @param title The page title.
+#' @param components A list of page components.
+#' @param layout The pages overall layout.
+#' @param menu The menu under which the page will be filed.
+#' @param sidebar Character string with sidebar content.
+#'
+#' @return A markdown string with the final page.
+.render_page <- function(title, components, layout = c("default", "storyboard", "focal_left", "2x2_grid"), menu = NULL, sidebar = NULL) {
+  if(!is.null(sidebar)) {
+    sidebar <- knitr::knit_expand(file = system.file("templates", "sidebar_template.Rmd", package = "i2dash"),
+                                  content = sidebar)
+  }
+
+  template <- switch(layout,
+                     "default" = system.file("templates", "layout_default.Rmd", package = "i2dash"),
+                     "storyboard" = system.file("templates", "layout_storyboard.Rmd", package = "i2dash"),
+                     "focal_left" = system.file("templates", "layout_focal_left.Rmd", package = "i2dash"),
+                     "2x2_grid" = system.file("templates", "layout_2x2_grid.Rmd", package = "i2dash"))
+
+  knitr::knit_expand(file = template,
+                     delim = c("<%", "%>"),
+                     title = title,
+                     menu = menu,
+                     layout = layout,
+                     sidebar = sidebar,
+                     components = components,
+                     date = Sys.time())
+}
\ No newline at end of file

R/components.R

@@ -23,13 +23,20 @@ setMethod("add_component", "i2dashboard", function(object, page = "default", com
 
   pn <- strsplit(component, "::")[[1]]
   eval_function <- if(length(pn) == 1) {
-    get(paste0("render_", pn[[1]]), envir = asNamespace("i2dash"), mode = "function")
+    get(pn[[1]], envir = asNamespace("i2dash"), mode = "function")
   } else {
-    get(paste0("render_", pn[[2]]), envir = asNamespace(pn[[1]]), mode = "function")
+    get(pn[[2]], envir = asNamespace(pn[[1]]), mode = "function")
   }
 
   component <- do.call(eval_function, args = list(object, ...))
-  object@pages[[name]]$components <- append(object@pages[[name]]$components, component)
 
+  if(is.list(component)) {
+    assertive.sets::is_subset(c("appendix", "component", "sidebar"), names(component))
+    object@pages[[name]]$components <- append(object@pages[[name]]$components, component$component)
+    object@pages[[name]]$sidebar <- paste0(object@pages[[name]]$sidebar, component$sidebar)
+    # ToDo: Handle appendix
+  } else {
+    object@pages[[name]]$components <- append(object@pages[[name]]$components, component)
+  }
   return(object)
 })

R/i2dashboard.R

@@ -22,7 +22,7 @@ setClass("i2dashboard",
     interactive = FALSE,
     theme = "yeti",
     workdir = getwd(),
-    pages = list(default = list(title = "Default page", layout = "default", menu = NULL, components = list(), max_components = Inf))
+    pages = list(default = list(title = "Default page", layout = "default", menu = NULL, components = list(), sidebar = NULL, max_components = Inf))
     )
   )
 

R/pages.R

@@ -21,7 +21,7 @@ setGeneric("add_page", function(object, ...) standardGeneric("add_page"))
 #'
 #' @rdname idashboard-class
 #' @export
-setMethod("add_page", "i2dashboard", function(object, page, title, layout = "storyboard", menu = NULL, ...) {
+setMethod("add_page", "i2dashboard", function(object, page, title, layout = "default", menu = NULL, sidebar = NULL, ...) {
   name <- .create_page_name(page)
 
   max_components <- switch(layout,
@@ -42,7 +42,7 @@ setMethod("add_page", "i2dashboard", function(object, page, title, layout = "sto
     }
   }
 
-  object@pages[[name]] <- list(title = title, layout = layout, menu = menu, components = list(), max_components = max_components)
+  object@pages[[name]] <- list(title = title, layout = layout, menu = menu, components = list(), max_components = max_components, sidebar = sidebar)
   return(object)
 })
 

inst/templates/i2dash-global-setup.Rmd

@@ -6,4 +6,5 @@ if (any(grepl(pattern = ".switchr", x = .libPaths()))) {
 
 # Make it possible to reuse chunk labels
 options(knitr.duplicate.label = "allow")
-```
+```
\ No newline at end of file
+

inst/templates/layout_2x2_grid.Rmd

+<% title %> {data-navmenu="<% menu %>"}
+====================================================
+
+<!-- Page created on <% date %> -->
+<% if(!is.null(sidebar)) sidebar %>
+
+Column
+-------------------------------------
+    
+<% if(length(components) > 0) components[[1]] %>
+ 
+<% if(length(components) > 2) components[[3]] %>
+
+Column
+-------------------------------------
+    
+<% if(length(components) > 1) components[[2]] %>
+    
+<% if(length(components) > 3) components[[4]] %>

inst/templates/layout_default.Rmd

+<% title %> {data-navmenu="<% menu %>"}
+====================================================
+
+<!-- Page created on <% date %> -->
+<% if(!is.null(sidebar)) sidebar %>
+
+Column
+----------------------------------------------------
+
+<% components %>
\ No newline at end of file

inst/templates/layout_focal_left.Rmd

+<% title %> {data-navmenu="<% menu %>"}
+====================================================
+
+<!-- Page created on <% date %> -->
+<% if(!is.null(sidebar)) sidebar %>
+
+Column {data-width=600}
+-------------------------------------
+    
+<% if(length(components) > 0) components[[1]] %>
+   
+Column {data-width=400}
+-------------------------------------
+   
+<% if(length(components) > 1) components[[2]] %>
+
+<% if(length(components) > 2) components[[3]] %>
\ No newline at end of file

inst/templates/layout_storyboard.Rmd

+<% title %> {.storyboard data-navmenu="<% menu %>"}
+====================================================
+
+<!-- Page created on <% date %> -->
+
+<% components %>

inst/templates/page_template.Rmd

-{{ title }} {{ layout_with_menu }}
-=========================================
-
-<!-- Page created on {{ date }} -->
-{{ components }}

inst/templates/sidebar_template.Rmd

+Inputs {.sidebar}
+-------------------------------------
+
+{{ content }}

man/dot-render_page.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assemble.R
+\name{.render_page}
+\alias{.render_page}
+\title{Method for rendering a page with a given layout and components}
+\usage{
+.render_page(title, components, layout = c("default", "storyboard",
+  "focal_left", "2x2_grid"), menu = NULL, sidebar = NULL)
+}
+\arguments{
+\item{title}{The page title.}
+
+\item{components}{A list of page components.}
+
+\item{layout}{The pages overall layout.}
+
+\item{menu}{The menu under which the page will be filed.}
+
+\item{sidebar}{Character string with sidebar content.}
+}
+\value{
+A markdown string with the final page.
+}
+\description{
+Method for rendering a page with a given layout and components
+}

man/idashboard-class.Rd

@@ -15,8 +15,8 @@
 \S4method{add_component}{i2dashboard}(object, page = "default",
   component, ...)
 
-\S4method{add_page}{i2dashboard}(object, page, title,
-  layout = "storyboard", menu = NULL, ...)
+\S4method{add_page}{i2dashboard}(object, page, title, layout = "default",
+  menu = NULL, sidebar = NULL, ...)
 
 \S4method{remove_page}{i2dashboard}(object, page)
 }

man/render_features_by_factors.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/features_by_factors.R
-\name{render_features_by_factors}
-\alias{render_features_by_factors}
-\title{Renders a features by factor violin plot}
-\usage{
-render_features_by_factors(object, plot_title, x, y)
-}
-\arguments{
-\item{plot_title}{The title of the Component}
-
-\item{x}{A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
-
-\item{y}{A list with the y-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.(Needs to be categorial. Horizontal violinplots are not possible.)}
-}
-\value{
-A string containing markdown code for the rendered textbox
-}
-\description{
-Renders a features by factor violin plot
-}

man/render_multiplot.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/multiplot.R
-\name{render_multiplot}
-\alias{render_multiplot}
-\title{Renders a Sequence saturation plot}
-\usage{
-render_multiplot(object, plot_title, x, y, color_by)
-}
-\arguments{
-\item{plot_title}{The title of the Component}
-
-\item{x}{A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
-
-\item{y}{A list with the y-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
-
-\item{color_by}{A list with the color_by values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
-}
-\value{
-A string containing markdown code for the rendered textbox
-}
-\description{
-Renders a Sequence saturation plot
-}

man/render_sequence_saturation.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sequence_saturation.R
-\name{render_sequence_saturation}
-\alias{render_sequence_saturation}
-\title{Renders a Sequence saturation plot}
-\usage{
-render_sequence_saturation(object, plot_title, x, y, color_by)
-}
-\arguments{
-\item{plot_title}{The title of the Component}
-
-\item{x}{A list with the x-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
-
-\item{y}{A list with the y-axis values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
-
-\item{color_by}{A list with the color_by values. If it is a nested list, a dropdown-field will be provided in the interactive mode.}
-}
-\value{
-A string containing markdown code for the rendered textbox
-}
-\description{
-Renders a Sequence saturation plot
-}