1

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

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

单击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)
4

1 回答 1

0

以下最小可重现示例是对上述问题的回答。与上面的代码相比，我更正了模块的服务器功能中的一个错字，并将服务器部分的初始化放在observeEventfor 中input$addObject并删除了observeEventfor 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)
于 2021-01-14T14:28:20.480 回答