Shiny 中的级联变量选择

Question

在我下面的闪亮示例中，我有 3 个变量（Project、Stand 和 ID_Unique）。我希望当我 select Project 时，变量 Stand 和 ID_Unique 只会包含在 Project 中制作的 selection 中在输入中。这是我的详细示例：

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


# 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(
      uiOutput("selectedvariable0"),
      uiOutput("selectedvariable1"),
      uiOutput("selectedvariable2"),
    ),
      mainPanel(
        textOutput("idSaida"),
        fluidRow(
          splitLayout(plotOutput("myplot"))),
        dateInput(inputId = "Dates selection", label = "Time"),
        leafletOutput("map") 
      )
    )
  )
  
  server <- function(input, output, session){
    
    
    output$selectedvariable0 <- renderUI({
      selectInput("selectedvariable0",
                  label = "PROJECT",
                  choices = unique(stands_ds$PROJECT),
                  selected = TRUE )
    })
    
    data2 <- reactive({
      req(input$selectedvariable0)
      data2 <- subset(stands_ds, PROJECT %in% input$selectedvariable0)
    }) 
    
    output$selectedvariable1 <- renderUI({ 
      req(data2())
      selectInput("selectedvariable1",
                  label = "STAND",
                  choices = unique(data2()$CD_TALHAO),
                  selected = TRUE )
    })
    
    data3 <- reactive({
      req(input$selectedvariable2,data2())
      data3 <- subset(data2(), CD_TALHAO %in% input$selectedvariable1)
    })  
    
    output$selectedvariable2 <- renderUI({  
      req(data3())
      selectInput("selectedvariable2",
                  label = "ID UNIQUE",
                  choices = unique(data2()$ID_UNIQUE),  ##  use data3() instead of data2(), if you wish to subset from data3()
                  selected = TRUE )
    })
    
    currentvariable0 <- reactive({input$selectedvariable0})
    currentvariable1 <- reactive({input$selectedvariable1})
    currentvariable2 <- reactive({input$selectedvariable2})
    
    
    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)
  ##

拜托，任何帮助，因为只有两个反应变量（selectedvariable0 和 selectedvariable1）工作得很好，我的情节也不起作用。

Answer 1

也感谢@YBS 和 Wickham 的 Mastering Shiny！！问题已解决：

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


# 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", "Type", choices = unique(stands_ds$PEST), selected = TRUE),
      selectInput(inputId = "selectedvariable1", "Date", choices = NULL),
      selectInput(inputId = "selectedvariable2", "Project",choices = NULL),
      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, session){

  currentvariable3 <- reactive({input$selectedvariable3})
  currentvariable4 <- reactive({input$selectedvariable4})  

  selectedvariable0 <- reactive({
    filter(stands_ds, PEST == input$selectedvariable0)
  })
  observeEvent(selectedvariable0(), {
    choices <- unique(selectedvariable0()$DATA_S2)
    updateSelectInput(inputId = "selectedvariable1", choices = choices) 
  })
  
  selectedvariable1 <- reactive({
    req(input$selectedvariable1)
    filter(selectedvariable0(), DATA_S2 == as.Date(input$selectedvariable1))
  })
  observeEvent(selectedvariable1(), {
    choices <- unique(selectedvariable1()$PROJETO)
    updateSelectInput(inputId = "selectedvariable2", choices = choices)
  })
  
  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)
##

Shiny 中的级联变量选择

Cascade variable selection in Shiny

r

shiny

shiny-reactivity