使用 server.R 中的字符串作为 ui.r 中函数的参数

Question

我正在使用shinydashboardPlus() 在我正在开发的应用程序中添加时间线。我希望每个 timelineItem() 图标根据阶段是否标记为完成来改变颜色。当一个阶段不完整时，我希望图标为灰色。 When a checkboxInput() is selected, I would like the colour to change to olive.

我已经编写了服务器端逻辑，当checkboxInput 为FALSE 时返回字符串'grey'，而当TRUE 返回字符串'olive' 时。我需要将此字符串传递给timelineItem() 中的参数color。我尝试使用textOutput() 将字符串传递给参数，但这不起作用。有什么想法可以将正确的颜色字符串传递给color？

这是一个 MRE：

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)


ui <- dashboardPagePlus(

  header = dashboardHeaderPlus(title = "Quality & Assurance Dashboard"),
  sidebar = dashboardSidebar(


  ),

  body = dashboardBody(

    fluidRow(

      box(width = 9,

          title = "Assurance Timeline",
          status = "info",

          timelineBlock(
            timelineEnd(color = "danger"),
            timelineLabel("Start", color = "teal"),
            timelineItem(
              title = "Stage 1",
              icon = "gears",
              color = textOutput("survey_released_colour"), # Need to paste the correct colour string here
              time = "now",
              footer = "",

              textOutput("survey_released_colour")

            )

          )

      ),

      box(width = 3, 

          title = "Stage Sign-Off",
          status = "info",

          timelineBlock(

            timelineEnd(color = "danger"),
            timelineLabel("Start", color = "teal"),

            timelineItem(
              title = "Stage 1",
              icon = "gears",
              color = "olive",
              time = "",
              footer = "",

              "Check here when Stage 1 complete.",
              checkboxInput(inputId = "survey_release", "Surveys Released", value = FALSE, width = NULL)

            )
          )
      )
    )

  ),

)

server <- function(input, output) { 


  output$survey_released_colour<-renderText({

    if (input$survey_release == TRUE){

      paste0("olive")

    }

    else

      paste0("grey")


  })


}


app<-shinyApp(ui = ui, server = server)
runApp(app, host="0.0.0.0",port=5050, launch.browser = TRUE)

Answer 1

根据 Shiny 的基本规则，您不能在 ui.R 中使用任何服务器组件。您可以使用条件来更改服务器端的颜色。 我的尝试：

library(shinydashboardPlus)

ui <- dashboardPagePlus(

  header = dashboardHeaderPlus(title = "Quality & Assurance Dashboard"),
  sidebar = dashboardSidebar(
  ),

  body = dashboardBody(
    fluidRow(
      box(width = 9,

          title = "Assurance Timeline",
          status = "info",
          uiOutput("timeline")
      ),

      box(width = 3, 
          title = "Stage Sign-Off",
          status = "info",
          checkboxInput(inputId = "survey_release", "Surveys Released", value = FALSE, width = NULL)
      )
    )
  )
)

server <- function(input, output) { 
output$timeline<-renderUI({
  if (input$survey_release == TRUE)
  {
    timelineBlock(
      timelineEnd(color = "danger"),
      timelineLabel("Start", color = "teal"),
      timelineItem(
        title = "Stage 1",
        icon = "gears",
        #color = textOutput("survey_released_colour"), # Need to paste the correct colour string here
        color ='red',
        time = "now",
        footer = ""
      )
    )
  }
  else
  {
    timelineBlock(
      timelineEnd(color = "danger"),
      timelineLabel("Start", color = "teal"),
      timelineItem(
        title = "Stage 1",
        icon = "gears",
        #color = textOutput("survey_released_colour"), # Need to paste the correct colour string here
        color ="green",
        time = "now",
        footer = ""
      )
    )
  }
})  

}


shinyApp(ui, server) 

如果这有帮助，请告诉我。