R ShinyDashboard 文本输出到 Header

Question

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

在我的测试运行中，我只在代码中放置一个变量时就可以正常工作，但是当我使用 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)

R ShinyDashboard 文本输出到 Header

R ShinyDashboard textOutput to Header

shiny

shinydashboard