Question

一旦单击了actionButton，我试图保存从[here] [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，：将列名附加到文件

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

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

Answer 1

错误消息

错误来自在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中添加了一行列名。由于您可能不希望在每组答案之间添加一行列名，因此在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")
)

您应用中的哪个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 = "")
            }
        })
    }
)

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

1 个答案:

错误消息

清空csv

完整示例