是否可以从另一个模块引用命名空间？

Question

我想从第二个服务器模块mod_btn_server2 引用命名空间ns("map")。该模块嵌套在第一个服务器模块mod_btn_server1 中。当我单击“按钮 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)

Answer 1

正如我在上面的评论中提到的，规范的方法是将按钮推送捕获为模块 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)

这是一个更规范的形式，它适用于模块的正确输入/输出，并且不会与命名空间混淆：

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)