r-闪亮的服务器选择输入

Question

A bunch of points are being shown on a map. There are two types of water sources. I want to be able to just show the points associated with one source, or the other or both.

When water resource is chosen to be both, not all points are shown. Why is that? what is wrong with it?

That is all the question and explanation, however, stackoverflow is asking me to explain more and this is mostly code. So, I am just typing stuff in here so that stackoverflow lets me to post the question.

# 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")

                        )
                    )
           )

)

style.css

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; //}

---

Another version of the code without 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 搞砸了！！！！