rstudio / crosstalk

Inter-htmlwidget communication for R (with and without Shiny)
http://rstudio.github.io/crosstalk
Other
288 stars 52 forks source link

Highlight in plotly figure breaks in shiny app when fixed group argument is used in SharedData$new() #132

Open LDSamson opened 2 years ago

LDSamson commented 2 years ago

The Highlight in a plotly figure breaks when fixed group argument is used in SharedData$new(). I think it is a crosstalk and not a plotly issue, but please correct me if I am wrong.

This only happens when filtering the dataset in Shiny, dynamically selecting between two (or more) groups to show. It only happens when in the plotly figure a factor is used, of which the levels are different between the (dynamically selected) groups . In my examples this is the variable col_group, see below:

library(shiny)
library(plotly)
library(dplyr)
library(crosstalk)

example_data <- data.frame(
  id         = unlist(lapply(1:25, rep, times = 4)),
  item       = rep(c("item1", "item2"), times = 50),
  xvalue     = rnorm(100),
  yvalue     = rnorm(100)
) %>% 
  mutate(
    col_group = round(runif(100, 1,5), digits = 0),
    col_group = ifelse(item == "item2" & col_group %in% 4:5, 1, col_group),
    col_group = factor(col_group)
  )

plotly_figure <- function(data, group = "group1"){
  SharedData$new(data, ~id, group = group) %>% 
    plot_ly(x = ~xvalue, y = ~yvalue, 
            color = ~col_group, text = ~id, 
            type = "scatter", mode = "markers")
}

ui <- fluidPage(
  selectInput(
    inputId = "selection", 
    label = "select item",
    choices = unique(example_data$item)
  ),
  plotlyOutput("figure")
)

server <- function(input, output) {
  data_reactive <- reactive(filter(example_data, item == input$selection))
  output$figure <- renderPlotly(plotly_figure(data_reactive()))
}

shinyApp(ui = ui, server = server)

Expectation: When clicking on a point, I expect that all points with the same ID are highlighted

What happens Only when item1 is selected, the behaviour is as expected. When item2 is selected, nothing happens after a click.

solutions/workarounds

The problem does not occur :

dynamicgroup <- reactiveVal("grouped")
observeEvent(input$selection, {
    dynamicgroup(crosstalk:::createUniqueId(4))
  })
  output$figure <- renderPlotly(plotly_figure(data_reactive(), dynamicgroup()))
session info: ``` R version 4.2.1 (2022-06-23 ucrt) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 19044) Matrix products: default locale: [1] LC_COLLATE=English_United Kingdom.utf8 LC_CTYPE=English_United Kingdom.utf8 [3] LC_MONETARY=English_United Kingdom.utf8 LC_NUMERIC=C [5] LC_TIME=English_United Kingdom.utf8 attached base packages: [1] stats graphics grDevices utils datasets methods base other attached packages: [1] crosstalk_1.2.0 dplyr_1.0.10 plotly_4.10.0 ggplot2_3.3.6 shiny_1.7.2 loaded via a namespace (and not attached): [1] tidyselect_1.1.2 xfun_0.33 bslib_0.4.0 purrr_0.3.4 [5] colorspace_2.0-3 vctrs_0.4.1 generics_0.1.3 htmltools_0.5.3 [9] viridisLite_0.4.1 yaml_2.3.5 utf8_1.2.2 rlang_1.0.6 [13] later_1.3.0 pillar_1.8.1 jquerylib_0.1.4 glue_1.6.2 [17] withr_2.5.0 RColorBrewer_1.1-3 lifecycle_1.0.2 stringr_1.4.1 [21] munsell_0.5.0 gtable_0.3.1 htmlwidgets_1.5.4 evaluate_0.16 [25] memoise_2.0.1 labeling_0.4.2 knitr_1.40 fastmap_1.1.0 [29] httpuv_1.6.6 fansi_1.0.3 highr_0.9 Rcpp_1.0.9 [33] xtable_1.8-4 promises_1.2.0.1 scales_1.2.1 cachem_1.0.6 [37] jsonlite_1.8.0 farver_2.1.1 mime_0.12 digest_0.6.29 [41] stringi_1.7.8 grid_4.2.1 cli_3.4.1 tools_4.2.1 [45] magrittr_2.0.3 sass_0.4.2 lazyeval_0.2.2 tibble_3.1.8 [49] crayon_1.5.2 tidyr_1.2.1 pkgconfig_2.0.3 ellipsis_0.3.2 [53] rsconnect_0.8.27 data.table_1.14.2 rmarkdown_2.16 httr_1.4.4 [57] rstudioapi_0.14 R6_2.5.1 compiler_4.2.1 ```