Erstellen eines variablen Hyperlinks in einer R Shiny App

Question

In meiner glänzenden App versuche ich einen Hyperlink zu erstellen, der eine HTML-Datei, die aus einer R Markdown-Datei erstellt wurde, zu einem bestimmten Abschnitt auf der Basis des aktuellen Tabs öffnet die App, auf der sich der Benutzer befindet

Hier ist ein Auszug aus dem ui und Server-Code, den ich benutze.

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 '' 
              }) 
              } 

Wenn ich die app laufen lasse, erhalte ich die Fehlermeldung „Fehler: kann nicht Typ‚Schließung‘zu Vektor vom Typ‚Zeichen‘zwingen“. Wenn ich page in der textOutput Funktion in der UI in einfache Anführungszeichen setzen, wird die App ausgeführt, aber die Datei wird nicht geöffnet. Ich denke, entweder die textOuput Funktion ist falsch oder die renderText Funktion im Server ist falsch, aber ich bin mir nicht sicher, was die richtige Syntax ist.

Answer 1

Ihr Problem ist, dass renderText nur Text als Ausgabe nicht über, sondern ein komplettes HTML-Objekt. In diesem Fall möchten Sie renderUI für das vollständige Objekt a verwenden. Und lass das href dynamisch darin generiert werden. Gefällt mir

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) 

Hoffe, das hilft!