Server and Clientside issues

thanks for taking the time and effort to read/answer this! :slight_smile:

In my current application I am allowing users to modify existing cells inside the datatables displayed. This causes an issue because for some reason when I modify an existing cell, and then later try to append a new row to the same datatable, the previously modified cell will revert back to its original label. I believe this is because the data that is saved clientside is not in sync with the datatable that is server side. I don't know how to fix this and have tried several methods for several hours now. Any ideas would be much appreciated


library(shiny)
library(DT)
library(data.table)

# Define UI ----
ui <- fluidPage(
  titlePanel("Alpha"),
  mainPanel(
    fluidRow(
      tabsetPanel(id = 'tpanel',
                  type = "tabs",
                  tabPanel("Alpha", plotOutput("plot1")),
                  tabPanel("Beta", plotOutput("plot2")),
                  tabPanel("Delta",  plotOutput("plot3")),
                  tabPanel("Omega", plotOutput("plot4")))
    ),
    fluidRow(
      splitLayout(
        dateInput("sdate", "Start Date"),
        dateInput("edate", "End Date"),
        textInput("gmin", "Min"),
        textInput("gmax", "Max") 
      )
    ),
    fluidRow(
      splitLayout(
        textInput("groupInp", NULL, placeholder = "New Group"),
        actionButton("addGrpBtn", "Add Group"),
        textInput("tickerSub", NULL, placeholder = "New Sub"),
        actionButton("addSubBtn", "Add Sub")
      )
    ),
    fluidRow(
      splitLayout(
        DT::dataTableOutput('groupsTable'),
        DT::dataTableOutput('groupSubs')
      )
    )
  )
)

# Define server logic ----
server <- function(input, output) {
  rv <- reactiveValues(
    groups = data.frame('Group' = c('Group'), 'Minimum' = c(0), 'Maximum' = c(0), 'Type' = c('-')),
    subs = list(group1 = data.frame('Group' = c('Sub'), 'Minimum' = c(0), 'Maximum' = c(0), 'Type' = c('-'))),
    deletedRows  = NULL, 
    deletedRowIndices = list()
  )
  output$groupsTable <- DT::renderDataTable(
    # Add the delete button column
    deleteButtonColumn(rv$groups, 'delete_button')
  )
  
  ############## LISTENERS ################
  
  observeEvent(input$deletePressed, {
    rowNum <- parseDeleteEvent(input$deletePressed)
    dataRow <- rv$groups[rowNum,]
    # Put the deleted row into a data frame so we can undo
    # Last item deleted is in position 1
    rv$deletedRows <- rbind(dataRow, rv$deletedRows)
    rv$deletedRowIndices <- append(rv$deletedRowIndices, rowNum, after = 0)
    
    # Delete the row from the data frame
    rv$groups <- rv$groups[-rowNum,]
  })
  
  observeEvent(input$addGrpBtn, {
    row <- data.frame('Group' = c(input$groupInp), 
                      'Minimum' = c(0),
                      'Maximum' = c(0), 
                      'Type' = c('-'))
    proxy <- dataTableProxy('groupsTable')
    rv$groups <- addRowAt(rv$groups, row, nrow(rv$groups))
  })
}

addRowAt <- function(df, row, i) {
  # Slow but easy to understand
  if (i > 1) {
    rbind(df[1:(i - 1), ], row, df[-(1:(i - 1)), ])
  } else {
    rbind(row, df)
  }
}

deleteButtonColumn <- function(df, id, ...) {
  # function to create one action button as string
  f <- function(i) {
    # https://shiny.rstudio.com/articles/communicating-with-js.html
    as.character(actionLink(paste(id, i, sep="_"), label = 'Delete', icon = icon('trash'),
                            onclick = 'Shiny.setInputValue(\"deletePressed\",  this.id, {priority: "event"})'))
  }
  
  deleteCol <- unlist(lapply(seq_len(nrow(df)), f))
  # Return a data table
  
  DT::datatable(cbind(' ' = deleteCol, df),
                # Need to disable escaping for html as string to work
                escape = FALSE,
                editable = 'cell',
                selection = 'single',
                rownames = FALSE,
                class = 'compact',
                options = list(
                  # Disable sorting for the delete column
                  dom = 't',
                  columnDefs = list(list(targets = 1, sortable = FALSE))
                ))
}

parseDeleteEvent <- function(idstr) {
  res <- as.integer(sub(".*_([0-9]+)", "\\1", idstr))
  if (! is.na(res)) res
}

# Run the app ----
shinyApp(ui = ui, server = server)

Here is the order in which the error occurs.

I'm sure I'm doing something wrong here in terms of keeping my data in sync between the client and the server. I'm open to any suggestions.

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