「经济研究」2023 年 6 月刊里面有篇论文 <国内贸易网络、地理距离和供应商本地化>中使用了上市公司数字赋能指数的数据来反映上市公司数字技术的应用程度。该指标的计算方法如下：
其中 D 表示数字赋能指标词典集合，包括如下词语：AI技术、人工智能、计算机技术、信息技术、智能化、自动化、神经网络、虚拟现实、数据科学、数据挖掘、数字化、信息化战略、信息化、生物识别、人脸识别、机器学习、深度学习、自然语言处理、图像识别、语音识别、云计算、云平台、云安全、物联网、大数据（最后一个大数据是我自己加的，感觉不能少了这个）。
TF 表示术语频率或者说词频，IDF 表示逆文档频率指数。TF-IDF 分析在我们的系列课程「R 语言文本分析」(平台链接：https://rstata.duanshu.com/#/brief/course/bf37cf50eef04d38b43541cc52114c96 )中讲解过。
TF-IDF 的主要思想是：如果某个词或短语（term）在一篇文章中出现的频率高（TF 高），并且在其他文章中很少出现，则认为此词或者短语具有很好的类别区分能力，适合用来分类。例如一篇文档的总术语数是 100 ，而词汇 “母牛” 出现了 3 次，那么“母牛”一词在该文档中的词频就是 3/100 = 0.03。计算文件频率 (IDF) 的方法是文件集里包含的文件总数除以测定有多少份文件出现过“母牛”一词。所以，如果“母牛”一词在 1000 份文档出现过，而文件总数是 10000000 份的话，其逆向文件频率就是 ln(10 000000 / 1000) = 4。最后的 tf-idf 的分数为 0.03 x 4 = 0.12。
本课程中我们讲讲解如何爬取上市公司年报文件、pdf 文本提取、中文文本分析以及 TF-IDF 分析。
一家上市公司年报爬取 上市公司年报可以从巨潮资讯网搜索和下载：http://www.cninfo.com.cn/new/commonUrl/pageOfSearch?url=disclosure/list/search
首先获取所有的 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=F54CF9328287E65080CD42475D1D0B23; insert_cookie=37836164; routeId=.uc2; _sp_ses.2141=*; _sp_id.2141=b13ee9ff-2493-4f42-a7f5-089a2990e863.1694410049.5.1694427697.1694423114.e98c8005-d826-47b7-8bf0-e994e4d09f2f' \ -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/116.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=2020-09-11~2023-09-12&sortName=&sortType=&isHLtitle=true' \ --compressed \ --insecure
然后可以使用这个网站把上面的 curl 语句转换成 R 语言：https://curlconverter.com/r/ ，还可以试着改改其中的一些参数，下面是转换得到的 R 代码：
library( tidyverse) require( httr) cookies = c ( `JSESSIONID` = "F54CF9328287E65080CD42475D1D0B23" , `insert_cookie` = "37836164" , `routeId` = ".uc2" , `_sp_ses.2141` = "*" , `_sp_id.2141` = "b13ee9ff-2493-4f42-a7f5-089a2990e863.1694410049.5.1694427697.1694423114.e98c8005-d826-47b7-8bf0-e994e4d09f2f" ) headers = c ( `Accept` = "*/*" , `Accept-Language` = "zh-CN,zh;q=0.9,en;q=0.8" , `Connection` = "keep-alive" , `Content-Type` = "application/x-www-form-urlencoded; charset=UTF-8" , `Origin` = "http://www.cninfo.com.cn" , `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/116.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` = "2020-09-11~2023-09-12" , `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 ) )
我们可以试试把 seDate 修改成 “2000-01-01~2023-09-11”（pageSize 也可以试试修改成 100，不过没什么效果）：
data = list ( `pageNum` = "1" , `pageSize` = "30" , `column` = "szse" , `tabName` = "fulltext" , `plate` = "" , `stock` = "000002,gssz0000002" , `searchkey` = "" , `secid` = "" , `category` = "category_ndbg_szsh" , `trade` = "" , `seDate` = "2000-01-01~2023-09-11" , `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
这样就得到了第一页的结果，类似的方法再获取第二页的：
data = list ( `pageNum` = "2" , `pageSize` = "30" , `column` = "szse" , `tabName` = "fulltext" , `plate` = "" , `stock` = "000002,gssz0000002" , `searchkey` = "" , `secid` = "" , `category` = "category_ndbg_szsh" , `trade` = "" , `seDate` = "2000-01-01~2023-09-11" , `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) ) -> df2 df2
看起来应该没有第三页了，合并 df1 和 df2：
bind_rows( df1, df2) %>% filter( ! str_detect( announcementTitle, "英文" ) ) %>% filter( ! str_detect( announcementTitle, "补充公告" ) ) %>% filter( ! announcementTitle %in% c ( "2015年年度报告" , "2006年年度报告" ) ) -> df
然后就可以下载 pdf 文件了：
dir.create("pdf") lapply(df$adjunctUrl, function(x){ if(!file.exists(paste0("pdf/", basename(x)))) { try({ download.file(x, paste0("pdf/", basename(x)), mode = "wb") }) } }) -> res
多家上市公司年报的爬取 所有可选的公司可以从这里看到：http://www.cninfo.com.cn/new/data/szse_stock.json ，是个 json 文件：
library( jsonlite) fromJSON( "http://www.cninfo.com.cn/new/data/szse_stock.json" ) -> lst lst$ stockList %>% as_tibble( ) %>% mutate( stext = paste0( code, "," , orgId) ) -> codelist codelist
这里我们演示前 5 家公司的年报爬取：
lapply( 1 : 5 , function ( i) { print( codelist$ zwjc[ i] ) lapply( 1 : 3 , function ( x) { data = list ( `pageNum` = x, `pageSize` = "30" , `column` = "szse" , `tabName` = "fulltext" , `plate` = "" , `stock` = codelist$ stext[ i] , `searchkey` = "" , `secid` = "" , `category` = "category_ndbg_szsh" , `trade` = "" , `seDate` = "2000-01-01~2023-09-11" , `sortName` = "" , `sortType` = "" , `isHLtitle` = "true" ) 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( ) -> ls if ( length ( ls$ announcements) > 0 ) { ls$ announcements %>% transpose( ) %>% as_tibble( ) %>% unnest( ) %>% filter( ! str_detect( announcementTitle, "摘要" ) ) %>% select( announcementTitle, adjunctUrl) %>% mutate( adjunctUrl = paste0( "http://static.cninfo.com.cn/" , adjunctUrl) , code = codelist$ code[ i] ) } } ) %>% bind_rows( ) } ) %>% bind_rows( ) -> dfall dfall %>% filter( ! str_detect( announcementTitle, "英文" ) ) %>% filter( ! str_detect( announcementTitle, "补充公告" ) ) %>% rename( title = announcementTitle, url = adjunctUrl) %>% mutate( year = str_extract( title, "\\d{4}" ) ) %>% mutate( title = paste0( code, "_" , year, "_" , title) ) -> dfall dfall
这里的 pdf 文件很多，为了更快的下载，可以使用多线程：
library( parallel) makeCluster( 8 ) -> cl clusterExport( cl, "dfall" ) dir.create( "pdf2" ) parLapply( cl, 1 : nrow( dfall) , function ( x) { if ( ! file.exists( paste0( "pdf2/" , dfall$ title[ x] , ".pdf" ) ) ) { try( { download.file( dfall$ url[ x] , paste0( "pdf2/" , dfall$ title[ x] , ".pdf" ) , mode = "wb" ) } ) } } ) -> res
由于里面还包含了一些不合要求的结果，所以还需要手动删除下。
pdf 文本提取 这里的 pdf 都不是扫描文档，可以使用 pdftools 包进行文本提取，提取单个文件的：
library( pdftools) pdftools:: pdf_text( "pdf2/000006_2022_2022年年度报告.pdf" ) -> text text %>% paste0( collapse = "" ) %>% str_remove_all( "[\\s\\n\\t\\d[a-z].]" ) -> text
中文文本分词可以使用 jiebaR 包，在分词前我们需要准备一个停用词词典和一个用户词典：
library( jiebaR) engine_s <- worker( stop_word = "stopwords.txt" , user = "dictionary.txt" ) segment( text, jiebar = engine_s) %>% as_tibble( ) %>% count( value, sort = T ) -> df df
其中 dictionary.txt 文件放的就是上面数字赋能指标词典。
read_csv( "dictionary.txt" , col_names = F ) -> word df %>% arrange( desc( n) ) %>% dplyr:: filter( value %in% word$ X1)
pdf 文本批量提取 然后我们就可以批量提取所有文件的文本并进行分词了：
fs:: dir_ls( "pdf2" ) %>% 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 textdf %>% mutate( seg = map( text, function ( x) { segment( x, jiebar = engine_s) %>% as_tibble( ) %>% count( value, sort = T ) } ) ) -> textdf2 textdf2 textdf2 %>% select( - text) -> textdf2 textdf2 %>% rename( file = value) %>% unnest( seg) -> textdf3 textdf3
TF-IDF 分析 tidytext 包提供了 TF-IDF 的简便方法：
library( tidytext) textdf3 %>% bind_tf_idf( term = value, document = file, n = n) %>% mutate( file = basename( file) ) %>% tidyr:: extract( col = file, into = c ( "code" , "year" ) , regex = "(.*)_(\\d{4})_" ) %>% filter( value %in% word$ X1) %>% group_by( code, year) %>% summarise( tf_idf = sum ( tf_idf, na.rm = T ) ) %>% ungroup( ) -> textdf4 textdf4 %>% mutate( year = as.numeric ( year) ) -> textdf4 textdf4
这样就得到了每个公司每年的数字赋能指数。
绘图展示 下面我们再使用 ggplot2 绘图展示：
codelist %>% slice( 1 : 5 ) %>% pull( zwjc) %>% paste0( collapse = "、" ) library( ggforce) textdf4 %>% ggplot( aes( year, tf_idf, color = code) ) + geom_point( ) + geom_bspline( linewidth = 1.2 ) + labs( x = "" , y = "数字赋能指数（TF-IDF）" , color = "" , title = "2001～2022 年 5 家上市公司数字技术应用程度指标计算结果（数字赋能指数）" , subtitle = "数据处理&绘图：微信公众号 RStata" , caption = "数据来源：巨潮资讯网<http://www.cninfo.com.cn/>" ) + scale_color_manual( values = c ( "#e64b35" , "#4dbbd5" , "#00a087" , "#3c5488" , "#f39b7f" ) ) + theme( legend.position = "top" , plot.background = element_rect( fill = "white" , color = "white" ) ) + scale_x_continuous( breaks = seq( 2001 , 2022 , by = 2 ) ) -> p ggsave( "pic1.png" , width = 10 , height = 7 , device = png)
点击这里跳转到 RStata 短书平台获取附件：名师讲堂｜使用 R 语言计算上市公司数字赋能指数（数字技术应用程度指标）
评论