闪亮的 DT 编辑保存在错误的列中

Shiny DT editing saves in the wrong column

作为一名志愿者,我正在开发一个闪亮的应用程序,试图制作一个应用程序,该应用程序可以注册公民在当地红十字会办公室封锁期间的所有电话。我已设法获得报名表并查看 DT,但我需要 DT 可编辑,因此我包含了一些代码来执行此操作。

一切正常,除了当我在某些列中写入更改时,应用程序更改了列 -1(左一),覆盖了我不想编辑的 -1 列中的先前条目,并且在我想编辑的列中留下我实际上想编辑的条目(如果这有意义的话)。我究竟做错了什么?我正在粘贴代码,存储在 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)

R 和 DT 对列的计数不同。在 R 中,最左边的列是第 1 列。在 DT 中,最左边的列是第 0 列。这也称为从一或从零开始的数组索引。

添加一些战略性的 +1 或 -1 即可。

如果您需要帮助了解将它们放在哪里,请随时 post 举一个最简单的示例,我们可以帮助您完成它。