章节概述

本章围绕自然语言处理（Natural Language Processing, NLP）展开，介绍文本如何被整理为可计算的数据对象，并通过词频图、词云、TF-IDF、LDA 主题模型和主题网络展示文本模式。

当前版本开放 1.0-3.0。专题研究 1 使用 OpenAlex 英文文献标题与摘要，分析 2009-2024 年社交媒体 (social media) 研究主题的分期变化。专题研究 2、专题研究 2 反思和章节练习将在后续版本开放。

本章学习内容

学习导航

本章学习内容

欢迎开始 第 9 章 的学习。请点击 下方导航卡 进入相应小节：

NLP导论

文本数据与解释

专题研究 1

社媒研究的演变

总结与反思

专题研究 1

专题研究 2

社交媒体情感分析

总结与反思

专题研究 2

章节练习

复现与挑战

💡 提示：学习完一个小节后，请再次点击 屏幕右下角的章节主页按钮回到本导航页

1.0 自然语言处理入门导论

1.1 什么是自然语言处理？

基本概念

自然语言（Natural Language）是人类在日常交流、制度表达和知识生产中使用的自然演化的语言。它不同于 R、Python、SQL 等经过严格定义的形式语言（Formal Language），也不同于高度结构化的数据库字段或统计变量。自然语言具有高度的语境依赖性、歧义性与表达的灵活性，同一个词在不同的文本上下文、社会群体和历史事件中，可能具有截然不同的含义。

自然语言处理（Natural Language Processing, 简称 NLP）是一门融合了计算机科学、人工智能与语言学的交叉学科，旨在让计算机能够理解、解释和处理人类语言。对社会科学研究而言，NLP 的基础任务是将政策文件、新闻报道、访谈记录、社交媒体帖子、文学作品和历史文献等非结构化的文本材料，转化为可观察、可计算、可比较的结构化数据对象。后续的词频统计、情感分析、主题模型和文本分类等高级分析任务，均建立在这个核心转化过程之上。

知识小卡片：文本分析与自然语言处理的关系

在社会科学研究语境下，文本分析（Text Analysis）通常被视为 NLP 技术在具体研究中的一种应用取向。它更侧重于问题驱动与理论阐释，关心研究者如何从文本中提出问题、清洗语料、构建测量指标、比较差异并解释实质性结果。

相对而言，自然语言处理（NLP）的范畴更宽，且侧重于算法研发与底层技术。除了支撑文本分析的基础工具（如分词、词性标注、命名实体识别、信息抽取）外，NLP 的核心任务还涵盖机器翻译、自动摘要、问答系统和自然语言生成等。此外，在实际的文本处理工作流中，通常还会结合语音识别（ASR）与光学字符识别（OCR）等跨模态前端技术，以实现从音频或图像到可计算文本的转化。

文本分析
文本分析的基本路径是：先将非结构化的原始文本转化为结构化数据，进而围绕研究问题探究其中的语言模式。研究者通常会将文本切分为词、句子或文档等分析单位，观察词频、共现网络、主题分布和情感倾向等量化结果，并结合原文内容、具体语境与社会科学理论进行深度解释。

从方法发展的轨迹看，NLP 技术大致可以划分为三种核心路径。第一类是基于规则的方法（Rule-based approach），高度依赖专家构建的词典、模板、语法树或人工编码规则，适合结构明确、专业性强且范围较小的特定任务。第二类是基于统计的方法（Statistical approach），主要通过词频、共现矩阵、TF-IDF（词频-逆文档频率）以及概率主题模型等算法，识别并提取文本特征的统计分布规律。第三类是机器学习与深度学习方法（Machine learning & Deep learning approaches），依赖算法模型从海量语料中自动学习分类边界、稠密的语义表示（如词向量）以及复杂的上下文关联。

本章作为入门章节，将把教学重心放在第二类（统计分析路径），并在此基础上，建立与基础机器学习分类思维的初步连接。

Figure 1. NLP发展路径：不同驱动方式

1.2 文本如何成为数据？

概念

文本本身是一种非结构化、连续的语言材料。要对其进行计算分析，研究者需要先将其转化为具有明确行列结构的量化数据（如数据框或矩阵）。这一转化过程主要涉及三个层次的结构定义：语料库（corpus）界定分析范围，文档（document）确定观测单位，词元（token）确定最小分析单位。

语料库（corpus）是被纳入研究的文本集合。它界定了研究的“总体”或“样本”，回答的是“我们分析哪些文本”。例如，一批政府工作报告、特定时间段的新闻报道、某平台上的用户评论，或一本小说的全部章节，均可构成语料库。研究者必须清晰说明语料库的构建边界（如文本来源、时间跨度、筛选条件和样本规模），因为这直接决定了研究结论的外部效度与可推论范围。
文档（document）是语料库中的基础观测单位。它回答的是结构化数据中“每一行代表什么”。一份政策文件、一条微博、一段访谈、甚至小说的一个章节，都可以被定义为一篇文档。文档粒度（Granularity）的划分会直接影响分析结果：若以整本书为文档，分析侧重于宏观的整体主题；若以章节为文档，则能比较内部的结构化差异；粒度越细，单个文档的信息量越少，但局部特征会更明显。
词元（token）是从文档中切分出来的最小分析单位。它回答的是“后续的统计或算法模型究竟在计算什么单元”。Token 可以是单个汉字、中文词语、英文单词、多词组合（n-gram），甚至是完整的句子。将连续文本切分为独立词元的过程称为分词或词元化（tokenization）。

注：英文文本通常可借助空格和标点符号完成初步的词元切分；而中文文本的词与词之间没有天然的物理分隔符（空格），因此通常需要依赖 jiebaR 等自然语言处理工具或自定义词典来辅助完成分词。

知识小卡片：传统 NLP 的 Token 与大语言模型（LLM）的 Token 是一回事吗？

拓展

在概念本质上，它们都是文本处理的最小单位，但在具体实现和应用重点上有所不同。

在传统文本分析（如词频统计、主题模型）中，我们通常期望将文本切分为完整的词语（如“社会”、“科学”）。这里的 Token 强调的是人类可读的语义单位。

而在当前的大语言模型（LLM，如 ChatGPT 等）中，Token 是神经网络输入和输出的基础计算单位。为了提高词汇覆盖率和计算效率，LLM 通常采用子词切分（Subword Tokenization，如 BPE 算法）。这意味着，LLM 中的一个 Token 未必是一个完整的词。例如，一个较长的英文单词可能会被拆分为两三个 Token（词根或前缀），而一个中文词语也可能被拆分为多个单字或特定的字符组合。

由于大模型的计算资源（如算力、内存占用）与处理的序列长度严格成正比，因此文本被切分出的 Token 数量，自然就演变成了衡量模型处理量、上下文窗口限制以及商业 API “消耗成本与计费”的通用标准。

这一转化过程可以概括为以下数据流：

语料库（Corpus） $\rightarrow$ 文档（Document） $\rightarrow$ 词元（Token） $\rightarrow$ 词频表 / 文档-词项矩阵（DTM）

在实际的量化分析工作流（如 R 语言的 tidytext 生态）中，研究者通常会维护两类结构化数据表。一类是文档表，每一行对应一个文档，包含 doc_id 以及时间、来源、作者、地区、文本原文等元数据（Metadata）。另一类是词元表，这是一种长表（Long format）格式，每一行对应一个被切分出来的 token，包含 doc_id 和 token 的具体内容。这两张表通过 doc_id 进行关系型连接。这种结构既能高效统计词频和提取主题，也能随时折返回文档层面，比较不同来源、历史时期或社会群体的文本差异。

为了满足高级算法的输入要求，词元表通常还需要转换为文档-词项矩阵（Document-Term Matrix, 简称 DTM）。在 DTM 这种宽表（Wide format）结构中，每一行代表一个文档，每一列代表一个唯一的词项（Term），单元格内的数值记录了某个词在特定文档中出现的频数或权重（如 TF-IDF）。许多经典的文本模型——例如概率主题模型、文本分类算法和文档相似度计算——都严格依赖这种结构化的高维矩阵输入。

下表概括了入门阶段最常见的文本数据结构。

自然语言处理入门阶段的常见数据结构
概念	英文	含义	课堂中常见形式
语料库	Corpus	纳入分析的一组文本集合	一批政策文件、新闻报道或评论数据
文档	Document	语料库中的单个文本单位	一篇演说、一条微博、一段访谈
词元	Token	被切分出来的最小分析单位	词、字、短语、句子或 n-gram
词表	Vocabulary	语料中保留下来的所有词项集合	去除停用词和低频词后的词项列表
文档-词项矩阵	Document-Term Matrix	以文档为行、词项为列的稀疏矩阵	主题模型、分类模型的常见输入
整洁文本	Tidy Text	每行一个 token 的长表结构	便于用 dplyr、ggplot2 继续处理

整洁文本

整洁文本（Tidy text）的核心形式是一行一个词元（One-token-per-row）。这与前几章介绍的整洁数据（Tidy data）原则高度一致：每个变量构成一列，每个观测构成一行，每类观测单位构成一张表。将文本整理为这种结构后，研究者就可以像处理标准数据框一样处理文本资料，例如筛选特定词项、统计词频、按文档或来源分组聚合、连接外部词典，并无缝衔接后续的数据可视化或统计建模。

这种数据结构还有一个至关重要的优势：它完整保留了文本与元数据（Metadata）之间的映射关系。只要保留 doc_id，词元表就可以随时重新连接到文档表中的时间、来源、作者、地区、类别标签等结构化信息。因此，文本分析不再局限于全局的词语计数，而是能够深入比较不同历史时期、媒介平台、社会群体或空间单元之间的语言表达差异。

下面通过一个简单的例子，直观演示文本如何从原始句子转化为词元表。这里特意采用英文短句，是因为英文文本天然以空格作为物理分隔符，其切分过程更加直观。

注：中文文本的结构化思路与此完全相同，但由于缺乏天然空格，通常需要先借助分词工具（如 jiebaR）将连续的字符序列切分为有意义的词语。

# ============================================================
# 从原始文本到 one-token-per-row 数据表
# ============================================================

library(tibble)

# 1. 构造一个小型文档表
# 每一行代表一个文档，doc_id 是后续连接文档表与词元表的关键外键
text_demo <- tibble(
  doc_id = c("d1", "d2", "d3"),
  source = c("政策文本", "新闻报道", "访谈材料"),
  text = c(
    "digital governance improves public services",
    "young workers discuss housing costs",
    "residents worry about personal data"
  )
)

# 2. 将每个文档切分为 token
# 这里用英文空格进行物理切分；中文文本通常需要调用分词算法
token_demo <- do.call(
  rbind,
  lapply(seq_len(nrow(text_demo)), function(i) {
    words <- strsplit(text_demo$text[i], "\\s+")[[1]]

    # 3. 为每个 token 保留原始文档编号和文本来源
    # 确保文本数据能够随时与元数据重新连接
    data.frame(
      doc_id = text_demo$doc_id[i],
      source = text_demo$source[i],
      token = words,
      stringsAsFactors = FALSE
    )
  })
)

# 4. 查看 one-token-per-row 结构
token_demo

##    doc_id   source      token
## 1      d1 政策文本    digital
## 2      d1 政策文本 governance
## 3      d1 政策文本   improves
## 4      d1 政策文本     public
## 5      d1 政策文本   services
## 6      d2 新闻报道      young
## 7      d2 新闻报道    workers
## 8      d2 新闻报道    discuss
## 9      d2 新闻报道    housing
## 10     d2 新闻报道      costs
## 11     d3 访谈材料  residents
## 12     d3 访谈材料      worry
## 13     d3 访谈材料      about
## 14     d3 访谈材料   personal
## 15     d3 访谈材料       data

上面的例子展示了文本分析的基本数据结构：doc_id 保留每个 token 所属的原始文档，token 列提供可以计数和建模的语言单位，source 列保留文本来源，便于比较不同类型文本的用词差异。

注：真实研究中的语料通常涉及海量文档、丰富的元数据以及更复杂的文本清洗规则（如去除停用词、词干提取等）。

Figure 2. 从微博文本到数据与后续分析示意图

知识小卡片：自然语言处理核心术语指南

为了便于后续的算法操作与文献阅读，这里梳理了文本量化分析中最常见的基础技术概念：

停用词（Stop Words）：在文本中频繁出现但缺乏实质分析价值的功能词，例如“的”、“在”、“and”、“the”。在数据清洗阶段通常会被移除，以降低矩阵维度。
词频（Term Frequency, TF）：某个词在单一文档或整个语料库中出现的绝对次数，是构建量化文本特征的最基础指标。
词表（Vocabulary）：语料库经过清洗和切分后，保留下来的所有唯一词项的集合。清洗规则和停用词表的设定会直接决定词表的规模。
词袋模型（Bag of Words, BoW）：将文本简化为词语的无序集合，仅记录词汇是否出现及其频次，而完全不考虑词序和局部语法结构的经典文本表示方法。
N元语法（N-gram）：由连续 N 个词或字符组成的语言单位。例如 Bigram 表示连续两个词的组合，Trigram 表示连续三个词。它能在一定程度上弥补词袋模型丢失的局部上下文信息。
词频-逆文档频率（TF-IDF）：衡量某个词语在特定文档中区分度（信息熵）的经典统计指标。如果一个词在当前文档中高频出现，但在整个语料库的其他文档中极为罕见，其 TF-IDF 权重就会非常高。
词性标注（Part-of-Speech Tagging, POS）：通过算法自动识别并标注词语在句子中的语法类别，例如名词、动词、形容词等，常用于前期的特征筛选。
命名实体识别（Named Entity Recognition, NER）：从非结构化文本中自动抽取具有特定意义的实体边界与类别，如人名、地名（如具体的城市或街区）、机构名及时间表达式。
主题模型（Topic Modeling）：一种无监督的统计方法，用于从大规模语料库中挖掘潜在的语义议题结构，观察文档和词语在不同主题上的概率分布。
情感分析（Sentiment Analysis）：判断文本所蕴含的态度或情绪倾向，常见的输出结果包括极性（正面、负面、中性）或更复杂的情感维度（如愤怒、喜悦）。
文本分类（Text Classification）：根据文本特征将其归入预先设定的离散类别中，例如判别某段公众留言的诉求类型或政策文本的干预领域。
词向量（Word Embedding）：将词语映射为多维连续实数向量的深度学习表示方法，能够在稠密的向量空间中精确刻画词语之间的语义相似性和句法关系。

1.3 R 环境准备

环境准备

R 语言拥有极为丰富的文本分析生态。对于初学者而言，建议沿着数据处理工作流将这些工具分为三个核心阶段来理解：第一阶段是文本清洗，重点处理字符编码、标点剔除与正则表达式提取；第二阶段是分词与文本结构化，负责将非结构化的长文本转化为词元表或高维文档-词项矩阵；第三阶段是建模与可视化，涵盖语义特征提取、网络关系绘制与量化结果展示。

学习建议：本章涉及的 R 包较多，无需一次性全部掌握。前半部分请重点聚焦于数据整理与分词的基础组件，在理解“文本如何转为数据”后，再根据后续的专题研究需求，按需引入高级的建模与绘图工具。

工具提示：文本分析常用 R 包概览

数据整理与字符处理：tidyverse 生态（特别是 dplyr 与 stringr）、stringi。用于高效完成语料的读取、正则表达式清洗以及元数据的分组聚合。
接口解析与时间特征：httr2、jsonlite、lubridate。专用于调用外部大模型或数据 API、解析 JSON 格式回传结构，以及处理文本中的时间序列变量。
分词与文本矩阵构建：jiebaR、tidytext、quanteda。自然语言处理的核心组件，主要负责中文分词、去除停用词、构建词元表与文档-词项矩阵（DTM）。
建模计算与关系可视化：topicmodels、text2vec、ggplot2、ggraph、wordcloud2。涵盖了从概率主题抽取、词向量表达，到文本共现网络与动态交互词云的高级结果渲染。

# ============================================================
# 自然语言处理常用依赖包
# 安装通常只需要执行一次
# ============================================================

install.packages(c(
  # 数据整理与字符串处理
  "tidyverse",
  "stringr",
  "stringi",
  "lubridate",

  # API 调用与 JSON 解析
  "httr2",
  "jsonlite",

  # 示例语料、分词与文本结构化
  "janeaustenr",
  "jiebaR",
  "tidytext",
  "quanteda",

  # 建模与可视化
  "topicmodels",
  "text2vec",
  "wordcloud",
  "wordcloud2",
  "RColorBrewer",
  "igraph",
  "ggraph",
  "tidygraph",
  "ggalluvial",
  "ggrepel",
  "scales"
))

# ============================================================
# 加载本章常用 R 包
# ============================================================

# 1. 数据整理与字符串处理
library(tidyverse)
library(stringr)
library(stringi)
library(lubridate)

# 2. API 调用与 JSON 解析
# 后续进行大语言模型辅助编码时会用到
library(httr2)
library(jsonlite)

# 3. 示例语料、分词与文本结构化
library(janeaustenr)
library(jiebaR)
library(tidytext)
library(quanteda)

# 4. 建模与可视化
library(topicmodels)
library(text2vec)
library(wordcloud)
library(wordcloud2)
library(RColorBrewer)
library(igraph)
library(ggraph)
library(tidygraph)
library(ggalluvial)
library(ggrepel)
library(scales)

1.4 文本分析的基本流程

重要方法框架

文本量化分析本质上是一条始于研究问题、经过文本结构化处理、最终回归理论解释的闭环工作流。在入门阶段，比起盲目追求复杂的黑盒模型，更重要的是建立清晰的数据工程思维，弄懂数据流水线中每一步的具体操作及其方法论影响：语料从何而来？文档粒度如何界定？清洗规则如何影响最终保留的词表？词元表如何转化为统计频率或高维矩阵？算法模型的输出结果最终又该如何结合原文回答最初的研究问题？

本节及后续教程将贯穿整洁文本分析（Tidy text analysis）的核心思路。正如经典教材《Text Mining with R》所指出的，整洁文本秉持一行一个词元（One-token-per-row）的标准化表格格式，这使得原本非结构化的语言材料能够与 tidyverse 等现代数据科学生态无缝衔接。

整个核心分析流程可以概括为以下步骤：

明确研究问题 $\rightarrow$ 文档表构建 $\rightarrow$ 清洗与分词 $\rightarrow$ 生成词元表 $\rightarrow$ 特征提取（词频统计 / 构建 DTM） $\rightarrow$ 建模分析与可视化 $\rightarrow$ 原文回读与实质解释

1.4.1 明确研究问题与语料边界

Step 1

文本量化分析的起点始终是明确研究问题与界定语料库边界。研究问题将自上而下地决定后续所有的技术路径选择，特别是对文档粒度的界定：若关注宏观政策议题的演变，文档单位通常是一份完整的政策文件或核心条文；若关注社交媒体上的公众情绪，文档单位可能是一条独立的帖子或评论；而若探究个体的经验叙事，文档单位则可能是一段具体的访谈转写。

在界定语料边界时，研究者须清晰交代文本的具体来源、时间跨度、筛选标准以及最终的样本规模。举例而言，同样是研究“城市治理”这一主题，基于政府规划文件、新闻媒体报道、政务热线留言或深度访谈材料所提取出的语言结构截然不同。文本生成语境的根本差异，将直接决定最终量化研究结论的外部效度与可推论范围。

1.4.2 构建文档表

Step 2

完成语料界定后，需要把原始文本整理为文档表。文档表通常是一行一个文档，并保留 doc_id、文本来源、日期、原始文本和其他元数据。doc_id 是后续连接文档表、词元表、模型结果和原文回读的关键字段。

下面构造一个小型示例。它包含政策文本、新闻报道和访谈材料三类文本，用于演示后续流程。

# ============================================================
# 1. 构建文档表：一行代表一个文档
# ============================================================

library(tibble)
library(dplyr)
library(stringr)
library(tidyr)

text_docs <- tibble::tribble(
  ~doc_id, ~source, ~date, ~text_raw,
  "d1", "政策文本", "2026-01-10", "推进数字经济与实体经济深度融合，提升城市治理智能化水平。",
  "d2", "政策文本", "2026-01-18", "完善公共服务体系，鼓励社区参与，增强基层治理能力。",
  "d3", "新闻报道", "2026-02-03", "青年群体关注就业机会、住房成本与城市生活品质。",
  "d4", "新闻报道", "2026-02-15", "人工智能技术正在改变教育、医疗与交通服务的组织方式。",
  "d5", "访谈材料", "2026-03-01", "居民认为社区服务更方便了，但也担心个人数据被过度收集。"
) %>%
  mutate(date = as.Date(date))

text_docs

