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

这是一个有点棘手的解决方案，对于大型语料库来说，扩展性不是很好。我很想知道是否还有一种更简约，优雅和可扩展的方法来实现这一目标。

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

P.S。不幸的是，reprex不能用于彩色文本，因此无法生成完整的reprex。

Answer 2

因陀罗耶特的进攻是伟大的。这是基于Indrajeet的答案的答案，只是做了一些改动。

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)

将输出分为两行（Collapse text by group in data frame）：

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

如果我想在R控制台中将其打印出来，答案看起来还可以。如果要在R Shinyapp中使用输出，该如何工作？

正在寻找其他替代方法，感谢您的帮助。

Answer 3

这是完整的调试应用程序代码！

首先，必需的库：

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

然后，添加HTML标签的函数：

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

现在的UI部分：

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)

用R高亮显示文本以显示预定义的单词列表

3 个答案: