今天给大家分享使用 R 语言测算上市公司专利碎片化指数的方法。专利碎片化指数用于衡量专利引用知识的分散程度，碎片化越高，越容易导致专利丛林问题。专利所有权的分散意味着用于保护复杂产品不同组件的专利由不同的主体所持有。要制造该产品，就必须从所有不同的专利持有者那里获得这些专利的使用许可。因此，专利所有权的分散可能会阻碍相关专利技术的使用，不同专利所有者之间就整合分散的权利进行谈判也会产生高昂的成本。
附件中的「Strategic Patenting, Patent Portfolio Races, and Patent Thickets」文中提到了两个指标：
看起来这个数据使用全部工商企业的专利数据计算更合适，不过目前还没有这个数据，所以这里我们仅仅根据上市公司专利互引信息计算。
上市公司专利互引信息的处理可以学习之前的课程：
名师讲堂｜使用 Stata 处理上市公司专利互引矩阵及测算上市公司供应链协同创新程度（一）: https://rstata.duanshu.com/#/brief/course/e58dd2c837c443469d65cf37c26d8b39
Ziedonis(2004) Ziedonis(2004) 的方法是分别计算两个变量：
NBCITESi：企业 i 引用其他企业专利的总次数；
NBCITESij：企业 i 引用企业 j 专利的总次数。
不过在计算这两个变量之前，我们需要做一些预处理：
删除自引的专利；
删除撤销的专利；
删除最终未被授权的专利。
由于我们的专利数据里面包含重复专利，也就是申请和公告同时存在的。这些重复的也要删除。
由于前述课程里面处理得到的「上市公司之间专利互引信息.dta」数据里面没有包含授权信息，所以我们还需要补充一份专利的授权信息：
library( tidyverse) read_csv( "/Volumes/ADT/常用大数据/1985~2024年上市公司与专利数据匹配结果.csv" ) -> patent_data patent_data %>% filter( ! is.na ( 授权公告日) ) -> patent_data patent_data %>% select( newipzlid) %>% distinct( ) -> patent_list patent_list
#> # A tibble: 1,975,083 × 1 #> newipzlid #> <dbl> #> 1 19850031 #> 2 19850705 #> 3 19850975 #> 4 19852578 #> 5 19853984 #> 6 19853985 #> 7 19854106 #> 8 19854608 #> 9 19855735 #> 10 19855840 #> # ℹ 1,975,073 more rows
patent_list %>% write_csv( "授权专利列表.csv" )
「1985~2024年上市公司与专利数据匹配结果.csv」数据来源于这个数据分享：
1985~2024 年上市公司与专利数据匹配结果（版本3， 含申请、授权信息）：https://rstata.duanshu.com/#/brief/course/04100321f88b411f90429be934934bff
由于数据非常大，就没有放到附件中。
然后按照上面所说的，进行一些删除：
# 此处代码需要下载讲义材料查看～ citation_data
#> # A tibble: 238,973 × 9 #> 股票代码_被引专利 股票代码_原专利 newipzlid_原专利 newipzlid_被引专利 #> <chr> <chr> <dbl> <dbl> #> 1 000709 600808 199612501 19855840 #> 2 600740 600569 199743295 199240808 #> 3 600005 600019 199837832 199105070 #> 4 000709 600019 199872317 199306484 #> 5 600005 600019 199911653 199454543 #> 6 002312 002587 199963159 199716639 #> 7 000521 000921 2000071352 199903262 #> 8 200521 000921 2000071352 199903262 #> 9 000866 600028 2000122264 199511743 #> 10 900947 600320 2001053155 2001053154 #> # ℹ 238,963 more rows #> # ℹ 5 more variables: IPC_被引专利 <chr>, IPC_原专利 <chr>, #> # IPC_被引证专利 <chr>, 公开公告号_被引专利 <chr>, 公开公告号_原专利 <chr>
计算企业间的引用次数：
# 此处代码需要下载讲义材料查看～ tempdata1
#> # A tibble: 81,403 × 5 #> year 股票代码_原专利 股票代码_被引专利 NBCITESij NBCITESi #> <dbl> <chr> <chr> <int> <int> #> 1 1996 600808 000709 1 1 #> 2 1997 600569 600740 1 1 #> 3 1998 600019 000709 1 2 #> 4 1998 600019 600005 1 2 #> 5 1999 002587 002312 1 1 #> 6 1999 600019 600005 1 1 #> 7 2000 000921 000521 1 2 #> 8 2000 000921 200521 1 2 #> 9 2000 600028 000866 1 1 #> 10 2001 000527 000651 1 1 #> # ℹ 81,393 more rows
# 保存中间结果 write_rds(tempdata1, "tempdata1.rds")
这里计算出来的结果就是 NBCITESij，分公司求和就可以得到 NBCITESi。
Ziedonis (2004) 的方法类似赫芬达尔指数的计算：
tempdata1 %>% mutate( Frag_sq = ( NBCITESij / NBCITESi) ^ 2 ) %>% group_by( year, 股票代码_原专利) %>% summarise( Frag = 1 - sum ( Frag_sq) , .groups = "drop" ) %>% arrange( year, 股票代码_原专利) %>% rename( 年份 = year, 股票代码 = 股票代码_原专利) -> data1 data1
#> # A tibble: 19,270 × 3 #> 年份 股票代码 Frag #> <dbl> <chr> <dbl> #> 1 1996 600808 0 #> 2 1997 600569 0 #> 3 1998 600019 0.5 #> 4 1999 002587 0 #> 5 1999 600019 0 #> 6 2000 000921 0.5 #> 7 2000 600028 0 #> 8 2001 000527 0 #> 9 2001 000651 0 #> 10 2001 600320 0 #> # ℹ 19,260 more rows
Noel and Schankerman (2013) Noel and Schankerman (2013) 则是仅保留前四大专利持有企业所占的份额，并且没有平方：
tempdata1 %>% arrange( 股票代码_被引专利, 股票代码_原专利, year) %>% group_by( 股票代码_被引专利, 股票代码_原专利) %>% mutate( NBCITESij_cum = cumsum ( NBCITESij) ) %>% ungroup( ) %>% arrange( 股票代码_原专利, year) %>% group_by( 股票代码_原专利) %>% mutate( NBCITESi_cum = cumsum ( NBCITESi) ) %>% ungroup( ) %>% arrange( 股票代码_被引专利, 股票代码_原专利, year) %>% mutate( Fragcite = NBCITESij_cum / NBCITESi_cum) -> tempdata2 tempdata2
#> # A tibble: 81,403 × 8 #> year 股票代码_原专利 股票代码_被引专利 NBCITESij NBCITESi NBCITESij_cum #> <dbl> <chr> <chr> <int> <int> <int> #> 1 2021 002657 000001 1 4 1 #> 2 2019 300188 000001 1 21 1 #> 3 2019 300628 000001 1 15 1 #> 4 2019 300872 000001 1 8 1 #> 5 2021 600036 000001 1 6 1 #> 6 2022 600050 000001 1 139 1 #> 7 2023 600570 000001 1 12 1 #> 8 2019 601288 000001 1 15 1 #> 9 2020 601398 000001 1 208 1 #> 10 2021 601398 000001 1 169 2 #> # ℹ 81,393 more rows #> # ℹ 2 more variables: NBCITESi_cum <int>, Fragcite <dbl>
#> # A tibble: 19,270 × 3 #> 年份 股票代码 Fragcite #> <dbl> <chr> <dbl> #> 1 1996 600808 0 #> 2 1997 600569 0 #> 3 1998 600019 0.25 #> 4 1999 002587 0 #> 5 1999 600019 0.6 #> 6 2000 000921 0.25 #> 7 2000 600028 0 #> 8 2001 000527 0 #> 9 2001 000651 0 #> 10 2001 600320 0 #> # ℹ 19,260 more rows
合并两个结果 最后合并两个结果：
combined_data <- data1 %>% full_join( data2, by = c ( "年份" , "股票代码" ) ) combined_data
#> # A tibble: 19,270 × 4 #> 年份 股票代码 Frag Fragcite #> <dbl> <chr> <dbl> <dbl> #> 1 1996 600808 0 0 #> 2 1997 600569 0 0 #> 3 1998 600019 0.5 0.25 #> 4 1999 002587 0 0 #> 5 1999 600019 0 0.6 #> 6 2000 000921 0.5 0.25 #> 7 2000 600028 0 0 #> 8 2001 000527 0 0 #> 9 2001 000651 0 0 #> 10 2001 600320 0 0 #> # ℹ 19,260 more rows
library( ggplot2) ggplot( combined_data, aes( x = Fragcite, y = Frag) ) + geom_point( alpha = 0.8 , color = "gray" , shape = 10 ) + geom_abline( slope = 1 , intercept = 0 , color = "blue" , linetype = "dashed" ) + labs( title = "两种碎片化测度的关系" , subtitle = "数据计算 & 处理：微信公众号 RStata" , y = "Ziedonis (2004)" , x = "Noel and Schankerman (2013)" ) -> p ggsave( "两种碎片化测度的关系.png" , width = 10 , height = 7 , device = png)
相关性还是挺强的：
点击这里跳转到 RStata 短书平台获取附件：名师讲堂｜使用 R 语言测算上市公司专利碎片化指数：专利所有权分散与专利丛林
评论