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