diff --git a/DESCRIPTION b/DESCRIPTION index 674c5f71cd9d3cff172e895d4266cd3c0f6786ad..f638530385f9bae926c19a84178566a95468b3c0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,6 +23,7 @@ Imports: glue, ymlthis Suggests: + switchr, highcharter, plotly, crosstalk, diff --git a/R/assemble.R b/R/assemble.R index 802a82132c4c74976d619c9fcbe7084dcaf1be72..d937e5d85ab1bcaab3d14cb270bbc9d1e9dc8bc1 100644 --- a/R/assemble.R +++ b/R/assemble.R @@ -24,7 +24,7 @@ setMethod("assemble", "i2dashboard", function(dashboard, pages = names(dashboard 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)) %>% {if(dashboard@interactive) ymlthis::yml_runtime(., runtime = "shiny") else .} %>% ymlthis::use_rmarkdown(path = tmp_document, include_body = FALSE, quiet = TRUE, open_doc = FALSE) diff --git a/R/vis_objects.R b/R/vis_objects.R index 0ac32374f4cbab484c3c64196406a2666cbee15b..3f2c2449f7c0ecf6c30ddf19a6e8522e8a71b2e1 100644 --- a/R/vis_objects.R +++ b/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) + }) diff --git a/inst/templates/vis_object.Rmd b/inst/templates/vis_object.Rmd index a43ef1c6abf141b757bdb0c77841a7784af3a3d4..88f0960d7f53efe4f9ccf8f3aca2e272b0d16ef0 100644 --- a/inst/templates/vis_object.Rmd +++ b/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'))