在 R Shiny 中设置相对 link / 锚点
Set relative link / anchor in R Shiny
我想创建一个可钻取的图形,links 到我的 Shiny App 中的其他地方。
library(tidyverse)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title="My Fitness Dashboard",titleWidth =400),
####sidebar#####
dashboardSidebar(width = 240,
sidebarMenu(startExpanded = TRUE,
br(),
br(),
br(),
menuItem(text = 'Overview',
tabName = "fitDash"),
menuItem(text = 'Floors',
tabName = "floors")
)), #close dashboardSidebar
dashboardBody(
tabItems(
tabItem(tabName = 'fitDash',
uiOutput("dashboard"),
), #close tabItem
tabItem(tabName = 'floorsUp',
fluidRow(
column(width = 10,
box(width = 12,
textOutput('floorsClimbed') #plot comments
) #close box
) #close column
) #close fluidRow
) #close tabItem
) #close tabItems
) #close dashboardBody
) #close dashboardPage
###### Server logic required to draw plots####
server <- function(input, output, session) {
output$dashboard <- renderUI({
tags$map(name="fitMap",
tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="https://www.w3schools.com"),
#tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="/floorsClimbed"),
tags$img(src = 'fitbit1.jpg', alt = 'System Indicators', usemap = '#fitMap')
) #close tags$map
})
output$floorsClimbed <- renderText({
"I walked up 12 floors today!"
})
} #close server function
# Run the application
shinyApp(ui = ui, server = server)
以下行非常适合 link 到外部站点:
tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="https://www.w3schools.com")
但是,我实际上想在内部 link 到 "floorsUp" 选项卡,其中包含以下内容:
tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="/floorsUp")
您可以向您的元素添加一个 onclick 侦听器。不幸的是,我无法重现您的示例,但我修改了闪亮文档中的示例应用程序。
您可以从 javascript 向 shiny 发送消息并通过 onclick
侦听器触发 javascript 代码。
shiny::tags$a("Switch to Widgets", onclick="Shiny.onInputChange('tab', 'widgets');")
onInputChange
的参数是id
和value
。在服务器端,您可以通过 input$id
访问这些值。在我们的例子中是 input$tab
。结果值将是 widgets
.
然后我们可以使用updateTabItems
更新tabItem:
observeEvent(input$tab, {
updateTabItems(session, "tabs", input$tab)
})
其他详细信息:
请注意,输入仅在值更改时在服务器端触发。因此,我们可能希望在我们发送的值中添加一个随机成分。
"var message = {id: \"tab\", data: \"widgets\", nonce: Math.random()};
Shiny.onInputChange('tab', message)")
您可以在此处找到更多信息:https://shiny.rstudio.com/articles/js-send-message.html。
可重现的例子:
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h5("Click the upper left hand corner of the picture to switch tabs"),
tags$map(name="fitMap",
tags$area(shape ="rect", coords="10,10,200,300", alt="floors",
onclick="var message = {id: \"tab\", data: \"widgets\",
nonce: Math.random()}; Shiny.onInputChange('tab', message)"),
tags$img(src = 'https://i.stack.imgur.com/U1SsV.jpg',
alt = 'System Indicators', usemap = '#fitMap')
)
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$tab, {
updateTabItems(session, "tabs", input$tab$data)
})
}
shinyApp(ui, server)
library(tidyverse)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title="My Fitness Dashboard",titleWidth =400),
####sidebar#####
dashboardSidebar(width = 240,
sidebarMenu(startExpanded = TRUE,
br(),
br(),
br(),
menuItem(text = 'Overview',
tabName = "fitDash"),
menuItem(text = 'Floors',
tabName = "floors")
)), #close dashboardSidebar
dashboardBody(
tabItems(
tabItem(tabName = 'fitDash',
uiOutput("dashboard"),
), #close tabItem
tabItem(tabName = 'floorsUp',
fluidRow(
column(width = 10,
box(width = 12,
textOutput('floorsClimbed') #plot comments
) #close box
) #close column
) #close fluidRow
) #close tabItem
) #close tabItems
) #close dashboardBody
) #close dashboardPage
###### Server logic required to draw plots####
server <- function(input, output, session) {
output$dashboard <- renderUI({
tags$map(name="fitMap",
tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="https://www.w3schools.com"),
#tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="/floorsClimbed"),
tags$img(src = 'fitbit1.jpg', alt = 'System Indicators', usemap = '#fitMap')
) #close tags$map
})
output$floorsClimbed <- renderText({
"I walked up 12 floors today!"
})
} #close server function
# Run the application
shinyApp(ui = ui, server = server)
以下行非常适合 link 到外部站点:
tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="https://www.w3schools.com")
但是,我实际上想在内部 link 到 "floorsUp" 选项卡,其中包含以下内容:
tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="/floorsUp")
您可以向您的元素添加一个 onclick 侦听器。不幸的是,我无法重现您的示例,但我修改了闪亮文档中的示例应用程序。
您可以从 javascript 向 shiny 发送消息并通过 onclick
侦听器触发 javascript 代码。
shiny::tags$a("Switch to Widgets", onclick="Shiny.onInputChange('tab', 'widgets');")
onInputChange
的参数是id
和value
。在服务器端,您可以通过 input$id
访问这些值。在我们的例子中是 input$tab
。结果值将是 widgets
.
然后我们可以使用updateTabItems
更新tabItem:
observeEvent(input$tab, {
updateTabItems(session, "tabs", input$tab)
})
其他详细信息:
请注意,输入仅在值更改时在服务器端触发。因此,我们可能希望在我们发送的值中添加一个随机成分。
"var message = {id: \"tab\", data: \"widgets\", nonce: Math.random()};
Shiny.onInputChange('tab', message)")
您可以在此处找到更多信息:https://shiny.rstudio.com/articles/js-send-message.html。
可重现的例子:
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h5("Click the upper left hand corner of the picture to switch tabs"),
tags$map(name="fitMap",
tags$area(shape ="rect", coords="10,10,200,300", alt="floors",
onclick="var message = {id: \"tab\", data: \"widgets\",
nonce: Math.random()}; Shiny.onInputChange('tab', message)"),
tags$img(src = 'https://i.stack.imgur.com/U1SsV.jpg',
alt = 'System Indicators', usemap = '#fitMap')
)
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$tab, {
updateTabItems(session, "tabs", input$tab$data)
})
}
shinyApp(ui, server)