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

编程问答 2022-05-30

问题描述

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

应用程序应该能够动态创建模块并呈现模块的 UI - 在我的示例中为 obj_UI - 在 tabsetpanel 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,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,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)

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

rrr6shinyshinymodules