Создание закладок и сохранение закладок в R глянцевый

Question

Я пытаюсь использовать закладку в R блестящем приложении и сохранить закладки в таблице.Первый этап: я хочу сохранить их локально и извлекать их всякий раз, когда я загружаю это приложение.Затем сохраните их в базе данных.Вот код для закладки и сохранения его на столе.Закладка на данный момент работает там, где она читает из сохраненного RDS.

Также закладка с URL работает на shinyapps.io, что позволяет сохранять закладки в базе данных, расположенной на 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.

Блестящие приложения, не поддерживаемые в статических документах R Markdown

^{Создано в 2019-01-29 пакетом Представление (v0.2.1.9000)}

Answer 1

Вот альтернативный подход к моему ранее ответу с использованием saveRDS() вместо sqlite:

Редактировать: Добавлена ​​проверка имени пользователя.

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)