I'm working on the large shiny app and I need to show a modal dialog and allow to perform some arithmetics operations in there, and when it is closed, it should return the data modified according to with de arithmetics to update data in the data table output. Furthermore, if the new dataset is selected, it should clear the fields, otherwise, if the modal is open again, should show the field loaded previously. Since my app is very large, I want to create a modular code but when I call de module from bt_show_modal button in observeEvent, it does not do anything.
I've build the app in ui.r and server.r structure and works fine! This is app code:
# 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)
AND THIS IS THE MODULE IMPLEMEMTATION:
# 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)
