URL Закладка R Shiny - PullRequest
Новая
       9

URL Закладка R Shiny

0 голосов
/ 31 января 2019

У меня блестящее приложение с несколькими вкладками.Каждая вкладка имеет таблицы данных, сюжетные диаграммы.В одной вкладке я пытаюсь использовать функцию закладки 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)

1 Ответ

0 голосов
/ 01 февраля 2019

Согласно вашему описанию, я полагаю, что для более сложных приложений вы превышаете ограничение браузера с URL-адресами закодированного состояния, как упомянуто в этой статье :

С закодированным состоянием,URL может стать очень длинным, если есть много значений.В некоторых браузерах длина URL-адреса не может превышать 2000 символов, поэтому если URL-адрес закладки больше этого, он не будет работать должным образом в этих браузерах.

Поэтому вам следует начать использовать сохраненныеЗакладки для сервера путем установки 

enableBookmarking(store = "server")

Вместо: 

enableBookmarking(store = "url")

Редактировать: Кроме того, чтобы это работало, ваш код пользовательского интерфейса должен быть заключен в функцию, принимающую request какаргумент:

2nd Edit: добавлен 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 или мойранее ответ .

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...