updatePickerInput instantly refreshing update

Question

I have almosat completed a very basic web app in shiny.

I have it functioning as intended, however I believe I have incorrectly used "updatePickerInput" as the table is rendered as expected, however I am not able to select any options in my two pickers as it seems to continue to instantly refresh. I assume this is because the session is looking for input and then regenerating the output, which includes my picker refresh (so I have causes a cyclical refresh). I may be wrong though.

I have looked up the literature but I am unsure exactly what i have done wrong and what the syntax should be to prevent this from occuring.

Typical input is a .csv matrix with different animals on X-axis row 1 (column names) and Y-axis column 1 (row names) with values between any two animals.

library(shiny)
library(ggplot2)
library(shinyWidgets)
library(DT)
options(shiny.maxRequestSize = 50*1024^2)

# Define UI
ui <- fluidPage(
   
   # Application title
   titlePanel("Interactive Relatedness Comparison"),
   
   
   # Sidebar inputs
   sidebarLayout(
      
      mainPanel(dataTableOutput("contents")),
           
      sidebarPanel(
         
         #Upload GRM file
         fileInput("file1", "Choose GRM File", accept= c(
          "text/csv",
          "text/comma-separated-values,text/plain",
          ".csv")),
         
         #Client can choose sires along x-axis
         pickerInput(
            inputId = "sireselect",
            label = "Select Sires",
            choices = "Please Upload GRM",
            multiple = TRUE,
            options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
         ),
         
         #Client can choose dams along y-axis
         pickerInput(
            inputId = "damselect",
            label = "Select Dams",
            choices = "Please Upload GRM",
            multiple = TRUE,
            options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
         ),
         
         #Show raw values
         checkboxInput("relatedness", "Show Values (will reset sorting)", value = FALSE),
        )
      ),

   )


server <- function(input, output, session) {

   #Output uploaded table as data table
   output$contents <- DT::renderDataTable({
      rownames = TRUE
      inFile <- input$file1
      if (is.null(inFile))
        return(NULL)
      file2 <- read.csv(inFile$datapath)
      #shiney data table render was not showing row names correctly, changed to DT
      rownames(file2) <- file2[,1]
      #Remove first column which is now the rownames
      file2 <- file2[-c(1)]
      #Update pickers for the row/column names
      updatePickerInput(session, inputId = "damselect", choices = rownames(file2), selected = rownames(file2))
      updatePickerInput(session, inputId = "sireselect", choices = colnames(file2), selected = colnames(file2))
      
      #Create summarized data table (to be primary view unless raw values selected)
      newgrid <- as.data.frame(file2)
      
      #Generate summarised data table
      for (irow in 1:nrow(file2)){
         for (icol in 1:ncol(file2)){
            dig <- file2[irow,icol]
            if (dig >= 0.8) {
               newgrid[irow,icol] <- "SAME"
            } else if (dig >= 0.3)  {
               newgrid[irow,icol] <- "HIGH"
            } else if (dig >= 0.1)  {
               newgrid[irow,icol] <- "MED"
            } else {
               newgrid[irow,icol] <- "NOT"
            }
         }
      }
      
      #Check box for raw values or not
      if (input$relatedness == TRUE){
         return(file2[input$damselect,input$sireselect])
      } else {
         return(newgrid[input$damselect,input$sireselect])
      }
   })
}

# Run the application 
shinyApp(ui, server)

Any help would ne much appreciated

Answer 1

Read in data and updatePickerInput outside of output$contents might help. Try this

library(shiny)
library(ggplot2)
library(shinyWidgets)
library(DT)
options(shiny.maxRequestSize = 50*1024^2)

# Define UI
ui <- fluidPage(
  
  # Application title
  titlePanel("Interactive Relatedness Comparison"),
  
  
  # Sidebar inputs
  sidebarLayout(
    
    mainPanel(DTOutput("contents")),
    
    sidebarPanel(
      
      #Upload GRM file
      fileInput("file1", "Choose GRM File", accept= c(
        "text/csv",
        "text/comma-separated-values,text/plain",
        ".csv")),
      
      #Client can choose sires along x-axis
      pickerInput(
        inputId = "sireselect",
        label = "Select Sires",
        choices = "Please Upload GRM",
        multiple = TRUE,
        options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
      ),
      
      #Client can choose dams along y-axis
      pickerInput(
        inputId = "damselect",
        label = "Select Dams",
        choices = "Please Upload GRM",
        multiple = TRUE,
        options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
      ),
      
      #Show raw values
      checkboxInput("relatedness", "Show Values (will reset sorting)", value = FALSE),
    )
  )
  
)


server <- function(input, output, session) {
  
  file3 <- reactive({
    rownames = TRUE
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    file2 <- read.csv(inFile$datapath)
    #shiney data table render was not showing row names correctly, changed to DT
    rownames(file2) <- file2[,1]
    #Remove first column which is now the rownames
    file2 <- file2[-c(1)]
    file2
  })
  
  observe({
    req(file3())
    updatePickerInput(session, inputId = "damselect", choices = rownames(file3()), selected = rownames(file3()))
    updatePickerInput(session, inputId = "sireselect", choices = colnames(file3()), selected = colnames(file3()))
  })
  
  #Output uploaded table as data table
  output$contents <- renderDT({
    req(file3())
    
    #Create summarized data table (to be primary view unless raw values selected)
    newgrid <- as.data.frame(file3())
    
    #Generate summarised data table
    for (irow in 1:nrow(file3())){
      for (icol in 1:ncol(file3())){
        dig <- file3()[irow,icol]
        if (dig >= 0.8) {
          newgrid[irow,icol] <- "SAME"
        } else if (dig >= 0.3)  {
          newgrid[irow,icol] <- "HIGH"
        } else if (dig >= 0.1)  {
          newgrid[irow,icol] <- "MED"
        } else {
          newgrid[irow,icol] <- "NOT"
        }
      }
    }
    
    #Check box for raw values or not
    if (input$relatedness == TRUE){
      return(file3()[input$damselect,input$sireselect])
    }else {
      return(newgrid[input$damselect,input$sireselect])
    }
    
  })
}

# Run the application 
shinyApp(ui, server)