click for multiple series

This commit is contained in:
pvictor 2020-03-04 15:14:02 +01:00
parent 38dde279f9
commit a0ec017373
7 changed files with 185 additions and 81 deletions

View File

@ -19,14 +19,14 @@ Imports:
magrittr,
rlang,
ggplot2,
jsonlite
jsonlite,
shiny (>= 1.1.0)
Suggests:
testthat,
dplyr,
knitr,
scales,
rmarkdown,
shiny,
gapminder,
highcharter
RoxygenNote: 7.0.2

View File

@ -52,5 +52,6 @@ importFrom(htmlwidgets,sizingPolicy)
importFrom(magrittr,"%>%")
importFrom(rlang,as_label)
importFrom(rlang,eval_tidy)
importFrom(shiny,getDefaultReactiveDomain)
importFrom(stats,setNames)
importFrom(utils,modifyList)

View File

@ -10,6 +10,8 @@
#' default value will suffice
#'
#' @export
#'
#' @importFrom shiny getDefaultReactiveDomain
#'
apexchartProxy <- function(shinyId, session = shiny::getDefaultReactiveDomain()) {

View File

@ -12,14 +12,19 @@
#' @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.
#'
#'
#' @return An \code{apexcharts} \code{htmlwidget} object.
#' @export
#'
#' @importFrom shiny getDefaultReactiveDomain
#'
#' @examples
set_input_click <- function(ax, inputId, multiple = FALSE,
effect_type = c("darken", "lighten", "none"),
effect_value = 0.35) {
effect_value = 0.35,
session = shiny::getDefaultReactiveDomain()) {
effect_type <- match.arg(effect_type)
ax <- ax_states(ax, active = list(
allowMultipleDataPointsSelection = isTRUE(multiple),
@ -29,7 +34,7 @@ set_input_click <- function(ax, inputId, multiple = FALSE,
)
))
ax$x$input$category <- list(
inputId = inputId
inputId = session$ns(inputId)
)
ax
}

View File

@ -6,16 +6,22 @@ ui <- fluidPage(
tags$h2("Retrieve click information"),
fluidRow(
column(
width = 6,
width = 4,
tags$b("Single selection"),
apexchartOutput("chart1"),
verbatimTextOutput("result1")
apexchartOutput("bar1"),
verbatimTextOutput("clickbar1")
),
column(
width = 6,
width = 4,
tags$b("Multiple selection"),
apexchartOutput("chart2"),
verbatimTextOutput("result2")
apexchartOutput("bar2"),
verbatimTextOutput("clickbar2")
),
column(
width = 4,
tags$b("Several series"),
apexchartOutput("bar3"),
verbatimTextOutput("clickbar3")
)
),
fluidRow(
@ -32,12 +38,28 @@ ui <- fluidPage(
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")
)
),
tags$br()
)
server <- function(input, output, session) {
output$chart1 <- renderApexchart({
# Bar single ----
output$bar1 <- renderApexchart({
data.frame(
month = month.abb,
value = sample(1:100, 12)
@ -45,11 +67,12 @@ server <- function(input, output, session) {
apex(aes(month, value)) %>%
set_input_click("month_click")
})
output$result1 <- renderPrint({
output$clickbar1 <- renderPrint({
input$month_click
})
output$chart2 <- renderApexchart({
# Bar multiple ----
output$bar2 <- renderApexchart({
data.frame(
month = month.abb,
value = sample(1:100, 12)
@ -61,10 +84,27 @@ server <- function(input, output, session) {
effect_value = 0.1
)
})
output$result2 <- renderPrint({
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"),
@ -77,6 +117,7 @@ server <- function(input, output, session) {
input$click_pie
})
# Time-serie ----
output$chart4 <- renderApexchart({
data.frame(
date = seq(as.Date("1960-01-01"), length.out = 24, by = "month"),
@ -91,6 +132,26 @@ server <- function(input, output, session) {
input$click_time
})
# Scatter ----
output$chart5 <- renderApexchart({
apex(data = mtcars, type = "scatter", mapping = aes(x = wt, y = mpg)) %>%
set_input_click("click_scatter", multiple = TRUE)
})
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
})
}
shinyApp(ui, server)

View File

@ -1,19 +1,14 @@
HTMLWidgets.widget({
name: "apexcharter",
name: 'apexcharter',
type: 'output',
type: "output",
factory: function(el, width, height) {
var ax_opts;
var apexchart = null;
return {
renderValue: function(x) {
// Global options
ax_opts = x.ax_opts;
@ -26,7 +21,7 @@ HTMLWidgets.widget({
if (!ax_opts.chart.hasOwnProperty("parentHeightOffset")) {
ax_opts.chart.parentHeightOffset = 0;
}
if (x.hasOwnProperty("input") & HTMLWidgets.shinyMode) {
if (!ax_opts.hasOwnProperty("chart")) {
ax_opts.chart = {};
@ -35,30 +30,27 @@ HTMLWidgets.widget({
ax_opts.chart.events = {};
}
if (x.input.hasOwnProperty("category")) {
ax_opts.chart.events.dataPointSelection = function(event, chartContext, opts) {
var typeLabels = ["pie", "radialBar", "donut"];
var selected;
if (typeLabels.indexOf(opts.w.config.chart.type) > -1) {
var labels = opts.w.config.labels;
selected = opts.selectedDataPoints[0].map(function(index) {
return labels[index];
});
} else {
var data = opts.w.config.series[opts.seriesIndex].data;
selected = opts.selectedDataPoints[0].map(function(index) {
var val = data[index];
if (val.hasOwnProperty("x")) {
val = val.x;
} else {
val = val[0];
}
return val;
});
ax_opts.chart.events.dataPointSelection = function(
event,
chartContext,
opts
) {
var selected = {};
for (var i = 0; i < opts.selectedDataPoints.length; i++) {
if (typeof opts.selectedDataPoints[i] === "undefined") {
continue;
}
if (opts.w.config.series[i].hasOwnProperty("name")) {
var name = opts.w.config.series[i].name;
selected[name] = getSelection(opts, i);
} else {
selected[i] = getSelection(opts, i);
}
}
Shiny.setInputValue(
x.input.category.inputId,
selected
);
if (is_single(opts)) {
selected = selected[Object.keys(selected)[0]];
}
Shiny.setInputValue(x.input.category.inputId, selected);
};
}
}
@ -69,11 +61,14 @@ HTMLWidgets.widget({
apexchart.render();
} else {
if (x.auto_update) {
apexchart.updateSeries(ax_opts.series, x.auto_update.series_animate);
apexchart.updateSeries(
ax_opts.series,
x.auto_update.series_animate
);
if (x.auto_update.update_options) {
apexchart.updateOptions(
ax_opts,
x.auto_update.options_redrawPaths,
ax_opts,
x.auto_update.options_redrawPaths,
x.auto_update.options_animate
);
}
@ -83,11 +78,9 @@ HTMLWidgets.widget({
apexchart.render();
}
}
},
getChart: function(){
getChart: function() {
return apexchart;
},
@ -99,52 +92,91 @@ HTMLWidgets.widget({
}
});
}
};
}
});
// From Friss tuto (https://github.com/FrissAnalytics/shinyJsTutorials/blob/master/tutorials/tutorial_03.Rmd)
function get_widget(id){
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') {
var widgetObj;
if (typeof htmlWidgetsObj != "undefined") {
widgetObj = htmlWidgetsObj.getChart();
}
return(widgetObj);
return widgetObj;
}
function is_single(opts) {
var typeLabels = ["pie", "radialBar", "donut"];
var lab = typeLabels.indexOf(opts.w.config.chart.type) > -1;
var single = opts.w.config.series.length == 1;
return lab | single;
}
function getSelection(opts, serieIndex) {
var typeLabels = ["pie", "radialBar", "donut"];
var typeXY = ["scatter", "bubble"];
var selected;
if (typeLabels.indexOf(opts.w.config.chart.type) > -1) {
var labels = opts.w.config.labels;
selected = opts.selectedDataPoints[serieIndex].map(function(index) {
return labels[index];
});
} else {
var data = opts.w.config.series[serieIndex].data;
//console.log(opts.selectedDataPoints);
selected = opts.selectedDataPoints[serieIndex].map(function(index) {
var val = data[index];
if (typeXY.indexOf(opts.w.config.chart.type) < 0) {
if (val.hasOwnProperty("x")) {
val = val.x;
} else {
val = val[0];
}
}
return val;
});
}
if (typeXY.indexOf(opts.w.config.chart.type) > -1) {
selected = {
x: selected.map(function(obj) {
return obj.x;
}),
y: selected.map(function(obj) {
return obj.y;
})
};
}
return selected;
}
if (HTMLWidgets.shinyMode) {
// update serie
Shiny.addCustomMessageHandler('update-apexchart-series',
function(obj) {
var chart = get_widget(obj.id);
if (typeof chart != 'undefined') {
chart.updateSeries([{
data: obj.data.newSeries
}], obj.data.animate);
}
Shiny.addCustomMessageHandler("update-apexchart-series", function(obj) {
var chart = get_widget(obj.id);
if (typeof chart != "undefined") {
chart.updateSeries(
[
{
data: obj.data.newSeries
}
],
obj.data.animate
);
}
});
// update options
Shiny.addCustomMessageHandler('update-apexchart-options',
function(obj) {
var chart = get_widget(obj.id);
if (typeof chart != 'undefined') {
chart.updateOptions(obj.data.options);
}
Shiny.addCustomMessageHandler("update-apexchart-options", function(obj) {
var chart = get_widget(obj.id);
if (typeof chart != "undefined") {
chart.updateOptions(obj.data.options);
}
});
}

View File

@ -9,7 +9,8 @@ set_input_click(
inputId,
multiple = FALSE,
effect_type = c("darken", "lighten", "none"),
effect_value = 0.35
effect_value = 0.35,
session = shiny::getDefaultReactiveDomain()
)
}
\arguments{
@ -22,6 +23,8 @@ set_input_click(
\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.