Unable to get echarts4r working behind modal with selectizeInput()

[Patrikios]

https://user-images.githubusercontent.com/11005155/201293276-3d5215cf-d3c2-4cba-8a8e-f66bbc5e662c.mp4

System details

Output of sessionInfo():

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=German_Germany.utf8  LC_CTYPE=German_Germany.utf8    LC_MONETARY=German_Germany.utf8 LC_NUMERIC=C                   
[5] LC_TIME=German_Germany.utf8    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] echarts4r_0.4.4 shiny_1.7.3    

loaded via a namespace (and not attached):
 [1] tidyselect_1.2.0  zoo_1.8-11        xfun_0.33         bslib_0.4.0       urca_1.3-3        lattice_0.20-45   colorspace_2.0-3  vctrs_0.4.2      
 [9] generics_0.1.3    htmltools_0.5.3   yaml_2.3.5        utf8_1.2.2        rlang_1.0.6       jquerylib_0.1.4   pillar_1.8.1      later_1.3.0      
[17] withr_2.5.0       glue_1.6.2        forecast_8.18     TTR_0.24.3        lifecycle_1.0.3   quantmod_0.4.20   timeDate_4021.106 munsell_0.5.0    
[25] gtable_0.3.1      htmlwidgets_1.5.4 memoise_2.0.1     evaluate_0.17     knitr_1.40        tseries_0.10-52   fastmap_1.1.0     httpuv_1.6.6     
[33] lmtest_0.9-40     parallel_4.2.1    curl_4.3.3        fansi_1.0.3       xts_0.12.1        Rcpp_1.0.9        xtable_1.8-4      scales_1.2.1     
[41] promises_1.2.0.1  cachem_1.0.6      jsonlite_1.8.3    mime_0.12         fracdiff_1.5-1    ggplot2_3.3.6     digest_0.6.29     dplyr_1.0.10     
[49] grid_4.2.1        quadprog_1.5-8    cli_3.4.1         tools_4.2.1       magrittr_2.0.3    sass_0.4.2        tibble_3.1.8      crayon_1.5.2     
[57] pkgconfig_2.0.3   ellipsis_0.3.2    rmarkdown_2.17    rstudioapi_0.14   R6_2.5.1          nnet_7.3-18       nlme_3.1-160      compiler_4.2.1   

Example application reprex

library(shiny)
library(echarts4r)

app <- shinyApp(
  ui = fluidPage(
    selectInput(
      "species",
      "Select spiecies",
      sort(unique(iris$Species)),
      "virginica"
    )
  ),
  server = function(input, output) {
    observeEvent(input$species, {
      showModal(modalDialog(
        echarts4rOutput("plot"),
        easyClose = TRUE,
        footer = NULL
      ))
    })

    output$plot <- renderEcharts4r({
      subset(iris, Species == input$species) |>
        e_charts(Sepal.Length) |>
        e_line(Sepal.Width) |>
        e_tooltip(trigger = "axis")
    })
  }
)

runApp(app)

Describe the problem in detail

The default select input "virginica" dependent output renders Okay (as it is the first render outcome cached???) however the other 2 Species render only after, for a brief moment, the outcome of "virginica" is displyed, only then the correct output is to be seen.

Obviously, this happens only in modal dialogues, when you bind output directly into fluidPage, it works as expected.

This could be resolved assigning a custom "NS"ed output ID to each input via shiny module or a functional approach (which I tested and works), however I think that is not the idea behind having a simple output depending on simple input like in the example above, it should be working out of the box right without flash of old input value.

[stla]

Seems OK by adding outputOptions(output, "plot", suspendWhenHidden = FALSE).

[Patrikios]

If you do so, the nice loading effect of echarts is gone. Any better option?

[stla]

Strange, I get the loading effect.

[cpsievert]

It seems this issue is specific to using {echarts4r} in combination with selectizeInput(). For example, plotOutput() works as expected:

server = function(input, output) {
  observeEvent(input$species, {
    showModal(modalDialog(plotOutput("plot"), easyClose = TRUE, footer = NULL))
  })

  output$plot <- renderPlot({
    ggplot(subset(iris, Species == input$species)) + geom_point(aes(Sepal.Length, Sepal.Width))
  })
}

