DESCRIPTION

@@ -18,11 +18,13 @@ Imports:
     flexdashboard,
     yaml,
     assertive.sets,
+    assertive.types,
     rmarkdown,
     stringr,
     glue,
     ymlthis
 Suggests: 
+    switchr,
     highcharter,
     plotly,
     crosstalk,

NAMESPACE

@@ -3,11 +3,15 @@
 export("%>%")
 export("author<-")
 export("datadir<-")
+export("embed_source<-")
 export("interactivity<-")
+export("social_links<-")
+export("source<-")
 export("theme<-")
 export("title<-")
 export(add_colormap)
 export(add_component)
+export(add_link)
 export(add_page)
 export(add_to_sidebar)
 export(assemble)
@@ -17,11 +21,14 @@ export(embed_var)
 export(i2dashboard)
 export(interactivity)
 export(remove_page)
+export(social_links)
+export(source)
 export(theme)
 export(title)
 exportClasses(i2dashboard)
 exportMethods(add_colormap)
 exportMethods(add_component)
+exportMethods(add_link)
 exportMethods(add_page)
 exportMethods(add_to_sidebar)
 exportMethods(assemble)

R/AllGenerics.R

@@ -45,4 +45,22 @@ setGeneric("theme<-", function(dashboard, value) standardGeneric("theme<-"))
 setGeneric("datadir", function(dashboard) standardGeneric("datadir"))
 
 #' @export
-setGeneric("datadir<-", function(dashboard, value) standardGeneric("datadir<-"))
+setGeneric("datadir<-", function(dashboard, value) standardGeneric("datadir<-"))
\ No newline at end of file
+
+#' @export
+setGeneric("social_links", function(dashboard) standardGeneric("social_links"))
+
+#' @export
+setGeneric("social_links<-", function(dashboard, value) standardGeneric("social_links<-"))
+
+#' @export
+setGeneric("embed_source<-", function(dashboard, value) standardGeneric("embed_source<-"))
+
+#' @export
+setGeneric("source", function(dashboard) standardGeneric("source"))
+
+#' @export
+setGeneric("source<-", function(dashboard, value) standardGeneric("source<-"))
+
+#' @export
+setGeneric("add_link", function(dashboard, ...) standardGeneric("add_link"))
\ No newline at end of file

R/assemble.R

@@ -19,12 +19,24 @@ setMethod("assemble", "i2dashboard", function(dashboard, pages = names(dashboard
     saveRDS(dashboard@colormaps, file = file.path(dashboard@datadir, colormap_id))
   }
 
+  # Hack to proper source and social
+  if (dashboard@source == "") {
+    source <- NULL
+  } else {
+    source <- dashboard@source
+  }
+  if (dashboard@social == "") {
+    social <- NULL
+  } else {
+    social <- dashboard@social
+  }
+
   # Add YAML header
   options(ymlthis.rmd_body = "")
   ymlthis::yml(date = F) %>%
     ymlthis::yml_title(dashboard@title) %>%
     ymlthis::yml_author(dashboard@author) %>%
-    ymlthis::yml_output(flexdashboard::flex_dashboard(theme = dashboard@theme)) %>%
+    ymlthis::yml_output(flexdashboard::flex_dashboard(theme = !!dashboard@theme, social = !!social, source = !!source, navbar = !!dashboard@navbar)) %>%
     {if(dashboard@interactive) ymlthis::yml_runtime(., runtime = "shiny") else .} %>%
     ymlthis::use_rmarkdown(path = tmp_document, include_body = FALSE, quiet = TRUE, open_doc = FALSE)
 

R/components.R

@@ -59,7 +59,7 @@ setMethod("add_component",
           })
 
 setMethod("add_component", signature(dashboard = "i2dashboard", component = "function"),
-          function(dashboard, component, page = "default", title = NULL, ...) {
+          function(dashboard, component, page = "default", ...) {
             # validate "page" input
             name <- .create_page_name(page)
             if (!(name %in% names(dashboard@pages))) {

R/get_set.R

@@ -77,3 +77,83 @@ setMethod("datadir<-", "i2dashboard", function(dashboard, value) {
   dashboard@datadir <- value
   dashboard
 })
+
+#' Get/set the links to be shown for sharing on social media. Any of the following services are allowed: “facebook”, “twitter”, “google-plus”, “linkedin”, and “pinterest”. You can also specify “menu” to provide a generic sharing drop-down menu that includes all of the services.
+#'
+#' @param dashboard A \linkS4class{i2dash::i2dashboard}.
+#' @param value The value of the desired property.
+#'
+#' @name i2dashboard-class
+#' @rdname i2dashboard-class
+setMethod("social_links", "i2dashboard", function(dashboard) dashboard@social_links)
+
+#' @name i2dashboard-class
+#' @rdname i2dashboard-class
+setMethod("social_links<-", "i2dashboard", function(dashboard, value) {
+  i <- intersect(tolower(value), c("facebook", "twitter", "google-plus", "linkedin", "pinterest", "menu"))
+  if (length(i) > 0) {
+    dashboard@social <- i
+  }
+  dashboard
+})
+
+#' Get/set the embedding of the source code of the i2dashboard. Can either be a URL pointing to where the source code can be found online or whether or not to embed the source code into the document.
+#'
+#' @param dashboard A \linkS4class{i2dash::i2dashboard}.
+#' @param value The value of the desired property. A URL pointing to where the source code can be found online.
+#'
+#' @name i2dashboard-class
+#' @rdname i2dashboard-class
+setMethod("source", "i2dashboard", function(dashboard) dashboard@source)
+
+#' @name i2dashboard-class
+#' @rdname i2dashboard-class
+setMethod("source<-", "i2dashboard", function(dashboard, value) {
+  dashboard@source <- tolower(as.character(value))
+  dashboard
+})
+
+#' @name i2dashboard-class
+#' @rdname i2dashboard-class
+setMethod("embed_source<-", "i2dashboard", function(dashboard, value) {
+  if(value) {
+    dashboard@source <- "embed"
+  } else {
+    dashboard@source <- ""
+  }
+  dashboard
+})
+
+#' Add a link to the navigation bar.
+#'
+#' @param dashboard A \linkS4class{i2dash::i2dashboard}.
+#' @param href The target of the link.
+#' @param title The link title.
+#' @param icon An optional link icon (see https://rmarkdown.rstudio.com/flexdashboard/using.html#icon-sets)
+#' @param align Optional argument that can be “left” or “right” (defaults = “right”) defining the alignment of the links in the navigation bar
+#' @param target An optional target (e.g. "_blank")
+#'
+#' @rdname i2dashboard-methods
+#' @export
+setMethod("add_link", "i2dashboard", function(dashboard, href, title = NULL, icon = NULL, align = c("right","left"), target = NULL) {
+  align <- match.arg(align)
+  if(is.null(title) & is.null(icon)) {
+    warning("Both, title and icon, cannot be NULL when adding a link.")
+    return(dashboard)
+  }
+
+  # Workaround for NULL values
+  if(is.null(icon)) {
+    icon <- ""
+  }
+  if(is.null(title)) {
+    title = ""
+  }
+  if(is.null(target)) {
+    target = ""
+  }
+
+  dashboard@navbar <- append(dashboard@navbar, list(list("href" = href, "title" = title, "icon" = icon, "align" = align, "target" = target)))
+  dashboard
+})
+

R/i2dashboard.R

@@ -9,6 +9,9 @@
 #' @slot pages A list of dashboard pages
 #' @slot sidebar Content of the global sidebar
 #' @slot colormaps A named list with color mappings.
+#' @slot source Either a logical value describing whether the source code should be embeded through an item in the navigation bar or a link to a URL where the source code can be found online.
+#' @slot social A vector with any number of the following services: “facebook”, “twitter”, “google-plus”, “linkedin”, and “pinterest”. You can also specify “menu” to provide a generic sharing drop-down menu that includes all of the services.
+#' @slot navbar A list of links in the navigation bar (see https://rmarkdown.rstudio.com/flexdashboard/using.html#navigation_bar).
 #'
 #' @return An i2dashboard object.
 #'
@@ -25,14 +28,19 @@ setClass("i2dashboard",
     file = "character",
     pages = "list",
     sidebar = "character",
-    colormaps = "list"
+    colormaps = "list",
+    source = "character",
+    social = "character",
+    navbar = "list"
     ),
   prototype=list(
     title = "i2dashboard",
     interactive = FALSE,
     theme = "yeti",
     datadir = file.path(getwd(), "report-data"),
-    pages = list(default = list(title = "Default page", layout = "default", menu = NULL, components = list(), sidebar = NULL, max_components = Inf))
+    pages = list(default = list(title = "Default page", layout = "default", menu = NULL, components = list(), sidebar = NULL, max_components = Inf)),
+    source = "",
+    social = ""
     )
   )
 

R/vis_objects.R

@@ -29,7 +29,7 @@ add_vis_object <- function(dashboard, object, package, page = "default", title =
                                            delim = c("<%", "%>"),
                                            title = title,
                                            package = package,
-                                           class = class(object),
+                                           class = is(object),
                                            component_id = component_id,
                                            timestamp = timestamp)
 
@@ -42,61 +42,42 @@ add_vis_object <- function(dashboard, object, package, page = "default", title =
 # Methods to add common visualization objects
 #
 setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "highchart"),
+          signature = signature(dashboard = "i2dashboard", component = "gg"),
           definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "highcharter", page, title, ...) })
+            add_vis_object(dashboard, component, "ggplot2", page, title, ...) })
 
 setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "plotly"),
+          signature = signature(dashboard = "i2dashboard", component = "gt_tbl"),
           definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "plotly", page, title, ...) })
+            add_vis_object(dashboard, component,"gt", page, title, ...) })
 
 setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "leaflet"),
+          signature = signature(dashboard = "i2dashboard", component = "knitr_kable"),
           definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "leaflet", page, title, ...) })
+            add_vis_object(dashboard, component, "kableExtra", page, title, ...) })
 
 setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "dygraphs"),
+          signature = signature(dashboard = "i2dashboard", component = "Heatmap"),
           definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "dygraphs", page, title, ...) })
+            add_vis_object(dashboard, component, "ComplexHeatmap", page, title, ...) })
 
 setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "rbokeh"),
+          signature = signature(dashboard = "i2dashboard", component = "ANY"),
           definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "rbokeh", page, title, ...) })
 
-setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "visNetwork"),
-          definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "visNetwork", page, title, ...) })
+            # HTMLWIDGETS
+            if(inherits(component, "htmlwidget")) {
+              package <- packageSlot(component)
 
-setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "d3heatmap"),
-          definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "d3heatmap", page, title, ...) })
+              if(is.null(package)) {
+                warning("No component added, since the package name of the HTML widget could not be determined.")
+                return(dashboard)
+              }
 
-setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "metricsgraphics"),
-          definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "metricsgraphics", page, title, ...) })
+              return(add_vis_object(dashboard, component, package, page, title, ...))
+            }
 
-setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "gg"),
-          definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "ggplot2", page, title, ...) })
-
-setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "datatables"),
-          definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "DT", page, title, ...) })
-
-setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "grViz"),
-          definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "DiagrammeR", page, title, ...) })
-
-setMethod("add_component",
-          signature = signature(dashboard = "i2dashboard", component = "gt_tbl"),
-          definition = function(dashboard, component, page = "default", title = NULL, ...) {
-            add_vis_object(dashboard, component, "gt", page, title, ...) })
+            # OTHER
+            warning("The component did not inherit from any of the currently supported classes ('htmlwidget').")
+            return(dashboard)
+            })

inst/templates/vis_object.Rmd

