Question

借助StéphaneLaurent的帮助，我能够在Shiny中创建一个具有多种字体样式的下拉菜单。

但是，当我将这些更改添加到代码中时，会出现一些不需要的行为。最有可能是由于我在updateSelectizeInput中添加了selected = input $ tree引起的。我觉得我必须添加它，因为否则，它只会映射列表中的第一棵树。

问题

我不明白为什么每个下拉选择都会两次调用get_tree_data。
搜索不再有效。在进行更改以在下拉列表中具有多种字体样式之前，我可以清除下拉字段并键入一些字符，它将找到所有匹配的树。例如，找到名称中带有“桦树”的所有树木。我不能再这样做了。

server.R

library(sf)
library(shiny)
library(leaflet)
library(tidyverse) 

# Short list of Toronto's trees
tree_clean <- #see dput output below

function(input, output, session){

  my_list <- reactive({
     list("Walnut - latin1", "Willow - latin2", "European Birch - latin3", "Birch - latin4", "White Birch - latin5")
  })

  get_tree_data <- reactive({
      # Extract common name of tree
      common_name_plus_space <- str_extract(input$tree, "[^-]+") 
      length = str_length(common_name_plus_space)
      common_name_only <- str_sub(common_name_plus_space, 1, length - 1)
      print("Inside else")
      print(common_name_only)
      filter(tree_clean, tname == common_name_only) 
  })


  # 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 = 11)
  })

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

    updateSelectizeInput(session, "tree",
                         choices = my_list(),
                         selected = input$tree, # Otherwise defaults to NULL and thus the first tree in list
                         options = list(render = I(
                           '{
                           item: function(item, escape) {
                           var splittedLabel = escape(item.label).split(" - ");
                           return "<div>" + splittedLabel[0] + " - <i>" + splittedLabel[1] + "</i></div>"
                           },
                           option: function(item, escape) {
                           var splittedLabel = escape(item.label).split(" - ");
                           return "<div>" + splittedLabel[0] + " - <i>" + splittedLabel[1] + "</i></div>"
                                                          }
                          }'
                                                  )
                                      )
                       )




    # 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 = "red",
                 weight = 5)
  })

}

ui.R

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,
                      selectizeInput(inputId = "tree", label = "Select a Tree", choices = NULL) 
                   )
            )
      )    
)

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

dput（tree_clean）

structure(list(address = c(123, 25, 8, 173, 91, 75), suffix = structure(c(NA_integer_, 
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_
), .Label = character(0), class = "factor"), street = structure(c(6L, 
1L, 5L, 3L, 4L, 2L), .Label = c("Allenbury Gdns", "Bishop Ave", 
"Mckee Ave", "Overland Dr", "Rainswood Crt", "Tavistock Rd"), class = "factor"), 
    diam = c(25, 120, 15, 25, 50, 13), tname = structure(c(3L, 
    5L, 1L, 2L, 4L, 4L), .Label = c("Northern Catalpa", "Oak", 
    "Walnut", "White Birch", "Willow"), class = "factor"), latin = structure(c(3L, 
    5L, 2L, 4L, 1L, 1L), .Label = c("Betula papyrifera", "Catalpa speciosa", 
    "Juglans sp.", "Quercus sp.", "Salix sp."), class = "factor"), 
    geometry = structure(list(structure(c(-79.4937308518207, 
    43.731917558949), class = c("XY", "POINT", "sfg")), structure(c(-79.341836652518, 
    43.781317809768), class = c("XY", "POINT", "sfg")), structure(c(-79.5049053101647, 
    43.7200907429279), class = c("XY", "POINT", "sfg")), structure(c(-79.4036125917919, 
    43.7749109691476), class = c("XY", "POINT", "sfg")), structure(c(-79.3507333084168, 
    43.7317206455347), class = c("XY", "POINT", "sfg")), structure(c(-79.4103946558101, 
    43.7826649178121), class = c("XY", "POINT", "sfg"))), n_empty = 0L, crs = structure(list(
        epsg = 4326L, proj4string = "+proj=longlat +ellps=WGS84 +no_defs"), .Names = c("epsg", 
    "proj4string"), class = "crs"), class = c("sfc_POINT", "sfc"
    ), precision = 0, bbox = structure(c(-79.5049053101647, 43.7200907429279, 
    -79.341836652518, 43.7826649178121), .Names = c("xmin", "ymin", 
    "xmax", "ymax"), class = "bbox"))), .Names = c("address", 
"suffix", "street", "diam", "tname", "latin", "geometry"), row.names = c(NA, 
-6L), class = c("sf", "data.frame"), sf_column = "geometry", agr = structure(c(NA_integer_, 
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_
), class = "factor", .Label = c("constant", "aggregate", "identity"
), .Names = c("address", "suffix", "street", "diam", "tname", 
"latin")))

不了解闪亮下拉菜单的行为

0 个答案: