URL 书签 R 闪亮

Question

我有一个带有多个标签的闪亮应用。每个选项卡都有数据表、图表。在一个选项卡中，我尝试使用 URL 书签功能。当我将此书签用作单独的闪亮选项卡时，我可以单击已添加书签的 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

根据您的描述，我猜对于更复杂的应用程序，您正在使用article 中提到的编码状态 URL 达到浏览器限制：

在编码状态下，如果有很多值，URL 可能会变得很长。某些浏览器的 URL 长度限制为大约 2,000 个字符，因此如果书签 URL 长于该长度，则在这些浏览器中将无法正常工作。

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

enableBookmarking(store = "server")

代替：

enableBookmarking(store = "url")

编辑：同样为了让你的 UI 代码能够工作，你的 UI 代码必须包含在一个以 request 作为参数的函数中：

第二次编辑：将 id = "myNavbarPage" 添加到导航栏页面 - 因此它将被识别为书签的输入（并相应地恢复）。

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。