From a0ec0173737114dab2dfd9be0ed2de7d10552aa1 Mon Sep 17 00:00:00 2001 From: pvictor Date: Wed, 4 Mar 2020 15:14:02 +0100 Subject: [PATCH] click for multiple series --- DESCRIPTION | 4 +- NAMESPACE | 1 + R/proxy.R | 2 + R/shiny-input.R | 9 +- inst/examples-input/click.R | 83 +++++++++++++--- inst/htmlwidgets/apexcharter.js | 162 +++++++++++++++++++------------- man/set_input_click.Rd | 5 +- 7 files changed, 185 insertions(+), 81 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 71a1a8b..96315d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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 diff --git a/NAMESPACE b/NAMESPACE index 8a79839..23d292a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -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) diff --git a/R/proxy.R b/R/proxy.R index cfd4873..fe15018 100644 --- a/R/proxy.R +++ b/R/proxy.R @@ -10,6 +10,8 @@ #' default value will suffice #' #' @export +#' +#' @importFrom shiny getDefaultReactiveDomain #' apexchartProxy <- function(shinyId, session = shiny::getDefaultReactiveDomain()) { diff --git a/R/shiny-input.R b/R/shiny-input.R index 415b3ab..2a895c4 100644 --- a/R/shiny-input.R +++ b/R/shiny-input.R @@ -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 } diff --git a/inst/examples-input/click.R b/inst/examples-input/click.R index ddc49bc..48e7056 100644 --- a/inst/examples-input/click.R +++ b/inst/examples-input/click.R @@ -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) diff --git a/inst/htmlwidgets/apexcharter.js b/inst/htmlwidgets/apexcharter.js index eee366c..c488ab4 100644 --- a/inst/htmlwidgets/apexcharter.js +++ b/inst/htmlwidgets/apexcharter.js @@ -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); + } }); } - - - - diff --git a/man/set_input_click.Rd b/man/set_input_click.Rd index 8c6d5a1..9b37864 100644 --- a/man/set_input_click.Rd +++ b/man/set_input_click.Rd @@ -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.