Блестящий выпадающий выбор как вход для фильтра - PullRequest
0 голосов
/ 06 июля 2018

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

Ниже я создал простую автономную версию. Прямо сейчас «клен» жестко закодирован как дерево для фильтрации. Я хотел бы фильтровать по тому, что пользователь выбирает в раскрывающемся списке.

Очевидно, я новичок в блестящем и хотел бы знать, какую переменную использовать вместо "клен".

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
) 

СТАРЫЙ ВОПРОС --------------------------------------------

В Server.R я подумал, что заменить жестко закодированную «японскую катсуру» входным $ tree будет работать. Однако выдает ошибку:

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

Какой переменной я должен заменить жестко закодированную "японскую катсуру", чтобы мой фильтр подавался по выбору пользователя в раскрывающемся списке?

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