Search code examples
rshinyaction-button

Create a csv based on actionButton labels in shiny app


I have the shiny app below in which initially lands the user to Bet1 tabPanel. Then the user chooses one of the three actionbuttons below and I want the answer (label of the actionButton) to be recorded in a csv file created inside the working directory.Then the user is moved automatically to Bet2 tabPanel and does the same. The answers should be recorded in a way that the Bet1,Bet2 are the column names and the answers (actionButtons labels) as rows like:

     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)

Solution

  • Perhaps you are looking for this

    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)
    

    It may be better to download a csv file with another action or download button. Also, inputIDs need to be unique in the UI.

    output