给定十六进制代码的查找，如何有条件地格式化 Shiny 中的文本？

Posted 2023-03-24

【中文标题】给定十六进制代码的查找，如何有条件地格式化 Shiny 中的文本？

【英文标题】：How do I conditionally format text in Shiny given a lookup of hex codes?

【发布时间】：2018-03-05 21:03:03

【问题描述】：

我真的很难过。希望有人知道如何解决这个问题。

这是我的问题的简化版本。假设我在 R 中有这样一句话：

“敏捷的棕色狐狸跳过了懒惰的狗。”

假设我希望单词“brown”和“over”分别以蓝色和绿色突出显示。其他一切都应该没有亮点。

在 R 中，我为每个单词分配了一个十六进制代码。在我上面的示例中，数据框如下所示：

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

现在，进入闪亮的应用程序。我可以使用这种方法将整个字符串的背景颜色设置为一个十六进制代码：

tags$head(tags$style(html("#thetextoutputbackground-color: #a7eef9")))))

但是如何逐字集成十六进制代码？我发现这很难实现。任何见解将不胜感激。

具有单一突出显示的完全可重现的代码：

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("#thetextoutputbackground-color: #a7eef9")))))


server <- function(input, output)

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


shinyApp(ui, server)

非常感谢。

【问题讨论】：

在做了一些研究之后，我发现使用 shinyjs 可能是合适的，特别是某种条件 addClass。

【参考方案1】：

不清楚您是如何设置变量的，所以我冒昧地对其进行了一些更改。

我所做的是在 renderUI 中，我将字符串拆分为单词（您需要使用更聪明的正则表达式，因为这个正则表达式不会删除标点符号），然后将每个单词与表，并为每个单词创建一个单独的 <span> 标记。

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)