From b99155b6f9dd1aa044ed685ab6d447b738382cff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jens=20Preu=C3=9Fner?= <jens.preussner@mpi-bn.mpg.de>
Date: Fri, 3 May 2019 16:20:42 +0200
Subject: [PATCH] Components extension: Sidebar and layout templates
---
.gitignore | 1 +
DESCRIPTION | 3 +-
R/assemble.R | 59 ++++++++++++++++++--------
R/components.R | 13 ++++--
R/i2dashboard.R | 2 +-
R/pages.R | 4 +-
inst/templates/i2dash-global-setup.Rmd | 3 +-
inst/templates/layout_2x2_grid.Rmd | 19 +++++++++
inst/templates/layout_default.Rmd | 10 +++++
inst/templates/layout_focal_left.Rmd | 17 ++++++++
inst/templates/layout_storyboard.Rmd | 6 +++
inst/templates/page_template.Rmd | 5 ---
inst/templates/sidebar_template.Rmd | 4 ++
man/dot-render_page.Rd | 26 ++++++++++++
man/idashboard-class.Rd | 4 +-
man/render_features_by_factors.Rd | 21 ---------
man/render_multiplot.Rd | 23 ----------
man/render_sequence_saturation.Rd | 23 ----------
18 files changed, 143 insertions(+), 100 deletions(-)
create mode 100644 inst/templates/layout_2x2_grid.Rmd
create mode 100644 inst/templates/layout_default.Rmd
create mode 100644 inst/templates/layout_focal_left.Rmd
create mode 100644 inst/templates/layout_storyboard.Rmd
delete mode 100644 inst/templates/page_template.Rmd
create mode 100644 inst/templates/sidebar_template.Rmd
create mode 100644 man/dot-render_page.Rd
delete mode 100644 man/render_features_by_factors.Rd
delete mode 100644 man/render_multiplot.Rd
delete mode 100644 man/render_sequence_saturation.Rd
diff --git a/.gitignore b/.gitignore
index ee0c663..c5b3e02 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,4 @@
.RData
.Ruserdata
.DS_store
+*.html
diff --git a/DESCRIPTION b/DESCRIPTION
index 3fd2d48..f6533a1 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -15,4 +15,5 @@ RoxygenNote: 6.1.1
Imports:
knitr,
flexdashboard,
- yaml
+ yaml,
+ assertive.sets
diff --git a/R/assemble.R b/R/assemble.R
index 473ea66..1bf0b20 100644
--- a/R/assemble.R
+++ b/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
diff --git a/R/components.R b/R/components.R
index 28079f6..eb6e4a3 100644
--- a/R/components.R
+++ b/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)
})
diff --git a/R/i2dashboard.R b/R/i2dashboard.R
index ec866f8..4c9812a 100644
--- a/R/i2dashboard.R
+++ b/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))
)
)
diff --git a/R/pages.R b/R/pages.R
index 2be433e..9ecb5ac 100644
--- a/R/pages.R
+++ b/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)
})
diff --git a/inst/templates/i2dash-global-setup.Rmd b/inst/templates/i2dash-global-setup.Rmd
index 0b02ae5..119b919 100644
--- a/inst/templates/i2dash-global-setup.Rmd
+++ b/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
+```
+
diff --git a/inst/templates/layout_2x2_grid.Rmd b/inst/templates/layout_2x2_grid.Rmd
new file mode 100644
index 0000000..8c84537
--- /dev/null
+++ b/inst/templates/layout_2x2_grid.Rmd
@@ -0,0 +1,19 @@
+<% 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]] %>
diff --git a/inst/templates/layout_default.Rmd b/inst/templates/layout_default.Rmd
new file mode 100644
index 0000000..89ee17b
--- /dev/null
+++ b/inst/templates/layout_default.Rmd
@@ -0,0 +1,10 @@
+<% title %> {data-navmenu="<% menu %>"}
+====================================================
+
+<!-- Page created on <% date %> -->
+<% if(!is.null(sidebar)) sidebar %>
+
+Column
+----------------------------------------------------
+
+<% components %>
\ No newline at end of file
diff --git a/inst/templates/layout_focal_left.Rmd b/inst/templates/layout_focal_left.Rmd
new file mode 100644
index 0000000..360fb26
--- /dev/null
+++ b/inst/templates/layout_focal_left.Rmd
@@ -0,0 +1,17 @@
+<% 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
diff --git a/inst/templates/layout_storyboard.Rmd b/inst/templates/layout_storyboard.Rmd
new file mode 100644
index 0000000..3a050ac
--- /dev/null
+++ b/inst/templates/layout_storyboard.Rmd
@@ -0,0 +1,6 @@
+<% title %> {.storyboard data-navmenu="<% menu %>"}
+====================================================
+
+<!-- Page created on <% date %> -->
+
+<% components %>
diff --git a/inst/templates/page_template.Rmd b/inst/templates/page_template.Rmd
deleted file mode 100644
index 76e6339..0000000
--- a/inst/templates/page_template.Rmd
+++ /dev/null
@@ -1,5 +0,0 @@
-{{ title }} {{ layout_with_menu }}
-=========================================
-
-<!-- Page created on {{ date }} -->
-{{ components }}
diff --git a/inst/templates/sidebar_template.Rmd b/inst/templates/sidebar_template.Rmd
new file mode 100644
index 0000000..18634ab
--- /dev/null
+++ b/inst/templates/sidebar_template.Rmd
@@ -0,0 +1,4 @@
+Inputs {.sidebar}
+-------------------------------------
+
+{{ content }}
diff --git a/man/dot-render_page.Rd b/man/dot-render_page.Rd
new file mode 100644
index 0000000..43ddd2f
--- /dev/null
+++ b/man/dot-render_page.Rd
@@ -0,0 +1,26 @@
+% 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
+}
diff --git a/man/idashboard-class.Rd b/man/idashboard-class.Rd
index 3ed70c8..c2d3c6d 100644
--- a/man/idashboard-class.Rd
+++ b/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)
}
diff --git a/man/render_features_by_factors.Rd b/man/render_features_by_factors.Rd
deleted file mode 100644
index 7682cb9..0000000
--- a/man/render_features_by_factors.Rd
+++ /dev/null
@@ -1,21 +0,0 @@
-% 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
-}
diff --git a/man/render_multiplot.Rd b/man/render_multiplot.Rd
deleted file mode 100644
index ce78313..0000000
--- a/man/render_multiplot.Rd
+++ /dev/null
@@ -1,23 +0,0 @@
-% 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
-}
diff --git a/man/render_sequence_saturation.Rd b/man/render_sequence_saturation.Rd
deleted file mode 100644
index 1475843..0000000
--- a/man/render_sequence_saturation.Rd
+++ /dev/null
@@ -1,23 +0,0 @@
-% 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
-}
--
GitLab