MENU

Fun & Interesting

R for Authoring SNIPPED!!! --- Shiny Dashboards in Quarto

Forensic Psychometrics 229 lượt xem 12 months ago
Video Not Working? Fix It Now

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/#plots

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/e6/4c09e608d548b4abf525f3bb2b215c68.png
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/LiveStreams/blob/main/temp.qmd) 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")`](https://www.youtube.com/watch?v=7PSr2B_9zlA).

# 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

Comment