Step through n screens or carousel in Shiny app

user_9454855 0
Viewed 46

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)
shiny r
1 Answers

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]]}))
  })
}
user_88646190
Related