I feel like Im pretty close close with My App - the last thing I need to do is to get the RowReorder extension working alongside being able to use proxy tables - Ive read that Proxy Table only works when Server = True - and its important for me to be able to use Proxy as i will be rendering quite large tables for users... speed is important.
Scenario A
output$TabBU <- renderDT(server=T,
values,
escape = FALSE,
When server is set to True... Proxy Table works fine and the level up/down buttons in my App work as desired. However the rowreorder extension doesnt work - and any reordering snaps back to its original place
Scenario B
output$TabBU <- renderDT(server=F,
values,
escape = FALSE,
When server is set to False... Rowreorder extension works as expected - however obviously the problem with Proxy Table comes up - as expected this errors on the line below... throwing an "Invalid JSON Response"
replaceData(proxyTable,
values, resetPaging = FALSE
)
Full code below
# Load packages
library(dplyr)
library(shiny)
library(data.table)
library(DT)
values <- data.frame(Country = c("England","Scotland","Wales"),Level = c(4,5,6))
ui <- fluidPage(
tags$style("#TabBU { white-space:pre; }"),
DT::dataTableOutput('TabBU')
)
server <- function(input, output) {
getPlusButton <- function(n, idS = "", lab = "Pit") {
if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
ret <- shinyInput(actionButton, n,
'button_', label = ">>>",icon = icon("icon-plus-sign-alt"),
onclick = sprintf('Shiny.onInputChange(\"%splus_button_%s\", this.id)' ,idS, lab))
return (ret)
}
shinyInput <- function(FUN, n, id, ses, ...) {
as.character(FUN(paste0(id, n), ...))
}
getMinusButton <- function(n, idS = "", lab = "Pit") {
if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
ret <- shinyInput(actionButton, n,
'button_', label = "<<<",icon = icon("icon-plus-sign-alt"),
onclick = sprintf('Shiny.onInputChange(\"%sminus_button_%s\", this.id)' ,idS, lab))
return (ret)
}
values <- values %>%
mutate(id_level = 1:nrow(values)) %>%
rowwise() %>%
mutate(`-` = getMinusButton(id_level, idS = "", lab = "Tab1")) %>%
mutate(`+` = getPlusButton(id_level, idS = "", lab = "Tab1")) %>%
select(id_level,Country,Level,`-`,`+`) %>% ungroup()
#Note In order to Use PRoxy Tables - reloadData() only works for tables in the server-side processing mode,
# e.g. tables rendered with renderDataTable(server = TRUE).
# The data to be reloaded (i.e. the one you pass to dataTableAjax())
# must have exactly the same number of columns as the previous data object in the table.
output$TabBU <- renderDT(server=T,
values,
escape = FALSE,
colnames = c(Position = 1),
# add the name
extensions = 'RowReorder',
selection = 'none',
options = list(
order = list(list(0, 'asc')),
rowReorder = TRUE,
pageLength = 500
),callback=JS(
"// pass on data to R
table.on('row-reorder', function(e, details, changes) {
Shiny.onInputChange('TabBU_row_reorder', JSON.stringify(details));
});")
)
proxyTable <<- dataTableProxy('TabBU')
observeEvent(input$plus_button_Tab1, {
i <- as.numeric(strsplit(input$plus_button_Tab1, "_")[[1]][2])
j = which( colnames(values)=="Level" )
v = as.numeric(values[i, j]) + 1
values[[i, j]] <<- DT::coerceValue(v, values[[i, j]])
replaceData(proxyTable,
values, resetPaging = FALSE
)
})
observeEvent(input$minus_button_Tab1, {
i <- as.numeric(strsplit(input$minus_button_Tab1, "_")[[1]][2])
j = which( colnames(values)=="Level" )
v = as.numeric(values[i, j]) - 1
values[[i, j]] <<- DT::coerceValue(v, values[[i, j]])
replaceData(proxyTable,
values, resetPaging = FALSE
)
})
}
shinyApp(ui, server)