使用RODBC的Shiny App中的数据存储

问题描述：

前几天偶然发现了这篇文章：http://deanattali.com/blog/shiny-persistent-data-storage/#sqlite，并且想为自己尝试一下。使用RODBC的Shiny App中的数据存储

但是我必须使用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()) 
    }) 

    } 
)

这基本上是一样的文章和应用程序运行的，并且没有显示错误，但没有信息被读回我的数据库表。

在做一个正常的INSERT INTO说法是这样的：

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

它的工作原理，所以我知道这是没有问题的。

答

我建议您将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 
    ) 
    }

答

我惊讶的博客方法产生所需的结果为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中的数据存储

相关推荐