R闪亮电抗选择输入

Question

当我尝试使我在R Shiny中的选择输入对另一个选择输入做出反应时，我不断收到错误消息。 我尝试了renderUi和updateSelectizeInput失败。 我更喜欢使用updateSelectize，因为这与应用程序的其余部分保持一致。

我希望第二个选择输入是不是NA的列的列名。 这是一些简化的代码：

library(dplyr)
library(shiny)

df <- setNames(data.frame(matrix(c(NA, NA, NA, 4, 6, 2, 1, 6, NA, NA), ncol = 5, nrow = 2, byrow = TRUE)), c("t1", "t2", "t3", "t4", "t5"))
df <- cbind(data.frame(ID = c("a", "b"), stringsAsFactors = FALSE), df)

all_drop_options <- df %>% pull(ID)

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

  updateSelectizeInput(session = session, inputId = "SID",
                       choices = all_drop_options, selected = "a",
                       server = TRUE)

  new_dat <- reactive({
    df %>% filter(ID == input$SID)
  })

  year_opts2 <- reactive({
    new_dat() %>%
      select(-ID) %>%
      select_if(~!is.na(.)) %>% colnames()
  })

  observe({
    updateSelectizeInput(session = session, inputId = "yr",
                         choices = year_opts2()
    )})
}

ui <- fluidPage(

  selectInput(inputId = "SID", label = NULL,
              choices = "a", selected = "a"),

  selectInput(inputId = "yr", label = "",choices = "")
)

shinyApp(ui, server)

Answer 1

您的问题是这样的：

new_dat <- reactive({
    df %>% filter(ID == input$SID)
  })

试图评估reactve()内部的reactve()将无法正常工作。 只需将df %>% filter(ID == input$SID)代替：

new_dat()

所以：

library(dplyr)
library(shiny)

df <- setNames(data.frame(matrix(c(NA, NA, NA, 4, 6, 2, 1, 6, NA, NA), ncol = 5, nrow = 2, byrow = TRUE)), c("t1", "t2", "t3", "t4", "t5"))
df <- cbind(data.frame(ID = c("a", "b"), stringsAsFactors = FALSE), df)

all_drop_options <- df %>% pull(ID)



ui <- fluidPage(

  selectInput(inputId = "SID", label = NULL,
              choices = "a", selected = "a"),

  selectInput(inputId = "yr", label = "",choices = "")
)


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

  updateSelectizeInput(session = session, inputId = "SID",
                       choices = all_drop_options, selected = "a",
                       server = TRUE)


  year_opts2 <- reactive({
    tryCatch({
    df %>% filter(ID == input$SID) %>%
      select(-ID) %>%
      select_if(~!is.na(.)) %>% colnames()},
    error = function(x){
      return('')
    })
  })

  observe({
    updateSelectizeInput(session = session, inputId = "yr",
                         choices = year_opts2()
    )})
}


shinyApp(ui, server)

编辑：

如您所述，脚本有时会出错，因为filter偶尔会因错误返回空数据帧，从而阻止colnames()执行。

我添加了一个tryCatch来缓解这种情况，但不能完全确定为什么会发生这种情况！

Answer 2

背景：

对于一些原因，“我不知道他们”在第二个reactive ， new_dat()成为第一个迭代后空，那么select_if做什么应该做，产生这种错误。

#Run this code for better understanding
observe(print(new_dat()))

year_opts2 <- reactive({
   browser()
 new_dat() %>%
   select(-ID) %>%
   select_if(~!is.na(.)) %>%
   colnames()

})

observe(print(year_opts2()))

现在，如果我们对browser()和select_if(~!is.na(.))代码将可以正常工作。 像这样

observe(print(new_dat()))

year_opts2 <- reactive({
#browser()
 new_dat() %>%
   select(-ID) %>%
  #select_if(~!is.na(.)) %>%
   colnames()

})

observe(print(year_opts2()))

解：

希望下面可以解决您的问题

year_opts2 <- reactive({
 colnames(new_dat()[,!is.na(new_dat())][-1])
})