Cleaned up navbar, source and social

Merge branch 'master' into navbar_items

# Conflicts:
#	R/assemble.R

DESCRIPTION

@@ -24,8 +24,10 @@ Imports:
     glue,
     ymlthis
 Suggests: 
+    switchr,
     highcharter,
     plotly,
+    crosstalk,
     gt,
     ggplot2,
     DT,

NAMESPACE

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

R/AllGenerics.R

@@ -54,10 +54,13 @@ setGeneric("social_links", function(dashboard) standardGeneric("social_links"))
 setGeneric("social_links<-", function(dashboard, value) standardGeneric("social_links<-"))
 
 #' @export
-setGeneric("source_code", function(dashboard) standardGeneric("source_code"))
+setGeneric("embed_source<-", function(dashboard, value) standardGeneric("embed_source<-"))
 
 #' @export
-setGeneric("source_code<-", function(dashboard, value) standardGeneric("source_code<-"))
+setGeneric("source", function(dashboard) standardGeneric("source"))
 
 #' @export
-setGeneric("add_to_navbar", function(dashboard, ...) standardGeneric("add_to_navbar"))
+setGeneric("source<-", function(dashboard, value) standardGeneric("source<-"))
\ No newline at end of file
+
+#' @export
+setGeneric("add_link", function(dashboard, ...) standardGeneric("add_link"))
\ No newline at end of file

R/assemble.R

