r - updatePickerInput 即时刷新更新

Question

我已经完成了一个非常基本的闪亮 Web 应用程序。

我让它按预期运行，但是我相信我错误地使用了“updatePickerInput”，因为表格按预期呈现，但是我无法在我的两个选择器中选择任何选项，因为它似乎会继续立即刷新。我认为这是因为会话正在寻找输入，然后重新生成输出，其中包括我的选择器刷新（所以我有导致循环刷新）。不过我可能是错的。

我查阅了文献，但我不确定我到底做错了什么，以及防止这种情况发生的语法应该是什么。

典型的输入是一个 .csv 矩阵，其中 X 轴第 1 行（列名）和 Y 轴第 1 列（行名）上有不同的动物，值介于任意两个动物之间。

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)

任何帮助将不胜感激

标签： rshiny

Answer 1

读取数据和updatePickerInput外部数据output$contents可能会有所帮助。尝试这个

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)