How to avoid double plot with multiple inputs Shiny App-CodePudding

I have a shiny app where changes to the pickerInputs update a set of plots. These inputs are time, zone or dimension filters and also indicators. The indicators do not have to have the same time period.

Unfortunately, there are situations where changing the indicator (ind_1) causes a chart to be redrawn. Then refresh again and the graph is drawn a second time. So I end up with a plot redraw multiple times.

I want that when a user changes the year, the zone or a dimension the drawing is updated. But when the user changes indicators, he can also end up updating the whole drawing at the same time and not in two parts.

Is there a way to allow a short delay, so that shiny "updates" and doesn't have the inputs trigger the plot?

Example of double plot

Here is part of my code:

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyBS)
library(plotly)
library(shinycssloaders)
library(googledrive)

id1 <- "1Gc9M9mN0U38QXobrFBgdTNYFdCTCU0GZ"
id<-"1cZRfzycJ-bhXHEAC_2g6b6sbOhInlmMG"
metadatos<-read.csv2(sprintf("https://docs.google.com/uc?id=%s&export=download", id1),
                     encoding = "UTF-8")
metadatos<-subset(metadatos,metadatos[,1]!="")
indicadores<-read.csv2(sprintf("https://docs.google.com/uc?id=%s&export=download", id),
                       encoding = "UTF-8")
indicadores<-subset(indicadores,indicadores[,1]!="")
indicadores_id<-data.frame(cbind(substr(colnames(indicadores[4:length(indicadores)]),3,100),
                                 4:length(indicadores)))
names(indicadores_id)<-c("ID","column")
metadatos<-subset(metadatos,metadatos[,4] %in% indicadores_id[,1])


list_ind_factor_1<-unique(metadatos[,1])
list_ind_factor_1<-list_ind_factor_1[list_ind_factor_1!=""]
list_ind_factor_2<-unique(metadatos[,2])
list_ind_factor_2<-list_ind_factor_2[list_ind_factor_2!=""]
list_ind<-unique(metadatos$NOMBRE)
list_zona<-unique(indicadores$CCAA)
list_dim<-unique(indicadores$Sexo)

simpleCap <- function(x) {
  s <- strsplit(x, " ")[[1]]
  paste(toupper(substring(s, 1,1)), substring(s, 2),
        sep="", collapse=" ")
}

