Question

我有一个闪亮的应用程序，并且在该应用程序中，我有一个根据用户输入呈现的表格。在eviction_county_2010上的该管道中，我试图只返回与cluster处于同一input$county的一个县样本的表。我想出了如何使用多行代码和重新分配来执行此操作的方法，但是每次我执行此操作时Shiny都会引发错误，因为显然不允许这样做。如何调整代码以在一个管道中返回此代码？

具有多个分配的代码。尝试这样做时，我得到了Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

server <- function(input, output, session) {

  ec <- eviction_county_2010 %>%
    filter(parent_location == input$state) %>%
    filter(name == input$county)
  sel_clust <- c(unique(ec$cluster))
  sel_geoid <- c(unique(ec$GEOID))
  sim_cty <- eviction_county_2010 %>% filter(cluster == sel_clust | GEOID != sel_geoid)
  sim_cty <- unique(sim_cty$GEOID)
  sim_cty <- sample(sim_cty, 5)
  sim_cty <- append(sel_geoid, sim_cty)
...

output$table <- renderTable({eviction_county_2010 %>% filter(GEOID %in% sim_cty)})

我以反应式方式尝试了上述代码，并得到了Error: 'match' requires vector arguments。

sim_cty <- reactive({ec <- eviction_county_2010 %>%
    filter(parent_location == input$state) %>%
    filter(name == input$county)
  sel_clust <- c(unique(ec$cluster))
  sel_geoid <- c(unique(ec$GEOID))
  sim_cty <- eviction_county_2010 %>% filter(cluster == sel_clust | GEOID != sel_geoid)
  sim_cty <- unique(sim_cty$GEOID)
  sim_cty <- sample(sim_cty, 5)
  sim_cty <- append(sel_geoid, sim_cty)})

  output$table <- renderTable(
    eviction_county_2010 %>% 
      filter(GEOID %in% sim_cty)

当前代码

library(shiny)
library(tidyverse)
library(datasets)
library(lubridate)
library(stringr)

eviction_county_2010 <- read.csv("./eviction_county_2010.csv")

ui <- fluidPage(
  sliderInput(inputId = "year",
              label = "Select a Year:",
              min = 2010,
              max = 2016,
              value = 2010,
              step = 1),

  radioButtons(inputId = "layer",
               label = "Select a Dataset to View:",
               choices = c("Eviction Filing Rate"="eviction_filing_rate", "Percent Rent Burden"="rent_burden",
                           "Percent Renter Occupied"="pct_renter_occupied", "Poverty Rate"="poverty_rate")),

  selectInput(inputId = "state",
              label = "Select a State:",
              eviction_county_2010$parent_location),
  selectInput(inputId = "county",
              label = "Select a County:",
              choices = NULL),
  mainPanel(
    h2("Comparisons Across Similar Counties"),
    tableOutput('table')
  )
)

server <- function(input, output, session) {

  observe({
    x <- filter(eviction_county_2010,parent_location == input$state) %>%
      select(name)
    updateSelectInput(session,"county","Select a County:",choices = unique(x))}
  )

  output$table <- renderTable(
    eviction_county_2010 %>% 
      group_by(County) %>% 
      summarise_at(c("GEOID", "population", "cluster", "poverty_rate", "unemployment_rate", "pct_renter_occupied",  
                     "Percent_Rural", "median_gross_rent", "median_household_income", 
                     "median_property_value", "rent_burden", "pct_white", "pct_nonwhite", 
                     "pct_af_am", "pct_hispanic", "pct_am_ind", "pct_asian", 
                     "pct_nh_pi", "pct_multiple", "pct_other"), mean, na.rm = TRUE) %>% 
      rename(Population = population, `Poverty Rate` = poverty_rate, 
             `Unemployment Rate` = unemployment_rate, `% Renter Occupied` = pct_renter_occupied,  
             `% Rural` = Percent_Rural, `Median Gross Rent` = median_gross_rent, `Median Household Income` = median_household_income, 
             `Median Property Value` = median_property_value, `Rent Burden` = rent_burden, 
             `% White` = pct_white, `% Non White` = pct_nonwhite, 
             `% African American` = pct_af_am, `% Hispanic` = pct_hispanic, `% American Indian` = pct_am_ind, 
             `% Asian` = pct_asian, 
             `% Native Hawaiian/Pacific Islander` = pct_nh_pi, `% Multiple` = pct_multiple, `% Other` = pct_other) # %>%
      # filter(County == str_c(input$county, input$state, sep = ", "))
  )
}

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

Answer 1

没有示例/玩具数据（see here to learn how to create one），我无法对其进行测试。但是，根据您的代码，将sim_cty转换为反应式时，需要将其作为函数sim_cty()进行调用：

output$table <- renderTable(
    eviction_county_2010 %>% 
      filter(GEOID %in% sim_cty())

请参阅here，以了解有关发亮的反应物的更多信息。

根据单独过滤器的条件过滤管道中的值

1 个答案: