在Shiny中有条件地输出不同颜色的文本

Question

我希望Shiny根据矢量的大小打印出一些不同的颜色文本.我想的是:

  output$some_text <- renderText({ 
    if(length(some_vec) < 20){
      paste("This is red text")
      <somehow make it red>
    }else{
    paste("This is blue text")
      <somehow make it blue>

...但后来我才意识到,我在服务器上做这个,而不是用户界面.

而且,据我所知,我无法将此条件逻辑移动到UI中.

例如,这样的东西在UI中不起作用:

    if(length(some_vec)< 20){
         column(6, tags$div(
         HTML(paste("This text is ", tags$span(style="color:red", "red"), sep = ""))
      )}
    else{
         tags$div(HTML(paste("This text is ", tags$span(style="color:blue", "blue"), sep = ""))
)}

有没有人有任何创意？

Answer 1

受到jenesaisquoi 的回答的启发，我尝试了以下方法，它对我有用。它是反应式的，不需要额外的包。特别看output$text3

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Reactive"),
  sidebarLayout(
    sidebarPanel(
      helpText("Variables!"),
      selectInput("var", 
                  label = "Choose Variable",
                  choices = c("red", "blue",
                              "green", "black"),
                  selected = "Rojo"),
      sliderInput("range", 
                  label = "Range:",
                  min = 0, max = 100, value = c(0, 100))
    ),
    mainPanel(
      textOutput("text1"),
      textOutput("text2"),
      htmlOutput("text3"),
      textOutput("text4")
    )
  )
))

server <- function(input, output) {
  output$text1 <- renderText({ 
    paste("You have selected variable:", input$var)
  })

  output$text2 <- renderText({ 
    paste("You have selected range:", paste(input$range, collapse = "-"))
  })

  output$text3 <- renderText({
    paste('<span style=\"color:', input$var, 
          '\">This is "', input$var, 
          '" written ', input$range[2], 
          ' - ', input$range[1], 
          ' = ', input$range[2] - input$range[1], 
          ' times</span>', sep = "")
  })

  output$text4 <- renderText({ 
    rep(input$var, input$range[2] - input$range[1])
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 2

来寻找类似问题的答案。尝试了一种适合我的需要的简单方法。它使用内联 html 样式和 htmlOutput。

library(shiny)

ui <- fluidPage(
 mainPanel(
 htmlOutput("some_text")
 )
)

和

server <- function(input, output) {

   output$some_text <- renderText({ 

     if(length(some_vec) < 20){
     return(paste("<span style=\"color:red\">This is red text</span>"))

     }else{
     return(paste("<span style=\"color:blue\">This is blue text</span>"))
     }
   })
 }

条件运行在服务器端——从开放问题中我并不清楚作者需要条件在 UI 中运行。我没有。也许是解决常见情况下问题的简单方法。

Answer 3

好吧，我有一个想法的核心，但我对 HTML/CSS/JavaScript 相关的任何东西都相当陌生，所以我确信它可以得到很大的改进。也就是说，就目前而言，这似乎运作得相当不错。

关键函数是removeClass()和addClass()，它们在shinyjs各自的帮助文件中都有详细记录：

library(shiny)
library(shinyjs)

shinyApp(
    ui = fluidPage(
        useShinyjs(),  ## Set up shinyjs
        ## Add CSS instructions for three color classes
        inlineCSS(list(.red   = "color: red",
                       .green = "color: green",
                       .blue  = "color: blue")),
        numericInput("nn", "Enter a number",
                     value=1, min=1, max=10, step=1),
        "The number is: ", span(id = "element", textOutput("nn", inline=TRUE))
        ),
    server = function(input, output) {
        output$nn <- renderText(input$nn)
        observeEvent(input$nn, {
            nn <- input$nn
            if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn))) {
                ## Clean up any previously added color classes
                removeClass("element", "red")
                removeClass("element", "green")
                removeClass("element", "blue")
                ## Add the appropriate class
                cols <- c("blue", "green", "red")
                col <- cols[cut(nn, breaks=c(-Inf,3.5, 6.5, Inf))]
                addClass("element", col)
            } else  {}
        })
    })