# A tibble: 5 × 4
  doc_id source   date       text_raw                                                
  <chr>  <chr>    <date>     <chr>                                                   
1 d1     政策文本 2026-01-10 推进数字经济与实体经济深度融合，提升城市治理智能化水平。
2 d2     政策文本 2026-01-18 完善公共服务体系，鼓励社区参与，增强基层治理能力。      
3 d3     新闻报道 2026-02-03 青年群体关注就业机会、住房成本与城市生活品质。          
4 d4     新闻报道 2026-02-15 人工智能技术正在改变教育、医疗与交通服务的组织方式。    
5 d5     访谈材料 2026-03-01 居民认为社区服务更方便了，但也担心个人数据被过度收集。

1.4.3 文本清洗与标准化

Step 3

文本清洗的目标是减少技术性噪声，并保留对研究问题有意义的语言信息。常见操作包括删除多余空格、统一标点、处理网址、去除 HTML 标签、修正编码问题和删除重复文本。

注：清洗时应保留原文列，再新增清洗后的文本列，便于后续回读和检查。

# ============================================================
# 2. 文本清洗：保留原文列，新增 text_clean
# ============================================================

text_clean <- text_docs %>%
  mutate(
    text_clean = text_raw %>%
      str_replace_all("https?://\\S+", " ") %>%   # 删除网址
      str_replace_all("[[:punct:]]", " ") %>%     # 删除英文标点
      str_replace_all("[，。；：！？、“”‘’（）]", " ") %>% # 删除常见中文标点
      str_squish()                                # 合并多余空格
  )

text_clean %>%
  select(doc_id, source, text_raw, text_clean)

# A tibble: 5 × 4
  doc_id source   text_raw                                                 text_clean                     
  <chr>  <chr>    <chr>                                                    <chr>                          
1 d1     政策文本 推进数字经济与实体经济深度融合，提升城市治理智能化水平。 推进数字经济与实体经济深度融合 提升城市治理智能化水平……
2 d2     政策文本 完善公共服务体系，鼓励社区参与，增强基层治理能力。       完善公共服务体系 鼓励社区参与 增强基层治理能力……
3 d3     新闻报道 青年群体关注就业机会、住房成本与城市生活品质。           青年群体关注就业机会 住房成本与城市生活品质……
4 d4     新闻报道 人工智能技术正在改变教育、医疗与交通服务的组织方式。     人工智能技术正在改变教育 医疗与交通服务的组织方式……
5 d5     访谈材料 居民认为社区服务更方便了，但也担心个人数据被过度收集。   居民认为社区服务更方便了 但也担心个人数据被过度收集……

清洗规则应当服务于研究问题。研究政策文本时，年份、地名和机构名可能很重要；研究情感表达时，“不”“没有”“担心”等词会改变解释方向；研究社交媒体文本时，表情符号、话题标签和转发标记有时本身就是分析对象。清洗规则需要写在代码中，并在报告中说明关键取舍。

1.4.4 分词与词元表

Step 4

分词的任务是把连续文本切分为可以统计的语言单位。英文文本常以空格和标点作为初步边界，中文文本没有天然空格，需要借助分词工具或预先整理好的分词结果。无论采用哪种方式，后续分析都应尽量整理为一行一个 token的词元表。

为了保证示例可以稳定渲染，下面先使用一张预先整理好的中文词元表。真实研究中，可以用 jiebaR 等工具完成分词，并根据研究领域加入自定义词典。

# ============================================================
# 3. 词元表：一行代表一个 token
# ============================================================

tokens_prepared <- tibble::tribble(
  ~doc_id, ~token,
  "d1", "数字经济",
  "d1", "实体经济",
  "d1", "融合",
  "d1", "城市治理",
  "d1", "智能化",
  "d2", "公共服务",
  "d2", "社区参与",
  "d2", "基层治理",
  "d3", "青年群体",
  "d3", "就业机会",
  "d3", "住房成本",
  "d3", "生活品质",
  "d4", "人工智能",
  "d4", "教育",
  "d4", "医疗",
  "d4", "交通服务",
  "d5", "居民",
  "d5", "社区服务",
  "d5", "方便",
  "d5", "担心",
  "d5", "个人数据",
  "d5", "过度收集"
) %>%
  left_join(
    text_clean %>%
      select(doc_id, source, date),
    by = "doc_id"
  ) %>%
  select(doc_id, source, date, token)

tokens_prepared

# A tibble: 22 × 4
   doc_id source   date       token   
   <chr>  <chr>    <date>     <chr>   
 1 d1     政策文本 2026-01-10 数字经济
 2 d1     政策文本 2026-01-10 实体经济
 3 d1     政策文本 2026-01-10 融合    
 4 d1     政策文本 2026-01-10 城市治理
 5 d1     政策文本 2026-01-10 智能化  
 6 d2     政策文本 2026-01-18 公共服务
 7 d2     政策文本 2026-01-18 社区参与
 8 d2     政策文本 2026-01-18 基层治理
 9 d3     新闻报道 2026-02-03 青年群体
10 d3     新闻报道 2026-02-03 就业机会
# ℹ 12 more rows

# ============================================================
# 中文分词示例：使用 jiebaR 将 text_clean 转为 token 表
# 运行前需确认已安装 jiebaR
# ============================================================

library(jiebaR)
library(purrr)

worker <- jiebaR::worker()

tokens_jieba <- text_clean %>%
  mutate(token = purrr::map(text_clean, ~ jiebaR::segment(.x, worker))) %>%
  tidyr::unnest(token) %>%
  select(doc_id, source, date, token)

1.4.5 停用词、领域词典与词项筛选

Step 5

得到词元表之后，研究者通常需要处理停用词、低频词和领域词。停用词是高频但分析信息较少的词，低频词可能来自偶然表达或分词错误，领域词典则可以帮助分词工具识别“城市治理”“个人数据”“公共服务”等具有研究意义的短语。

# ============================================================
# 4. 停用词与词项筛选
# ============================================================

stop_words_cn <- tibble::tibble(
  token = c("与", "和", "的", "了", "也", "更")
)

tokens_filtered <- tokens_prepared %>%
  anti_join(stop_words_cn, by = "token") %>%
  filter(str_length(token) >= 2)

tokens_filtered

# A tibble: 22 × 4
   doc_id source   date       token   
   <chr>  <chr>    <date>     <chr>   
 1 d1     政策文本 2026-01-10 数字经济
 2 d1     政策文本 2026-01-10 实体经济
 3 d1     政策文本 2026-01-10 融合    
 4 d1     政策文本 2026-01-10 城市治理
 5 d1     政策文本 2026-01-10 智能化  
 6 d2     政策文本 2026-01-18 公共服务
 7 d2     政策文本 2026-01-18 社区参与
 8 d2     政策文本 2026-01-18 基层治理
 9 d3     新闻报道 2026-02-03 青年群体
10 d3     新闻报道 2026-02-03 就业机会
# ℹ 12 more rows

知识小卡片：停用词表的构建没有“绝对标准”

停用词（Stop Words）通常指在语料中极其高频但缺乏实质分析意义的词汇，例如英文中的“the”、“and”、“is”，中文里的“的”、“是”、“了”。然而，某个词究竟是否应当被剔除，完全取决于具体的研究问题与分析语境。

例如，在研究宏观政策文本时，“人民”、“发展”、“治理”可能被视为缺乏区分度的套话，但也可能是刻画特定历史时期制度话语变迁的核心线索；在进行情感分析时，“不”、“没有”等否定词会直接逆转整句话的情感极性，若盲目将其作为停用词删除，将导致严重的测量误差。

因此，在严谨的量化文本分析中，研究者应详细报告停用词表的来源（如哈工大停用词表、特定开源词典等）以及自定义的增删规则，以确保整个数据清洗流程的透明度与可重复性（Reproducibility）。

1.4.6 词频、TF-IDF 与特征矩阵构建

Step 6

经过清洗的词元表可以进一步聚合或重组为不同的量化分析结构，以支撑不同深度的研究任务：

基础词频统计（Term Frequency, TF）：最直观的分析形式，主要用于观察整个语料库或特定元数据分组下的高频核心词汇分布。
TF-IDF 加权（Term Frequency-Inverse Document Frequency）：当研究目的是比较不同文档、来源或历史时期中的区分性特征词时，仅凭绝对词频是不够的。TF-IDF 能够有效抑制那些“无意义的通用高频词”，凸显出具有高度信息熵与辨识度的话语特征。
文档-词项矩阵（Document-Term Matrix, DTM）：为了满足高级算法的输入规范，通常需要将词元表由“长表”重塑为高维稀疏的“宽表”矩阵。构建 DTM 是后续进行概率主题模型、机器学习文本分类以及文档相似度计算的必经之路。

# ============================================================
# 5. 从 token 表生成词频表
# ============================================================

term_freq <- tokens_filtered %>%
  count(source, token, sort = TRUE)

term_freq

# A tibble: 22 × 3
   source   token        n
   <chr>    <chr>    <int>
 1 政策文本 公共服务     1
 2 政策文本 城市治理     1
 3 政策文本 基层治理     1
 4 政策文本 实体经济     1
 5 政策文本 数字经济     1
 6 政策文本 智能化       1
 7 政策文本 社区参与     1
 8 政策文本 融合         1
 9 新闻报道 交通服务     1
10 新闻报道 人工智能     1
# ℹ 12 more rows

# ============================================================
# 6. 计算 TF-IDF，并构建简化版文档-词项矩阵
# ============================================================

tfidf_terms <- tokens_filtered %>%
  count(source, token, sort = TRUE) %>%
  tidytext::bind_tf_idf(token, source, n) %>%
  arrange(desc(tf_idf))

dtm_demo <- tokens_filtered %>%
  count(doc_id, token) %>%
  tidyr::pivot_wider(
    names_from = token,
    values_from = n,
    values_fill = 0
  )

tfidf_terms

# A tibble: 22 × 6
   source   token        n    tf   idf tf_idf
   <chr>    <chr>    <int> <dbl> <dbl>  <dbl>
 1 访谈材料 个人数据     1 0.167  1.10  0.183
 2 访谈材料 居民         1 0.167  1.10  0.183
 3 访谈材料 担心         1 0.167  1.10  0.183
 4 访谈材料 方便         1 0.167  1.10  0.183
 5 访谈材料 社区服务     1 0.167  1.10  0.183
 6 访谈材料 过度收集     1 0.167  1.10  0.183
 7 政策文本 公共服务     1 0.125  1.10  0.137
 8 政策文本 城市治理     1 0.125  1.10  0.137
 9 政策文本 基层治理     1 0.125  1.10  0.137
10 政策文本 实体经济     1 0.125  1.10  0.137
# ℹ 12 more rows

dtm_demo

# A tibble: 5 × 23
  doc_id 城市治理 实体经济 数字经济 智能化  融合 公共服务 基层治理 社区参与 住房成本 就业机会 生活品质
  <chr>     <int>    <int>    <int>  <int> <int>    <int>    <int>    <int>    <int>    <int>    <int>
1 d1            1        1        1      1     1        0        0        0        0        0        0
2 d2            0        0        0      0     0        1        1        1        0        0        0
3 d3            0        0        0      0     0        0        0        0        1        1        1
4 d4            0        0        0      0     0        0        0        0        0        0        0
5 d5            0        0        0      0     0        0        0        0        0        0        0
# ℹ 11 more variables: 青年群体 <int>, 交通服务 <int>, 人工智能 <int>, 医疗 <int>, 教育 <int>,
#   个人数据 <int>, 居民 <int>, 担心 <int>, 方便 <int>, 社区服务 <int>, 过度收集 <int>

TF-IDF 的核心逻辑可以理解为：如果某个词在当前文档（或某类特定文本）中出现频率极高，但在整个语料库的其他文档中却极为罕见，那么这个词就具有极强的特征区分度。

1.4.7 建模分析与理论测量目标的匹配

Step 7

完成文本数据的结构化转化后，研究者即可根据核心研究设问选择相应的计算分析策略。不同的算法与模型，实质上对应着不同的理论测量目标：

词频统计分析：适合在探索性数据分析（EDA）阶段，帮助研究者快速把握整个语料库的宏观概貌与核心词汇分布。
TF-IDF 与对比分析：适合用于识别和比较不同信息来源、特定社会群体或不同历史时期之间语言特征的显著差异。
情感分析：适合用于测度文本中蕴含的态度倾向、主观情绪波动及其随时间或事件的演化轨迹。
主题模型：作为一种典型的无监督学习方法，适合在缺乏先验标签的大规模文档集合中，自下而上地挖掘潜在的语义议题结构。
文本分类：作为一种典型的有监督学习方法，适合在具有明确理论框架的指导下，将海量文档自动映射并归入预先设定的类别体系中。

结构化文本数据之后的常见分析任务
研究任务	适合回答的问题	常见输出
词频统计	哪些词最常出现	高频词表、词频图
TF-IDF	哪些词更能区分不同文档或来源	区分性词项列表
情感分析	文本表达的态度或情绪如何变化	情感标签、情感得分、时序图
主题模型	一组文档中有哪些潜在议题	主题关键词、文档主题比例
文本分类	文本能否归入预设类别	类别标签、分类概率、混淆矩阵

教学建议：从简单透明的基础方法起步

对于初学者，强烈建议在入门阶段先从基础的词频统计、分组对比以及 TF-IDF 特征计算入手。这些基础方法不仅具有极高的算法透明度与可解释性，更重要的是，它们能有效指示研究者应当重点对哪些关键文档进行原文回读（Close reading），从而在量化指标与文本实质意义之间建立可靠的联系。至于概率主题模型、情感分析及机器学习文本分类等高级算法，建议在充分理解底层的文本数据结构转换逻辑之后，再循序渐进地引入。

1.4.8 结果解释与原文回读

Step 8

文本量化分析的最终落脚点在于实质性的理论解释。必须明确的是，无论是高频词表、TF-IDF 权重、主题分布概率还是情感得分，都仅仅是算法提取出的量化中间指标。研究者必须带着这些统计特征折返回最初的研究设问，通过原文回读（Close reading）来验证模型识别出的语言模式是否在真实的语境中获得了充分支持。

此外，在得出最终结论前，研究者还需审慎评估分析结果的稳健性与有效性。需要追问：当前观察到的统计差异，究竟客观反映了真实的社会规律，还是仅仅作为一种“方法人为制造的假象”（Artifacts），受到了特定清洗规则、分词工具差异、停用词表设定、样本抽样边界，甚至是底层平台数据生成机制的干扰？

# ============================================================
# 7. 回到原始文本进行解释
# ============================================================

text_clean %>%
  filter(doc_id == "d5") %>%
  select(doc_id, source, text_raw)

# A tibble: 1 × 3
  doc_id source   text_raw                                              
  <chr>  <chr>    <chr>                                                 
1 d5     访谈材料 居民认为社区服务更方便了，但也担心个人数据被过度收集。

例如，d5 中同时出现“方便”和“担心”，如果只把它处理成一个单一情感标签，就可能丢失居民对社区服务和个人数据收集的混合态度。正式报告中应把统计结果、代表性原文和语境解释放在一起，说明结论来自哪些文本证据，也说明哪些判断仍然需要人工复核。

1.5 词频结果的可视化展示

可视化方法

完成分词、停用词过滤和频数统计后，密集的文本统计表需要通过合适的可视化手段进行降维呈现。在社会科学的量化分析中，数据可视化的根本目的绝非单纯的视觉修饰，而是为了辅助研究者与读者直观识别语料中的核心分布模式：哪些词汇占据了话语中心？哪些概念高度集中于特定的文本群体？不同来源之间是否存在具有理论意义的语言表达差异？

本节将重点演示两种最基础的入门展示方式：

词频条形图（Bar Chart）：能够清晰、精确地对比各项数值的绝对大小或相对比例。这是学术论文与正式分析报告中最标准、最严谨的呈现形式。
词云图（Word Cloud）：通过字体大小直观映射词汇权重，视觉冲击力强，非常适合用于项目初期的探索性感知和学术汇报展示。本节将首先演示基于整体语料的中文词云，随后补充一个用于对比不同文本维度的英文比较词云。

接下来的代码示例使用的是为教学构建的演示数据，延续了前文中“政策文本”、“新闻报道”与“访谈材料”的三类文本来源。在实际的研究工作流中，这张聚合后的词频表应当是由底层的词元表（Token table），通过 dplyr::count(source, token) 等分组统计函数计算得来的。

1.5.1 准备词频表

数据准备

词频可视化通常从一张长表开始。表中至少需要包含三个字段：文本来源、词项和出现次数。保留来源变量的好处是，后续既可以展示总体高频词，也可以比较不同来源之间的词汇差异。

# ============================================================
# 1. 构建课堂演示用词频表
# ============================================================

library(tibble)
library(dplyr)
library(ggplot2)
library(forcats)
library(wordcloud2)
library(RColorBrewer)

# 手工构建一张小型词频表，模拟真实研究中 count() 之后的结果
viz_freq <- tibble::tribble(
  ~source, ~token, ~n,
  "政策文本", "城市治理", 18,
  "政策文本", "公共服务", 15,
  "政策文本", "基层治理", 13,
  "政策文本", "数字经济", 12,
  "政策文本", "社区参与", 10,
  "政策文本", "智能化", 9,
  "政策文本", "实体经济", 8,
  "政策文本", "融合", 7,
  "新闻报道", "人工智能", 16,
  "新闻报道", "就业机会", 13,
  "新闻报道", "住房成本", 12,
  "新闻报道", "青年群体", 11,
  "新闻报道", "教育", 10,
  "新闻报道", "医疗", 9,
  "新闻报道", "交通服务", 8,
  "新闻报道", "生活品质", 7,
  "访谈材料", "社区服务", 14,
  "访谈材料", "个人数据", 13,
  "访谈材料", "担心", 12,
  "访谈材料", "居民", 11,
  "访谈材料", "方便", 9,
  "访谈材料", "过度收集", 8,
  "访谈材料", "服务体验", 7,
  "访谈材料", "数据安全", 7
) %>%
  # 固定文本来源的显示顺序，避免图形按拼音或默认字母顺序排列
  mutate(
    source = factor(source, levels = c("政策文本", "新闻报道", "访谈材料"))
  )

viz_freq

# A tibble: 24 × 3
   source   token        n
   <fct>    <chr>    <dbl>
 1 政策文本 城市治理    18
 2 政策文本 公共服务    15
 3 政策文本 基层治理    13
 4 政策文本 数字经济    12
 5 政策文本 社区参与    10
 6 政策文本 智能化       9
 7 政策文本 实体经济     8
 8 政策文本 融合         7
 9 新闻报道 人工智能    16
10 新闻报道 就业机会    13
# ℹ 14 more rows

1.5.2 使用条形图展示高频特征词

条形图

相比于词云，水平条形图（Horizontal Bar Chart）能够更精确地呈现数值差异，是量化研究报告与学术论文中最规范、最严谨的可视化选择。在绘制对比条形图时，应有意识地控制展示的词项数量（通常截取 Top N），以过滤掉长尾的低频词汇，避免产生不必要的视觉冗余。

# ============================================================
# 比较并展示不同来源文本中的高频核心词
# ============================================================

viz_freq_top <- viz_freq %>%
  # 步骤 1：按文本来源分组
  group_by(source) %>%
  # 步骤 2：每类文本仅保留频数最高的 Top 6 词汇，避免图形过密
  slice_max(order_by = n, n = 6, with_ties = FALSE) %>%
  ungroup() %>%
  # 步骤 3：将词项转化为因子（Factor）并按频数重排，这是绘制水平条形图的规范预处理
  mutate(token = forcats::fct_reorder(token, n))

ggplot(viz_freq_top, aes(x = n, y = token, fill = source)) +
  # 使用 geom_col() 展示已计算好的绝对词频
  geom_col(width = 0.68, show.legend = FALSE) +
  # 按文本来源进行分面（Facet），设置独立的 Y 轴，实现跨类别的清晰对比
  facet_wrap(~ source, scales = "free_y", ncol = 1) +
  # 使用低饱和度的学术配色，确保在投影和黑白打印时依然清晰具有区分度
  scale_fill_manual(
    values = c(
      "政策文本" = "#2D6A4F",
      "新闻报道" = "#4C6F91",
      "访谈材料" = "#8A5A44"
    )
  ) +
  labs(
    title = "不同来源文本中的高频词特征对比",
    subtitle = "示例数据演示：从整洁词元表到可视化统计图形",
    x = "绝对词频",
    y = NULL,
    caption = "注：本图基于课堂演示数据生成，正式研究应由实际结构化语料计算得到。"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    strip.text = element_text(face = "bold", color = "#003153"),
    plot.title = element_text(face = "bold", color = "#003153"),
    plot.subtitle = element_text(color = "#555555"),
    plot.caption = element_text(color = "#666666", size = 9)
  )

