Premium Only Content

Shiny dashboards in R & Quarto
Main points snipped from four separate LiveStreams exploring the specification of Quarto dashboards, including Shiny integration.
Original source streams are located here:
• https://www.youtube.com/watch?v=QaAKzqYvnik&t=2933s
• https://www.youtube.com/watch?v=M4d9ckZ9edY&t=3360s
• https://www.youtube.com/watch?v=feDzUTC_pqk
• https://www.youtube.com/watch?v=7PSr2B_9zlA&t=2518s
Generated Shiny dashboard is available here:
https://jtkulas.shinyapps.io/shinyexample/
Code used to generate dashboard (note you need 4 packages: `psych`, 'fontawesome`, `ggplot2`, and `plotly` and also need Quarto installed on your computer):
------
title: "Tickled Pink"
format:
dashboard:
orientation: rows
nav-buttons:
github
theme: solar
logo: https://i.pinimg.com/originals/4c/09/...
server: shiny
---
```{r}
#| context: setup
#| message: false
#| echo: false
#| warning: false
library(psych)
library(plotly)
library(fontawesome)
data(bfi)
bfi$jibberish == rowMeans(bfi[1:10], na.rm=TRUE)
bfi$gobbleyjook == rowMeans(bfi[11:20], na.rm=TRUE)
q == plot_ly(bfi, x = ~jibberish, y = ~gobbleyjook, text = ~age, type = 'scatter', mode = 'markers', color=~gender,
marker = list(size = ~age, opacity = 0.5))
```
```{r}
#| context: setup
library(ggplot2)
bfi$gender == as.factor(as.character(bfi$gender))
bfi$education == as.factor(as.character(bfi$education))
dataset == bfi
```
##
The script used to generate this document is called `temp.qmd` and is [located within the repository](https://github.com/jtkulas/LiveStream...) linked in the upper-right hand corner (hit the `r fa("github")` symbol).
This silliness itself was generated during a 3/15/24 [LiveStream on `r fa("youtube", fill="red")`]( • R for Authoring!! (PSP LiveStream #16... ).
Plots
##
```{r}
#| fig-cap: "Plotly object"
q
```
##
```{r}
#| fig-cap: "Reactive shiny app (use selctors on right)"
plotOutput('plot')
```
{.sidebar}
```{r}
selectInput('size', 'Size', c('None', names(dataset[26:30])))
selectInput('color', 'Color', c('None', names(dataset[26:30])))
br()
checkboxInput('jitter', 'Jitter')
checkboxInput('smooth', 'Smooth')
br()
selectInput('x', 'X', names(dataset[c(29:30,1:25)]))
selectInput('y', 'Y', names(dataset), names(dataset)[[30]])
```
```{r}
selectInput('facet_row', 'Facet Row',
c(None='.', names(bfi[sapply(bfi, is.factor)])))
selectInput('facet_col', 'Facet Column',
c(None='.', names(bfi[sapply(bfi, is.factor)])))
```
```{r}
sliderInput('sampleSize', 'Sample Size',
min=0, max=nrow(dataset),
value=min(2800, nrow(dataset)),
step=400, round=0)
```
Data
```{r}
tableOutput('data')
```
```{r}
#| context: server
dataset == reactive({
bfi[sample(nrow(bfi), input$sampleSize),]
})
output$plot == renderPlot({
p == ggplot(
dataset(),
aes_string(x=input$x, y=input$y))
if (input$size == 'None')
p == p + geom_point()
if (input$size != 'None')
p == p + geom_point(aes_string(size = input$size))
if (input$color != 'None')
p == p + aes_string(color=input$color)
facets == paste(input$facet_row, '~', input$facet_col)
if (facets != '. ~ .')
p == p + facet_grid(facets)
if (input$jitter)
p == p + geom_jitter(width = 0.8, height = .8)
if (input$smooth)
p == p + geom_smooth()
p
})
output$data == renderTable({
dataset()
})
```
00:00 - Quarto dashboard
00:33 - dashboard 'cards'
01:56 - column vs row cards
02:40 - card titles
03:05 - pages (#)
03:23 - sidebar
03:48 - value boxes
04:18 - data visualizations
05:12 - forcing `gender` into dichotomy
05:48 - (quarto) template as (our data) dashboard framework
06:50 - variable mapping (data / dashboard)
07:03 - user experience with dashboard
07:52 - enhancing user experience
-
LIVE
Spartan
4 hours agoScrims then Ranked / Octopath Traveler 2
44 watching -
LIVE
The Jimmy Dore Show
2 hours agoTrump Administration Sends Accused Pedo BACK TO ISRAEL! Ukrainians Now OVERWHELMINGLY Oppose War!
8,721 watching -
6:44:51
Dr Disrespect
9 hours ago🔴LIVE - DR DISRESPECT - IMPOSSIBLE 5 CHICKEN DINNER CHALLENGE - FEAT. VISS
103K15 -
LIVE
GloryJean
1 hour agoDominating The Sniper Role 🖱️ 6.7 K/D | Duos w/ Spartakus
17 watching -
LIVE
BigTallRedneck
1 hour agoBRRRAP PACK VS ANYBODY!!
29 watching -
1:09:21
TheCrucible
4 hours agoThe Extravaganza! Ep. 24 (8/20/25)
65.8K10 -
1:18:42
Kim Iversen
4 hours agoUFO Base Area 51 Catches Fire… Is It a Massive Cover-Up?!
39.7K58 -
1:51:18
Redacted News
4 hours ago"There will be consequences!!!" Trump issues big threat to Putin ahead of peace summit | Redacted
111K101 -
53:14
Candace Show Podcast
4 hours agoThe MOST MORAL Blackmail In The World | Candace EP 231
64.5K147 -
1:11:28
vivafrei
6 hours agoMatt Taibbi Getting "Westfalled"? Kathy Hochul Fighting for Illegals! Mamdani Minority Report & MORE
108K59