标题中的 R Shiny Dynamic 文本（反应式 renderUI）

Question

我正在尝试将动态文本放入闪亮的标题中，并已设法将文本放入其中，但在从反应式表达式接收到新数据后无法对其进行更新。要将文本放在标题中，我使用了一个基本的 Java 调用 tags$script。

我担心的是，renderUI 只渲染第一次，并且不会在响应值 (val) 更新时强制渲染，这正是我所需要的。

对于下面这个奇怪的例子，我很抱歉，我有一个巨大的仪表板，它有几个链接的依赖项，我试图在下面的可重现示例中复制依赖项的类型。

library(shiny)
library(shinydashboard)

ui <- fluidPage(
    dashboardPage(skin = 'black',
                  dashboardHeader(title = "test"),
                  dashboardSidebar(
                      sidebarMenu(id = 'MenuTabs',
                                  menuItem("dummy", tabName = "rawanalysis", selected = TRUE, icon = icon("dashboard"))
                      )
                  ),
    dashboardBody(
        uiOutput(outputId = 'Header'),
        fluidRow(
            box(
                actionButton("change", "Change")
            )
    ))))


server <- function(input, output) {

    Go_rv <- reactiveValues(val = 0)
    observeEvent(input$change, {

        sam <- rnorm(1)

        if(sam > 0){
            Go_rv$val <- TRUE
        } else {
            Go_rv$val <- FALSE
        }

    })

    val <- reactive({
        print(Go_rv$val)
        if(Go_rv$val){

            out <- 0
        } else {
            out <- -5
        }    

        return(out)


    })

    output$Header <- renderUI({

        removeUI(
            selector = "div:has(> #Header)"
        )

        header_text <- paste0('$(document).ready(function() {
                              $("header").find("nav").append(\'<div class="myClass">', val(), '</div>\');})')

        tags$script(HTML(header_text),
                    id = 'Header'
        )
    })

}

shinyApp(ui = ui, server = server)

Answer 1

基本上，带有observeEvent 的reactive 文本输出应该可以完成这项工作！

library(shiny)
library(shinydashboard)

ui <- fluidPage(
  dashboardPage(skin = 'black',
                dashboardHeader(title = textOutput('test')),
                dashboardSidebar(
                  sidebarMenu(id = 'MenuTabs',
                              menuItem("dummy", tabName = "rawanalysis", selected = TRUE, icon = icon("dashboard"))
                  )
                ),
                dashboardBody(
                  #uiOutput(outputId = 'Header'),
                  fluidRow(
                    box(
                      actionButton("change", "Change")
                    )
                  ))))


server <- function(input, output,session) {


  title_change <- reactive({
    input$change
    as.character(Sys.time())
  })


observeEvent(input$change, { output$test <- renderText({ title_change()

})
})


}

shinyApp(ui = ui, server = server)