Question

我在shiny的{{1}}集成中遇到问题。我想制作一个交互式传单，用户可以在其中单击一个功能，然后在底部弹出与该特定功能相对应的图形。

基本上，在单击事件期间，Shiny会尝试收集该特殊功能的ID，根据该ID查询外部数据框，然后生成图形。到目前为止，我设法使工作流正常运行。

但是，当我尝试在地图中添加另一层（具有另一个ID）时，会出现问题。假设有两层：树和铁路。如果单击树层，则会弹出有关树的图形。但是，当我单击道路时，由于ID冲突，图形生成器仍会运行，然后更新图形返回错误。我不要这个我只希望在单击树时更新图形，而在单击铁路时不希望图形更新。

我注意到出现问题的原因是Shiny根据对象类别leaflet处理Leaflet的事件。在我的情况下，树木和铁路都归为形状，因此只要我单击任意一个对象，事件都会不断更新。到目前为止，我的解决方法是将其中一层添加为GeoJSON，以便Shiny可以区分不同的层。但这当然是不切实际的，因为如果再添加一层，问题就会再次出现。

这是我到目前为止的代码：

input$MAPID_OBJCATEGORY_EVENTNAME

这是我用来创建图形的函数：

library(shiny)
library(shinydashboard)
library(leaflet)
library(magrittr)
library(raster)
library(rgdal)
library(sf)
library(RColorBrewer)
library(ggplot2)

rm(list = ls())

# Get the functions from functions.R
source("functions.R")

# Loading the data
# Shapes
spoor <- readOGR("./data/ScoredSpoor.geojson")
kroon <- readOGR("./data/RiskyTrees.json")
# spoor <- readLines("./data/ScoredSpoor.geojson") %>% paste(collapse = "\n")
# kroon <- readLines("./data/RiskyTrees.json") %>% paste(collapse = "\n")
# Indices
ndvi <- readRDS("./data/ndvi.rds")
evi <- readRDS("./data/evi.rds")
lai1 <- readRDS("./data/lai1.rds")
lai2 <- readRDS("./data/lai2.rds")
lai3 <- readRDS("./data/lai3.rds")
date <- readRDS("./data/date.rds")

# Color palettes for visualization
palTree <- colorBin("RdBu", domain = kroon$SCORE, bins = c(0:5), reverse = T)
# bins <-  c(0:5)
# pal <- colorBin("RdBu", domain = kroon$BOOMHOOGTE, bins = bins)
# palette_rev <- rev(brewer.pal(5, "RdBu"))

### APPLICATION ###

header <- dashboardHeader(title = "Bomen in Beeld+")

body <- dashboardBody(

  fluidRow(
    column(width = 8,
           box(title = "Map", width = NULL, height = 500, solidHeader = T,
               leafletOutput("basemap"))

    ),
    column(width = 4,
           box(title = "Track Info", width = NULL, height = 250, solidHeader = T,
               "Spoorlijn Utrecht - Baarn", textOutput("text")),
           box(title = "Tree Info", width = NULL, height = 250, solidHeader = T,
               "Tree information would appear here.")
    )
  ),

  fluidRow(
    box(title = "How 'green' is the tree?", width = 4, height = 300,
        plotOutput("graph")),
    box(width = 4, height = 300,
        selectInput("parameter", "Select a parameter to visualize:",
                    choices = c("NDVI" = "ndvi", 
                                "EVI" = "evi", 
                                "LAI/EVI - Alexander et al (2019)" = "lai1",
                                "LAI/EVI - Wang et al (2005)" = "lai2", 
                                "LAI/NDVI - Wang et al (2005)" = "lai3"))),
    box(title = "Credits", width = 4, height = 300,
        "(c) 2019 Tombayu Amadeo Hidayat", br(),
        img(src = "logo.png", height = 30))
  )
)

ui <- dashboardPage(header, dashboardSidebar(disable = T), body = body)

server <- function(input, output) {

  # Basemap
  output$basemap <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>%
      setView(5.282715, 52.154510, 18) %>%
      addPolylines(data = spoor) %>%
      addPolygons(data = kroon, fillColor = ~palTree(SCORE), fillOpacity = 1, weight = 0.2,
                  highlight = highlightOptions(weight = 3, color = "black"),
                  layerId  = ~OBJECTID)
  })

  IDs <- list()

  # Retrieve ID of clicked polygon
  clickID <- eventReactive(input$basemap_shape_click, {
    return(input$basemap_shape_click$id)
  })

  # 'Greenness' graph
  output$graph <- renderPlot({
      createPlot(as.numeric(clickID()), as.character(input$parameter))
  })

  output$text <- renderText(getwd())
}

##### BUNDLE THE APP AND RUN #####

shinyApp(ui = ui, server = server)

对不起，我无法向您共享任何数据，因为它是机密的。.但我希望能为您提供足够的信息。

谢谢！

仅从Shiny的Leaflet集成中的特定图层获取layerID

0 个答案: