在R Shiny中设置相对链接/锚点

Question

bounty到期在7天内。这个问题的答案有资格获得+ 50声望赏金。 Susan Switzer想要引起更多关注对此问题。

我想创建可链接到我的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)

以下行非常适合链接到外部站点：

tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="https://www.w3schools.com")

但是，我实际上想在内部链接到“ floorsUp”选项卡，例如：

tags$area(shape ="rect", coords="130,250,240,150", alt="floors", href="/floorsUp")

Answer 1

您可以将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)