问题描述
在有人建议我从 sqlite 迁移到 Postgres 以进行扩展和多事务管理后，我在我的 Shinyapp 上使用 rhandsontable 时遇到了问题。我认为至少在闪亮的应用程序层上的过程不会那么不同。用户发送的更新、删除行和所有其他查询在 Postgres 上都可以正常工作。我在添加新数据（行）时遇到了一个问题，当我将下面的代码集成到 sqlite 时，它运行良好，但是当我尝试保存时，在连接到 Postgresql 时出现以下错误。
我在 rhandsontable 包上看到了多篇关于这个问题的 GitHub 帖子，但似乎除了更新包的要求之外没有明确的答案。
警告：seq.default 中的错误：参数“length.out”的长度必须为 1 79：停止 78：seq.default 76：genRowHeaders 75： 73：hot_to_r 72：observeEventHandler [模块/数据库/Truck_Receipts_Database.R#50] 1：运行应用
Truck_Receipts_UI <- function(id) {
ns <- NS(id)
tagList(
sidebarLayout(
absolutePanel(id = "controls",class = "panel panel-default",fixed = TRUE,draggable = TRUE,top = 250,left = "auto",right = 20,bottom = "auto",width = 230,height = "auto",h2(strong("Control Menu")),shinyalert("shinyalert2",FALSE,auto.close.after = 2),selectInput(ns("dataset"),"Blasting Database",choices = c("blasting1")),actionButton(ns("saveBtn"),"Save Changes",class = "btn-info"),hr(),radioButtons(ns("filetype"),"File-type Selector",choices = c("csv")),downloadButton(ns('downloadData'),'Download Data',class = "btn-primary"),fileInput(inputId = ns("fileDrive"),label = "Upload Transactions Verification Documents",accept = NULL)
),mainPanel(
fluidRow(
style='height:40vh',br(),withSpinner(rHandsontableOutput(ns('tabletest'),height = "75vh" ))
),width = 12),position = c("right")
)
)
}
Truck_Receipts <- function(input,output,session,pool) {
tableChoozer<-reactive({ input$dataset })
p1<-reactive({
results<-dbGetQuery(pool,paste('SELECT * FROM ',tableChoozer()))
return(results)
})
data_base<-function(){dbGetQuery(pool,paste('select * from ',tableChoozer()))}
observe({
if (input$saveBtn == 0)
return()
showshinyalert(session,"shinyalert2",paste("Database updated"),styleclass = "warning")
})
Mychanges<-reactive({
observeEvent(
input$saveBtn,{
p1<-data_base()
drops<-c("Comment" )
if(any(is.na(hot_to_r(input$tabletest))[,!(names(hot_to_r(input$tabletest))%in%drops)]))
{
#make no changes #incomplete data entry
as.data.frame(hot_to_r(input$tabletest))
#pop ups must be here
}else{
if((NROW(p1())!=NROW(hot_to_r(input$tabletest)))&&(!identical(p1,hot_to_r(input$tabletest)))){
stackeddf<-rbind(hot_to_r(input$tabletest),p1)
finaldf<-unique(stackeddf)
if((NROW(hot_to_r(input$tabletest))>NROW(p1()))&&(NROW(p1())<NROW(finaldf))&&(identical(finaldf,hot_to_r(input$tabletest)))
){
# new data entry
#works well on sqlite
dbWriteTable(pool,tableChoozer(),finaldf,overwrite=T,append=F,row.names=F)
#I tried using insert by row to see if it will solve the problem but still does not work,the following commented out code works well outside of the application
# new_df<-setdiff(tableChoozer(),finaldf)
#add the compare feature #hope it works
#last_rows<-tail(blasting2,n = 2)
# x<-c()
# for (i in 1:NROW(new_df)){
# x[[i]]<-dput(as.character(paste(new_df[i,])))
# }
# d<-gsub("\\]",")",gsub("\\[","(",jsonlite::toJSON(x)))
# bb<-gsub("\"","\'",d)
# BB<-substring(bb,2,nchar(bb)-1)
#paste("testing",BB,";")
# dbGetQuery(pool,paste("INSERT INTO blasting1(
# id,date,shift,time_in,time_out,reference_no,service_provider,product_code,blasted_quantity,comment)
# VALUES",";"))
#dbGetQuery(pool,paste("INSERT INTO blasting1(
#id,comment)
#VALUES hot_to_r(input$tabletest$select$rAll);"))
}else if((NROW(hot_to_r(input$tabletest))>NROW(p1()))&&(NROW(p1())<NROW(finaldf))&&(!identical(finaldf,hot_to_r(input$tabletest))) ){
#multiple users capturing
dbWriteTable(pool,row.names=F)
}
else if((NROW(hot_to_r(input$tabletest))<NROW(p1()))&&(NROW(p1())==NROW(finaldf))
){
#remove existing data
dbWriteTable(pool,hot_to_r(input$tabletest),row.names=F)
}
}else{
if((NROW(p1)==NROW(hot_to_r(input$tabletest)))&&
(identical(p1,hot_to_r(input$tabletest)))
){
#make no changes
as.data.frame(hot_to_r(input$tabletest))
}
else if(
(NROW(p1())==NROW(hot_to_r(input$tabletest)))&&(!identical(p1(),hot_to_r(input$tabletest)))
){
#replacing data
dbWriteTable(pool,row.names=F)
}
}
}
},ignoreInit = T)
#inception dataframe pull
if(TRUE){
return(p1())}
})
output$tabletest<-renderRHandsontable({
rhandsontable( Mychanges(),search = TRUE)%>%
hot_cols(columnSorting = TRUE,highlightCol = TRUE,highlightRow = TRUE,manualColumnResize = T) %>%
hot_cols(fixedColumnsLeft = 2) %>%
# hot_cell(1,1,"")%>%
# hot_col(col = "Date",type = "date",dateFormat = "YYYY-MM-DD")%>%
# hot_cols(fixedColumnsLeft = 2)%>% hot_col(col = "Shift",type = "autocomplete",source = c("A","B","C"),strict = FALSE)%>%
# hot_col(col = "Shift",strict = FALSE)%>%
# hot_col(col = "supplier details",source = c("FT000001 - Fertiliser raw","NT000001 - nitrogen",# "PH00001 - Phosphate","OTRW0000 - Other","PF00000 - Packaging material"),strict = FALSE)%>%
# hot_col(col = "Bin code",source = c("1001 - Finished product","1002 - Raw materials","1003 - Packaging","1006 - Blend","1010 - Coal"),strict = FALSE)%>%
# hot_col(col = "Pack size",source = c("2 kg","5 kg","10 kg","25 kg","37.50 kg","50 kg","1000 kg","1250 kg","1500 kg","Bulk","BG"),strict = FALSE)%>%
# hot_col(col = "Product code",source =dput(as.character(paste(Product_codes()[[2]],Product_codes()[[1]],sep="-"))),strict = FALSE)%>%
# hot_cols(renderer = "
# function (instance,td,row,col,prop,value,cellProperties) {
# Handsontable.renderers.TextRenderer.apply(this,arguments);
# var isValid = /^([0-1]?[0-9]|2[0-4]):([0-5][0-9])(:[0-5][0-9])?$/;
# if (value < 0) {td.style.background = 'pink';}
# if(col==2&& !isValid.test(value)) {td.style.background = 'pink';}
# if(col==3&& !isValid.test(value)) {td.style.background = 'pink';}
# if(col==1&&!['A','B','C'].includes(value)){td.style.background = 'pink';}
# }")%>%
hot_context_menu(
customOpts = list(
search = list(name = "Search",callback = htmlwidgets::JS(
"function (key,options) {
var srch = prompt('Search criteria');
this.search.query(srch);
this.render();
}")))) %>%
hot_cell(1,3,"")
})
output$downloadData<-downloadHandler(
filename = function(){paste("table.csv")},content = function(file){
sep <- switch(input$filetype,"csv" = ",")
write.table(p1(),file,sep = sep,row.names = FALSE)}
)
observe({
if (is.null(input$fileDrive)) return()
file.copy(input$fileDrive$datapath,file.path(paste(getwd(),"/truck_receipts_v",sep = ""),input$fileDrive$name),overwrite = TRUE) #used for local testing
# file.copy(input$fileDrive$datapath,file.path("/mnt/persistent/truck_receipts_v",overwrite = TRUE) #server side
})
}
解决方法
这个问题在rhandsontable github页面上被问过多次。我查看了以下内容以重现错误。
以下代码重现错误：
library(shiny)
library(rhandsontable)
ui <- function() {
fluidRow(actionButton(inputId = "download",label = "Save"),rHandsontableOutput("tab")
)
# fluidRow()
}
server <- function(input,output,session) {
output$tab <- renderRHandsontable({
rhandsontable(mtcars)
print (mtcars)
#output$tab <- renderRHandsontable({
# if (!is.null(input$tab)) {
# DF = hot_to_r(input$tab)
# } else {
# DF = mtcars
# }
# rhandsontable(DF)
#})
})
save <- observe({
if(input$download == 0) return()
saveRDS(hot_to_r(input$tab),file = "test.rds")
print(hot_to_r(input$tab))
})
}
shinyApp(ui = ui,server = server)
以下解决了 jrowen 在其中一个问题帖子中提出的问题。
library(shiny)
library(rhandsontable)
ui <- function() {
fluidRow(actionButton(inputId = "download",rHandsontableOutput("tab")
)
# fluidRow()
}
server <- function(input,session) {
#output$tab <- renderRHandsontable({
# rhandsontable(mtcars)
# print (mtcars)
output$tab <- renderRHandsontable({
if (!is.null(input$tab)) {
DF = hot_to_r(input$tab)
} else {
DF = mtcars
}
rhandsontable(DF)
#})
})
save <- observe({
if(input$download == 0) return()
saveRDS(hot_to_r(input$tab),file = "test.rds")
print(hot_to_r(input$tab))
})
}
shinyApp(ui = ui,server = server)
所以就上述问题而言，我只是添加了以下内容，然后崩溃问题就停止了。
output$tabletest<-renderRHandsontable({
if (!is.null(input$tabletest)) {
DF = hot_to_r(input$tabletest)
} else {
DF = Mychanges()
}
rhandsontable(DF,search = TRUE)%>%
hot_cols(columnSorting = TRUE,highlightCol = TRUE,highlightRow = TRUE,manualColumnResize = T) %>%
hot_cols(fixedColumnsLeft = 2) %>%