根据 shiny app 中的 actionButton 标签创建一个 csv
Create a csv based on actionButton labels in shiny app
我有下面这个闪亮的应用程序,它最初将用户带到 Bet1
tabPanel。然后用户选择下面三个操作按钮之一,我希望将答案(actionButton
的标签)记录在工作中创建的 csv 文件中 directory.Then 用户自动移动到 Bet2
tabPanel 并做同样的事情。答案应以 Bet1
、Bet2
是列名称和答案(actionButtons
标签)的方式记录为行,如:
Bet1 Bet2
1 Je choisis option A Je choisis option B
#app
library(shiny)
library(shinyjs)
outputDir <- "responses"
saveData <- function(mydata, namedata){
fileName=paste0(paste(namedata,as.integer(Sys.time()),sep="_"),".csv")
filePath <- file.path(tempdir(), fileName)
write.csv(mydata, filePath, row.names = FALSE, quote = TRUE)
}
ui <- fluidPage(
id="main",
title="Risk and ambiguity",
useShinyjs(),
navlistPanel(id="main",
tabPanel("Bet1",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action1", label = "Je choisis option A")),
column(12,align="center",actionButton("action2", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action3", label = "Je choisis option B"))) ))),
tabPanel("Bet2",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action1", label = "Je choisis option A")),
column(12,align="center",actionButton("action2", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action3", label = "Je choisis option B"))) )))
))
#################
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
也许您正在寻找这个
library(shiny)
library(shinyjs)
outputDir <- "responses"
saveData <- function(mydata, namedata){
fileName=paste0(paste(namedata,as.integer(Sys.time()),sep="_"),".csv")
filePath <- file.path(tempdir(), fileName)
write.csv(mydata, filePath, row.names = FALSE, quote = TRUE)
}
################ cbind datasets with different number of rows ######
cbindPad <- function(...){
args <- list(...)
n <- sapply(args,nrow)
mx <- max(n)
pad <- function(x, mx){
if (nrow(x) < mx){
nms <- colnames(x)
padTemp <- matrix(NA, mx - nrow(x), ncol(x))
colnames(padTemp) <- nms
if (ncol(x)==0) {
return(padTemp)
} else {
return(rbind(x,padTemp))
}
}
else{
return(x)
}
}
rs <- lapply(args,pad,mx)
return(do.call(cbind,rs))
}
ui <- fluidPage(
id="main",
title="Risk and ambiguity",
useShinyjs(),
navlistPanel(id="main",
tabPanel("Bet1",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))), DTOutput("t1"),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action11", label = "Je choisis option A")),
column(12,align="center",actionButton("action12", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action13", label = "Je choisis option B"))) ))),
tabPanel("Bet2",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))), DTOutput("t2"),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action21", label = "Je choisis option A")),
column(12,align="center",actionButton("action22", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action23", label = "Je choisis option B"))) )))
))
server <- function(input, output, session){
rv <- reactiveValues(col1=NULL, col2=NULL, df=NULL)
mylabel <- c("Je choisis option A", "Je choisis le sac avec A et B", "Je choisis option B")
lapply(1:3, function(i){
observeEvent(input[[paste0("action1",i)]], {
if (is.null(rv$col1)) {
rv$col1 <- mylabel[i]
}else rv$col1 <<- c(rv$col1,mylabel[i])
updateNavlistPanel(session, "main", "Bet2")
}, ignoreInit = TRUE)
})
lapply(1:3, function(i){
observeEvent(input[[paste0("action2",i)]], {
if (is.null(rv$col2)) {
rv$col2 <- mylabel[i]
}else rv$col2 <<- c(rv$col2,mylabel[i])
updateNavlistPanel(session, "main", "Bet1")
})
})
observe({
rv$df <- cbindPad(data.frame(Bet1 = rv$col1),data.frame(Bet2 = rv$col2))
#saveData(rv$df, aaabbb)
})
output$t1 <- renderDT(rv$df)
output$t2 <- renderDT(rv$df)
}
shinyApp(ui = ui, server = server)
最好使用其他操作或下载按钮下载 csv 文件。此外,inputID 在 UI
.
中必须是唯一的
我有下面这个闪亮的应用程序,它最初将用户带到 Bet1
tabPanel。然后用户选择下面三个操作按钮之一,我希望将答案(actionButton
的标签)记录在工作中创建的 csv 文件中 directory.Then 用户自动移动到 Bet2
tabPanel 并做同样的事情。答案应以 Bet1
、Bet2
是列名称和答案(actionButtons
标签)的方式记录为行,如:
Bet1 Bet2
1 Je choisis option A Je choisis option B
#app
library(shiny)
library(shinyjs)
outputDir <- "responses"
saveData <- function(mydata, namedata){
fileName=paste0(paste(namedata,as.integer(Sys.time()),sep="_"),".csv")
filePath <- file.path(tempdir(), fileName)
write.csv(mydata, filePath, row.names = FALSE, quote = TRUE)
}
ui <- fluidPage(
id="main",
title="Risk and ambiguity",
useShinyjs(),
navlistPanel(id="main",
tabPanel("Bet1",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action1", label = "Je choisis option A")),
column(12,align="center",actionButton("action2", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action3", label = "Je choisis option B"))) ))),
tabPanel("Bet2",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action1", label = "Je choisis option A")),
column(12,align="center",actionButton("action2", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action3", label = "Je choisis option B"))) )))
))
#################
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
也许您正在寻找这个
library(shiny)
library(shinyjs)
outputDir <- "responses"
saveData <- function(mydata, namedata){
fileName=paste0(paste(namedata,as.integer(Sys.time()),sep="_"),".csv")
filePath <- file.path(tempdir(), fileName)
write.csv(mydata, filePath, row.names = FALSE, quote = TRUE)
}
################ cbind datasets with different number of rows ######
cbindPad <- function(...){
args <- list(...)
n <- sapply(args,nrow)
mx <- max(n)
pad <- function(x, mx){
if (nrow(x) < mx){
nms <- colnames(x)
padTemp <- matrix(NA, mx - nrow(x), ncol(x))
colnames(padTemp) <- nms
if (ncol(x)==0) {
return(padTemp)
} else {
return(rbind(x,padTemp))
}
}
else{
return(x)
}
}
rs <- lapply(args,pad,mx)
return(do.call(cbind,rs))
}
ui <- fluidPage(
id="main",
title="Risk and ambiguity",
useShinyjs(),
navlistPanel(id="main",
tabPanel("Bet1",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))), DTOutput("t1"),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action11", label = "Je choisis option A")),
column(12,align="center",actionButton("action12", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action13", label = "Je choisis option B"))) ))),
tabPanel("Bet2",
fluidRow(column(12, align='center',
hr("Choisissez urne A, urne B ou un sac avec A et B:"))), DTOutput("t2"),
####
fluidRow(wellPanel(
splitLayout(cellWidths = c("33%", "33%", "33%"),
column(12,align="center",actionButton("action21", label = "Je choisis option A")),
column(12,align="center",actionButton("action22", label = "Je choisis le sac avec A et B")),
column(12,align="center",actionButton("action23", label = "Je choisis option B"))) )))
))
server <- function(input, output, session){
rv <- reactiveValues(col1=NULL, col2=NULL, df=NULL)
mylabel <- c("Je choisis option A", "Je choisis le sac avec A et B", "Je choisis option B")
lapply(1:3, function(i){
observeEvent(input[[paste0("action1",i)]], {
if (is.null(rv$col1)) {
rv$col1 <- mylabel[i]
}else rv$col1 <<- c(rv$col1,mylabel[i])
updateNavlistPanel(session, "main", "Bet2")
}, ignoreInit = TRUE)
})
lapply(1:3, function(i){
observeEvent(input[[paste0("action2",i)]], {
if (is.null(rv$col2)) {
rv$col2 <- mylabel[i]
}else rv$col2 <<- c(rv$col2,mylabel[i])
updateNavlistPanel(session, "main", "Bet1")
})
})
observe({
rv$df <- cbindPad(data.frame(Bet1 = rv$col1),data.frame(Bet2 = rv$col2))
#saveData(rv$df, aaabbb)
})
output$t1 <- renderDT(rv$df)
output$t2 <- renderDT(rv$df)
}
shinyApp(ui = ui, server = server)
最好使用其他操作或下载按钮下载 csv 文件。此外,inputID 在 UI
.