Question

前几天我偶然发现了这篇文章：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')

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

Answer 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
      )
    }

Answer 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)

使用RODBC在Shiny App中存储数据

2 个答案: