Resetting modal when closing it in a shiny app - r

Question

I have a shiny app where a datatable is displayed. There is a column with a checkbox that allows the user to select the row and when pressing a button a modal is displayed. The modal contains a table with a subset of the datatable including only the row selected (my real app triggers another function but the effect is the same)
However, when the user deselects the row and selects another row, the previous content in the model is displayed before being replaced with the new one.
Is there any way of resetting the model everytime the button is pressed?
Here is the code I am using:
library(shinydashboard)
library(shinydashboardPlus)
library(shiny)
library(flextable)
data(mtcars)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
fluidPage(
tags$head(tags$style("#modal1 .modal-body {padding: 10px}
#modal1 .modal-content {-webkit-border-radius: 12px !important;-moz-border-radius: 12px !important;border-radius: 12px !important;}
#modal1 .modal-dialog { width: 800px; display: inline-block; text-align: left; vertical-align: top;}
#modal1 .modal-header {background-color: #339FFF; border-top-left-radius: 6px; border-top-right-radius: 6px}
#modal1 .modal { text-align: center; padding-right:10px; padding-top: 24px;}
#moda1 .close { font-size: 16px}")),
tags$script(HTML('$(".modal").on("hidden.modal1", function(){
$(this).removeData();
});'
)
),
fluidRow(
column(2,offset = 2,
HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
actionButton(inputId = "Compare_row_head",label = "Get full data"),
HTML('</div>')
),
column(12,dataTableOutput("tabla")),
tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);})')
),
tags$script("$(document).on('click', '#Main_table button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())
});")
)
)
)
ui <- dashboardPagePlus(enable_preloader = TRUE, sidebar_fullCollapse = TRUE, header, sidebar, body)
## Server side
server = function(input, output, session) {
data("mtcars")
# Reactive function creating the DT output object
output$tabla <- renderDataTable({
req(mtcars)
data <- mtcars
data
data[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(data),'"><br>')
datatable(data, escape = FALSE)
})
###Modal visualisation
observeEvent(input$Compare_row_head,{
showModal(tags$div(id="modal1", annotation_modal1))
}
)
annotation_modal1<-modalDialog(
fluidPage(
h3(strong("Example modal"),align="left"),
uiOutput('disTable')
),
size="l"
)
output$disTable <- renderUI({
req(input$checked_rows)
row_to_sel=as.numeric(gsub("Row","",input$checked_rows))
if (length(row_to_sel)){
#if (length(s)) {
#df <- vals$fake_sales
df <- mtcars
df <- as.data.frame(df[row_to_sel,])
ft <- flextable(df)
ft <- flextable::bold(ft, part="header")
ft <- flextable::autofit(ft)
ft <- flextable::width(ft, j=2, width=.1)
ft <- flextable::align(ft, align = "left", part = "all" )
ft %>% htmltools_value()
}
})
} # Server R
shinyApp(ui, server)
In the code pasted above I have tried to reset the modal using this:
tags$script(HTML('$(".modal").on("hidden.modal1", function(){
$(this).removeData();
});'
)
)
But it doesn't work
Thanks

Answer 1

The problem here is, that disTable only is rendered when your modalDialog is triggered (not already when the boxes are checked).
We can force shiny to render disTable earlier (when input$checked_rows is changed) by setting:
outputOptions(output, "disTable", suspendWhenHidden = FALSE)
Please check the following:
library(shinydashboard)
library(shinydashboardPlus)
library(shiny)
library(DT)
library(flextable)
data(mtcars)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
fluidPage(
tags$head(tags$style("#modal1 .modal-body {padding: 10px}
#modal1 .modal-content {-webkit-border-radius: 12px !important;-moz-border-radius: 12px !important;border-radius: 12px !important;}
#modal1 .modal-dialog { width: 800px; display: inline-block; text-align: left; vertical-align: top;}
#modal1 .modal-header {background-color: #339FFF; border-top-left-radius: 6px; border-top-right-radius: 6px}
#modal1 .modal { text-align: center; padding-right:10px; padding-top: 24px;}
#moda1 .close { font-size: 16px}")),
fluidRow(
column(2,offset = 2,
HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
actionButton(inputId = "Compare_row_head",label = "Get full data"),
HTML('</div>')
),
column(12,dataTableOutput("tabla")),
tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);})')
),
tags$script("$(document).on('click', '#Main_table button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())
});")
)
)
)
ui <- dashboardPagePlus(enable_preloader = TRUE, sidebar_fullCollapse = TRUE, header, sidebar, body)
## Server side
server = function(input, output, session) {
data("mtcars")
# Reactive function creating the DT output object
output$tabla <- renderDataTable({
req(mtcars)
data <- mtcars
data
data[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(data),'"><br>')
datatable(data, escape = FALSE)
})
###Modal visualisation
observeEvent(input$Compare_row_head,{
showModal(tags$div(id="modal1", annotation_modal1))
}
)
annotation_modal1 <- modalDialog(
fluidPage(
h3(strong("Example modal"), align="left"),
uiOutput('disTable')
),
size="l"
)
output$disTable <- renderUI({
req(input$checked_rows)
row_to_sel=as.numeric(gsub("Row", "", input$checked_rows))
if (length(row_to_sel)){
#if (length(s)) {
#df <- vals$fake_sales
df <- mtcars
df <- as.data.frame(df[row_to_sel,])
ft <- flextable(df)
ft <- flextable::bold(ft, part="header")
ft <- flextable::autofit(ft)
ft <- flextable::width(ft, j=2, width=.1)
ft <- flextable::align(ft, align = "left", part = "all" )
ft %>% htmltools_value()
}
})
outputOptions(output, "disTable", suspendWhenHidden = FALSE)
} # Server R
shinyApp(ui, server)