是否可以从另一个模块引用命名空间?
Is it possible to refer to namespace from another module?
我想从第二个服务器模块 mod_btn_server2
引用命名空间 ns("map")
。该模块嵌套在第一个服务器模块 mod_btn_server1
中。当我单击 'Button 2' 点时,地图上应该会显示点,但实际上并没有。是否可以从嵌套模块中引用 "map"
?
这是工作示例:
library(shiny)
library(mapboxer)
library(dplyr)
library(sf)
library(leaflet)
moduleServer <- function(id, module) {
callModule(module, id)
}
# UI 1 #
mod_btn_UI1 <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("btn1"), "Button 1"),
mod_btn_UI2(ns("moduleServer2")),
leafletOutput(ns("map"))
)
}
# Server 1 #
mod_btn_server1 <- function(id){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
coords <- quakes %>%
sf::st_as_sf(coords = c("long","lat"), crs = 4326)
mod_btn_server2("moduleServer2", coords) # here is nested module2
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = coords,
stroke = FALSE,
radius = 6)
})
observeEvent(input$btn1, {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles()
})
})
}
# Module 2 - UI #
mod_btn_UI2 <- function(id){
ns <- NS(id)
actionButton(ns("btn2"), "Button 2"),
}
# Module 2 - server #
mod_btn_server2 <- function(id, dataMod){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = dataMod,
stroke = TRUE,
color = "red",
radius = 6)
})
# and here I refer to 'map' located in the first module
observeEvent(input$btn2, {
leaflet::leafletProxy("map", data = dataMod) %>%
leaflet::addCircles()
})
})
}
# App #
ui <- fluidPage(
tagList(
mod_btn_UI1("test-btn"))
)
server <- function(input, output, session) {
mod_btn_server1("test-btn")
}
shinyApp(ui = ui, server = server)
正如我在上面的评论中提到的,规范的方法是将按钮按下捕获为模块 moduleServer2
的输出,并将其用作执行操作的 test-btn
的输入.
但是,如果你想自己搞乱命名空间(不推荐),你可以使用以下解决方案。我不得不调整 leafletProxy
函数,因为正常的实现会自动添加调用模块的名称空间。这是你不想要的,因为你想使用不同模块的命名空间。
现在代码已适应编辑:
library(shiny)
library(mapboxer)
library(dplyr)
library(sf)
library(leaflet)
leafletProxy2 <- function (mapId, session = shiny::getDefaultReactiveDomain(),
data = NULL, deferUntilFlush = TRUE)
{
if (is.null(session)) {
stop("leafletProxy must be called from the server function of a Shiny app")
}
structure(list(session = session, id = mapId, x = structure(list(),
leafletData = data), deferUntilFlush = deferUntilFlush,
dependencies = NULL), class = "leaflet_proxy")
}
# UI 1 #
mod_btn_UI1 <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("btn1"), "Button 1"),
mod_btn_UI2(ns("moduleServer2")),
leafletOutput(ns("map"))
)
}
# Server 1 #
mod_btn_server1 <- function(id){
moduleServer(id, function(input, output, session) {
coords <- quakes %>%
sf::st_as_sf(coords = c("long","lat"), crs = 4326)
mod_btn_server2("moduleServer2", coords) # here is nested module2
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = coords,
stroke = FALSE,
radius = 6)
})
observeEvent(input$btn1, {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles()
})
})
}
# Module 2 - UI #
mod_btn_UI2 <- function(id){
ns <- NS(id)
actionButton(ns("btn2"), "Button 2")
}
# Module 2 - server #
mod_btn_server2 <- function(id, dataMod, btn){
moduleServer(id, function(input, output, session) {
# and here I refer to 'map' located in the first module
observeEvent(input$btn2, {
leafletProxy2("test-btn-map", data = dataMod) %>%
leaflet::addCircles(stroke = TRUE,
color = "red")
})
})
}
# App #
ui <- fluidPage(
tagList(
mod_btn_UI1("test-btn"))
)
server <- function(input, output, session) {
mod_btn_server1("test-btn")
}
shinyApp(ui = ui, server = server)
这是一个更规范的形式,适用于正确的 input/output 模块并且不会混淆命名空间:
library(shiny)
library(mapboxer)
library(dplyr)
library(sf)
library(leaflet)
# UI 1 #
mod_btn_UI1 <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("btn1"), "Button 1"),
mod_btn_UI2(ns("moduleServer2")),
leafletOutput(ns("map"))
)
}
# Server 1 #
mod_btn_server1 <- function(id){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
coords <- quakes %>%
sf::st_as_sf(coords = c("long","lat"), crs = 4326)
external_btn <- mod_btn_server2("moduleServer2", coords) # here is nested module2
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = coords,
stroke = FALSE,
radius = 6)
})
observeEvent(input$btn1, {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles()
})
observeEvent(external_btn(), {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles(stroke = TRUE,
color = "red")
})
})
}
# Module 2 - UI #
mod_btn_UI2 <- function(id){
ns <- NS(id)
actionButton(ns("btn2"), "Button 2")
}
# Module 2 - server #
mod_btn_server2 <- function(id, dataMod){
moduleServer(id, function(input, output, session) {
return(reactive(input$btn2))
})
}
# App #
ui <- fluidPage(
tagList(
mod_btn_UI1("test-btn"))
)
server <- function(input, output, session) {
mod_btn_server1("test-btn")
}
shinyApp(ui = ui, server = server)
我想从第二个服务器模块 mod_btn_server2
引用命名空间 ns("map")
。该模块嵌套在第一个服务器模块 mod_btn_server1
中。当我单击 'Button 2' 点时,地图上应该会显示点,但实际上并没有。是否可以从嵌套模块中引用 "map"
?
这是工作示例:
library(shiny)
library(mapboxer)
library(dplyr)
library(sf)
library(leaflet)
moduleServer <- function(id, module) {
callModule(module, id)
}
# UI 1 #
mod_btn_UI1 <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("btn1"), "Button 1"),
mod_btn_UI2(ns("moduleServer2")),
leafletOutput(ns("map"))
)
}
# Server 1 #
mod_btn_server1 <- function(id){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
coords <- quakes %>%
sf::st_as_sf(coords = c("long","lat"), crs = 4326)
mod_btn_server2("moduleServer2", coords) # here is nested module2
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = coords,
stroke = FALSE,
radius = 6)
})
observeEvent(input$btn1, {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles()
})
})
}
# Module 2 - UI #
mod_btn_UI2 <- function(id){
ns <- NS(id)
actionButton(ns("btn2"), "Button 2"),
}
# Module 2 - server #
mod_btn_server2 <- function(id, dataMod){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = dataMod,
stroke = TRUE,
color = "red",
radius = 6)
})
# and here I refer to 'map' located in the first module
observeEvent(input$btn2, {
leaflet::leafletProxy("map", data = dataMod) %>%
leaflet::addCircles()
})
})
}
# App #
ui <- fluidPage(
tagList(
mod_btn_UI1("test-btn"))
)
server <- function(input, output, session) {
mod_btn_server1("test-btn")
}
shinyApp(ui = ui, server = server)
正如我在上面的评论中提到的,规范的方法是将按钮按下捕获为模块 moduleServer2
的输出,并将其用作执行操作的 test-btn
的输入.
但是,如果你想自己搞乱命名空间(不推荐),你可以使用以下解决方案。我不得不调整 leafletProxy
函数,因为正常的实现会自动添加调用模块的名称空间。这是你不想要的,因为你想使用不同模块的命名空间。
现在代码已适应编辑:
library(shiny)
library(mapboxer)
library(dplyr)
library(sf)
library(leaflet)
leafletProxy2 <- function (mapId, session = shiny::getDefaultReactiveDomain(),
data = NULL, deferUntilFlush = TRUE)
{
if (is.null(session)) {
stop("leafletProxy must be called from the server function of a Shiny app")
}
structure(list(session = session, id = mapId, x = structure(list(),
leafletData = data), deferUntilFlush = deferUntilFlush,
dependencies = NULL), class = "leaflet_proxy")
}
# UI 1 #
mod_btn_UI1 <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("btn1"), "Button 1"),
mod_btn_UI2(ns("moduleServer2")),
leafletOutput(ns("map"))
)
}
# Server 1 #
mod_btn_server1 <- function(id){
moduleServer(id, function(input, output, session) {
coords <- quakes %>%
sf::st_as_sf(coords = c("long","lat"), crs = 4326)
mod_btn_server2("moduleServer2", coords) # here is nested module2
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = coords,
stroke = FALSE,
radius = 6)
})
observeEvent(input$btn1, {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles()
})
})
}
# Module 2 - UI #
mod_btn_UI2 <- function(id){
ns <- NS(id)
actionButton(ns("btn2"), "Button 2")
}
# Module 2 - server #
mod_btn_server2 <- function(id, dataMod, btn){
moduleServer(id, function(input, output, session) {
# and here I refer to 'map' located in the first module
observeEvent(input$btn2, {
leafletProxy2("test-btn-map", data = dataMod) %>%
leaflet::addCircles(stroke = TRUE,
color = "red")
})
})
}
# App #
ui <- fluidPage(
tagList(
mod_btn_UI1("test-btn"))
)
server <- function(input, output, session) {
mod_btn_server1("test-btn")
}
shinyApp(ui = ui, server = server)
这是一个更规范的形式,适用于正确的 input/output 模块并且不会混淆命名空间:
library(shiny)
library(mapboxer)
library(dplyr)
library(sf)
library(leaflet)
# UI 1 #
mod_btn_UI1 <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("btn1"), "Button 1"),
mod_btn_UI2(ns("moduleServer2")),
leafletOutput(ns("map"))
)
}
# Server 1 #
mod_btn_server1 <- function(id){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
coords <- quakes %>%
sf::st_as_sf(coords = c("long","lat"), crs = 4326)
external_btn <- mod_btn_server2("moduleServer2", coords) # here is nested module2
output$map <- leaflet::renderLeaflet({
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::setView(172.972965,-35.377261, zoom = 4) %>%
leaflet::addCircleMarkers(
data = coords,
stroke = FALSE,
radius = 6)
})
observeEvent(input$btn1, {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles()
})
observeEvent(external_btn(), {
leaflet::leafletProxy("map", data = coords) %>%
leaflet::addCircles(stroke = TRUE,
color = "red")
})
})
}
# Module 2 - UI #
mod_btn_UI2 <- function(id){
ns <- NS(id)
actionButton(ns("btn2"), "Button 2")
}
# Module 2 - server #
mod_btn_server2 <- function(id, dataMod){
moduleServer(id, function(input, output, session) {
return(reactive(input$btn2))
})
}
# App #
ui <- fluidPage(
tagList(
mod_btn_UI1("test-btn"))
)
server <- function(input, output, session) {
mod_btn_server1("test-btn")
}
shinyApp(ui = ui, server = server)