R Shiny - выбор города зависит от выбранной провинции с помощью selectInput - PullRequest
Новая
       21

R Shiny - выбор города зависит от выбранной провинции с помощью selectInput

0 голосов
/ 04 апреля 2019

Я пытаюсь установить базу данных в столбце Провинция и Город.В блестящем, я хочу позволить пользователю выбрать провинцию, а затем город с пользовательским интерфейсом selectInput.

Вот как выглядит фрейм данных.
Столбец InfoTemp[2] - это город, InfoTemp[3] - этопровинция.
Набор данных большой, на самом деле у него много уровней.

Year  Autumn    InfoTemp[2] InfoTemp[3]  
1913     8.9 SHAWNIGAN LAKE          BC  
1914     9.5 SHAWNIGAN LAKE          BC  
1915     9.3 SHAWNIGAN LAKE          BC  
1916     8.5 SHAWNIGAN LAKE          BC  
1917     9.9 SHAWNIGAN LAKE          BC  
1918 -9999.9 SHAWNIGAN LAKE          BC

В конечном счете, это заговор (для города), на который я планирую пойти.

Вот код пока, ничего не делал ...

server.R 

library(shiny)

shinyServer(function(input, output) {

  #MeanTemp
  load("CanadianMeanTemp.Rdata")

  province = input$provinces
  city = input$cities

  output$distPlot <- renderPlot({

    MeanTemp_province = MeanTemp[grep(c(province), MeanTemp$`InfoTemp[3]`),]
    MeanTemp_city = MeanTemp_province[grep(c(city), MeanTemp$`InfoTemp[2]`),]

    plot(MeanTemp_city$Year, MeanTemp_city$Annual, type = "l")
    lines(supsmu(MeanTemp_city$Year, MeanTemp_city$Annual), col = 2)
  })

})

ui.R 

library(shiny)
shinyUI(fluidPage(
  titlePanel("Temperature"),

  sidebarLayout(
    sidebarPanel(
      selectInput('provinces', 'Province', choices = levels(MeanTemp$`InfoTemp[3]`)),

      conditionalPanel(
        condition = "input.provinces == true",
        selectInput('cities', 'City', choices = levels(MeanTemp_province$`InfoTemp[2]`))
      )
    ),

    mainPanel(
      plotOutput("distPlot")
    )
  )

))

1 Ответ

0 голосов
/ 04 апреля 2019

Код 

library(shiny)

city_data <- expand.grid(Year = seq.Date(as.Date("1990/1/1"), 
                                         as.Date("2000/1/1"), by = "year"),
                         Province = LETTERS[1:3],
                         City_Counter = 1:4)

city_data$City <- paste(city_data$Province, city_data$City_Counter, sep = "_")
city_data$Autumn <- runif(NROW(city_data), 10, 100)

ui <- fluidPage(
  selectInput("province", "Select province:", unique(city_data$Province)),
  selectInput("city", "Select city:", unique(city_data$City)),
  plotOutput("plot")
)

server <- function(input, output, session) {
  get_filtered_data <- reactive({
     city_data[city_data$Province %in% input$province & 
               city_data$City %in% input$city, , drop = FALSE]
  })

  observe({
     updateSelectInput(session, 
                       "city",
                       choices = unique(city_data[city_data$Province %in%
                                                  input$province, "City"]))
  })

  output$plot <- renderPlot({
    my_data <- get_filtered_data()
    req(NROW(my_data) > 0)
    plot(my_data$Year, my_data$Autumn, type = "l")
  })
}

shinyApp(ui, server)

Некоторые замечания

  • Я использовал updateSelectInput вместо подхода uiOutput, b/ c Я чувствую, что перерасчет всего ввода - это излишнее, когда в конце концов только изменение choices.
  • Я использовал здесь базу R для поднабора, но это можно легко заменить на tidyverseсинтаксис при необходимости
  • Я использовал %in% вместо == при фильтрации, чтобы можно было расширить его, чтобы отображать несколько городов / провинций в граненых графах, если необходимо
...