我有一个 Shiny 的应用程序,其中显示了一个数据表。有一列带有复选框,允许用户选择该行,并在按下按钮时显示模式。模态包含一个表,该表具有数据表的子集,该子表仅包括选定的行(我的真实应用触发了另一个功能,但效果相同)
但是,当用户取消选择该行并选择另一行时,将显示模型中的先前内容,然后将其替换为新内容。
每次按下按钮有什么方法可以重置模型?
这是我正在使用的代码:
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)
在上面粘贴的代码中,我尝试使用以下方法重置模式:
tags$script(HTML('$(".modal").on("hidden.modal1", function(){
$(this).removeData();
});'
)
)
但这不起作用
谢谢
最佳答案
这里的问题是,仅当触发disTable
时才呈现modalDialog
(在选中复选框时尚未呈现)。
我们可以通过设置以下方式来强制Shiny提早渲染disTable
(当input$checked_rows
更改时):outputOptions(output, "disTable", suspendWhenHidden = FALSE)
请检查以下内容:
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)