1.5.3 使用词云图展示总体词频

词云图

词云图把词频映射为字号大小，适合快速呈现一组文本中的核心词汇。为了让词云更适合学术展示，建议使用白色背景、有限词数、少旋转或不旋转，并避免过于随机的颜色。词云的主要功能是帮助读者形成初步印象，而不是进行精确比较。

# ============================================================
# 3. 基于总体词频绘制中文词云
# ============================================================

wordcloud_freq <- viz_freq %>%
  # 合并三类来源，得到总体词频
  group_by(token) %>%
  summarise(freq = sum(n), .groups = "drop") %>%
  arrange(desc(freq)) %>%
  # 控制展示词数，避免词云过密
  slice_head(n = 30) %>%
  rename(word = token)

# 固定调色板，避免使用随机颜色导致每次 knit 风格不一致
cloud_palette <- c("#003153", "#2D6A4F", "#4C6F91", "#8A5A44", "#6C5B7B")

wordcloud2::wordcloud2(
  data = wordcloud_freq,
  size = 0.65,
  minSize = 8,
  gridSize = 8,
  fontFamily = "PingFang SC, Microsoft YaHei, SimHei, sans-serif",
  color = rep(cloud_palette, length.out = nrow(wordcloud_freq)),
  backgroundColor = "white",
  minRotation = 0,
  maxRotation = 0,
  rotateRatio = 0,
  shuffle = FALSE,
  shape = "circle",
  ellipticity = 0.65,
  widgetsize = c(760, 420)
)

1.5.4 英文比较词云：简·奥斯汀作品示例

比较词云

比较词云适合展示不同文本集合中更突出的词。下面使用 janeaustenr 中的三部简·奥斯汀作品作为英文示例。它和中文词云的逻辑相同：先整理词元表，再统计词频，最后把“词项 × 文档类别”的矩阵交给 comparison.cloud()。

# ============================================================
# 4. 简·奥斯汀不同作品的比较词云
# ============================================================

library(janeaustenr)
library(tidytext)
library(tidyr)
library(stringr)
library(wordcloud)

# 选择三部作品，便于在一张比较词云中阅读
target_books <- c("Pride & Prejudice", "Sense & Sensibility", "Emma")

austen_words <- janeaustenr::austen_books() %>%
  filter(book %in% target_books) %>%                # 只保留目标作品
  tidytext::unnest_tokens(word, text) %>%           # 将文本拆成一行一个英文词
  anti_join(tidytext::stop_words, by = "word") %>%  # 删除常见英文停用词
  filter(stringr::str_length(word) >= 3)            # 去掉过短词项

comparison_matrix <- austen_words %>%
  count(book, word, sort = TRUE) %>%                # 统计每部作品中的词频
  tidyr::pivot_wider(
    names_from = book,
    values_from = n,
    values_fill = 0
  ) %>%
  tibble::column_to_rownames("word") %>%            # 词项作为矩阵行名
  as.matrix()                                       # comparison.cloud() 需要矩阵输入

set.seed(1234)

wordcloud::comparison.cloud(
  comparison_matrix,
  max.words = 100,
  random.order = FALSE,
  rot.per = 0.05,
  scale = c(3.2, 0.55),
  colors = c("#1F4E79", "#9E2F3E", "#3E7C59"),
  title.colors = c("#1F4E79", "#9E2F3E", "#3E7C59"),
  title.bg.colors = "grey96",
  title.size = 1.15
)

使用提醒：词云用于探索，不用于精确比较

词云和比较词云可以帮助读者快速看到“哪些词显眼”，但它们不适合比较接近的数值差异，也容易受字号、布局、颜色和词项筛选影响。正式报告中建议同时提供词频表、条形图或 TF-IDF 结果，并说明停用词表和词项筛选规则。

1.6 拓展阅读：R 文本分析与社会科学应用

拓展阅读

学习建议：先掌握工作流，再回归研究问题

入门阶段切忌迷失在复杂的算法细节中。建议优先熟练掌握“清洗 $\rightarrow$ 结构化 $\rightarrow$ 建模”的 R 语言实操工作流；随后再广泛阅读社会科学领域的经典文献，思考文本变量如何服务于理论测量与推断；最后视研究需求，再系统补充 NLP 的底层数学原理。

以下推荐几份高价值的核心文献与教程，供后续按需查阅：

R 语言实操 | Silge & Robinson, Text Mining with R: A Tidy Approach：与本教程思路高度契合，详细展示了如何利用 tidytext 与 dplyr 等包处理文本数据。
R 语言实操 | Quanteda Tutorials：更适合中大型语料的分析，提供了一套极为完整的文本矩阵操作工具箱。
社科研究设计 | Grimmer, Roberts & Stewart, Text as Data：系统阐述如何将文本计算方法整合进严谨的社会科学测量与因果推断框架中。
社科应用综述 | Gentzkow, Kelly & Taddy, “Text as Data”：经济学与量化社会科学视角的经典综述文献。
NLP 底层理论 | Jurafsky & Martin, Speech and Language Processing：自然语言处理领域的权威教材，适合在掌握实操后，系统补充语言模型、词向量与深度学习的基础理论。

2.0 专题研究 1：Social Media 研究主题的分期演变

2.0 专题研究 1

专题研究 1：Social Media 研究主题的分期演变

专题导航

从 OpenAlex 文献摘要到分期 LDA 与主题演变图

“用文本分析方法观察 social media 研究如何变化”

本专题以 social media 相关英文论文为对象，演示如何从 OpenAlex 获取标题与摘要，如何通过宽口径检索和分期设计构建语料，如何使用 TF-IDF 与分期 LDA 识别不同时期的主题结构，并进一步用主题词重叠、Sankey/alluvial 图和主题网络展示主题演化线索。

点击下方卡片，快速跳转至相应模块：

问题与检索

语料边界与分期

数据获取

OpenAlex 与缓存

文本处理

TF-IDF 与 DTM

LDA 模型

分期 LDA 与主题解释

主题网络

主题对齐与网络

💡 提示：学习完一个小节后，请再次点击 屏幕右下角的专题导航按钮回到本导航页

问题与检索

2.1 研究问题与检索式设计

研究问题

本专题研究以 2009-2024 年间社交媒体 Social Media 相关英文论文的标题与摘要为语料，分析研究者围绕社交媒体展开的主题、方法和应用领域如何变化。核心研究问题是：2009-2024 年间，social media 研究形成了哪些主要主题？这些主题在不同四年时期中如何出现、延续和转向？

分析路径

本专题的分析路径包括四个步骤：

使用 OpenAlex 建立 2009-2024 年 Social Media 相关英文论文的标题与摘要语料；
使用 TF-IDF 比较不同时期中更具区分度的关键词，观察研究议题和方法表述的变化；
对每个时期分别运行 LDA 主题模型，识别各时期内部较稳定的主题结构；
基于主题高概率词的重叠关系，使用 Sankey/alluvial 图和主题网络近似展示主题之间的延续、分化与转向。

方法说明
分期 LDA 的主题编号只在同一个时期内部有意义。不同时间段中的 Topic 1、Topic 2 并不天然代表同一主题。专题将通过主题词重叠来建立相邻时期主题之间的近似关联，用于展示主题演化线索。

概念说明：什么是社交媒体研究？

社交媒体（social media）是指用户通过数字平台发布内容、建立关系、转发信息、表达态度和参与公共讨论的传播环境。它既是社会互动的场所，也是研究者观察社会行为、信息流动和群体关系的重要数据来源。

常见平台包括国际语境中的 X/Twitter、Facebook、Instagram、YouTube、Reddit、TikTok，也包括中文语境中的微博、微信、抖音、小红书、Bilibili 和知乎等。

社交媒体数据通常具有规模大、时间连续、互动关系清晰、文本与多媒体并存等特点，但也存在平台偏差、用户代表性不足、算法干预和研究伦理等问题。

在计算社会科学中，social media 数据常用于研究以下问题：

舆论形成、信息扩散、错误信息与政治传播；
情绪表达、公共健康、风险沟通与危机响应；
社会运动、集体行动、社会网络与在线动员；
平台治理、算法推荐、内容审核与数字不平等。

一些常被引用和讨论的研究包括：Golder 与 Macy（2011）使用 Twitter 数据分析跨文化情绪节律；Bond 等（2012）基于 Facebook 实验研究在线社会影响与政治动员；Kramer 等（2014）使用 Facebook 数据讨论情绪传播，同时引发了重要的研究伦理争议；Vosoughi、Roy 与 Aral（2018）基于 Twitter 数据比较真实新闻与虚假新闻的传播差异。

分期设计

本研究把 2009-2024 年划分为四个连续的四年窗口。分期的目的在于控制时间跨度，使每个时期都能形成相对独立的文献语料，并便于后续比较 TF-IDF 词项、LDA 主题结构和主题词重叠关系。

分期说明：四个等距分析窗口

本专题采用等距分期，避免提前给每个阶段赋予过强的历史解释。四个时期只作为分析窗口使用：

时期一：2009-2012 年
时期二：2013-2016 年
时期三：2017-2020 年
时期四：2021-2024 年

需要注意的是，时期编号只是分析设计，不代表相关研究已经自然分成四个固定阶段。后续解释应根据模型结果、代表性文献和具体语境来完成。

检索策略

本专题采用宽口径检索构建 social media 文献语料。检索词包括 social media、social media data，以及 Twitter、Facebook、Instagram、YouTube、Reddit、TikTok 等代表性平台名称及其 data 表述。前一类词用于获取直接讨论社交媒体的文献，后一类词用于补充以具体平台为研究对象或数据来源的研究。

方法提醒：宽口径检索与样本控制

宽口径检索可以提高召回率，也会带来更多差异较大的文献。为控制语料规模，本专题采用“时期 × 检索词”的分层抓取方式：每个时期、每个检索词最多保留 300 篇文献。例如，2009-2012 × twitter 最多保留 300 篇，2021-2024 × tiktok data 也最多保留 300 篇。

这种设置有助于避免某一个高频平台或高频检索词占据大部分语料。后续模型结果应理解为 OpenAlex 英文论文标题与摘要样本中的主题线索。

注：若要形成正式系统综述，还需要补充数据库检索、人工筛选、纳入排除标准和文献质量评估。

# ============================================================
# Social media 文献检索词与分期设定
# ============================================================

# 加载本专题后续表格、绘图和数据整理需要的基础包
library(tidyverse)
library(knitr)
library(kableExtra)
library(scales)

# 设定四个等距分析窗口。
# period 用于程序分组；period_label 用于表格和图形展示。
sm_periods <- tibble::tribble(
  ~period, ~period_label, ~start_year, ~end_year,
  "2009-2012", "时期一：2009-2012", 2009, 2012,
  "2013-2016", "时期二：2013-2016", 2013, 2016,
  "2017-2020", "时期三：2017-2020", 2017, 2020,
  "2021-2024", "时期四：2021-2024", 2021, 2024
)

# 设定 OpenAlex 检索词。
# 核心词捕捉直接讨论 social media 的文献；
# 平台词补充以具体平台为研究对象或数据来源的文献。
sm_included_terms <- tibble::tribble(
  ~search_term, ~role, ~reason,
  "social media", "核心检索", "捕捉以 social media 为明确对象的研究",
  "social media data", "数据入口", "捕捉把社交媒体作为经验数据来源的研究",
  "twitter", "平台入口", "捕捉围绕 Twitter 的平台研究",
  "twitter data", "平台数据入口", "捕捉使用 Twitter 数据的研究",
  "facebook", "平台入口", "捕捉围绕 Facebook 的平台研究",
  "facebook data", "平台数据入口", "捕捉使用 Facebook 数据的研究",
  "instagram", "平台入口", "捕捉围绕 Instagram 的平台研究",
  "instagram data", "平台数据入口", "捕捉使用 Instagram 数据的研究",
  "youtube", "平台入口", "捕捉围绕 YouTube 的平台研究",
  "youtube data", "平台数据入口", "捕捉使用 YouTube 数据的研究",
  "reddit", "平台入口", "捕捉围绕 Reddit 的平台研究",
  "reddit data", "平台数据入口", "捕捉使用 Reddit 数据的研究",
  "tiktok", "平台入口", "捕捉围绕 TikTok 的平台研究",
  "tiktok data", "平台数据入口", "捕捉使用 TikTok 数据的研究"
)

# 每个“时期 × 检索词”最多保留 300 篇文献，避免单一时期或平台过度主导语料。
sm_max_per_period_term <- 300

# 每个时期分别运行 LDA，默认提取 6 个主题。
sm_k <- 6

检索边界
本研究不使用 X、Weibo、Red Note、Xiaohongshu 等词作为主检索入口。X 在英文文献检索中歧义过大，难以稳定指向原 Twitter 平台；Weibo、小红书等平台涉及不同语言环境、平台制度和研究传统，适合单独设置语料边界。本专题先使用 Twitter、Facebook、Instagram、YouTube、Reddit 和 TikTok 等英文文献中更常见的平台词，以保持检索口径相对一致。

数据获取

2.2 OpenAlex 数据获取与语料构建

开放文献数据

本专题使用 OpenAlex 作为文献数据来源。OpenAlex 是一个开放的学术知识图谱，用于整理全球科研系统中的文献、作者、期刊或会议来源、机构、主题、关键词、资助信息和引用关系。它既可以通过网页界面浏览，也可以通过 OpenAlex REST API 批量获取数据。

在 OpenAlex 中，文献被称为 works（学术作品）。一条 work 记录通常包含标题、发表年份、文献类型、来源期刊或会议、作者信息、引用次数、主题分类、关键词、DOI 和摘要等元数据。本专题关注的是英文论文的标题与摘要，因此主要使用 /works 接口，并设置年份、文献类型和摘要可用性等筛选条件。

具体来说，本专题使用 OpenAlex 完成三件事：

按照 social media 和平台相关检索词获取 2009-2024 年的英文论文记录；
提取标题、年份、来源、引用次数、OpenAlex 主题、关键词和摘要等字段；
将这些字段整理为文档表，再进入后续的分词、TF-IDF、LDA 和主题演化分析。

数据说明
OpenAlex 提供的是文献元数据，不是论文全文。本专题分析的是标题与摘要，因此模型结果反映的是论文摘要层面的主题表达，而不是全文内容的完整结构。OpenAlex 官方文档也说明，摘要字段以 abstract_inverted_index 形式保存，即每个词对应其在摘要中的位置。进行文本分析前，需要先把这个倒排结构还原为普通文本。

OpenAlex 在本专题中的作用

OpenAlex 适合用于本专题，主要因为它提供了可复现的开放文献入口。研究者可以明确记录检索词、年份范围、文献类型、抽样上限和 API 参数，后续也可以根据研究问题调整语料边界。

本专题使用 OpenAlex 的方式可以概括为：

通过 /works 接口检索 social media 相关文献；
使用 publication_year、type、has_abstract 等条件筛选记录；
保留标题、摘要、年份、来源、引用次数、主题和关键词；
把每篇论文视为一个文档，将标题与摘要作为文本分析材料；
将 API 返回结果缓存为本地 .rds 文件，避免每次 knit 时重复请求接口。

OpenAlex 的详细说明可参考 OpenAlex Developers 和 Priem、Piwowar 与 Orr 的介绍性论文 OpenAlex: A fully-open index of scholarly works, authors, venues, institutions, and concepts。

OpenAlex API 与课堂缓存

为了保证课堂 knit 的稳定性，本专题把示范语料保存为本地 RDS 缓存。只要缓存文件存在，后续运行会直接读取本地数据；如果需要重新获取数据，可以在环境变量中设置 OPENALEX_MAILTO 或 OPENALEX_API_KEY，再运行本节提供的 API 模板。

下面的代码提供了从 OpenAlex 重新获取数据的模板。为了避免每次 knit 都重复请求 API，这个代码块默认不运行。首次复现时，可以把 eval=FALSE 改为 eval=TRUE，运行一次后会在 data/openalex_cache/ 中生成三个 .rds 缓存文件。后续再改回 eval=FALSE，直接读取本地缓存即可。

# ============================================================
# OpenAlex API 模板：抓取并保存 social media 文献缓存
# ============================================================

library(tidyverse)
library(httr2)
library(lubridate)
library(stringr)

# ------------------------------------------------------------
# 1. 设置缓存路径
# ------------------------------------------------------------

sm_cache_dir <- file.path("data", "openalex_cache")
dir.create(sm_cache_dir, recursive = TRUE, showWarnings = FALSE)

sm_counts_cache <- file.path(sm_cache_dir, "openalex_social_media_period_counts_2009_2024.rds")
sm_works_cache <- file.path(sm_cache_dir, "openalex_social_media_period_works_2009_2024.rds")
sm_query_cache <- file.path(sm_cache_dir, "openalex_social_media_period_query_summary_2009_2024.rds")

# ------------------------------------------------------------
# 2. 设置 OpenAlex 请求参数
# ------------------------------------------------------------

sm_openalex_mailto <- Sys.getenv("OPENALEX_MAILTO", unset = "")
sm_openalex_api_key <- Sys.getenv("OPENALEX_API_KEY", unset = "")

# OpenAlex 每页最多返回 200 条
sm_per_page <- 200

# 多词检索词使用引号，表示短语检索
sm_prepare_search_term <- function(search_term) {
  if (str_detect(search_term, "\\s+")) {
    str_c('"', search_term, '"')
  } else {
    search_term
  }
}

# ------------------------------------------------------------
# 3. 辅助函数：解析 OpenAlex 返回结果
# ------------------------------------------------------------

sm_chr <- function(x) {
  if (is.null(x) || length(x) == 0) return(NA_character_)
  as.character(x[[1]])
}

sm_num <- function(x) {
  if (is.null(x) || length(x) == 0) return(NA_real_)
  as.numeric(x[[1]])
}

sm_collapse_names <- function(x) {
  if (is.null(x) || length(x) == 0) return(NA_character_)

  x %>%
    purrr::map_chr(~ sm_chr(.x$display_name)) %>%
    purrr::discard(is.na) %>%
    str_c(collapse = "; ")
}

sm_invert_abstract <- function(idx) {
  if (is.null(idx) || length(idx) == 0) return(NA_character_)

  tibble(
    term = names(idx),
    positions = unname(idx)
  ) %>%
    tidyr::unnest_longer(positions, values_to = "position") %>%
    arrange(position) %>%
    pull(term) %>%
    paste(collapse = " ")
}

sm_parse_work <- function(work, period, period_label, start_year, end_year,
                          search_term, role) {
  title <- sm_chr(work$display_name)
  abstract <- sm_invert_abstract(work$abstract_inverted_index)

  tibble(
    openalex_id = sm_chr(work$id),
    doi = sm_chr(work$doi),
    title = title,
    abstract = abstract,
    text = str_squish(paste(title, abstract, sep = ". ")),
    publication_year = sm_num(work$publication_year),
    publication_date = sm_chr(work$publication_date),
    period = period,
    period_label = period_label,
    start_year = start_year,
    end_year = end_year,
    cited_by_count = sm_num(work$cited_by_count),
    source = sm_chr(work$primary_location$source$display_name),
    source_type = sm_chr(work$primary_location$source$type),
    primary_topic = sm_chr(work$primary_topic$display_name),
    keywords = sm_collapse_names(work$keywords),
    search_term = search_term,
    search_role = role,
    language = sm_chr(work$language)
  )
}

# ------------------------------------------------------------
# 4. 请求 OpenAlex 单页数据
# ------------------------------------------------------------

sm_fetch_page <- function(search_term, start_year, end_year, cursor = "*") {
  sm_filter <- str_c(
    "title_and_abstract.search:", sm_prepare_search_term(search_term),
    ",type:article",
    ",has_abstract:true",
    ",language:en",
    ",from_publication_date:", start_year, "-01-01",
    ",to_publication_date:", end_year, "-12-31"
  )

  req <- request("https://api.openalex.org/works") %>%
    req_url_query(
      filter = sm_filter,
      sort = "cited_by_count:desc",
      `per-page` = sm_per_page,
      cursor = cursor,
      select = str_c(
        "id,doi,display_name,publication_year,publication_date,",
        "cited_by_count,language,primary_location,primary_topic,",
        "keywords,abstract_inverted_index"
      )
    ) %>%
    req_user_agent("ECNU R course social media text mining") %>%
    req_retry(max_tries = 3)

  if (nzchar(sm_openalex_mailto)) {
    req <- req %>% req_url_query(mailto = sm_openalex_mailto)
  }

  if (nzchar(sm_openalex_api_key)) {
    req <- req %>% req_url_query(api_key = sm_openalex_api_key)
  }

  req %>%
    req_perform() %>%
    resp_body_json(simplifyVector = FALSE)
}

