Shiny double plotting reaction problem

[woodward]

I have a complex shiny app that plots coloured lines on a leaflet map. I am having problems with reactivity, with the lines being updated twice in some instances because they are dependent on two reactive chains. I created a toy example below. The user changes an input (here x/y), which triggers a replot. However the input also changes another option (colour) which then triggers another replot. The replots are slow and look ugly. I suspects there's some use of observeEvent that solves it but I've spent several days and can't get it. Any help appreciated.

library(shiny)
library(leaflet)

dlat <- 1 / 111000 * 100 # degrees per metre
n <- 10000 # number of circles
mylng <- 175.322 + (runif(n) * 2 - 1) * dlat * 6
mylat <- -37.789 + (runif(n) * 2 - 1) * dlat * 1.5

ui <- fluidRow(
  tags$h2("Avoid double reaction in leaflet"),
  leafletOutput("map"),
  selectInput("which", label = "Axis to collapse", choices = c("x","y")),
  selectInput("colour", label = "Choose colour", choices = c("red","blue"))
)

server <- function(input, output, session) {
  observeEvent(input$which, {
    # colour choices are dependent on input$which
    if (input$which == "x"){
      updateSelectInput(session, "colour", label = "Choose colour", choices = c("red","blue"))
    } else {
      updateSelectInput(session, "colour", label = "Choose colour", choices = c("red","yellow"))
    }
  })
  makepoints <- reactive({
    # data is dependent on input$which
    if (input$which == "x"){
      x <- mylng
      y <- -37.789 + (mylat - -37.789) / 10
    } else {
      x <- 175.322 + (mylng - 175.322) / 10
      y <- mylat
    }
    list(x = x, y = y)
  })
  output$map <- renderLeaflet({
    cat("renderLeaflet\n")
    leaflet() %>%
      addTiles() %>%
      setView(175.322, -37.789, zoom = 17) 
  })
  observe({
    # plot is dependent on data and also on colour, so triggers twice
    cat(paste("replot", input$which, input$colour, "\n"))
    leafletProxy("map") %>%
      clearShapes() %>% 
      addCircles(
        lng = makepoints()$x,
        lat = makepoints()$y,
        radius = 1, 
        color = input$colour)
  })
}

shinyApp(ui = ui, server = server)

[nirgrahamuk]

I was thinking that it 'double plots' because of invalid combinations, which can be skipped.

library(shiny)
library(leaflet)
library(tidyverse)
(myoptions <- tibble(which=c("x","x","y","y"),
                        colour=c("red","blue","red","yellow")))

dlat <- 1 / 111000 * 100 # degrees per metre
n <- 10000 # number of circles
mylng <- 175.322 + (runif(n) * 2 - 1) * dlat * 6
mylat <- -37.789 + (runif(n) * 2 - 1) * dlat * 1.5

ui <- fluidRow(
  tags$h2("Avoid double reaction in leaflet"),
  leafletOutput("map"),
  selectInput("which", label = "Axis to collapse", choices = c("x","y")),
  selectInput("colour", label = "Choose colour", choices = filter(myoptions,
                                                                  which == "x") %>% 
                pull(colour))
)

server <- function(input, output, session) {
  observeEvent(input$which, {
    # colour choices are dependent on input$which
    if (input$which == "x"){
      updateSelectInput(session, "colour",
                        label = "Choose colour",
                        choices = filter(myoptions,
                                         which == "x") %>% 
                          pull(colour))
    } else {
      updateSelectInput(session, "colour",
                        label = "Choose colour",
                        choices = filter(myoptions,
                                         which == "y") %>% 
                          pull(colour))
    }
  })
  makepoints <- reactive({
    # data is dependent on input$which
    if (input$which == "x"){
      x <- mylng
      y <- -37.789 + (mylat - -37.789) / 10
    } else {
      x <- 175.322 + (mylng - 175.322) / 10
      y <- mylat
    }
    list(x = x, y = y)
  })
  output$map <- renderLeaflet({
    cat("renderLeaflet\n")
    leaflet() %>%
      addTiles() %>%
      setView(175.322, -37.789, zoom = 17) 
  })
  observe({
    # plot is dependent on data and also on colour, so triggers twice
      if(filter(myoptions,
                which==input$which,
                colour==input$colour) %>% nrow() >0 ) {
    cat(paste("replot", input$which, input$colour, "\n"))
    leafletProxy("map") %>%
      clearShapes() %>% 
      addCircles(
        lng = makepoints()$x,
        lat = makepoints()$y,
        radius = 1, 
        color = input$colour)
  }
     else {
      cat("skipping invalid combo ",input$which," ",input$colour,"\n")
    }})
}

shinyApp(ui = ui, server = server)

[woodward]

Good work, this will work for this particular example. In my much more complex app some of the unnecessary plots were actually valid.

I finally managed to solve the problem in a similar way, with a combinations of saving the inputs from the last plot and a bunch of logic (like yours) to ensure the new plot is different and valid. Fairly complex, clunky and fragile code though. I wondered if there was a solution with better use of observeEvent or something.

[nirgrahamuk]

Memorization with R.cache library might be interesting to experiment with