Conditionally displays different colored text in Shiny

Question

I would like Shiny to print some other colored text depending on the size of the vector. I thought something like:

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 that I was doing this on the server, and not in the user interface.

And as far as I know, I cannot move this conditional logic to the user interface.

For example, something like this will not work in the user interface:

  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?

Answer 1

Well, I have a core idea, but I'm pretty new to something related to HTML / CSS / JavaScript, so I'm sure it can be improved quite a bit. However, this seems to work quite well as much as possible.

The key functions are removeClass() and addClass() , which are well documented in the corresponding help files in 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 {} }) }) 

Answer 2

It looks like you're trying to keep all of this on the client side, so you can just use a pair of conditionalPanel s that accept javascript as conditional code. For example, coloring text in response to the current value in the numericInput field with the identifier "len",

 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 can also add an event listener to update text using javascript. It's kind of ugly inline (and I don't know much javascript), but you can just move the script to a file in wwww/ and use includeScript . As in the previous example, server does nothing.

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

Answer 3

The hunt came for an answer to a similar question. Tried a simple approach that worked for my need. It uses the built-in html style and 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>")) } }) } 

Conditional parameters are executed on the server side - it is not clear to me that the question about the author must be conditional to run in the user interface. I haven't done that. Perhaps a simple way to solve the problem in normal situations.

Answer 4

Inspired by jenesaisquoi answer I tried the following and it worked for me. It is responsive and does not require additional packages. In particular, see 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 5

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

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