Реагировать или наблюдать в динамической фильтрации - PullRequest
1 голос
/ 20 мая 2019

У меня есть работающее приложение, которое использует несколько фильтров для построения графика некоторых данных, и я хочу, чтобы фильтры были динамическими и зависели от фильтра выше, показывая только доступные варианты выбора.Например, если Location_Id == 1, то в фильтре «Тип пользователя» доступен только «Велосипедный» тип_пользователя.Это все работает, когда приложение запускается с фильтрами, все из которых ограничены начальным начальным значением Location_ID, но как только я изменяю исходный ввод (Location_Id), ничего не обновляется автоматически, и мне нужно сделать Select All, чтобы увидеть, какие данные доступны дляновый выбранный идентификатор местоположения.Я читал все утро, и, кажется, мне нужно, возможно, где-то включить реактив () где-то на сервере, но не ясно, как тогда я обновлю интерфейс и если мне нужна функция типа рендеринга где-то.



#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 голосов
/ 01 июня 2019

Я разработал решение для вышеуказанной проблемы, которая начала эту проблему (создание обновлений фильтров с правильной реактивностью), но теперь, когда я добавил карту, приложение имеет тенденцию ломаться после выбора в первом селекторе, в этом примереэто было бы государством.

Я создал новый пример, приведенный ниже, который отвечает на поставленный выше вопрос, но ставит новый: почему происходит сбой моего приложения и связано ли это с ненадлежащим образом, с которым я справляюсь с реактивностью?

Чтобы приложение могло аварийно завершить работу, вы должны выбрать несколько состояний и позволить ему отображаться.Похоже, что это происходит в Калифорнии, поэтому меня интересует вопрос количества данных, которые пытается отобразить карта.К сожалению, нет ошибки, учитывая, что RStudio просто вылетает.Не уверен, что это правильный способ задать этот вопрос, но если проблема с реактивностью - это проблема с падением RStudio, я думаю, что он все еще имеет отношение к этой теме.Спасибо за любую помощь!

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

# 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
#Select final data and chart-----

  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)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...