r语言 - updatePickerInput不响应响应性数据

Question

我正在制作一个Shiny应用程序，允许用户上传感兴趣的区域(AOI)，并计算与管理边界(WMU)的重叠量。一切工作如预期，除了我的选择器输入选项不更新。选择器输入可以工作，但是我希望选择只包括与AOI重叠的WMU，而不是所有可能的WMU。我可以计算应该填充列表的WMU ID，如地图框架下面的"test_text"输出所示，但不能成功更新pickerInput。这个kmz将与下面脚本开头加载的几个WMU重叠:

library(shiny)
library(sf)
library(tidyverse)
library(bcdata)
library(shinyjs)
library(leaflet)
library(mapview)
library(DT)
library(pals)
library(shinyWidgets)
library(shinymanager)


WMU_DATA <-
bcdc_get_data("wildlife-management-units") %>% st_transform(4326) %>% mutate(Total.WMU.HA =
           as.numeric(st_area(.)) / 10000)

##### UI #####
ui <- fluidPage(
tags$head(tags$style(
HTML(
".shiny-notification {
height: 100px;
width: 400px;
position:fixed;
top: calc(25% - 50px);;
left: calc(50% - 200px);;
}
"
)
)),

# Application title
titlePanel("Calculate Overlap With WMU"),

# Inputs
sidebarLayout(
sidebarPanel(
width = 3,

textInput(
inputId = "AOI_NAME",
label = "AOI Name",
value = NULL
),
HTML("<br><br>"),
fileInput(
inputId = "KMZ",
label = "Choose KMZ",
multiple = FALSE,
accept = c('.kmz')
),
h3("or"),
HTML("<br><br>"),
fileInput(
inputId = "SHAPEFILE",
label = "Choose shapefile",
multiple = TRUE,
accept = c('.shp', '.dbf', '.sbn', '.sbx', '.shx', '.prj', '.xml')
),

pickerInput(
inputId = "WMU_FILTER",
label = "Filter Overlapping WMU",
choices = unique(WMU_DATA$WILDLIFE_MGMT_UNIT_ID),
selected = unique(WMU_DATA$WILDLIFE_MGMT_UNIT_ID),
multiple = TRUE,
options = list(`actions-box` = TRUE)
),

HTML("<br><br>")


),

# Display OUtputs
mainPanel(
width = 9,
leafletOutput("OVERLAP_MAP", height = 750),
h3(textOutput("TEST_TEXT")),
DTOutput("AOI_OVERLAP_TABLE")
)
)
)

######server#####
server <- function(input, output, session) {


####reactive data

AOI <-
reactive({
if (is.null(input$SHAPEFILE) & !is.null(input$KMZ)) {
st_read(unzip(input$KMZ$datapath)) %>%
st_zm(drop = T) %>%
mutate(AOI_NAME = input$AOI_NAME) %>%
st_transform(4326) %>%
select(-Name)
}
else if (!is.null(input$SHAPEFILE) & is.null(input$KMZ)) {
SHAPEFILE()
}
else{
return(NULL)
}
})

WMU_OVERLAP <- reactive({
st_filter(WMU_DATA, AOI())
})

AOI_WMU_INTERSECT <-
reactive({
st_intersection(AOI(), WMU_OVERLAP()) %>%
mutate(`HA of Overlap` = round(as.numeric(st_area(.)) / 10000, 0)) %>%
mutate(`Percent of WMU` = round(`HA of Overlap` / `Total.WMU.HA` *
100, 2))
})


observeEvent(AOI_WMU_INTERSECT
,
{
updatePickerInput(
session,
"WMU_FILTER",
choices =  unique(AOI_WMU_INTERSECT()$WILDLIFE_MGMT_UNIT_ID),
selected =   unique(AOI_WMU_INTERSECT()$WILDLIFE_MGMT_UNIT_ID)
)
},
ignoreInit = TRUE,
ignoreNULL = TRUE)


###outputs


output$OVERLAP_MAP <-
renderLeaflet({
withProgress(message = "Calcualting Overlap", detail = "Should be done soon", {
AOI_SPATIAL <- AOI() %>% mutate(AOI_NAME = input$AOI_NAME)

WMU <-
WMU_OVERLAP() %>% filter(WILDLIFE_MGMT_UNIT_ID %in% input$WMU_FILTER)

Overlap <-
AOI_WMU_INTERSECT() %>% filter(WILDLIFE_MGMT_UNIT_ID %in% input$WMU_FILTER)

MAP <-

mapview(
Overlap,
zcol = "WILDLIFE_MGMT_UNIT_ID",
alpha.regions = 0.2,
map.types = c("Esri.WorldTopoMap", "Esri.WorldImagery"),
col.regions = alphabet(nlevels(
as.factor(WMU$WILDLIFE_MGMT_UNIT_ID)
))
) +
mapview(
WMU,

zcol = "WILDLIFE_MGMT_UNIT_ID",
alpha.regions = 0.2,
lwd = 3,
col.regions = alphabet(nlevels(
as.factor(WMU$WILDLIFE_MGMT_UNIT_ID)
)),
hide = TRUE
) +
mapview(AOI_SPATIAL,
label = "AOI_NAME",
col.regions = "red")
MAP@map %>%
setView(st_coordinates(st_centroid(st_as_sfc(
st_bbox(AOI_SPATIAL)
)))[, 1],
st_coordinates(st_centroid(st_as_sfc(
st_bbox(AOI_SPATIAL)
)))[, 2],
zoom = 9) 
})
})


output$AOI_OVERLAP_TABLE <-
renderDT({
AOI_OVERLAP_TABLE <- AOI_WMU_INTERSECT() %>%
st_drop_geometry()

AOI_OVERLAP_TABLE

}, filter = "top", extensions = c("FixedHeader", "Buttons"),

options = list(
pageLength = 100,
fixedHeader = TRUE,
dom = "Bfrtip",
buttons = c('colvis', 'copy', 'excel', 'csv')
))

output$TEST_TEXT <-
renderText(unique(AOI_WMU_INTERSECT()$WILDLIFE_MGMT_UNIT_ID))
}
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

