DataTable - Proxy Table... ReplaceData returning blank table!

shiny
,
1

Hi!

I've never quite got to grips with using proxyTable. Although I have used it in Shiny Apps before - I find it quite hard to debug when something goes wrong.

In the code below I'm trying to create a button to incrementally increase a value by 1. I can redraw the table each time - although proxy table is better for users.

My Values are being altered as required - but replacedata() in this instance doesn't work and returns a blank output - 0 matching records. Any idea whats going on?

library(dplyr)
library(data.table)
library(dplyr)
library(DT)
        
values <- data.table(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), ...))
  }
  

  values = values %>%
    mutate(id = 1:nrow(values)) %>%
    rowwise() %>%
    mutate(Increase = getPlusButton(id, idS = "", lab = "Tab1")) %>%
    select(id,everything())
  
  
  
  
  output$TabBU <- renderDT(
    head(values),
    escape = FALSE)
 
  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])
    print(values)
    
    #Fine up until this point - then replace data breaks the datatable
    
    replaceData(proxyTable, values, resetPaging = FALSE, rownames = FALSE)  # important
    
    
  })
  
  
  
}


shinyApp(ui, server)
2 
library(shiny)
library(dplyr)
library(DT)
library(data.table)

values <- data.table(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), ...))
  }
  
  
  values = values %>%
    mutate(id = 1:nrow(values)) %>%
    rowwise() %>%
    mutate(Increase = getPlusButton(id, idS = "", lab = "Tab1")) %>%
    select(id,everything())  %>% ungroup()
  
  output$TabBU <- renderDT(
    head(values),
    escape = FALSE)
  
  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]])
    print(values)
    
    
    replaceData(proxyTable,
                values, resetPaging = FALSE
                                )#,rownames = FALSE)  # important not to have rowname=FALSE
  })
}

shinyApp(ui, server)
1 Like
3

Hello Again!

I feel like im excruciating 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 and 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 following line... throwing an "Invalid JSON Response"

replaceData(proxyTable,
                values, resetPaging = FALSE
    )

Full code below

...and thank you so much for your help so far!

# 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)
4

Hi - I think Ill post this as a new question and mark the original question as resolved. I think the scope of the question has changed sufficiently since last week!

5

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.