Merge pull request #9 from dreamRs/shiny-input

Added shiny interaction
This commit is contained in:
Victor Perrier 2020-03-18 18:52:55 +01:00 committed by GitHub
commit c3530c74c6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
27 changed files with 1353 additions and 100 deletions

View File

@ -19,17 +19,18 @@ Imports:
magrittr,
rlang,
ggplot2,
jsonlite
jsonlite,
shiny (>= 1.1.0)
Suggests:
testthat,
dplyr,
knitr,
scales,
rmarkdown,
shiny,
gapminder,
highcharter
RoxygenNote: 7.0.2
Roxygen: list(markdown = TRUE)
URL: https://github.com/dreamRs/apexcharter, https://dreamrs.github.io/apexcharter
BugReports: https://github.com/dreamRs/apexcharter/issues
VignetteBuilder: knitr

View File

@ -36,12 +36,17 @@ export(ax_yaxis2)
export(bar_opts)
export(config_update)
export(events_opts)
export(format_date)
export(format_num)
export(heatmap_opts)
export(parse_df)
export(pie_opts)
export(radialBar_opts)
export(renderApexchart)
export(run_input_demo)
export(set_input_click)
export(set_input_selection)
export(set_input_zoom)
importFrom(ggplot2,aes)
importFrom(htmlwidgets,JS)
importFrom(htmlwidgets,createWidget)
@ -51,5 +56,7 @@ importFrom(htmlwidgets,sizingPolicy)
importFrom(magrittr,"%>%")
importFrom(rlang,as_label)
importFrom(rlang,eval_tidy)
importFrom(shiny,getDefaultReactiveDomain)
importFrom(shiny,registerInputHandler)
importFrom(stats,setNames)
importFrom(utils,modifyList)

View File

@ -7,7 +7,7 @@
#' @param data Default dataset to use for chart. If not already
#' a \code{data.frame}, it will be coerced to with \code{as.data.frame}.
#' @param mapping Default list of aesthetic mappings to use for chart
#' @param type Specify the chart type. Available Options:
#' @param type Specify the chart type. Available options:
#' \code{"column"}, \code{"bar"}, \code{"line"},
#' \code{"area"}, \code{"spline"}, \code{"pie"}, \code{"donut"},
#' \code{"radialBar"}, \code{"radar"}, \code{"scatter"}, \code{"heatmap"},
@ -261,6 +261,13 @@ config_scatter <- function(range_x, range_y) {
),
yaxis = list(
min = range_y[1], max = range_y[2]
),
grid = list(
xaxis = list(
lines = list(
show = TRUE
)
)
)
)
}

View File

@ -38,3 +38,26 @@ check_locale <- function(x) {
}
}
#' Format date in JS
#'
#' @param x Date to use in JavaScript
#'
#' @return a JavaScript string
#' @export
#'
format_date <- function(x) {
stopifnot(length(x) == 1)
JS(sprintf("new Date('%s').getTime()", x))
}

38
R/onLoad.R Normal file
View File

@ -0,0 +1,38 @@
#' @importFrom shiny registerInputHandler
.onLoad <- function(...) {
shiny::registerInputHandler("apex_click", function(data, ...) {
if (is.null(data)) {
NULL
} else {
value <- ununlist(data$value)
if (isTRUE(data$datetime)) {
if (is.list(value)) {
value <- rapply(value, to_posix, how = "replace")
} else {
value <- to_posix(value)
}
}
return(value)
}
})
shiny::registerInputHandler("apex_datetime", function(data, ...) {
if (is.null(data)) {
NULL
} else {
result <- try({
data$x <- list(
min = to_posix(data$x$min),
max = to_posix(data$x$max)
)
data
}, silent = TRUE)
if (inherits(result, "try-error")) {
warning("apexcharter: Failed to parse dates!", call. = FALSE)
data
} else {
result
}
}
}, force = TRUE)
}

View File

