r - URL 书签 R Shiny

Question

我有一个带有多个选项卡的 Shiny 应用程序。每个选项卡都有数据表、图表。在一个选项卡中，我尝试使用 URL 书签功能。当我将此书签用作单独的 Shiny 选项卡时，我可以单击已添加书签的 URL，它将进入已添加书签的状态。然而，在这个更大的应用程序中，当我使用相同的代码时，URL 相当长，并且不会重定向到已添加书签的状态。这就是添加书签的 URL 的样子

library(shiny)
library(ggplot2)
library(DT)
library(shinyjqui)
library(shinydashboard)
library(shinydashboardPlus)
library(data.table)

ui <- navbarPage(
  "Navbar!",
  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 = "url")
}
shinyApp(ui = ui, server = server)

Answer 1

根据您的描述，我想对于更复杂的应用程序，您会遇到编码状态 URL 的浏览器限制，如本 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.

因此，您应该通过设置开始使用保存到服务器的书签

enableBookmarking(store = "server")

而不是:

enableBookmarking(store = "url")

编辑:为此，您的 UI 代码必须封装在以 request 作为参数的函数中:

第二次编辑:将 id = "myNavbarPage" 添加到 navbarPage - 因此它将被识别为书签的输入(并相应地恢复)。

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)

请参阅 ?enableBookmarking 或我之前的 answer .