Shiny R: Как сохранить список входов флажков из данных?

Сообщение об ошибке

Ошибка возникает из-за использования col.names = TRUE и append = TRUE в том же вызове write.table. Например:

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 хочет, чтобы вы знали, что он добавляет строку имен столбцов в ваш csv. Поскольку вы, вероятно, не хотите, чтобы между именами наборов ответов была col.names = FALSE строка с именами столбцов, вероятно, более чистым было бы использовать append = TRUE когда col.names = FALSE. Вы можете использовать if...else чтобы написать две разные формы для сохранения вашего csv: один для создания файла и один для добавления последующих ответов:

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 = ",")
}

Пустой csv

Ваш csv пуст, потому что ваши флажки не получают должным образом привязки в качестве входных данных. Мы можем это увидеть, добавив эти строки в ваше приложение:

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

В котором перечислены все входы в вашем приложении:

Флажки не указаны во input. Таким образом, listed_responses будет содержать список значений NULL, а write.table сохранит csv с пустыми строками.

Я не смотрел, почему ваши js не работают, но метод yihui для создания данных с флажками, похоже, хорошо работает:

# 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()); } ')
       )
 )

Полный пример

Вот пример с обоими исправлениями. Я также добавил модальности, чтобы предупредить пользователя, когда они успешно отправили форму, или если они не указали свое имя пользователя. Я очищаю форму после ее отправки.

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