Shiny Application example: Bookmarkable and Commentable

app.R

#
# 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")