Shiny R: How to save list of checkbox inputs from datatable?

Question

I am trying to save input from a checkbox table (see here) adapted from [here][2], once the actionButton has been clicked. Ideally, I would like a list of chosen boxes within one dataframe column, and the username as row name.

I tried it with the below syntax, by storing the responses in a list and then appending them to an existing csv.file.

    library(shiny)
    library(DT)

    answer_options<- c("reading", "swimming",
         "cooking", "hiking","binge- watching series",
         "other") 

    question2<- "What hobbies do you have?"

    shinyApp(
      ui = fluidPage(
        h2("Questions"),
        p("Below are a number of statements, please indicate your level of agreement"),


        DT::dataTableOutput('checkbox_matrix'),
        verbatimTextOutput('checkbox_list'),

        textInput(inputId = "username", label= "Please enter your username"),
        actionButton(inputId= "submit", label= "submit")
      ),


      server = function(input, output, session) {

          checkbox_m = matrix(
            as.character(answer_options), nrow = length(answer_options), ncol = length(question2), byrow = TRUE,
            dimnames = list(answer_options, question2)
          )

          for (i in seq_len(nrow(checkbox_m))) {
            checkbox_m[i, ] = sprintf(
              '<input type="checkbox" name="%s" value="%s"/>',
              answer_options[i], checkbox_m[i, ]
            )
          }
          checkbox_m
      output$checkbox_matrix= DT::renderDataTable(
        checkbox_m, escape = FALSE, selection = 'none', server = FALSE, 
        options = list(dom = 't', paging = FALSE, ordering = FALSE),
        callback = JS("table.rows().every(function(i, tab, row) {
                      var $this = $(this.node());
                      $this.attr('id', this.data()[0]);
                      $this.addClass('shiny-input-checkbox');
    });
                      Shiny.unbindAll(table.table().node());
                      Shiny.bindAll(table.table().node());")
      )



        observeEvent(input$submit,{
          # unlist values from json table
          listed_responses <- sapply(answer_options, function(i) input[[i]])

          write.table(listed_responses,
                      file = "responses.csv",
                      append= TRUE, sep= ',',
                      col.names = TRUE)
        })
        }
        )

All I get is Warning in :

write.table(listed_responses, file = "responses.csv", append = TRUE, :appending column names to file

Besides the warning, nothing is being saved in the .csv file and I am not sure what exactly I am missing.

How do you correctly save a list of checked boxes from a datatable?

score 4 · Accepted Answer · answered Mar 21 '18 at 23:00

Error Message

The error comes from using col.names = TRUE and append = TRUE in the same call to write.table. For example:

write.table(mtcars, "test.csv", append = TRUE, sep = ",", col.names = TRUE)
# Warning message:
# In write.table(mtcars, "test.csv", append = TRUE, sep = ",", col.names = TRUE) :
#  appending column names to file

write.table wants you to know that it's adding a row of column names to your csv. Since you likely don't want a row of column names between each set of answers, it's probably cleaner to only use append = TRUE when col.names = FALSE. You could use if...else to write two different forms for saving your csv, one to create the file and one to append subsequent responses:

if(!file.exists("responses.csv")) {
    write.table(responses, 
                "responses.csv", 
                col.names = TRUE, 
                append = FALSE,
                sep = ",")
} else {
    write.table(responses, 
                "responses.csv", 
                col.names = FALSE, 
                append = TRUE, 
                sep = ",")
}

Empty csv

Your csv is blank is because your checkboxes aren't getting properly bound as inputs. We can see this by adding these lines to your app:

server = function(input, output, session) {
   ...
   output$print <- renderPrint({
        reactiveValuesToList(input)
   })
}
ui = fluidPage(
    ...
    verbatimTextOutput("print")
)

Which lists all of the inputs in your app:

The checkboxes are not listed in input. So listed_responses will contain a list of NULL values, and write.table will save a csv with empty rows.

I didn't look into why your js didn't work, but yihui's method for making a datatable with checkboxes seems to work well:

# taken from https://github.com/rstudio/DT/issues/93/#issuecomment-111001538
# a) function to create inputs
shinyInput <- function(FUN, ids, ...) {
      inputs <- NULL
      inputs <- sapply(ids, function(x) {
      inputs[x] <- as.character(FUN(inputId = x, label = NULL, ...))
            })
      inputs
 }
 # b) create dataframe with the checkboxes
 df <- data.frame(
            Activity = answer_options,
            Enjoy = shinyInput(checkboxInput, answer_options),
            stringsAsFactors = FALSE
 )
 # c) create the datatable
 output$checkbox_table <- DT::renderDataTable(
            df,
            server = FALSE, escape = FALSE, selection = 'none',
            rownames = FALSE,
            options = list(
                dom = 't', paging = FALSE, ordering = FALSE,
                preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
       )
 )

Full Example

Here's an example with both fixes. I also added modals to alert the user when they'd successfully submitted the form or if they're missing their username. I clear the form after it has been submitted.

library(shiny)
library(DT)

shinyApp(
    ui =
        fluidPage(
            # style modals
            tags$style(
                HTML(
                    ".error {
                    background-color: red;
                    color: white;
                    }
                    .success {
                    background-color: green;
                    color: white;
                    }"
                    )),
            h2("Questions"),
            p("Please check if you enjoy the activity"),
            DT::dataTableOutput('checkbox_table'),
            br(),
            textInput(inputId = "username", label= "Please enter your username"),
            actionButton(inputId = "submit", label= "Submit Form")
        ),

    server = function(input, output, session) {

        # create vector of activities
        answer_options <- c("reading",
                            "swimming",
                            "cooking",
                            "hiking",
                            "binge-watching series",
                            "other")

        ### 1. create a datatable with checkboxes ###
        # taken from https://github.com/rstudio/DT/issues/93/#issuecomment-111001538
        # a) function to create inputs
        shinyInput <- function(FUN, ids, ...) {
            inputs <- NULL
            inputs <- sapply(ids, function(x) {
                inputs[x] <- as.character(FUN(inputId = x, label = NULL, ...))
            })
            inputs
        }
        # b) create dataframe with the checkboxes
        df <- data.frame(
            Activity = answer_options,
            Enjoy = shinyInput(checkboxInput, answer_options),
            stringsAsFactors = FALSE
        )
        # c) create the datatable
        output$checkbox_table <- DT::renderDataTable(
            df,
            server = FALSE, escape = FALSE, selection = 'none',
            rownames = FALSE,
            options = list(
                dom = 't', paging = FALSE, ordering = FALSE,
                preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
            )
        )

        ### 2. save rows when user hits submit -- either to new or existing csv ###
        observeEvent(input$submit, {
            # if user has not put in a username, don't add rows and show modal instead
            if(input$username == "") {
                showModal(modalDialog(
                    "Please enter your username first", 
                    easyClose = TRUE,
                    footer = NULL,
                    class = "error"
                ))
            } else {
                responses <- data.frame(user = input$username,
                                        activity = answer_options,
                                        enjoy = sapply(answer_options, function(i) input[[i]], USE.NAMES = FALSE))

                # if file doesn't exist in current wd, col.names = TRUE + append = FALSE
                # if file does exist in current wd, col.names = FALSE + append = TRUE
                if(!file.exists("responses.csv")) {
                    write.table(responses, "responses.csv", 
                                col.names = TRUE, 
                                row.names = FALSE,
                                append = FALSE,
                                sep = ",")
                } else {
                    write.table(responses, "responses.csv", 
                                col.names = FALSE, 
                                row.names = FALSE,
                                append = TRUE, 
                                sep = ",")
                }
                # tell user form was successfully submitted
                showModal(modalDialog("Successfully submitted",
                                      easyClose = TRUE,
                                      footer = NULL,
                                      class = "success")) 
                # reset all checkboxes and username
                sapply(answer_options, function(x) updateCheckboxInput(session, x, value = FALSE))
                updateTextInput(session, "username", value = "")
            }
        })
    }
)

Thank a lot for your time to respond. It does exactly what I'd like it to do! — mizzlosis, Mar 22 '18 at 08:19
@jkhuc Happy to help, and welcome to Stack Overflow! If this answer solved your issue, consider marking it as accepted — Hallie Swan, Mar 22 '18 at 15:51

Shiny R: How to save list of checkbox inputs from datatable?

1 Answers1

Error Message

Empty csv

Full Example