R ShinyDashboard textOutput to Header

Question

我正在尝试在标题上获取自定义字段，以便人们知道上次刷新数据的时间。

在我的测试运行中，我只是在代码中添加一个变量，但是当我使用textOutput时它会给我HTML背景逻辑。

<div id="Refresh" class="shiny-text-output"></div>

以下是我的代码：

library (shiny)
library (shinydashboard)

rm(list=ls())

header <- dashboardHeader(
          title = "TEST",
          tags$li(class = "dropdown", tags$a(paste("Refreshed on ", textOutput("Refresh")))))

body <- dashboardBody(

  fluidRow(box(textOutput("Refresh")))
)

sidebar <- dashboardSidebar()

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

  output$Refresh <- renderText({
  toString(as.Date("2017-5-4"))
  })
}

shinyApp(ui, server)

这就是我目前所看到的：

已编辑以显示更正后的代码

library (shiny)
library (shinydashboard)

header <- dashboardHeader(
  title = "TEST",
  tags$li(class = "dropdown", tags$a((htmlOutput("Refresh1")))))

body <- dashboardBody(

  fluidRow(box(textOutput("Refresh2")))
)

sidebar <- dashboardSidebar()

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

  output$Refresh1 <- renderUI({
    HTML(paste("Refreshed on ", toString(as.Date("2017-5-4"))))
  })

  output$Refresh2 <- renderText({
    toString(as.Date("2017-5-4"))
  })
}

shinyApp(ui, server)

Answer 1

您必须将内容粘贴为HTML tags$a，如下所示。您还必须renderText两次，因为在UI中无法使用相同的值。

library (shiny)
library (shinydashboard)

rm(list=ls())

header <- dashboardHeader(
  title = "TEST",
  tags$li(class = "dropdown", tags$a(HTML(paste("Refreshed on ", textOutput("Refresh1"))))))

body <- dashboardBody(

  fluidRow(box(textOutput("Refresh2")))
)

sidebar <- dashboardSidebar()

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output) {

  output$Refresh1 <- renderText({
    toString(as.Date("2017-5-4"))
  })

  output$Refresh2 <- renderText({
    toString(as.Date("2017-5-4"))
  })
}

shinyApp(ui, server)