Hello, I believe I have found a bug with the DT package, but wanted to run it by the community first to see if I'm missing something. In a shiny app where I have reactive data controlled by a shiny::uiSliderInput or shinyWidgets::noUISliderInput, the updateSlideInput and updateNoUISliderInput calls do not work when the resulting reactive dataset is rendered in a DT::dataTableOutput with filters turned on.
I have updated all relevant packages to the latest and greatest, including the dev version of DT, see package info below. I have also included a reprex app to demonstrate that the updateSlideInput and updateNoUISliderInput calls do not work when the user clicks the button to "Update Edits." To recreate the issue, simply slide one or both sliders, you'll see edits in the "preview" column, then click the "Update Edits" button. You can see the edit is now in the "saved" column and the preview column still has the saved edit because the sliders did not go back to zero with the updateSlider call.
Please let me know if I can provide further information or assistance for this bug.
R version 4.0.5 (2021-03-31)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19044), RStudio 2021.9.1.372
Locale:
LC_COLLATE=English_United States.1252 LC_CTYPE=English_United States.1252 LC_MONETARY=English_United States.1252
LC_NUMERIC=C LC_TIME=English_United States.1252
Package version:
base64enc_0.1.3 crosstalk_1.2.0 digest_0.6.29 DT_0.24.1 fastmap_1.1.0 graphics_4.0.5 grDevices_4.0.5
htmltools_0.5.2 htmlwidgets_1.5.4 jquerylib_0.1.4 jsonlite_1.8.0 later_1.3.0 lazyeval_0.2.2 magrittr_2.0.3
methods_4.0.5 promises_1.2.0.1 R6_2.5.1 Rcpp_1.0.8.3 rlang_1.0.2 stats_4.0.5 utils_4.0.5
yaml_2.3.5
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)
library(DT)
base_values <- tibble(names = c("Zebra", "Donkey", "Lion"),
values = c(10, 20, 30),
no_ui_saved_edit = c(10, 20, 30),
no_ui_values_edit_preview = c(10, 20, 30),
saved_edit = c(10, 20, 30),
values_edit_preview = c(10, 20, 30))
ui <-
tagList(
dashboardPage(dashboardHeader(disable = T),
shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "sidebar",
tagList(
shinyWidgets::noUiSliderInput(
inputId = "no_ui_slider",
label = "No UI Base Value Change: ",
min = -50,
max = 50,
value = 0,
step = .1,
pips = list(
mode = "range",
density = 10
)
),
shiny::sliderInput(
inputId = "ui_slider",
label = "Base Value Change: ",
min = -50,
max = 50,
value = 0,
step = .1
),
br(),
actionButton(
inputId = "bv_click",
label = "Update Edits"
)
)
)),
dashboardBody(
fluidPage(
column(12,DT::dataTableOutput("data_out"))
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
#create the datatable and return the reactiveVals object
react_vals <- reactiveValues(out_val = base_values)
observe({
react_vals$out_val <- react_vals$out_val %>%
mutate(no_ui_values_edit_preview = values * ((100 + input$no_ui_slider)/100),
values_edit_preview = values * ((100 + input$ui_slider)/100))
})
observeEvent(input$bv_click, {
showModal(
modalDialog(
title = "Working....", "Calculating your change.",
easyClose = FALSE,
footer = NULL
)
)
if(input$no_ui_slider != 0 | input$ui_slider != 0) {
react_vals$out_val <- react_vals$out_val %>%
mutate(no_ui_saved_edit = values * ((100 + input$no_ui_slider)/100),
saved_edit = values * ((100 + input$ui_slider)/100))
#update sliders back to default if slider wasn't 0
shinyWidgets::updateNoUiSliderInput(session, inputId = "no_ui_slider", value = 0)
shiny::updateSliderInput(session, inputId = "ui_slider", value = 0)
}
removeModal()
})
output$data_out <- DT::renderDataTable({
data <- react_vals$out_val
data %>%
DT::datatable(extensions = 'Buttons',
rownames= FALSE,
filter = 'top',
escape = FALSE#,
# Adding the filter in this way also doesn't work
# options = list(
# dom = 'lBfrtip'
# )
)
})
}
# Run the application
shinyApp(ui = ui, server = server)