与 sf 结合闪亮的非反应性地图

Question

我想通过列名称选择使地图闪亮 (PEST, DATA_S, PROJETO, CD_TALHAO, ID_UNIQUE)，但我不知道为什么函数 subset 不响应 reactive选择。请问有什么想法吗？

当我在示例中尝试时：

# Packages
library(rgdal)
library(shiny)
library(leaflet)
library(leaflet.providers)
library(ggplot2)
library(shinythemes)
library(sf)


# get AOI
download.file(
  "https://github.com/Leprechault/trash/raw/main/stands_example.zip",
  zip_path <- tempfile(fileext = ".zip")
)
unzip(zip_path, exdir = tempdir())

# Open the files
setwd(tempdir())
stands_extent <- readOGR(".", "stands_target") # Border
stands_ds <- read.csv("pred_target_stands.csv", sep=";") # Data set


# Create the shiny dash
ui <- fluidPage(
  theme = shinytheme("cosmo"),
  titlePanel(title="My Map Dashboard"),  
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "selectedvariable0",
                  label = "Type", 
                  choices = c(unique(stands_ds$PEST)),selected = TRUE ), 
      selectInput(inputId = "selectedvariable1",
                  label = "Date", 
                  choices = c(unique(stands_ds$DATA_S)),selected = TRUE ), 
      selectInput(inputId = "selectedvariable2",
                  label = "Project", 
                  choices = c(unique(stands_ds$PROJETO)),selected = TRUE ),
      selectInput(inputId = "selectedvariable3",
                  label = "Stand", 
                  choices = c(unique(stands_ds$CD_TALHAO)),selected = TRUE),
      selectInput(inputId = "selectedvariable4",
                  label = "Unique ID", 
                  choices = c(unique(stands_ds$ID_UNIQUE)),selected = TRUE)      
    ),
    mainPanel(
      textOutput("idSaida"),
      fluidRow(
        splitLayout(plotOutput("myplot"))),
      dateInput(inputId = "Dates selection", label = "Time"),
      leafletOutput("map") 
    )
  )
)
server <- function(input, output){
  
  currentvariable0 <- reactive({input$selectedvariable0})
  currentvariable1 <- reactive({input$selectedvariable1})
  currentvariable2 <- reactive({input$selectedvariable2})
  currentvariable3 <- reactive({input$selectedvariable3})
  currentvariable4 <- reactive({input$selectedvariable4})
  
  output$myplot <- renderPlot({
    
    #Subset stand
    stands_sel <- subset(stands_extent, stands_extent@data$UNIQUE==currentvariable4())
    
    #Subset for input$var and assign this subset to new object, "fbar"
    ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
    
    #Create a map
    polys <- st_as_sf(stands_sel)
    ggplot() +
      geom_sf(data=polys) +
      geom_point(data=ds_sel,
                 aes(x=x, y=y), color="red") +
      xlab("Longitude") + ylab("Latitude") +
      coord_sf() +
      theme_bw() +
      theme(text = element_text(size=10)) 
  })
  
  output$map <- renderLeaflet({
    lng <- ifelse(currentvariable4, mean(dfs()$x),
                  mean(subset(dfs(), Projeto %in% input$selectedvariable2y)$x)
    )
    lat <- ifelse(currentvariable4, mean(dfs()$y),
                  mean(subset(dfs(), Projeto %in% input$selectedvariable2)$y)
    )
    leaflet() %>%
      setView(lng = lng, lat = lat, zoom=16) %>%
      addProviderTiles(providers$Esri.WorldImagery,
                       options = providerTileOptions(time = input$selected_date)) %>%                   
      addMarkers(lng=x, lat=y, popup="Location")
    
  })   
}
shinyApp(ui, server)
#

我的输出是：

Listening on http://127.0.0.1:5861
Warning: Error in FUN: object 'x' not find
  183: FUN
  182: lapply
  181: scales_add_defaults
  180: f
  179: l$compute_aesthetics
  178: f
  177: by_layer
  176: ggplot_build.ggplot
  174: print.ggplot
  166: func
  164: f
  163: Reduce
  154: do
  153: hybrid_chain
  125: drawPlot
  111: <reactive:plotObj>
   95: drawReactive
   82: renderFunc
   81: output$myplot
    1: runApp