放一些req()，把observeEvent()改成observe()就可以了。试试这个

######server#####
server <- function(input, output, session) {

####reactive data
AOI <-
reactive({
if (is.null(input$SHAPEFILE) & !is.null(input$KMZ)) {
st_read(unzip(input$KMZ$datapath)) %>%
st_zm(drop = T) %>%
mutate(AOI_NAME = input$AOI_NAME) %>%
st_transform(4326) %>%
select(-Name)
}
else if (!is.null(input$SHAPEFILE) & is.null(input$KMZ)) {
SHAPEFILE()
}
else{
return(NULL)
}
})

WMU_OVERLAP <- reactive({
req(AOI())
st_filter(WMU_DATA, AOI())
})

AOI_WMU_INTERSECT <-
reactive({
req(AOI(), WMU_OVERLAP())
st_intersection(AOI(), WMU_OVERLAP()) %>%
dplyr::mutate(`HA of Overlap` = round(as.numeric(st_area(.)) / 10000, 0)) %>%
dplyr::mutate(`Percent of WMU` = round(`HA of Overlap` / `Total.WMU.HA` *100, 2))
})


observe({updatePickerInput(
session,
"WMU_FILTER",
choices =  unique(AOI_WMU_INTERSECT()$WILDLIFE_MGMT_UNIT_ID),
selected =   unique(AOI_WMU_INTERSECT()$WILDLIFE_MGMT_UNIT_ID)
)
} )#, ignoreInit = TRUE, ignoreNULL = TRUE)


###outputs


output$OVERLAP_MAP <-
renderLeaflet({
req(AOI_WMU_INTERSECT())
withProgress(message = "Calcualting Overlap", detail = "Should be done soon", {
AOI_SPATIAL <- AOI() %>% dplyr::mutate(AOI_NAME = input$AOI_NAME)

WMU <-
WMU_OVERLAP() %>% dplyr::filter(WILDLIFE_MGMT_UNIT_ID %in% input$WMU_FILTER)

Overlap <-
AOI_WMU_INTERSECT() %>% dplyr::filter(WILDLIFE_MGMT_UNIT_ID %in% input$WMU_FILTER)

MAP <-

mapview(
Overlap,
zcol = "WILDLIFE_MGMT_UNIT_ID",
alpha.regions = 0.2,
map.types = c("Esri.WorldTopoMap", "Esri.WorldImagery"),
col.regions = alphabet(nlevels(
as.factor(WMU$WILDLIFE_MGMT_UNIT_ID)
))
) +
mapview(
WMU,

zcol = "WILDLIFE_MGMT_UNIT_ID",
alpha.regions = 0.2,
lwd = 3,
col.regions = alphabet(nlevels(
as.factor(WMU$WILDLIFE_MGMT_UNIT_ID)
)),
hide = TRUE
) +
mapview(AOI_SPATIAL,
label = "AOI_NAME",
col.regions = "red")
MAP@map %>%
setView(st_coordinates(st_centroid(st_as_sfc(
st_bbox(AOI_SPATIAL)
)))[, 1],
st_coordinates(st_centroid(st_as_sfc(
st_bbox(AOI_SPATIAL)
)))[, 2],
zoom = 9) 
})
})


output$AOI_OVERLAP_TABLE <-
renderDT({
AOI_OVERLAP_TABLE <- AOI_WMU_INTERSECT() %>%  st_drop_geometry()

AOI_OVERLAP_TABLE

}, filter = "top", extensions = c("FixedHeader", "Buttons"),

options = list(
pageLength = 100,
fixedHeader = TRUE,
dom = "Bfrtip",
buttons = c('colvis', 'copy', 'excel', 'csv')
))

output$TEST_TEXT <- renderText(unique(AOI_WMU_INTERSECT()$WILDLIFE_MGMT_UNIT_ID))
}