从服务器运行时，闪亮的会话消失

如何解决从服务器运行时，闪亮的会话消失

我下面有一个闪亮的应用程序，它显示服务器端sqlite文件中的文件内容 我想每周从csv上传文件中覆盖我闪亮的服务器上的sqlite，并通过应用进行过滤

• 当我从RStudio的闪亮运行中更新sqlite文件时，我获得了新内容，可以使用它并可以按预期上传多个新内容
• 当我在浏览器中的闪亮服务器上运行相同的应用程序时，在通过“浏览”上传新的csv后（一旦成功），只要单击“上传”按钮，我就会与服务器断开连接。
li>

有人可以解释一下这种行为吗

我怀疑：：p

  observeEvent(input$Upload,{
    if(is.null(input$Browse))
    {
      return(NULL)
    }
    else
    {
      file <- input$Browse
      createDB(file$datapath,basename(file$name),dbfile)
      shinyalert(paste(basename(file$name),"database uploaded,please refresh the session",sep=" "),type = "success",timer=2000)
    }
  }) 

REM：虽然不是闪亮的警报

我的完整应用代码：

# accounts.shinyapp
# R/shiny tool to filter the weekly accounts_filtered.csv

library("shiny")
library("shinyBS")
library("shinyalert")
library("RSQLite")
library("DT")

# you may un-comment the next line to allow 10MB input files
options(shiny.maxRequestSize=10*1024^2)
# the following test checks if we are running on shinnyapps.io to limit file size dynamically
# ref: https://stackoverflow.com/questions/31423144/how-to-know-if-the-app-is-running-at-local-or-on-server-r-shiny/31425801#31425801
#if ( Sys.getenv('SHINY_PORT') == "" ) { options(shiny.maxRequestSize=1000*1024^2) }

# App defaults
app.name <- "accounts"
script.version <- "1.0b"
version <- "NA"
names <- c("Last","First","Email","Phone","Level","DeptNum","Code","Short","Logon","Location")

# database functions
createDB <- function(filepath,filename,dbfile){
  data <- read_csv(filepath,locale = locale(encoding = "ISO-8859-2",asciify = TRUE))
  # give proper english names to columns
  colnames(data) <- names
  data$Email <- tolower(data$Email)
  version <- data.frame(version=filename)
  
  # create sqlite and save
  mydb <- dbConnect(RSQLite::SQLite(),dbfile)
  dbWriteTable(mydb,"data",data,overwrite=TRUE)
  dbWriteTable(mydb,"version",version,overwrite=TRUE)  
  dbDisconnect(mydb)
}

loadDB <- function(dbfile){
  mydb <- dbConnect(RSQLite::SQLite(),dbfile)
  data <- dbReadTable(mydb,"data")
  version <- dbReadTable(mydb,"version")
  dbDisconnect(mydb)
  # return resulting data.frame
  return(list(data = as.data.frame(data),version = as.data.frame(version)))
}

# initial DB creation
# infile <- "Data/ori_accounts_filtered.csv"
# createDB(infile,basename(infile),dbfile)

#############################
# Define UI for application # 
#############################

ui <- fluidPage(
  
  useShinyalert(),HTML('<style type="text/css">
       .row-fluid { width: 25%; }
       .well { background-color: #99CCFF; }
       .shiny-html-output { font-size: 14px; line-height: 15px; }
       </style>'),# Application header
  headerPanel("Filter the weekly accounts list"),# Application title
  titlePanel(
    windowTitle = "accounts",tags$a(href="https://http://someIP:8787/accounts",target="_blank",img(src='logo.png',align = "right",width="150",height="58.5",alt="myApp"))
  ),sidebarLayout(
    # show file import weekly update csv data
    sidebarPanel(
  
      tags$h5(paste(app.name," version: ",script.version,sep="")),tipify(fileInput("Browse","Choose new Weekly update:",accept = ".csv"),"a accounts_filtered.csv file"),tipify(actionButton("Upload","Upload new table"),"This will replace the current database content!"),hr(),checkboxGroupInput("show_vars","Check columns to be shown:",names,selected = names[c(1:4,6)]),tipify(actionButton("Refresh","Refresh Session"),"This will reload the database content!")

    ),mainPanel(
      
      htmlOutput("version_tag"),dataTableOutput('dataTable')
      
    )
  )
)

#######################
# Define server logic #
#######################

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

  # initialize content at startup
  dbfile <- "Data/data.sqlite"
  # load both data and version
  mydat <- loadDB(dbfile)
  version <- mydat$version[1,1]
  accounts <- mydat$data
  names <- colnames(accounts)

  output$version_tag <- renderText({
    paste("<b>Data file: ","</b>")
    })

  observeEvent(input$Refresh,{
    session$reload()
    })
  
  observeEvent(input$Upload,timer=2000)
    }
  })
  
  output$dataTable <- renderDT(
        accounts[,input$show_vars],# data
        class = "display nowrap compact",# style
        filter = "top",# location of column filters
        options = list(pageLength = 20,autoWidth = TRUE),rownames= FALSE
        )

}

# Run the application 
shinyApp(ui = ui,server = server)

解决方法

这不见了。

library("readr")