Warning: Error in as.logical: cannot coerce type 'closure' to vector of type 'logical'
  97: ifelse
  96: htmlwidgets::shinyRenderWidget [C:/Users/fores/Desktop/forestcloud/ATshiny_dash_ForestCloud2.R#84]
  95: func
  82: renderFunc
  81: output$map
   1: runApp
Warning: Error in FUN: object 'x' not find
  183: FUN
  182: lapply
  181: scales_add_defaults
  180: f
  179: l$compute_aesthetics
  178: f
  177: by_layer
  176: ggplot_build.ggplot
  174: print.ggplot
  166: func
  164: f
  163: Reduce
  154: do
  153: hybrid_chain
  125: drawPlot
  111: <reactive:plotObj>
   95: drawReactive
   82: renderFunc
   81: output$myplot
    1: runApp

Answer 1

感谢@HubertL 的指点，问题已解决！！解决方案是：

# Packages
library(rgdal)
library(shiny)
library(leaflet)
library(leaflet.providers)
library(ggplot2)
library(shinythemes)
library(sf)
library(lubridate)


# get AOI
download.file(
  "https://github.com/Leprechault/trash/raw/main/stands_example.zip",
  zip_path <- tempfile(fileext = ".zip")
)
unzip(zip_path, exdir = tempdir())

# Open the files
setwd(tempdir())
stands_extent <- readOGR(".", "stands_target") # Border
stands_ds <- read.csv("pred_target_stands.csv", sep=";") # Data set
stands_ds <- stands_ds %>%
  mutate(DATA_S2 = ymd(DATA_S2))

# Create the shiny dash
ui <- fluidPage(
  theme = shinytheme("cosmo"),
  titlePanel(title="My Map Dashboard"),  
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "selectedvariable0",
                  label = "Type", 
                  choices = c(unique(stands_ds$PEST)),selected = TRUE ), 
      selectInput(inputId = "selectedvariable1",
                  label = "Date", 
                  choices = c(unique(stands_ds$DATA_S)),selected = TRUE ), 
      selectInput(inputId = "selectedvariable2",
                  label = "Project", 
                  choices = c(unique(stands_ds$PROJETO)),selected = TRUE ),
      selectInput(inputId = "selectedvariable3",
                  label = "Stand", 
                  choices = c(unique(stands_ds$CD_TALHAO)),selected = TRUE),
      selectInput(inputId = "selectedvariable4",
                  label = "Unique ID", 
                  choices = c(unique(stands_ds$ID_UNIQUE)),selected = TRUE)      
    ),
    mainPanel(
      textOutput("idSaida"),
      fluidRow(
        splitLayout(plotOutput("myplot"))),
      dateInput(inputId = "Dates selection", label = "Time"),
      leafletOutput("map") 
    )
  )
)
server <- function(input, output){
  
  currentvariable0 <- reactive({input$selectedvariable0})
  currentvariable1 <- reactive({input$selectedvariable1})
  currentvariable2 <- reactive({input$selectedvariable2})
  currentvariable3 <- reactive({input$selectedvariable3})
  currentvariable4 <- reactive({input$selectedvariable4})
  
  output$myplot <- renderPlot({
    
    #Subset stand
    stands_sel <- subset(stands_extent, stands_extent@data$ID_UNIQUE==currentvariable4())
    
    #Subset for input$var and assign this subset to new object, "fbar"
    ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
    
    #Create a map
    polys <- st_as_sf(stands_sel)
    ggplot() +
      geom_sf(data=polys) +
      geom_point(data=ds_sel,
                 aes(x=X, y=Y), color="red") +
      xlab("Longitude") + ylab("Latitude") +
      coord_sf() +
      theme_bw() +
      theme(text = element_text(size=10)) 
  })
  
  output$map <- renderLeaflet({
    
    stands_actual<-stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
    lng <- mean(stands_actual$X)
    lat <- mean(stands_actual$Y)
    
    leaflet() %>%
      setView(lng = lng, lat = lat, zoom=17) %>%
      addProviderTiles(providers$Esri.WorldImagery) %>%                   
      addMarkers(lng=stands_actual$X, lat=stands_actual$Y, popup="Location")
    
  })   
}
shinyApp(ui, server)
##

与 sf 结合闪亮的非反应性地图

Not reactive maps in shiny combinig with sf

maps

r

shiny

shiny-reactivity

sf