Shiny DT editing saves in the wrong column

Question

I am wroking on an shiny app as a volonteer trying to produce an app that would register all of the calls citizens have in the these times of a lockdown for a local Red Cross office. I have managed to get the entry form and to review the DT, but I need to the DT editable so I have included some code to do that.

All is working, except when I write the changes in some of the columns the app changes the column -1 (one to left), overwrites its previous entry in column -1 that I didn't wanted to edit and leaves the entry I actually wanted to edit in the column I wanted to edit (if that makes any sense). What am I doing wrong? I am pasting the code, datasets stored on Dropbox.

## app.R ##
# load the required packages
library(shiny)
library(shinyjs)
require(shinydashboard)
library(ggplot2)
library(dplyr)
library(DT)
library(data.table)

  # Obavezna polja
    fieldsMandatory <- c("Ime", "Prezime", "Problem")

    # Označiti obavezna polja s crvenim asteriksom
      labelMandatory <- function(label) {
        tagList(
          label,
          span("*", class = "mandatory_star")
        )
      }

    # CSS za obavezna polja, *  
      appCSS <-
        ".mandatory_star { color: red; }"

  # HumanTime za time stamp u csv
  humanTime <- function() format(Sys.time(), "%Y%m%d-%H%M%OS") 

  # Čuvanje odgovora u folderu "reponses"
  fieldsAll <- c("Ime", "Prezime", "Adresa", "BrojTel", "OIB", 
               "Problem", "Pomagac","Trajanje","Rjesenje") 

            # DropBox autorizacija
                library(rdrop2)

                # This will launch your browser and request access to your Dropbox account. 
                # You will be prompted to log in if you aren't already logged in.

                #drop_auth()

                # Once completed, close your browser window and return to R to complete authentication.
                # The credentials are automatically cached (you can prevent this) for future use.

                # If you wish to save the tokens, for local/remote use

                #token <- drop_auth()
                #saveRDS(token, file = "dropbox_token.rds")

                # Then in any drop_* function, pass `dtoken = token
                # Tokens are valid until revoked.

outputDir <- "responses"
outputJedan <- "reponsesJedanFajl"

loadData <- function() {
  files_info <- drop_dir(outputDir)
  file_paths <- files_info$path_display
  # Only take the last 20 because each file takes ~1 second to download
  file_paths <- tail(file_paths, 1)
  zadnji <-
    lapply(file_paths, drop_read_csv, stringsAsFactors = FALSE, encoding = 'UTF-8') %>%
    do.call(rbind, .)

  write.csv(zadnji, "zadnji.csv", row.names = FALSE, quote = TRUE, fileEncoding = "UTF-8")
  # Upload the file to Dropbox
  drop_upload("zadnji.csv", path = outputDir, mode = "overwrite")

  # files_info2 <- drop_dir(outputJedan)
  # file_paths2 <- files_info2$path_display
  # Only take the last 20 because each file takes ~1 second to download
  #file_paths2 <- tail(file_paths, 20)
  data <-
    lapply(c("responses/zadnji.csv", "reponsesJedanFajl/fajl.csv"), 
           drop_read_csv, stringsAsFactors = FALSE, encoding = 'UTF-8') %>%
    do.call(rbind, .)

  write.csv(data, "fajl.csv", row.names = FALSE, quote = TRUE, fileEncoding = "UTF-8")
  # Upload the file to Dropbox
  drop_upload("fajl.csv", path = outputJedan, mode = "overwrite")
  data
}

# UI

ui <- dashboardPage(
  dashboardHeader(title = "HDCK-ČK Dashboard"),
  skin = "red",

  ## Sidebar content
  dashboardSidebar(
    collapsed = TRUE,
    sidebarMenu(
      #menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Evidencija", tabName = "evidencija", icon = icon("th")),
      #menuItem("Evidencija", tabName = "evidencija", icon = icon("th")),
      menuItem("Sajt", icon = icon("send",lib='glyphicon'),
               href = "http://www.crveni-kriz-cakovec.hr")
    )
  ),

  ## Body content
  dashboardBody(
    tabItems(

      # First tab content
      tabItem(
        tabName = "evidencija",

        navbarPage("",

                   tabPanel("Upis", 
                            fluidPage(
                              shinyjs::useShinyjs(),
                              shinyjs::inlineCSS(appCSS),

                              sidebarPanel(

                                width = 3,

                                id = "form",

                                textInput("Ime", labelMandatory("1. Ime")),
                                textInput("Prezime", labelMandatory("2. Prezime")),
                                textInput("Adresa", label = "3. Adresa (ulica i broj, mjesto)"),
                                textInput(inputId = "BrojTel", label = "4. Broj telefona", 
                                          value = NULL),
                                numericInput(inputId = "OIB", label = "5. OIB", value = NULL),
                                #checkboxInput("CZSS", "Označiti ako je korisnik CZSS", FALSE),
                                #sliderInput("Dob", "5. Dob", 1, 100, 50, ticks = FALSE),
                                textAreaInput("Problem", labelMandatory("6. Opis problema ili potrebe"),
                                              "", height = 100),
                                textAreaInput("Rjesenje", "7. Na koji način je problem riješen?",
                                              "", height = 50),
                                selectInput("Pomagac", "8. Pomagač",
                                            c("", "Barbara", "Elizabeta",
                                              "Ines", "Iva", "Lana", "Vlatka", "Željka")),
                                numericInput(inputId = "Trajanje", label = "9. Trajanje razgovora u min", value = 5),
                                actionButton("submit", "Unesi")#, class = "btn-primary")
                              ),

                              mainPanel(

                                width = 9,

                                h3("Tablica s pregledom prethodnih zapisa:"),
                                DT::dataTableOutput("responsesTable"), 
                                style = "overflow-y: scroll;overflow-x: scroll; overflow: auto;",
                                #downloadButton("downloadBtn", "Skini *.csv"),
                                # br(),
                                # actionButton("viewBtn","View"),
                                br(),
                                actionButton("saveBtn", "Zapiši rješenje", style="float:right")
                                # br(),
                                # DT::dataTableOutput("updated.df")
                              )
                            )),

                   tabPanel("Upute"
                            )
        )
      )
    )
  )
)

