r-閃亮的服務器選擇輸入

Question

地圖上顯示了一堆點。 有兩種類型的水源。 我希望能夠只顯示與一個來源或另一個或兩者相關的點。

當水資源被選擇為兩者時，並不是所有的點都顯示出來。 這是為什么？ 它有什么問題？

這就是所有的問題和解釋，但是，stackoverflow 要求我解釋更多，這主要是代碼。 所以，我只是在這里輸入內容，以便計算器讓我發布問題。

# global.R:

library(scales)
library(lattice)
library(jsonlite)
library(raster)

library(data.table)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(maps)
library(rgdal)    # for readOGR and others
library(sp)       # for spatial objects
library(leaflet)  # for interactive maps (NOT leafletR here)
library(dplyr)    # for working with data frames
library(ggplot2)  # for plotting
library(reshape2)
library(RColorBrewer)


RD <- c("1916-06-30", "1884-10-30", 
        "1905-05-10", "1905-05-10",
        "1905-05-10", "1974-08-02",
        "1933-08-25", "1902-06-30", 
        "2009-07-30", "2009-07-30")

lat <- c(47.10483, 47.10483, 47.10483,
         47.10483, 47.10483, 47.10483,
         47.33486, 47.33486, 47.33486, 47.33486)

long <- c(-121.1577, -121.2309, -121.0622,
          -121.3069, -121.2470, -121.2208,
          -121.2534, -121.0608, -121.2736,
          -120.9735)

WRS <- c("surfaceWater", "surfaceWater", "surfaceWater", 
         "surfaceWater", "surfaceWater", "surfaceWater", 
         "groundwater", "groundwater", "groundwater",
         "groundwater")


spatial_wtr_right = data.table(right_date = RD,
                  lat = lat,
                  long = long,
                  WaRecRCWCl = WRS
                  )
spatial_wtr_right$popup <- 1

spatial_wtr_right$color <- "#ffff00"

######## Server.R
shinyServer(function(input, output, session) {

  observe({
       water_resource <- input$WaRecRCWCl
       if (water_resource == "surfaceWater") {
           curr_spatial <- spatial_wtr_right %>% 
                           filter(WaRecRCWCl == "surfaceWater")
           curr_spatial <- data.table(curr_spatial)

           } else if (water_resource == "groundwater"){
            curr_spatial <- spatial_wtr_right %>% 
                            filter(WaRecRCWCl == "groundwater")
            curr_spatial <- data.table(curr_spatial)

           } else if (water_resource == "both_water_resource") {
            curr_spatial <- spatial_wtr_right %>% 
                            filter(WaRecRCWCl %in% c("surfaceWater", 
                                                     "groundwater")
                                  )
            curr_spatial <- data.table(curr_spatial)
       }

      target_date <- as.Date(input$cut_date)
      curr_spatial[, color := ifelse(right_date < target_date, 
                                     "#FF3333", "#0080FF")]
      # curr_spatial[right_date < target_date, color := "#FF3333"]
      # curr_spatial[right_date >= target_date, color := "#0080FF"]

      leafletProxy("a_map", data = curr_spatial) %>%
      clearShapes() %>%
      addCircleMarkers(data = curr_spatial, 
                       lng = ~long, lat = ~lat,
                       label = ~ popup,
                       layerId = ~ location,
                       radius = 3,
                       color = ~ color,
                       stroke  = FALSE,
                       fillOpacity = .95 
                       )
  })

  output$a_map <- renderLeaflet({
     leaflet() %>%
     addTiles(urlTemplate = "http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}",
              attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>',
              layerId = "Satellite",
              options= providerTileOptions(opacity = 0.9)) %>%

     setView(lat = 47, lng = -120, zoom = 7)
  })

})

########## ui.R
navbarPage(title = div(""),
           id="nav", 
           windowTitle = "Q",
           #
           tabPanel(tags$b("Q"),
                    div(class="outer",
                        tags$head(includeCSS("styles.css")),
                        leafletOutput("a_map", width="100%", height="100%"),
                        absolutePanel(id = "controls", 
                                      class = "panel panel-default", 
                                      fixed = TRUE,
                                      draggable = TRUE, 
                                      top = 60, right = 20,
                                      left = "auto", bottom = "auto",
                                      width = 330, height = "auto",

                                      h4("Earlier in red, later in blue"),
                                      sliderInput(inputId = "cut_date",
                                                  label = "Dates:",
                                                  min = as.Date("1800-01-01","%Y-%m-%d"),
                                                  max = as.Date("2015-12-30","%Y-%m-%d"),
                                                  value=as.Date("1800-01-01"),
                                                  timeFormat="%Y-%m-%d"),

                                      selectInput(inputId = "WaRecRCWCl", 
                                                  label = "Water Resource", 
                                                  choices = c("Surface Water" = "surfaceWater",
                                                              "Ground Water" = "groundwater",
                                                              "Both" = "both_water_resource"), 
                                                  selected = "both_water_resource")

                        )
                    )
           )

)

樣式文件

