#' @include class_AmChart.R class_AmStockChart.R
NULL
setClassUnion(name = "AmCharts", members = c("AmChart", "AmStockChart"))
#' @title Setters for AmChart and AmStockChart.
#' @description These methods can be used both for AmChart and AmStockChart.
#' There are general for some first-level properties.
#' @param .Object \linkS4class{AmChart} or \linkS4class{AmStockChart}.
#' @param enabled \code{logical}, TRUE to display the export button.
#' @param ... Other properties that can be used depending on the setter.
#' @rdname amcharts-setters
#' @export
#'
setGeneric(name = "setExport", def = function(.Object, enabled = TRUE, ...) {standardGeneric("setExport")})
#' @examples
#' \dontrun{
#' # Dummy examples
#' setExport(amPlot(1:10))
#' setExport(amStockChart())
#' }
#' @rdname amcharts-setters
#'
setMethod(f = "setExport", signature = c("AmCharts", "logicalOrMissing"),
definition = function(.Object, enabled = TRUE, ...)
{
.Object <- setProperties( .Object, export = list(enabled = enabled, ...) )
validObject(.Object)
return(.Object)
})
#' @rdname amcharts-setters
#' @export
#'
setGeneric(name = "setResponsive", def = function(.Object, enabled = TRUE, ...) {standardGeneric("setResponsive")})
#' @examples
#' \dontrun{
#' # Dummy examples
#' setResponsive(amSerialChart())
#' setResponsive(amStockChart())
#' }
#' @rdname amcharts-setters
setMethod(f = "setResponsive", signature = c("AmCharts", "logicalOrMissing"),
definition = function(.Object, enabled = TRUE, ...)
{
.Object <- setProperties(.Object = .Object, responsive = list(enabled = enabled, ...))
validObject(.Object)
return(.Object)
})
#' Test wether a chart can be plotted (or printed)
#' @noRd
#'
.plot_or_print <- function(object)
{
if (length(object@type)) {
# cat("Plotting...")
chart_widget <- plot(object)
if (isTRUE(getOption('knitr.in.progress')))
knitr::knit_print(chart_widget)
else
print(chart_widget)
} else {
# cat("Printing...")
print(object)
}
}
#' @title Visualize AmStockChart with show
#' @description Display the object in the console.
#' @param object \linkS4class{AmChart}.
#' @return If the object has a valid type, it will plot the chart.
#' If not the method will trigger the method 'print'.
#'
setMethod(f = "show", signature = "AmChart", definition = .plot_or_print)
#' @title Visualize AmStockChart with show
#' @description Display the object in the console.
#' @param object \linkS4class{AmStockChart}.
#' @return If the object has a valid type, it will plot the chart.
#' If not the method will trigger the method 'print'.
#'
setMethod(f = "show", signature = "AmStockChart", definition = .plot_or_print)
#' @title PLOTTING METHOD
#' @description Basic method to plot an AmChart
#' @details Plots an object of class \code{\linkS4class{AmChart}}
#' @param x \linkS4class{AmChart}
#' @param y unused.
#' @param width \code{character}.
#' @param height \code{character}.B
#' @param background \code{character}.
#' @param ... Other properties.
#' @rdname plot.AmChart
#' @import htmlwidgets
#' @import htmltools
#' @export
setMethod(f = "plot", signature = "AmCharts",
definition = function(x, y, width = "100%", height = NULL,
background = "#ffffff", ...)
{
chart_ls <- listProperties(x)
# remove temporary parameter
chart_ls["RType_"] <- NULL
theme <- chart_ls$theme
if (length(theme)) {
background <- switch(theme,
"light" = "#ffffff",
"patterns" = "#ffffff",
"default" = "#ffffff",
"dark" = "#3f3f4f",
"chalk" = "#282828",
stop("[plot]: invalid theme"))
} else {}
# set background
if (exists("backgroundColor", where = chart_ls)) {
background <- chart_ls$backgroundColor
chart_ls["backgroundColor"] <- NULL
} else {}
# listeners on chart
if (exists("listeners", where = chart_ls)) {
listeners <- chart_ls$listeners
chart_ls[grep(x = names(chart_ls), pattern = "^listeners")] <- NULL
} else {
listeners <- NULL
}
# listeners on axes (GaugeAxis class)
ls_temp <- substituteMultiListeners(chart_ls, "axes")
chart_ls <- ls_temp$chart
axes_listeners <- ls_temp$listeners_ls
axes_listenersIndices <- ls_temp$indices
# listeners on categoryAxis
ls_temp <- substituteListener(chart_ls, "categoryAxis")
chart_ls <- ls_temp$chart
categoryAxis_listeners <- ls_temp$listeners
# listeners on chartCursor
ls_temp <- substituteListener(chart_ls, "chartCursor")
chart_ls <- ls_temp$chart
chartCursor_listeners <- ls_temp$listeners
# listeners on dataSetSelector
ls_temp <- substituteListener(chart_ls, "dataSetSelector")
chart_ls <- ls_temp$chart
dataSetSelector_listeners <- ls_temp$listeners
# listeners on legend
ls_temp <- substituteListener(chart_ls, "legend")
chart_ls <- ls_temp$chart
legend_listeners <- ls_temp$listeners
# listeners on panels
ls_temp <- substituteMultiListeners(chart_ls, "panels")
chart_ls <- ls_temp$chart
panels_listeners <- ls_temp$listeners_ls
panels_listenersIndices <- ls_temp$indices
# listeners on stockLegend
stockLegend_listeners <- NULL
if(!is.null(chart_ls$panels) && "stockLegend" %in% names(chart_ls$panels[[1]])){
if(!is.null(chart_ls$panels[[1]]$stockLegend$listeners)){
stockLegend_listeners <- chart_ls$panels[[1]]$stockLegend$listeners
chart_ls$panels[[1]]$stockLegend$listeners <- NULL
}
}
# listeners on periodSelector
ls_temp <- substituteListener(chart_ls, "periodSelector")
chart_ls <- ls_temp$chart
periodSelector_listeners <- ls_temp$listeners
# listeners on valueAxis
ls_temp <- substituteMultiListeners(chart_ls, "valueAxes")
chart_ls <- ls_temp$chart
valueAxes_listeners <- ls_temp$listeners_ls
valueAxes_listenersIndices <- ls_temp$indices
# group (Stock synchronisation)
if (exists("group", where = chart_ls)) {
group <- chart_ls$group
chart_ls[grep(x = names(chart_ls), pattern = "^group")] <- NULL
if(group == ""){
group <- NULL
}
} else {
group <- NULL
}
# is_ts_module (Stock synchronisation & module)
if (exists("is_ts_module", where = chart_ls)) {
is_ts_module <- chart_ls$is_ts_module
chart_ls[grep(x = names(chart_ls), pattern = "^is_ts_module")] <- NULL
} else {
is_ts_module <- FALSE
}
# case for drilldown chart
if (exists("subChartProperties", where = chart_ls)) {
jsFile <- "amDrillChart"
chart_ls["subChartProperties"] <- NULL
data <- list(main = chart_ls,
subProperties = x@subChartProperties,
background = background)
} else {
jsFile <- "ramcharts_base"
data <- list(chartData = chart_ls,
background = background,
# listeners on chart
listeners = listeners,
#listeners on properties
axes_listeners = axes_listeners,
axes_listenersIndices = axes_listenersIndices,
categoryAxis_listeners = categoryAxis_listeners,
chartCursor_listeners = chartCursor_listeners,
dataSetSelector_listeners = dataSetSelector_listeners,
legend_listeners = legend_listeners,
panels_listeners = panels_listeners,
panels_listenersIndices = panels_listenersIndices,
periodSelector_listeners = periodSelector_listeners,
valueAxes_listeners = valueAxes_listeners,
valueAxes_listenersIndices = valueAxes_listenersIndices,
stockLegend_listeners = stockLegend_listeners,
group = group, is_ts_module = is_ts_module)
}
# Create initial widget
widget <- htmlwidgets::createWidget(name = eval(jsFile),
x = data,
width = width,
height = height,
package = 'rAmCharts')
# Add dependencies if necessary
widget <- .add_type_dependency(widget = widget, data = data, type = x@type)
widget <- .add_export_dependency(widget = widget, data = data)
widget <- .add_theme_dependency(widget = widget, data = data)
widget <- .add_dataloader_dependency(widget = widget, data = data)
widget <- .add_responsive_dependency(widget = widget, data = data)
widget <- .add_language_dependency(widget = widget, data = data)
return(widget)
})
#' Add dependency for chart type
#' @import yaml
#' @noRd
#'
.add_type_dependency <- function(widget,
data,
type = c("funnel", "gantt", "gauge", "pie",
"radar", "serial", "stock", "xy"))
{
type <- match.arg(type)
if (type == "stock") type <- "amstock" # modification temporaire
file_js <- paste0(type, ".js")
# For some type, we need to source also 'serial.js'
if (type %in% c("gantt", "amstock")) file_js <- c("serial.js", file_js)
# Load the configuration yaml file into list
conf_list <- yaml::yaml.load_file(system.file("conf.yaml", package = "rAmCharts"))
# Add main js dependency
type_dep <- htmltools::htmlDependency(name = paste0("amcharts_type_", type),
# name = paste0("amcharts_type", type),
version = conf_list$amcharts_version,
src = c(file = system.file("htmlwidgets/lib", package = "rAmCharts")),
script = file_js)
widget <- .add_dependency(widget = widget, dependency = type_dep)
# Add stylesheet if necessary
if (type == "amstock") {
style_dep <- htmltools::htmlDependency(name = conf_list$styles$amstockcharts$name,
version = conf_list$amcharts_version,
src = c(file = system.file("htmlwidgets/lib", package = "rAmCharts")),
stylesheet = conf_list$styles$amstockcharts$script)
widget <- .add_dependency(widget = widget, dependency = style_dep)
} else {
# No stylesheet needed
}
return (widget)
}
#' Add dependency for export
#' @noRd
.add_export_dependency <- function(widget, data)
{
cond <- exists("chartData", where = data) &&
exists("export", where = data$chartData) &&
data$chartData$export$enabled
if (cond) widget <- add_export_dependency(widget)
return (widget)
}
#' @title Add the export dependency to an htmlwidget
#'
#' @description Add the 'export' dependency to an htmlwidget.
#' You can only manipulate the htmlwidget if you call the method 'plot' with an rAmChart.
#'
#' @param widget An htmlwidget.
#'
#' @return Return the updated widget with the 'export' dependency.
#'
#' @export
#'
add_export_dependency <- function (widget)
{
# Load the configuration yaml file into list
conf_list <- yaml::yaml.load_file(system.file("conf.yaml", package = "rAmCharts"))
# export module
export_dep <- htmltools::htmlDependency(name = conf_list$plugins$export$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export", package = "rAmCharts"),
stylesheet = conf_list$plugins$export$stylesheet,
script = conf_list$plugins$export$script)
widget <- .add_dependency(widget = widget, dependency = export_dep)
# blob module
export_blob_dep <- htmltools::htmlDependency(name = conf_list$plugins$blob$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/blob.js", package = "rAmCharts"),
script = conf_list$plugins$blob$script)
widget <- .add_dependency(widget = widget, dependency = export_blob_dep)
# fabric module
export_fabric_dep <- htmltools::htmlDependency(name = conf_list$plugins$fabric$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/fabric.js", package = "rAmCharts"),
script = conf_list$plugins$fabric$script)
widget <- .add_dependency(widget = widget, dependency = export_fabric_dep)
# filesaver module
export_filesaver_dep <- htmltools::htmlDependency(name = conf_list$plugins$FileSaver$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/FileSaver.js", package = "rAmCharts"),
script = conf_list$plugins$FileSaver$script)
widget <- .add_dependency(widget = widget, dependency = export_filesaver_dep)
# jszip module
export_jszip_dep <- htmltools::htmlDependency(name = conf_list$plugins$jszip$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/jszip", package = "rAmCharts"),
script = conf_list$plugins$jszip$script)
widget <- .add_dependency(widget = widget, dependency = export_jszip_dep)
# pdfmake module
export_pdfmake_dep <- htmltools::htmlDependency(name = conf_list$plugins$pdfmake$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/pdfmake", package = "rAmCharts"),
script = conf_list$plugins$pdfmake$script)
widget <- .add_dependency(widget = widget, dependency = export_pdfmake_dep)
export_pdfmake_font_dep <- htmltools::htmlDependency(name = conf_list$plugins$pdfmake_font$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/pdfmake", package = "rAmCharts"),
script = conf_list$plugins$pdfmake_font$script)
widget <- .add_dependency(widget = widget, dependency = export_pdfmake_font_dep)
# xlsx module
export_xlsx_dep <- htmltools::htmlDependency(name = conf_list$plugins$xlsx$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/xlsx", package = "rAmCharts"),
script = conf_list$plugins$xlsx$script)
widget <- .add_dependency(widget = widget, dependency = export_xlsx_dep)
# class list
export_classlist <- htmltools::htmlDependency(name = conf_list$plugins$classList$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/libs/classList.js", package = "rAmCharts"),
script = conf_list$plugins$classList$script)
widget <- .add_dependency(widget = widget, dependency = export_classlist)
return (widget)
}
#' Add theme
#' @noRd
.add_theme_dependency <- function(widget, data)
{
cond <- exists("chartData", where = data) &&
exists("theme", where = data$chartData) &&
length(data$chartData$theme) &&
(data$chartData$theme != "default")
if (cond) {
theme_js <- switch(data$chartData$theme,
"light" = "light.js",
"patterns" = "patterns.js",
"dark" = "dark.js",
"chalk" = "chalk.js",
stop("[plot]: invalid theme"))
widget <- add_theme_dependency(widget = widget, theme_js = theme_js)
} else {
# Nothing to do, the condition is FALSE
}
return (widget)
}
#' @title Add theme dependency
#'
#' @description Add the 'theme' dependency to an htmlwidget.
#' You can only manipulate the htmlwidget if you call the method 'plot' with an rAmChart.
#'
#' @param widget An htmlwidget.
#' @param theme_js A character indicating the JS file dependency.
#'
#' @return Return the updated htmlwidget.
#'
#' @examples
#' \dontrun{
#' library(pipeR)
#' amPlot(1:10, theme = "dark") %>>% plot() %>>% add_theme_dependency("light.js")
#' }
#'
#' @export
#'
add_theme_dependency <- function (widget, theme_js = c("light.js", "patterns.js", "dark.js", "chalk.js"))
{
# Load the configuration yaml file into list
conf_list <- yaml::yaml.load_file(system.file("conf.yaml", package = "rAmCharts"))
theme_dep <- htmltools::htmlDependency(name = paste0("amcharts_themes_", theme_js),
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/themes", package = "rAmCharts"),
script = theme_js)
widget <- .add_dependency(widget = widget, dependency = theme_dep)
return (widget)
}
#' Add dataloader feature
#' @noRd
.add_dataloader_dependency <- function(widget, data)
{
cond1 <- exists("chartData", where = data) &&
exists("dataLoader", where = data$chartData)
cond2 <- exists("chartData", where = data) &&
any(sapply(X = data$chartData$dataSets, FUN = exists, x = "dataLoader"))
if (cond1 || cond2) widget <- add_dataloader_dependency(widget = widget)
return(widget)
}
#' @title Add dataloader dependency
#'
#' @description Add the 'dataloader' dependency to an htmlwidget.
#' You can only manipulate the htmlwidget if you call the method 'plot' with an rAmChart.
#'
#' @param widget An htmlwidget
#'
#' @return Return the updated htmlwidget.
#'
#' @export
#'
add_dataloader_dependency <- function(widget)
{
# Load the configuration yaml file into list
conf_list <- yaml::yaml.load_file(system.file("conf.yaml", package = "rAmCharts"))
dataloader_dep <- htmltools::htmlDependency(name = conf_list$plugins$dataloader$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/dataloader", package = "rAmCharts"),
script = conf_list$plugins$dataloader$script)
widget <- .add_dependency(widget = widget, dependency = dataloader_dep)
return(widget)
}
#' Add responsive feature
#' @noRd
.add_responsive_dependency <- function(widget, data, version)
{
cond <- exists("chartData", where = data) && exists("responsive", where = data$chartData)
if (cond) widget <- add_responsive_dependency(widget)
return(widget)
}
#' @title Add responsive dependency
#'
#' @description Add the 'responsive' dependency to an htmlwidget.
#' You can only manipulate the htmlwidget if you call the method 'plot' with an rAmChart.
#'
#' @param widget An htmlwidget.
#'
#' @return Return an updated htmlwidget with the dependency.
#'
#' @export
#'
add_responsive_dependency <- function(widget)
{
# Load the configuration yaml file into list
conf_list <- yaml::yaml.load_file(system.file("conf.yaml", package = "rAmCharts"))
responsive_dep <- htmltools::htmlDependency(name = conf_list$plugins$responsive$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/responsive", package = "rAmCharts"),
script = conf_list$plugins$responsive$script)
widget <- .add_dependency(widget = widget, dependency = responsive_dep)
return(widget)
}
#' @title Add animate dependency
#'
#' @description Add the 'animate' dependency to an htmlwidget.
#' You can only manipulate the htmlwidget if you call the method 'plot' with an rAmChart.
#'
#' @param widget An htmlwidget.
#'
#' @return Return an updated htmlwidget with the dependency.
#'
#' @export
#'
add_animate_dependency <- function(widget)
{
# Load the configuration yaml file into list
conf_list <- yaml::yaml.load_file(system.file("conf.yaml", package = "rAmCharts"))
animate_dep <- htmltools::htmlDependency(name = conf_list$plugins$animate$name,
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/animate", package = "rAmCharts"),
script = conf_list$plugins$animate$script)
widget <- .add_dependency(widget = widget, dependency = animate_dep)
return(widget)
}
#' @title Add language
#'
#' @description Add the javascript file associated to the language if necessary
#'
#' @param widget An htmlwidget.
#' @param data The associated data list.
#'
#' @return Return an updated htmlwidget with the dependency.
#'
#' @noRd
#' @export
#'
.add_language_dependency <- function(widget, data)
{
# Load the configuration yaml file into list
conf_list <- yaml::yaml.load_file(system.file("conf.yaml", package = "rAmCharts"))
language <- data$chartData$language
if (length(language) > 0) {
language_dep_general <- htmltools::htmlDependency(name = "general_language",
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/lang",
package = "rAmCharts"),
script = paste0(language, ".js"))
language_dep_export <- htmltools::htmlDependency(name = "export_language",
version = conf_list$amcharts_version,
src = system.file("htmlwidgets/lib/plugins/export/lang",
package = "rAmCharts"),
script = paste0(language, ".js"))
widget <- .add_dependency(widget = widget, dependency = language_dep_general)
widget <- .add_dependency(widget = widget, dependency = language_dep_export)
} else {
# no need to add the dependency
}
return(widget)
}
#' Substitue listeners from a single chart object
#' @param chart \code{list} of chart properties.
#' @param obj \code{character} naming the object.
#' @noRd
substituteListener <- function(chart, obj)
{
if (exists(obj, where = chart) &&
exists("listeners", where = chart[[eval(obj)]])) {
chart_obj <- chart[[eval(obj)]]
listeners <- chart_obj[["listeners"]]
chart_obj["listeners"] <- NULL
chart[[eval(obj)]] <- chart_obj
} else {
listeners <- NULL
}
return(list(chart = chart, listeners = listeners))
}
#' Substitue listeners from a multiple chart object
#' @param chart \code{list} of chart properties.
#' @param obj \code{character} naming the object.
#' @examples
#' x <- list(valueAxes = list(list(title = "tata"),
#' list(title = "titi"),
#' list(title = "tata", listeners = "tocnzj")))
#'
#' substituteMultiListeners(x, "valueAxes")
#'
#' #---
#' x <- list(valueAxes = list(list(title = "tata"),
#' list(title = "titi"),
#' list(title = "tata")))
#'
#' substituteMultiListeners(x, "valueAxes")
#' @noRd
substituteMultiListeners <- function(chart, obj)
{
indices <- NULL
listeners_ls <- NULL
if (exists(obj, where = chart)) {
# which element has listener(s) ?
cond <- lapply(chart[[eval(obj)]], function(x) "listeners" %in% names(x))
indices <- which(unlist(cond))
if (length(indices)) {
# for element that have listener(s)
listeners_ls <- lapply(indices, function(i) {
chart_obji <- chart[[eval(obj)]][[i]]
listeners <- chart_obji[["listeners"]]
chart_obji["listeners"] <- NULL
chart[[eval(obj)]][[i]] <<- chart_obji
return(listeners)
})
# reformat data for JavaScript
if (length(indices) == 1)
indices <- list(indices)
} else {}
} else {}
return(list(chart = chart, listeners_ls = listeners_ls, indices = indices))
}
#' @title Add any dependency to an htmlwidget
#' @param widget An htmlwidget.
#' @param dependency An htmlDependency.
#' @return The widget with the given dependency
#' @noRd
#'
.add_dependency <- function (widget, dependency)
{
if (length(widget$dependencies) == 0) widget$dependencies <- list()
widget$dependencies[[length(widget$dependencies)+1]] <- dependency
return(widget)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.