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