Цвет подсветки текста в R для предварительно определенного списка слов

Question

Предположим, у меня есть коллекция документов, такая как:

text = c("is it possible to highlight text for some words" , 
      "suppose i want words like words to be red and words like text to be blue")

Мне интересно, можно ли выделить документы (особенно для большого корпуса) цветами для предварительно определенного списка слов, используяR. Каждое слово в списке будет иметь определенный цвет.Например, выделив «слова» красным и «текст» синим, как показано ниже.

Answer 1

Ответ Индраджита великолепен.Это ответ, основанный на ответе Индраджита, только небольшое изменение.

unique_words <- lapply(strsplit(text, " "), function(x){x[!x ==""]})

# creating a dataframe with crayonized text
df <- 
  tibble::enframe(unique_words) %>%
  tidyr::unnest() %>%

# here you can specify the color/word combinations you need 
dplyr::mutate(.data = .,
            value2 = dplyr::case_when(value == "text" ~ crayon::blue(value),
                                      value == "words" ~ crayon::red(value),
                                      TRUE ~ value)) %>%
dplyr::select(., -value) 

Вывод в две разные строки ( Свернуть текст по группам во фрейме данных ):

df <- data.table(df)
df <- df[, list(text = paste(value2, collapse=" ")), by = name]

Ответ выглядит хорошо, если бы я хотел напечатать его в консоли R.Как это работает, если я хочу получить вывод в R shinyapp?

Ищете другие альтернативы и ценим вашу помощь.

Answer 2

Вот полный отлаженный код приложения!

Сначала необходимые библиотеки:

library(shiny)
library(tidyverse)
library(DT)
library(magrittr)

Затем функция, добавляющая тег HTML:

wordHighlight <- function(SuspWord,colH = 'yellow') {
  paste0('<span style="background-color:',colH,'">',SuspWord,'</span>')
}

СейчасЧасть пользовательского интерфейса:

ui <- fluidPage(
   titlePanel("Text Highlighting"),
   sidebarLayout(
      sidebarPanel(
        textInput("wordSearch", "Word Search")
      ),
    mainPanel(
        DT::dataTableOutput("table")
      )   
   )  
   )

Наконец, на стороне сервера:

server <- function(input, output) {
   sentence <- "The term 'data science' (originally used interchangeably with 'datalogy') has existed for over thirty years and was used initially as a substitute for computer science by Peter Naur in 1960."
   sentence2 = "One of the things we will want to do most often for social science analyses of text data is generate a document-term matrix."
   YourData = data.frame(N = c('001','002'), T = c(sentence,sentence2), stringsAsFactors=FALSE)
   highlightData <- reactive({
     if (input$wordSearch!="")
      {
        patterns = input$wordSearch
        YourData2 = YourData
        YourData2[,2] %<>% str_replace_all(regex(patterns, ignore_case = TRUE), wordHighlight)
        return(YourData2)
      }
    return(YourData)
  })
    output$table <- DT::renderDataTable({
      data <- highlightData() 
    }, escape = FALSE)
}

Запустите приложение:

shinyApp(ui = ui, server = server)

Answer 3

Это несколько хакерское решение этого вопроса и не очень масштабируемое для большого корпуса.Мне будет любопытно посмотреть, есть ли гораздо более экономный, элегантный и масштабируемый способ сделать это.

library(tidyverse)
library(crayon)

# define text
text <- c("is it possible to highlight text for some words" , 
         "suppose i want words like words to be red and words like text to be blue")

# individuate words
unique_words <- function(x) {
  purrr::map(.x = x,
             .f = ~ unique(base::strsplit(x = ., split = " ")[[1]],
                           collapse = " "))
}

# creating a dataframe with crayonized text
df <- 
  tibble::enframe(unique_words(x = text)) %>%
  tidyr::unnest() %>%
# here you can specify the color/word combinations you need 
  dplyr::mutate(.data = .,
                value2 = dplyr::case_when(value == "text" ~ crayon::blue(value),
                                          value == "words" ~ crayon::red(value),
                TRUE ~ value)) %>%
  dplyr::select(., -value) 

# printing the text
print(cat(df$value2))

PS К сожалению,reprex не работает с цветным текстом, поэтому не может произвести полное представление.