R Shiny - 保存动态创建的模块的结果答案

【问题标题】：R Shiny - Saving results of dynamically created modulesR Shiny - 保存动态创建的模块的结果
【发布时间】：2021-01-13 20:58:16
【问题描述】：

我遇到了以下问题，我试图在这个最小的可重现示例中进行总结。

应用程序应该能够动态创建模块并呈现模块的 UI - 在我的示例中为 obj_UI - 在 tabsetpanel objTP 的选项卡中。每个模块都应该呈现一个objR6 类型的R6 对象。我想将生成的 R6 对象保存到名为 objCollection 的 reactiveValues 变量中，并将其显示在名为 displayValues 的 verbatimTextOutput 中。

单击input$addObject 按钮时，我收到错误消息"Error in <-: cannot add bindings to a locked environment"。我相信问题在于示例末尾的observeEvent，但无法弄清楚它是什么。

任何帮助将不胜感激！

library(shiny)
library(R6)

# Simple R6 object
objR6 <- R6::R6Class(
  "objR6",
  public = list(
    identifier = NULL,
    selected_value = NULL,

    initialize = function(identifier) {
      self$identifier <- identifier
    }
  )
)

# Module Ui
obj_UI <- function(id) {
  tagList(
    selectInput(NS(id, "value"), "Chose Value", letters)
  )
}

# Module Server
obj_Server <- function(id) {
  moduleServer(id, function(input, output, session) {

    obj <- reactiveVal(objR6$new(id))

    observeEvent(input$value, {
      newObj <- obj()$clone()
      newObj$selectec_value <- input$value
      obj(newObj)
    })


    return(reactive(obj()))

  })
}


# Shiny App
ui <- fluidPage(
  fluidPage(
    selectInput("objSelection", "Select Object",
                choices = "",
                selectize = FALSE,
                size = 10),
    actionButton("addObject", "Add Object"),
    actionButton("rmvObject", "Remove Object"),
    tabsetPanel(id = "objTP"),
    verbatimTextOutput("displayValues")
  )
)

server <- function(input, output, session) {
  objCount <- reactiveVal(0)
  objCollection <- reactiveValues(objects = list())

  # Reaction on action button "addObject"
  observeEvent(input$addObject, {

    # Add another item
    objCount(objCount() + 1)
    newObjName <- paste0("Object_", objCount())
    updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))

    # Append the object tabset panel
    appendTab("objTP", tabPanel(newObjName, obj_UI(newObjName)), select = TRUE)

  })

  # Reaction on action button "rmvObject"
  observeEvent(input$rmvObject, {
    delObjName <- paste0("Object_", objCount())
    objCount(objCount() - 1)
    updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))
    removeTab("objTP", target = delObjName)

  })

  # Implement the server side of module
  observeEvent(objCount(), {
    if (objCount() > 0) {

      for (i in 1:objCount()) {
        identifier <- paste0("Object_", i)
        observeEvent(obj_Server(identifier), {
          objCollection$objects[[identifier]] <- obj_Server(identifier)
        })
      }
    }

    # Ouput the selected values
    output$displayValues <- renderPrint({
      reactiveValuesToList(objCollection)
    })

  })


}

shinyApp(ui, server)

【问题讨论】：

我在 moduleserver 函数中遇到错误（应用程序找不到它）。我错过了什么吗？
@Alessio 你有最新的shiny吗？它是在 1.5.0 中引入的
问题出在这部分：newObj <- obj$clone()。它必须是newObj <- obj()$clone()，但是现在我收到错误消息“shiny 是建立在
谢谢@starja。我已经编辑了更正此问题的帖子，但收到与您相同的错误消息。
也许this 有帮助？否则可能值得尝试创建一个 [issue]() 并要求在响应式中正确使用 R6 对象

标签： r shiny r6 shinymodules

【解决方案1】：

以下最小可重现示例是对上述问题的回答。与上面的代码相比，我更正了模块的服务器功能中的一个错字，并将服务器部分的初始化放在了observeEvent 的input$addObject 中，并删除了observeEvent 的objCount()。

library(shiny)
library(R6)

# Simple R6 object
objR6 <- R6::R6Class(
  "objR6",
  public = list(
    identifier = NULL,
    selected_value = NULL,

    initialize = function(identifier) {
      self$identifier <- identifier
    }
  )
)

# Module Ui
obj_UI <- function(id) {
  tagList(
    selectInput(NS(id, "value"), "Chose Value", letters)
  )
}

# Module Server
obj_Server <- function(id) {
  moduleServer(id, function(input, output, session) {

    obj <- reactiveVal(objR6$new(id))

    observeEvent(input$value, {
      newObj <- obj()$clone()
      newObj$selected_value <- input$value
      obj(newObj)
    })


    return(reactive(obj()))

  })
}


# Shiny App
ui <- fluidPage(
  fluidPage(
    selectInput("objSelection", "Select Object",
                choices = "",
                selectize = FALSE,
                size = 10),
    actionButton("addObject", "Add Object"),
    actionButton("rmvObject", "Remove Object"),
    tabsetPanel(id = "objTP"),
    verbatimTextOutput("displayValues")
  )
)

server <- function(input, output, session) {
  objCount <- reactiveVal(0)
  objCollection <- reactiveValues(objects = list())

  # Reaction on action button "addObject"
  observeEvent(input$addObject, {

    # Add another item
    objCount(objCount() + 1)
    newObjName <- paste0("Object_", objCount())
    updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))

    # Append the object tabset panel
    appendTab("objTP", tabPanel(newObjName, obj_UI(newObjName)), select = TRUE)

    # Add the server component of the module
    observeEvent(obj_Server(newObjName), {
      objCollection$objects[[newObjName]] <- obj_Server(newObjName)
    })


  })

  # Reaction on action button "rmvObject"
  observeEvent(input$rmvObject, {
    delObjName <- paste0("Object_", objCount())
    if (objCount() > 0) {
      objCount(objCount() - 1)
      removeTab("objTP", target = delObjName)
      objCollection$objects[[delObjName]] <- NULL
      if (objCount() > 0) {
        updateSelectInput(session, "objSelection", choices = c(paste0("Object_", 1:objCount())))
      } else {
        updateSelectInput(session, "objSelection", choices = "")
      }
    }
  })

  # Ouput the selected values
  output$displayValues <- renderPrint({
    lapply(reactiveValuesToList(objCollection)$objects, function(i) {i()})
  })


}

shinyApp(ui, server)

【讨论】：