Question

我有一个R Shiny应用程序，该应用程序过滤一些变量并使用模块返回表。我想使用missing()，以便即使没有为模块提供任何值，该应用程序仍然可以运行。但是，当我在missing()中使用reactive()时，会出现错误：Warning: Error in missing: 'missing' can only be used for arguments。有谁知道为什么会这样？有办法解决这个问题吗？

示例应用程序：

df <- data.frame(a = sample(letters,100,T), b = sample(10,100,T))
dfFilter <- function(data, a, b){
  if (!missing(a)) {
    if(!is.null(a)){
      data <- data[data$a %in% a,]
    }
  }
  if (!missing(b)) {
    if(!is.null(b)){
      data <- data[data$b %in% b,]
    }
  }
  return(data)
}
filterTable <- function(input, output, session, data, aFetcher, bFetcher){
  return(reactive(dfFilter(data = data,
                a = switch(!missing(aFetcher),
                                 aFetcher(),NULL),
                b = switch(!missing(bFetcher),
                                 bFetcher(), NULL))))


}

displayTableUI <- function(id){
  ns <- NS(id)
  DT::dataTableOutput(ns('displayer'))
}
displayTable <- function(input, output, session, data){
  output$displayer <- DT::renderDataTable(data())
}


chooserUI <- function(id){
  ns <- NS(id)
  uiOutput(ns('filter'))
}
chooseA <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose A:',
                choices = unique(data$a),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}
chooseB <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose B:',
                choices = unique(data$b),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}

ui <- fluidPage(
  tabPanel('data',
           sidebarPanel(
             chooserUI('aChooser'),
             chooserUI('bChooser')
           ),
           mainPanel(
             displayTableUI('table1')
           )
  )
)

server <- function(input,output){
  chosenA <- callModule(chooseA,
                        id = 'aChooser',
                        data = df)
  chosenB <- callModule(chooseB,
                        id = 'bChooser',
                        data = df)
  table1 <- callModule(filterTable, 
                       data = df,
                       id = 'tableFilterer',
                       aFetcher = chosenA,
                       bFetcher = chosenB)
  callModule(displayTable, id = 'table1', data = table1)


}
shinyApp(ui, server)

Answer 1

通过使用exists()而非!missing()进行了固定：

df <- data.frame(a = sample(letters,100,T), b = sample(10,100,T))
dfFilter <- function(data, a, b){
  if (!missing(a)) {
    if(!is.null(a)){
      data <- data[data$a %in% a,]
    }
  }
  if (!missing(b)) {
    if(!is.null(b)){
      data <- data[data$b %in% b,]
    }
  }
  return(data)
}
filterTable <- function(input, output, session, data, aFetcher, bFetcher){
  return(reactive(dfFilter(data = data,
                a = switch(exists(aFetcher),
                                 aFetcher(),NULL),
                b = switch(exists(bFetcher),
                                 bFetcher(), NULL))))


}

displayTableUI <- function(id){
  ns <- NS(id)
  DT::dataTableOutput(ns('displayer'))
}
displayTable <- function(input, output, session, data){
  output$displayer <- DT::renderDataTable(data())
}


chooserUI <- function(id){
  ns <- NS(id)
  uiOutput(ns('filter'))
}
chooseA <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose A:',
                choices = unique(data$a),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}
chooseB <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose B:',
                choices = unique(data$b),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}

ui <- fluidPage(
  tabPanel('data',
           sidebarPanel(
             chooserUI('aChooser'),
             chooserUI('bChooser')
           ),
           mainPanel(
             displayTableUI('table1')
           )
  )
)

server <- function(input,output){
  chosenA <- callModule(chooseA,
                        id = 'aChooser',
                        data = df)
  chosenB <- callModule(chooseB,
                        id = 'bChooser',
                        data = df)
  table1 <- callModule(filterTable, 
                       data = df,
                       id = 'tableFilterer',
                       aFetcher = chosenA,
                       bFetcher = chosenB)
  callModule(displayTable, id = 'table1', data = table1)


}
shinyApp(ui, server)

为什么缺少的功能在反应式RShiny内部不起作用？

1 个答案: