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

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了闪亮的DT编辑保存在错误的列中相关的知识,希望对你有一定的参考价值。

[我正在努力尝试制作一个闪亮的应用程序,作为志愿服务人员,尝试制作一个应用程序,该应用程序会记录下在当地红十字会办公室封锁期间市民拨打的所有电话。我已经设法获得了参赛表格并查看了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即可解决问题。

[如果您需要知道将它们放在何处的帮助,请随时发布一个最小的示例,我们可以帮助您完成工作。

以上是关于闪亮的DT编辑保存在错误的列中的主要内容,如果未能解决你的问题,请参考以下文章

如何在闪亮的可编辑数据表中指定文件名并限制列编辑

根据可编辑单元格用户输入更新闪亮的 DT

在闪亮应用程序的 DT::datatable 中添加、删除和编辑行

使用下拉选择编辑闪亮的数据表(对于 DT v0.19)

为 DT 输出渲染文本输入时出现 R 闪亮错误

为 EF4.3 中代码优先方法中的列设置小数(16、3)[重复]