# ------------------------------------------------------------
# 5. 按“时期 × 检索词”分层抓取
# ------------------------------------------------------------

sm_fetch_period_term <- function(period, period_label, start_year, end_year,
                                 search_term, role, reason, query_id) {
  message("Fetching: ", period, " | ", search_term)

  cursor <- "*"
  rows <- list()
  total_count <- NA_real_

  while (sum(purrr::map_int(rows, nrow)) < sm_max_per_period_term) {
    Sys.sleep(0.2)

    page <- sm_fetch_page(
      search_term = search_term,
      start_year = start_year,
      end_year = end_year,
      cursor = cursor
    )

    if (is.na(total_count)) {
      total_count <- sm_num(page$meta$count)
    }

    page_rows <- page$results %>%
      purrr::map_dfr(
        sm_parse_work,
        period = period,
        period_label = period_label,
        start_year = start_year,
        end_year = end_year,
        search_term = search_term,
        role = role
      )

    if (nrow(page_rows) == 0) break

    rows <- append(rows, list(page_rows))
    cursor <- page$meta$next_cursor

    if (is.null(cursor) || !nzchar(cursor)) break
  }

  works <- rows %>%
    bind_rows() %>%
    slice_head(n = sm_max_per_period_term)

  summary <- tibble(
    query_id = query_id,
    period = period,
    period_label = period_label,
    start_year = start_year,
    end_year = end_year,
    search_term = search_term,
    role = role,
    reason = reason,
    count = total_count,
    n_fetched = nrow(works),
    max_per_period_term = sm_max_per_period_term
  )

  list(works = works, summary = summary)
}

sm_query_grid <- tidyr::crossing(
  sm_periods,
  sm_included_terms
) %>%
  mutate(query_id = row_number())

sm_fetch_results <- purrr::pmap(
  sm_query_grid,
  sm_fetch_period_term
)

# ------------------------------------------------------------
# 6. 去重、整理字段并保存 RDS 缓存
# ------------------------------------------------------------

sm_works_raw <- sm_fetch_results %>%
  purrr::map("works") %>%
  bind_rows()

sm_works <- sm_works_raw %>%
  group_by(openalex_id) %>%
  summarise(
    across(
      c(doi, title, abstract, text, publication_year, publication_date,
        period, period_label, start_year, end_year, cited_by_count,
        source, source_type, primary_topic, keywords, language),
      first
    ),
    search_terms = str_c(sort(unique(search_term)), collapse = "; "),
    search_term_count = n_distinct(search_term),
    .groups = "drop"
  ) %>%
  arrange(period, desc(cited_by_count), title) %>%
  mutate(
    doc_id = str_c("sm_", row_number()),
    publication_date = ymd(publication_date),
    period_label = factor(period_label, levels = sm_periods$period_label)
  ) %>%
  select(
    doc_id, openalex_id, doi, title, abstract, text,
    publication_year, publication_date, period, period_label,
    start_year, end_year, cited_by_count, source, source_type, primary_topic,
    keywords, search_terms, search_term_count, language
  )

sm_query_summary <- sm_fetch_results %>%
  purrr::map("summary") %>%
  bind_rows()

sm_search_counts <- sm_query_summary %>%
  select(period, period_label, start_year, end_year, search_term, count)

saveRDS(sm_search_counts, sm_counts_cache)
saveRDS(sm_works, sm_works_cache)
saveRDS(sm_query_summary, sm_query_cache)

sm_works %>%
  count(period_label, name = "n_documents")

注：以上代码为AI生成，这段代码默认不运行，功能是为了从OpenAlex获得相应数据，仅供参考

读取缓存

本专题的缓存语料位于 data/openalex_cache/。其中，openalex_social_media_period_counts_2009_2024.rds 保存各时期、各检索词的 OpenAlex 结果规模，openalex_social_media_period_works_2009_2024.rds 保存用于课堂建模的分层抽样文献数据，openalex_social_media_period_query_summary_2009_2024.rds 保存抓取过程的简要记录。

# ============================================================
# 读取 OpenAlex social media 文献分期缓存
# ============================================================

# 加载数据读取、日期处理、字符串清洗和表格展示需要的包
library(tidyverse)
library(lubridate)
library(stringr)
library(knitr)
library(kableExtra)
library(scales)

# 设定缓存目录和三个缓存文件路径
# counts: 每个“时期 × 检索词”的检索规模
# works:  实际进入分析的文献记录
# query:  每次 API 请求的参数与返回信息
sm_cache_dir <- file.path("data", "openalex_cache")
sm_counts_cache <- file.path(sm_cache_dir, "openalex_social_media_period_counts_2009_2024.rds")
sm_works_cache <- file.path(sm_cache_dir, "openalex_social_media_period_works_2009_2024.rds")
sm_query_cache <- file.path(sm_cache_dir, "openalex_social_media_period_query_summary_2009_2024.rds")

# knit 时优先读取本地缓存。
# 如果缓存不存在，停止运行并提示使用后面的 API 模板重新获取数据。
if (!file.exists(sm_counts_cache) || !file.exists(sm_works_cache) || !file.exists(sm_query_cache)) {
  stop(
    "未找到 OpenAlex 缓存文件。请检查 data/openalex_cache/，或使用本节 API 模板重新获取数据。",
    call. = FALSE
  )
}

# 读取已经保存到本地的 OpenAlex 数据
sm_search_counts <- readRDS(sm_counts_cache)
sm_works <- readRDS(sm_works_cache)
sm_query_summary <- readRDS(sm_query_cache)

# 兼容旧缓存：如果早期缓存没有保存 source_type，则先补一个空列。
# 重新运行上方 API 模板后，新缓存会自动包含 OpenAlex 的 source type。
if (!"source_type" %in% names(sm_works)) {
  sm_works <- sm_works %>%
    mutate(source_type = NA_character_)
}

# 缓存文件可能保留旧版 period_label。
# 这里以 period 为准，重新映射为当前版本使用的“时期一至四”标签。
sm_period_lookup <- sm_periods %>%
  select(period, period_label)

sm_search_counts <- sm_search_counts %>%
  select(-any_of("period_label")) %>%
  left_join(sm_period_lookup, by = "period") %>%
  mutate(period_label = factor(period_label, levels = sm_periods$period_label))

sm_query_summary <- sm_query_summary %>%
  select(-any_of("period_label")) %>%
  left_join(sm_period_lookup, by = "period") %>%
  mutate(period_label = factor(period_label, levels = sm_periods$period_label))

# 整理文献表中的日期、文本和分期变量。
# factor 的顺序用于保证后续表格和图形按照时期一至四排列。
sm_works <- sm_works %>%
  select(-any_of("period_label")) %>%
  left_join(sm_period_lookup, by = "period") %>%
  mutate(
    publication_date = ymd(publication_date),
    text = str_squish(text),
    period_label = factor(period_label, levels = sm_periods$period_label)
  )

当前示范语料包含 9,638 篇文献，覆盖 2009 到 2024 年。语料按“时期 × 检索词”分层抓取，每个单元最多保留 300 篇文献。下表和图形用于检查语料在检索词和时期上的分布情况。

# ============================================================
# 检查不同时期与检索词的 OpenAlex 结果规模
# ============================================================

sm_search_counts %>%
  # 固定时期顺序，避免表格列按照字母或默认顺序排列
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label),
    count = comma(count)
  ) %>%
  # 只保留展示检索规模需要的字段
  select(search_term, period_label, count) %>%
  # 将长表转换为宽表：每一行是检索词，每一列是一个时期
  tidyr::pivot_wider(
    names_from = period_label,
    values_from = count
  ) %>%
  arrange(search_term) %>%
  kable(
    caption = "表：OpenAlex 中各检索词的分期检索规模",
    col.names = c(
      "检索词",
      "时期一：2009-2012",
      "时期二：2013-2016",
      "时期三：2017-2020",
      "时期四：2021-2024"
    ),
    align = "lrrrr",
    booktabs = TRUE
  ) %>%
  kable_styling(full_width = FALSE, position = "center", font_size = 12) %>%
  column_spec(1, width = "4.2cm")

表：OpenAlex 中各检索词的分期检索规模
检索词	时期一：2009-2012	时期二：2013-2016	时期三：2017-2020	时期四：2021-2024
facebook	38,031	43,215	45,254	41,456
facebook data	21,899	17,837	14,655	18,549
instagram	73	2,481	14,770	33,899
instagram data	10	604	4,757	12,988
reddit	9,455	8,818	6,997	8,803
reddit data	7,269	6,460	419	5,871
social media	45,235	81,120	116,823	186,165
social media data	5,373	17,538	37,297	74,503
tiktok	13	19	394	11,380
tiktok data	3	4	93	4,633
twitter	40,477	39,218	38,535	44,688
twitter data	23,977	19,068	15,743	24,117
youtube	4,138	7,241	21,550	32,559
youtube data	659	1,322	3,887	10,692

下图展示进入分析语料的文献在四个时期中的分布。由于语料按“时期 × 检索词”分层抓取，并在去重后进入分析，四个时期的样本量需要先做一次检查。

# ============================================================
# 查看 OpenAlex social media 语料的分期分布
# ============================================================

sm_works %>%
  # 统计每个时期进入分析的文献数量
  count(period_label, name = "n") %>%
  mutate(
    period_label = factor(period_label, levels = rev(sm_periods$period_label)),
    share = n / sum(n),
    label = str_c(comma(n), " 篇  |  ", percent(share, accuracy = 0.1))
  ) %>%
  ggplot(aes(x = n, y = period_label)) +
  geom_col(
    fill = "#2F6F73",
    width = 0.62
  ) +
  geom_text(
    aes(label = label),
    hjust = -0.08,
    size = 3.4,
    color = "#2B2B2B"
  ) +
  scale_x_continuous(
    labels = comma,
    expand = expansion(mult = c(0, 0.18))
  ) +
  labs(
    title = "OpenAlex Social Media 文献摘要语料的分期分布",
    subtitle = str_c(
      "2009-2024 年，按“时期 × 检索词”抓取；",
      "每个单元最多保留 ", sm_max_per_period_term, " 篇"
    ),
    x = "文献数量",
    y = NULL
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0, color = "#1F2933"),
    plot.subtitle = element_text(hjust = 0, color = "#5B6770", size = 10.5),
    axis.text.y = element_text(color = "#263238", size = 10.5),
    axis.text.x = element_text(color = "#5B6770"),
    axis.title.x = element_text(color = "#263238", margin = margin(t = 8)),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    plot.margin = margin(10, 28, 10, 10)
  )

# ============================================================
# 检查各时期样本中的主要检索入口
# ============================================================

sm_works %>%
  # 一篇文献可能由多个检索词命中，这里先拆成一行一个检索词
  tidyr::separate_rows(search_terms, sep = ";\\s*") %>%
  mutate(
    search_terms = str_squish(search_terms),
    period_label = factor(period_label, levels = sm_periods$period_label)
  ) %>%
  filter(!is.na(search_terms), search_terms != "") %>%
  # 统计每个时期中不同检索词进入样本的文献数量
  count(period_label, search_terms, name = "n") %>%
  group_by(period_label) %>%
  slice_max(n, n = 6, with_ties = FALSE) %>%
  ungroup() %>%
  arrange(period_label, desc(n)) %>%
  transmute(
    `时期` = period_label,
    `检索词` = search_terms,
    `文献数` = comma(n)
  ) %>%
  kable(
    caption = "表：各时期样本中出现较多的检索入口",
    align = "llr",
    booktabs = TRUE
  ) %>%
  kable_styling(full_width = FALSE, position = "center", font_size = 12) %>%
  column_spec(1, width = "4.0cm") %>%
  column_spec(2, width = "7.0cm") %>%
  column_spec(3, width = "2.0cm")

表：各时期样本中出现较多的检索入口
时期	检索词	文献数
时期一：2009-2012	social media data	300
时期一：2009-2012	youtube	300
时期一：2009-2012	facebook	299
时期一：2009-2012	social media	299
时期一：2009-2012	reddit	298
时期一：2009-2012	reddit data	298
时期二：2013-2016	facebook	300
时期二：2013-2016	reddit	300
时期二：2013-2016	reddit data	300
时期二：2013-2016	social media data	300
时期二：2013-2016	twitter	300
时期二：2013-2016	twitter data	300
时期三：2017-2020	reddit	300
时期三：2017-2020	reddit data	299
时期三：2017-2020	social media data	299
时期三：2017-2020	twitter	299
时期三：2017-2020	twitter data	299
时期三：2017-2020	social media	298
时期四：2021-2024	reddit	300
时期四：2021-2024	reddit data	300
时期四：2021-2024	social media	300
时期四：2021-2024	facebook data	299
时期四：2021-2024	social media data	299
时期四：2021-2024	twitter	298

这个表用于检查分层抓取后的语料构成。每一行表示某一时期中，一个检索词实际进入样本的文献数量。由于本专题设定每个“时期 × 检索词”最多保留 300 篇文献，因此表中 298、299、300 这类数值说明这些检索入口在 OpenAlex 中都有较充足的文献来源，并且基本达到了抽样上限。

从表中可以看到，social media、social media data、twitter、twitter data、facebook、reddit 等词在多个时期中都能稳定进入样本。这说明本专题的语料不是由单一平台或单一关键词构成，而是同时覆盖了总体性 social media 研究和以具体平台为对象的数据研究。

需要注意的是，表中的“文献数”不是该时期某一平台研究的真实总量，而是本专题抽样后进入分析的数据量。

文本处理

2.3 摘要还原、文本清洗与 DTM 构建

摘要还原

OpenAlex 的摘要字段采用 abstract_inverted_index 结构。它不是直接保存一整段摘要文本，而是保存“词语”和“位置”的对应关系。例如，某个词可能出现在摘要的第 3、18 和 42 个位置。要进行分词、词频统计和主题模型，需要先按照位置顺序把这些词重新排列，恢复为普通摘要文本。

本专题使用的缓存语料已经完成摘要还原，sm_works$abstract 中保存的是可直接分析的摘要文本。下面仍然保留还原函数，主要用于说明 OpenAlex 摘要字段如何从倒排结构转为普通文本。

数据结构说明：什么是倒排索引？

倒排索引（inverted index）常用于搜索引擎和文献数据库。普通文本按阅读顺序保存词语；倒排索引则反过来记录每个词出现在哪些位置。这样做有利于快速检索，但不适合直接进入文本分析。

在本专题中，摘要还原的目标很简单：把 OpenAlex 返回的 abstract_inverted_index 按词语位置重新排序，恢复成一段可以分词、清洗和建模的摘要文本。

# ============================================================
# 将 OpenAlex abstract_inverted_index 还原为普通摘要文本
# ============================================================

sm_invert_abstract <- function(idx) {
  # 如果摘要字段为空，返回 NA，避免后续处理报错
  if (is.null(idx) || length(idx) == 0) {
    return(NA_character_)
  }

  tibble(
    # names(idx) 是词语，idx 中的数值是该词出现的位置
    term = names(idx),
    positions = unname(idx)
  ) %>%
    # 一个词可能出现多次，需要展开为“一行一个词语位置”
    tidyr::unnest_longer(positions, values_to = "position") %>%
    # 按原始摘要中的位置排序
    arrange(position) %>%
    # 取出排序后的词语，并合并为普通文本
    pull(term) %>%
    paste(collapse = " ")
}

文本清洗与结构化

进入模型之前，需要把标题和摘要整理为两类数据结构。第一类是词元表（token table），适合用 tidytext 计算词频和 TF-IDF；第二类是文档-词项矩阵（Document-Term Matrix, DTM），适合交给 topicmodels 运行 LDA。

这两类结构来自同一批文献。差别在于：词元表便于检查词语在不同时期中的分布，DTM 则把每篇文献表示为一行、每个词项表示为一列，供主题模型使用。

从文本到模型输入

本节的处理流程可以概括为：

建立文档表：保留标题、摘要、年份、来源和检索词等元数据；
构建词元表：把标题与摘要拆成一行一个词；
计算 TF-IDF：比较不同时期中相对更突出的词；
构建 DTM：把词元信息转换为 LDA 可以使用的矩阵格式。

重要

数据清洗提醒：模型语料需要先筛选

开放文献数据库返回的是可复用的文献元数据，但 API 结果不一定都适合直接进入模型。部分记录可能存在来源缺失、仓储来源、标题过短、摘要混入网页导航文本、平台词只出现在边缘位置等问题。

因此，下面的代码在 TF-IDF 和 LDA 之前增加一层分析语料筛选：保留英文、来源可识别、标题和摘要基本完整，并且在标题与摘要中具有 social media 研究语境的文献。这个步骤不改变 OpenAlex 原始缓存，只决定哪些记录进入后续建模。

# ============================================================
# 构建用于文本分析的文档表，并筛选可进入模型的文献
# ============================================================

library(quanteda)
library(tidytext)

# 1. 设置网页残留文本的清洗规则
#    这些短语常见于出版网页的导航、分享和引文工具，不属于论文摘要。
sm_boilerplate_pattern <- str_c(
  c(
    "views icon", "article contents", "figures & tables",
    "supplementary data", "peer review", "share icon",
    "share twitter facebook reddit linkedin",
    "share twitter facebook reddit linkedin email",
    "share facebook twitter linkedin",
    "share facebook twitter linkedin email",
    "share twitter facebook linkedin",
    "cite view this citation", "add to citation manager",
    "reprints and permissions", "download citation",
    "reference manager", "easybib", "mendeley", "refworks",
    "bibtex", "toolbar search", "search dropdown", "citation search",
    "first online", "google scholar", "pubmed", "crossref",
    "web of science", "related articles", "permissions search site citation",
    "advertisement", "advertisements", "altmetric attention score",
    "altmetric.com", "social media presence for the given article"
  ),
  collapse = "|"
)

# 2. 设置 social media 研究语境判断规则
#    \\b 表示词边界，避免把某个词的一部分误识别为检索词。
sm_social_context_pattern <- str_c(
  c(
    "\\bsocial media\\b", "\\bsocial networking\\b", "\\bsocial networks?\\b",
    "\\bonline social networks?\\b", "\\bhashtag\\b",
    "\\buser[- ]generated content\\b", "\\bonline communit"
  ),
  collapse = "|"
)

# 单独的平台名称有时不足以说明文献属于 social media 研究。
# 因此平台词需要与用户、内容、互动、传播或具体应用语境共同出现。
sm_platform_pattern <- str_c(
  c(
    "\\btwitter\\b", "\\btweets?\\b", "\\bfacebook\\b",
    "\\binstagram\\b", "\\byoutube\\b", "\\breddit\\b", "\\btiktok\\b"
  ),
  collapse = "|"
)

sm_social_action_pattern <- str_c(
  c(
    "\\busers?\\b", "\\bposts?\\b", "\\bcomments?\\b", "\\bsharing\\b",
    "\\bengagement\\b", "\\bcommunication\\b", "\\bnetworks?\\b",
    "\\bcontent\\b", "\\binfluencers?\\b", "\\bfollowers?\\b",
    "\\blikes?\\b", "\\bsentiment\\b", "\\bmisinformation\\b",
    "\\bnews\\b", "\\bpublic\\b", "\\bpolitical\\b", "\\bhealth\\b",
    "\\beducation\\b", "\\blearning\\b", "\\bmarketing\\b", "\\bbrand\\b"
  ),
  collapse = "|"
)

# 3. 设置记录层面的排除规则
#    regex(..., ignore_case = TRUE) 表示忽略大小写进行匹配。
sm_excluded_source_pattern <- regex(
  "zenodo|figshare|osf|open science framework|ssrn|arxiv|biorxiv|medrxiv|research square|library|repository|thesis|dissertation|jurnal",
  ignore_case = TRUE
)

# 用 Unicode 脚本大致识别明显非英文脚本标题。
# 这一步只做轻量筛查，不替代正式的语言识别模型。
sm_non_english_script_pattern <- regex(
  "[\\p{Han}\\p{Cyrillic}\\p{Hangul}\\p{Hiragana}\\p{Katakana}]"
)

