1
votes

I am really stumped. Hopefully someone has an idea how to solve this.

Here's a simplified version of my problem. Let's say I have a sentence in R like such:

"The quick brown fox jumped over the lazy dog."

Let's also say that I want the word "brown" and the word "over" to be highlighted in blue and green, respectively. Everything else should have no highlights.

In R, I have assigned a hex code per word. In my example above, the data frame would look like this:

df <- as.data.frame(c("The", "quick", "brown", "fox", "jumped", "over", "the", "lazy", "dog."))
df$color <- c("#ffffff","#ffffff", "#a7eef9", "#ffffff", "#ffffff", "#bcdd87", "#ffffff", "#ffffff", "#ffffff")
colnames(df) <- c("word", "color")

Now, onto the Shiny App. I am able to set the background color of the entire string to one hex code, using this method:

tags$head(tags$style(HTML("#thetextoutput{background-color: #a7eef9}")))))

But how do I integrate hex codes word-by-word? I am finding this to be extremely difficult to pull off. Any insight would be appreciated.

Fully reproducible code with single highlight:

library(shiny)
library(shinyjs)
library(tidyverse)
library(htmltools)
library(tools)

df <- as.data.frame(c("The", "quick", "brown", "fox", "jumped", "over", "the", "lazy", "dog."))
df$color <- c("#ffffff","#ffffff", "#a7eef9", "#ffffff", "#ffffff", "#bcdd87", "#ffffff", "#ffffff", "#ffffff")
colnames(df) <- c("word", "color")
example.text <- "The quick brown fox jumped over the lazy dog."

ui <- mainPanel(
  fluidRow(
    useShinyjs(),
    h3("Hello world"),
    uiOutput("thetextoutput"),
    tags$head(tags$style(HTML("#thetextoutput{background-color: #a7eef9}")))))


server <- function(input, output){

output$thetextoutput <- 
  renderUI({
    return(example.text)
    })
}

shinyApp(ui, server)

Thank you very much.

1
After doing some research I have found that using shinyjs might be appropriate, specifically, some sort of conditional addClass.darth_vad0r

1 Answers

1
votes

It's not super clear how you have your variables set up, so I've taken the liberty of changing it up a bit.

What I'm doing is inside the renderUI, I split the string into words (you'd need to use a more clever regex because this regex won't remove punctuation for example), and then just compare each word to the table, and create a separate <span> tag with a colour for each word.

library(shiny)

word_colour_map <- setNames(
  c("#aaaaaa","#aaaaaa", "#a7eef9", "#aaaaaa", "#aaaaaa", "#bcdd87", "#aaaaaa", "#aaaaaa", "#aaaaaa"),
  c("The", "quick", "brown", "fox", "jumped", "over", "the", "lazy", "dog")
)
example.text <- "The quick brown fox jumped over the foo lazy dog bar"
default_colour <- "#000000"

ui <- mainPanel(
  fluidRow(
    uiOutput("thetextoutput")
  )
)


server <- function(input, output){

  output$thetextoutput <- 
    renderUI({
      words <- strsplit(example.text, " ")[[1]]
      lapply(words, function(word) {
        col <- default_colour
        if (word %in% names(word_colour_map)) {
          col <- word_colour_map[[word]]
        }
        tags$span(style = paste("color:", col), word)
      })
    })
}

shinyApp(ui, server)