我有一个 Shiny 应用程序，它根据用户选择的人口统计数据显示名为 demographicdata 的数据帧中的各种指标。
5 个地区的示例数据-
人口统计数据
structure(list(Geography = c("AK", "AL", "AR", "AZ", "CA"), `Sum of Total Persons` = c(855385L,
5293523L, 3766990L, 6420943L, 37431000L), `Sum of Total Families2` = c(199849L,
1375812L, 991124L, 1551127L, 8540363L), `Sum of Total Pop Non-Hispanic White` = c(514947L,
3513711L, 2825573L, 3712555L, 15076071L), `Sum of Total Pop Non-Hispanic Black/African American` = c(23112L,
1430075L, 585477L, 239295L, 2165712L), `Sum of Total Pop Hispanic only` = c(44256L,
195145L, 226525L, 1903995L, 14054449L), `Sum of Total Pop Non-Hispanic American Indian/Alaska Native` = c(164157L,
28974L, 25122L, 259769L, 169113L), `Sum of Total Pop Non-Hispanic Asian` = c(45630L,
54301L, 39553L, 170643L, 4777879L), `Sum of Total Pop Non-Hispanic Native Hawaiian/other Pacific Islander` = c(7749L,
2082L, 5732L, 10969L, 128793L), `Sum of Total Female Pop2` = c(406897L,
2722926L, 1914617L, 3230172L, 18821643L), `Sum of LMI Pop` = c(18648L,
256265L, 95286L, 431282L, 2680252L), `Sum of MIN Pop` = c(229268L,
1243264L, 531623L, 2059293L, 22733389L)), .Names = c("Geography",
"Sum of Total Persons", "Sum of Total Families2", "Sum of Total Pop Non-Hispanic White",
"Sum of Total Pop Non-Hispanic Black/African American", "Sum of Total Pop Hispanic only",
"Sum of Total Pop Non-Hispanic American Indian/Alaska Native",
"Sum of Total Pop Non-Hispanic Asian", "Sum of Total Pop Non-Hispanic Native Hawaiian/other Pacific Islander",
"Sum of Total Female Pop2", "Sum of LMI Pop", "Sum of MIN Pop"
), class = "data.frame", row.names = c(NA, -5L))
当仅选择一种人口统计特征时，该应用程序运行良好，但当我尝试在 selectizeInput 框中引入多个选择时，它会崩溃。
这是整个代码的最小示例
应用程序.r
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "demography", 'Choose MSA/MD for calculating Demographics',
choices = c("Select a geography",sort((demographicdata$Geography)))
),
actionButton(inputId="DatabyPage", label="Calculate")
),
mainPanel(
tabsetPanel(
tabPanel("Page 1 - Demographic Summary",
fluidRow(
column(width =12, tableOutput("Population")))
)))
))
server <- shinyServer(function(input, output, session) {
observeEvent(input$DatabyPage, {
Population = c("Total Population",
"Total Families",
"White",
"Black",
"Hispanic/Latino",
"Native American",
"Asian",
"HOPI",
"Total Minority",
"Number of Females",
"Population in LMI Tracts",
"Population in Minority Tracts"
)
Values = c(demographicdata$`Sum of Total Persons`[demographicdata$Geography== input$demography],
demographicdata$`Sum of Total Families2`[demographicdata$Geography==input$demography],
demographicdata$`Sum of Total Pop Non-Hispanic White`[demographicdata$Geography==input$demography],
demographicdata$`Sum of Total Pop Non-Hispanic Black/African American`[demographicdata$Geography==input$demography],
demographicdata$`Sum of Total Pop Hispanic only`[demographicdata$Geography==input$demography],
demographicdata$`Sum of Total Pop Non-Hispanic American Indian/Alaska Native`[demographicdata$Geography==input$demography],
demographicdata$`Sum of Total Pop Non-Hispanic Asian`[demographicdata$Geography==input$demography],
demographicdata$`Sum of Total Pop Non-Hispanic Native Hawaiian/other Pacific Islander`[demographicdata$Geography==input$demography],
(demographicdata$`Sum of Total Persons`[demographicdata$Geography==input$demography]) - (demographicdata$`Sum of Total Pop Non-Hispanic White`[demographicdata$Geography==input$demography]),
demographicdata$`Sum of Total Female Pop2`[demographicdata$Geography==input$demography],
demographicdata$`Sum of LMI Pop`[demographicdata$Geography==input$demography],
demographicdata$`Sum of MIN Pop`[demographicdata$Geography==input$demography])
Percent = c("","",
Values[3]/Values[1],
Values[4]/Values[1],
Values[5]/Values[1],
Values[6]/Values[1],
Values[7]/Values[1],
Values[8]/Values[1],
Values[9]/Values[1],
Values[10]/Values[1],
Values[11]/Values[1],
Values[12]/Values[1])
Values = prettyNum(Values,big.mark=',')
Percent[3:12] = paste(round(100*as.numeric(Percent[3:12]), 2), "%", sep="")
Population = data.frame(Population, Values, Percent)
colnames(Population) = c("Population Demographics", "Number", "Percent")
rm(Values, Percent)
output$Population <- renderTable({
Population
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
基本上我想访问数据框以进行多种人口统计选择
示例 - 如果用户选择阿拉巴马州和蒙大拿州，我想访问阿拉巴马州和蒙大拿州的 demographicdata$'Sum of Total Persons' 的累积总和。
我知道我必须在这里引入某种 react 元素，但我很难将它们组合在一起。
有什么想法吗？非常感谢!
最佳答案
有几件事需要改变。
1) 在 selectizeInput 中使用 multiple=TRUE
2) 将 == 替换为 %in% 以进行多个元素比较
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "demography", 'Choose MSA/MD for calculating Demographics', multiple = TRUE,
choices = c("Select a geography",sort((demographicdata$Geography)))
),
actionButton(inputId="DatabyPage", label="Calculate")
),
mainPanel(
tabsetPanel(
tabPanel("Page 1 - Demographic Summary",
fluidRow(
column(width =12, tableOutput("Population")))
)))
))
server <- shinyServer(function(input, output, session) {
observeEvent(input$DatabyPage, {
Population = c("Total Population",
"Total Families",
"White",
"Black",
"Hispanic/Latino",
"Native American",
"Asian",
"HOPI",
"Total Minority",
"Number of Females",
"Population in LMI Tracts",
"Population in Minority Tracts"
)
Values = c(sum(demographicdata$`Sum of Total Persons`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of Total Families2`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of Total Pop Non-Hispanic White`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of Total Pop Non-Hispanic Black/African American`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of Total Pop Hispanic only`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of Total Pop Non-Hispanic American Indian/Alaska Native`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of Total Pop Non-Hispanic Asian`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of Total Pop Non-Hispanic Native Hawaiian/other Pacific Islander`[demographicdata$Geography %in% input$demography]),
(sum(demographicdata$`Sum of Total Persons`[demographicdata$Geography %in% input$demography])) - (sum(demographicdata$`Sum of Total Pop Non-Hispanic White`[demographicdata$Geography %in% input$demography])),
sum(demographicdata$`Sum of Total Female Pop2`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of LMI Pop`[demographicdata$Geography %in% input$demography]),
sum(demographicdata$`Sum of MIN Pop`[demographicdata$Geography %in% input$demography]))
Percent = c("","",
Values[3]/Values[1],
Values[4]/Values[1],
Values[5]/Values[1],
Values[6]/Values[1],
Values[7]/Values[1],
Values[8]/Values[1],
Values[9]/Values[1],
Values[10]/Values[1],
Values[11]/Values[1],
Values[12]/Values[1])
Values = prettyNum(Values,big.mark=',')
Percent[3:12] = paste(round(100*as.numeric(Percent[3:12]), 2), "%", sep="")
Population = data.frame(Population, Values, Percent)
colnames(Population) = c("Population Demographics", "Number", "Percent")
rm(Values, Percent)
output$Population <- renderTable({
Population
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
-输出
关于r - 在 SelectizeInput Shiny 中过滤多个输入的数据帧，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/46875709/