sm_doc_candidates <- sm_works %>%
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label),

    # 将标题与摘要合并为原始建模文本
    text_raw = str_squish(paste(title, abstract, sep = ". ")),

    # 转为小写，删除常见网页残留短语，并再次压缩多余空格
    text_model = text_raw %>%
      str_to_lower() %>%
      str_replace_all(sm_boilerplate_pattern, " ") %>%
      str_replace_all(
        "\\bshare\\s+(facebook|twitter|reddit|linkedin|email)(\\s+(facebook|twitter|reddit|linkedin|email))*\\b",
        " "
      ) %>%
      str_squish()
  ) %>%
  mutate(
    # coalesce(source, "") 把 NA 转为空字符串，使 str_detect() 稳定运行
    has_source = !is.na(source) & str_squish(source) != "",
    has_abstract = !is.na(abstract) & str_squish(abstract) != "",

    # boundary("word") 按词边界计数，用于排除过短或不完整标题
    title_word_n = str_count(coalesce(title, ""), boundary("word")),

    # 标记不适合作为学术论文来源的记录。
    # source_type 来自 OpenAlex；旧缓存没有该字段时，上文已补为 NA。
    is_repository_source =
      coalesce(source_type, "") == "repository" |
      str_detect(coalesce(source, ""), sm_excluded_source_pattern),

    # 标记明显不是英文脚本的标题
    has_non_english_script = str_detect(
      coalesce(title, ""),
      sm_non_english_script_pattern
    ),

    # 两种 social media 语境：直接表述，或“平台词 + 社会研究语境”
    has_general_social_context = str_detect(text_model, sm_social_context_pattern),
    has_platform_social_context =
      str_detect(text_model, sm_platform_pattern) &
      str_detect(text_model, sm_social_action_pattern),
    has_social_media_context =
      has_general_social_context | has_platform_social_context
  )

sm_docs <- sm_doc_candidates %>%
  # 进入模型前的分析语料筛选。
  # 这里不修改 OpenAlex 原始缓存，只决定哪些文献进入 TF-IDF 和 LDA。
  filter(
    # 只保留 OpenAlex 标记为英文的记录
    language == "en",

    # 来源和摘要必须存在，避免来源缺失或文本内容不足的记录进入模型
    has_source,
    has_abstract,

    # 标题至少大于 4 个词，排除标题过短、信息量不足的记录
    title_word_n > 4,

    # 排除明显不适合作为论文来源的记录
    !is_repository_source,

    # 排除标题中明显包含非英文脚本的记录
    !has_non_english_script,

    # 标题或摘要需要具有 social media 研究语境
    has_social_media_context
  ) %>%
  # 保留后续 TF-IDF、DTM、LDA 和结果解释需要的字段
  select(
    doc_id, openalex_id, title, publication_year, publication_date,
    period, period_label, start_year, end_year,
    cited_by_count, source, source_type, primary_topic,
    keywords, search_terms, text_model
  )

sm_docs %>%
  count(period_label, name = "n_documents")

# A tibble: 4 × 2
  period_label      n_documents
  <fct>                   <int>
1 时期一：2009-2012         727
2 时期二：2013-2016        1301
3 时期三：2017-2020        1886
4 时期四：2021-2024        2350

停用词与领域泛词

文本清洗不仅是删除标点和常见停用词，还需要处理与研究设计有关的高频泛词。由于本专题的检索词包含 social media 和 data，这些词几乎一定会反复出现。它们能说明语料来源，但对区分主题帮助有限，因此进入领域泛词表。

Twitter、Facebook、Instagram、YouTube、Reddit、TikTok 等平台名暂时保留。平台本身是 social media 研究的重要对象，也可能反映不同时期的数据来源变化。

# ============================================================
# 设置领域泛词
# ============================================================

sm_domain_stop <- c(
  # 检索口径带来的高频词
  "social", "media", "data", "online", "platform", "platforms",

  # 学术摘要中常见但区分度较低的词
  "research", "study", "studies", "paper", "article",
  "method", "methods", "approach", "approaches", "analysis",
  "result", "results", "using", "use", "based", "new",

  # 建模中容易反复出现但解释价值有限的泛词
  "model", "models", "also", "provide", "field", "fields",
  "show", "shows", "find", "findings", "important",

  # 出版网页和引文工具残留中常见的词
  "share", "icon", "views", "citation", "citations", "download",
  "manager", "toolbar", "dropdown", "permissions", "email",
  "linkedin", "google", "scholar", "pubmed", "crossref",
  "issn", "doi", "copyright", "editor", "professor", "vol", "mar"
)

处理原则
停用词表没有固定答案。是否删除某个词，取决于研究问题和解释目标。这里删除 social、media、data，是为了避免模型反复识别出检索式本身；保留平台名，是为了观察平台作为研究场景和数据来源时是否进入主题结构。

词元表与 TF-IDF

下面把文档表转换为一行一个词的词元表。这个结构适合做词频统计、TF-IDF 比较和后续可视化。

# ============================================================
# 构建 one-token-per-row 词元表
# ============================================================

sm_tokens <- sm_docs %>%
  select(doc_id, period, period_label, publication_year, text_model) %>%

  # 将文本拆成一行一个词
  tidytext::unnest_tokens(word, text_model) %>%

  # 只保留英文单词，删除数字、符号和单字母噪声
  filter(str_detect(word, "^[a-z][a-z]+$")) %>%

  # 删除 tidytext 提供的英文停用词
  anti_join(tidytext::stop_words, by = "word") %>%

  # 删除本专题设定的领域泛词
  filter(!word %in% sm_domain_stop)

sm_tokens %>%
  count(period_label, name = "n_tokens")

# A tibble: 4 × 2
  period_label      n_tokens
  <fct>                <int>
1 时期一：2009-2012    91045
2 时期二：2013-2016   156361
3 时期三：2017-2020   241622
4 时期四：2021-2024   305766

概念说明：什么是 TF-IDF？

TF-IDF（Term Frequency-Inverse Document Frequency）用于衡量一个词在某类文本中是否具有区分度。它由两部分组成：

\[ \mathrm{TF\text{-}IDF}(t, d) = \mathrm{TF}(t, d) \times \mathrm{IDF}(t) \]

其中，$t$ 表示词项，$d$ 表示文档或文档组。

\[ \mathrm{TF}(t, d) = \frac{n_{t,d}}{\sum_k n_{k,d}} \]

$\mathrm{TF}(t, d)$ 表示词项 $t$ 在文档 $d$ 中的相对出现频率。$n_{t,d}$ 是词项 $t$ 在文档 $d$ 中出现的次数，$\sum_k n_{k,d}$ 是文档 $d$ 中所有词项的总次数。

\[ \mathrm{IDF}(t) = \log \left(\frac{N}{df_t}\right) \]

$\mathrm{IDF}(t)$ 表示词项 $t$ 的逆文档频率。$N$ 是文档总数，$df_t$ 是包含词项 $t$ 的文档数量。一个词如果在很多文档中都出现，IDF 会较低；如果主要集中在少数文档中，IDF 会较高。

在本专题中，TF-IDF 的“文档”不是单篇论文，而是四个时期。计算结果回答的问题是：某个词是否相对更能代表某一时期的 social media 研究摘要。一个词在某一时期出现较多，同时在其他时期较少出现，它的 TF-IDF 通常会更高。

重要

TF-IDF 对低频但高度集中的词很敏感。少量噪声文献中的专业缩写，如果只出现在某一个时期，也可能得到较高分数。因此，下面在计算 TF-IDF 前加入文档频次过滤：一个词至少要出现在同一时期的 20 篇文献中，才进入展示结果。

# ============================================================
# 按时期计算 TF-IDF，并过滤低文档频次词
# ============================================================

# 统计每个词在每个时期中出现于多少篇文献
sm_period_docfreq <- sm_tokens %>%
  distinct(period, period_label, doc_id, word) %>%
  count(period, period_label, word, name = "period_doc_n")

sm_period_tfidf <- sm_tokens %>%
  # 先统计每个时期中每个词出现的次数
  count(period, period_label, word, name = "n") %>%

  # 合并文档频次，用于过滤只来自极少数文献的词
  left_join(
    sm_period_docfreq,
    by = c("period", "period_label", "word")
  ) %>%

  # 至少出现在同一时期的 20 篇文献中，降低少量噪声文献的影响
  filter(period_doc_n >= 20) %>%

  # 删除多数两字母缩写，但保留 ai、ml 这类有解释意义的词
  filter(str_length(word) >= 3 | word %in% c("ai", "ml")) %>%

  # 以时期为比较单位计算 TF-IDF
  bind_tf_idf(term = word, document = period_label, n = n) %>%

  arrange(period_label, desc(tf_idf))

TF-IDF 更适合在 LDA 之前帮助研究者熟悉语料，观察每个时期中哪些词相对更突出。

# ============================================================
# 按时期展示 TF-IDF 较高的词
# ============================================================

sm_period_tfidf %>%
  group_by(period_label) %>%
  # 每个时期取 TF-IDF 最高的 8 个词
  slice_max(tf_idf, n = 8, with_ties = FALSE) %>%
  ungroup() %>%
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label),

    # 在分面图中分别重排词语顺序
    word = tidytext::reorder_within(word, tf_idf, period_label)
  ) %>%
  ggplot(aes(x = tf_idf, y = word)) +
  geom_col(fill = "#2F6F73", width = 0.72) +
  facet_wrap(~ period_label, scales = "free_y", ncol = 2) +
  tidytext::scale_y_reordered() +
  scale_x_continuous(
    labels = label_number(accuracy = 0.001),
    expand = expansion(mult = c(0, 0.12))
  ) +
  theme_minimal(base_size = 11) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0, color = "#1F2933"),
    plot.subtitle = element_text(hjust = 0, color = "#5B6770"),
    axis.text.y = element_text(color = "#263238"),
    axis.text.x = element_text(color = "#5B6770"),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    strip.text = element_text(face = "bold", color = "#1F2933")
  ) +
  labs(
    title = "不同时期中 TF-IDF 较高的词",
    subtitle = "每个时期展示相对更具区分度的 8 个词",
    x = "TF-IDF",
    y = NULL
  )

DTM 构建

LDA 主题模型不能直接读取普通文本。它需要一个文档-词项矩阵：每一行是一篇文献，每一列是一个词项，单元格记录这个词在该文献中出现的次数。

本专题对四个时期分别构建 DTM。这样做是为了让每个时期单独运行 LDA，再比较不同时期主题之间的词语重叠关系。

概念说明：什么是 DTM？

文档-词项矩阵（Document-Term Matrix, DTM）是许多传统文本模型的输入格式。行表示文档，列表示词项，数值表示词频。由于大多数文档只包含词表中的一小部分词，DTM 通常非常稀疏。

在 LDA 中，DTM 用来告诉模型：每篇文献中出现了哪些词，以及这些词出现了多少次。

# ============================================================
# 分时期构建 DFM/DTM
# ============================================================

sm_build_period_input <- function(period_value) {
  # 取出某一个时期的文献
  docs_period <- sm_docs %>%
    filter(period == period_value)

  # 使用 quanteda 构建 DFM
  dfm_period <- docs_period %>%
    corpus(text_field = "text_model", docid_field = "doc_id") %>%
    tokens(
      remove_punct = TRUE,
      remove_numbers = TRUE,
      remove_symbols = TRUE
    ) %>%
    tokens_tolower() %>%

    # 只保留英文单词
    tokens_select(
      pattern = "^[a-z][a-z]+$",
      valuetype = "regex",
      selection = "keep"
    ) %>%

    # 删除通用停用词和领域泛词
    tokens_remove(c(stopwords("en"), sm_domain_stop)) %>%
    dfm() %>%

    # 删除过低频词，减少噪声和计算负担
    dfm_trim(
      min_termfreq = 8,
      min_docfreq = 5,
      docfreq_type = "count"
    ) %>%

    # 删除在过多文档中出现的词，避免泛词主导模型
    dfm_trim(
      max_docfreq = 0.45,
      docfreq_type = "prop"
    )

  # 删除清洗后没有有效词项的文档
  dfm_period <- dfm_period[ntoken(dfm_period) > 0, ]

  # 保留实际进入 DTM 的文献元数据
  docs_model <- docs_period %>%
    semi_join(
      tibble(doc_id = docnames(dfm_period)),
      by = "doc_id"
    )

  list(
    dfm = dfm_period,
    dtm = quanteda::convert(dfm_period, to = "topicmodels"),
    docs = docs_model
  )
}

# 对四个时期分别构建模型输入
sm_period_inputs <- sm_periods$period %>%
  set_names() %>%
  purrr::map(sm_build_period_input)

下面的表用于检查每个时期进入 LDA 前的 DTM 规模。文档数说明有多少篇文献实际进入模型，词项数说明保留了多少个可建模词，稀疏度则反映矩阵中零值所占比例。

# ============================================================
# 分期 DTM 基本信息检查
# ============================================================

sm_dtm_summary <- purrr::imap_dfr(
  sm_period_inputs,
  function(period_input, period_value) {
    tibble(
      period = period_value,
      model_docs = ndoc(period_input$dfm),
      terms = nfeat(period_input$dfm),
      nonzero = sum(period_input$dfm > 0),
      sparsity = sparsity(period_input$dfm)
    )
  }
) %>%
  left_join(sm_periods %>% select(period, period_label), by = "period") %>%
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label)
  ) %>%
  arrange(period_label)

sm_dtm_summary %>%
  transmute(
    `时期` = period_label,
    `进入模型的文档数` = comma(model_docs),
    `保留词项数` = comma(terms),
    `DTM 非零单元格数` = comma(nonzero),
    `DTM 稀疏度` = percent(sparsity, accuracy = 0.1)
  ) %>%
  kable(
    caption = "表：Social media 文献摘要分期 DTM 的基本规模",
    align = "lrrrr",
    booktabs = TRUE
  ) %>%
  kable_styling(full_width = FALSE, position = "center", font_size = 12)

表：Social media 文献摘要分期 DTM 的基本规模
时期	进入模型的文档数	保留词项数	DTM 非零单元格数	DTM 稀疏度
时期一：2009-2012	727	2,365	50,056	97.1%
时期二：2013-2016	1,301	3,419	97,064	97.8%
时期三：2017-2020	1,886	4,357	152,855	98.1%
时期四：2021-2024	2,350	4,803	195,346	98.3%

解释提示
DTM 的稀疏度较高是文本数据的常见现象。每篇文献只会使用词表中的一小部分词，因此矩阵中多数单元格为 0。稀疏度本身不是错误，但过多低频词会增加计算负担，也会让主题模型更容易受到噪声影响。

LDA 模型

2.4 LDA 主题模型与主题解释

主题模型

主题模型（topic model）是一类用于发现文本集合中潜在议题结构的统计模型。它不要求研究者事先给每篇文献贴标签，而是根据词语在文档中的共同出现模式，推断语料中可能存在的主题。

本专题使用 LDA（Latent Dirichlet Allocation，潜在狄利克雷分配）。LDA 将每篇文档理解为若干主题的混合，将每个主题理解为一组高概率词的组合。例如，一篇关于疫情期间社交媒体错误信息的论文，可能同时包含“公共健康”“错误信息”“平台传播”等主题成分；其中每个主题又由若干更常出现的词共同构成。

方法说明：LDA 如何从 DTM 中识别主题？

LDA 的输入是文档-词项矩阵（Document-Term Matrix, DTM）。在 DTM 中，每一行是一篇文档，每一列是一个词项，单元格记录该词在该文档中出现的次数。LDA 利用这个矩阵观察词语的共现模式：哪些词经常出现在同一批文档中，哪些文档又共享相似的词语组合。

LDA 的基本思想可以概括为两层概率关系：

每篇文档都有一个主题分布（document-topic distribution），表示这篇文档由哪些主题组成，以及各主题所占比例；
每个主题都有一个词项分布（topic-word distribution），表示哪些词更可能出现在这个主题中。

因此，LDA 输出的是两类概率结果：一类是“某个主题中哪些词概率更高”，另一类是“某篇文档更接近哪些主题”。主题名称、社会科学含义和解释边界需要研究者结合高概率词、代表性文献和研究语境来判断。

Figure 4. LDA 示意图 1

Figure 5. LDA 示意图 2

实施计划

本专题对四个时期分别运行LDA

注：在不同时间段分别实施LDA可以观察每个时期内部的主题结构

本案例把每个时期的主题数设为 k = 6。这意味着四个时期一共得到 24 个时期主题。需要注意的是，2009-2012 的 Topic 1 与 2013-2016 的 Topic 1 并不表示同一主题；跨时期比较需要通过高概率词重叠、代表性文献回读和可视化对齐完成。

注：设置主题的数量是主观性比较强的工作，但也会考虑一些统计上的数据（参考第七章聚类算法中的参数设定）；同时，设置主题数也需要多次尝试找到合适的解

# ============================================================
# 分期运行 LDA 主题模型
# ============================================================

library(topicmodels)
library(tidytext)

# 固定随机种子，保证每次 knit 得到相同的主题模型结果
set.seed(2026)

sm_run_period_lda <- function(period_input, period_value) {
  # 1. 取出当前时期的中文标签，用于后续表格和图形展示
  period_label_value <- sm_periods %>%
    filter(period == period_value) %>%
    pull(period_label)

  # 2. 对当前时期的 DTM 单独运行 LDA
  # k = sm_k 表示每个时期提取的主题数量
  lda_model <- LDA(
    period_input$dtm,
    k = sm_k,
    control = list(seed = 2026)
  )

  # 3. beta 表示“主题-词项”概率
  # beta 越高，说明该词越能代表这个主题
  beta <- tidy(lda_model, matrix = "beta") %>%
    mutate(
      period = period_value,
      period_label = period_label_value,
      topic_label = paste0(period_value, " T", topic),

      # period_topic 是跨时期可视化时使用的唯一主题编号
      period_topic = paste(period_value, topic, sep = "_T")
    )

  # 4. gamma 表示“文档-主题”概率
  # gamma 越高，说明该文档越接近这个主题
  gamma <- tidy(lda_model, matrix = "gamma") %>%
    mutate(
      period = period_value,
      period_label = period_label_value,
      topic_label = paste0(period_value, " T", topic),
      period_topic = paste(period_value, topic, sep = "_T")
    )

  # 5. 同时返回模型对象和两个整理后的概率表
  list(model = lda_model, beta = beta, gamma = gamma)
}

# 对四个时期分别运行 LDA
sm_lda_results <- purrr::imap(sm_period_inputs, sm_run_period_lda)

# 合并四个时期的 beta 和 gamma，便于统一制表和绘图
sm_beta <- purrr::map_dfr(sm_lda_results, "beta")
sm_gamma <- purrr::map_dfr(sm_lda_results, "gamma")

主题关键词

beta 表示词项在某个主题中的概率。一个词在某个主题中的 beta 越高，说明它越能代表这个主题。观察每个主题中 beta 最高的一组词，是给主题命名和解释主题含义的第一步。

解释提示
LDA 不会自动给主题命名。图中的 Topic 1、Topic 2 只是模型编号。研究者需要根据高概率词、代表性文献标题和摘要回读，为主题赋予实质解释。

# ============================================================
# 提取并展示各时期 LDA 主题的高概率词
# ============================================================

sm_top_terms <- sm_beta %>%
  # 按时期和主题分组，保证每个主题单独提取关键词
  group_by(period, period_label, topic, topic_label, period_topic) %>%

  # 每个主题保留 beta 最高的 6 个词
  # beta 越高，表示该词越能代表这个主题
  slice_max(beta, n = 6, with_ties = FALSE) %>%
  ungroup() %>%
  mutate(
    # 固定时期顺序，避免 facet 按字母顺序排列
    period_label = factor(period_label, levels = sm_periods$period_label),

    # 固定 topic_label 顺序，使图形与表格中的主题顺序一致
    topic_label = factor(topic_label, levels = unique(topic_label)),

    # 只为绘图创建排序字段，保留原始 term 供后续表格使用
    term_plot = tidytext::reorder_within(term, beta, topic_label)
  ) %>%
  arrange(period_label, topic, desc(beta))

sm_topic_period_colors <- c(
  "时期一：2009-2012" = "#2F6F73",
  "时期二：2013-2016" = "#8A6F2A",
  "时期三：2017-2020" = "#8F4E5D",
  "时期四：2021-2024" = "#4F6F9F"
)

