如何在R Shiny App中创建变量超链接(How to create a variable hyperlink in an R Shiny App)

在我闪亮的应用程序中，我试图创建一个超链接，该超链接基于用户所在的应用程序的当前选项卡打开从R Markdown文件创建的html文件到某个部分。

这是我正在使用的ui和服务器代码的摘录。

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

当我运行该应用程序时，出现错误“错误：无法强制类型'关闭'到'字符'类型的向量。如果我在ui的textOutput函数的page中放置单引号，应用程序将运行，但文件无法打开。我认为textOuput函数是错误的或者服务器中的renderText函数是错误的，但我不确定正确的语法是什么。

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.

最满意答案

你的问题是， renderText不仅仅有文本作为输出，而是一个完整的html对象。在这种情况下，您希望将renderUI用于完整a对象。并让href在此内部动态生成。喜欢这个

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)

希望这可以帮助！

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!

更多推荐