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/components.R b/R/components.R index 0ebb9b9fb3f8322794704264fea0ff0c179def70..dc726f3e737a2717348f9b4ca370399e9546a5cb 100644 --- a/R/components.R +++ b/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))) { 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'))