如何将操作按钮和其他反应性输入发送到 R Shiny 代码的模块服务器部分？

Question

下面发布的代码可以工作，但我在为指定的服务器部分创建命名空间模块时遇到问题。我希望将嵌套在

# START HERE

和

# END HERE

注释之间的服务器代码移至模块

mod1

的服务器部分。我注释掉了我通常使用的模块代码的形式。我不确定如何将操作按钮触发器发送到模块，以及如何让此代码以模块形式工作，就像以非模块形式工作一样。谁能展示如何做到这一点？

library(rhandsontable)
library(shiny)

seriesGenTrm <- data.frame('Series_1' = c(1), row.names = c("Input_1"))

calc <- function(x) {
  x <- max(x, 1)
  Sys.sleep(x)
  result <- x * 2
  result <- data.frame(c(x, result))
  result
}

ui <- fluidPage(
  rHandsontableOutput('hottable_1'), br(),
  actionButton("addSeries", "Add series"),
  actionButton("calculate", "Calculate"),
  tableOutput("alloc_tbl")
  # mod1_ui("mod1")
)

server <- function(input, output, session) {
  seriesTbl_1 <- reactiveVal(seriesGenTrm)
  
  observeEvent(input$hottable_1, {
    seriesTbl_1(hot_to_r(input$hottable_1))
  })
  
  output$hottable_1 <- renderRHandsontable({
    rhandsontable(
      data.frame(seriesTbl_1(), check.names = FALSE),
      rowHeaderWidth = 100
    )
  })
  
  # START HERE for code to send to mod1
  observeEvent(input$addSeries, {
    newSeriesCol_1 <- data.frame(c(1))
    names(newSeriesCol_1) <- paste0("Series_", ncol(hot_to_r(input$hottable_1)) + 1)
    seriesTbl_1(cbind(seriesTbl_1(), newSeriesCol_1))
  })
  
  addCol <- function(allocData, columnName, seriesTbl_1) {
    allocData[[columnName]] <-
      calc(seriesTbl_1()[1, colnames(seriesTbl_1()) == columnName])
    return(allocData)
  }
  
  allocData <- reactiveVal(data.frame(Row = 1:2, Input_1 = c(1, 2)))
  
  observeEvent(input$calculate, {
    allocDataTmp <- data.frame(Row = 1:2)
    for (colName in colnames(seriesTbl_1())) {
      allocDataTmp <- addCol(allocDataTmp, colName, seriesTbl_1)
    }
    allocData(allocDataTmp)
  })
  
  output$alloc_tbl <- renderTable({allocData()})
  # END HERE for code to send to mod1      
}

shinyApp(ui, server)

Answer 1

下面是OP代码的模块化。我做了很多评论标记

#

解释了OP的变化，对于像我这样试图理解命名空间模块化的新手。

library(rhandsontable)
library(shiny)

seriesGenTrm <- data.frame('Series_1' = c(1), row.names = c("Input_1"))

calc <- function(x) {
  x <- max(x, 1)
  Sys.sleep(x)
  result <- x * 2
  result <- data.frame(c(x, result))
  result
}

# Move UI items from OP to this module ui
mod1_ui <- function(id) {
  ns <- NS(id) 
  list( # use list to contain module UI items; same ones from OP with noted changes
    actionButton(ns("calculate"), "Calculate"),  # note the namespace ns()
    tableOutput(ns("alloc_tbl"))                 # note the namespace ns()
  )
}

# Same as server section in OP; note use of "common$" which links reactives from main App
mod1_server <- function(id, common, input) {
  moduleServer(id, function(input, output, session) {
    # seriesTbl_1 <- reactiveVal(seriesGenTrm)
    
    addCol <- function(allocData, columnName, seriesTbl_1) {
      allocData[[columnName]] <-
        calc(common$seriesTbl_1()[1, colnames(common$seriesTbl_1()) == columnName])
      return(allocData)
    }
    
    allocData <- reactiveVal(data.frame(Row = 1:2, Input_1 = c(1, 2)))
    
    observeEvent(input$calculate, {
      allocDataTmp <- data.frame(Row = 1:2)
      for (colName in colnames(common$seriesTbl_1())) {
        allocDataTmp <- addCol(allocDataTmp, colName, common$seriesTbl_1())
      }
      allocData(allocDataTmp)
    })
    
    output$alloc_tbl <- renderTable({allocData()})
  })
}

# Main App
ui <- fluidPage(
  mainPanel(
    rHandsontableOutput('hottable_1'), br(), # remains in Main App, same as OP
    actionButton("addSeries", "Add series"), 
    mod1_ui("mod1") # pulls in UI from module mod1
  )
)

# Most server items moved from server section of OP main App to module mod1
server <- function(input, output, session) {
  seriesTbl_1 <- reactiveVal(seriesGenTrm)
  
  observeEvent(input$hottable_1, {
    seriesTbl_1(hot_to_r(input$hottable_1))
  })
  
  output$hottable_1 <- renderRHandsontable({
    rhandsontable(
      data.frame(seriesTbl_1(), check.names = FALSE),
      rowHeaderWidth = 100
    )
  })
  
  observeEvent(input$addSeries, {
    newSeriesCol_1 <- data.frame(c(1))
    names(newSeriesCol_1) <- paste0("Series_", ncol(hot_to_r(input$hottable_1)) + 1)
    seriesTbl_1(cbind(seriesTbl_1(), newSeriesCol_1))
  })
  
  # Below added so main App server can communicate with module mod1
  common <- reactiveValues(
    sharedValue = 0,
    seriesTbl_1 = reactive(seriesTbl_1())
  )
  mod1_server("mod1", common, input)
}

shinyApp(ui, server)