闪亮的下拉选择作为过滤器的输入

时间:2018-07-05 21:00:22

标签: r shiny

我正在尝试使用下拉菜单中选择的树类型来过滤数据框。

我在下面创建了一个简单的独立版本。 现在,“槭树”被硬编码为要过滤的树。我想按用户在下拉菜单中选择的内容进行过滤。

很显然,我是Shiny的新手,我想知道在替换“枫木”时使用什么变量。

server.R

library(shiny)
library(dplyr) # Needed for filter

# Read tree types
data  <- c("oak", "maple", "elm")

# Read clean list of all Toronto's trees
tree_clean <- tibble (
  type = c("oak", "oak", "elm", "maple", "maple", "maple"),
  size = c(10, 20, 30, 10, 20, 30),
  id = c(1, 2, 3, 4, 5, 6)
)

function(input, output, session){

  my_list <- reactive({
    my_list <- as.character(data)

  })

  output$tree <- renderUI({
        selectInput(inputId = "tree", label = "Select a Tree", choices = my_list())
  })

  get_tree_data <- reactive({
    filter(tree_clean, type == "maple") 
  })



  observe({
  tree_data <- get_tree_data()
  print(tree_data)


  })

}

ui.R

# Scrollable dropdown with 246 tree names
library(shiny)
library(shinydashboard)


header <- dashboardHeader(title = "Toronto Tree Map")

body <- dashboardBody(
        fluidPage(
            column(width = 9,
                   box(width = NULL, solidHeader = TRUE)
                  ),

            column(width = 3,
                   box(width = NULL,
                       uiOutput(outputId = "tree")
                   )
            )
      )    
)

dashboardPage(
  header,
  dashboardSidebar(disable = TRUE),
  body
) 

旧问题-------------------------------------------- < / p>

在Server.R中,我认为用input $ tree代替硬编码的“ Japanese Katsura”是可行的。但是,它给出了错误:

Warning in is.na(e2) :
  is.na() applied to non-(list or vector) of type 'NULL'
Warning: Error in filter_impl: Result must have length 567061, not 0

我应该使用哪个变量替换硬编码的“ Japanese Katsura”,以便通过下拉菜单中的用户选择填充过滤器?

Server.R

# Scrollable dropdown with 246 tree names linked to map 
library(sf)
library(shiny)
library(leaflet)
library(dplyr) # Needed for filter

# Read border of Toronto
to_border <- st_read("citygcs_regional_mun_wgs84.shp", quiet = TRUE)
border  <-  to_border %>%
  st_cast("MULTILINESTRING")

# Read list of Toronto's 246 tree types
data <- read.csv("common_tree_names_246.csv", header = FALSE)$V1

# Read clean list of all Toronto's trees
tree_clean <- st_read("trees_lower_case6.shp")

function(input, output, session){

  my_list <- reactive({
    my_list <- as.character(data)

  })

  output$tree <- renderUI({
        selectInput(inputId = "tree", label = "Select a Tree", choices = my_list())
  })

  get_tree_data <- reactive({
    filter(tree_clean, tname == "Japanese Katsura") 
  })


  # Call once since using Leaflet proxy
  output$torontoMap<-renderLeaflet({
      leaflet(options = leafletOptions(minZoom = 10, maxZoom = 18), width = "100%") %>%
      addTiles() %>%

      addProviderTiles(providers$Stamen.Watercolor) %>%

      # Centre the map in the middle of Toronto
      setView(lng = -79.384293, 
      lat = 43.685, #43.653908, 
      zoom = 12)
  })

  observe({
  tree_data <- get_tree_data()
  print(nrow(tree_data))

    # If the data changes, the polygons are cleared and redrawn, however, the map (above) is not redrawn
    leafletProxy("torontoMap", data = tree_data) %>%
      clearShapes() %>%

      addCircles(data = tree_data,
                 color = "green",
                 weight = 5)
  })

}

UI.R

# Scrollable dropdown with 246 tree names
library(shiny)
library(shinydashboard)
library(leaflet)

# Remember   verbatimTextOutput("selection")

header <- dashboardHeader(title = "Toronto Tree Map")

body <- dashboardBody(
        fluidPage(
            column(width = 9,
                   box(width = NULL, solidHeader = TRUE,
                       leafletOutput("torontoMap", height = 400)
                      )
                  ),

            column(width = 3,
                   box(width = NULL,
                       uiOutput(outputId = "tree")
                   )
            )
      )    
)

dashboardPage(
  header,
  dashboardSidebar(disable = TRUE),
  body
)  

0 个答案:

没有答案