Data Storage in Shiny App using RODBC

Question

I stumbled across this article the other day: http://deanattali.com/blog/shiny-persistent-data-storage/#sqlite, and wanted to try it out for myself.

However I have to use RODBC and that is not talked about in the article.

Currently I have tried this:

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

    }
)

This is basically the same as in the article and the application runs, and no errors are shown, however no information is read back into my database table.

When doing a normal insert into statement like this:

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

It works so I know that is not the problem.

Answer 1

I am astounded the blog method yields desired results as R's c function bleeds into the query as string literal and every value in each column is concatenated and stored as one row strings with embedded commas. To demonstrate with random letter data:

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\")')"

However, for your specific needs to align to SQL Server's dialect, consider building values sets with apply loop and then concatenate to larger query string:

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')"

Moreover, consider RODBC's sqlSave to append entire dataframe to database:

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

Answer 2

I would recommend rewriting your saveData function to use RODBCext. Parameterizing the query will help you clarify what the final query looks like, and will protect against SQL injection.

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