sm_top_terms %>%
  ggplot(aes(x = beta, y = term_plot, fill = period_label)) +

  # 用横向柱状图展示每个词在对应主题中的 beta 值
  geom_col(
    width = 0.72,
    show.legend = TRUE
  ) +

  # 每个时期主题单独成一个小图
  facet_wrap(~ topic_label, scales = "free_y", ncol = 4) +

  # 还原 reorder_within() 生成的分面内排序标签
  tidytext::scale_y_reordered() +

  # 不同时期使用不同颜色
  scale_fill_manual(
    values = sm_topic_period_colors,
    name = "时期"
  ) +

  # beta 通常是较小的小数，保留三位小数即可
  scale_x_continuous(
    labels = label_number(accuracy = 0.001),
    expand = expansion(mult = c(0, 0.12))
  ) +

  theme_minimal(base_size = 10.5) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0, color = "#1F2933"),
    plot.subtitle = element_text(hjust = 0, color = "#5B6770"),
    axis.text.y = element_text(color = "#263238", size = 8.5),
    axis.text.x = element_text(color = "#5B6770", size = 8),
    axis.title.x = element_text(color = "#263238", margin = margin(t = 8)),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    strip.text = element_text(face = "bold", color = "#1F2933"),
    legend.position = "bottom",
    legend.title = element_text(face = "bold", color = "#263238"),
    legend.text = element_text(color = "#263238"),
    panel.spacing.x = unit(1.0, "lines"),
    panel.spacing.y = unit(0.8, "lines")
  ) +
  labs(
    title = "各时期 LDA 主题的高概率词",
    subtitle = "每个时期单独运行 LDA；每个主题展示 beta 最高的 6 个词",
    x = "beta",
    y = NULL
  )

# ============================================================
# 用高概率词辅助初步主题命名
# ============================================================

sm_topic_summary <- sm_top_terms %>%
  # 每个“时期 × 主题”整理为一行
  group_by(period_label, topic, topic_label, period_topic) %>%
  arrange(desc(beta), .by_group = TRUE) %>%

  # 取每个主题中 beta 较高的前 6 个词，作为人工命名主题的依据
  summarise(
    representative_terms = paste(head(term, 6), collapse = ", "),
    .groups = "drop"
  ) %>%
  # 按时期和主题编号排序，方便与前面的主题词图对应
  arrange(period_label, topic)

sm_topic_summary %>%
  transmute(
    `时期` = period_label,
    `时期主题` = topic_label,
    `高概率词` = representative_terms
  ) %>%
  kable(
    caption = "表：各时期 LDA 主题的高概率词组合",
    align = "lll",
    booktabs = TRUE
  ) %>%
  kable_styling(full_width = FALSE, position = "center", font_size = 12) %>%
  column_spec(1, width = "4.2cm") %>%
  column_spec(2, width = "3.0cm") %>%
  column_spec(3, width = "9.0cm")

表：各时期 LDA 主题的高概率词组合
时期	时期主题	高概率词
时期一：2009-2012	2009-2012 T1	twitter, information, can, news, content, digital
时期一：2009-2012	2009-2012 T2	youtube, videos, facebook, video, information, content
时期一：2009-2012	2009-2012 T3	systems, web, information, learning, user, technologies
时期一：2009-2012	2009-2012 T4	students, health, facebook, learning, education, mental
时期一：2009-2012	2009-2012 T5	users, web, marketing, networks, political, network
时期一：2009-2012	2009-2012 T6	see, accessed, university, available, internet, search
时期二：2013-2016	2013-2016 T1	twitter, health, information, facebook, political, public
时期二：2013-2016	2013-2016 T2	students, learning, internet, university, education, technology
时期二：2013-2016	2013-2016 T3	facebook, brand, instagram, marketing, users, engagement
时期二：2013-2016	2013-2016 T4	twitter, information, can, sentiment, network, users
时期二：2013-2016	2013-2016 T5	digital, news, instagram, practices, communication, cultural
时期二：2013-2016	2013-2016 T6	videos, youtube, content, video, users, information
时期三：2017-2020	2017-2020 T1	health, pandemic, mental, public, care, among
时期三：2017-2020	2017-2020 T2	learning, sentiment, twitter, language, can, tweets
时期三：2017-2020	2017-2020 T3	news, information, posts, twitter, content, reddit
时期三：2017-2020	2017-2020 T4	digital, political, twitter, facebook, content, users
时期三：2017-2020	2017-2020 T5	videos, youtube, video, students, learning, can
时期三：2017-2020	2017-2020 T6	instagram, brand, marketing, facebook, engagement, consumers
时期四：2021-2024	2021-2024 T1	videos, tiktok, content, video, quality, information
时期四：2021-2024	2021-2024 T2	health, students, vaccine, learning, among, mental
时期四：2021-2024	2021-2024 T3	public, pandemic, digital, can, reddit, people
时期四：2021-2024	2021-2024 T4	content, users, news, twitter, political, misinformation
时期四：2021-2024	2021-2024 T5	marketing, instagram, brand, influencers, engagement, tiktok
时期四：2021-2024	2021-2024 T6	learning, sentiment, machine, ai, detection, twitter

主题命名（参考）

主题命名基于每个 LDA topic 的高概率词完成。命名时优先依据平台、研究对象、方法词和应用场景；can、information、content 等泛词只作为辅助线索。含义接近的 topic 尽量使用相同或相近名称，便于后续观察主题的延续与变化。

时期	时期主题	高概率词线索	建议名称
时期一：2009-2012	2009-2012 T1	twitter, news, content, digital	新闻信息
时期一：2009-2012	2009-2012 T2	youtube, videos, facebook, video	视频内容
时期一：2009-2012	2009-2012 T3	systems, web, learning, technologies	平台技术
时期一：2009-2012	2009-2012 T4	students, health, facebook, learning, education, mental	健康教育
时期一：2009-2012	2009-2012 T5	users, web, marketing, networks, political	用户网络
时期一：2009-2012	2009-2012 T6	accessed, university, available, internet, search	信息检索
时期二：2013-2016	2013-2016 T1	twitter, health, facebook, political, public	公共议题
时期二：2013-2016	2013-2016 T2	students, learning, internet, university, education, technology	数字教育
时期二：2013-2016	2013-2016 T3	facebook, brand, instagram, marketing, engagement	品牌营销
时期二：2013-2016	2013-2016 T4	twitter, sentiment, network, users	情感分析
时期二：2013-2016	2013-2016 T5	digital, news, instagram, practices, communication, cultural	数字文化
时期二：2013-2016	2013-2016 T6	videos, youtube, video, users	视频内容
时期三：2017-2020	2017-2020 T1	health, pandemic, mental, public, care	公共健康
时期三：2017-2020	2017-2020 T2	learning, sentiment, twitter, language, tweets	情感分析
时期三：2017-2020	2017-2020 T3	news, posts, twitter, content, reddit	新闻内容
时期三：2017-2020	2017-2020 T4	digital, political, twitter, facebook, users	政治传播
时期三：2017-2020	2017-2020 T5	videos, youtube, video, students, learning	视频学习
时期三：2017-2020	2017-2020 T6	instagram, brand, marketing, facebook, engagement, consumers	品牌营销
时期四：2021-2024	2021-2024 T1	videos, tiktok, video, quality	短视频内容
时期四：2021-2024	2021-2024 T2	health, students, vaccine, learning, mental	健康教育
时期四：2021-2024	2021-2024 T3	public, pandemic, digital, reddit, people	公共健康
时期四：2021-2024	2021-2024 T4	news, twitter, political, misinformation	政治信息
时期四：2021-2024	2021-2024 T5	marketing, instagram, brand, influencers, engagement, tiktok	品牌营销
时期四：2021-2024	2021-2024 T6	learning, sentiment, machine, ai, detection, twitter	情感检测

解释提示
这些名称是基于高概率词的初步解释，不是 LDA 自动生成的标签。命名应保持克制：能明确判断的主题直接命名，语义较弱的主题先使用较宽的名称。后续需要结合代表性论文标题和摘要回读，判断主题是否稳定、是否需要合并，以及是否受到检索噪声影响。

文档主题分布

gamma 表示某篇文档属于某个主题的概率。将每篇文档的最高概率主题与年份、标题和 OpenAlex 标签连接起来，可以观察主题在时间上的变化，也可以回到代表性文献中检查模型解释是否合理。

# ============================================================
# 提取每篇文档的主导主题，并连接文献元数据
# ============================================================

sm_doc_topic <- sm_gamma %>%
  # 每篇文档在每个时期模型中都有 6 个 gamma 值
  # 这里保留 gamma 最大的主题，作为该文档的主导主题
  group_by(period, document) %>%
  slice_max(gamma, n = 1, with_ties = FALSE) %>%
  ungroup() %>%

  # 连接文献元数据，便于后续查看标题、年份、来源和检索入口
  left_join(
    sm_works %>%
      select(
        doc_id, title, publication_year, publication_date,
        cited_by_count, source, primary_topic, keywords, search_terms
      ),
    by = c("document" = "doc_id")
  ) %>%

  # 固定时期顺序，保证表格和图形按时期一至四排列
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label)
  )

sm_representative_docs <- sm_doc_topic %>%
  # 在每个“时期 × 主题”中，选出 gamma 最高的文献
  # 这些文献可作为主题解释时的代表性文本
  group_by(period_label, topic, topic_label) %>%
  slice_max(gamma, n = 1, with_ties = FALSE) %>%
  ungroup() %>%

  # 整理展示字段，并截断过长文本，避免表格过宽
  transmute(
    period_label,
    topic_label,
    gamma = round(gamma, 3),
    year = publication_year,
    title = str_trunc(title, 88),
    source = str_trunc(source, 42),
    search_terms = str_trunc(search_terms, 55)
  )

sm_representative_docs %>%
  kable(
    caption = "表：每个时期主题中 gamma 较高的代表性文献",
    col.names = c("时期", "时期主题", "gamma", "年份", "标题", "来源", "检索入口"),
    align = "llcrlll",
    booktabs = TRUE
  ) %>%
  kable_styling(full_width = FALSE, position = "center", font_size = 11) %>%
  column_spec(1, width = "4.0cm") %>%
  column_spec(2, width = "2.4cm") %>%
  column_spec(3, width = "1.5cm") %>%
  column_spec(4, width = "1.4cm") %>%
  column_spec(5, width = "8.0cm") %>%
  column_spec(6, width = "4.0cm") %>%
  column_spec(7, width = "4.8cm")

表：每个时期主题中 gamma 较高的代表性文献
时期	时期主题	gamma	年份	标题	来源	检索入口
时期一：2009-2012	2009-2012 T1	0.999	2011	Proceedings of the International Conference on New Interfaces for Musical Expression	Duo Research Archive (University of Oslo)	twitter; twitter data
时期一：2009-2012	2009-2012 T2	0.998	2012	Features Predicting Weight Loss in Overweight or Obese Participants in a Web-Based In…	Journal of Medical Internet Research	social media data
时期一：2009-2012	2009-2012 T3	1.000	2009	The user – the great unknown of systems development: reasons, forms, challenges, expe…	Information Systems Journal	youtube; youtube data
时期一：2009-2012	2009-2012 T4	1.000	2012	Actions to alleviate the mental health impact of the economic crisis	World Psychiatry	social media data
时期一：2009-2012	2009-2012 T5	0.999	2010	Impacts of Luxury Fashion Brand’s Social Media Marketing on Customer Relationship and…	Journal of Global Fashion Marketing	facebook; facebook data; social media; social media …
时期一：2009-2012	2009-2012 T6	1.000	2012	The North American Third-Party Logistics Industry in 2011: The Provider CEO Perspective	Transportation Journal	youtube data
时期二：2013-2016	2013-2016 T1	0.997	2015	Social media campaigns that make a difference: what can public health learn from the …	Public Health Research & Practice	social media data
时期二：2013-2016	2013-2016 T2	1.000	2016	Paging Dr. Google: The Changing Face of Plastic Surgery	Plastic & Reconstructive Surgery	instagram data
时期二：2013-2016	2013-2016 T3	0.998	2013	The impact of user interactions in social media on brand awareness and purchase inten…	Journal of Product & Brand Management	facebook; social media
时期二：2013-2016	2013-2016 T4	0.999	2015	Image Retrieval: Modelling Keywords via Low-level Features	ELCVIA Electronic Letters on Computer V…	instagram data
时期二：2013-2016	2013-2016 T5	0.997	2016	Researching microcelebrity: Methods, access and labour	First Monday	instagram; instagram data; youtube data
时期二：2013-2016	2013-2016 T6	0.997	2013	Misleading Health-Related Information Promoted Through Video-Based Social Media: Anor…	Journal of Medical Internet Research	youtube
时期三：2017-2020	2017-2020 T1	1.000	2020	Mental Health Response to the COVID-19 Outbreak in China	American Journal of Psychiatry	social media data; twitter; twitter data
时期三：2017-2020	2017-2020 T2	0.998	2017	Discriminant Analysis on Riemannian Manifold of Gaussian Distributions for Face Recog…	IEEE Transactions on Image Processing	youtube data
时期三：2017-2020	2017-2020 T3	0.997	2018	Social Drinking on Social Media: Content Analysis of the Social Aspects of Alcohol-Re…	Journal of Medical Internet Research	instagram
时期三：2017-2020	2017-2020 T4	0.997	2018	The tactics & tropes of the Internet Research Agency	Lincoln (University of Nebraska)	facebook data; twitter data
时期三：2017-2020	2017-2020 T5	0.999	2018	Irresistible: The Rise of Addictive Technology and the Business of Keeping Us Hooked	Journal of Information Policy	facebook; facebook data
时期三：2017-2020	2017-2020 T6	0.998	2017	Generation Y’s positive and negative eWOM: use of social media and mobile technology	International Journal of Contemporary H…	social media data
时期四：2021-2024	2021-2024 T1	1.000	2022	Health Supervision for Children and Adolescents With Down Syndrome	PEDIATRICS	social media
时期四：2021-2024	2021-2024 T2	0.998	2021	A Cyberbullying Media-Based Prevention Intervention for Adolescents on Instagram: Pil…	JMIR Mental Health	facebook data; instagram; instagram data; youtube; y…
时期四：2021-2024	2021-2024 T3	0.997	2021	Public parks and the pandemic: How park usage has been affected by COVID-19 policies	PLoS ONE	social media data
时期四：2021-2024	2021-2024 T4	1.000	2021	How does fake news spread? Understanding pathways of disinformation spread through APIs	Policy & Internet	reddit; reddit data
时期四：2021-2024	2021-2024 T5	0.999	2021	Consumer engagement within retail communication channels: an examination of online br…	European Journal of Marketing	facebook; facebook data; social media data
时期四：2021-2024	2021-2024 T6	0.998	2024	Shots segmentation-based optimized dual-stream framework for robust human activity re…	Alexandria Engineering Journal	youtube data

# ============================================================
# 统计每个时期内部的主导主题占比
# ============================================================

sm_topic_period <- sm_doc_topic %>%
  # 固定时期顺序，保证分面按时期一至四排列
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label)
  ) %>%

  # 统计每个时期中，被归入各主导主题的文献数量
  count(period, period_label, topic, topic_label, period_topic, name = "n") %>%

  # 在每个时期内部计算主题占比
  # 这里的分母是该时期进入模型的文献总数
  group_by(period, period_label) %>%
  mutate(prop = n / sum(n)) %>%
  ungroup() %>%

  # 将 topic 转为因子，便于柱状图按 Topic 编号展示
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label),
    topic = factor(topic)
  )

sm_topic_period %>%
  ggplot(aes(x = topic, y = prop, fill = topic)) +

  # 每根柱表示某一时期内一个主导主题覆盖的文献比例
  geom_col(
    width = 0.72,
    color = "white",
    linewidth = 0.25
  ) +

  # 每个时期单独成图，避免把不同时期的 Topic 编号误读为同一主题
  facet_wrap(~ period_label, ncol = 2) +

  # y 轴显示为百分比
  scale_y_continuous(labels = percent_format(accuracy = 1)) +

  # 颜色只用于区分同一时期内的 Topic 编号
  scale_fill_brewer(palette = "Dark2", name = "Topic") +

  theme_minimal(base_size = 11) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    plot.subtitle = element_text(color = "grey40", hjust = 0.5),
    legend.position = "none",
    panel.grid.minor = element_blank()
  ) +
  labs(
    title = "各时期内部的主导主题占比",
    subtitle = "每个时期的 Topic 编号只在该时期内部解释，不跨时期直接对应",
    x = "时期内部 Topic 编号",
    y = "文献占比"
  )

重要解释提醒
主题名称需要研究者完成。高概率词提供的是线索，代表性文献提供的是语境，时期内部占比提供的是主题规模。不同期 LDA 的 Topic 编号不能直接比较，下一节会用主题词重叠来近似连接相邻时期的主题。

主题网络

2.5 主题对齐与主题网络可视化

为什么需要主题对齐

分期 LDA 把每个时期作为独立语料建模。这样可以保留各时期内部的主题结构，但 Topic 编号只在本期内部有效。2009-2012 T1 和 2013-2016 T1 只是两个模型各自的第一个主题，不能直接视为同一主题。

为了比较主题变化，需要先把每个 topic 转换成可比较对象。本节采用一个入门做法：提取每个时期主题的高概率词，计算相邻时期主题之间的 Jaccard 相似度，并用 Sankey/alluvial 图 （第四章有提及）展示主题之间的近似连接。相似度越高，说明两个主题的高概率词越接近；如果用距离指标表达，距离越小，主题越接近。

如何理解主题对齐？

主题对齐解决的是一个比较问题：不同时间窗口中的 LDA topic 如何放到同一张图里观察。

本节把每个 topic 看作一组高概率词 (取前 20 个词)。如果两个相邻时期的 topic 共享较多关键词，就把它们连接起来；如果共享词很少，它们之间的连接就弱，或者不连接。Sankey/alluvial 图中的 flow 表示这种相似关系，flow 越宽，说明两个主题的词汇结构越接近。

这种做法可以帮助我们观察三类现象：

某些主题在多个时期中持续出现，例如视频内容、品牌营销或公共健康；
某些主题在后期出现新的表达，例如短视频、AI、误信息或疫苗；
某些主题虽然名称相近，但高概率词发生变化，需要回到代表性论文进一步判断。

这里的连接表示词汇相似，不表示论文数量流动，也不表示严格的因果演化。主题名称、变化解释和社会科学含义仍然需要结合代表性论文标题、摘要和研究背景来判断。

主题命名与可视化参数

下面先把前面人工命名的 topic 整理成一张查找表。后续表格、Sankey 和网络图都使用这张表，避免同一个 topic 在不同图中出现不同标签。

# ============================================================
# 主题命名与可视化参数设置
# ============================================================

library(ggalluvial)
library(igraph)
library(ggrepel)
library(scales)

# 主题相似度与网络图都使用 beta 最高的 20 个词
sm_topic_top_n <- 20

# 网络图中每个 topic 只标注前 6 个词，避免标签过密
sm_topic_label_n <- 6

# 相邻时期 topic 连接的筛选阈值
sm_alignment_keep_n <- 2
sm_alignment_min_overlap <- 2
sm_alignment_min_jaccard <- 0.05

# 参考图表资料中的手动配色思路，直接写入稳定色值，避免新增依赖
sm_period_palette <- c(
  "时期一：2009-2012" = "#3C5488",
  "时期二：2013-2016" = "#00A087",
  "时期三：2017-2020" = "#E64B35",
  "时期四：2021-2024" = "#F39B2F"
)

sm_node_palette <- c(
  "时期主题" = "#003153",
  "高概率词" = "#B35C44"
)

# 手工主题命名表：topic_label 必须与 LDA 结果中的 topic_label 对应
sm_topic_name_lookup <- tibble::tribble(
  ~topic_label, ~topic_name,
  "2009-2012 T1", "新闻信息",
  "2009-2012 T2", "视频内容",
  "2009-2012 T3", "平台技术",
  "2009-2012 T4", "健康教育",
  "2009-2012 T5", "用户网络",
  "2009-2012 T6", "信息检索",
  "2013-2016 T1", "公共议题",
  "2013-2016 T2", "数字教育",
  "2013-2016 T3", "品牌营销",
  "2013-2016 T4", "情感分析",
  "2013-2016 T5", "数字文化",
  "2013-2016 T6", "视频内容",
  "2017-2020 T1", "公共健康",
  "2017-2020 T2", "情感分析",
  "2017-2020 T3", "新闻内容",
  "2017-2020 T4", "政治传播",
  "2017-2020 T5", "视频学习",
  "2017-2020 T6", "品牌营销",
  "2021-2024 T1", "短视频内容",
  "2021-2024 T2", "健康教育",
  "2021-2024 T3", "公共健康",
  "2021-2024 T4", "政治信息",
  "2021-2024 T5", "品牌营销",
  "2021-2024 T6", "情感检测"
)

# 将命名表与模型输出中的时期、topic 编号连接起来
sm_topic_label_lookup <- sm_beta %>%
  distinct(period, period_label, topic, topic_label, period_topic) %>%
  left_join(sm_topic_name_lookup, by = "topic_label") %>%
  mutate(
    # 如果后续重新运行 LDA 导致某个 topic 没有人工命名，先保留原 topic_label
    topic_name = coalesce(topic_name, topic_label),

    # 图形节点标签同时保留模型编号与人工命名
    topic_node_label = str_c(topic_label, "\n", topic_name),
    period_label = factor(period_label, levels = sm_periods$period_label)
  ) %>%
  arrange(period_label, topic)