server <- function(input, output, session) {
  observeEvent(input$ind_1, {
    output$ft_1<-renderText({
      if(isTRUE(input$ft_ind_1)){
        m<-1
      } else {
        m<-0
      }
      m
    })
    outputOptions(output, 'ft_1', suspendWhenHidden=FALSE)
    output$titol_1<-renderText({
      m<-subset(metadatos,metadatos[,5]==input$ind_1)
      if (nrow(m)!=0){
        m<-m[,5]
      } else {
        m<-"NO"
      }
      m
    })
    output$det_1<-renderText({
      m<-subset(metadatos,metadatos[,5]==input$ind_1)
      if (nrow(m)!=0){
        m<-m[,3]
      } else {
        m<-"NO"
      }
      m
    })
    output$unit_1<-renderText({
      m<-subset(metadatos,metadatos[,5]==input$ind_1)
      if (nrow(m)!=0){
        m<-m[,6]
      } else {
        m<-"NO"
      }
      m
    })
    output$serie_1<-renderText({
      m<-subset(metadatos,metadatos[,5]==input$ind_1)
      ind<-subset(indicadores_id,indicadores_id[,1]==m[,4])
      n<-data.frame(indicadores[,1],
                    indicadores[,as.numeric(ind[,2])])
      n<-n[!is.na(n[,2]), ]
      if (nrow(n)!=0){
        k<-paste(min(n[,1]),max(n[,1]),sep="-")
      } else {
        k<-paste("-")
      }
      k
    })
    output$titol_<-renderText({
      m<-subset(metadatos,metadatos[,5]==input$ind_1)
      if (nrow(m)==0){
        m<-0
      } else {
        m<-1
      }
      m
    })
    outputOptions(output, 'titol_', suspendWhenHidden=FALSE)
  }, ignoreInit = F, ignoreNULL = F)
  observeEvent(c(input$ind_1_factor_1,input$ind_1_factor_2,input$ind_1), {
    if(length(input$ind_1_factor_1)!=0){
      m<-subset(metadatos, metadatos[,1] %in% input$ind_1_factor_1)
    } else {
      m<-metadatos
    }
    if(length(input$ind_1_factor_2)!=0){
      n<-subset(metadatos, metadatos[,2] %in% input$ind_1_factor_2)
    } else {
      n<-metadatos
    }
    if(length(input$ind_1)!=0){
      a<-subset(metadatos, metadatos[,5] %in% input$ind_1)
      if (nrow(a)!=0){
        a_id<-subset(indicadores_id,indicadores_id[,1]==a[,4])
        a_id<-data.frame(indicadores[,1],
                         indicadores[,2],
                         indicadores[,3],
                         indicadores[,as.numeric(a_id[,2])])
        names(a_id)<-c("year","dim","zona","valor")
        a_id<-a_id[!is.na(a_id$valor),]
        a_id<-subset(a_id,valor!="")
        a_id_<-subset(a_id,zona!="ESPAÑA")
        a_id <- a_id[order(a_id$year,decreasing = T),]
        updatePickerInput(session = session,
                          inputId = "ind_1_any_1",
                          label = "Selecciona el periodo a estudiar:",
                          choices = unique(a_id_$year),
                          selected = unique(a_id_$year))
        if(is.null(input$ind_1_zona_1)){
          updatePickerInput(session = session,
                            inputId = "ind_1_zona_1",
                            label = "Selecciona las zonas a estudiar:",
                            choices = unique(a_id$zona),
                            selected = c("ESPAÑA"))
        } else {
          updatePickerInput(session = session,
                            inputId = "ind_1_zona_1",
                            label = "Selecciona las zonas a estudiar:",
                            choices = unique(a_id$zona),
                            selected = input$ind_1_zona_1)
        }
        if(a_id$dim %in% "Ambos sexos"){
          updatePickerInput(session = session,
                            inputId = "ind_1_dim_1",
                            label = "Selecciona el sexo a estudiar:",
                            choices = unique(a_id$dim),
                            selected = c("Ambos sexos"))
          updatePickerInput(session = session,
                            inputId = "ind_1_dim_11",
                            label = "Sexo a estudiar:",
                            choices = unique(a_id$dim),
                            selected = c("Ambos sexos"))
          updatePickerInput(session = session,
                            inputId = "ind_1_dim_12",
                            label = "Sexo a estudiar:",
                            choices = unique(a_id$dim),
                            selected = c("Ambos sexos"))
        } else {
          updatePickerInput(session = session,
                            inputId = "ind_1_dim_1",
                            label = "Selecciona el sexo a estudiar:",
                            choices = unique(a_id$dim),
                            selected = unique(a_id$dim))
          updatePickerInput(session = session,
                            inputId = "ind_1_dim_11",
                            label = "Sexo a estudiar:",
                            choices = unique(a_id$dim),
                            selected = unique(a_id$dim))
          updatePickerInput(session = session,
                            inputId = "ind_1_dim_12",
                            label = "PENE:",
                            choices = unique(a_id$dim),
                            selected = unique(a_id$dim))
        }
        updatePickerInput(session = session,
                          inputId = "ind_1_any_11",
                          label = "Periodos a estudiar:",
                          choices = unique(a_id$year),
                          selected = unique(a_id$year))
        updatePickerInput(session = session,
                          inputId = "ind_1_any_12",
                          label = "Periodo a estudiar:",
                          choices = unique(a_id$year),
                          selected = unique(a_id$year))
        updatePickerInput(session = session,
                          inputId = "ind_1_zona_11",
                          label = "Zonas a estudiar:",
                          choices = unique(a_id$zona),
                          selected = unique(a_id$zona))
        updatePickerInput(session = session,
                          inputId = "ind_1_zona_12",
                          label = "Zonas a estudiar:",
                          choices = unique(a_id$zona),
                          selected = unique(a_id$zona))
      }
    } else {
      a<-metadatos
    }
    updatePickerInput(session = session,
                      inputId = "ind_1_factor_2",
                      label = "Filtra por el factor de desigualdad: ",
                      choices = unique(m[,2]),
                      selected = input$ind_1_factor_2)
    updatePickerInput(session = session,
                      inputId = "ind_1",
                      label = "Elige un indicador:",
                      choices = unique(n[,5]),
                      selected = input$ind_1)
    updatePickerInput(session = session,
                      inputId = "ind_2",
                      label = "Elige un indicador:",
                      choices = unique(n[,5]),
                      selected = input$ind_1)
    updatePickerInput(session = session,
                      inputId = "ind_3",
                      label = "Elige un indicador:",
                      choices = unique(n[,5]),
                      selected = input$ind_1)
  }, ignoreInit = F, ignoreNULL = F)
  observeEvent(c(input$ind_1,input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1),{
    ############# FER 3 FILTRES DIFERENTS PER CADA PLOT #############
    output$dots_box<-renderPlotly({
      a_<-subset(metadatos, metadatos[,5] %in% input$ind_1)
      a_id<-subset(indicadores_id,indicadores_id[,1]==a_[,4])
      a_id<-data.frame(indicadores[,1],
                       indicadores[,2],
                       indicadores[,3],
                       as.numeric(indicadores[,as.numeric(a_id[,2])]),
                       a_[,6])
      names(a_id)<-c("Periodo","Sexo","Zonas","Valor","Dim")
      a_id<-subset(a_id,!is.na(Valor))
      n<-input$ind_1
      a<-subset(a_id,a_id[,2] %in% input$ind_1_dim_1)
      a<-subset(a,a[,1] %in% input$ind_1_any_1)
      b<-subset(a,a[,3]!="ESPAÑA")
      a<-subset(a,a[,3] %in% input$ind_1_zona_1)
      if (length(unique(a[,2]))>2){
        sex<-tolower(paste(unique(a[,2])[1]," , ",unique(a[,2])[2]," y ",unique(a[,2])[3],sep=""))
      } else if (length(unique(a[,2]))>1){
        sex<-tolower(paste(unique(a[,2])[1]," y ",unique(a[,2])[2],sep=""))
      } else {
        sex<-tolower(unique(a[,2]))
      }
      p<- plot_ly(data= b, x=~b[,1], y=~as.numeric(b[,4]), type = "box",name = "España",showlegend=FALSE) %>%
        layout(boxmode = "group",
               yaxis = list(title = unique(b[,5]),
                            titlefont = list(size = 10)),
               xaxis = list(title = 'Años', tickangle = -42,autotick = T), margin=list(b = -0.1), 
               legend = list(title=list(text='<b> Zonas (medianas) </b>'),
                             font=list(size=8))) %>%
        layout(title = list(text = HTML(paste0(paste('Evolución temporal segun',sex),
                                               '<br>',
                                               '<sup>',
                                               input$ind_1,
                                               '</sup>')),
                            font=list(size=14)),
               x=0,
               margin=list(t = 75)) %>%
        layout(
          showlegend = T) %>%
        add_annotations(
          text = "Fuente: Atlas de los determinantes sociales de la salud en España",
          legendtitle=TRUE,
          x = 0,
          y = -0.33,
          xref="paper",
          yref = "paper",
          align='left',
          textposition="bottom left",
          showarrow = FALSE,
          font = list(size = 9))
      p  %>%
        layout(resposnive = T)
    })
  }, ignoreInit = T)

} 

