在R Shiny中添加书签并保存书签

Question

I am trying to use the bookmark in R shiny app and the save the bookmarks in a table. First stage I want to save them locally and retrieve them whenever I load this application. Then save them on a database. Here is the code for bookmarking and saving it on the table. The bookmarking as of now works where it does read from the saved RDS.

Also does bookmarking with URL work on shinyapps.io which can save the bookmarks to a database residing on AWS.

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){
      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({
    #read_rds("bookmarks.rds")
    myBookmarks$urlDF
    write_rds(myBookmarks$urlDF, "bookmark.rds")
  }, escape=FALSE)

}

enableBookmarking(store = "url")
shinyApp(ui, server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.

Shiny applications not supported in static R Markdown documents

^{Created on 2019-01-29 by the reprex package (v0.2.1.9000)}

Answer 1

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)