在 R Shiny 应用程序的 selectInput 中仅显示一个值

Question

我正在尝试从用户上传的数据文件中动态填充selectInput 的值。 selectInput 必须只包含数字列。

这是server.R的代码sn-p

...
idx <- sapply(data.file, is.numeric)
numeric_columns <- data.file[, idx]
factor_columns <- data.file[, !idx]

updateSelectInput(session, "bar_x", "Select1", choices = names(numeric_columns))
updateSelectInput(session, "bar_y", "Select2", choices = names(factor_columns))
...

对应ui.r

 ...
 selectInput("bar_x", "Select1", choices = NULL),
 selectInput("bar_y", "Select2", choices = NULL)
 ...

只要任何下拉列表中有多个值，代码就可以正常工作。但是，只要遇到selectInput 中要显示的一个值，它就会失败。

鉴于数据已上传，如果只有一列作为数字，我该如何处理这种特定情况？

Answer 1

看来在 2019 年，这个问题仍然存在。我看到的问题是，当下拉列表中只有一个选项时，会显示列的名称而不是一个选项。

这似乎只是一个图形问题，因为查询 selectInput 元素的值会返回正确的基础数据。

我无法弄清楚为什么会出现此问题，但解决此错误的一种简单方法是简单地更改列的名称，使其看起来像列表中的第一个元素。

library(shiny)

ui <- fluidPage(
  selectInput("siExample",
    label = "Example Choices",
    choices = list("Loading...")),
)

server <- function(input, output, session) {
  # load some choices into a single column data frame
  sampleSet <- data.frame(Example = c("test value"))

  # rename the set if there is only one value
  if (length(sampleSet$Example) == 1) {

    # This should only be done on a copy of your original data,
    # you don't want to accidentally mutate your original data set
    names(sampleSet) <- c(sampleSet$Example[1])
  }

  # populate the dropdown with the sampleSet
  updateSelectInput(session,
    "siExample",
    choices = sampleSet)
}

shinyApp(ui = ui, server = server)

Answer 2

信息：代码已由 OP 修改以使错误可重现。 要解决您的问题，请使用val2 <- val[,idx, drop = FALSE] 您通过子集data.frame() 删除了列名。 为避免这种情况，请使用drop = FALSE；见Keep column name when select one column from a data frame/matrix in R。

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
# drj's changes START block 1
        #selectInput('states', 'Select states', choices = c(1,2,4))
        selectInput('states', 'Select states', choices = NULL)
# drj's changes END block 1
      ),

      # Show a plot of the generated distribution
      mainPanel(
         plotOutput("distPlot")
      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

  observe({


#drj's changes START block 2
    #val <- c(1,2,3)
    #names(val) <- c("a","b","c")
    #updateSelectInput(session, 'states', 'Select states', choices = names(val[1]))
    val <- as.data.frame(cbind(c("_1","_2","_3"), c(4, 4, 6)))
    names(val) <- c("a","b")
    val$b <- as.numeric(val$b)
    idx <- sapply(val, is.numeric)
    val2 <- val[,idx, drop = FALSE]
    updateSelectInput(session, 'states', 'Select states', choices = names(val2))
#drj's changes END block 2
  })
}

# Run the application 
shinyApp(ui = ui, server = server)