Shiny dashboards in R & Quarto

4 months ago
5

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

Loading comments...