Serverless shiny app embedded in a Quarto Website

Oct 25, 2023 · 4 min read · R shiny Quarto ·

Serverless Shiny

Inspired by Max Kuhn's presentation at R/Pharma today I tried out embedding shiny a app within a Quarto website and hosting it on GitHub pages. The app itself is a chemistry quiz built to help my son who had a school test coming up. By running it within a Quarto website it's available for him to use on the bus on the way to school for some quick revision.

Note

Thanks so the app he scored 27/30!

Setup

To use shinylive in a Quarto document, you need to first install the shinylive Quarto extension:

1quarto add quarto-ext/shinylive

along with the shinylive R package

1remotes::install_github("posit-dev/r-shinylive")

_quarto.yml file

The _quarto.yml file is a project with some basic parameters to define the website. The only additional parameter of note is to include shinylive as a filter.

 1project:
 2  type: website
 3  output-dir: docs
 4  
 5format: 
 6  html
 7  
 8website:
 9  title: "shinylive elements quiz"
10  navbar:
11    left:
12      - index.qmd
13
14filters:
15  - shinylive

index.qmd

The shiny app is in a single chunk of the index.qmd file with a code chunk type of shinylive-r and the standalone option set.

  1---
  2title: "Chem symbol test"
  3---
  4
  5This is a simple chemical symbol test.  You'll be tested on chemical elements and their names.
  6
  7```{r}
  8#| include: false
  9library(shinylive)
 10```
 11
 12```{shinylive-r}
 13#| viewerHeight: 300
 14#| standalone: true
 15
 16chem <- data.frame(
 17  symbol = c("Al", "Sb", "Ar", "As", "Ba", "Be", "Bi", 
 18             "B", "Br", "Cd", "Ca", "C", "Cs", "Cl", "Cr",
 19             "Co", "Cu", "F", "Au", "He", "H", "I", "Fe",
 20             "Kr", "Pb", "Li", "Mg", "Mn", "Hg", "Ne", "Ni",
 21             "N", "O", "P", "Pt", "K", "Rn", "Se", "Si", "Ag",
 22             "Na", "Sr", "S", "Te", "Sn", "Ti", "W",
 23             "U", "V", "Xe", "Zn", "Zr"),
 24  name = c("aluminum", "antimony", "argon", "arsenic", "barium", "beryllium", "bismuth", 
 25           "boron", "bromine","cadmium", "calcium", "carbon", "cesium", "chlorine", "chromium",
 26           "cobalt", "copper", "fluorine", "gold", "helium", "hydrogen", "iodine", "iron",
 27           "krypton", "lead", "lithium", "magnesium", "mangenese", "mercury", "neon", "nickel",
 28           "nitrogen", "oxygen", "phosphorus", "platinum", "potassium", "radon", "selenium", "silicon", "silver",
 29           "sodium", "strontium", "sulfur", "tellurium", "tin", "titanium", "tungsten",
 30           "uranium", "vanadium", "xenon", "zinc", "zirconium")
 31)
 32
 33ui <- fluidPage(
 34  fluidRow(
 35    column(5, offset = 1, checkboxGroupInput("chk_options", "Test me on", choices = names(chem), selected = "symbol", inline = TRUE))
 36  ),
 37  fluidRow(
 38    column(5, offset = 1, uiOutput("ui_question")),
 39    column(5, 
 40           fluidRow(uiOutput("ui_score")),
 41           fluidRow(uiOutput("ui_streak"))
 42           )
 43  )
 44  
 45)
 46
 47server <- function(input, output, session) {
 48
 49  last_num <- 0
 50  rv <- reactiveValues(
 51    question_count = 0,
 52    score = 0,
 53    question_type = NULL,
 54    question = NULL,
 55    answer = NULL,
 56    streak = 0
 57  )
 58  
 59  question_index <- reactive({
 60    rv$question_count
 61    num <- last_num
 62    while (num == last_num) {
 63      num <- sample(nrow(chem), size = 1)
 64    }
 65    last_num <- num
 66  })
 67  
 68  output$ui_question <- renderUI({
 69    if (length(input$chk_options) > 0) {
 70      rv$question_type <- sample(input$chk_options, size = 1)
 71      answer_type <- names(chem)[!names(chem) == rv$question_type]
 72      rv$question <- chem[[rv$question_type]][question_index()]
 73      rv$answer <- chem[[answer_type]][question_index()]
 74      tagList(
 75        h3(paste(answer_type, "for:", rv$question)),
 76        textInput("txt_answer", label = NULL),
 77        actionButton("but_answer", "Submit")
 78      )
 79    }
 80  })
 81  
 82  observeEvent(input$but_answer, {
 83    if (rv$question_type == "symbol") {
 84      answer <- tolower(input$txt_answer)
 85    } else {
 86      answer <- input$txt_answer
 87    }
 88    if (answer == rv$answer) {
 89      rv$score <- rv$score + 1
 90      rv$streak <- rv$streak + 1
 91      showNotification(ui = "CORRECT!", type = "message")
 92    } else {
 93      rv$streak <- 0
 94      showNotification(ui = paste0("WRONG.  Correct answer is ", rv$answer), type = "error")
 95    }
 96    rv$question_count <- rv$question_count + 1
 97  })
 98  
 99  output$ui_score <- renderUI({
100    h3(paste0("Score: ", rv$score, "/", rv$question_count), style = "color: #388E3C")
101  })
102  
103  output$ui_streak <- renderUI({
104    if (rv$streak > 29) {
105      col <- "#2E7D32"
106    } else if (rv$streak > 19) {
107      col <- "#00838F"
108    } else if (rv$streak > 9) {
109      col <- "#1E88E5"
110    } else if (rv$streak > 0) {
111      col <- "#8E24AA"
112    } else {
113      col <- "#E53935"
114    }
115    h3(paste0("Streak: ", rv$streak), style = paste0("color: ", col))
116  })
117
118}
119
120app <- shinyApp(ui = ui, server = server)
121
122```

The app itself contains the typical ui and server along with the shinyapp() function to execute. It is basic and unoptimized (but it demonstrates the purpose). It takes very little effort to change a standalone app to an embedded one.

The quarto website with embedded app is available at https://harveyl888.github.io/shinylive-test/