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

Question

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

该应用程序应该能够动态创建模块并呈现模块的 UI - 在我的示例中 obj_UI - 在选项卡设置面板的选项卡中 objTP。每个模块都应呈现一个 R6 类型 objR6 的对象。我想将生成的 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)

Answer 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)

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

R Shiny - Saving results of dynamically created modules

r

shiny

r6

shinymodules