反应或观察动态过滤

时间：2019-05-20 20:55:42

标签： dynamic filter reactive

我有一个正在运行的应用程序，该应用程序使用多个过滤器来绘制一些数据，并且我希望过滤器是动态的，并且仅通过显示可用选项来依赖于上面的过滤器。例如，如果Location_Id == 1，则“用户类型”过滤器中仅“自行车”用户类型可用。当应用程序以所有受初始Location_ID起始值限制的过滤器启动时，这一切都有效，但是一旦我更改了初始输入（Location_Id），任何内容都不会自动更新，因此我必须执行“全选”以查看哪些数据可用于新选择的位置ID。我整个上午都在看书，似乎我可能需要在服务器中的某个位置包括一个react（），但是不清楚如何更新ui以及是否需要在某个地方使用render类型的函数。 



#Example for stack overflow
library(shiny)
library(datasets)
library(dplyr)
library(shinyWidgets)
library(lubridate)
#Create test data
set.seed(10)
Dates. <- sample(c(seq(as.Date("2017-01-01"),as.Date("2017-12-28"),1),seq(as.Date("2018-01-01"),as.Date("2019-12-28"),1)),1000)
Facility_Type. <- sample(c("Bikelane","No facility"),length(Dates.),replace = T)
Data.. <- data.frame(Date = Dates., Facility_Type = Facility_Type.)
Data..$User_Type_Desc<- sample(c("Bike","Pedestrian"),nrow(Data..),replace = T)
Data..$Counts <- sample(1:100,nrow(Data..),replace = T)
Data..$Location_Id <- sample(c("01","02","03","04"),nrow(Data..),replace = T)
Data..$Month <- months(Data..$Date)
Data..$Year <- year(Data..$Date)
Data..$User_Type_Desc <- as.character(Data..$User_Type_Desc)
Data..$Facility_Type <- as.character(Data..$Facility_Type)

#Force some changes on data to highlight problem 
Data..$User_Type_Desc[Data..$Location_Id%in%"01"] <- "Bike"
Data..$User_Type_Desc[Data..$Location_Id%in%"04"] <- "Pedestrian"


ui <- 
  #shinyUI(fluidPage(
  navbarPage(title = "Bend Bike/PedTraffic Counts",
             #Graphics panel
             tabPanel("Charting",
                      #headerPanel(title = "Bend Traffic Count Data Viewer"),
                      sidebarLayout(
                        sidebarPanel(
                          #Select Location Id
                          selectInput("Location_Id","Select a Location Id",choices = unique(Data..$Location_Id)),

                          #Select Year
                          pickerInput(inputId = "Year", label = "Select/deselect all + format selected", choices = NULL, 
                                      options = list(`actions-box` = TRUE, size = 10,`selected-text-format` = "count > 3"), multiple = TRUE),
                          #Select Month
                          pickerInput(inputId = "Month", label = "Select/deselect all + format selected", choices = NULL, 
                                      options = list(`actions-box` = TRUE, size = 10,`selected-text-format` = "count > 3"), multiple = TRUE),
                          #Location details
                          ##################
                          #Select User Types 
                          pickerInput(inputId = "User_Type", label = "Select/deselect all + format selected", choices = NULL, 
                                      options = list(`actions-box` = TRUE, size = 10,`selected-text-format` = "count > 3"), multiple = TRUE),
                          #Select Facility Types
                          pickerInput(inputId = "Facility_Type", label = "Select/deselect all + format selected", choices = NULL, 
                                      options = list(`actions-box` = TRUE, size = 10,`selected-text-format` = "count > 3"), multiple = TRUE)
                          #dateRangeInput("Date", "Input date range")
                          #selectInput("Date","Select a Product",choices = NULL)


                          #Panel end
                        ),
                        mainPanel( plotOutput("location_plot"))
                        #Sidebar panel layout end  
                      )
                      # Sidebar panel end
             )
             #PAge end   
  )



server <- 
  #print(str(product_list))
  shinyServer(function(session,input,output) {

    #Create selection menus
    ##########################
    #Year selection with choices constrained by Location_Id
    observe({
      Years. <- unique(Data..$Year[Data..$Location_Id%in%input$Location_Id])
      updatePickerInput(session,"Year","Select Year(s)",choices = Years.,selected = Years.[1])
    })
    #Month selection  with Year choices
    observe({
      Months. <- unique(Data..$Month[Data..$Year%in%input$Year])
      updatePickerInput(session,"Month","Select Month(s)",choices = Months., selected = Months.[1]  )

    })
    #User Type
    observe({
      User_Type. <- unique(Data..$User_Type_Desc[Data..$Year%in%input$Year & Data..$Month%in%input$Month])
      updatePickerInput(session,"User_Type","Select User Type(s)",choices = User_Type., selected = User_Type.[1])

    })
    #Facility Type
    observe({
      Facility_Type. <- unique(Data..$Facility_Type[Data..$Year%in%input$Year & Data..$Month%in%input$Month
                                                    & Data..$User_Type_Desc%in%input$User_Type])
      updatePickerInput(session,"Facility_Type","Select Facility Type(s)",choices = Facility_Type., selected = Facility_Type.[1])

    })

    #Plot data
    ##########################
    #Select final data and chart
    output$location_plot <- renderPlot({
      #Select data
      dat <- Data..[Data..$Location_Id%in%input$Location_Id & Data..$Month%in%input$Month & 
                      Data..$Year%in%input$Year & Data..$User_Type_Desc%in%input$User_Type,]
      #Initialze chart
      ggplot(data = dat, x=Date, y = Counts) +
        geom_bar(aes(x = Date,y = Counts),color = "black", position = "dodge", stat = "identity")+
        facet_wrap(Facility_Type~User_Type_Desc)

    })
  })




