Shiny R：如何从数据表中保存复选框输入列表？

Question

一旦单击了 actionButton，我正在尝试保存从 [此处][2] 改编的复选框表 (see here) 中的输入。理想情况下，我想要一个数据框列中的选定框列表，并将用户名作为行名。

我尝试使用以下语法，将响应存储在列表中，然后将它们附加到现有的 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)
        })
        }
        )

我得到的只是警告：

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

除了警告之外，.csv 文件中没有保存任何内容，我不确定我到底缺少什么。

如何正确保存数据表中的选中框列表？

Answer 1

错误信息

错误来自在对write.table 的同一调用中使用col.names = TRUE 和append = TRUE。例如：

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 可能更干净。您可以使用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")
)

您的应用中的lists all of the inputs：

复选框未在input 中列出。所以listed_responses 将包含NULL 值的列表，write.table 将保存一个空行的 csv。

我没有研究为什么你的 js 不起作用，但 yihui's method 用于制作带有复选框的数据表似乎效果很好：

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