@@ -19,31 +19,25 @@ setMethod("assemble", "i2dashboard", function(dashboard, pages = names(dashboard
     saveRDS(dashboard@colormaps, file = file.path(dashboard@datadir, colormap_id))
   }
 
-  # Handle source code embeding
-  source_settings <- .validate_source_code(dashboard@source_code)
+  # 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 = "yeti")) -> yaml_header
-
-  # workaround, because variable "dashboard@theme" was not recognised
-  yaml_header$output$`flexdashboard::flex_dashboard`$theme <- dashboard@theme
-  if(dashboard@interactive) yaml_header <- ymlthis::yml_runtime(yaml_header, runtime = "shiny")
-
-  # add source_code to yaml_header
-  if(source_settings$source){
-    yaml_header$output$`flexdashboard::flex_dashboard`$source_code <- source_settings$value
-  }
-
-  # add social_links to yaml_header
-  if(length(dashboard@social_links) > 0){
-    yaml_header$output$`flexdashboard::flex_dashboard`$social <- dashboard@social_links
-  }
-
-  yaml_header %>%
+    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)
 
   # Add i2dash global setup
@@ -134,23 +128,3 @@ setMethod("assemble", "i2dashboard", function(dashboard, pages = names(dashboard
                      components = components,
                      date = Sys.time())
 }
-
-#' Method for validating the character of the source_code slot
-#'
-#' @param source_code_slot The source_code slot of the dashboard
-#'
-#' @return A list with a logical defining, wether source_code should be ebed in the navigation bar, and a character containing NULL, "embed" or a URL.
-.validate_source_code <- function(source_code_slot){
-  source_code <- FALSE
-  source_value <- NULL
-  if(length(source_code_slot) > 0){
-    if(is.na(as.logical(source_code_slot))){
-      source_code <- TRUE
-      source_value <- source_code_slot
-    } else if(as.logical(source_code_slot)){
-      source_code <- TRUE
-      source_value <- "embed"
-    }
-  }
-  return(list("source" = source_code, "value" = source_value))
-}

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

@@ -78,10 +78,10 @@ setMethod("datadir<-", "i2dashboard", function(dashboard, value) {
   dashboard
 })
 
-#' Get/set the list of social links 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.
 #'
 #' @param dashboard A \linkS4class{i2dash::i2dashboard}.
-#' @param social_links 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.
+#' @param value The value of the desired property.
 #'
 #' @name i2dashboard-class
 #' @rdname i2dashboard-class
@@ -90,44 +90,70 @@ setMethod("social_links", "i2dashboard", function(dashboard) dashboard@social_li
 #' @name i2dashboard-class
 #' @rdname i2dashboard-class
 setMethod("social_links<-", "i2dashboard", function(dashboard, value) {
-  assertive.types::assert_is_character(value)
-  assertive.sets::assert_is_subset(value, c("facebook", "twitter", "google-plus", "linkedin", "pinterest", "menu", ""))
-  dashboard@social_links <- value
+  i <- intersect(tolower(value), c("facebook", "twitter", "google-plus", "linkedin", "pinterest", "menu"))
+  if (length(i) > 0) {
+    dashboard@social <- i
+  }
   dashboard
 })
 
-#' Get/set the embeding of the source code of the i2dashboard.
+#' 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 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.
+#' @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_code", "i2dashboard", function(dashboard) dashboard@source_code)
+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("source_code<-", "i2dashboard", function(dashboard, value) {
-  value <- as.character(value)
-  dashboard@source_code <- value
+setMethod("embed_source<-", "i2dashboard", function(dashboard, value) {
+  if(value) {
+    dashboard@source <- "embed"
+  } else {
+    dashboard@source <- ""
+  }
   dashboard
 })
 
-#' Add item to the navigation bar.
+#' Add a link to the navigation bar.
 #'
 #' @param dashboard A \linkS4class{i2dash::i2dashboard}.
-#' @param href The target of the navigation item.
-#' @param title The item should have either a title or an icon.
-#' @param icon The item should have either a title or an icon. (See "https://ionicons.com/")
-#' @param align Optional argument that can be “left” or “right” (defaults = “right”) defining the alignment of the user-added items in the navigation bar
+#' @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_to_navbar", "i2dashboard", function(dashboard, href, title = NULL, icon = NULL, align = c("right","left")) {
+setMethod("add_link", "i2dashboard", function(dashboard, href, title = NULL, icon = NULL, align = c("right","left"), target = NULL) {
   align <- match.arg(align)
-  key <- letters[length(dashboard@navbar_items)+1]
-  if(is.null(title)&is.null(icon)) title <- key
-  dashboard@navbar_items[[key]] <- append(dashboard@navbar_items[[key]], list("href" = href, "title" = title, "icon" = icon, "align" = 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

@@ -29,16 +29,18 @@ setClass("i2dashboard",
     pages = "list",
     sidebar = "character",
     colormaps = "list",
-    source_code = "character",
-    social_links = "character",
-    navbar_items = "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,10 +4,23 @@
 
 ```{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)
 }
 
-readRDS(file.path(datadir, '<% component_id %>.rds'))
+vis_<% component_id %> <- readRDS(file.path(datadir, '<% component_id %>.rds'))
+
+# workaround for plotly dependencies issue (https://github.com/ropensci/plotly/issues/1044)
+# 
+fix_dependency <- function(dependency){
+  if(dependency$name == "jquery") dependency$src$file <- file.path(system.file(package ="crosstalk"), "lib/jquery")
+  if(dependency$name == "crosstalk") dependency$src$file <- file.path(system.file(package ="crosstalk"), "www")
+  return(dependency)
+}
+if ("<% package %>" == "plotly"){
+  vis_<% component_id %>$dependencies <- lapply(vis_<% component_id %>$dependencies, fix_dependency)  
+}
+
+vis_<% component_id %>
 ```
 
 

man/dot-validate_source_code.Rd

-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/assemble.R
-\name{.validate_source_code}
-\alias{.validate_source_code}
-\title{Method for validating the character of the source_code slot}
-\usage{
-.validate_source_code(source_code_slot)
-}
-\arguments{
-\item{source_code_slot}{The source_code slot of the dashboard}
-}
-\value{
-A list with a logical defining, wether source_code should be ebed in the navigation bar, and a character containing NULL, "embed" or a URL.
-}
-\description{
-Method for validating the character of the source_code slot
-}

man/i2dashboard-class.Rd

@@ -28,16 +28,16 @@
 
 \S4method{social_links}{i2dashboard}(dashboard) <- value
 
-\S4method{source_code}{i2dashboard}(dashboard)
+\S4method{source}{i2dashboard}(dashboard)
 
-\S4method{source_code}{i2dashboard}(dashboard) <- value
+\S4method{source}{i2dashboard}(dashboard) <- value
+
+\S4method{embed_source}{i2dashboard}(dashboard) <- value
 }
 \arguments{
 \item{dashboard}{A \linkS4class{i2dash::i2dashboard}.}
 
-\item{value}{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{social_links}{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{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.
@@ -50,7 +50,7 @@ Get/set the theme of the i2dashboard.
 
 Get/set the datadir of the i2dashboard.
 
-Get/set the list of social links 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 embeding of the source code of the i2dashboard.
+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

@@ -4,7 +4,7 @@
 \name{assemble,i2dashboard-method}
 \alias{assemble,i2dashboard-method}
 \alias{add_colormap,i2dashboard-method}
-\alias{add_to_navbar,i2dashboard-method}
+\alias{add_link,i2dashboard-method}
 \alias{add_page,i2dashboard-method}
 \alias{remove_page,i2dashboard-method}
 \alias{add_to_sidebar,i2dashboard-method}
@@ -21,12 +21,13 @@
 
 \S4method{add_colormap}{i2dashboard}(dashboard, map, name)
 
-\S4method{add_to_navbar}{i2dashboard}(
+\S4method{add_link}{i2dashboard}(
   dashboard,
   href,
   title = NULL,
   icon = NULL,
-  align = c("right", "left")
+  align = c("right", "left"),
+  target = NULL
 )
 
 \S4method{add_page}{i2dashboard}(
@@ -67,13 +68,15 @@
 
 \item{name}{A name for the color mapping.}
 
-\item{href}{The target of the navigation item.}
+\item{href}{The target of the link.}
 
 \item{title}{The title of the page to be added.}
 
-\item{icon}{The item should have either a title or an icon. (See "https://ionicons.com/")}
+\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 user-added items in the navigation bar}
+\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.}