今天给大家分享使用 R 语言计算专利颠覆性创新指数及筛选颠覆性专利的方法。
不过需要注意，直接对每个专利计算和之前年份（即使是 3 年内的）所有专利的相似度是非常非常耗时的，建议还是限定在某个领域内，例如只计算该专利与自己所在的部、大类、小类的。
1. 指标来源与计算方法
参照冉征、刘修岩、陈露（2025）发表于《中国工业经济》2025 年第 10 期的论文《技术集群结构与颠覆式创新——兼论关联性”陷阱”的突破路径》，本文基于 Kelly et al.（2021）设计的文本相似度法，通过专利文本的前后对比测度每项专利的颠覆性指标。
1.1 核心思想
颠覆式创新聚焦突破原有技术模式，形成全新的生产和价值创造模式，即一方面突破已有技术的限制，另一方面对后续的创新活动产生深远影响（Kerr, 2010）。基于这一内涵，一项专利如果：
- 与此前的专利关联性较小（新颖性高）
- 与此后的专利关联性较大（影响力大）
则说明该项专利突破了已有技术的框架，形成了新的技术模式，具有更强的颠覆性。
1.2 计算步骤
1.3 两种计算方案
1.4 颠覆性专利筛选
考虑到 radical 指数是连续指标且可以跨时期对比，按照论文方法设置前 5% 作为颠覆式创新的识别区间，即全样本中颠覆性指数位于前 5% 的专利定义为颠覆式创新专利。
2. 数据读取与预处理
加载相关 R 包：
required_packages <- c(
"tidyverse",
"tidytext",
"jiebaR",
"text2vec",
"Matrix",
"haven",
"progress"
)
for (pkg in required_packages) {
if (!requireNamespace(pkg, quietly = TRUE)) {
install.packages(pkg, repos = "https://cloud.r-project.org")
}
}
library(tidyverse)
library(tidytext)
library(jiebaR)
library(Matrix)
library(haven)
|
首先读取专利数据样本文件夹中的所有 CSV 文件。专利数据包含如下变量：newipzlid（专利 ID，前 4 位为年份）、标题、摘要、公开公告号、申请号。
data_dir <- "专利数据样本"
csv_files <- list.files(data_dir, pattern = "\\.csv$", full.names = TRUE)
cat("\n===== 读取专利数据 =====\n")
df_raw <- csv_files %>%
map_dfr(~ read_csv(.x, show_col_types = FALSE, locale = locale(encoding = "UTF-8")))
cat(sprintf("原始数据总行数: %d\n", nrow(df_raw)))
|
2.1 提取年份
从 newipzlid 的前 4 位提取专利申请年份：
df <- df_raw %>%
mutate(年份 = as.integer(str_sub(as.character(newipzlid), 1, 4)))
cat(sprintf("年份范围: %d - %d\n", min(df$年份), max(df$年份)))
|
2.2 专利去重
专利数据中可能存在重复专利，需要按年份和申请号进行去重。先去重公开公告号（去掉末尾的类型标识字母），再去重申请号：
cat("\n===== 专利去重 =====\n")
cat(sprintf("去重前: %d 行\n", nrow(df)))
df <- df %>%
mutate(
公开公告号_clean = str_replace(公开公告号, "[A-Z]$", "")
) %>%
distinct(年份, 公开公告号_clean, .keep_all = TRUE) %>%
select(-公开公告号_clean)
df <- df %>%
distinct(年份, 申请号, .keep_all = TRUE)
cat(sprintf("去重后: %d 行\n", nrow(df)))
df
|
2.3 文本清洗
合并专利的标题和摘要作为完整文本，去除标点、数字、英文及多余空格：
此处代码需下载讲义材料查看～
df
#> # A tibble: 10,993 × 8
#> newipzlid 标题 摘要 公开公告号 申请号 年份 text_raw text_clean
#> <dbl> <chr> <chr> <chr> <chr> <int> <chr> <chr>
#> 1 2000090933 听诊器头 省略其它… CN3204328D CN003… 2000 听诊器头 省略… 听诊器头 省略其它…
#> 2 2000034715 棚舍暖风炉 一种棚舍… CN2422585Y CN002… 2000 棚舍暖风炉 一… 棚舍暖风炉 一种棚…
#> 3 2000062767 麻将棋盘 省略其它… CN3192088D CN003… 2000 麻将棋盘 省略… 麻将棋盘 省略其它…
#> 4 2000024941 一种表面条纹陶瓷砖的成型工艺…… 一种表面… CN1281777A CN001… 2000 一种表面条纹陶… 一种表面条纹陶瓷砖…
#> 5 2000014255 温室大棚骨架 本实用新… CN2409766Y CN002… 2000 温室大棚骨架 … 温室大棚骨架 本实…
#> 6 2000039857 卫生间用排污管道 一种卫生… CN2425141Y CN002… 2000 卫生间用排污管… 卫生间用排污管道 …
#> 7 2000027011 钉书机结构改良 本实用新… CN2418002Y CN002… 2000 钉书机结构改良… 钉书机结构改良 本…
#> 8 2000087646 纯氧烟 一种保健… CN2450912Y CN002… 2000 纯氧烟 一种保… 纯氧烟 一种保健型…
#> 9 2000073315 一种加工微孔金属板的方法和产品… 一种加工… CN1307957A CN001… 2000 一种加工微孔金… 一种加工微孔金属板…
#> 10 2000006162 阀门(塑料) <NA> CN3164174D CN003… 2000 阀门(塑料) … 阀门 塑料
#> # ℹ 10,983 more rows
|
2.4 中文分词
使用 jiebaR 进行中文分词，过滤长度小于 2 的词和非中文字符：
此处代码需下载讲义材料查看～
3. 辅助函数：TF-IDF 矩阵与颠覆性指数
3.1 构建时变 TF-IDF 矩阵
根据目标年份的 ±τ 窗口筛选专利，展开词条为 tidy 格式，计算 TF-IDF 权重，构建稀疏文档-词项矩阵（DTM），并进行 L2 归一化——使得归一化后的余弦相似度等于向量点积：
build_tfidf_matrix <- function(df, year_range) {
corpus <- df %>% filter(年份 %in% year_range)
tidy_corpus <- corpus %>%
select(newipzlid, words) %>%
unnest(words) %>%
rename(word = words) %>%
count(newipzlid, word, name = "n")
tidy_corpus <- tidy_corpus %>%
bind_tf_idf(word, newipzlid, n)
dtm <- tidy_corpus %>%
cast_sparse(newipzlid, word, tf_idf)
row_norms <- sqrt(rowSums(dtm^2) + 1e-10)
dtm_norm <- dtm / row_norms
return(dtm_norm)
}
|
3.2 计算颠覆性指数
对每一年，确定前后窗口内的专利索引，计算后向相似度（BPS）和前向相似度（FPS），并同时输出两种方案的 radical 指数。其中求和法是论文中使用的：
此处代码需下载讲义材料查看～
4. 逐年计算颠覆性指数
设定计算窗口 τ=3 年，对 2003～2007 年逐年计算颠覆性指数：
此处代码需下载讲义材料查看～
5. 汇总结果与筛选颠覆性专利
5.1 标记颠覆性专利
在全样本期内，将颠覆性指数位于前 5% 的专利定义为颠覆式创新，分别对两种方案计算阈值并标记：
df_radical <- bind_rows(all_results)
threshold_sum <- quantile(df_radical$radical_sum, probs = 0.95, na.rm = TRUE)
threshold_avg <- quantile(df_radical$radical_avg, probs = 0.95, na.rm = TRUE)
cat(sprintf("\n===== 颠覆性创新阈值（top 5%%）=====\n"))
cat(sprintf(" 方案一（求和法）: radical_sum >= %.4f\n", threshold_sum))
cat(sprintf(" 方案二（均值法）: radical_avg >= %.4f\n", threshold_avg))
df_radical <- df_radical %>%
mutate(
颠覆性_sum = ifelse(!is.na(radical_sum) & radical_sum >= threshold_sum, 1, 0),
颠覆性_avg = ifelse(!is.na(radical_avg) & radical_avg >= threshold_avg, 1, 0)
)
|
5.2 合并原始专利信息
df <- df %>% mutate(newipzlid = as.character(newipzlid))
df_radical <- df_radical %>% mutate(newipzlid = as.character(newipzlid))
df_final <- df %>%
select(newipzlid, 年份, 标题, 摘要, 公开公告号, 申请号) %>%
left_join(df_radical, by = c("newipzlid", "年份"))
|
6. 结果展示
6.1 总体描述
cat("\n===== 结果摘要 =====\n")
cat(sprintf("目标年份: %d - %d\n", min(target_years), max(target_years)))
cat(sprintf("总专利数（去重后，含窗口期）: %d\n", nrow(df)))
cat(sprintf("计算了 radical 指数的专利数: %d\n", sum(!is.na(df_final$radical_avg))))
|
6.2 各年颠覆性专利分布（方案一：求和法）
此处代码需下载讲义材料查看～
6.3 各年颠覆性专利分布（方案二：均值法）
cat("\n--- 各年颠覆性专利分布（方案二：均值法）---\n")
df_final %>%
filter(年份 %in% target_years) %>%
group_by(年份) %>%
summarise(
总专利数 = n(),
有效radical = sum(!is.na(radical_avg)),
颠覆性专利数 = sum(颠覆性_avg, na.rm = TRUE),
颠覆性占比 = round(mean(颠覆性_avg, na.rm = TRUE) * 100, 2),
radical均值 = round(mean(radical_avg, na.rm = TRUE), 4),
radical中位数 = round(median(radical_avg, na.rm = TRUE), 4),
.groups = "drop"
) %>%
knitr::kable(caption = "方案二：均值法")
|
6.4 两种方案一致性比较
cat("\n--- 两种方案一致性比较 ---\n")
df_target <- df_final %>% filter(年份 %in% target_years)
both <- sum(df_target$颠覆性_sum == 1 & df_target$颠覆性_avg == 1, na.rm = TRUE)
only_sum <- sum(df_target$颠覆性_sum == 1 & df_target$颠覆性_avg == 0, na.rm = TRUE)
only_avg <- sum(df_target$颠覆性_sum == 0 & df_target$颠覆性_avg == 1, na.rm = TRUE)
cat(sprintf(" 两种方案均标记为颠覆性: %d\n", both))
cat(sprintf(" 仅求和法标记: %d\n", only_sum))
cat(sprintf(" 仅均值法标记: %d\n", only_avg))
cat(sprintf(" 一致率: %.1f%%\n", both / (both + only_sum + only_avg) * 100))
|
7. 保存结果
将计算结果保存为 Stata 格式（.dta）：
output_file <- "patent_disruptive_index.dta"
df_output <- df_final %>%
select(newipzlid, 年份, 标题, 摘要, 公开公告号, 申请号,
BPS_sum, FPS_sum, radical_sum, 颠覆性_sum,
BPS_avg, FPS_avg, radical_avg, 颠覆性_avg)
df_output <- df_output %>%
mutate(across(where(is.numeric), as.numeric)) %>%
mutate(across(c(颠覆性_sum, 颠覆性_avg), as.integer))
write_dta(df_output, output_file, label = "数据处理:微信公众号 RStata")
|
7.1 目标年份子集（2003～2007）
由于 3 年窗口期的选择，实际上只有 2003～2007 年是有数据的：
df_target <- df_output %>%
filter(年份 %in% target_years)
df_target
|
#> # A tibble: 4,995 × 14
#> newipzlid 年份 标题 摘要 公开公告号 申请号 BPS_sum FPS_sum radical_sum
#> <chr> <dbl> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl>
#> 1 2003069124 2003 拉丝铝塑复合板… 该产品为… CN3364938D CN033… 32.8 44.8 1.37
#> 2 2003195916 2003 软轴式工程污水… 本实用新… CN2663694Y CN200… 16.3 16.1 0.988
#> 3 2003171135 2003 一体化井下工具… 一种一体… CN2687325Y CN200… 8.88 8.05 0.907
#> 4 2003064947 2003 MP3数字网络… <NA> CN3362831D CN200… 3.71 4.98 1.34
#> 5 2003047227 2003 标贴(LILY… 主视图中… CN3353888D CN033… 21.2 18.0 0.847
#> 6 2003088533 2003 输卵管再通器械… 本实用新… CN2623179Y CN032… 10.7 12.2 1.14
#> 7 2003162795 2003 蓄能式冷干机蓄… 本发明蓄… CN1202198C CN031… 3.18 4.08 1.28
#> 8 2003057925 2003 转轴结构的改良… 本实用新… CN2608643Y CN032… 11.6 13.3 1.15
#> 9 2003032767 2003 新型管夹件…… 本实用新… CN2597802Y CN032… 10.7 10.8 1.01
#> 10 2003189845 2003 阴角及阳角浇注… 一种阴角… CN1182311C CN031… 6.38 7.32 1.15
#> # ℹ 4,985 more rows
#> # ℹ 5 more variables: 颠覆性_sum <int>, BPS_avg <dbl>, FPS_avg <dbl>,
#> # radical_avg <dbl>, 颠覆性_avg <int>
|
target_output <- "patent_disruptive_index_2003_2007.dta"
write_dta(df_target, target_output, label = "数据处理:微信公众号 RStata")
|
点击这里跳转到 RStata 短书平台获取附件：名师讲堂｜使用 R 语言计算专利颠覆性创新指数及筛选颠覆性专利
评论