Question

我想在此代码中添加一个条件，以避免在我的其他selectinput为空时出现错误消息。我试图在反应式表达中使用req()但不起作用。我还尝试为不同的输入添加if(input$name == NULL){return(NULL)}之类的条件，但也不起作用..

任何帮助都将不胜感激

代码：

l <- NULL
l$name <- c('b','e','d','b','b','d','e','e','b','b')
l$age <- c(20,20,21,21,20,22,22,30,21,32)
l$gender <- c('Female', 'Female', 'Male', 'Female', 'Male','Male', 
              'Female','Male',"Female","Male")
l <- as.data.frame(l)
l$name <- as.character(l$name)
l$age <- as.numeric(l$age)
l$gender <- as.character(l$gender)


library(shiny)
server <- shinyServer(function(input,output){

  assign('All Names', unique(sort(l$name)))
  assign("All Ages", unique(sort(l$age)))
  assign('All Genders', unique(sort(l$gender)))

  data1 <- reactive(l[which(l$name %in% if(exists(input$name))
  {get(input$name)}else{input$name}),])


  data2 <- reactive(data1()[which(data1()$age %in% if(exists(input$age))
  {get(input$age)}else{input$age}),])


  data3 <- eventReactive(input$go_baba, {
    data2()[which(data2()$gender %in% if(exists(input$gender))
    {get(input$gender)}else{input$gender}),]
  })

  output$table3 <- renderTable(data3())


  output$Box1 =  renderUI(
    if((is.null(input$age)) & (is.null(input$gender))){
      selectInput("name", "Choose Name", choices=c("All Names",unique(sort(l$name))), selected = input$name)
    } else{selectInput("name", "Choose Name", choices=c("All Names",unique(l[l$gender %in% (if(exists(input$gender)){get(input$gender)}else{input$gender}) & l$age %in% (if(exists(input$age)){get(input$age)}else{input$age}) , "name"])), selected = input$name, multiple = T)
    }
  )



  output$Box2 =  renderUI(
    if((is.null(input$name)) & (is.null(input$gender))){
      selectInput("age", "Choose Age", choices=c("All Ages", unique(sort(l$age))), selected = input$age)
    }else{selectInput("age", "Choose Age", choices=c("All Ages",unique(l[l$gender %in% (if(exists(input$gender)){get(input$gender)}else{input$gender}) & l$name %in% (if(exists(input$name)){get(input$name)}else{input$name}) , "age"])), selected = input$age, multiple = T)}
  )

  output$Box3 =  renderUI(
    if((is.null(input$name)) & (is.null(input$age))){
      selectInput("gender", "Choose Gender", choices=c("All Genders", unique(sort(l$gender))), selected = input$gender)
    }else{

      selectInput("gender", "Choose Gender", choices=c("All Genders", unique(l[l$name %in% (if(exists(input$name)){get(input$name)}else{input$name}) & l$age %in% (if(exists(input$age)){get(input$age)}else{input$age}), "gender"])), selected = input$gender, multiple = TRUE)
    }
  )



})

ui <-shinyUI(fluidPage(
  uiOutput("Box1"),
  uiOutput("Box2"),
  uiOutput("Box3"),
  actionButton("go_baba", "GO !"),
  tableOutput("table3")
))

shinyApp(ui,server)

Answer 1

在这种情况下，一个方便的工具是validate(need(condition, message))。如果未满足条件，它将显示一条消息并停止执行当前输出。更多信息here。您也可以使用req(!is.null(input$...))，它具有完全相同的效果但没有消息。

我重写了你的代码，使其更具可读性：

library(shiny)

l <- data.frame( name = c('b','e','d','b','b','d','e','e','b','b'),
                 age =  c(20,20,21,21,20,22,22,30,21,32),
                 gender = c('Female', 'Female', 'Male', 'Female', 'Male','Male', 'Female','Male',"Female","Male"),
                 stringsAsFactors = F)

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

  # subset l according to inputs
  data <- eventReactive(input$go_baba, {
    out <- l
    if(!"All Names" %in% input$name) out <- subset(l, name %in% input$name)
    if(!"All Ages" %in% input$age) out <- subset(l, age %in% input$age)
    if(!"All Genders" %in% input$gender) out <- subset(l, gender %in% input$gender)
    return(out)
  })

  # display the result as table
  output$table3 <- renderTable({ 
    data()
  })

  # selectInput for Date
  output$Box1 =  renderUI({
      selectInput("name", "Choose Name", choices=c("All Names", unique(sort(l$name))), selected=NULL, multiple=T)
  })

  # selectInput for Age
  output$Box2 =  renderUI({
    validate(need(!is.null(input$name), "Please choose a name"))
    selectInput("age", "Choose Age", choices=c("All Ages", unique(l$age)), selected=NULL,
                 multiple = T)
  })

  # selectInput for Gender
  output$Box3 =  renderUI({
    validate(need(!is.null(input$age), "Please choose an age"))
    selectInput("gender", "Choose Gender", choices=c("All Genders", unique(l$gender)), selected=NULL)
  })
})

ui <-shinyUI(fluidPage(
  uiOutput("Box1"),
  uiOutput("Box2"),
  uiOutput("Box3"),

  conditionalPanel(condition="input.age != null & input.gender != null", actionButton("go_baba", "GO !")),
  tableOutput("table3")
))

shinyApp(ui,server)

闪亮输入中的“无效参数”消息错误

1 个答案: