gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-11-30 14:43:07 24 4
gpt4 key购买 nike

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

我尝试使用以下语法,将响应存储在列表中,然后将它们附加到现有的 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 文件中没有保存任何内容,我不确定我到底遗漏了什么。

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

最佳答案

错误信息

错误来自于在对 write.table 的同一调用中使用 col.names = TRUEappend = 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 为空白是因为您的复选框未正确绑定(bind)为输入。我们可以通过将这些行添加到您的应用程序来看到这一点:

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

哪个lists all of the inputs在您的应用中:

enter image description here

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

关于javascript - Shiny 的 R : How to save list of checkbox inputs from datatable?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/49352886/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com