其他
R 语言文本分析｜上市公司年报批量爬取、文本提取分词、词频统计与词云图绘制
欢迎大家参加明晚 8 点的直播课：「上市公司年报批量爬取、文本提取分词、词频统计与词云图绘制」
明晚的课程包含如下内容：
从巨潮资讯网爬取上市公司年报； pdf 文档文本提取； 中文文本分词与词频统计； 使用 highcharter 绘制精美词云图。
上节课我们讲解了如何使用 R 语言进行字符串处理、分词和词频统计，本次课我们将重新讲解本系列课程第一次课结尾的案例：「爬取平安银行年报、提取文本、分词与词频统计」，然后再讲解 R 语言中词云图的绘制。
爬取平安银行年报、提取文本、分词与词频统计
上市公司年报可以从巨潮资讯网搜索和下载：http://www.cninfo.com.cn/new/commonUrl/pageOfSearch?url=disclosure/list/search
这里我们的目标是爬取 2008～2022 年平安银行年报，获得 pdf 后提取文本并进行词频统计。
首先获取所有的 pdf 链接。对上述的网站进行分析可以找到 pdf 链接数据在这里：
对着这个项目右键选择 copy as curl (中文的话大致是“以 cURL 格式复制”) 就可以得到 curl 代码了：
curl 'http://www.cninfo.com.cn/new/hisAnnouncement/query' \
-H 'Accept: */*' \
-H 'Accept-Language: zh-CN,zh;q=0.9,en;q=0.8' \
-H 'Connection: keep-alive' \
-H 'Content-Type: application/x-www-form-urlencoded; charset=UTF-8' \
-H 'Cookie: JSESSIONID=194CEB2640D6CE58BE79D98B36581BA9; insert_cookie=37836164; _sp_ses.2141=*; routeId=.uc2; _sp_id.2141=87e08577-7638-4e83-a94a-65df12f52503.1676037821.3.1686471823.1684069346.345e3554-4bb4-4480-affe-7d1e3686c278' \
-H 'Origin: http://www.cninfo.com.cn' \
-H 'Referer: http://www.cninfo.com.cn/new/commonUrl/pageOfSearch?url=disclosure/list/search' \
-H 'User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36' \
-H 'X-Requested-With: XMLHttpRequest' \
--data-raw 'pageNum=1&pageSize=30&column=szse&tabName=fulltext&plate=&stock=000001%2Cgssz0000001&searchkey=&secid=&category=category_ndbg_szsh&trade=&seDate=2022-12-11~2023-06-12&sortName=&sortType=&isHLtitle=true' \
--compressed \
--insecure
然后可以使用这个网站把上面的 curl 语句转换成 R 语言：https://curlconverter.com/r/ ，还可以试着改改其中的一些参数，下面是转换得到的 R 代码：
library(tidyverse)
library(httr)
cookies = c(
`JSESSIONID` = "68C7C3F74CBF51A4117858FB38265C1C",
`_sp_ses.2141` = "*",
`insert_cookie` = "45380249",
`routeId` = ".uc1",
`_sp_id.2141` = "87e08577-7638-4e83-a94a-65df12f52503.1676037821.2.1684069346.1676037821.a1c8e99d-2d14-4a9c-8186-ffd7c2a0d42a"
)
headers = c(
`Accept` = "*/*",
`Accept-Language` = "zh-CN,zh;q=0.9,en;q=0.8",
`Content-Type` = "application/x-www-form-urlencoded; charset=UTF-8",
`Origin` = "http://www.cninfo.com.cn",
`Proxy-Connection` = "keep-alive",
`Referer` = "http://www.cninfo.com.cn/new/commonUrl/pageOfSearch?url=disclosure/list/search",
`User-Agent` = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/113.0.0.0 Safari/537.36",
`X-Requested-With` = "XMLHttpRequest"
)
data = list(
`pageNum` = "1",
`pageSize` = "30",
`column` = "szse",
`tabName` = "fulltext",
`plate` = "",
`stock` = "000001,gssz0000001",
`searchkey` = "",
`secid` = "",
`category` = "category_ndbg_szsh",
`trade` = "",
`seDate` = "2000-01-01~2023-05-15",
`sortName` = "",
`sortType` = "",
`isHLtitle` = "true"
)
res <- httr::POST(url = "http://www.cninfo.com.cn/new/hisAnnouncement/query",
httr::add_headers(.headers=headers),
httr::set_cookies(.cookies = cookies),
body = data, encode = "form",
config = httr::config(ssl_verifypeer = FALSE))
content(res) -> ls
ls$announcements %>%
transpose() %>%
as_tibble() %>%
unnest() %>%
filter(!str_detect(announcementTitle, "摘要")) %>%
select(announcementTitle, adjunctUrl) %>%
mutate(adjunctUrl = paste0("http://static.cninfo.com.cn/", adjunctUrl)) -> df1
df1
#> # A tibble: 15 × 2
#> announcementTitle adjunctUrl
#> <chr> <chr>
#> 1 2022年年度报告 http://static.cninfo.com.cn/finalpage/2023-03-09/121607295…
#> 2 2021年年度报告 http://static.cninfo.com.cn/finalpage/2022-03-10/121253341…
#> 3 2020年年度报告 http://static.cninfo.com.cn/finalpage/2021-02-02/120922437…
#> 4 2019年年度报告 http://static.cninfo.com.cn/finalpage/2020-02-14/120730548…
#> 5 2018年年度报告 http://static.cninfo.com.cn/finalpage/2019-03-07/120588106…
#> 6 2017年年度报告 http://static.cninfo.com.cn/finalpage/2018-03-15/120447715…
#> 7 2016年年度报告 http://static.cninfo.com.cn/finalpage/2017-03-17/120316751…
#> 8 2015年年度报告 http://static.cninfo.com.cn/finalpage/2016-03-10/120203339…
#> 9 2014年年度报告 http://static.cninfo.com.cn/finalpage/2015-03-13/120069456…
#> 10 2013年年度报告 http://static.cninfo.com.cn/finalpage/2014-03-07/63646360.…
#> 11 2012年年度报告 http://static.cninfo.com.cn/finalpage/2013-03-08/62193049.…
#> 12 2011年年度报告 http://static.cninfo.com.cn/finalpage/2012-03-09/60645730.…
#> 13 2010年年度报告 http://static.cninfo.com.cn/finalpage/2011-02-25/59043233.…
#> 14 2009年年度报告 http://static.cninfo.com.cn/finalpage/2010-03-12/57679912.…
#> 15 2008年年度报告 http://static.cninfo.com.cn/finalpage/2009-03-20/50366297.…
下载 pdf 文件：
# 下载 pdf 文件
dir.create("pdf")
lapply(df1$adjunctUrl, function(x){
if(!file.exists(paste0("pdf/", basename(x)))) {
try({
download.file(x, paste0("pdf/", basename(x)))
})
}
}) -> res
首先尝试从一个 pdf 文件中提取文本进行分词：
# pdf 文本提取
library(jiebaR)
library(pdftools)
# 分词引擎：需要停用词字典和用户字典
engine_s <- worker(stop_word = "stopwords.txt", user = "dictionary.txt")
# 单个文本的提取
pdftools::pdf_text("pdf/1216072952.PDF") -> text
text %>%
paste0(collapse = "") %>%
str_remove_all("[\\s\\n\\t\\d[a-z].]") -> text
# 分词
segment(text, jiebar = engine_s) %>%
as_tibble() %>%
count(value, sort = T) -> df
df
#> # A tibble: 5,968 × 2
#> value n
#> <chr> <int>
#> 1 银行 688
#> 2 平安 670
#> 3 资产 657
#> 4 风险 571
#> 5 股份 493
#> 6 价值 436
#> 7 客户 356
#> 8 投资 356
#> 9 金融 356
#> 10 负债 344
#> # ℹ 5,958 more rows
read_csv("dictionary.txt", col_names = F) -> word
word$X1
#> [1] "工业互联网" "量化金融" "第三方支付" "云计算" "区块链"
#> [6] "互联网"
df %>%
arrange(desc(n)) %>%
dplyr::filter(value %in% word$X1)
#> # A tibble: 3 × 2
#> value n
#> <chr> <int>
#> 1 互联网 19
#> 2 区块链 6
#> 3 云计算 1
然后再批量处理所有的 pdf 文件：
# 多个 pdf 文档处理
fs::dir_ls("pdf") %>%
as.character() %>%
as_tibble() %>%
mutate(text = map_chr(value, function(x){
pdftools::pdf_text(x) %>%
paste0(collapse = "") %>%
str_remove_all("[\\s\\n\\t\\d[a-z].]")
})) -> textdf
# 分词并筛选我们感兴趣的几个词汇
textdf %>%
mutate(seg = map(text, function(x){
segment(x, jiebar = engine_s) %>%
as_tibble() %>%
count(value, sort = T) %>%
dplyr::filter(value %in% word$X1)
})) -> textdf2
textdf2 %>%
select(-text) -> textdf2
textdf2
添加年份：
df1 %>%
mutate(value = paste0("pdf/", basename(adjunctUrl))) %>%
left_join(textdf2) %>%
select(-adjunctUrl, -value) %>%
rename(year = announcementTitle) %>%
mutate(year = as.numeric(str_extract(year, "\\d{4}"))) %>%
unnest(seg) -> df2
#> # A tibble: 15 × 2
#> value seg
#> <chr> <list>
#> 1 pdf/1200694563.PDF <tibble [1 × 2]>
#> 2 pdf/1202033390.PDF <tibble [2 × 2]>
#> 3 pdf/1203167519.PDF <tibble [2 × 2]>
#> 4 pdf/1204477157.PDF <tibble [3 × 2]>
#> 5 pdf/1205881066.PDF <tibble [3 × 2]>
#> 6 pdf/1207305488.PDF <tibble [3 × 2]>
#> 7 pdf/1209224370.PDF <tibble [3 × 2]>
#> 8 pdf/1212533413.PDF <tibble [3 × 2]>
#> 9 pdf/1216072952.PDF <tibble [3 × 2]>
#> 10 pdf/50366297.PDF <tibble [1 × 2]>
#> 11 pdf/57679912.PDF <tibble [1 × 2]>
#> 12 pdf/59043233.PDF <tibble [1 × 2]>
#> 13 pdf/60645730.PDF <tibble [1 × 2]>
#> 14 pdf/62193049.PDF <tibble [1 × 2]>
#> 15 pdf/63646360.PDF <tibble [1 × 2]>
最后绘图展示这些词语在历年年报中词频的变化：
# 绘图
library(ggforce)
df2 %>%
ggplot(aes(year, n, color = value)) +
geom_bspline(linewidth = 1.2) +
labs(x = "", y = "词频", color = "",
title = "2008～2022 年平安银行年报中互联网、区块链、云计算词频的变化",
subtitle = "数据处理&绘图：微信公众号 RStata",
caption = "数据来源：巨潮资讯网<http://www.cninfo.com.cn/>") +
scale_color_manual(values = c("#9f248f", "#ffce4e", "#017a4a")) +
theme(legend.position = "top",
plot.background = element_rect(fill = "white", color = "white")) -> p
ggsave("pic1.png", width = 10, height = 6, device = png)
使用词云图展示分词结果
在上面的代码中我们得到了 textdf 对象：
textdf
#> # A tibble: 15 × 2
#> value text
#> <chr> <chr>
#> 1 pdf/1200694563.PDF "平安银行股份有限公司年年度报告第一节重要提示、目录和释义…
#> 2 pdf/1202033390.PDF "平安银行股份有限公司年年度报告第一节重要提示、目录和释义…
#> 3 pdf/1203167519.PDF "平安安银行行股份份有限公公司年年度度报告告第一节重要提示…
#> 4 pdf/1204477157.PDF "平安银行股份有限公司年年度报告第一节重要提示、目录和释义…
#> 5 pdf/1205881066.PDF "平安银行股份有限公司年年度报告第一节重要提示、目录和释义…
#> 6 pdf/1207305488.PDF "平安银行股份有限公司年年度报告重要提示、本行董事会、监事…
#> 7 pdf/1209224370.PDF "平安银行股份有限公司年年度报告平安银行股份有限公司重要提…
#> 8 pdf/1212533413.PDF "平安银行股份有限公司年年度报告平安银行股份有限公司重要提…
#> 9 pdf/1216072952.PDF "平安银行股份有限公司年年度报告平安银行股份有限公司重要提…
#> 10 pdf/50366297.PDF "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二…
#> 11 pdf/57679912.PDF "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二…
#> 12 pdf/59043233.PDF "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二…
#> 13 pdf/60645730.PDF "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二…
#> 14 pdf/62193049.PDF "第一节重要提示、目录和释义、本行董事会、监事会及董事、监…
#> 15 pdf/63646360.PDF "平安银行股份有限公司年年度报告--第一节重要提示、目录和释…
为数据添加年份：
df1 %>%
mutate(value = paste0("pdf/", basename(adjunctUrl))) %>%
select(-adjunctUrl) %>%
left_join(textdf) %>%
select(-value) %>%
mutate(year = str_extract(announcementTitle, "\\d{4}")) %>%
select(year, -announcementTitle, text) %>%
mutate(year = as.numeric(year)) -> textdf
textdf
#> # A tibble: 15 × 2
#> year text
#> <dbl> <chr>
#> 1 2022 "平安银行股份有限公司年年度报告平安银行股份有限公司重要提示年年度报告…
#> 2 2021 "平安银行股份有限公司年年度报告平安银行股份有限公司重要提示年年度报告…
#> 3 2020 "平安银行股份有限公司年年度报告平安银行股份有限公司重要提示年年度报告…
#> 4 2019 "平安银行股份有限公司年年度报告重要提示、本行董事会、监事会及董事、监…
#> 5 2018 "平安银行股份有限公司年年度报告第一节重要提示、目录和释义重要提示、本…
#> 6 2017 "平安银行股份有限公司年年度报告第一节重要提示、目录和释义重要提示、本…
#> 7 2016 "平安安银行行股份份有限公公司年年度度报告告第一节重要提示、目录和释义…
#> 8 2015 "平安银行股份有限公司年年度报告第一节重要提示、目录和释义、本行董事会…
#> 9 2014 "平安银行股份有限公司年年度报告第一节重要提示、目录和释义、本行董事会…
#> 10 2013 "平安银行股份有限公司年年度报告--第一节重要提示、目录和释义、本行董事…
#> 11 2012 "第一节重要提示、目录和释义、本行董事会、监事会及董事、监事、高级管理…
#> 12 2011 "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二节公司基本情…
#> 13 2010 "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二节公司基本情…
#> 14 2009 "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二节公司基本情…
#> 15 2008 "深圳发展银行股份有限公司年年度报告目录第一节重要提示第二节公司基本情…
使用 unnest_tokens() 进行分词：
library(tidytext)
segmentlist <- function(x, ...) {
lapply(x, segment, jiebar = engine_s, ...)
}
textdf %>%
unnest_tokens(output = word, input = text,
token = segmentlist) -> worddf
worddf
#> # A tibble: 681,717 × 2
#> year word
#> <dbl> <chr>
#> 1 2022 平安
#> 2 2022 银行
#> 3 2022 股份
#> 4 2022 年度报告
#> 5 2022 平安
#> 6 2022 银行
#> 7 2022 股份
#> 8 2022 提示
#> 9 2022 年度报告
#> 10 2022 提示
#> # ℹ 681,707 more rows
# 统计词频
worddf %>%
count(year, word, sort = T) -> worddf2
worddf2
#> # A tibble: 71,427 × 3
#> year word n
#> <dbl> <chr> <int>
#> 1 2009 公司 828
#> 2 2008 公司 791
#> 3 2010 公司 765
#> 4 2020 平安 735
#> 5 2012 股份 727
#> 6 2020 银行 708
#> 7 2021 平安 699
#> 8 2022 银行 688
#> 9 2021 银行 687
#> 10 2020 资产 682
#> # ℹ 71,417 more rows
词云图经常被用于词频分布的展示。在 R 语言中有非常多绘制词云图的方法，这里我推荐使用 highcharter 包进行绘制。
选择 2022 年词频最大的 300 个词：
worddf2 %>%
filter(year == 2022) %>%
slice(1:300) %>%
select(-year) %>%
set_names(c("name", "weight")) -> worddf2022
然后就可以使用 highcharter 包绘制词云图了，这里的代码是根据 JS 代码改的（官方给出的词云图案例很简单，不过部分图表元素可以参考其他图表进行设置）：
https://www.hcharts.cn/demo/highcharts
library(highcharter)
# 字体需要根据自己的电脑/浏览器设置
myfont <- "SourceHanSerifCNVF-Regular"
highchart(type = "chart") %>%
hc_add_dependency(name = "modules/wordcloud.js") %>%
hc_chart(type = "wordcloud") %>%
hc_add_series(data = worddf2022,
rotation = list(
orientations = 1,
shadow = TRUE
),
name = "word") %>%
hc_tooltip(headerFormat = "",
pointFormat = "<b>{point.name}:</b> {point.weight}",
borderRadius = 5,
style = list(fontFamily = myfont,
fontSize = 14)) %>%
hc_title(text = "2022 年平安银行上市公司年报词频分布",
style = list(fontFamily = myfont,
fontSize = 20)) %>%
hc_subtitle(text = "绘制：微信公众号 RStata",
useHTML = TRUE,
style = list(fontFamily = myfont)) %>%
hc_plotOptions(wordcloud = list(
maxFontSize = 80, minFontSize = 5,
style = list(fontFamily = myfont)
)) %>%
hc_add_theme(hc_theme_bloom(title = list(align = "center"),
subtitle = list(align = "center"))) %>%
hc_credits(text = "数据来源：2022 年平安银行上市公司年报", enabled = T,
style = list(fontFamily = myfont)) -> p
p
highcharter 绘制出来的是交互式图表。交互式图表可以使用 htmlwidgets::saveWidget() 保存成 html 文件：
p %>%
htmlwidgets::saveWidget("wordcloud.html")
如果想保存成静态图片，可以直接截图；如果想保存成矢量图（例如 pdf 文件），可以使用浏览器的打印功能（参考视频演示）。
直接打印出来的 pdf 可能会有较大的空白边距，可以使用 knitr 包的函数进行裁剪：
knitr::plot_crop("wordcloud.pdf")
另外也可以使用 highcharts 自带的导出功能（右上角有个导出控件）：
p %>%
hc_exporting(enabled = T, filename = "wordclound2",
url = "http://export.hcharts.cn/")
注意这里的导出操作最好在电脑浏览器中进行，不要直接在 RStudio 中操作。
多个交互式图表可以使用 manipulateWidget 进行组合：
library(manipulateWidget)
worddf2 %>%
filter(year == 2021) %>%
slice(1:300) %>%
select(-year) %>%
set_names(c("name", "weight")) -> worddf2021
highchart(type = "chart") %>%
hc_add_dependency(name = "modules/wordcloud.js") %>%
hc_chart(type = "wordcloud") %>%
hc_add_series(data = worddf2021,
rotation = list(
orientations = 1,
shadow = TRUE
),
name = "word") %>%
hc_tooltip(headerFormat = "",
pointFormat = "<b>{point.name}:</b> {point.weight}",
borderRadius = 5,
style = list(fontFamily = myfont,
fontSize = 14)) %>%
hc_title(text = "2021 年平安银行上市公司年报词频分布",
style = list(fontFamily = myfont,
fontSize = 20)) %>%
hc_subtitle(text = "绘制：微信公众号 RStata",
useHTML = TRUE,
style = list(fontFamily = myfont)) %>%
hc_plotOptions(wordcloud = list(
maxFontSize = 80, minFontSize = 5,
style = list(fontFamily = myfont)
)) %>%
hc_add_theme(hc_theme_bloom(title = list(align = "center"),
subtitle = list(align = "center"))) %>%
hc_credits(text = "数据来源：2022 年平安银行上市公司年报", enabled = T,
style = list(fontFamily = myfont)) -> p2
combineWidgets(p, p2, nrow = 1)
保存方法也类似。
直播信息
为了让大家更好的理解上面的内容，欢迎各位培训班会员参加明晚 8 点的直播课 「上市公司年报批量爬取、文本提取分词、词频统计与词云图绘制」
直播地址：腾讯会议(需要报名 RStata 培训班参加) 讲义材料：需要报名 RStata 培训班，详情可阅读：一起来学习 R 语言和 Stata 啦！学习过程中遇到的问题也可以随时提问！
更多关于 RStata 会员的更多信息可添加微信号 r_stata 咨询：