Render plot twice, when output plot depends on another two ui(one input ui and one output ui)

#1

Hello all,
I have a problem when use shiny to render plot, here is the simple code:

This is part of ui.R:

ui = fluidPage(
    selectInput("selectValue", label = "Select: ", choices = c(A, B, C), selected = A)),
    uiOutput("dateRange")
    plotOutput(outputId = "plot")
)

This is part of server.R:

server = function(input, output) {
    output$dateRange = renderUI({
        start = myTimeFunction(input$selectValue)
        end = myTimeFunction(input$selectValue)
        dateRangeInput("dateRange", label = "Date Range:", start = start, end = end)
     })

    output$plot = renderPlot({
        plot = myRenderFunction(input$selectValue, input$dateRange[1], input$dateRange[2])
    })
}

as you see:
output$dateRange depends on input$selvetValue,
output$plot denpends on both input$selectVlaue and input$dateRang

when I change the selectValue in UI , the plot will render twice
first render plot uses the old date range(Wrong)
second render plot uses the right date range

Can anyone help me to solve this problem to render plot only once when change selectValue

Any help would be hugely appreciated!

#2

Hi @gang. What I get from your code is the first render of plot was triggered by inupt$selectValue and the second was triggered by input$dateRange. So, you may isolate the plot function myRenderFunction and decide which input is depend on. The following code is depend on the input$dateRange.

  output$plot = renderPlot({
    req(input$dateRange)
    isolate({
      myRenderFunction(input$selectValue, input$dateRange[1], input$dateRange[2])
    })
  })
#3

Hi @raytong. I try the method you surggested，now the plot is rendered only once，but there is a new problem:
some dateRanges generated by different select.value are equal. So, the plot will not update if i change the select.value in some case becaouse of the dataRange does not changed.

#4

@gang. Your condition logic are little complicate. Can you share the code of myTimeFunction and myRenderFunction see if anything can modified to fit your condition.

#5

HI @raytong. I share the simple code here, just run the code and the plot would be rendered twice if you select 3

library(shiny)
library(lubridate)

ui = fluidPage(
    selectInput("selectValue", label = "SelectValue: ", choices = c(1, 2, 3), selected = 1),
    uiOutput("dateRange"),
    plotOutput(outputId = "myPlot")
)

myStartTime = function(value) {
    if (value == 1 || value == 2)
        return(as.POSIXct("2019-10-1"))
    else
        return(as.POSIXct("2019-10-2"))
}
myEndTime = function(value) {
    if (value == 1 || value == 2)
        return(as.POSIXct("2019-10-10"))
    else
        return(as.POSIXct("2019-10-11"))
}
server = function(input, output) {
    output$dateRange = renderUI({
        value = input$selectValue
        dateRangeInput("dateRange", label = "Date Range:", start = myStartTime(value), end = myEndTime(value))
    })

    output$myPlot = renderPlot({
        x = seq(as.POSIXct(input$dateRange[1]), as.POSIXct(input$dateRange[2]), by = as.numeric(days(1)))
        y = rnorm(length(x), mean = as.numeric(input$selectValue), sd = 10)
        return(plot(x, y))
    })

    #output$myPlot = renderPlot({
    #rep(input$dateRange)
    #isolate({
        #x = seq(as.POSIXct(input$dateRange[1]), as.POSIXct(input$dateRange[2]), by = as.numeric(days(1)))
        #y = rnorm(10, mean = as.numeric(input$selectValue), sd = 10)
        #return(plot(x, y))
        #})
    #})
}

shinyApp(ui, server)
#6

@gang. The logic was very complicated and too many dependency between each others. And the render twice are not that critical. It is not worth to do it. Check the following code that work.

library(shiny)
library(lubridate)

ui = fluidPage(
  selectInput("selectValue", label = "SelectValue: ", choices = c(1, 2, 3), selected = 1),
  dateRangeInput("dateRange", "Date Range:", start = as.POSIXct("2019-10-1"), end = as.POSIXct("2019-10-10")),
  plotOutput(outputId = "myPlot")
)

myStartTime = function(value) {
  if (value == "1" || value == "2")
    return(as.POSIXct("2019-10-1"))
  else
    return(as.POSIXct("2019-10-2"))
}
myEndTime = function(value) {
  if (value == "1" || value == "2")
    return(as.POSIXct("2019-10-10"))
  else
    return(as.POSIXct("2019-10-11"))
}

server = function(input, output, session) {
  vals <- reactiveValues(prevValue = 1)
  
  observe({
    req(input$selectValue)
    updateDateRangeInput(session, "dateRange", start = myStartTime(input$selectValue), end = myEndTime(input$selectValue))
  })
  
  observe({
    req(input$selectValue)
    isolate({
      if(vals$prevValue %in% c(1, 2) && input$selectValue %in% c(1, 2) && 
         (input$dateRange[1] == as.POSIXct("2019-09-30") || input$dateRange[1] == as.POSIXct("2019-10-1")) &&
         (input$dateRange[2] == as.POSIXct("2019-10-09") || input$dateRange[2] == as.POSIXct("2019-10-10"))) {
        selectValueTrigger$resume()
      }
      vals$prevValue <- input$selectValue
    })
  },priority = 1)

  selectValueTrigger <- observe({
    req(input$selectValue)
    isolate({
      x = seq(as.POSIXct(input$dateRange[1]), as.POSIXct(input$dateRange[2]), by = as.numeric(days(1)))
      y = rnorm(length(x), mean = as.numeric(input$selectValue), sd = 10)
      vals$table <- data.frame(x, y)
      str("s")
      selectValueTrigger$suspend()
    })
  }, suspended = TRUE)
  
  observe({
    req(input$dateRange)
    isolate({
      x = seq(as.POSIXct(input$dateRange[1]), as.POSIXct(input$dateRange[2]), by = as.numeric(days(1)))
      y = rnorm(length(x), mean = as.numeric(input$selectValue), sd = 10)
      vals$table <- data.frame(x, y)
      str("d")
    })
  })

  output$myPlot = renderPlot({
    req(vals$table)
    return(plot(vals$table$x, vals$table$y))
  })
}

shinyApp(ui, server)