由父模块递归调用的模块:如何将数据从子模块返回到父模块?

时间:2019-02-11 13:10:46

标签: r shiny

我正在尝试创建具有任意数量的子元素的动态UI。我通过创建一个父模块(modOperation)来实现此目的,该模块递归地调用了一个子模块(modOperationElement)。到目前为止,UI可以按预期工作,但是我无法弄清楚如何将输入$数据从子模块返回给父模块(最终我将需要将其传递回闪亮的服务器函数)。

在下面的示例中,当子模块中的值更改时,返回到reactValue operation_rvs[["operation"]]并renderPrinted到textOutput(ns("testOutput"))的数据似乎没有更新。因此,在创建或删除子模块时将重置这些值。

当我省略父模块并将代码从modOperation移到server()时,一种相同的方法似乎可行。

我很高兴听到我错过的任何明显的破坏代码的信息,或者是解决该一般问题的更有效的方法(例如,采用这种方法使删除带有actionButton的子模块变得很困难。子模块本身)

library(shiny)
library(data.table)
library(shinydashboard)

# Modules ----

## modOperationElement ----

modOperationElementUI_List = function (operationList) {
    uiList = lapply(
      1:(length(operationList) %>% as.integer), 
    function(i) {
      modOperationElementUI(i, operationList[[i]])
    }
  )
  return (uiList)
}

modOperationElementUI = function(id, operationListElement)
  {
  ns = NS(id)

  tagList(
    wellPanel(
      h3(paste0("Operation ", id)),
      selectInput(
        ns("operationInput"), "Select operation: ", 
        c("Select & Rename", "Recode", "Joins"),   #forget mutate, as, for now
        selected = operationListElement[["operationInput"]]
      )
    )
  )
}

modOperationElement = function(input, output, session) {

  return(list(operationInput=input$operationInput))
}

## ModOperation ----

modOperationUI = function(id)
{
  ns = NS(id)
  tagList(
    box (
      textOutput(ns("testOutput")),
      width=12
    ),
    box (
      column(
        4, 
        h4("Add Operation"),
        actionButton(ns("menuOperation_addOperation_Button"), "Add Table...")
      ),
      column(
        4,
        h4("Delete Table..."),
        selectInput(ns("menuOperation_delOperation_Select"), choices= 1 %>% set_names("Operation One"), label = "Choose Operation: "),
        actionButton(ns("menuOperation_delOperation_Button"), "Delete...")
      ),
      width= 12
    ),
    box(
      uiOutput(ns("menuOperation_modUI")),
      width=12
    )
  )

}

modOperation = function(input, output, session, i) {            
  # setup reactive 

  operation_rvs = reactiveValues() #! I can delete the setup vars!!! - just have to req(operation_rvs[["operation"]]) every observer

  # delmodule action ----

  observeEvent(input$menuOperation_delOperation_Button, {
    operation_rvs[["operation"]][input$menuOperation_delOperation_Select %>% as.integer] <<- NULL
    operation_rvs[["ui"]] = modOperationElementUI_List( operation_rvs[["operation"]])
  })

  # add module action ----

  observeEvent(input$menuOperation_addOperation_Button, {
    ind = length(operation_rvs[["operation"]])+1
    operation_rvs[["operation"]][[ind]] =
      list(operationInput="Recode")

    operation_rvs[["ui"]] = modOperationElementUI_List( operation_rvs[["operation"]])

  })

  # update menuOperation Choices

  observe({
    req(operation_rvs[["operation"]])
    updateSelectizeInput(session,
                         inputId = "menuOperation_delOperation_Select", 
                         choices  = 1:length(operation_rvs[["operation"]]) )
  })

  # recurse UI

  output$menuOperation_modUI = renderUI({
    req(operation_rvs[["ui"]])
    operation_rvs[["ui"]]
  })

  # recurse server

  observe({
    req(operation_rvs[["operation"]])
    for (i in 1:(length(operation_rvs[["operation"]]) %>% as.integer)) { 
      operation_rvs[["operation"]][[i]] <<- callModule(modOperationElement, i )
    }
  })

  # test output
  output$testOutput = renderPrint(
    operation_rvs[["operation"]]
  ) 
}


# UI ----
ui <- dashboardPage(

  dashboardHeader(title="Test Conditional Panel in Modules"),

  dashboardSidebar( 
    sidebarMenu(
      menuItem("Upload Tables", tabName = "menuUploadTable", icon = icon("file-import"))
    )
  ),

  dashboardBody( 
    tabItems (

      ## UI: Upload Table ----
      tabItem(tabName = "menuUploadTable",
              fluidRow(
                modOperationUI("operationModule")
              )
      )
    )
  )

)

# Server ----

server <- function(input, output, session) {

callModule(modOperation, "operationModule")

}

# Run the application 
shinyApp(ui = ui, server = server)

0 个答案:

没有答案