在一个侧边栏中有多个复选框组

Question

我正在尝试从多个复选框组中获取输入，但只有最后一个复选框组（标记为 industry）显示其内容。我在这里做错了什么？请注意复选框选项如何在不同的子标题下重复。

我的代码：

library(dplyr)
library(shiny)
dlxl<-function(url,sht){
  tmp = tempfile(fileext = ".xlsx")
  download.file(url = url, destfile = tmp, mode="wb")
  library(readxl)
  read_excel(tmp,sheet=sht)
}
csv<-dlxl("https://www.bls.gov/cps/cpsa2016.xlsx",sht="cpsaat14")
colnames(csv)<-csv[4,]
csv<-csv[6:81,]

ui = bootstrapPage(
  titlePanel("Occupation by Race and Age"),

  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput('age',"Choose Age/Racial Group(s)", choices=csv[1,],selected=NULL),
      checkboxGroupInput('industry',"Choose Industries", choices=colnames(csv),selected=NULL)
    ),
    mainPanel(
      plotOutput("plot1"),
      htmlOutput("text1")
    )
  )
)
server = function(input, output, session){

  output$text1 <- renderUI({HTML(paste("GO"))})

  getData<-reactive({
    cat(paste0("in_get_data_\n",input$age))
    cat(paste0("in_get_data2_\n",input$industry))
    shiny::validate(need(input$age!="", "Please select an age"))
    shiny::validate(need(input$industry!="", "Please select an industry"))
    #ages are x axis, y are industry values
    data<-csv[grepl(input$age,row.names(csv)),] #filter only selected ages (rows)
    data<-data[,grepl(input$industry,colnames(csv))] #filter only selected industry (column)
    data
})

  output$plot1 <- renderPlot({
    data<-getData()
    shiny::validate(need(length(data)>1, "The data for the source you selected was not reported"))
    plot(data,names.arg=colnames(data),legend.text = T,beside=T,col =palette()[1:nrow(data)])
  })
}

shinyApp(ui, server)

Answer 1

有很多事情我会改变。

age选择框

您将错误的值传递给第一个复选框，请尝试：

choices = unique(as.data.frame(csv)[,1])

固定复选框

更新：为choices 参数创建命名列表

在回复讨论时，在 cmets 中，在 this answer 之后，如果您打算使用 unique(as.data.frame(csv)[,1]) 作为复选框的 choices 参数的标签和值，您可以按以下方式创建必要的列表：

choicesList <- as.list(unique(as.data.frame(csv)[,1]))
names(choicesList) <- as.list(unique(as.data.frame(csv)[,1]))

您可以稍后传递给复选框函数：choices = choicesList。

其他问题

值得补充的是，您可以同时过滤这两个条件：

data <-
    csv[grepl(input$age, row.names(csv)) ,
        grepl(input$industry, colnames(csv))]

---

还有其他值得修复的地方。运行代码：

dlxl <- function(url, sht) {
    tmp = tempfile(fileext = ".xlsx")
    download.file(url = url,
                  destfile = tmp,
                  mode = "wb")
    library(readxl)
    read_excel(tmp, sheet = sht)
}
csv <-
    dlxl("https://www.bls.gov/cps/cpsa2016.xlsx", sht = "cpsaat14")
colnames(csv) <- csv[4,]
csv <- csv[6:81,]

将生成：

>> head(csv)
Error in x[needs_ticks] <- paste0("`", gsub("`", "\\\\`", x[needs_ticks]),  : 
  NAs are not allowed in subscripted assignments

如果你看看：

>> head(as.data.frame(csv))
                        NA Mining,\r\nquarry-\r\ning,\r\nand oil\r\nand gas\r\nextract-\r\nion
1                    TOTAL                                                                <NA>
2 Total, 16 years and over                                                                 792
3           16 to 19 years                                                                   4
4        20 years and over                                                                 788
5           20 to 24 years                                                                  45
6        25 years and over                                                                 743

使用此数据框将是一场噩梦。您可以从将列名更改为语法正确的列名开始，最残酷的方法是使用 make.names 函数：

>> make.names(names(as.data.frame(csv)))
 [1] "NA."                                                    
 [2] "Mining...quarry...ing...and.oil..and.gas..extract...ion"
 [3] "Con...struc...tion" 

恕我直言，我认为值得先修复数据框，然后派生 UI 元素并实现子集逻辑，因为尝试利用当前可用的值将证明由于内容奇怪而存在问题：NA Mining,\r\nquarry-\r\ning,\r\