htmlrshinyanchorrelative-url

Set relative link / anchor in R Shiny


enter image description hereI would like to create a drillable graphic that links to other places in my 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)

The following line works perfectly to link to an external site:

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

However, I would actually like to internally link to the "floorsUp" tab with something like:

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

enter image description here


Solution

  • You could add an onclick listener to your element. Unfortunately, i can´t reproduce your example, but i modified an example app from the shiny docu.

    You can send a message from javascript to shiny and trigger the javascript code by the onclick listener.

    shiny::tags$a("Switch to Widgets", onclick="Shiny.onInputChange('tab', 'widgets');")
    

    The parameters of onInputChange are the id and value. On the server side you can access the values by input$id. In our case it is input$tab. The resulting value would be widgets.

    Then we can use updateTabItems to update the tabItem:

     observeEvent(input$tab, {
        updateTabItems(session, "tabs", input$tab)
      })
    

    Additional details:

    Note that the input only fires on the server side if the value changes. Therefore, we might want to add a stochastic component to the value we send.

    "var message = {id: \"tab\", data: \"widgets\", nonce: Math.random()};
     Shiny.onInputChange('tab', message)")
    

    You can find more infos here: https://shiny.rstudio.com/articles/js-send-message.html.

    Reproducible example:

    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.sstatic.net/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)