在SelectizeInput Shiny

Question

我有一个Shiny应用程序，根据用户选择的人口统计信息显示来自名为demographicdata的数据框的各种指标。

5个地理区域的样本数据 -

demographicdata

    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框中引入多个选择时，它会崩溃。

这是整个代码的最小例子

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

基本上我想访问多个人口统计选择的数据框

示例 - 如果用户选择Alabama和Montana，我想访问阿拉巴马州和蒙大拿州的累计总和demographicdata$'Sum of Total Persons'。

我知道我必须在这里介绍一些反应元素，但我很难将它组合在一起。

有什么想法？非常感谢！

Answer 1

有几件事要改变。

1）在multiple=TRUE中使用selectizeInput 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)

-output