Clickable Table of Contents in R Shiny

I currently have a Story as one of the tabs in my Shiny app. I am trying to create a clickable table of contents (similar to what can be done for instance in Microsoft Word), to link the various sections in that table of contents to the actual text within the Story (e.g. clicking on "Chapter I" in the table of contents would take me to Chapter I within the story. The clickable table of contents should appear within the same tab, at the very top of the text.

While I have successfully created the text (of the Story), I am not familiar with a way to create the clickable table of contents noted above. Your guidance will be much appreciated.

What I currently have for the text of the story is presented below.

tabPanel("Story",
         
         fluidRow(column(width=2),
                  column(
                    h3(p(tags$em("Introduction"),style="color:black;text-align:left; font-family: Georgia; font-size: 20px")),
                    width=6,offset=1,style="background-color:white;border-radius: 10px")),
         
         fluidRow(column(width=2),
                  column(
                    h4(p("This is a short story about nature")),
                    width=6,offset=1,
                    style="background-color:white;border-radius: 10px")),
         
         fluidRow(column(width=2),
                  column(
                    h3(p(tags$em("Chapter I"),style="color:black;text-align:left; font-family: Georgia; font-size: 20px")),
                    width=6,offset=1,style="background-color:white;border-radius: 10px")),
         
         
         fluidRow(column(width=2),
                  column(
                    h4(p("In this chapter we present the background of the story")),
                    width=6,offset=1,
                    style="background-color:white;border-radius: 10px")),
         
         fluidRow(column(width=2),
                  column(
                    h3(p(tags$em("Chapter II"),style="color:black;text-align:left; font-family: Georgia; font-size: 20px")),
                    width=6,offset=1,style="background-color:white;border-radius: 10px")),
         
         fluidRow(column(width=2),
                  column(
                    h4(p("This chapter is about the main protagonists")),
                       width=6,offset=1,
                       style="background-color:white;border-radius: 10px"))
)

In pure HTML you would assign anchor names, and then you can write ancor href's to make clickable links to them.

I use that concept to extend your example.

library(shiny)

linebreaks<-function(x){
  tagList(map(1:x,~br()))
}

ui <- fluidPage(sidebarLayout(
  sidebarPanel = sidebarPanel(
    h4("Contents"),
    a(href="#protag", "Protagonists")
  ),mainPanel = 
  mainPanel(
    tabsetPanel(
      tabPanel("Story",
               
               fluidRow(column(width=2),
                        column(
                          h3(p(tags$em("Introduction"),style="color:black;text-align:left; font-family: Georgia; font-size: 20px")),
                          width=6,offset=1,style="background-color:white;border-radius: 10px")),
               linebreaks(10),
               fluidRow(column(width=2),
                        column(
                          h4(p("This is a short story about nature")),
                          width=6,offset=1,
                          style="background-color:white;border-radius: 10px")),
               linebreaks(10),
               fluidRow(column(width=2),
                        column(
                          h3(p(tags$em("Chapter I"),style="color:black;text-align:left; font-family: Georgia; font-size: 20px")),
                          width=6,offset=1,style="background-color:white;border-radius: 10px")),
               
               linebreaks(10),
               fluidRow(column(width=2),
                        column(
                          h4(p("In this chapter we present the background of the story")),
                          width=6,offset=1,
                          style="background-color:white;border-radius: 10px")),
               linebreaks(10),
               fluidRow(column(width=2),
                        column(
                          h3(p(tags$em("Chapter II"),style="color:black;text-align:left; font-family: Georgia; font-size: 20px")),
                          width=6,offset=1,style="background-color:white;border-radius: 10px")),
               linebreaks(10),
               fluidRow(column(width=2),
                        column(
                          a( name = "protag"),
                          h4(p("This chapter is about the main protagonists")),
                          width=6,offset=1,
                          style="background-color:white;border-radius: 10px"))),
    )
  )
))

server <- function(input, output, session) {
  
}

shinyApp(ui, server)

probably you want to use shinydashboard or one of its variants to have independently scrollable sidebar from main panel to have this approach make more sense.

Crosspost on SO:

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.