使用 RODBC 在 Shiny App 中存储数据

Posted 2023-05-07

【中文标题】使用 RODBC 在 Shiny App 中存储数据

【英文标题】：Data Storage in Shiny App using RODBC

【发布时间】：2017-08-08 18:46:01

【问题描述】：

前几天我偶然发现了这篇文章：http://deanattali.com/blog/shiny-persistent-data-storage/#sqlite，并想亲自尝试一下。

但是我必须使用 RODBC，这在文章中没有讨论。

目前我已经尝试过：

table <- "[shinydatabase].[dbo].[response]"

fieldsMandatory <- c("name", "favourite_pkg")

labelMandatory <- function(label) 
  tagList(
    label,
    span("*", class = "mandatory_star")
  )


appCSS <-
  ".mandatory_star  color: red; "


fieldsAll <- c("Name", "favpkg", "used_shiny", "num_years", "os_type")

shinyApp(
  ui = fluidPage(
    shinyjs::useShinyjs(),
    shinyjs::inlineCSS(appCSS),
    titlePanel("Mimicking a Google Form with a Shiny app"),

    div(
      id = "form",

      textInput("name", labelMandatory("Name"), ""),
      textInput("favourite_pkg", labelMandatory("Favourite R package")),
      checkboxInput("used_shiny", "I've built a Shiny app in R before", FALSE),
      sliderInput("r_num_years", "Number of years using R", 0, 25, 2, ticks = FALSE),
      selectInput("os_type", "Operating system used most frequently",
                  c("",  "Windows", "Mac", "Linux")),
      actionButton("submit", "Submit", class = "btn-primary")
    )

  ),

  server = function(input, output, session) 
    observe(
      mandatoryFilled <-
        vapply(fieldsMandatory,
               function(x) 
                 !is.null(input[[x]]) && input[[x]] != ""
               ,
               logical(1))
      mandatoryFilled <- all(mandatoryFilled)
      shinyjs::toggleState(id = "submit", condition = mandatoryFilled)

    )

    formData <- reactive(
      data <- sapply(fieldsAll, function(x) input[[x]])
    )

    saveData <- function(data) 
      # Connect to the database
      db<- odbcConnect(".", uid = "uid", pwd = "pwd")
      # Construct the update query by looping over the data fields
      query <- sprintf(
        "INSERT INTO [shinydatabase].[dbo].[response] (Name, favpkg, used_shiny, num_years, os_type) VALUES ('%s')",
        paste(data, collapse = "', '")
      )
      # Submit the update query and disconnect
      sqlQuery(db, query)
      odbcClose(db)
    

    loadData <- function() 
      # Connect to the database
      odbcChannel<- odbcConnect(".", uid = "uid", pwd = "pwd")
      # Construct the fetching query
      query <- sprintf("SELECT * FROM [shinydatabase].[dbo].[response]")
      # Submit the fetch query and disconnect
      data <- sqlQuery(db, query)
      odbcClose(db)
      data
    

    # action to take when submit button is pressed
    observeEvent(input$submit, 
      saveData(formData())
    )

    
)

这与文章中的基本相同，应用程序运行，没有显示错误，但是没有信息被读回我的数据库表中。

当像这样进行正常的插入语句时：

sqlQuery(db, "INSERT INTO [shinydatabase].[dbo].[response] (Name, favpkg, used_shiny, num_years, os_type) VALUES ('a', 'b', 'yes', '2','mac')

它有效，所以我知道这不是问题。

【参考方案1】：

我建议重写您的 saveData 函数以使用 RODBCext。参数化查询将帮助您阐明最终查询的样子，并防止 SQL 注入。

saveData <- function(data) 
      # Connect to the database
      db<- odbcConnect(".", uid = "uid", pwd = "pwd")
      # make sure the connection is closed even if an error occurs.
      on.exit(odbcClose(db))

      sqlExecute(
        channel = db,
        query = "INSERT INTO [shinydatabase].[dbo].[response] 
                 (Name, favpkg, used_shiny, num_years, os_type) 
                 VALUES
                 (?, ?, ?, ?, ?)",
        data = data
      )
    

【参考方案2】：

我很惊讶博客方法产生了预期的结果，因为 R 的 c 函数作为字符串文字渗入查询中，并且每列中的每个值都被连接并存储为嵌入逗号的一行字符串。用随机字母数据进行演示：

sample.seed(111)
data <- data.frame(col1 = sample(LETTERS, 5),
                   col2 = sample(LETTERS, 5),
                   col3 = sample(LETTERS, 5),
                   col4 = sample(LETTERS, 5),
                   col5 = sample(LETTERS, 5), stringsAsFactors = FALSE)

query <- sprintf(
  "INSERT INTO [shinydatabase].[dbo].[response] (Name, favpkg, used_shiny, num_years, os_type) VALUES ('%s')",
  paste(data, collapse = "', '")
)

query
# [1] "INSERT INTO [shinydatabase].[dbo].[response] (Name, favpkg, used_shiny, 
# num_years, os_type) VALUES ('c(\"E\", \"C\", \"I\", \"U\", \"B\")',
# 'c(\"F\", \"W\", \"R\", \"O\", \"L\")', 'c(\"Q\", \"V\", \"M\", \"T\", \"I\")', 
# 'c(\"Y\", \"V\", \"C\", \"M\", \"O\")', 'c(\"A\", \"V\", \"U\", \"I\", \"D\")')"

但是，为了符合 SQL Server 方言的特定需求，请考虑使用 apply 循环构建值集，然后连接到更大的查询字符串：

vals <- paste(apply(data, 1, function(d) paste0("('", paste(d, collapse = "', '"), "')")), collapse = ", ")

query <- sprintf("INSERT INTO [shinydatabase].[dbo].[response] ([Name], favpkg, used_shiny, num_years, os_type) VALUES %s", vals)    
query
# [1] "INSERT INTO [shinydatabase].[dbo].[response] (Name, favpkg, used_shiny, num_years, os_type) 
# VALUES ('E', 'F', 'Q', 'Y', 'A'), ('C', 'W', 'V', 'V', 'V'),  ('I', 'R', 'M', 'C', 'U'), 
# ('U', 'O', 'T', 'M', 'I'), ('B', 'L', 'I', 'O', 'D')"

此外，考虑 RODBC 的 sqlSave 将整个数据框附加到数据库：

sqlSave(db, data,  tablename = "response", append = TRUE, rownames = FALSE)