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

I would like Shiny to print out some different color text depending on the size of a vector. I was thinking something like:

我希望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>

...but then I realized, I'm doing this in the server, not the UI.

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

And, as far as I know, I can't move this conditional logic into the UI.

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

For example, something like this won't work in the 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 = ""))
)}

Does anyone have any creative ideas?

有没有人有任何创意?

5 个解决方案

#1

Came hunting for an answer to a similar question. Tried a simple approach that worked for my need. It uses inline html style, and htmlOutput.

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

library(shiny)

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

and

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>"))
     }
   })
 }

Conditionals run server side--it wasn't precisely clear to me from opening question that the author needed the conditional to run in UI. I didn't. Perhaps a simple way to address the issue in common situations.

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

#2

Well, I have the kernel of an idea, but I'm fairly new to anything HTML/CSS/JavaScript-related, so I'm sure it could be improved quite a bit. That said, this seems to work fairly well, as far as it goes.

好吧,我有一个想法的内核,但我对HTML / CSS / JavaScript相关的任何东西都相当新,所以我相信它可以改进很多。也就是说,就目前而言,这似乎运作得相当好。

The key functions are removeClass() and addClass(), which are well documented in their respective help files in shinyjs:

关键函数是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  {}
        })
    })

#3

It sounds like you are trying to keep it all on the client side, so you could just use a couple of conditionalPanels, which accept javascript as conditional code. For example, coloring the text in response to the current value in a numericInput box with id "len",

听起来你正试图将它全部保留在客户端,所以你可以使用几个conditionalPanels,它接受javascript作为条件代码。例如,将文本着色以响应id为“len”的numericInput框中的当前值,

library(shiny)
ui <- shinyUI(
    fluidPage(
        fluidRow(
            numericInput('len', "Length", value=19),
            conditionalPanel(
                condition = "$('#len').val() > 20",
                div(style="color:red", "This is red!")),
            conditionalPanel(
                condition = "$('#len').val() <= 20",
                div(style="color:blue", "This is blue!"))
        )
    )
)

server <- function(input, output, session) {}
shinyApp(ui = ui, server=server)

You could also add an event listener to update the text with javascript. It's kinda ugly inline (and I don't know much javascript), but you could just move the script to a file in wwww/ and use includeScript. As in the previous example, the server does nothing.

您还可以添加事件侦听器以使用javascript更新文本。它有点丑陋的内联(我不太了解javascript),但您可以将脚本移动到wwww /中的文件并使用includeScript。与前面的示例一样,服务器不执行任何操作。

ui <- shinyUI(bootstrapPage(
    numericInput('len', "Length", value=19),
    div(id="divvy", style="color:blue", "This is blue!"),
    tags$script(HTML("
        var target = $('#len')[0];
        target.addEventListener('change', function() {
            var color = target.value > 20 ? 'red' : 'blue';
            var divvy = document.getElementById('divvy');
            divvy.style.color = color;
            divvy.innerHTML = divvy.innerHTML.replace(/red|blue/g, color);
        });
    "))
))

#4

Inspired by jenesaisquoi's answer I tried the following and it worked for me. It is reactive and requires no additional packages. In particular look at output$text3

灵感来自jenesaisquoi的回答,我尝试了以下内容,它对我有用。它是被动的,不需要额外的包装。特别要看输出$ 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)

#5

Here's a more flexible answer that uses shinyjs::extendShinyjs() to give R a way to produce some parameterized JavaScript code. Compared to my other answer, the advantage of this one is that the same function can be used to reactively colorize multiple numeric outputs.

这是一个更灵活的答案,它使用shinyjs :: extendShinyjs()为R提供一种生成一些参数化JavaScript代码的方法。与我的其他答案相比,这个的优点是可以使用相同的功能来对多个数字输出进行反应性着色。

library(shiny)
library(shinyjs)

jsCode <-
"shinyjs.setCol = function(params){
     var defaultParams = {
         id: null,
         color : 'red'
     };
     params = shinyjs.getParams(params, defaultParams);
     $('.shiny-text-output#' + params.id).css('color', params.color);
 }"
setColor <- function(id, val) {
    if(is.numeric(as.numeric(val)) & !is.na(as.numeric(val))) {
        cols <- c("green", "orange", "red")
        col <- cols[cut(val, breaks=c(-Inf,3.5, 6.5, Inf))]
        js$setCol(id, col)
    }
}

shinyApp(
    ui = fluidPage(
        useShinyjs(),  ## Set up shinyjs
        extendShinyjs(text = jsCode),
        numericInput("n", "Enter a number", 1, 1, 10, 1),
        "The number is: ", textOutput("n", inline=TRUE),
        br(),
        "Twice the number is: ", textOutput("n2", inline=TRUE)
        ),
    server = function(input, output) {
        output$n  <- renderText(input$n)
        output$n2 <- renderText(2 *  input$n)
        observeEvent(input$n, setColor(id = "n", val = input$n))
        observeEvent(input$n, setColor(id = "n2", val = 2 * input$n))
    })