Step through n screens or carousel in Shiny app-CodePudding

I'm trying to design an app where the user will step through some varying number of screens and do something to some data subset on each screen. The number of screens will depend on the numbers of groups in the data. I've hand coded a a sketch of what I want to do with two groups. But I'd like it to be dynamic and have a screen for each grouping in the data (10 here). I like the look and feel of shinyglide but I'm unsure how to loop (and I know it's not a loop like a for loop) through levels. Any ideas appreciated.

library(shiny)
library(shinyglide)
library(tidyverse)

n <- 100
nGroups <- 10
dat <- data.frame(someGroup = rep(letters[1:nGroups],n/nGroups),
                  someVariable = rnorm(n))

ui <- fixedPage(style = "max-width: 500px;",
                titlePanel("Simple shinyglide app"),

                glide(
                  height = "350px",
                  screen(
                    p("This is the intro screen")
                  ),
                  screen(
                    p("Here you'd do something to the first group (a)"),
                    numericInput(inputId = "aNumber1",
                                 label = "Add a constant",
                                 value = 10,min = 0,max = 100,step = 1),
                    checkboxInput(inputId = "getLog1",
                                  label = "Take the log?",
                                  value=FALSE),
                    tableOutput("group1Result")
                  ),
                  screen(
                    p("Here you'd do something to the second group (b)"),
                    numericInput(inputId = "aNumber2",
                                 label = "Enter a number",
                                 value = 10,min = 0,max = 100,step = 1),
                    checkboxInput(inputId = "getLog2",
                                  label = "Take the log?",
                                  value=FALSE),
                    tableOutput("group2Result")
                  ),
                  screen(
                    p("After all the groups are done you'd get to this screen."),
                    tableOutput("summaryResults")
                  )
                )
)


server <- function(input, output, session) {

  outRV <- reactiveValues()

  output$group1Result <- renderTable({
    res <- dat %>% filter(someGroup == "a") %>%
      mutate(someNewVariable = someVariable   input$aNumber1)

    if(input$getLog1) res$someNewVariable <- log(res$someNewVariable)

    outRV$a <- res$someNewVariable

    return(res)
  })

  output$group2Result <- renderTable({
    res <- dat %>% filter(someGroup == "b") %>%
      mutate(someNewVariable = someVariable   input$aNumber2)

    if(input$getLog2) res$someNewVariable <- log(res$someNewVariable)

    outRV$b <- res$someNewVariable

    return(res)
  })

  output$summaryResults <- renderTable({
    data.frame(outRV$a,outRV$b)
  })
}

shinyApp(ui, server)

CodePudding user response：

Assuming all screens are using the same title/description, we can generalise the code needed to add a screen. By using, lapply we can generate a list containing n screens, as follows:

lapply(1:nGroups, function(i) {
  screen(
    p(paste0("Here you'd do something to the group (",dat[i,1],")")),
    numericInput(inputId = paste0("aNumber",i),
                 label = "Add a constant",
                 value = 10,min = 0,max = 100,step = 1),
    checkboxInput(inputId = paste0("getLog",i),
                  label = "Take the log?",
                  value=FALSE),
    tableOutput(paste0("group",i,"Result"))
  )
})

So, the ui would like this:

ui <- fixedPage(style = "max-width: 500px;",
                titlePanel("Simple shinyglide app"),
                glide(
                  height = "350px",
                  screen(
                    p("This is the intro screen")
                  ),
                  lapply(1:nGroups, function(i) {
                    screen(
                      p(paste0("Here you'd do something to the group (",dat[i,1],")")),
                      numericInput(inputId = paste0("aNumber",i),
                                   label = "Add a constant",
                                   value = 10,min = 0,max = 100,step = 1),
                      checkboxInput(inputId = paste0("getLog",i),
                                    label = "Take the log?",
                                    value=FALSE),
                      tableOutput(paste0("group",i,"Result"))
                    )
                  }),
                  screen(
                    p("After all the groups are done you'd get to this screen."),
                    div(style = 'overflow-x: scroll', tableOutput("summaryResults"))
                  )
                )
)

Then, regarding the server, by using lapply again, we can render the table for each group dynamically and then render the summary table containing columns for all groups.

server <- function(input, output, session) {
  
  outRV <- reactiveValues()
  
  lapply(1:nGroups, function(i) {
    output[[paste0('group', i,'Result')]] <- renderTable({
      res <- dat %>% filter(someGroup == dat[i,1]) %>%
        mutate(someNewVariable = someVariable   input[[paste0("aNumber",i)]])
      
      if(input[[paste0("getLog",i)]]) res$someNewVariable <- log(res$someNewVariable)
      
      outRV[[dat[i,1]]] <- res$someNewVariable
      
      return(res)
    })
  })
  
  output$summaryResults <- renderTable({
    data.frame(sapply(dat[1:nGroups,1], function(x) {outRV[[x]]}))
  })
}