r - 如何从 Shiny 模块中的模态对话框将数据框返回到 Shiny 应用程序？

Question

我正在开发大型闪亮应用程序，我需要显示一个模态对话框并允许在其中执行一些算术运算，当它关闭时，它应该返回根据与去算术修改的数据以更新数据中的数据表输出。此外，如果选择了新数据集，则应清除字段，否则，如果再次打开模式，则应显示先前加载的字段。由于我的应用程序非常大，我想创建一个模块化代码，但是当我从observeEvent 中的 bt_show_modal 按钮调用 de 模块时，它什么也不做。

我已经在 ui.r 和 server.r 结构中构建了应用程序并且工作正常！ 这是应用程序代码：

# APP CODE WITHOUT MODULE
library(shiny)
library(DT)
library(shinydashboard)
library(sortable)

doSum <- function(data, col1, col2, col_result) {
  data[col_result] <- data[, col1] + data[, col2] # sum columns
  return(data)
}
dataSet1 <- data.frame(
    country = c("EEUU", "Italy", "Spain", "France"),
    sales1 = c(500, 200, 1000, 1800),
    sales2 = c(900, 100, 200, 1200))
dataSet2 <-  data.frame(
    city = c("Nwe York", "Rome", "Madrid", "Paris"),
    sales1 = c(500, 200, 1000, 1800),
    sales2 = c(900, 100, 200, 1200))  
ui <- fluidPage(
  fluidRow(
    selectInput(inputId =  "datasets",label = "Datasets",
                choices = c("Countries", "Cities"),selected = "Countries"),
    actionButton("bt_show_modal", "Show modal")),
  dataTableOutput("preview1")
)    
server <- function(input, output) {
  values <- reactiveValues(df_wd = NULL)
  values <- reactiveValues(g_l_oper1 = NULL)
  values <- reactiveValues(g_l_oper2 = NULL)
  modalReactive <- reactive({
    modalDialog(
      column(width = 6,
             fluidRow(rank_list(text = "Fields",
                 labels = names(values$df_wd),
                 input_id = "l_source",
                 options = sortable_options(group = "list_group")))),
      column(width = 6,
        fluidRow(rank_list(text = "Variable 1",
            labels = values$g_l_oper1,
            input_id = "l_oper1",
            options = sortable_options(group = "list_group"))),
        fluidRow(rank_list(text = "Variable 2",
            labels = values$g_l_oper2,
            input_id = "l_oper2",
            options = sortable_options(group = "list_group")))),
      actionButton("btExecute", "Execute")
    )
  })      
  resetReactiveValues <- function() {
    values$df_wd <- NULL
    values$g_l_oper1 <- NULL
    values$g_l_oper2 <- NULL
  }      
  workData <- reactive({
    if (!is.null(values$df_wd))
      values$df_wd
    else
      if (input$datasets == "Countries")
        values$df_wd <- dataSet1
      else
        values$df_wd <- dataSet2
  })    
  observeEvent(input$bt_show_modal, {
    showModal(modalReactive())
  })      
  observeEvent(input$btExecute, {
    values$df_wd <- doSum(workData(), input$l_oper1, input$l_oper2, "col_sum")
    values$g_l_oper1 <- input$l_oper1
    values$g_l_oper2 <- input$l_oper2
    removeModal()
  })      
  observeEvent(input$datasets, {
    resetReactiveValues()
  })      
  output$preview1 <- renderDataTable({
    df <- workData()
    req(df)
    datatable(df)
  })
}    
shinyApp(ui = ui, server = server)

这是模块实现：

# MODULE CODE
doSum <- function(data, col1, col2, col_result) {
  data[col_result] <- data[, col1] + data[, col2] # sum columns
  return(data)
}    
modalUI <- function(id) {
  ns <- NS(id)
  tagList(uiOutput(ns("sortable_object")))
}

modalServer <- function(id, data) {
  moduleServer(id,
               function(input, output, session) {
                 values <- reactiveValues(df_wd = NULL)
                 values <- reactiveValues(v_operand1 = NULL)
                 values <- reactiveValues(v_operand2 = NULL)
                 
                 modalReactive <- reactive({
                   values$df_wd = data # Save parameter in reative global variable
                   ns <- session$ns # Name space
                   modalDialog(
                     column(width = 6,
                            fluidRow(rank_list(text = "Fields",
                                               labels = names(values$df_wd),
                                               input_id = ns("l_source"),
                                               options = sortable_options(group = "list_group")))),
                     column(width = 6,
                            fluidRow(rank_list(text = "Variable 1",
                                               labels = values$v_operand1,
                                               input_id = ns("l_oper1"),
                                               options = sortable_options(group = "list_group"))),
                            fluidRow(rank_list(text = "Variable 2",
                                               labels = values$v_operand2,
                                               input_id = ns("l_oper2"),
                                               options = sortable_options(group = "list_group")))),
                     actionButton(ns("btExecute"), "Execute")
                   )
                 })
                 
                 observe({
                   req(values$df_wd)
                   showModal(modalReactive())
                 })
                 
                 observeEvent(input$btExecute, {
                     print("Execute")
                     values$df_wd <- doSum(values$df_wd,input$l_oper1,input$l_oper2,"col_sum")
                     values$v_operand1 <- input$l_oper1
                     values$v_operand2 <- input$l_oper2
                     removeModal()
                   })
                 return(reactive(values$df_wd)) # Dataframe with the new col "col_sum"
               })
}
# APP CODE
library(shiny)
library(DT)
library(shinydashboard)
library(sortable)

dataSet1 <- data.frame(
  country = c("EEUU", "Italy", "Spain", "France"),
  sales1 = c(3500, 2100, 2000, 1500),
  sales2 = c(900, 100, 200, 1200))
dataSet2 <-  data.frame(
  city = c("Nwe York", "Rome", "Madrid", "Paris"),
  sales1 = c(500, 200, 1000, 1800),
  sales2 = c(700, 300, 500, 1100))

ui <- fluidPage(
  fluidRow(
    selectInput(inputId =  "datasets",label = "Datasets",
                choices = c("Countries", "Cities"),selected = "Countries"),
    actionButton("bt_show_modal", "Show modal")),
  dataTableOutput("preview1"),
  modalUI("modal_module")
)

server <- function(input, output) {
  values <- reactiveValues(df_wd = NULL)
  workData <- reactive({
    if (!is.null(values$df_wd))
      values$df_wd
    else
      if (input$datasets == "Countries")
        values$df_wd <- dataSet1
      else
        values$df_wd <- dataSet2
  })
  
  modalReactive <- modalServer("modal_module", reactive(values$df_wd)) # Call the module
  
  observeEvent(input$bt_show_modal, {
    values$df_wd  <- modalReactive()
  })
  
  observeEvent(input$datasets, {
    values$df_wd <- NULL # Reset variable
  })
  
  output$preview1 <- renderDataTable({
    df <- workData()
    req(df)
    datatable(df)
  })
}    
shinyApp(ui = ui, server = server)

标签： rshinyappsshinymodules