R ShinyDashboard textOutput到标头

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)