主题相似度计算

主题对齐的第一步，是把每个 topic 转换成一组可以比较的关键词。这里取每个时期主题中 beta 最高的 20 个词，作为该主题的简化表示。随后比较相邻时期的 topic：两个 topic 共享的高概率词越多，它们的文本结构越接近。

本节同时计算两个指标。第一个是重叠词数量（overlap），表示两个 topic 共有多少个关键词。第二个是 Jaccard 相似度（Jaccard similarity），计算方式为：

\[ J(A,B)=\frac{|A \cap B|}{|A \cup B|} \]

其中，$A$ 和 $B$ 分别表示两个 topic 的关键词集合。Jaccard 值越高，两个集合越相似。为了让后续图形保持可读，每个 topic 只保留相邻时期中相似度最高的两个连接，并要求至少有 2 个共同词，且 Jaccard 不低于 0.05。

# ============================================================
# 基于 top 20 高概率词计算相邻时期 topic 相似度
# ============================================================

# 1. 为每个“时期主题”提取 beta 最高的 20 个词。
#    term_set 保存完整关键词集合，用于 intersect() 和 union() 计算；
#    display_terms 只保留前 6 个词，用于表格快速阅读。
sm_alignment_terms <- sm_beta %>%
  group_by(period, period_label, topic, topic_label, period_topic) %>%
  slice_max(beta, n = sm_topic_top_n, with_ties = FALSE) %>%
  arrange(period_label, topic, desc(beta)) %>%
  summarise(
    term_set = list(term),
    display_terms = paste(head(term, 6), collapse = ", "),
    .groups = "drop"
  ) %>%
  left_join(
    sm_topic_label_lookup %>%
      select(period_topic, topic_name, topic_node_label),
    by = "period_topic"
  )

# 2. 构造相邻时期组合。
#    这里比较 2009-2012 -> 2013-2016，
#    2013-2016 -> 2017-2020，
#    2017-2020 -> 2021-2024。
sm_period_pairs <- tibble(
  from_period = head(sm_periods$period, -1),
  to_period = tail(sm_periods$period, -1)
) %>%
  left_join(
    sm_periods %>%
      select(period, from_period_label = period_label),
    by = c("from_period" = "period")
  ) %>%
  left_join(
    sm_periods %>%
      select(period, to_period_label = period_label),
    by = c("to_period" = "period")
  ) %>%
  mutate(
    transition = paste(from_period, to_period, sep = " -> "),
    transition_label = paste(from_period_label, to_period_label, sep = " -> ")
  )

# 3. 对每一组相邻时期，计算所有 topic 两两之间的词汇重叠。
#    pmap_dfr() 会逐行读取 sm_period_pairs，并把每次结果合并成一个表。
sm_topic_alignment_raw <- purrr::pmap_dfr(
  sm_period_pairs,
  function(from_period, to_period, from_period_label, to_period_label,
           transition, transition_label) {

    # 取出前一个时期的 topic，并统一改成 from_ 字段
    from_topics <- sm_alignment_terms %>%
      filter(period == from_period) %>%
      transmute(
        from_period = period,
        from_period_label = period_label,
        from_topic = topic,
        from_topic_label = topic_label,
        from_period_topic = period_topic,
        from_topic_name = topic_name,
        from_topic_node = topic_node_label,
        from_term_set = term_set,
        from_display_terms = display_terms
      ) %>%
      mutate(join_key = 1)

    # 取出后一个时期的 topic，并统一改成 to_ 字段
    to_topics <- sm_alignment_terms %>%
      filter(period == to_period) %>%
      transmute(
        to_period = period,
        to_period_label = period_label,
        to_topic = topic,
        to_topic_label = topic_label,
        to_period_topic = period_topic,
        to_topic_name = topic_name,
        to_topic_node = topic_node_label,
        to_term_set = term_set,
        to_display_terms = display_terms
      ) %>%
      mutate(join_key = 1)

    # join_key = 1 用于生成笛卡尔连接：
    # 前一期每个 topic 都会与后一期每个 topic 配对比较。
    from_topics %>%
      left_join(to_topics, by = "join_key") %>%
      select(-join_key) %>%
      mutate(
        transition = transition,
        transition_label = transition_label,

        # overlap 是两个 topic 共同拥有的高概率词数量
        overlap = purrr::map2_int(
          from_term_set,
          to_term_set,
          ~ length(intersect(.x, .y))
        ),

        # union_size 是两个 topic 关键词集合的并集大小
        union_size = purrr::map2_int(
          from_term_set,
          to_term_set,
          ~ length(union(.x, .y))
        ),

        # Jaccard similarity = 交集大小 / 并集大小
        jaccard = if_else(union_size > 0, overlap / union_size, NA_real_),

        # 图中使用百分比宽度，课堂解释更直观
        jaccard_pct = jaccard * 100,

        # 保存共同词，便于解释具体是哪些词支撑了连接
        shared_terms = purrr::map2_chr(
          from_term_set,
          to_term_set,
          ~ paste(intersect(.x, .y), collapse = ", ")
        )
      )
  }
) %>%
  # 至少有 2 个共同词，并且 Jaccard 不低于 0.05，才保留为可解释连接
  filter(
    overlap >= sm_alignment_min_overlap,
    jaccard >= sm_alignment_min_jaccard
  ) %>%
  # 每个前期 topic 最多保留 2 条最相似的后期连接
  group_by(from_period_topic) %>%
  slice_max(jaccard, n = sm_alignment_keep_n, with_ties = FALSE) %>%
  ungroup() %>%
  mutate(
    # edge_id 是 Sankey/alluvial 中每条 flow 的唯一编号
    edge_id = str_c("edge_", row_number()),
    shared_terms = if_else(shared_terms == "", "无", shared_terms)
  ) %>%
  arrange(from_period, from_topic, desc(jaccard))

sm_topic_alignment <- sm_topic_alignment_raw

# ============================================================
# 查看相邻时期主题之间的高重叠连接
# ============================================================

sm_topic_alignment %>%
  # 先按时期转换排序，再把相似度较高、共同词较多的连接排在前面
  arrange(transition, desc(jaccard), desc(overlap)) %>%

  # 整理为适合课堂阅读的展示表
  transmute(
    `时期转换` = transition_label,
    `前一时期主题` = str_c(from_topic_label, "：", from_topic_name),
    `后一时期主题` = str_c(to_topic_label, "：", to_topic_name),

    # overlap 是两个 topic 共同拥有的高概率词数量
    `共同词数量` = overlap,

    # Jaccard 越高，说明两个 topic 的关键词集合越接近
    `Jaccard` = round(jaccard, 3),
    `相似度百分比` = percent(jaccard, accuracy = 0.1),

    # 共同词用于解释连接来源；过长时截断，避免表格过宽
    `共同高概率词` = str_trunc(shared_terms, 80)
  ) %>%
  kable(
    caption = "表：相邻时期主题之间的词汇重叠连接",
    align = "lllrrrl",
    booktabs = TRUE
  ) %>%

  # 控制表格宽度和字体，使 HTML 页面中更容易阅读
  kable_styling(
    full_width = FALSE,
    position = "center",
    font_size = 11
  ) %>%
  column_spec(1, width = "4.2cm") %>%
  column_spec(2, width = "4.6cm") %>%
  column_spec(3, width = "4.6cm") %>%
  column_spec(4, width = "2.3cm") %>%
  column_spec(6, width = "3.3cm") %>%
  column_spec(7, width = "5.0cm")

表：相邻时期主题之间的词汇重叠连接
时期转换	前一时期主题	后一时期主题	共同词数量	Jaccard	相似度百分比	共同高概率词
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T5：用户网络	2013-2016 T3：品牌营销	12	0.429	42.9%	users, marketing, brand, facebook, sites, content, influence, consumers, enga…
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T1：新闻信息	2013-2016 T1：公共议题	9	0.290	29.0%	twitter, information, can, content, tweets, public, users, communication, used
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T1：新闻信息	2013-2016 T5：数字文化	9	0.290	29.0%	twitter, can, news, content, digital, public, people, communication, one
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T2：视频内容	2013-2016 T6：视频内容	8	0.250	25.0%	youtube, videos, facebook, video, information, content, users, comments
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T2：视频内容	2013-2016 T1：公共议题	7	0.212	21.2%	facebook, information, content, users, communication, sites, used
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T5：用户网络	2013-2016 T1：公共议题	7	0.212	21.2%	users, political, facebook, sites, content, can, engagement
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T3：平台技术	2013-2016 T1：公共议题	6	0.176	17.6%	information, users, knowledge, can, organizations, participation
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T3：平台技术	2013-2016 T2：数字教育	6	0.176	17.6%	web, information, learning, youtube, technology, can
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T4：健康教育	2013-2016 T1：公共议题	6	0.176	17.6%	health, facebook, can, used, public, sites
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T4：健康教育	2013-2016 T2：数字教育	6	0.176	17.6%	students, learning, education, can, university, used
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T6：信息检索	2013-2016 T2：数字教育	4	0.111	11.1%	university, internet, search, can
时期一：2009-2012 -> 时期二：2013-2016	2009-2012 T6：信息检索	2013-2016 T1：公共议题	2	0.053	5.3%	political, can
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T3：品牌营销	2017-2020 T6：品牌营销	17	0.739	73.9%	facebook, brand, instagram, marketing, users, engagement, implications, brand…
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T4：情感分析	2017-2020 T2：情感分析	14	0.538	53.8%	twitter, information, can, sentiment, network, users, different, tweets, lear…
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T5：数字文化	2017-2020 T4：政治传播	11	0.379	37.9%	digital, instagram, practices, communication, public, facebook, work, can, co…
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T2：数字教育	2017-2020 T5：视频学习	10	0.333	33.3%	students, learning, education, technology, can, used, educational, informatio…
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T6：视频内容	2017-2020 T3：新闻内容	9	0.290	29.0%	content, users, information, health, people, facebook, individuals, community…
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T1：公共议题	2017-2020 T3：新闻内容	8	0.250	25.0%	twitter, health, information, facebook, public, used, users, content
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T1：公共议题	2017-2020 T4：政治传播	8	0.250	25.0%	twitter, facebook, political, public, communication, users, can, content
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T4：情感分析	2017-2020 T4：政治传播	6	0.176	17.6%	twitter, can, users, different, big, user
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T5：数字文化	2017-2020 T3：新闻内容	6	0.176	17.6%	news, public, facebook, content, people, twitter
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T6：视频内容	2017-2020 T5：视频学习	6	0.176	17.6%	videos, youtube, content, video, information, quality
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T2：数字教育	2017-2020 T1：公共健康	5	0.143	14.3%	patients, medical, used, information, time
时期二：2013-2016 -> 时期三：2017-2020	2013-2016 T3：品牌营销	2017-2020 T4：政治传播	4	0.111	11.1%	facebook, instagram, users, content
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T2：情感分析	2021-2024 T6：情感检测	16	0.667	66.7%	learning, sentiment, twitter, language, can, tweets, machine, detection, feat…
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T6：品牌营销	2021-2024 T5：品牌营销	13	0.481	48.1%	instagram, brand, marketing, engagement, consumers, content, users, influence…
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T1：公共健康	2021-2024 T2：健康教育	8	0.250	25.0%	health, pandemic, mental, among, information, used, participants, depression
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T3：新闻内容	2021-2024 T3：公共健康	8	0.250	25.0%	posts, reddit, users, people, may, public, health, community
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T3：新闻内容	2021-2024 T4：政治信息	8	0.250	25.0%	news, information, twitter, content, users, fake, misinformation, facebook
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T4：政治传播	2021-2024 T4：政治信息	8	0.250	25.0%	political, twitter, facebook, content, users, can, different, user
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T5：视频学习	2021-2024 T1：短视频内容	8	0.250	25.0%	videos, youtube, video, content, quality, information, tiktok, used
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T2：情感分析	2021-2024 T4：政治信息	7	0.212	21.2%	twitter, can, tweets, information, network, users, different
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T4：政治传播	2021-2024 T3：公共健康	7	0.212	21.2%	digital, users, public, can, work, practices, communities
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T1：公共健康	2021-2024 T1：短视频内容	6	0.176	17.6%	health, patients, may, information, used, medical
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T5：视频学习	2021-2024 T2：健康教育	5	0.143	14.3%	students, learning, information, education, used
时期三：2017-2020 -> 时期四：2021-2024	2017-2020 T6：品牌营销	2021-2024 T4：政治信息	3	0.081	8.1%	facebook, content, users

主题演化 Sankey

前面已经计算了相邻时期 topic 之间的 Jaccard 相似度。接下来使用 Sankey/alluvial 图把这些相似关系放在同一张图中。每一列表示一个时期，每个矩形表示该时期的一个 topic；列与列之间的 flow 表示相邻时期 topic 之间的词汇相似关系。

读图提示
flow 越宽，说明这条连接在该时期的相似关系中占比越高；颜色越深，说明两个 topic 的原始 Jaccard 相似度越高。颜色主调来自连接的起始时期，例如从时期一流向时期二的连接使用时期一的颜色。这个图展示的是 topic 词汇结构的接续线索，不表示文献数量流动，也不表示因果转移。

# ============================================================
# 四时期主题对齐 Sankey / alluvial 图
# ============================================================
# 这张图使用相邻时期 topic 的 Jaccard 相似度构建。
# 为了让四个时期的柱高一致，代码会先在每个时期内标准化连接权重。
# 标准化后的权重用于控制 flow 宽度，原始 Jaccard 用于控制透明度。

library(ggalluvial)

if (nrow(sm_topic_alignment) == 0) {

  # 如果没有任何连接达到前文设定的重叠阈值，则输出提示图
  ggplot() +
    annotate(
      "text",
      x = 0,
      y = 0,
      label = "没有达到重叠阈值的主题连接"
    ) +
    theme_void()

} else {

  # ------------------------------------------------------------
  # 1. 整理 alluvial 所需的长表数据
  # ------------------------------------------------------------
  # sm_topic_alignment 中每一行是一条“前一时期 topic -> 后一时期 topic”的连接。
  # ggalluvial 需要每条连接在起点时期和终点时期各有一行。
  sm_sankey_lodes <- bind_rows(

    # 起点 topic
    sm_topic_alignment %>%
      transmute(
        edge_id,
        transition,
        period_label = from_period_label,
        topic_node = from_topic_node,
        source_period_label = from_period_label,
        jaccard_pct,
        endpoint = "from"
      ),

    # 终点 topic
    sm_topic_alignment %>%
      transmute(
        edge_id,
        transition,
        period_label = to_period_label,
        topic_node = to_topic_node,
        source_period_label = from_period_label,
        jaccard_pct,
        endpoint = "to"
      )
  ) %>%
    mutate(
      # 固定时期顺序，避免横轴按字母顺序排列
      period_label = factor(period_label, levels = sm_periods$period_label),

      # source_period_label 用于决定 flow 的主色调
      source_period_label = factor(source_period_label, levels = sm_periods$period_label)
    ) %>%

    # ------------------------------------------------------------
    # 2. 将每个时期内部的连接权重标准化为 100%
    # ------------------------------------------------------------
    # 这样每一列总高度一致，便于比较各时期内部的连接结构。
    # flow_weight 控制图中的 flow 宽度。
    group_by(period_label) %>%
    mutate(
      flow_weight = jaccard_pct / sum(jaccard_pct, na.rm = TRUE) * 100
    ) %>%
    ungroup()

  # ------------------------------------------------------------
  # 3. 绘制 Sankey / alluvial 图
  # ------------------------------------------------------------
  ggplot(
    sm_sankey_lodes,
    aes(
      x = period_label,
      stratum = topic_node,
      alluvium = edge_id,
      y = flow_weight
    )
  ) +

    # flow 表示相邻时期 topic 之间的相似关系。
    # fill 使用起始时期的颜色，alpha 使用原始 Jaccard 相似度。
    # 因此，越粗且越深的 flow，表示两个 topic 越相似。
    geom_flow(
      aes(
        fill = source_period_label,
        alpha = jaccard_pct
      ),
      stat = "alluvium",
      lode.guidance = "frontback",
      color = "grey88",
      linewidth = 0.12,
      knot.pos = 0.45
    ) +

    # stratum 是每个时期中的 topic 矩形。
    # 使用浅灰色填充，避免与 flow 的颜色竞争。
    geom_stratum(
      width = 0.18,
      fill = "grey97",
      color = "grey45",
      linewidth = 0.28
    ) +

    # 给每个 topic 矩形添加标签。
    # 标签来自前文人工命名后的 topic_node。
    geom_text(
      stat = "stratum",
      aes(label = after_stat(stratum)),
      size = 2.55,
      lineheight = 0.9,
      color = "#1F2933"
    ) +

    # 横轴放在顶部，更接近 Sankey 图的阅读习惯
    scale_x_discrete(
      position = "top",
      expand = c(0.04, 0.04)
    ) +

    # y 轴表示每个时期内部标准化后的连接权重。
    # 这里隐藏 y 轴文本，只保留图形结构。
    scale_y_continuous(
      labels = function(x) paste0(round(x, 0), "%"),
      expand = expansion(mult = c(0.02, 0.08))
    ) +

    # 使用前文设定的时期色板。
    # alpha 越高，说明原始 Jaccard 相似度越高。
    scale_fill_manual(values = sm_period_palette, guide = "none") +
    scale_alpha_continuous(range = c(0.22, 0.88), guide = "none") +

    # clip = "off" 可以减少边缘标签被裁切
    coord_cartesian(clip = "off") +

    theme_minimal(base_size = 11) +
    theme(
      plot.title = element_text(face = "bold", hjust = 0, color = "#1F2933"),
      plot.subtitle = element_text(hjust = 0, color = "#5B6770"),
      axis.title = element_blank(),
      axis.text.x = element_text(face = "bold", color = "#003153", size = 10.8),
      axis.text.y = element_blank(),
      panel.grid = element_blank(),
      plot.margin = margin(14, 22, 14, 22)
    ) +
    labs(
      title = "Social Media 研究主题的分期接续关系",
      subtitle = "Flow 宽度表示各时期内部标准化后的相似度权重；颜色深浅表示原始 Jaccard 相似度"
    )
}

如何理解这张 Sankey 图？

这张图把相邻时期的 topic 相似关系转化为可视化线索。每个时期的总高度都被标准化为 100%，因此柱高不表示论文数量。图中需要重点看三件事：

哪些 topic 之间有较粗的连接，说明它们共享较多高概率词；
哪些连接颜色更深，说明原始 Jaccard 相似度更高；
某个 topic 是否流向多个后续 topic，或多个 topic 是否汇入同一后续 topic，这可以提示主题分化或主题合并的可能。

时期主题-关键词网络

完成分期 LDA 后，我们还需要把模型结果转换成更直观的结构关系。这里参考第六章的网络分析思路，将每个时期的 topic 和高概率词整理为一张 topic-term 二部网络。网络中的一类节点是人工命名后的 topic，另一类节点是该 topic 的高概率词；二者之间的连线来自 LDA 的 beta 值。

读图提示
深蓝色节点表示人工命名后的 topic，棕色节点表示关键词。topic 节点更大，便于先识别每个时期的主题框架；关键词节点较小，用来展示支撑主题的具体词项。连线表示 topic 与关键词之间的关系，线越粗，说明该词在该 topic 中的 beta 越高。若一个词连接多个 topic，说明它可能是该时期多个主题共享的表达。

连边

在代码实现上，先整理 topic-term 边表。边表中的每一行表示一个 topic 与一个高概率词之间的连接，同时保留 beta 作为边权。为了避免同名主题或同名词被错误合并，代码会为 topic 节点和词节点分别生成唯一节点 ID，并保留人工主题名作为后续图中的显示标签。

# ============================================================
# 构建 topic-term 边表
# ============================================================

library(tidygraph)
library(ggraph)
library(ggrepel)

set.seed(2026)

sm_topic_term_edges <- sm_beta %>%
  left_join(
    sm_topic_label_lookup %>%
      select(period_topic, topic_name),
    by = "period_topic"
  ) %>%
  group_by(period, period_label, topic, topic_label, period_topic, topic_name) %>%
  slice_max(beta, n = sm_topic_top_n, with_ties = FALSE) %>%
  arrange(desc(beta), .by_group = TRUE) %>%
  mutate(term_rank = row_number()) %>%
  ungroup() %>%
  transmute(
    period,
    period_label = factor(period_label, levels = sm_periods$period_label),
    period_topic,
    topic_name,
    term,
    beta,
    term_rank,

    # topic 节点用唯一 ID 保存，避免同名主题在网络中被错误合并
    from = str_c(period_topic, "__topic"),

    # 词节点按“时期 + 词”构造 ID，使同一时期内相同词可以连接多个 topic
    to = str_c(period, "__term__", term),

    # 每个 topic 只标注 beta 最高的若干词
    label_term = term_rank <= sm_topic_label_n
  )