Also, I get the following JS error when running your example, so it seems the selectInput() accessibility plugin is not compatible with {echarts4r}.

As a workaround, you could consider selectInput() with selectize = FALSE, but I'm pretty sure a fix will have to come from https://github.com/JohnCoene/echarts4r

[Patrikios]

I would disagree that the problem is not present with ggplot2. Let us take a look at this video, that demonstrates that as well with ggpot2 plot, firstly the old values are displayed and then chang to the updated input. Is that an intention to have it like that?

https://user-images.githubusercontent.com/11005155/204334078-a8387d9e-1127-4cfc-9de6-75c026da81fb.mp4

Code:

library(shiny)
library(ggplot2)

app <- shinyApp(
  ui = fluidPage(
    selectInput(
      "species",
      "Select spiecies",
      sort(unique(iris$Species)),
      "virginica"
    )
  ),
  server = function(input, output) {
    observeEvent(input$species, {
      showModal(
        modalDialog(
          textOutput("heading"),
          plotOutput("plot"),
          easyClose = TRUE,
          footer = NULL
        )
      )
    })

    output$heading <- renderText(input$species)

    output$plot <- renderPlot({
      ggplot(subset(iris, Species == input$species)) +
        geom_point(aes(Sepal.Length, Sepal.Width))
    })
  }
)

runApp(app)

[cpsievert]

Ahh, sorry, I mis-understood the problem. Yes, it is intentional that the "outdated" version of the plot is shown before the "new" version. That's because, by default, shiny will not update outputs that aren't currently shown. As was suggested, https://github.com/rstudio/shiny/issues/3731#issuecomment-1328703158 is the typical way to opt-out of that behavior.

In this case, you could also consider creating a modal for each output that you want to show:

library(shiny)
library(ggplot2)

species <- levels(iris$Species)

app <- shinyApp(
  ui = fluidPage(
    selectInput(
      "species", "Select spiecies", species, "virginica"
    )
  ),
  server = function(input, output) {
    observeEvent(input$species, {
      showModal(
        modalDialog(
          plotOutput(input$species),
          easyClose = TRUE,
          footer = NULL
        )
      )
    })

    lapply(species, function(x) {
      output[[x]] <- renderPlot({
        ggplot(subset(iris, Species == x)) +
          geom_point(aes(Sepal.Length, Sepal.Width))
      })
    })

  }
)

runApp(app)

Regardless of how you decide to implement this behavior, I don't think there is anything for the shiny team to do here, so I'll be closing the issue

[stla]

I see what you mean now regarding the effect. I found a solution:

library(shiny)
library(echarts4r)

app <- shinyApp(
  ui = fluidPage(
    useShinyjs(),
    selectInput(
      "species",
      "Select spiecies",
      sort(unique(iris$Species)),
      "virginica"
    )
  ),
  server = function(input, output) {

    observeEvent(input$species, {
      showModal(modalDialog(
        tagList(renderEcharts4r(echart())),
        footer = NULL,
        easyClose = TRUE
      ))
    })

    echart <- reactive({
      subset(iris, Species == input$species) |>
        e_charts(Sepal.Length) |>
        e_line(Sepal.Width) |>
        e_tooltip(trigger = "axis")
    })

  }
)

runApp(app)

[Patrikios]

That is something new right there, somehow shortcircuiting the output object directly via render. Never seen it before. But works as I intended. Thnx.

A more bare bones (no shinyjsdependency and no tagListwrapper) app is here:

library(shiny)
library(echarts4r)

shinyApp(
  ui = fluidPage(
    selectInput(
      "species",
      "Select spiecies",
      sort(unique(iris$Species)),
      "virginica"
    )
  ),
  server = function(input, output) {

    observeEvent(input$species, {
      showModal(modalDialog(
        renderEcharts4r(echart()),
        footer = NULL,
        easyClose = TRUE
      ))
    })

    echart <- reactive({
      subset(iris, Species == input$species) |>
        e_charts(Sepal.Length) |>
        e_line(Sepal.Width) |>
        e_tooltip(trigger = "axis")
    })
  }
) |> runApp()