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

我试图从用户上传的数据文件中动态填充

selectInput

的值。

selectInput

只能包含数字列

这是我的

server.R

...
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))
...

只要任何下拉列表中有多个值，代码就可以正常工作。但是，当它只遇到一个要在

selectInput

中显示的值时，它就会失败

---

考虑到数据已上载，且只有一列为数字时无法控制，我如何处理此特定情况？

信息：OP对代码进行了调整，以使错误重现。

---

要解决您的问题，请使用

val2似乎在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)

库（闪亮）
ui我已经更新了你的代码，只做了一些修改。它现在在我这边断了。希望您现在能够重现该问题。按预期工作。我唯一不明白的是，如果代码是在控制台中手动运行的，而没有
drop
参数，它确实会给我列的预期名称。我最好的猜测是，在反应性代码块中作为参数传递它是不一样的。嗯，我不能重现它，在控制台中也不起作用，对于mecan，我还在这里帮助吗？否则，我希望能投赞成票：）
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)

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)