在R中实现支持多词术语的文本分析与TF-IDF计算

本人是R语言新手，正尝试使用自建词典对一批报告执行文本分析与TF-IDF计算。现有代码可统计单字词（如"technology"），但无法识别多词术语（如"data technology"）。先后尝试多种修改方案均未解决问题，需修正代码以纳入多词术语分析。

初始代码 #

# Load libraries
library(tidyverse)
library(tm)
library(tidytext)
library(readxl)

# Setting the folder where the documents are (set to subfolder 2012 for now to make it easier to handle)
wd <- "C:/Users/ple.si/Dropbox (CBS)/Manegerial Digital Attention (MAD)/New set 10K/2012"

# Create the corpus and clean it up a bit
corpus <- Corpus(DirSource(wd, recursive = TRUE)) # Create corpus
corpus <- tm_map(corpus, removePunctuation) # remove punctuation
corpus <- tm_map(corpus, removeNumbers) # remove numbers
corpus <- tm_map(corpus, removeWords, stopwords("english")) # remove English stop words

# Create a DocumentTerm Matrix
dtm <- DocumentTermMatrix(corpus)

# Use multiple steps to...
corpus_words <- tidy(dtm) %>% # ... transform the dtm to a tidy object
  bind_tf_idf(term, document, count) # ... use the tf_idf function from tidytext to calculate 

total_words <- corpus_words %>% group_by(document) %>% summarize(total = sum(count)) # Calculate the number of words in each document
corpus_words <- left_join(corpus_words, total_words) # add it to the table

# Get the words of interest from the dictionary and rename the columns
dictionary <- read_xlsx("C:/Users/ple.si/Dropbox (CBS)/Manegerial Digital Attention (MAD)/New set 10K/DictionaryLIWCDigital_OnlyDigital_TG.xlsx", col_names = FALSE)
names(dictionary) <- c("term", "group")

# Take the individual term lists
inno_terms    <- dictionary$term[dictionary$group==1]
techno_terms  <- dictionary$term[dictionary$group==2]
data_terms    <- dictionary$term[dictionary$group==3]
digital_terms <- dictionary$term[dictionary$group==4]

# Filter the corpus for the words of interest
TF_IDF_Inno_terms2 <- corpus_words %>% filter(grepl(paste(inno_terms, collapse = "|"), term))
TF_IDF_techno_terms2 <- corpus_words %>% filter(grepl(paste(techno_terms, collapse = "|"), term))
TF_IDF_data_terms2 <- corpus_words %>% filter(grepl(paste(data_terms, collapse = "|"), term))
TF_IDF_digital_terms2 <- corpus_words %>% filter(grepl(paste(digital_terms, collapse = "|"), term))

尝试了多种修改代码的方式，但都没能解决多词术语识别的问题。

尝试2 #

# Function to check if all multi-word terms are present in a document
check_multiword <- function(doc, multiword_terms) {
  all_terms_present <- all(sapply(multiword_terms, function(term) grepl(term, doc)))
  return(all_terms_present)
}

# Filter the corpus for documents containing multi-word terms of interest
docs_with_multiword_inno <- Filter(function(doc) check_multiword(doc, inno_terms), corpus)
docs_with_multiword_techno <- Filter(function(doc) check_multiword(doc, techno_terms), corpus)
docs_with_multiword_data <- Filter(function(doc) check_multiword(doc, data_terms), corpus)
docs_with_multiword_digital <- Filter(function(doc) check_multiword(doc, digital_terms), corpus)

尝试3 #

# Filter the corpus words for the documents containing multi-word terms of interest
corpus_words_inno <- corpus_words %>% filter(document %in% docs_with_multiword_inno)
corpus_words_techno <- corpus_words %>% filter(document %in% docs_with_multiword_techno)
corpus_words_data <- corpus_words %>% filter(document %in% docs_with_multiword_data)
corpus_words_digital <- corpus_words %>% filter(document %in% docs_with_multiword_digital)

尝试4 #

# Function to check if all multi-word terms are present in a document
check_multiword <- function(doc, multiword_terms) {
  all_terms_present <- all(sapply(multiword_terms, function(term) grepl(paste0("\\\\b", term, "\\\\b"), doc, ignore.case = TRUE)))
  return(all_terms_present)
}

# Filter the corpus for documents containing multi-word terms of interest
docs_with_multiword_inno <- Filter(function(doc) check_multiword(doc, inno_terms), corpus)
docs_with_multiword_techno <- Filter(function(doc) check_multiword(doc, techno_terms), corpus)
docs_with_multiword_data <- Filter(function(doc) check_multiword(doc, data_terms), corpus)
docs_with_multiword_digital <- Filter(function(doc) check_multiword(doc, digital_terms), corpus)

# Filter the corpus words for the documents containing multi-word terms of interest
corpus_words_inno <- corpus_words %>% filter(document %in% docs_with_multiword_inno)
corpus_words_techno <- corpus_words %>% filter(document %in% docs_with_multiword_techno)
corpus_words_data <- corpus_words %>% filter(document %in% docs_with_multiword_data)
corpus_words_digital <- corpus_words %>% filter(document %in% docs_with_multiword_digital)

尝试5 #

# Create the corpus and clean it up a bit
corpus <- Corpus(DirSource(wd, recursive = TRUE)) # Create corpus
corpus <- tm_map(corpus, removePunctuation) # remove punctuation
corpus <- tm_map(corpus, removeNumbers) # remove numbers
corpus <- tm_map(corpus, removeWords, stopwords("english")) # remove English stop words

# Tokenize the text into n-grams (multiword terms)
multiword_terms <- c("new product", "new products", "new technologies", "new services",
                     "new solutions", "renew services", "artificial intelligence",
                     "machine learning", "data technology", "data security",
                     "data protection", "personal data", "data collection",
                     "store data", "internal data", "external data", "data privacy",
                     "data centers", "data driven", "customer data", "data from customer",
                     "data science", "data collection", "data analysis", "big data",
                     "market data", "data sets")
custom_tokenizer <- function(x) {
  unlist(lapply(ngrams(words(x), n = 1:2), paste, collapse = " "))
}

corpus <- tm_map(corpus, content_transformer(custom_tokenizer))

# Create a DocumentTerm Matrix
dtm <- DocumentTermMatrix(corpus)

# Get the words of interest from the dictionary and rename the columns
dictionary <- read_xlsx("C:/Users/ple.si/Dropbox (CBS)/Manegerial Digital Attention (MAD)/New set 10K/DictionaryLIWCDigital_OnlyDigital_TG.xlsx", col_names = FALSE)
names(dictionary) <- c("term", "group")

# Take the individual term lists
inno_terms    <- c(dictionary$term[dictionary$group == 1], multiword_terms)
techn_terms  <- c(dictionary$term[dictionary$group == 2], multiword_terms)
data_terms    <- c(dictionary$term[dictionary$group == 3], multiword_terms)
digital_terms <- c(dictionary$term[dictionary$group == 4], multiword_terms)

# Use multiple steps to...
corpus_words <- tidy(dtm) %>% # ... transform the dtm to a tidy object
  bind_tf_idf(term, document, count) # ... use the tf_idf function from tidytext to calculate 

total_words <- corpus_words %>% group_by(document) %>% summarize(total = sum(count)) # Calculate the number of words in each document
corpus_words <- left_join(corpus_words, total_words) # add it to the table

# Filter the corpus for the words of interest
TF_IDF_Inno_terms5 <- corpus_words %>% filter(term %in% inno_terms)
TF_IDF_techno_terms5 <- corpus_words %>% filter(term %in% techno_terms)
TF_IDF_data_terms5 <- corpus_words %>% filter(term %in% data_terms)
TF_IDF_digital_terms5 <- corpus_words %>% filter(term %in% digital_terms)

除了这些尝试，我还试过用Julia的ngrams方法，但现在代码只返回单字词，字典里的双字词完全提取不出来（我手动检查过，文件里确实存在这些双字词）。

尝试6 #

# Set paths
folder_path <- "C:/Users/ple.si/Dropbox (CBS)/Manegerial Digital Attention (MAD)/New set 10K/2012"
dictionary_path <- "C:/Users/ple.si/Dropbox (CBS)/Manegerial Digital Attention (MAD)/New set 10K/DictionaryLIWCDigital_OnlyDigital_TG.xlsx"

# Read dictionary words
dictionary <- read_excel(dictionary_path)
dictionary_words <- dictionary$Word

# Read all text files
all_text <- list.files(path = folder_path, full.names = TRUE) %>%
  map_chr(read_file) %>%
  enframe(name = NULL, value = "text")

# Tokenize unigrams and bigrams
tidy_tokens <- all_text %>%
  unnest_tokens(token, text) %>%
  filter(token %in% dictionary_words)  # Filter by dictionary words

tidy_bigrams <- all_text %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2) %>%
  filter(str_replace_all(bigram, " ", "_") %in% dictionary_words)  # Filter by dictionary words

# Combine unigrams and bigrams
combined_tokens <- bind_rows(
  tidy_tokens %>% mutate(type = "unigram"),
  tidy_bigrams %>% mutate(type = "bigram")
)

# Count token frequencies
token_counts <- combined_tokens %>%
  count(type, token, sort = TRUE)

token_counts

尝试7 #

# Set paths
folder_path <- "C:/Users/ple.si/Dropbox (CBS)/Manegerial Digital Attention (MAD)/New set 10K/2012"
dictionary_path <- "C:/Users/ple.si/Dropbox (CBS)/Manegerial Digital Attention (MAD)/New set 10K/DictionaryLIWCDigital_OnlyDigital_TG.xlsx"

# Read dictionary words
dictionary <- read_excel(dictionary_path)
dictionary_words <- dictionary$Word

# Read all text files
all_text <- list.files(path = folder_path, full.names = TRUE) %>%
  map_chr(read_file) %>%
  enframe(name = NULL, value = "text")

# Tokenize unigrams and bigrams
tidy_tokens <- all_text %>%
  unnest_tokens(token, text) %>%
  filter(token %in% dictionary_words)  # Filter by dictionary words

tidy_bigrams <- all_text %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2) 

# Filter bigrams using inner_join with dictionary words
tidy_bigrams <- tidy_bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  filter(word1 %in% dictionary_words, word2 %in% dictionary_words) %>%
  unite(bigram, word1, word2, sep = " ")  # Rejoin the filtered words

# Combine unigrams and bigrams
combined_tokens <- bind_rows(
  tidy_tokens %>% mutate(type = "unigram"),
  tidy_bigrams %>% mutate(type = "bigram")
)

# Count token frequencies
token_counts <- combined_tokens %>%
  count(type, token, sort = TRUE)

token_counts

谢谢 :)

内容的提问来源于stack exchange，提问作者Pablo