input[type="number"] { max-width: 80%; } div.outer { //margin-top: 60px; margin-top: 10px; position: fixed; top: 41px; left: 0; right: 0; bottom: 0; overflow: hidden; padding: 0; } /* Customize fonts */ body, label, input, button, select { font-family: Helvetica; //'Helvetica Neue', Helvetica; font-weight: 200; font-size: 15px; } h1, h2, h3, h4 { font-weight: 400; } #controls { /* Appearance */ background-color: white; padding: 0 20px 20px 20px; cursor: move; /* Fade out while not hovering */ opacity: 0.75; zoom: 0.9; transition: opacity 500ms 1s; } #controls:hover { /* Fade in while hovering */ opacity: 0.95; transition-delay: 0; } /* Position and style citation */ #cite { position: absolute; bottom: 10px; left: 10px; font-size: 12px; } /* If not using map tiles, show a white background */ .leaflet-container { background-color: white !important; } .leaflet-control-layers-expanded .leaflet-control-layers-list { font-size: 20px; padding: 12px 20px 12px 12px; } #map-css { margin-top: 60px; // adding this new css attribute to the updated map view } //.leaflet-control-layers .leaflet-control-layers-expanded .leaflet-control { //.leaflet-top .leaflet-control { // top: 20px; // margin-top: 20px; //}

---

沒有observe/reactive 的另一個版本的代碼：

 # Water Rights library(scales) library(lattice) library(jsonlite) library(raster) library(data.table) library(shiny) library(shinydashboard) library(shinyBS) library(maps) library(rgdal) # for readOGR and others library(sp) # for spatial objects library(leaflet) # for interactive maps (NOT leafletR here) library(dplyr) # for working with data frames library(ggplot2) # for plotting library(reshape2) library(RColorBrewer) ###################################################### RD <- c("1916-06-30", "1884-10-30", "1905-05-10", "1903-05-10", "1902-05-10", "1974-08-02", "1933-08-25", "1901-06-30", "2010-07-30", "2009-07-30") lat <- c(47.10483, 47.10483, 47.10483, 47.10483, 47.10483, 47.10483, 47.33486, 47.33486, 47.33486, 47.33486) long <- c(-120.8522, -121.0577, -121.1509,-121.2570, -121.3508, -121.4569, -120.8522, -121.0577, -121.1509,-121.2570) WRS <- c("surfaceWater", "surfaceWater", "surfaceWater", "surfaceWater", "surfaceWater", "surfaceWater", "groundwater", "groundwater", "groundwater", "groundwater") spatial_wtr_right = data.table(right_date = RD, lat = lat, long = long, WaRecRCWCl = WRS ) spatial_wtr_right$popup <- 1 spatial_wtr_right$colorr <- "#ffff00" spatial_wtr_right_surface <- spatial_wtr_right %>% filter(WaRecRCWCl == "surfaceWater") %>% data.table() spatial_wtr_right_ground <- spatial_wtr_right %>% filter(WaRecRCWCl == "groundwater") %>% data.table() spatial_wtr_right_both <- spatial_wtr_right %>% data.table() shinyServer(function(input, output, session) { output$water_right_map <- renderLeaflet({ target_date <- as.Date(input$cut_date) water_resource <- input$water_source_type if (water_resource == "surfaceWater") { curr_spatial <- spatial_wtr_right_surface print ("surface") } else if (water_resource == "groundwater"){ curr_spatial <- spatial_wtr_right_ground print ("ground") } else if (water_resource == "both_water_resource") { curr_spatial <- spatial_wtr_right_both print ("both") } curr_spatial[, colorr := ifelse(right_date < target_date, "#FF3333", "#0080FF")] print(curr_spatial) leaflet() %>% addTiles(urlTemplate = "http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}", attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>', layerId = "Satellite", options= providerTileOptions(opacity = 0.9)) %>% setView(lat = 47, lng = -120, zoom = 7) %>% addCircleMarkers(data = curr_spatial, lng = ~long, lat = ~lat, label = ~ popup, layerId = ~ location, radius = 3, color = ~ colorr, stroke = FALSE, fillOpacity = .95 ) }) }) # Water Rights # library(leaflet) # library(shinyBS) # library(shiny) # library(plotly) # library(shinydashboard) navbarPage(title = div(""), id="nav", windowTitle = "Q", # tabPanel(tags$b("Q"), div(class="outer", tags$head(includeCSS("styles.css")), leafletOutput("water_right_map", width="100%", height="100%"), absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE, draggable = TRUE, top = 60, right = 20, left = "auto", bottom = "auto", width = 330, height = "auto", h4("Earlier in red, later in blue"), sliderInput(inputId = "cut_date", label = "Dates:", min = as.Date("1800-01-01","%Y-%m-%d"), max = as.Date("2015-12-30","%Y-%m-%d"), value=as.Date("1800-01-01"), timeFormat="%Y-%m-%d"), selectInput(inputId = "water_source_type", label = "Water Resource", choices = c("Surface Water" = "surfaceWater", "Ground Water" = "groundwater", "Both" = "both_water_resource"), selected = "both_water_resource") ) ) ) )

Answer 1

location 不是空間數據表的一列，addCircleMarkers 中的 layerId = ~ location 搞砸了！！！！