闪亮的 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 举一个最简单的示例，我们可以帮助您完成它。
作为一名志愿者，我正在开发一个闪亮的应用程序，试图制作一个应用程序，该应用程序可以注册公民在当地红十字会办公室封锁期间的所有电话。我已设法获得报名表并查看 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 举一个最简单的示例，我们可以帮助您完成它。