节点

接下来构建节点表。topic 节点全部标注人工主题名；词节点只标注每个 topic 的 top 6 词，其余词保留为节点，但不显示文字。

# ============================================================
# 构建 topic 节点与关键词节点
# ============================================================
# tidygraph 的网络对象需要两张表：
# 1. 边表：说明哪些节点彼此连接；
# 2. 节点表：说明每个节点的属性，例如标签、类型和所属时期。
#
# 上一步已经构建了边表 sm_topic_term_edges。
# 这里继续从边表中拆出两类节点：topic 节点和关键词节点。

# ------------------------------------------------------------
# 1. 构建 topic 节点表
# ------------------------------------------------------------
# 每个 topic 是一个节点。
# name 使用前面生成的唯一 ID，label 使用人工命名后的主题名称。
sm_topic_nodes <- sm_topic_term_edges %>%
  distinct(
    period,
    period_label,

    # name 是 tidygraph 识别节点关系的主键
    name = from,

    # label 是图中实际显示的文字
    label = topic_name
  ) %>%
  mutate(
    # 标记节点类型，后续用于设置颜色和大小
    node_type = "时期主题",

    # topic 节点全部显示标签
    show_label = TRUE
  )

# ------------------------------------------------------------
# 2. 构建关键词节点表
# ------------------------------------------------------------
# 一个关键词可能同时出现在多个 topic 的 top 20 词中。
# 因此需要按 period + name + term 分组，避免重复生成同一个词节点。
sm_term_nodes <- sm_topic_term_edges %>%
  group_by(period, period_label, name = to, term) %>%
  summarise(
    # 如果一个词属于任一 topic 的 top 6，就在图中显示标签。
    # 如果它只出现在 top 20 但不属于 top 6，则保留节点，不显示文字。
    show_label = any(label_term),
    .groups = "drop"
  ) %>%
  mutate(
    # 标记节点类型，后续用于设置颜色和大小
    node_type = "高概率词",

    # 只给需要显示的关键词保留 label，其他关键词设为 NA
    label = if_else(show_label, term, NA_character_)
  ) %>%
  select(period, period_label, name, label, node_type, show_label)

# ------------------------------------------------------------
# 3. 合并两类节点
# ------------------------------------------------------------
# bind_rows() 将 topic 节点和关键词节点合并为 tidygraph 所需的节点表。
# period_label 和 node_type 转为 factor，便于后续控制分面顺序和图例顺序。
sm_topic_term_nodes <- bind_rows(
  sm_topic_nodes,
  sm_term_nodes
) %>%
  mutate(
    # 固定时期顺序，避免 facet_wrap() 按字母顺序排列
    period_label = factor(period_label, levels = sm_periods$period_label),

    # 固定节点类型顺序，使图例先显示 topic，再显示关键词
    node_type = factor(node_type, levels = c("时期主题", "高概率词"))
  )

网络构建

下面使用 tidygraph::tbl_graph() 构建网络对象，并通过 ggraph::create_layout() 为每个时期分别计算 Fruchterman-Reingold 布局。

# ============================================================
# 为每个时期构建 tidygraph 对象并计算布局
# ============================================================
# 这一段代码的目标是：
# 1. 把每个时期的 topic-term 边表和节点表转为 tidygraph 网络对象；
# 2. 为每个时期单独计算网络布局坐标；
# 3. 把节点坐标回接到边表中，方便后面用 ggplot 绘制连线。

# ------------------------------------------------------------
# 1. 定义坐标缩放函数
# ------------------------------------------------------------
# create_layout() 生成的 x/y 坐标没有固定范围。
# 为了让四个分面在同一图幅中更协调，这里把每个时期的坐标缩放到 [-1, 1]。
sm_rescale_safe <- function(x) {
  # 如果某一维度中所有坐标都一样，rescale() 会缺少可缩放范围。
  # 这种情况下直接把节点放在 0，避免代码报错。
  if (length(unique(stats::na.omit(x))) <= 1) {
    rep(0, length(x))
  } else {
    scales::rescale(x, to = c(-1, 1))
  }
}

# ------------------------------------------------------------
# 2. 为单个时期生成网络布局
# ------------------------------------------------------------
# period_value 是时期代码，例如 "2009-2012"。
# 函数每次只处理一个时期，保证四个时期的网络结构各自独立。
sm_build_period_layout <- function(period_value) {

  # 取出该时期的边表。
  # from 是 topic 节点 ID，to 是关键词节点 ID，beta 是边权。
  period_edges <- sm_topic_term_edges %>%
    filter(period == period_value) %>%
    select(from, to, beta)

  # 取出该时期的节点表。
  # name 是节点 ID，label 是图中显示的文字，node_type 区分 topic 和关键词。
  period_nodes <- sm_topic_term_nodes %>%
    filter(period == period_value) %>%
    select(name, period, period_label, label, node_type, show_label)

  # 使用 tidygraph 的 tbl_graph() 组装网络。
  # nodes 接收节点表，edges 接收边表。
  # directed = FALSE 表示这里不讨论方向，只表示 topic 与词之间存在连接。
  period_graph <- tbl_graph(
    nodes = period_nodes,
    edges = period_edges,
    directed = FALSE
  )

  # create_layout() 会为网络中的每个节点生成 x/y 坐标。
  # layout = "fr" 使用 Fruchterman-Reingold 力导向布局：
  # 连接较强或关系较近的节点会更容易靠近。
  ggraph::create_layout(period_graph, layout = "fr") %>%
    as_tibble() %>%
    mutate(
      # 缩放坐标，便于四个时期放入同一张分面图
      x = sm_rescale_safe(x),
      y = sm_rescale_safe(y),

      # 固定时期顺序，避免 facet 按字母顺序排列
      period_label = factor(period_label, levels = sm_periods$period_label)
    )
}

# ------------------------------------------------------------
# 3. 批量计算四个时期的节点布局
# ------------------------------------------------------------
# 对 sm_periods$period 中的四个时期逐一运行 sm_build_period_layout()。
# map_dfr() 会把四个时期的节点坐标合并成一个数据框。
sm_network_nodes <- sm_periods$period %>%
  purrr::map_dfr(sm_build_period_layout)

# ------------------------------------------------------------
# 4. 将节点坐标回接到边表
# ------------------------------------------------------------
# geom_segment() 需要每条边的起点坐标和终点坐标。
# 因此需要把 from 节点的 x/y 和 to 节点的 x/y 都连接回边表。
sm_network_edges <- sm_topic_term_edges %>%
  select(period, period_label, from, to, beta) %>%
  mutate(
    period_label = factor(period_label, levels = sm_periods$period_label)
  ) %>%

  # 连接起点坐标：from 对应 topic 节点
  left_join(
    sm_network_nodes %>%
      select(name, x_from = x, y_from = y),
    by = c("from" = "name")
  ) %>%

  # 连接终点坐标：to 对应关键词节点
  left_join(
    sm_network_nodes %>%
      select(name, x_to = x, y_to = y),
    by = c("to" = "name")
  )

网络可视化

最后绘制四个时期的 topic-term 网络。这里将 topic 标签和词标签分开绘制：topic 标签加粗，词标签较小，保证读图时先看到主题结构，再查看支撑主题的关键词。

# ============================================================
# 绘制四个时期的 topic-term 网络
# ============================================================
# 这张图有三类视觉映射：
# 1. 节点颜色和大小区分“时期主题”和“高概率词”；
# 2. 连线宽度映射 beta，表示词对 topic 的代表性强弱；
# 3. 分面展示四个时期，便于比较不同时期的主题词结构。

sm_topic_network_plot <- ggplot() +

  # ------------------------------------------------------------
  # 1. 绘制连边
  # ------------------------------------------------------------
  # 每一条边连接一个 topic 和一个关键词。
  # linewidth = beta：beta 越高，线越粗，说明该词越能代表这个 topic。
  # alpha 设为 0.42，是为了弱化背景连线，避免影响节点和标签阅读。
  geom_segment(
    data = sm_network_edges,
    aes(
      x = x_from, y = y_from,
      xend = x_to, yend = y_to,
      linewidth = beta
    ),
    color = "grey70",
    alpha = 0.42,
    lineend = "round"
  ) +

  # ------------------------------------------------------------
  # 2. 绘制节点
  # ------------------------------------------------------------
  # 节点分为两类：
  # - 时期主题：人工命名后的 topic；
  # - 高概率词：该 topic 中 beta 较高的关键词。
  # shape = 21 支持同时设置 fill 和 color，便于控制填充色与边框色。
  geom_point(
    data = sm_network_nodes,
    aes(
      x = x,
      y = y,
      fill = node_type,
      color = node_type,
      size = node_type
    ),
    shape = 21,
    stroke = 0.45,
    alpha = 0.95
  ) +

  # ------------------------------------------------------------
  # 3. 标注 topic 节点
  # ------------------------------------------------------------
  # topic 标签只显示人工命名后的主题名，不显示年份和 Topic 编号。
  # fontface = "bold" 用于提高 topic 标签的层级，使其区别于普通关键词。
  # geom_text_repel() 会自动调整标签位置，减少文字重叠。
  ggrepel::geom_text_repel(
    data = sm_network_nodes %>%
      filter(node_type == "时期主题"),
    aes(x = x, y = y, label = label),
    size = 3.65,
    fontface = "bold",
    color = "#003153",
    seed = 2026,
    box.padding = 0.38,
    point.padding = 0.24,
    segment.color = "grey65",
    segment.linewidth = 0.25,
    min.segment.length = 0,
    max.overlaps = Inf
  ) +

  # ------------------------------------------------------------
  # 4. 标注关键词节点
  # ------------------------------------------------------------
  # 关键词节点较多，全部标注会造成遮挡。
  # 因此这里只显示前面筛选出的关键词标签，即每个 topic 中 beta 最高的若干词。
  # 关键词标签字号小于 topic 标签，避免抢占主要视觉层级。
  ggrepel::geom_text_repel(
    data = sm_network_nodes %>%
      filter(node_type == "高概率词", !is.na(label)),
    aes(x = x, y = y, label = label),
    size = 2.35,
    color = "#263238",
    seed = 2026,
    box.padding = 0.18,
    point.padding = 0.08,
    segment.color = "grey76",
    segment.linewidth = 0.22,
    min.segment.length = 0,
    max.overlaps = Inf
  ) +

  # ------------------------------------------------------------
  # 5. 分面展示四个时期
  # ------------------------------------------------------------
  # 每个时期单独计算网络布局，再放入同一张图中比较。
  # 这里比较的是各时期内部结构，不比较不同分面中节点的绝对坐标。
  facet_wrap(~ period_label, ncol = 2) +

  # ------------------------------------------------------------
  # 6. 设置颜色、大小和线宽
  # ------------------------------------------------------------
  # sm_node_palette 在前文已经定义，用于保证 topic 节点和词节点配色一致。
  # topic 节点更大，关键词节点更小，读图时可以先看主题，再看支撑词。
  scale_fill_manual(values = sm_node_palette) +
  scale_color_manual(values = sm_node_palette) +
  scale_size_manual(values = c("时期主题" = 6.6, "高概率词" = 2.25)) +

  # line width 不显示图例，因为 beta 的数值主要用于视觉辅助。
  # 若正式论文需要精确比较 beta，应回到表格或主题词图。
  scale_linewidth(range = c(0.08, 1.0), guide = "none") +

  # coord_equal() 保持 x 与 y 的比例一致，避免网络形状被拉伸。
  # clip = "off" 允许标签稍微超出绘图区，减少边缘标签被裁切。
  coord_equal(clip = "off") +

  # ------------------------------------------------------------
  # 7. 图形主题
  # ------------------------------------------------------------
  # 网络图不依赖坐标轴读数，因此使用 theme_void() 去掉坐标轴和网格线。
  theme_void(base_size = 11) +
  theme(
    legend.position = "bottom",
    legend.title = element_blank(),
    strip.text = element_text(face = "bold", color = "#003153", size = 12.5),
    plot.title = element_text(face = "bold", hjust = 0, color = "#1F2933"),
    plot.subtitle = element_text(hjust = 0, color = "#5B6770"),
    panel.spacing = grid::unit(1.75, "lines"),
    plot.margin = margin(14, 22, 14, 22)
  ) +

  # ------------------------------------------------------------
  # 8. 标题与说明
  # ------------------------------------------------------------
  labs(
    title = "不同时期的 LDA topic-term 网络",
    subtitle = "深蓝节点为人工命名的 topic；棕色节点为高概率词；连线宽度表示 beta"
  )

# 输出图形对象
sm_topic_network_plot

小结

本节把分期 LDA 的结果转化为两类可视化证据。Sankey/alluvial 图用于观察相邻时期 topic 的接续关系，分期 topic-term 网络用于观察每个时期内部的主题词结构。两类图都服务于同一个问题：social media 研究中的主题是否延续、是否分化，以及哪些词支撑了这种判断。需要注意的是，这些图展示的是模型结果的解释线索，最终判断仍然需要回到代表性论文和摘要语境。

3.0 专题研究 1：回顾与反思

专题回顾

本节对专题研究 1：“Social Media 研究主题的分期演变”进行回顾与反思。该专题以 OpenAlex 中 2009-2024 年 social media 相关英文论文的标题与摘要为语料，系统地展示了从开放文献数据获取、文本清洗、TF-IDF、分期 LDA 到主题对齐和网络可视化的一套文本分析的入门流程。

本案例的重点在于把文献摘要整理为可复现、可检查、可解释的文本分析对象。研究者可以通过检索词、分期、停用词、主题数和可视化规则逐步检查语料如何形成，模型如何输出结果，解释如何回到高概率词、代表性文献和摘要语境。

延伸说明：从系统性文献综述到文本挖掘式综述

系统性文献综述（systematic literature review, SLR）通常要求研究者事先说明研究问题、数据库、检索式、纳入与排除标准、筛选流程和证据综合方法。传统 SLR 很大程度依赖人工阅读、编码和归纳。随着开放文献数据库、文本挖掘和大语言模型的发展，文献综述正在出现更强的数据化取向：研究者可以把题名、摘要、关键词和引用关系整理为可计算语料，用于检索式评估、主题映射、研究趋势识别和证据地图构建。

本专题可以看作一种文本挖掘式文献综述练习。它的优势在于流程可复现、语料边界可检查、主题变化可视化，并能处理人工阅读难以快速覆盖的大规模摘要。

但是，请注意，目前来说专题研究1还不能单独构成完整 SLR。完整 SLR 仍需补充注册或预设方案、筛选、质量评价、精细化阅读、研究设计分类、证据强度判断和报告规范 （不过大语言出现的模型已经开始冲击这类综述方法）。

可参考的综述方法与案例包括：Tranfield、Denyer 与 Smart（2003）关于管理研究中的 systematic review 方法，Petticrew 与 Roberts（2006）关于社会科学系统综述的实践指南，Page 等（2021）提出的 PRISMA 2020 报告规范，Snyder（2019）关于文献综述作为研究方法的概述，以及 Ye 与 Yang（2025）在 Sustainable Cities and Society 发表的 heat health risk assessment systematic review。

3.1 专题研究 1 回顾

回顾专题研究 1，本案例主要完成了五个环节：

构建文献语料：使用 OpenAlex 获取 social media 相关英文论文的标题与摘要，并按 2009-2024 年四个时期组织语料。检索词覆盖 social media 及 Twitter、Facebook、Instagram、YouTube、Reddit、TikTok 等平台入口。
清洗与筛选文本：将 OpenAlex 的摘要还原为普通文本，保留英文论文、可识别来源和有效摘要，并剔除明显不适合进入模型的记录。
比较时期差异词：使用 TF-IDF 观察每个时期更具区分度的词项，初步识别平台、公共健康、短视频、AI、情感分析等变化线索。
提取分期主题结构：对每个时期分别运行 LDA，每期设定 k = 6，再根据高概率词、代表性标题和摘要回读为 topic 命名。
展示主题接续关系：使用 Jaccard 相似度连接相邻时期 topic，并通过 Sankey/alluvial 图和 topic-term 网络观察主题延续、分化和汇合的可能线索。

3.2 专题研究 1 反思

方法边界

文本分析可以帮助研究者快速整理大规模文献摘要，但模型结果仍然依赖语料边界、参数设定和解释规则。本专题适合用于入门训练，在正式研究中还需要进一步检查以下问题。

后续拓展方向

本专题可以从四个方向继续推进：比较不同检索式和筛选口径，检查语料边界对结果的影响；比较不同 k 值和不同分期方案，观察 topic 是否稳定；使用 BERTopic 或 embedding topic model 与 LDA 对照；转向中文社交媒体文本，结合中文分词、中文预训练模型和 LLM 辅助编码开展复核。

4.0 专题研究 2：社交媒体情感分析

4.0 专题研究 2

专题研究 2：社交媒体情感分析

专题导航

社交媒体情感分析

专题研究 2 仍在建设中，当前版本暂未开放。本节仅保留导航位置与章节结构。

4.1 待补充

专题研究 2 后续将围绕社交媒体情感分析展开，内容包括研究问题、数据准备、中文文本处理、情感编码、可视化和原文复核。相关内容完成前，本节不提供实质任务。

5.0 专题研究 2：回顾与反思

专题研究 2 仍在建设中，当前版本暂未开放。本节将在专题研究 2 完成后补充回顾与反思内容。

6.0 本章练习

6.0 动手实战

本章练习仍在建设中，当前版本暂未开放。练习将在专题研究 2 完成后统一补充。

第九章：自然语言处理入门

章节作者：刘贇喆 | 华东师范大学 社会发展学院

更新时间：2026-06-14

本章学习内容

学习导航

1.0 自然语言处理入门导论

1.0 自然语言处理入门导论

1.1 什么是自然语言处理？

知识小卡片：文本分析与自然语言处理的关系

1.2 文本如何成为数据？

知识小卡片：传统 NLP 的 Token 与大语言模型（LLM）的 Token 是一回事吗？

知识小卡片：自然语言处理核心术语指南

1.3 R 环境准备

工具提示：文本分析常用 R 包概览

1.4 文本分析的基本流程

1.4.1 明确研究问题与语料边界

1.4.2 构建文档表

1.4.3 文本清洗与标准化

1.4.4 分词与词元表

1.4.5 停用词、领域词典与词项筛选

知识小卡片：停用词表的构建没有“绝对标准”

1.4.6 词频、TF-IDF 与特征矩阵构建

1.4.7 建模分析与理论测量目标的匹配

1.4.8 结果解释与原文回读

1.5 词频结果的可视化展示

1.5.1 准备词频表

1.5.2 使用条形图展示高频特征词

1.5.3 使用词云图展示总体词频

1.5.4 英文比较词云：简·奥斯汀作品示例

使用提醒：词云用于探索，不用于精确比较

1.6 拓展阅读：R 文本分析与社会科学应用

学习建议：先掌握工作流，再回归研究问题

2.0 专题研究 1：Social Media 研究主题的分期演变

2.0 专题研究 1

专题研究 1：Social Media 研究主题的分期演变

专题导航

问题与检索

2.1 研究问题与检索式设计

概念说明：什么是社交媒体研究？

分期说明：四个等距分析窗口

方法提醒：宽口径检索与样本控制

数据获取

2.2 OpenAlex 数据获取与语料构建

OpenAlex 在本专题中的作用

OpenAlex API 与课堂缓存

文本处理

2.3 摘要还原、文本清洗与 DTM 构建

数据结构说明：什么是倒排索引？

从文本到模型输入

数据清洗提醒：模型语料需要先筛选

概念说明：什么是 TF-IDF？

概念说明：什么是 DTM？

LDA 模型

2.4 LDA 主题模型与主题解释

方法说明：LDA 如何从 DTM 中识别主题？

主题网络

2.5 主题对齐与主题网络可视化

如何理解主题对齐？

如何理解这张 Sankey 图？

3.0 专题研究 1：回顾与反思

3.0 专题研究 1：回顾与反思

延伸说明：从系统性文献综述到文本挖掘式综述

3.1 专题研究 1 回顾

3.2 专题研究 1 反思

后续拓展方向

4.0 专题研究 2：社交媒体情感分析

4.0 专题研究 2

专题研究 2：社交媒体情感分析

专题导航

4.1 待补充

5.0 专题研究 2：回顾与反思

5.0 专题研究 2：回顾与反思

6.0 本章练习

6.0 动手实战

章节作者：刘贇喆 | 华东师范大学社会发展学院