如何从 Shiny 模块中的 Modal Dialog 将数据帧返回到 Shiny 应用程序？

问题描述

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

我已经在 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,1200))
dataSet2 <-  data.frame(
    city = c("Nwe York","Rome","Madrid","Paris"),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",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,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,input_id = ns("l_source"),labels = values$v_operand1,input_id = ns("l_oper1"),labels = values$v_operand2,input_id = ns("l_oper2"),actionButton(ns("btExecute"),"Execute")
                   )
                 })
                 
                 observe({
                   req(values$df_wd)
                   showModal(modalReactive())
                 })
                 
                 observeEvent(input$btExecute,{
                     print("Execute")
                     values$df_wd <- doSum(values$df_wd,"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",sales1 = c(3500,2100,2000,1500),1200))
dataSet2 <-  data.frame(
  city = c("Nwe York",sales2 = c(700,300,500,1100))

ui <- fluidPage(
  fluidRow(
    selectInput(inputId =  "datasets",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)

解决方法

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

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

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