R Shiny MySQL 上传动作按钮

Question

我正在开发一个 shinydashboard 来 upload/append 我定期获取的一些 csv 文件到 MySQL 数据库。到目前为止，该应用程序做了三件事。

允许指定要上传的 csv 文件。
允许作为新列添加到数据中的项目编号的文本输入。
用于启动上传并显示上传数据的操作按钮。

问题第一次上传工作正常。当我通过浏览或删除文件来上传第二个文件时，应用程序会在我按下操作按钮之前上传新文件，因此它会在我更改项目编号之前上传。如果我对文本输入进行任何更改，它也会开始新的上传

示例文件和架构结构已简化并显示如下。任何关于我遗漏或误用的代码的线索都将不胜感激。

test.csv
v1,v2,v3
33,78,44
4,49,15
87,132,98

数据库模式名为 shiny，table 名为 table1，列如下：
id - 主键，自增。
pn - varchar(10).
v1 - varchar(10).
v2 - varchar(10).
v3 - varchar(10).

闪亮代码如下

## app.R ##
library(shiny)
library(shinydashboard)
library(DT)
library(RMySQL)

# Database access information
user = 'root'
password = 'password'
host = 'host'
dbname='shiny'

ui <- dashboardPage(
  
  
  dashboardHeader(title = "Shiny SQL Upload App"),
  
  #### Main Sidebar Menu Items ####
  dashboardSidebar(width = 120,
                   sidebarMenu(
                     menuItem("Upload", tabName = "aa", icon = icon("dashboard")),
                     menuItem("Menu2", tabName = "bb", icon = icon("dashboard")),
                     menuItem("Menu3", tabName = "cc", icon = icon("dashboard")),
                     menuItem("Menu4", tabName = "dd", icon = icon("dashboard"))
                   ) # End sidebarMenu
  ), #End dashboardSidebar
  
  #### Main Body Content ####
  dashboardBody(
    shinyDashboardThemes(theme = "poor_mans_flatly"),
    tabItems(
      
      tabItem(tabName = "aa", # Start of Menu Item 1 aa
              fluidRow(
                tabBox(
                  width = 6,
                  id = "tabset1",
                  tabPanel("Up Load File", # Start of 1st subtab to first menu item
                           { 
                             sidebarLayout( # Sidebar style for subtab
                               sidebarPanel( # Sidebar panel details and content
                                 width = 7,
                                 fileInput("file1", label = "File input", accept = c(".xlsx", ".xls", ".csv", ".ods")),
                                 textInput("pn", "Project Number or Name", value = "", width = NULL, placeholder = NULL),
                                 actionButton("go", "Upload")
                               ), # End of sidebarPanel
                               mainPanel( # Main panel details and content
                                 width = 3,
                                 tableOutput("contents")
                                 
                               ) # End of mainPanel
                             ) # End of sidebarLayout
                           }
                  ), # End of tabPanel
                  
                  tabPanel("Instructions for Upload", # Start of 2nd subtab to first menu item
                           {
                             mainPanel(
                               "Insert instructions for upload here..." 
                             ) # End of mainPanel
                           }
                  ) # End of tabPanel
                ) # End of tabBox
              ) # End of fluidRow
      ), # End of tabItem menu Item 1
      
      #secondtab contents  menu bb
      tabItem(tabName = 'bb',
              h2("Menu 2 Tab Heading"),
              "text2 text2 text2 text2 text2"
      ),
      
      #third tab contents  menu cc
      tabItem(tabName = "cc",
              h2("Menu 3 Tab Heading"),
              "text3 text3 text3 text3 text3"
      ),
      
      #third tab contents menu dd
      tabItem(tabName = "dd",
              h2("Menu 4 Tab Heading"),
              "text4 text4 text4 text4 text4"
      )
    )
  )
)


server <- function(input, output) {
  observeEvent(input$go, {
    output$contents = 
      renderTable({
        inFile <- input$file1
        
        if (is.null(inFile))
          return(NULL)
        #connect to database 
        con <- dbConnect(MySQL(),
                         user = user,
                         password = password,
                         host = host,
                         dbname = dbname)
        data = read.csv(inFile$datapath, header = TRUE) # csv file contents to data dataframe
        data = mutate(data, pn = input$pn) # add project name to dataframe
        data <- data[,c(ncol(data),1:(ncol(data)-1))]  # move last col to first col
        dbWriteTable(conn = con, name = 'table1', value = data, append = TRUE, header = TRUE, row.names=FALSE) # upload dataframe to MySQL database
        lapply(dbListConnections(MySQL()), dbDisconnect) # close database connection
        data # Show data uploaded
      }
      )
  }
  )
}

shinyApp(ui, server)

Answer 1

试试这个

server <- function(input, output) {
 
  mydata <- eventReactive(input$go, {
    inFile <- input$file1
    if (is.null(inFile)) return(NULL)
    
    data = read.csv(inFile$datapath, header = TRUE) # csv file contents to data dataframe
    data = mutate(data, pn = input$pn) # add project name to dataframe
    data <- data[,c(ncol(data),1:(ncol(data)-1))]  # move last col to first col
    data
  })
  output$contents <- renderTable({
    req(mydata())
    #connect to database 
    con <- dbConnect(MySQL(),
                     user = user,
                     password = password,
                     host = host,
                     dbname = dbname)
    dbWriteTable(conn = con, name = 'table1', value = mydata(), append = TRUE, header = TRUE, row.names=FALSE) # upload dataframe to MySQL database
    lapply(dbListConnections(MySQL()), dbDisconnect) # close database connection
    mydata() # Show data uploaded
  })
}

R Shiny MySQL 上传动作按钮

R Shiny MySQL Upload actionButton

mysql

r

shiny

reactive