#Run App

shinyApp(ui,server)

1 个答案:

答案 0 :(得分：0)

我已经针对上述问题开发了一个解决方案，该问题开始了该问题（使滤镜以适当的反应性进行更新），但是现在我添加了地图，在本示例中，在第一个选择器中进行选择后，应用程序往往会崩溃那就是状态。

我在下面创建了一个新示例，该示例回答了上述问题，但又提出了一个新示例：为什么我的应用程序崩溃了，这与我处理反应性的方式不正确有关吗？

为了使应用程序崩溃，您必须选择几个不同的状态并使其呈现。它似乎是在加利福尼亚进行的，所以让我想知道这是否与地图尝试呈现的数据量有关。不幸的是，鉴于RStudio崩溃，没有任何错误。不知道这是否是提出此问题的正确方法，但是如果反应性是RStudio崩溃的问题，我认为它仍然与此线程相关。感谢您的帮助！

library(shiny)    # for shiny apps
library(ggplot2)
library(plotly)
library(dplyr)
library(shinyWidgets)
library(tigris)
library(mapview)
library(raster)

# Load(Create) data
State_01_Tracts_Sp <- tracts("01")
State_02_Tracts_Sp <- tracts("02")
State_04_Tracts_Sp <- tracts("04")
State_05_Tracts_Sp <- tracts("05")
State_06_Tracts_Sp <- tracts("06")
Tracts_Sp <- rbind(State_01_Tracts_Sp ,State_02_Tracts_Sp, State_04_Tracts_Sp, 
State_05_Tracts_Sp , State_06_Tracts_Sp  )


#Decode fips into descriptive state and county names
Tracts_Sp@data$State <- 
fips_codes$state_name[match(Tracts_Sp@data$STATEFP,fips_codes$state_code)]
Tracts_Sp@data$County <- 
fips_codes$county[match(Tracts_Sp@data$COUNTYFP,fips_codes$county_code)]
#Create a copy of the spatial data's data frame
Data.. <- Tracts_Sp@data



#Set up User Interface
   ui <- fluidPage(
    titlePanel("Census Viewer Test"),
  tabsetPanel(
    #Daily Counts Panel
    ##############
    #Hourly Counts Panel
    #######################
    tabPanel("Tab 1",
             #Call plot 
             fluidRow(column(width = 12,plotlyOutput("county_plot" ))),
             #Location Details 
             fluidRow( 
               column(3,
                      h4("Select Details"),
                      uiOutput("State_selector"),
                      uiOutput("County_selector"),
                      uiOutput("Tract_selector")),
               column(6,
                      #h4("Selected Location"),
                      leafletOutput("map_plot",height = 500))
               #Close row
             )
             #Close panel
    )
    #Close setPanel
  )
  #PAge end   
)

#Set up Server
#---------------------------
server <- shinyServer(function(session,input,output){
  #Temporal Details
  ##################
  #State
  output$State_selector <- renderUI({
    selectInput(inputId = "State",
                label = "State", multiple = FALSE,
                choices = c( unique(Data..$State)),
                selected =  unique(Data..$State)[1])
  })
  #County selection----
  output$County_selector <- renderUI({
    available0 <- as.character(unique(Data..$County[Data..$State %in% input$State ] 
))
    pickerInput(inputId = "County", label = "Select/deselect all + format selected", 
choices = as.character(unique(available0)), 
                options = list(`actions-box` = TRUE, size = 10,`selected-text-format` 
= "count > 3"), multiple = TRUE,selected = as.character(unique(available0)))
  })
  #Tract selection----
  output$Tract_selector <- renderUI({
    available1 <- as.character(unique(Data..$GEOID[Data..$State %in% input$State ] ))
    pickerInput(inputId = "Tract", label = "Select/deselect all + format selected", 
  choices = as.character(unique(available1)), 
                options = list(`actions-box` = TRUE, size = 10,`selected-text-format` 
= "count > 3"), multiple = TRUE,selected = as.character(unique(available1)))
  })

#Graphics   #########################   ＃选择最终数据和图表----- 

  output$county_plot <- renderPlotly({
    #Select data
    dat <- Data..[Data..$State%in%input$State & Data..$County%in%input$County & 
Data..$GEOID%in%input$Tract ,]
    #Set up axis parameters depending on amount of data 
    angle = 90

    #Initialze chart
    ggplotly(ggplot(data = dat, x=GEOID, y = ALAND, fill = State) +
               geom_bar(aes(x=GEOID, y = ALAND, fill = State),color = "black", 
position = "dodge", stat = "identity")+
                ggtitle(paste("Land Area of Select Counties 
",unique(dat$State),sep="")) + 
               #Center plot
               theme(plot.title = element_text(hjust = 0.5)) +
               ylab("LAnd Area") +
               xlab("") +
               guides(color=guide_legend("State")) +
               theme(axis.text.x = element_text(angle = angle, hjust = 
1),plot.background = element_rect(fill = "darkseagreen"))) %>% layout(dragmode = 
"select") 

  })
  #Select final data and map-----
  output$map_plot <- renderLeaflet({
    #Select data
    Map_Data_Sp <- Tracts_Sp[Tracts_Sp@data$State%in%input$State,]
    class(Map_Data_Sp )
    #Create map 
    Map <- mapview(Map_Data_Sp, map.types = "OpenStreetMap", legend = FALSE, 
col.regions = "red",color = "black",cex = 10)
    Map@map

    #Close map
  })


})
#Run App
shinyApp(ui,server)
相关问题
最新问题