Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/78.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
使用RODBC在Shining应用程序中存储数据_R_Shiny_Rodbc - Fatal编程技术网

使用RODBC在Shining应用程序中存储数据

使用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_

前几天我无意中发现了这篇文章:,我想自己试一试

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

    }
)

它可以工作,因此我知道这不是问题。

我建议重写
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)