Skip to content

Instantly share code, notes, and snippets.

@kellobri
Created January 23, 2021 18:33
Show Gist options
  • Save kellobri/3ad88c04dfa6de7d7dbe06b9dd4976d2 to your computer and use it in GitHub Desktop.
Save kellobri/3ad88c04dfa6de7d7dbe06b9dd4976d2 to your computer and use it in GitHub Desktop.
Shiny Application example: Bookmarkable and Commentable
#
# The basic multiple bookmark buttons example on Shiny Dev Center:
# https://shiny.rstudio.com/articles/bookmarking-state.html
#
library(shiny)
library(palmerpenguins)
library(ggplot2)
library(dplyr)
penguin_data <- penguins %>%
select(-c(sex, year)) %>%
na.omit()
vars <- setdiff(names(penguin_data), c("species","island"))
ui <- function(request) {
fluidPage(
tags$head(HTML('<script src="https://hypothes.is/embed.js" async></script>')),
tags$head(HTML('<link rel="canonical" href="https://colorado.rstudio.com/rsc/multi-tab/" />')),
tabsetPanel(id = "tabs",
tabPanel("Cluster",
titlePanel("Palmer Penguins k-means clustering"),
sidebarPanel(
selectInput('xcol', 'X Variable', vars),
selectInput('ycol', 'Y Variable', vars, selected = vars[[2]]),
numericInput('clusters', 'Cluster count', 3, min = 1, max = 9),
bookmarkButton(id = "bookmarkC"),
hr(),
HTML('<center><img src="palmerpenguins.png" width=100></center>'),
br(),
p("Data are available by CC-0 license in accordance with the Palmer Station LTER Data Policy and the LTER Data Access Policy for Type I data.")
),
mainPanel(plotOutput('kmeans'),
p('The goal of palmerpenguins is to provide a great dataset for data exploration & visualization, as an alternative to iris.'),
p('Data were collected and made available by Dr. Kristen Gorman and the Palmer Station, Antarctica LTER, a member of the Long Term Ecological Research Network.'),
p('For more information about the palmerpenguins dataset and R package, visit: https://allisonhorst.github.io/palmerpenguins/')
)
),
tabPanel("Visualize",
titlePanel("Penguins are fun to Visualize"),
sidebarPanel(
selectInput('xpen', 'X Variable', vars),
selectInput('ypen', 'Y Variable', vars, selected = vars[[2]]),
bookmarkButton(id = "bookmarkV"),
hr(),
HTML('<center><img src="palmerpenguins.png" width=100></center>'),
br(),
p("Data are available by CC-0 license in accordance with the Palmer Station LTER Data Policy and the LTER Data Access Policy for Type I data.")
),
mainPanel(plotOutput('penguinviz'),
p('The goal of palmerpenguins is to provide a great dataset for data exploration & visualization, as an alternative to iris.'),
p('Data were collected and made available by Dr. Kristen Gorman and the Palmer Station, Antarctica LTER, a member of the Long Term Ecological Research Network.'),
p('For more information about the palmerpenguins dataset and R package, visit: https://allisonhorst.github.io/palmerpenguins/')
)
),
tabPanel("Explore",
fluidRow(
column(5, h2("Palmer Penguins Data Explorer"),
p("This dataset contains data for 344 penguins. There are 3 different species of penguins in this dataset, collected from 3 islands in the Palmer Archipelago, Antarctica."),
p("Artwork by @allison_horst")
),
column(4, br(),
wellPanel(
selectInput('attribute', 'Penguin Attribute', vars, selected = vars[[1]])
)
),
column(3, br(), HTML('<center><img src="penguin-art.png" width=225></center>')
)
),
fluidRow(
column(6, wellPanel(plotOutput('explorehist')), bookmarkButton(id = "bookmarkE")),
column(6, wellPanel(plotOutput('explorebxp')))
)
)
)
)
}
server <- function(input, output, session) {
# Need to exclude the buttons from themselves being bookmarked
setBookmarkExclude(c("bookmarkC", "bookmarkV", "bookmarkE"))
# Trigger bookmarking with either button
observeEvent(input$bookmarkC, {
session$doBookmark()
})
observeEvent(input$bookmarkV, {
session$doBookmark()
})
observeEvent(input$bookmarkE, {
session$doBookmark()
})
selectedData <- reactive({
penguin_data[, c(input$xcol, input$ycol)]
})
clusters <- reactive({
kmeans(selectedData(), input$clusters)
})
output$kmeans <- renderPlot({
palette(c("darkorange", "purple", "cyan4", "#984EA3",
"#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))
par(mar = c(5.1, 4.1, 0, 1))
plot(selectedData(),
col = clusters()$cluster,
pch = 20, cex = 3)
points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
})
output$explorehist <- renderPlot({
ggplot(data = penguins, aes_string(x = input$attribute)) +
geom_histogram(aes(fill = species),
alpha = 0.5,
position = "identity") +
scale_fill_manual(values = c("darkorange","purple","cyan4")) +
theme_minimal() +
labs(x = "Penguin Attribute",
y = "Frequency")
})
output$explorebxp <- renderPlot({
ggplot(data = penguins, aes_string(x = "species", y = input$attribute)) +
geom_boxplot(aes(color = species), width = 0.3, show.legend = FALSE) +
geom_jitter(aes(color = species), alpha = 0.5, show.legend = FALSE, position = position_jitter(width = 0.2, seed = 0)) +
scale_color_manual(values = c("darkorange","purple","cyan4")) +
theme_minimal() +
labs(x = "Species",
y = "Penguin Attribute")
})
output$penguinviz <- renderPlot({
ggplot(data = penguins,
aes_string(x = input$xpen,
y = input$ypen)) +
geom_point(aes(color = species,
shape = species),
size = 3,
alpha = 0.8) +
theme_minimal() +
scale_color_manual(values = c("darkorange","purple","cyan4")) +
labs(color = "Penguin species",
shape = "Penguin species") +
theme(legend.position = c(0.1, 0.1),
legend.background = element_rect(fill = "white", color = NA),
plot.title.position = "plot",
plot.caption = element_text(hjust = 0, face= "italic"),
plot.caption.position = "plot")
})
}
shinyApp(ui, server, enableBookmarking = "server")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment