[英]shiny.router and shinydashboard
假設您有一個簡單的shinydashboard
,其中包含使用menuItem
創建的鏈接和使用tabItems
創建的頁面:
library(shiny)
library(shinydashboard)
skin <- Sys.getenv("DASHBOARD_SKIN")
skin <- tolower(skin)
skin <- "blue"
## ui.R ##
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Put them together into a dashboardPage
ui<-dashboardPage(
dashboardHeader(title = "Simple tabs"),
sidebar,
body
)
server <- function(input, output) {
}
shinyApp(ui, server)
是否可以為頁面創建永久鏈接? 例如主頁( tabName
== "dashboard")的 URL 為 127.0.0.1:1234/home,小部件頁面位於 127.0.0.1:1234/widgets?
似乎shiny
沒有開箱即用的 URL 路由。 shiny.router
似乎是一個可能的替代方案,但我發現沒有簡單的方法可以使用shinydashboard
來做到這一點,即使用menuItem
和tabItem
。 我試圖避免重寫應用程序的 UI 以使用與shiny.router
更緊密集成的東西(例如shiny.semantic
)
是否可以在實現到各個不同頁面的永久鏈接時保留上述shinydashboard
代碼?
編輯:實際上我們可以在不使用getQueryString
和updateTabItems
書簽的情況下做同樣的事情:
library(shiny)
library(shinydashboard)
ui <- function(request) {
dashboardPage(
header = dashboardHeader(title = "Simple tabs"),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem(
"Dashboard",
tabName = "dashboard",
icon = icon("dashboard")
),
menuItem(
"Widgets",
icon = icon("th"),
tabName = "widgets",
badgeLabel = "new",
badgeColor = "green"
)
)
),
body = dashboardBody(tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
observeEvent(input$sidebarID, {
# http://127.0.0.1:6172/?tab=dashboard
# http://127.0.0.1:6172/?tab=widgets
newURL <- paste0(
session$clientData$url_protocol,
"//",
session$clientData$url_hostname,
":",
session$clientData$url_port,
session$clientData$url_pathname,
"?tab=",
input$sidebarID
)
updateQueryString(newURL, mode = "replace", session)
})
observe({
currentTab <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
if(!is.null(currentTab)){
updateTabItems(session, "sidebarID", selected = currentTab)
}
})
}
shinyApp(ui, server, enableBookmarking = "disable")
不確定您是否對這樣的解決方法感興趣,但您可以使用閃亮的書簽和updateQueryString
來實現類似的行為:
library(shiny)
library(shinydashboard)
ui <- function(request) {
dashboardPage(
header = dashboardHeader(title = "Simple tabs"),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarID",
menuItem(
"Dashboard",
tabName = "dashboard",
icon = icon("dashboard")
),
menuItem(
"Widgets",
icon = icon("th"),
tabName = "widgets",
badgeLabel = "new",
badgeColor = "green"
)
)
),
body = dashboardBody(tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
)
}
server <- function(input, output, session) {
bookmarkingWhitelist <- c("sidebarID")
observe({
setBookmarkExclude(setdiff(names(input), bookmarkingWhitelist))
})
observeEvent(input$sidebarID, {
# http://127.0.0.1:6172/?_inputs_&sidebarID=%22dashboard%22
# http://127.0.0.1:6172/?_inputs_&sidebarID=%22widgets%22
newURL <- paste0(
session$clientData$url_protocol,
"//",
session$clientData$url_hostname,
":",
session$clientData$url_port,
session$clientData$url_pathname,
"?_inputs_&sidebarID=%22",
input$sidebarID,
"%22"
)
updateQueryString(newURL,
mode = "replace",
session)
})
}
shinyApp(ui, server, enableBookmarking = "url")
一些相關鏈接:
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.