@ -11,6 +11,8 @@
#'
#' @export
#'
#' @importFrom shiny getDefaultReactiveDomain
#'
apexchartProxy <- function(shinyId, session = shiny::getDefaultReactiveDomain()) {
if (is.null(session)) {

199
R/shiny-input.R Normal file
View File

@ -0,0 +1,199 @@
#' @title Retrieve click information in Shiny
#'
#' @description According to type of chart, different values are retrieved:
#' * **bar and column:** retrieve category (x-axis).
#' * **pie and donut:** retrieve label.
#' * **time-series:** retrieve x-axis value, you have to display markers
#' with size > 0 and set tooltip's options `intersect = TRUE` and `shared = FALSE`.
#' * **scatter:** retrieve XY coordinates.
#'
#' @param ax An \code{apexcharts} \code{htmlwidget} object.
#' @param inputId The id that will be used server-side for retrieving click.
#' @param multiple Allow multiple selection: \code{TRUE} or \code{FALSE} (default).
#' @param effect_type Type of effect for selected element, default is to use lightly darken color.
#' @param effect_value A larger value intensifies the select effect, accept value between 0 and 1.
#' @param session The Shiny session.
#'
#' @note If x-axis is of type datetime, value retrieved is of class \code{POSIXct}.
#'
#' @return An \code{apexcharts} \code{htmlwidget} object.
#' @export
#'
#' @importFrom shiny getDefaultReactiveDomain
#'
#' @examples
#'
#' library(apexcharter)
#'
#' # Not in Shiny but you can still click on bars
#' data.frame(
#' month = month.abb,
#' value = sample(1:100, 12)
#' ) %>%
#' apex(aes(month, value)) %>%
#' set_input_click("month_click", multiple = TRUE)
#'
#'
#' # Interactive examples:
#' if (interactive()) {
#'
#' run_input_demo("click")
#'
#' }
set_input_click <- function(ax, inputId, multiple = FALSE,
effect_type = c("darken", "lighten", "none"),
effect_value = 0.35,
session = shiny::getDefaultReactiveDomain()) {
effect_type <- match.arg(effect_type)
if (is.null(session))
session <- list(ns = identity)
ax <- ax_states(ax, active = list(
allowMultipleDataPointsSelection = isTRUE(multiple),
filter = list(
type = effect_type,
value = effect_value
)
))
ax$x$shinyEvents$click <- list(
inputId = session$ns(inputId)
)
ax
}
#' Retrieve zoom information in Shiny
#'
#' @param ax An \code{apexcharts} \code{htmlwidget} object.
#' @param inputId The id that will be used server-side for retrieving zoom.
#' @param session The Shiny session.
#'
#' @note If x-axis is of type datetime, value retrieved is of class \code{POSIXct}.
#'
#' @return An \code{apexcharts} \code{htmlwidget} object.
#' @export
#'
#' @importFrom shiny getDefaultReactiveDomain
#'
#' @examples
#' if (interactive()) {
#'
#' run_input_demo("zoom")
#'
#' }
set_input_zoom <- function(ax, inputId,
session = shiny::getDefaultReactiveDomain()) {
if (is.null(session))
session <- list(ns = identity)
ax$x$shinyEvents$zoomed <- list(
inputId = session$ns(inputId)
)
ax
}
#' Retrieve selection information in Shiny
#'
#' @param ax An \code{apexcharts} \code{htmlwidget} object.
#' @param inputId The id that will be used server-side for retrieving selection.
#' @param type Allow selection either on x-axis, y-axis or on both axis.
#' @param fill_color Background color of the selection rect which is drawn when user drags on the chart.
#' @param fill_opacity Opacity of background color of the selection rectangle.
#' @param stroke_width Border thickness of the selection rectangle.
#' @param stroke_dasharray Creates dashes in borders of selection rectangle.
#' Higher number creates more space between dashes in the border.
#' @param stroke_color Colors of selection border.
#' @param stroke_opacity Opacity of selection border.
#' @param xmin,xmax Start value of x-axis. Both \code{min} and \code{max} must be provided.
#' @param ymin,ymax Start value of y-axis. Both \code{min} and \code{max} must be provided.
#' @param session The Shiny session.
#'
#' @return An \code{apexcharts} \code{htmlwidget} object.
#' @export
#'
#' @examples
#'
#' library(apexcharter)
#' data("economics", package = "ggplot2")
#'
#' # Not in Shiny so no events
#' # but you can still select an area on chart
#' apex(economics, aes(date, psavert), type = "line") %>%
#' set_input_selection("selection")
#'
#' # Default selection at start
#' apex(economics, aes(date, psavert), type = "line") %>%
#' set_input_selection(
#' inputId = "selection",
#' xmin = format_date("1980-01-01"),
#' xmax = format_date("1985-01-01")
#' )
set_input_selection <- function(ax, inputId, type = c("x", "xy", "y"),
fill_color = "#24292e", fill_opacity = 0.1,
stroke_width = 1, stroke_dasharray = 3,
stroke_color = "#24292e", stroke_opacity = 0.4,
xmin = NULL, xmax = NULL, ymin = NULL, ymax = NULL,
session = shiny::getDefaultReactiveDomain()) {
type <- match.arg(type)
if (is.null(session))
session <- list(ns = identity)
selection <- list(
enabled = TRUE, type = type,
fill = list(color = fill_color, opacity = fill_opacity),
stroke = list(
width = stroke_width, dashArray = stroke_dasharray,
color = stroke_color, opacity = stroke_opacity
)
)
if (!is.null(xmin) & !is.null(xmax)) {
selection$xaxis <- list(min = xmin, max = xmax)
}
if (!is.null(ymin) & !is.null(ymax)) {
selection$yaxis <- list(min = ymin, max = ymax)
}
ax <- ax_chart(
ax = ax,
selection = selection,
toolbar = list(autoSelected = "selection")
)
ax$x$shinyEvents$selection <- list(
inputId = session$ns(inputId),
type = type
)
ax
}
#' Run Shiny input events examples
#'
#' @param example Name of the example.
#'
#' @export
#'
#' @examples
#' if (interactive()) {
#'
#' run_input_demo("click")
#' run_input_demo("zoom")
#' run_input_demo("selection")
#'
#' }
run_input_demo <- function(example = c("click", "zoom", "selection")) {
example <- match.arg(example)
shiny::shinyAppFile(
appFile = system.file("examples-input", example, "app.R", package = "apexcharter"),
options = list("display.mode" = "showcase")
)
}

View File

@ -15,6 +15,27 @@ formatNoSci <- function(x) {
}
ununlist <- function(x) {
if (is.null(x))
return(x)
n <- names(x)
if (!is.null(n) && all(nzchar(n))) {
lapply(x, ununlist)
} else {
unlist(x)
}
}
to_posix <- function(x) {
if (!is.null(x)) {
x <- as.POSIXct(x/1000, origin = "1970-01-01", tz = "UTC")
}
x
}
#' Utility function to create ApexChart parameters JSON
#'
#' @param ax A \code{apexcharts} \code{htmlwidget} object.

View File

@ -0,0 +1,188 @@
library(shiny)
library(apexcharter)
ui <- fluidPage(
tags$h2("Retrieve click information"),
fluidRow(
column(
width = 4,
tags$b("Single selection"),
apexchartOutput("bar1"),
verbatimTextOutput("clickbar1")
),
column(
width = 4,
tags$b("Multiple selection"),
apexchartOutput("bar2"),
verbatimTextOutput("clickbar2")
),
column(
width = 4,
tags$b("Several series"),
apexchartOutput("bar3"),
verbatimTextOutput("clickbar3")
)
),
fluidRow(
column(
width = 6,
tags$b("Pie selection"),
apexchartOutput("chart3"),
verbatimTextOutput("result3")
),
column(
width = 6,
tags$b("Time serie: you must display markers and use"),
tags$code("ax_tooltip(intersect = TRUE, shared = FALSE)"),
apexchartOutput("chart4"),
verbatimTextOutput("result4")
)
),
fluidRow(
column(
width = 6,
tags$b("Scatter exemple"),
apexchartOutput("chart5"),
verbatimTextOutput("result5")
),
column(
width = 6,
tags$b("Bubble + color exemple"),
apexchartOutput("chart6"),
verbatimTextOutput("result6")
)
),
fluidRow(
column(
width = 6,
tags$b("Heatmap exemple"),
apexchartOutput("chart7"),
verbatimTextOutput("result7")
),
column(
width = 6
)
),
tags$br()
)
server <- function(input, output, session) {
# Bar single ----
output$bar1 <- renderApexchart({
data.frame(
month = month.abb,
value = sample(1:100, 12)
) %>%
apex(aes(month, value)) %>%
set_input_click("month_click")
})
output$clickbar1 <- renderPrint({
input$month_click
})
# Bar multiple ----
output$bar2 <- renderApexchart({
data.frame(
month = month.abb,
value = sample(1:100, 12)
) %>%
apex(aes(month, value)) %>%
set_input_click(
"month_click_mult",
multiple = TRUE,
effect_value = 0.1
)
})
output$clickbar2 <- renderPrint({
input$month_click_mult
})
# Bar several series ----
output$bar3 <- renderApexchart({
data.frame(
month = rep(month.abb, 2),
value = sample(1:100, 24),
year = rep(c("Y-1", "Y"), each = 12)
) %>%
apex(aes(month, value, fill = year)) %>%
set_input_click(
"month_click_series"
)
})
output$clickbar3 <- renderPrint({
input$month_click_series
})
# Pie ----
output$chart3 <- renderApexchart({
data.frame(
answer = c("Yes", "No"),
n = c(254, 238)
) %>%
apex(type = "pie", mapping = aes(x = answer, y = n)) %>%
set_input_click("click_pie")
})
output$result3 <- renderPrint({
input$click_pie
})
# Time-serie ----
output$chart4 <- renderApexchart({
data.frame(
date = seq(as.Date("1960-01-01"), length.out = 24, by = "month"),
value = tail(as.vector(AirPassengers), 24)
) %>%
apex(aes(date, value), "line") %>%
ax_markers(size = 5) %>%
ax_tooltip(intersect = TRUE, shared = FALSE) %>%
set_input_click("click_time")
})
output$result4 <- renderPrint({
input$click_time
})
# Scatter ----
output$chart5 <- renderApexchart({
apex(data = mtcars, type = "scatter", mapping = aes(x = wt, y = mpg)) %>%
set_input_click("click_scatter")
})
output$result5 <- renderPrint({
input$click_scatter
})
# Bubble + color ----
output$chart6 <- renderApexchart({
apex(
data = iris, type = "scatter",
aes(Sepal.Length, Sepal.Width, color = Species, size = Petal.Length)
) %>%
set_input_click("click_bubble", multiple = TRUE)
})
output$result6 <- renderPrint({
input$click_bubble
})
# heatmap ----
output$chart7 <- renderApexchart({
data.frame(
month = rep(month.abb, times = 5),
city = rep(c("Paris", "Marseille", "Lyon", "Lille", "Nantes"), each = 12),
value = sample(1:100, 5*12, TRUE)
) %>%
apex(
type = "heatmap",
mapping = aes(x = month, y = city, fill = value)
) %>%
ax_dataLabels(enabled = FALSE) %>%
ax_colors("#008FFB") %>%
set_input_click("click_heatmap")
})
output$result7 <- renderPrint({
input$click_heatmap
})
}
shinyApp(ui, server)

View File

@ -0,0 +1,52 @@
library(shiny)
library(apexcharter)
data("economics", package = "ggplot2")
ui <- fluidPage(
tags$h2("Retrieve selection information"),
fluidRow(
column(
width = 8,
tags$b("Datetime"),
apexchartOutput("chart1")
),
column(
width = 4,
verbatimTextOutput("result1")
)
),
fluidRow(
column(
width = 8,
tags$b("Scatter"),
apexchartOutput("chart2")
),
column(
width = 4,
verbatimTextOutput("result2")
)
)
)
server <- function(input, output, session) {
output$chart1 <- renderApexchart({
apex(economics, aes(date, psavert), type = "line") %>%
set_input_selection("selection_ts")
})
output$result1 <- renderPrint({
input$selection_ts
})
output$chart2 <- renderApexchart({
apex(iris, aes(Sepal.Length, Sepal.Width), type = "scatter") %>%
set_input_selection("selection_scatter", type = "xy")
})
output$result2 <- renderPrint({
input$selection_scatter
})
}
shinyApp(ui, server)

View File

@ -0,0 +1,53 @@
library(shiny)
library(apexcharter)
data("economics", package = "ggplot2")
ui <- fluidPage(
tags$h2("Retrieve zoom information"),
fluidRow(
column(
width = 8,
tags$b("Datetime"),
apexchartOutput("chart1")
),
column(
width = 4,
verbatimTextOutput("result1")
)
),
fluidRow(
column(
width = 8,
tags$b("Scatter"),
apexchartOutput("chart2")
),
column(
width = 4,
verbatimTextOutput("result2")
)
)
)
server <- function(input, output, session) {
output$chart1 <- renderApexchart({
apex(economics, aes(date, psavert), type = "line") %>%
set_input_zoom("zoom_ts")
})
output$result1 <- renderPrint({
input$zoom_ts
})
output$chart2 <- renderApexchart({
apex(iris, aes(Sepal.Length, Sepal.Width), type = "scatter") %>%
ax_chart(zoom = list(type = "xy")) %>%
set_input_zoom("zoom_scatter")
})
output$result2 <- renderPrint({
input$zoom_scatter
})
}
shinyApp(ui, server)

View File

@ -1,54 +1,245 @@
/*!
*
* htmlwidgets bindings for ApexCharts
* https://github.com/dreamRs/apexcharter
*
*/
/// Functions
// From Friss tuto (https://github.com/FrissAnalytics/shinyJsTutorials/blob/master/tutorials/tutorial_03.Rmd)
function get_widget(id) {
var htmlWidgetsObj = HTMLWidgets.find("#" + id);
var widgetObj;
if (typeof htmlWidgetsObj !== "undefined") {
widgetObj = htmlWidgetsObj.getChart();
}
return widgetObj;
}
function is_single(options) {
var typeLabels = ["pie", "radialBar", "donut"];
var lab = typeLabels.indexOf(options.w.config.chart.type) > -1;
var single = options.w.config.series.length === 1;
return lab | single;
}
function is_datetime(chartContext) {
if (
chartContext.hasOwnProperty("w") &&
chartContext.w.hasOwnProperty("config") &&
chartContext.w.config.hasOwnProperty("xaxis") &&
chartContext.w.config.xaxis.hasOwnProperty("type")
) {
return chartContext.w.config.xaxis.type == "datetime";
} else {
return false;
}
}
function getSelection(chartContext, selectedDataPoints, serieIndex) {
var typeLabels = ["pie", "radialBar", "donut"];
var typeXY = ["scatter", "bubble"];
var selected;
if (typeLabels.indexOf(chartContext.opts.chart.type) > -1) {
var labels = chartContext.opts.labels;
selected = selectedDataPoints[serieIndex].map(function(index) {
return labels[index];
});
} else {
var data = chartContext.opts.series[serieIndex].data;
selected = selectedDataPoints[serieIndex].map(function(index) {
var val = data[index];
if (typeXY.indexOf(chartContext.opts.chart.type) < 0) {
if (val.hasOwnProperty("x")) {
val = val.x;
} else {
val = val[0];
}
}
return val;
});
}
//console.log(selected);
if (typeXY.indexOf(chartContext.opts.chart.type) > -1) {
selected = {
x: selected.map(function(obj) {
return obj.x;
}),
y: selected.map(function(obj) {
return obj.y;
})
};
}
if (typeof selected == "undefined") {
selected = null;
}
return selected;
}
function getYaxis(axis) {
var yzoom = { min: null, max: null };
if (typeof axis.yaxis !== "undefined" && axis.yaxis !== null) {
var y_axis;
if (axis.yaxis.hasOwnProperty("min")) {
y_axis = axis.yaxis;
} else {
y_axis = axis.yaxis[0];
}
if (y_axis.hasOwnProperty("min") && typeof y_axis.min !== "undefined") {
yzoom.min = y_axis.min;
}
if (y_axis.hasOwnProperty("max") && typeof y_axis.max !== "undefined") {
yzoom.max = y_axis.max;
}
}
return yzoom;
}
function getXaxis(axis) {
var xzoom = { min: null, max: null };
if (typeof axis.xaxis !== "undefined") {
var x_axis = axis.xaxis;
if (x_axis.hasOwnProperty("min") && typeof x_axis.min !== "undefined") {
xzoom.min = x_axis.min;
}
if (x_axis.hasOwnProperty("max") && typeof x_axis.max !== "undefined") {
xzoom.max = x_axis.max;
}
}
return xzoom;
}
/// Widget
HTMLWidgets.widget({
name: "apexcharter",
name: 'apexcharter',
type: 'output',
type: "output",
factory: function(el, width, height) {
var ax_opts;
var axOpts;
var apexchart = null;
return {
renderValue: function(x) {
// Global options
ax_opts = x.ax_opts;
axOpts = x.ax_opts;
// Sizing
if (typeof ax_opts.chart === 'undefined') {
ax_opts.chart = {};
if (typeof axOpts.chart === "undefined") {
axOpts.chart = {};
}
axOpts.chart.width = width;
axOpts.chart.height = height;
if (!axOpts.chart.hasOwnProperty("parentHeightOffset")) {
axOpts.chart.parentHeightOffset = 0;
}
if (x.hasOwnProperty("shinyEvents") & HTMLWidgets.shinyMode) {
if (!axOpts.hasOwnProperty("chart")) {
axOpts.chart = {};
}
if (!axOpts.chart.hasOwnProperty("events")) {
axOpts.chart.events = {};
}
if (x.shinyEvents.hasOwnProperty("click")) {
axOpts.chart.events.dataPointSelection = function(
event,
chartContext,
opts
) {
var options = opts;
var nonEmpty = opts.selectedDataPoints.filter(function(el) {
return el !== null && el.length > 0;
});
if (nonEmpty.length > 0) {
var select = {};
for (var i = 0; i < opts.selectedDataPoints.length; i++) {
if (typeof opts.selectedDataPoints[i] === "undefined") {
continue;
}
var selection = getSelection(
chartContext,
options.selectedDataPoints,
i
);
if (selection !== null) {
if (opts.w.config.series[i].hasOwnProperty("name")) {
var name = opts.w.config.series[i].name;
select[name] = selection;
} else {
select[i] = selection;
}
}
}
if (is_single(options)) {
select = select[Object.keys(select)[0]];
}
Shiny.setInputValue(
x.shinyEvents.click.inputId + ":apex_click",
{ value: select, datetime: is_datetime(chartContext) }
);
} else {
Shiny.setInputValue(x.shinyEvents.click.inputId, null);
}
};
}
if (x.shinyEvents.hasOwnProperty("zoomed")) {
axOpts.chart.events.zoomed = function(chartContext, xaxis, yaxis) {
var id = x.shinyEvents.zoomed.inputId;
if (is_datetime(chartContext)) {
id = id + ":apex_datetime";
}
Shiny.setInputValue(id, {
x: getXaxis(xaxis),
y: getYaxis(xaxis)
});
};
}
if (x.shinyEvents.hasOwnProperty("selection")) {
axOpts.chart.events.selection = function(
chartContext,
xaxis,
yaxis
) {
var id = x.shinyEvents.selection.inputId;
if (is_datetime(chartContext)) {
id = id + ":apex_datetime";
}
var selectionValue;
if (x.shinyEvents.selection.type === "x") {
selectionValue = { x: xaxis.xaxis };
} else if (x.shinyEvents.selection.type === "xy") {
selectionValue = { x: xaxis.xaxis, y: getYaxis(xaxis) };
} else if (x.shinyEvents.selection.type === "y") {
selectionValue = { y: getYaxis(xaxis) };
}
Shiny.setInputValue(id, selectionValue);
};
}
ax_opts.chart.width = width;
ax_opts.chart.height = height;
if (!ax_opts.chart.hasOwnProperty('parentHeightOffset')) {
ax_opts.chart.parentHeightOffset = 0;
}
// Generate or update chart
if (apexchart === null) {
apexchart = new ApexCharts(el, ax_opts);
apexchart = new ApexCharts(el, axOpts);
apexchart.render();
} else {
if (x.auto_update) {
apexchart.updateSeries(ax_opts.series, x.auto_update.series_animate);
apexchart.updateSeries(axOpts.series, x.auto_update.series_animate);
if (x.auto_update.update_options) {
apexchart.updateOptions(
ax_opts,
axOpts,
x.auto_update.options_redrawPaths,
x.auto_update.options_animate
);
}
} else {
apexchart.destroy();
apexchart = new ApexCharts(el, ax_opts);
apexchart = new ApexCharts(el, axOpts);
apexchart.render();
}
}
},
getChart: function() {
@ -63,52 +254,32 @@ HTMLWidgets.widget({
}
});
}
};
}
});
// From Friss tuto (https://github.com/FrissAnalytics/shinyJsTutorials/blob/master/tutorials/tutorial_03.Rmd)
function get_widget(id){
// Get the HTMLWidgets object
var htmlWidgetsObj = HTMLWidgets.find("#" + id);
// Use the getChart method we created to get the underlying billboard chart
var widgetObj ;
if (typeof htmlWidgetsObj != 'undefined') {
widgetObj = htmlWidgetsObj.getChart();
}
return(widgetObj);
}
if (HTMLWidgets.shinyMode) {
// update serie
Shiny.addCustomMessageHandler('update-apexchart-series',
function(obj) {
Shiny.addCustomMessageHandler("update-apexchart-series", function(obj) {
var chart = get_widget(obj.id);
if (typeof chart != 'undefined') {
chart.updateSeries([{
if (typeof chart != "undefined") {
chart.updateSeries(
[
{
data: obj.data.newSeries
}], obj.data.animate);
}
],
obj.data.animate
);
}
});
// update options
Shiny.addCustomMessageHandler('update-apexchart-options',
function(obj) {
Shiny.addCustomMessageHandler("update-apexchart-options", function(obj) {
var chart = get_widget(obj.id);
if (typeof chart != 'undefined') {
if (typeof chart != "undefined") {
chart.updateOptions(obj.data.options);
}
});
}

View File

@ -1,6 +1,6 @@
dependencies:
- name: apexcharts
version: 3.16.0
version: 3.16.1
src: htmlwidgets/lib/apexcharts-3.16
script: apexcharts.min.js
- name: d3-format

File diff suppressed because one or more lines are too long

View File

@ -22,7 +22,7 @@ a \code{data.frame}, it will be coerced to with \code{as.data.frame}.}
\item{mapping}{Default list of aesthetic mappings to use for chart}
\item{type}{Specify the chart type. Available Options:
\item{type}{Specify the chart type. Available options:
\code{"column"}, \code{"bar"}, \code{"line"},
\code{"area"}, \code{"spline"}, \code{"pie"}, \code{"donut"},
\code{"radialBar"}, \code{"radar"}, \code{"scatter"}, \code{"heatmap"},

17
man/format_date.Rd Normal file
View File

@ -0,0 +1,17 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/format.R
\name{format_date}
\alias{format_date}
\title{Format date in JS}
\usage{
format_date(x)
}
\arguments{
\item{x}{Date to use in JavaScript}
}
\value{
a JavaScript string
}
\description{
Format date in JS
}

23
man/run_input_demo.Rd Normal file
View File

@ -0,0 +1,23 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/shiny-input.R
\name{run_input_demo}
\alias{run_input_demo}
\title{Run Shiny input events examples}
\usage{
run_input_demo(example = c("click", "zoom", "selection"))
}
\arguments{
\item{example}{Name of the example.}
}
\description{
Run Shiny input events examples
}
\examples{
if (interactive()) {
run_input_demo("click")
run_input_demo("zoom")
run_input_demo("selection")
}
}

64
man/set_input_click.Rd Normal file
View File

@ -0,0 +1,64 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/shiny-input.R
\name{set_input_click}
\alias{set_input_click}
\title{Retrieve click information in Shiny}
\usage{
set_input_click(
ax,
inputId,
multiple = FALSE,
effect_type = c("darken", "lighten", "none"),
effect_value = 0.35,
session = shiny::getDefaultReactiveDomain()
)
}
\arguments{
\item{ax}{An \code{apexcharts} \code{htmlwidget} object.}
\item{inputId}{The id that will be used server-side for retrieving click.}
\item{multiple}{Allow multiple selection: \code{TRUE} or \code{FALSE} (default).}
\item{effect_type}{Type of effect for selected element, default is to use lightly darken color.}
\item{effect_value}{A larger value intensifies the select effect, accept value between 0 and 1.}
\item{session}{The Shiny session.}
}
\value{
An \code{apexcharts} \code{htmlwidget} object.
}
\description{
According to type of chart, different values are retrieved:
\itemize{
\item \strong{bar and column:} retrieve category (x-axis).
\item \strong{pie and donut:} retrieve label.
\item \strong{time-series:} retrieve x-axis value, you have to display markers
with size > 0 and set tooltip's options \code{intersect = TRUE} and \code{shared = FALSE}.
\item \strong{scatter:} retrieve XY coordinates.
}
}
\note{
If x-axis is of type datetime, value retrieved is of class \code{POSIXct}.
}
\examples{
library(apexcharter)
# Not in Shiny but you can still click on bars
data.frame(
month = month.abb,
value = sample(1:100, 12)
) \%>\%
apex(aes(month, value)) \%>\%
set_input_click("month_click", multiple = TRUE)
# Interactive examples:
if (interactive()) {
run_input_demo("click")
}
}

View File

@ -0,0 +1,73 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/shiny-input.R
\name{set_input_selection}
\alias{set_input_selection}
\title{Retrieve selection information in Shiny}
\usage{
set_input_selection(
ax,
inputId,
type = c("x", "xy", "y"),
fill_color = "#24292e",
fill_opacity = 0.1,
stroke_width = 1,
stroke_dasharray = 3,
stroke_color = "#24292e",
stroke_opacity = 0.4,
xmin = NULL,
xmax = NULL,
ymin = NULL,
ymax = NULL,
session = shiny::getDefaultReactiveDomain()
)
}
\arguments{
\item{ax}{An \code{apexcharts} \code{htmlwidget} object.}
\item{inputId}{The id that will be used server-side for retrieving selection.}
\item{type}{Allow selection either on x-axis, y-axis or on both axis.}
\item{fill_color}{Background color of the selection rect which is drawn when user drags on the chart.}
\item{fill_opacity}{Opacity of background color of the selection rectangle.}
\item{stroke_width}{Border thickness of the selection rectangle.}
\item{stroke_dasharray}{Creates dashes in borders of selection rectangle.
Higher number creates more space between dashes in the border.}
\item{stroke_color}{Colors of selection border.}
\item{stroke_opacity}{Opacity of selection border.}
\item{xmin, xmax}{Start value of x-axis. Both \code{min} and \code{max} must be provided.}
\item{ymin, ymax}{Start value of y-axis. Both \code{min} and \code{max} must be provided.}
\item{session}{The Shiny session.}
}
\value{
An \code{apexcharts} \code{htmlwidget} object.
}
\description{
Retrieve selection information in Shiny
}
\examples{
library(apexcharter)
data("economics", package = "ggplot2")
# Not in Shiny so no events
# but you can still select an area on chart
apex(economics, aes(date, psavert), type = "line") \%>\%
set_input_selection("selection")
# Default selection at start
apex(economics, aes(date, psavert), type = "line") \%>\%
set_input_selection(
inputId = "selection",
xmin = format_date("1980-01-01"),
xmax = format_date("1985-01-01")
)
}

31
man/set_input_zoom.Rd Normal file
View File

@ -0,0 +1,31 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/shiny-input.R
\name{set_input_zoom}
\alias{set_input_zoom}
\title{Retrieve zoom information in Shiny}
\usage{
set_input_zoom(ax, inputId, session = shiny::getDefaultReactiveDomain())
}
\arguments{
\item{ax}{An \code{apexcharts} \code{htmlwidget} object.}
\item{inputId}{The id that will be used server-side for retrieving zoom.}
\item{session}{The Shiny session.}
}
\value{
An \code{apexcharts} \code{htmlwidget} object.
}
\description{
Retrieve zoom information in Shiny
}
\note{
If x-axis is of type datetime, value retrieved is of class \code{POSIXct}.
}
\examples{
if (interactive()) {
run_input_demo("zoom")
}
}

View File

@ -0,0 +1,235 @@
---
title: "Shiny integration"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{shiny-integration}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
eval = FALSE
)
library(apexcharter)
```
```{r setup}
library(apexcharter)
```
## Charts
### Create and update (or destroy and re-create)
When a graph has been generated in Shiny, if the values change (via a reactive function), the graph is *not regenerated*, only the data is *updated*. If you have changed specific options in the graphic (such as maximum y axis value, chart's title, ...) these will not be updated. This behavior can be controlled with `auto_update` argument (available in `apexchart()` and `apex()`) :
By default, `auto_update` is `TRUE` :
```{r}
apex(..., auto_update = TRUE)
```
If you want to re-create the whole chart, set the option to `FALSE`:
```{r}
apex(..., auto_update = FALSE)
```
You can also use `config_update()` to specify what to update :
```{r}
apex(..., auto_update = config_update(update_options = TRUE))
```
### Proxy
A proxy is also implemented to update charts manually server-side. You can update data:
```{r}
output$my_chart <- renderApexchart({
apex(data = isolate(data_reactive()), ..., auto_update = FALSE)
})
observeEvent(input$update, {
apexchartProxy("my_chart") %>%
ax_proxy_series(data_reactive())
})
```
Be sure to use `shiny::isolate()` to block any reactivity in `renderApexchart` function and to set `auto_update` to FALSE to prevent updating twice.
Then you can use in an observe function (or any reactive function) `apexchartProxy()` with the output id to get the chart instance and `ax_proxy_series()` to update data.
If you want to update chart's options, use :
```{r}
observeEvent(input$update, {
apexchartProxy("my_chart") %>%
ax_proxy_options(list(
title = list(
text = "New title"
),
xaxis = list(
max = NEW_VALUE
)
))
})
```
## Interactions
### Click
Click on a chart to select a data point and retrieve value server side with `set_input_click()` :
```{r, eval=TRUE}
data.frame(
month = month.abb,
value = sample(1:100, 12)
) %>%
apex(aes(month, value), height = "250px") %>%
ax_title("Click a bar:") %>%
set_input_click("click")
```
Value server-side will be available through `input$click`.
Depending on the type of graphic, you can retrieve :
* **bar and column:** category (x-axis).
* **pie and donut:** label.
* **time-series:** retrieve x-axis value, you have to display markers
with size > 0 and set tooltip's options `intersect = TRUE` and `shared = FALSE`.
* **scatter:** retrieve XY coordinates.
Multiple selection is possible and you can change the darken effect of selected bars :
```{r, eval=TRUE}
data.frame(
month = month.abb,
value = sample(1:100, 12)
) %>%
apex(aes(month, value), height = "250px") %>%
ax_title("Click several bars:") %>%
set_input_click(
inputId = "click",
multiple = TRUE,
effect_value = 0.1
)
```
More examples are available with:
```{r}
run_input_demo("click")
```
### Zoom
Retrieve the coordinates of the axes when the graph is zoomed in:
```{r, eval=TRUE}
data("economics", package = "ggplot2")
apex(economics, aes(date, psavert), type = "line", height = "250px") %>%
set_input_zoom("zoom")
```
Value server-side will be available through `input$zoom` under the form :
```{r, echo=FALSE, eval=TRUE}
list(
x = list(
min = "1981-10-24 15:41:16 UTC",
max = "1992-01-24 06:40:22 UTC"
),
y = list(
min = NULL,
max = NULL
)
)
```
Here values for `y` are `NULL` because zoom is only possible on x-axis, but for a scatter chart for example you can zoom on both axis.
More examples are available with:
```{r}
run_input_demo("zoom")
```
### Selection
Retrieve the coordinates of the axes when user select an area on a chart (without zooming):
```{r, eval=TRUE}
apex(economics, aes(date, psavert), type = "line", height = "250px") %>%
set_input_selection("selection")
```
Value server-side will be available through `input$selection` under the form :
```{r, echo=FALSE, eval=TRUE}
list(
x = list(
min = "1981-10-24 15:41:16 UTC",
max = "1992-01-24 06:40:22 UTC"
)
)
```
You can define a selected area at start:
```{r, eval=TRUE}
apex(economics, aes(date, psavert), type = "line", height = "250px") %>%
set_input_selection(
inputId = "selection",
xmin = format_date("1980-01-01"),
xmax = format_date("1985-01-01")
)
```
Above selection is only made possible on x-axis, but in case of scatter chart for example, you can select a rectangle (both axis):
```{r, eval=TRUE}
apex(iris, aes(Sepal.Length, Sepal.Width), type = "scatter", height = "250px") %>%
set_input_selection("selection_scatter", type = "xy")
```
In this case, input value will look like this:
```{r, echo=FALSE, eval=TRUE}
list(
x = list(
min = 5.130187,
max = 5.541228
),
y = list(
min = 2.959623,
max = 3.860357
)
)
```
More examples are available with:
```{r}
run_input_demo("selection")
```

View File

@ -17,19 +17,19 @@ knitr::opts_chunk$set(
```{r setup}
library(apexcharter)
data("economics", package = "ggplot2")
economics <- tail(economics, 150)
```
## Sync charts
With [Apexcharts](https://apexcharts.com) you can sync (tooltip, zoom) several charts together by providing a group and id to each charts. This works in Shiny and Markdown. Here a basic example :
```{r example-1, eval=FALSE}
apex(
data = economics,
data = tail(economics, 150),
mapping = aes(x = date, y = pce),
type = "line"
) %>%
ax_stroke(width = 2) %>%
ax_chart(
group = "economics", id = "pce" # <- define common group and unique id
) %>%
@ -40,11 +40,10 @@ apex(
)
apex(
data = economics,
data = tail(economics, 150),
mapping = aes(x = date, y = psavert),
type = "line"
) %>%
ax_stroke(width = 2) %>%
ax_chart(
group = "economics", id = "psavert" # <- define common group and unique id
) %>%
@ -59,3 +58,52 @@ apex(
```{r run-example-1, echo=FALSE, ref.label="example-1"}
```
## Brush chart
Create a brush chart to navigate into a synced chart.
```{r example-2, eval=FALSE}
apex(
data = economics,
mapping = aes(x = date, y = psavert),
type = "line"
) %>%
ax_chart(
id = "target-chart", # <-- define target id here
toolbar = list(
autoSelected = "pan",
show = FALSE
)
)
apex(
data = economics,
mapping = aes(x = date, y = psavert),
type = "line",
height = "130px"
) %>%
ax_chart(
brush = list(
target = "target-chart", # <-- use target id here
enabled = TRUE
),
offsetY = -20,
selection = list(
enabled = TRUE, # <-- enable selection and define starting range
xaxis = list(
min = format_date(economics$date[1]),
max = format_date(economics$date[100])
)
)
) %>%
ax_xaxis(labels = list(show = FALSE)) %>%
ax_yaxis(labels = list(show = FALSE))
```
```{r run-example-2, echo=FALSE, ref.label="example-2"}
```