0

In my shiny app, I'm trying to create a hyperlink that opens an html file, created from an R Markdown file, to a certain section based on the current tab of the app the user is on.

Here's an excerpt from the ui and server code I'm using.

ui <- fluidPage(title = "App Title",
                dashboardPage(title = "App Title",
                              dashboardHeader(tags$li(a(href = paste0('Help_File.html', textOutput(page), target="_blank", icon("question"), title = "Help"), class = "dropdown")),
                              dashboardSidebar(sidebarMenu(id = "tabs",
                                                           menuItem(text = 'Tab 1', tabName = 'tab1'),
                                                           menuItem(text = 'Tab 2', tabName = 'tab2'),
                                                           menuItem(text = 'Tab 3', tabName = 'tab3')
                                                           )
                                               )

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

                   output$page <- renderText({
                                  if(input$tabs == 'tab1') {'#page_1'}
                                  else if (input$tabs == 'tab2') {'#page_2'}
                                  else if (input$tabs == 'tab3') {'#page_3'}
                                  else ''
                                             })
                                            }

When I run the app, I get the error "ERROR: cannot coerce type 'closure' to vector of type 'character'". If I put single quotes around page in the textOutput function in the ui, the app runs but the file doesn't open. I think either the textOuput function is wrong or the renderText function in the server is wrong but I'm not sure what the correct syntax is.

mosk915
  • 696
  • 1
  • 7
  • 16

1 Answers1

1

Your problem is that renderText doesn't just have text as output but rather a complete html object. In this case you want to use renderUI for the complete a object. And let the href be dynamicly generated within this. Like this

library(shiny)
library(shinydashboard)
ui <- fluidPage(title = "App Title",
                dashboardPage(title = "App Title",
                              header = dashboardHeader(tags$li(uiOutput("page"), class = "dropdown")),
                              sidebar = dashboardSidebar(sidebarMenu(id = "tabs",
                                                           menuItem(text = 'Tab 1', tabName = 'tab1'),
                                                           menuItem(text = 'Tab 2', tabName = 'tab2'),
                                                           menuItem(text = 'Tab 3', tabName = 'tab3')
                                                           )
                                               ),
                              body = dashboardBody(div())
                )
)
server <- function(input, output, session) {
  output$page <- renderUI({
    a(href = paste0(
      'Help_File.html', 
      if(input$tabs == 'tab1') {'#page_1'}
      else if (input$tabs == 'tab2') {'#page_2'}
      else if (input$tabs == 'tab3') {'#page_3'}
      else ''), 
      target="_blank", 
      style = "color:#FFF;",
      icon("question"), 
      title = "Help",
      "Help")
  })
}

shinyApp(ui,server)

Hope this helps!

Bertil Baron
  • 4,923
  • 1
  • 15
  • 24
  • Thanks, this did the trick! One side effect seems to be that the icon is now at the very top right corner of the dashboard header instead of having a little space to the right and being more centered from top to bottom. I can shift it back to the left by defining a margin but is there anything I can use to shift it back down so that it’s aligned in the middle of the header? – mosk915 Dec 06 '17 at 13:51
  • 1
    it is not the best way but you can add `style = "vertical-align: middle;line-height: 50px;"` to the li object after `class = "dropdown"` – Bertil Baron Dec 06 '17 at 13:59
  • Works for me. Thanks again! – mosk915 Dec 06 '17 at 14:55