使用RODBC在Shining应用程序中存储数据
前几天我无意中发现了这篇文章:,我想自己试一试 但是,我必须使用RODBC,这在本文中没有讨论 目前我已经尝试过:使用RODBC在Shining应用程序中存储数据,r,shiny,rodbc,R,Shiny,Rodbc,前几天我无意中发现了这篇文章:,我想自己试一试 但是,我必须使用RODBC,这在本文中没有讨论 目前我已经尝试过: table <- "[shinydatabase].[dbo].[response]" fieldsMandatory <- c("name", "favourite_pkg") labelMandatory <- function(label) { tagList( label, span("*", class = "mandatory_
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())
})
}
)
它可以工作,因此我知道这不是问题。我建议重写
saveData
函数以使用rodbext
。参数化查询将帮助您澄清最终查询的外观,并防止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
)
}
saveData当R的c
函数以字符串文本的形式进入查询时,blog方法会产生所需的结果,并且每列中的每个值都被连接并存储为带有嵌入逗号的单行字符串。要使用随机字母数据演示:
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\")')"
此外,考虑RODBC的代码> SqLaveS/<代码>将整个DATAFAFRAMS附加到数据库:
sqlSave(db, data, tablename = "response", append = TRUE, rownames = FALSE)
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')"
sqlSave(db, data, tablename = "response", append = TRUE, rownames = FALSE)