Bookmarking and saving the bookmarks in R shiny
Here is an alternative approach to my earlier answer using saveRDS() instead of sqlite:
Edit: Added username check.
library(shiny)
# library(RSQLite)
library(data.table)
ui <- function(request) {
fluidPage(
plotOutput("plot"),
sliderInput("n", "Number of observations", 1, nrow(faithful), 100),
fluidRow(column(2, textInput(inputId = "description", label = "Bookmark description", placeholder = "Data Summary")), column(2, bookmarkButton(id="bookmarkBtn"))),
DT::dataTableOutput("urlTable", width = "100%"),
tags$style(type='text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
)
}
server <- function(input, output, session) {
# con <- dbConnect(RSQLite::SQLite(), "bookmarks.db", overwrite = FALSE)
myBookmarks <- reactiveValues(urlDF = NULL)
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
# if(dbExistsTable(con, "Bookmarks")){
# tmpUrlDF <- data.table(dbReadTable(con, "Bookmarks"))
# myBookmarks$urlDF <- tmpUrlDF[, Timestamp := as.POSIXct(Timestamp, origin="1970-01-01 00:00")]
# } else {
# myBookmarks$urlDF <- NULL
# }
if(file.exists("bookmarks.rds")){
myBookmarks$urlDF <- readRDS("bookmarks.rds")
} else {
myBookmarks$urlDF <- NULL
}
session$onSessionEnded(function() {
tmpUrlDF <- isolate({myBookmarks$urlDF})
if(!is.null(tmpUrlDF)){
# dbWriteTable(con, "Bookmarks", tmpUrlDF, overwrite = TRUE)
saveRDS(tmpUrlDF, "bookmarks.rds")
}
# dbDisconnect(con)
})
setBookmarkExclude(c("bookmarkBtn", "description", "urlTable_cell_clicked", "urlTable_rows_all", "urlTable_rows_current", "urlTable_rows_selected", "urlTable_search", "urlTable_state", "urlTable_row_last_clicked"))
output$plot <- renderPlot({
hist(faithful$eruptions[seq_len(input$n)], breaks = 40)
})
onBookmarked(fun=function(url){
if(!url %in% myBookmarks$urlDF$URL){
if(is.null(myBookmarks$urlDF)){
myBookmarks$urlDF <- unique(data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")), by="URL")
} else {
myBookmarks$urlDF <- unique(rbindlist(list(myBookmarks$urlDF, data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")))), by="URL")
}
}
})
output$urlTable = DT::renderDataTable({
req(myBookmarks$urlDF)
myBookmarks$urlDF[User %in% Sys.getenv("USERNAME")]
}, escape=FALSE)
}
enableBookmarking(store = "url")
shinyApp(ui, server)
Save R Shiny bookmark into a table and retrieve it
Here is how I would approach this:
Edit: Now using sqlite to persist the changes across different session, also duplicates are avoided.
2nd Edit: Added a description input for the bookmarks.
library(shiny)
library(RSQLite)
library(data.table)
ui <- function(request) {
fluidPage(
plotOutput("plot"),
sliderInput("n", "Number of observations", 1, nrow(faithful), 100),
fluidRow(column(2, textInput(inputId = "description", label = "Bookmark description", placeholder = "Data Summary")), column(2, bookmarkButton(id="bookmarkBtn"))),
DT::dataTableOutput("urlTable", width = "100%"),
tags$style(type='text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
)
}
server <- function(input, output, session) {
con <- dbConnect(RSQLite::SQLite(), "bookmarks.db", overwrite = FALSE)
myBookmarks <- reactiveValues(urlDF = NULL)
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
if(dbExistsTable(con, "Bookmarks")){
tmpUrlDF <- data.table(dbReadTable(con, "Bookmarks"))
myBookmarks$urlDF <- tmpUrlDF[, Timestamp := as.POSIXct(Timestamp, origin="1970-01-01 00:00")]
} else {
myBookmarks$urlDF <- NULL
}
session$onSessionEnded(function() {
tmpUrlDF <- isolate({myBookmarks$urlDF})
if(!is.null(tmpUrlDF)){
dbWriteTable(con, "Bookmarks", tmpUrlDF, overwrite = TRUE)
}
dbDisconnect(con)
})
setBookmarkExclude(c("bookmarkBtn", "description", "urlTable_cell_clicked", "urlTable_rows_all", "urlTable_rows_current", "urlTable_rows_selected", "urlTable_search", "urlTable_state", "urlTable_row_last_clicked"))
output$plot <- renderPlot({
hist(faithful$eruptions[seq_len(input$n)], breaks = 40)
})
onBookmarked(fun=function(url){
if(!url %in% myBookmarks$urlDF$URL){
if(is.null(myBookmarks$urlDF)){
myBookmarks$urlDF <- unique(data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token), by="URL")
} else {
myBookmarks$urlDF <- unique(rbindlist(list(myBookmarks$urlDF, data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token))), by="URL")
}
}
})
output$urlTable = DT::renderDataTable({
myBookmarks$urlDF
}, escape=FALSE)
}
enableBookmarking(store = "url")
shinyApp(ui, server)
You might want to think about saving the bookmark table to a file (e.g. using saveRDS()) and load it globally so its available for new sessions.
For further information see this.
URL Bookmarking R Shiny
According to your description I guess for more complex apps you are hitting a browser limit with the encoded state URLs as mentioned in this article:
With an encoded state, the URL could become very long if there are many values. Some browsers have a limit of about 2,000 characters for the length of a URL, so if the bookmark URL is longer than that, it will not work properly in those browsers.
Therefore you should start using saved-to-server bookmarks by setting
enableBookmarking(store = "server")
Instead of:
enableBookmarking(store = "url")
Edit: Also for this to work your UI code must be wrapped in a function taking request as an argument:
2nd Edit: Added id = "myNavbarPage" to the navbarPage - so it will be recognized as an input for bookmarking (and restored accordingly).
library(shiny)
library(ggplot2)
library(DT)
library(shinyjqui)
library(shinydashboard)
library(shinydashboardPlus)
library(data.table)
ui <- function(request) {navbarPage(
"Navbar!", id = "myNavbarPage",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(radioButtons(
"plotType", "Plot type",
c("Scatter" = "p", "Line" = "l")
)),
mainPanel(plotOutput("plot"))
)),
tabPanel(
"Summary",
fluidPage(
plotOutput("bookmarkplot"),
sliderInput("n", "Number of observations", 1, nrow(faithful), 100),
fluidRow(column(
2,
textInput(
inputId = "description",
label = "Bookmark description",
placeholder = "Data Summary"
)
), column(2, bookmarkButton(id = "bookmarkBtn"))),
DT::dataTableOutput("urlTable", width = "100%"),
tags$style(type = 'text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
)
),
navbarMenu(
"More",
tabPanel("Table",
DT::dataTableOutput("table")),
tabPanel("About",
fluidRow(column(
3,
img(
class = "img-polaroid",
src = paste0(
"http://upload.wikimedia.org/",
"wikipedia/commons/9/92/",
"1919_Ford_Model_T_Highboy_Coupe.jpg"
)
),
tags$small(
"Source: Photographed at the Bay State Antique ",
"Automobile Club's July 10, 2005 show at the ",
"Endicott Estate in Dedham, MA by ",
a(href = "http://commons.wikimedia.org/wiki/User:Sfoskett",
"User:Sfoskett")
)
)))
)
)}
server <- function(input, output, session) {
output$plot <- renderPlot({
plot(cars, type = input$plotType)
})
output$summary <- renderPrint({
summary(cars)
})
output$table <- DT::renderDataTable({
DT::datatable(cars)
})
#BOOKMARK AND SAVING THEM
myBookmarks <- reactiveValues(urlDF = NULL)
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
if (file.exists("bookmarks.rds")) {
myBookmarks$urlDF <- readRDS("bookmarks.rds")
} else {
myBookmarks$urlDF <- NULL
}
session$onSessionEnded(function() {
tmpUrlDF <- isolate({
myBookmarks$urlDF
})
if (!is.null(tmpUrlDF)) {
saveRDS(tmpUrlDF, "bookmarks.rds")
}
})
setBookmarkExclude(
c(
"bookmarkBtn",
"data_table_rows_all",
"data_table_rows_current",
"data_table_rows_selected",
"data_table_rows_search",
"data_table_rows_state",
"data_table_rows_last_clicked",
"bar",
"navbar",
"Scenario",
"description",
"urlTable_cell_clicked",
"urlTable_rows_all",
"urlTable_rows_current",
"urlTable_rows_selected",
"urlTable_search",
"urlTable_state",
"urlTable_row_last_clicked"
)
)
output$bookmarkplot <- renderPlot({
hist(faithful$eruptions[seq_len(input$n)], breaks = 40)
})
onBookmarked(
fun = function(url) {
if (!url %in% myBookmarks$urlDF$URL) {
if (is.null(myBookmarks$urlDF)) {
myBookmarks$urlDF <-
unique(
data.table(
Description = input$description,
URL = paste0("<a href='", url, "'>", url, "</a>"),
Timestamp = Sys.time(),
Session = session$token
),
by = "URL"
)
} else {
myBookmarks$urlDF <-
unique(rbindlist(list(
myBookmarks$urlDF,
data.table(
Description = input$description,
URL = paste0("<a href='", url, "'>", url, "</a>"),
Timestamp = Sys.time(),
Session = session$token
)
)), by = "URL")
}
}
}
)
output$urlTable = DT::renderDataTable({
req(myBookmarks$urlDF)
myBookmarks$urlDF
}, escape = FALSE)
enableBookmarking(store = "server")
}
shinyApp(ui = ui, server = server)
See ?enableBookmarking or my earlier answer.
R shiny bookmark bucket lists
The minimal example above is missing a few bits. Below is a minimal example showing bookmarking used to persistently store selections.
library(shiny)
ui <- function(request) {
fluidPage(
textInput("txt", "Text"),
checkboxInput("chk", "Checkbox"),
bookmarkButton()
)
}
server <- function(input, output, session) {
}
enableBookmarking("url")
shinyApp(ui, server)
Bucket lists don't appear to be natively supported by bookmarks. You can manually store and retrieve data from bookmarks using onBookmark and onRestore and then renderUI to update your bucket list.
Edit: Additional example showing the use of onBookmark and onRestore and then renderUI to get bucket lists working with bookmarks.
library(shiny)
library(sortable)
ui <- function(request) {
fluidPage(
uiOutput("bucket"),
bookmarkButton()
)
}
server <- function(input, output, session) {
output$bucket <- renderUI({
bucket_list(
header = "This is a bucket list. You can drag items between the lists.",
add_rank_list(
text = "Drag from here",
labels = c("a", "bb", "ccc"),
input_id = 'list1'
),
add_rank_list(
text = "to here",
labels = NULL,
input_id = 'list2'
)
)
})
#When creating a bookmark, manually store the selections from our bucket lists
onBookmark(function(state) {
state$values$list1 <- input$list1
state$values$list2 <- input$list2
})
#When restoring a bookmark, manually retrieve the selections from our bucket lists and re-render the bucket list input
onRestore(function(state) {
output$bucket <- renderUI({
bucket_list(
header = "This is a bucket list. You can drag items between the lists.",
add_rank_list(
text = "Drag from here",
labels = state$values$list1,
input_id = 'list1'
),
add_rank_list(
text = "to here",
labels = state$values$list2,
input_id = 'list2'
)
)
})
})
}
enableBookmarking("url")
shinyApp(ui, server)
R shiny bookmark button
As said by @Tschösi these values are hard coded in the function, which leaves you with 2 options:
- You create an own copy of the function, where you replace the hard coded versions.
- You apply some Javascript to change the text dynamically.
Personally, I'd favor option 2.
Here's a working example of how to do that:
library(shiny)
js <- HTML(paste("$(function() {",
"$('body').on('shown.bs.modal', function() {",
"$('.modal-dialog .modal-header > .modal-title').text('Speicher Lesezeichen')",
"$('.modal-dialog .modal-body > span:first').text('Dieser Link speichert den aktuellen Status der Applikation.')",
"$('#shiny-bookmark-copy-text').text('Drücken Sie Ctrl-C um den Link zu kopieren.')",
"$('.modal-dialog .modal-footer > button').text('Schließen')",
"})",
"})",
sep = "\n"))
ui <- function(request) {
fluidPage(
tags$head(tags$script(js, type = "text/javascript")),
tabsetPanel(id = "tabs",
tabPanel("One",
checkboxInput("chk1", "Checkbox 1"),
bookmarkButton(id = "bookmark1")
),
tabPanel("Two",
checkboxInput("chk2", "Checkbox 2"),
bookmarkButton(id = "bookmark2")
)
)
)
}
server <- function(input, output, session) {
# Need to exclude the buttons from themselves being bookmarked
setBookmarkExclude(c("bookmark1", "bookmark2"))
# Trigger bookmarking with either button
observeEvent(input$bookmark1, {
session$doBookmark()
})
observeEvent(input$bookmark2, {
session$doBookmark()
})
}
enableBookmarking(store = "url")
shinyApp(ui, server)
Related Topics
Aggregate by Specific Year in R
How to Install Multiple Packages
Loop Over Rows of Dataframe Applying Function with If-Statement
How to Append a Plot to an Existing PDF File
How to Rename a Variable in R Without Copying the Object
An Elegant Way to Change Columns Type in Dataframe in R
Add Text to Geom_Line in Ggplot
Why Is Seq(X) So Much Slower Than 1:Length(X)
Lookup Values Corresponding to the Closest Date
Move a Column to First Position in a Data Frame
Rearrange Dataframe to a Table, the Opposite of "Melt"
Using R and Plot.Ly - How to Script Saving My Output as a Webpage
R "Stats" Citation for a Scientific Paper
Is There Any Other Package Other Than "Sentiment" to Do Sentiment Analysis in R