# Server 

  # Učitavnje podataka na prvom učitavnju app
  tablica <- function() {
    data <- drop_read_csv("reponsesJedanFajl/fajl.csv", fileEncoding = "UTF-8", 
                          stringsAsFactors = FALSE)
    data
  }

  server <- function(input, output, session) {

    drop_auth(rdstoken = "dropbox_token.rds")

    # Prikaži tablicu na onload
      tablicica <- data.frame(tablica())

        output$responsesTable <- DT::renderDataTable(
          tablicica,
          selection = "none",
          editable = TRUE,
          rownames = FALSE,
          extensions = 'Buttons',
          server = FALSE,
          options = list(
            paging = TRUE,
            searching = TRUE,
            scroller = TRUE,
            dom = 'Bfrtip',
            extensions = c('Responsive', 'Buttons'),
            buttons = c('excel', 'pdf', 'copy', 'csv', 'print')
        ))

    # Provjera obaveznih polja kod upisa
      observe({
        mandatoryFilled <-
          vapply(fieldsMandatory,
                 function(x) {
                   !is.null(input[[x]]) && input[[x]] != ""
                 },
                 logical(1))
        mandatoryFilled <- all(mandatoryFilled)
        shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
        })

      # Čuvanje pojedinih inputa u csv nakon upisa
        formData <- reactive({
          data <- sapply(fieldsAll, function(x) input[[x]])
          data <- c(data, VremenskiPoredak = humanTime())
          data <- t(data)
          data
        })

    # Čuvanje inputa u pojedinim csv i što učiniti nakon što se stisne gumb 
      saveData <- function(data) {
        #data <- t(data)
        # Unique file name
        fileName <- sprintf("%s_%s.csv", humanTime(), digest::digest(data))
        # Čuvanje fajla u prvremenom direktoriju
        filePath <- file.path(tempdir(), fileName)
        write.csv(data, filePath, row.names = FALSE, quote = TRUE, fileEncoding = "UTF-8")
        # Upload fajla na Dropbox
        drop_upload(filePath, path = outputDir)
      }

    # akcija kad se pritisne gumb Zapiši, za zapisivanje novih upisa
      observeEvent(input$submit, {
        saveData(formData())
          # I prikaži tablicu s novim upisima
          output$responsesTable <- DT::renderDataTable(
            datatable(
              loadData(),
              rownames = FALSE,
              extensions = 'Buttons',
              #server = FALSE,
              options = list(
                paging = TRUE,
                searching = TRUE,
                #fixedColumns = FALSE,
                #autoWidth = TRUE,
                #ordering = TRUE,
                deferRender = TRUE,
                #scrollY = 400,
                scroller = TRUE,
                dom = 'Bfrtip',
                orientation ='landscape',
                extensions = c('Responsive', 'Buttons'),
                buttons = c('excel', 'pdf', 'copy', 'csv', 'print')
              ))
          ) 
        })

    observeEvent(input$responsesTable_cell_edit, {
      tablicica[input$responsesTable_cell_edit$row,
                input$responsesTable_cell_edit$col] <<-  input$responsesTable_cell_edit$value
    })

    observeEvent(input$saveBtn,{
      write.csv(tablicica, "fajl.csv", row.names = FALSE, quote = TRUE, fileEncoding = "UTF-8")
      # Upload the file to Dropbox
      drop_upload("fajl.csv", path = outputJedan, mode = "overwrite")

      # Prikaži tablicu nakon što su unesene promjene
      output$responsesTable <- DT::renderDataTable(
          datatable(
          tablicica,
          rownames = FALSE,
          options = list(
            searching = TRUE,
            lengthChange = TRUE
            #   # fixedColumns = FALSE,
            #   # autoWidth = TRUE,
            #   # ordering = FALSE,
            #   dom = 'tB',
            #   buttons = c('copy', 'csv', 'excel', 'pdf')
            # ),
            # # class = "display", #if you want to modify via .css
            # # extensions = "Buttons"
          ))
      ) 
    })

    # # Download button
    # output$downloadBtn <- downloadHandler(
    #   filename = function() {
    #     sprintf("evidencija-psihosocijalne_%s.csv", humanTime())
    #   },
    #   content = function(file) {
    #     write.csv(loadData(), file, row.names = FALSE)
    #   }
    # )

    # Reset formu nakon submita
    observeEvent(input$submit, {
      reset("form")
    })

  }

shinyApp(ui, server)

Spatter

Answer 1

R and DT count columns differently. In R the leftmost column is column 1. In DT the leftmost column is column 0. This is also known as one or zero-based array indexing.

Adding a few strategic +1 or -1 will do the trick.

If you need help knowing where to put those, feel free to post a minimal example and we can help you work through it.

Scupper

Thanks, Ash. Tips&Tricks. Your suggestion worked and rownames = TRUE in DT::renderDataTable did the track. – Spatter