Skip to content
Snippets Groups Projects
Commit 50efbb2a authored by jens.preussner's avatar jens.preussner :ghost:
Browse files

Added ANY signature to add_component for a generic way to add htmlwidgets

See merge request !18
parents 88672b1b 118b0da2
No related branches found
No related tags found
1 merge request!18Generic htm lwidget
Pipeline #129979 failed
...@@ -23,6 +23,7 @@ Imports: ...@@ -23,6 +23,7 @@ Imports:
glue, glue,
ymlthis ymlthis
Suggests: Suggests:
switchr,
highcharter, highcharter,
plotly, plotly,
crosstalk, crosstalk,
......
...@@ -59,7 +59,7 @@ setMethod("add_component", ...@@ -59,7 +59,7 @@ setMethod("add_component",
}) })
setMethod("add_component", signature(dashboard = "i2dashboard", component = "function"), setMethod("add_component", signature(dashboard = "i2dashboard", component = "function"),
function(dashboard, component, page = "default", title = NULL, ...) { function(dashboard, component, page = "default", ...) {
# validate "page" input # validate "page" input
name <- .create_page_name(page) name <- .create_page_name(page)
if (!(name %in% names(dashboard@pages))) { if (!(name %in% names(dashboard@pages))) {
......
...@@ -29,7 +29,7 @@ add_vis_object <- function(dashboard, object, package, page = "default", title = ...@@ -29,7 +29,7 @@ add_vis_object <- function(dashboard, object, package, page = "default", title =
delim = c("<%", "%>"), delim = c("<%", "%>"),
title = title, title = title,
package = package, package = package,
class = class(object), class = is(object),
component_id = component_id, component_id = component_id,
timestamp = timestamp) timestamp = timestamp)
...@@ -42,61 +42,42 @@ add_vis_object <- function(dashboard, object, package, page = "default", title = ...@@ -42,61 +42,42 @@ add_vis_object <- function(dashboard, object, package, page = "default", title =
# Methods to add common visualization objects # Methods to add common visualization objects
# #
setMethod("add_component", setMethod("add_component",
signature = signature(dashboard = "i2dashboard", component = "highchart"), signature = signature(dashboard = "i2dashboard", component = "gg"),
definition = function(dashboard, component, page = "default", title = NULL, ...) { 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", setMethod("add_component",
signature = signature(dashboard = "i2dashboard", component = "plotly"), signature = signature(dashboard = "i2dashboard", component = "gt_tbl"),
definition = function(dashboard, component, page = "default", title = NULL, ...) { 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", setMethod("add_component",
signature = signature(dashboard = "i2dashboard", component = "leaflet"), signature = signature(dashboard = "i2dashboard", component = "knitr_kable"),
definition = function(dashboard, component, page = "default", title = NULL, ...) { 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", setMethod("add_component",
signature = signature(dashboard = "i2dashboard", component = "dygraphs"), signature = signature(dashboard = "i2dashboard", component = "Heatmap"),
definition = function(dashboard, component, page = "default", title = NULL, ...) { 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", setMethod("add_component",
signature = signature(dashboard = "i2dashboard", component = "rbokeh"), signature = signature(dashboard = "i2dashboard", component = "ANY"),
definition = function(dashboard, component, page = "default", title = NULL, ...) { definition = function(dashboard, component, page = "default", title = NULL, ...) {
add_vis_object(dashboard, component, "rbokeh", page, title, ...) })
setMethod("add_component", # HTMLWIDGETS
signature = signature(dashboard = "i2dashboard", component = "visNetwork"), if(inherits(component, "htmlwidget")) {
definition = function(dashboard, component, page = "default", title = NULL, ...) { package <- packageSlot(component)
add_vis_object(dashboard, component, "visNetwork", page, title, ...) })
setMethod("add_component", if(is.null(package)) {
signature = signature(dashboard = "i2dashboard", component = "d3heatmap"), warning("No component added, since the package name of the HTML widget could not be determined.")
definition = function(dashboard, component, page = "default", title = NULL, ...) { return(dashboard)
add_vis_object(dashboard, component, "d3heatmap", page, title, ...) }) }
setMethod("add_component", return(add_vis_object(dashboard, component, package, page, title, ...))
signature = signature(dashboard = "i2dashboard", component = "metricsgraphics"), }
definition = function(dashboard, component, page = "default", title = NULL, ...) {
add_vis_object(dashboard, component, "metricsgraphics", page, title, ...) })
setMethod("add_component", # OTHER
signature = signature(dashboard = "i2dashboard", component = "gg"), warning("The component did not inherit from any of the currently supported classes ('htmlwidget').")
definition = function(dashboard, component, page = "default", title = NULL, ...) { return(dashboard)
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, ...) })
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
```{r} ```{r}
if (!requireNamespace("<% package %>", quietly = TRUE)) { 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')) vis_<% component_id %> <- readRDS(file.path(datadir, '<% component_id %>.rds'))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment