使用R的gutenbergr与cv.glmnet做文本分析出现意外结果

大家好，
我正在尝试使用R语言的gutenbergr库复现文本分析练习，并通过glmnet库运行机器学习模型。

目前代码可正常运行，但输出结果不符合预期。以下是可完整复现的精简代码：

##### 加载所需依赖库 #####
library(tidyverse)
library(tidytext)
library(udpipe)
library(gutenbergr)
library(rsample)
library(glmnet)
library(yardstick)

##### 1. 从Gutenberg项目下载目标书籍 #####
twist_tale <- gutenberg_metadata %>%
  filter(
    title %in% c("A Tale of Two Cities", "Oliver Twist"),
    has_text,
    language == "en") %>%
  pull(gutenberg_id) %>%
  gutenberg_download(meta_fields = "title")

##### 2. 去除空白行 #####
twist_tale <- twist_tale %>%
  filter(text != "")

View(twist_tale)

##### 3. 创建标签变量 #####
twist_tale <- twist_tale %>%
  mutate(
    es_two_cities = case_when(
      title == "A Tale of Two Cities" ~ 1L,
      title == "Oliver Twist" ~ 0L
    ),
    line_id = row_number()
  )%>%
  view()

##### 3.1 统计不同书籍的行数 #####
twist_tale %>%
  count(title)

##### 4. 数据集预处理与建模准备 #####
dl <- udpipe_download_model(language = "english")
english_model <- udpipe_load_model(dl$file_model)

text <- twist_tale %>%
  select(doc_id = line_id, text)

twist_tale_preprocesado <- udpipe(text, english_model, parallel.cores = 4L)

##### 4b 拆分训练集与测试集 #####
set.seed(1234L)
twist_tale_split <- initial_split(twist_tale)
twist_tale_training <- training(twist_tale_split)
twist_tale_testing <- testing(twist_tale_split)

##### 4a 文本标准化与稀疏矩阵构建 #####
sparse_train_data <- twist_tale_preprocesado %>%
  mutate(lemma = str_to_lower(lemma)) %>%
  anti_join(stop_words, by = c("lemma" = "word")) %>%
  filter(upos %in% c("PUNCT", "SYM", "X", "NUM")) %>%
  mutate(doc_id = as.integer(doc_id)) %>%
  anti_join(twist_tale_testing, by = c("doc_id" = "line_id")) %>%
  count(doc_id, lemma) %>%
  cast_sparse(doc_id, lemma, n)

截至此处所有步骤运行正常。问题出在运行cv.glmnet()模型环节：该步骤没有返回任何错误或警告信息，但输出结果为行向量，预期应当返回矩阵或tibble格式的结果。

##### 5a 提取模型标签变量 #####
y <- twist_tale_training %>%
  filter(line_id %in% rownames(sparse_train_data)) %>%
  pull(es_two_cities)

##### 6a 拟合正则化逻辑回归模型 #####
model <- cv.glmnet(sparse_train_data, y, family = "binomial", 
                   keep = T, trace.it=1)           # 问题实际出在这里

coeficientes <- model$glmnet.fit %>%
  tidy() %>%
  filter(lambda == model$lambda.1se)

coeficientes %>%
  group_by(estimate > 0) %>%
  slice_max(estimate, n = 5) %>%
  ungroup()

coeficientes %>%
  group_by(estimate > 0) %>%
  slice_max(estimate, n = 5) %>%
  ungroup() %>%
  ggplot() +
  geom_col(aes(x = fct_reorder(term, estimate), y = estimate, fill = estimate > 0)) + 
  coord_flip()

问题修复说明 #

核心错误原因

稀疏矩阵构建阶段的词性过滤逻辑写反了：当前代码只保留了标点、符号、未知词、数词四类无实际语义的特征，模型无法从这些特征中学习到区分两本书的规律，最终所有特征的系数都被正则化压缩为0，仅保留截距项，所以返回的系数结果只有一行。

修复方法

将稀疏矩阵构建环节的过滤代码修改为反向过滤：

# 原错误代码
filter(upos %in% c("PUNCT", "SYM", "X", "NUM"))
# 替换为以下代码，过滤掉无意义词性，保留实义词汇
filter(!upos %in% c("PUNCT", "SYM", "X", "NUM"))

修改后重新运行即可得到包含多个特征系数的tibble结果，后续可视化代码也可正常输出。

内容的提问来源于stack exchange，提问作者Sergio A. Gottret Rios