@@ -4,7 +4,7 @@
 
 ```{r}
 if (!requireNamespace("<% package %>", quietly = TRUE)) {
-    stop('The package <% package %> is needed to embed objects of class <% class %>.', call. = FALSE)
+    stop('The package "<% package %>" is needed to embed objects of class "<% class %>".', call. = FALSE)
 }
 
 vis_<% component_id %> <- readRDS(file.path(datadir, '<% component_id %>.rds'))

man/i2dashboard-class.Rd

@@ -23,11 +23,21 @@
 \S4method{datadir}{i2dashboard}(dashboard)
 
 \S4method{datadir}{i2dashboard}(dashboard) <- value
+
+\S4method{social_links}{i2dashboard}(dashboard)
+
+\S4method{social_links}{i2dashboard}(dashboard) <- value
+
+\S4method{source}{i2dashboard}(dashboard)
+
+\S4method{source}{i2dashboard}(dashboard) <- value
+
+\S4method{embed_source}{i2dashboard}(dashboard) <- value
 }
 \arguments{
 \item{dashboard}{A \linkS4class{i2dash::i2dashboard}.}
 
-\item{value}{The value of the desired property.}
+\item{value}{The value of the desired property. A URL pointing to where the source code can be found online.}
 }
 \description{
 Get/set the interactivity of the i2dashboard.
@@ -39,4 +49,8 @@ Get/set the author of the i2dashboard.
 Get/set the theme of the i2dashboard.
 
 Get/set the datadir of the i2dashboard.
+
+Get/set the links to be shown for sharing on social media. Any of the following services are allowed: “facebook”, “twitter”, “google-plus”, “linkedin”, and “pinterest”. You can also specify “menu” to provide a generic sharing drop-down menu that includes all of the services.
+
+Get/set the embedding of the source code of the i2dashboard. Can either be a URL pointing to where the source code can be found online or whether or not to embed the source code into the document.
 }

man/i2dashboard-methods.Rd

 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/assemble.R, R/colormap.R, R/pages.R,
-%   R/sidebar.R
+% Please edit documentation in R/assemble.R, R/colormap.R, R/get_set.R,
+%   R/pages.R, R/sidebar.R
 \name{assemble,i2dashboard-method}
 \alias{assemble,i2dashboard-method}
 \alias{add_colormap,i2dashboard-method}
+\alias{add_link,i2dashboard-method}
 \alias{add_page,i2dashboard-method}
 \alias{remove_page,i2dashboard-method}
 \alias{add_to_sidebar,i2dashboard-method}
@@ -20,6 +21,15 @@
 
 \S4method{add_colormap}{i2dashboard}(dashboard, map, name)
 
+\S4method{add_link}{i2dashboard}(
+  dashboard,
+  href,
+  title = NULL,
+  icon = NULL,
+  align = c("right", "left"),
+  target = NULL
+)
+
 \S4method{add_page}{i2dashboard}(
   dashboard,
   page,
@@ -58,10 +68,18 @@
 
 \item{name}{A name for the color mapping.}
 
-\item{page}{The name of the page to which add the sidebar.}
+\item{href}{The target of the link.}
 
 \item{title}{The title of the page to be added.}
 
+\item{icon}{An optional link icon (see https://rmarkdown.rstudio.com/flexdashboard/using.html#icon-sets)}
+
+\item{align}{Optional argument that can be “left” or “right” (defaults = “right”) defining the alignment of the links in the navigation bar}
+
+\item{target}{An optional target (e.g. "_blank")}
+
+\item{page}{The name of the page to which add the sidebar.}
+
 \item{layout}{The page layout (see below).}
 
 \item{menu}{The name of the menu, under which the page should appear.}

man/idashboard-class.Rd

@@ -44,5 +44,11 @@ Create a new i2dashboard object.
 \item{\code{sidebar}}{Content of the global sidebar}
 
 \item{\code{colormaps}}{A named list with color mappings.}
+
+\item{\code{source}}{Either a logical value describing whether the source code should be embeded through an item in the navigation bar or a link to a URL where the source code can be found online.}
+
+\item{\code{social}}{A vector with any number of the following services: “facebook”, “twitter”, “google-plus”, “linkedin”, and “pinterest”. You can also specify “menu” to provide a generic sharing drop-down menu that includes all of the services.}
+
+\item{\code{navbar}}{A list of links in the navigation bar (see https://rmarkdown.rstudio.com/flexdashboard/using.html#navigation_bar).}
 }}