ui <-dashboardBody(
  fluidPage(
  fluidRow(
    pickerInput(
      inputId = "ind_1", 
      label = "Elige un indicador:", 
      choices = list_ind,
      selected=1),
    pickerInput(
      inputId = "ind_1_zona_1",
      label = "Selecciona la zona a estudiar:",
      choices = c("hola"),
      selected = 2,
      multiple = T),
    pickerInput(
      inputId = "ind_1_dim_1", 
      label = "hola", 
      choices = c("hola")),
  pickerInput(
    inputId = "ind_1_any_1",
    label = "Selecciona el periodo a estudiar:",
    choices = c("hola"),
    multiple = T),
  plotlyOutput("dots_box")
        )
      )
    )
shinyApp(ui = ui, server = server)

CodePudding user response：

Nesting reactives is not a good idea. You can control when the plot gets updated using eventReactive(). Try this

 myplot <- eventReactive(c(input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1), {  ## removed input$ind_1 so that it does not update when ind_1 is changed
  #observeEvent(c(input$ind_1,input$ind_1_zona_1,input$ind_1_dim_1,input$ind_1_any_1),{
    ############# FER 3 FILTRES DIFERENTS PER CADA PLOT #############
    #output$dots_box<-renderPlotly({
      a_<-subset(metadatos, metadatos[,5] %in% input$ind_1)
      a_id<-subset(indicadores_id,indicadores_id[,1]==a_[,4])
      a_id<-data.frame(indicadores[,1],
                       indicadores[,2],
                       indicadores[,3],
                       as.numeric(indicadores[,as.numeric(a_id[,2])]),
                       a_[,6])
      names(a_id)<-c("Periodo","Sexo","Zonas","Valor","Dim")
      a_id<-subset(a_id,!is.na(Valor))
      n<-input$ind_1
      a<-subset(a_id,a_id[,2] %in% input$ind_1_dim_1)
      a<-subset(a,a[,1] %in% input$ind_1_any_1)
      b<-subset(a,a[,3]!="ESPAÑA")
      a<-subset(a,a[,3] %in% input$ind_1_zona_1)
      if (length(unique(a[,2]))>2){
        sex<-tolower(paste(unique(a[,2])[1]," , ",unique(a[,2])[2]," y ",unique(a[,2])[3],sep=""))
      } else if (length(unique(a[,2]))>1){
        sex<-tolower(paste(unique(a[,2])[1]," y ",unique(a[,2])[2],sep=""))
      } else {
        sex<-tolower(unique(a[,2]))
      }
      p<- plot_ly(data= b, x=~b[,1], y=~as.numeric(b[,4]), type = "box",name = "España",showlegend=FALSE) %>%
        layout(boxmode = "group",
               yaxis = list(title = unique(b[,5]),
                            titlefont = list(size = 10)),
               xaxis = list(title = 'Años', tickangle = -42,autotick = T), margin=list(b = -0.1), 
               legend = list(title=list(text='<b> Zonas (medianas) </b>'),
                             font=list(size=8))) %>%
        layout(title = list(text = HTML(paste0(paste('Evolución temporal segun',sex),
                                               '<br>',
                                               '<sup>',
                                               input$ind_1,
                                               '</sup>')),
                            font=list(size=14)),
               x=0,
               margin=list(t = 75)) %>%
        layout(
          showlegend = T) %>%
        add_annotations(
          text = "Fuente: Atlas de los determinantes sociales de la salud en España",
          legendtitle=TRUE,
          x = 0,
          y = -0.33,
          xref="paper",
          yref = "paper",
          align='left',
          textposition="bottom left",
          showarrow = FALSE,
          font = list(size = 9))
      p  %>%  layout(responsive = T)
    #})
  #}, ignoreInit = T)
  })
  
  output$dots_box<-renderPlotly({
    myplot()
  })