updatePickerInput 不响应反应数据
updatePickerInput does not respond to reactive data
我正在组装一个 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)
放一些 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))
}
我正在组装一个 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)
放一些 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))
}