r - 在闪亮的应用程序中基于 actionButton 标签创建 csv

Question

我有下面闪亮的应用程序，最初将用户带到Bet1tabPanel。然后用户选择下面的三个操作按钮之一，我希望将答案（的标签actionButton）记录在工作目录内创建的 csv 文件中。然后用户自动移动到Bet2tabPanel 并执行相同操作。答案应该以Bet1,Bet2是列名和答案（actionButtons标签）的方式记录为如下行：

     Bet1                Bet2
1 Je choisis option A Je choisis option B

＃应用程序

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)

标签： rshinyaction-button

Answer 1

也许你正在寻找这个

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.