標題中的R Shiny動態文本（反應式renderUI）

Question

我試圖將動態文本放在閃亮的標題中，並設法將文本放入其中，但在從反應式表達式接收到新數據后無法更新它。 要將文本放在標題中，我使用了一個基本的Java調用， 標記為$ 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)