juba / shinyglide

Glide.js component for Shiny apps
https://juba.github.io/shinyglide/
91 stars 8 forks source link

Step through n screens when n is unknown #31

Closed AndyBunn closed 2 years ago

AndyBunn commented 2 years ago

Hello, I'm trying to modify this example from SO. Code is below.

I'd like the user to step through each group in dat, subset the data to that group, and do something to that subset. In this case the user chooses a spline stiffness and the residuals are saved along with the smoothing parameter.

First, is using lapply a good way of going about this or is there a simpler way? And second, in the example below the data (dat) is loaded with the app. In my application, the user would choose between data sets with a varying number of groups making me think that I'd want to use screenOutput inside of renderUI but I'm unsure of how to go about that.

Is this something that shinyglide is good for?

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

# what if the user loaded a different `dat` with 2 or 8 groups in z?
dat <- data.frame(x = rep(1:10,4),
                  y = rnorm(40),
                  z = rep(1:4,each=10))
nGroups <- 4
dat

ui <- fixedPage(style = "max-width: 500px;",
                titlePanel("Simple shinyglide app"),
                glide(
                  screen(
                    p("This is the intro screen")
                  ),
                  lapply(1:nGroups, function(i) {
                    screen(
                      p(paste0("Here you'd do something to the group ",i)),
                      numericInput(inputId = paste0("spar",i),
                                   label = "choose smooth param",
                                   value = 0.5,min = 0,max = 1,step = 0.1),
                      plotOutput(paste0("group",i,"Plot"))
                    )
                  }),
                  screen(
                    p("After all the groups are done you'd get to this screen."),
                    div(style = 'overflow-x: scroll',
                        verbatimTextOutput("summaryResults"))
                  )
                )
)

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

  outRV <- reactiveValues()
  # see if you can put this into a render UI and us screenOutput
  lapply(1:nGroups, function(i) {
    output[[paste0('group', i,'Plot')]] <- renderPlot({
      tmp <- dat %>% filter(z == i)
      tmp$ySm <- smooth.spline(tmp$y,spar = input[[paste0("spar",i)]])$y
      outRV[[paste0("spar",i)]] <- input[[paste0("spar",i)]]
      outRV[[paste0("resids",i)]] <- tmp$y - tmp$ySm

      res <- ggplot(tmp) +
        geom_line(aes(x=x,y=y)) +
        geom_line(aes(x=x,y=ySm),color="red")

      return(res)
    })
  })

  values <- reactive({
    reactiveValuesToList(outRV)
  })
  output$summaryResults <- renderPrint({
    values()
  })
}

shinyApp(ui, server)
juba commented 2 years ago

Hi,

If you want to generate an undetermined number of screens, you indeed have to put it in renderUI. I think the following should work.


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

# what if the user loaded a different `dat` with 2 or 8 groups in z?
dat <- data.frame(
    x = rep(1:10, 4),
    y = rnorm(40),
    z = rep(1:5, each = 8)
)
nGroups <- length(unique(dat$z))

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

server <- function(input, output, session) {
    outRV <- reactiveValues()
    # see if you can put this into a render UI and us screenOutput
    lapply(1:nGroups, function(i) {
        output[[paste0("group", i, "Plot")]] <- renderPlot({
            tmp <- dat %>% filter(z == i)
            tmp$ySm <- smooth.spline(tmp$y, spar = input[[paste0("spar", i)]])$y
            outRV[[paste0("spar", i)]] <- input[[paste0("spar", i)]]
            outRV[[paste0("resids", i)]] <- tmp$y - tmp$ySm

            res <- ggplot(tmp) +
                geom_line(aes(x = x, y = y)) +
                geom_line(aes(x = x, y = ySm), color = "red")

            return(res)
        })
    })

    output$group_screens <- renderUI({
        screens <- c(
            list(
                screen(
                    p("This is the intro screen")
                )
            ),
            lapply(1:nGroups, function(i) {
                screen(
                    p(paste0("Here you'd do something to the group ", i)),
                    numericInput(
                        inputId = paste0("spar", i),
                        label = "choose smooth param",
                        value = 0.5, min = 0, max = 1, step = 0.1
                    ),
                    plotOutput(paste0("group", i, "Plot"))
                )
            }),
            list(
                screen(
                    p("After all the groups are done you'd get to this screen."),
                    div(
                        style = "overflow-x: scroll",
                        verbatimTextOutput("summaryResults")
                    )
                )
            )
        )

        do.call(glide, screens)
    })

    values <- reactive({
        reactiveValuesToList(outRV)
    })

    output$summaryResults <- renderPrint({
        values()
    })
}

shinyApp(ui, server)

The content of renderUI is a bit complicated because glide does not accept the screens in a list, so you have to generate a list of screens and then use do.call to call glide with these screens as arguments.

AndyBunn commented 2 years ago

Ah! I see. Thanks. I would never had gotten the list with do.call scheme. This seems like such a natural thing to want to do with an app. I'm surprised this hasn't been snatched up by the shiny devs as an idea for a layout. Thanks for a great pacakge!