URL Bookmarking R Shiny

前端 未结 1 937
感动是毒
感动是毒 2021-01-22 10:34

I have a shiny app with multiple tabs. Each tab has datatables,plotly charts. In one tab I am trying to use the URL bookmark functionality. When I use this bookmarking as a sepe

相关标签:
1条回答
  • 2021-01-22 10:54

    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.

    0 讨论(0)
提交回复
热议问题