今天给大家分享使用 R 语言在 IPC 小类内 计算专利颠覆性创新指数及筛选颠覆性专利的方法。
为什么要限定在 IPC 小类内计算？直接对每个专利计算和之前年份所有专利的相似度非常耗时，而且不同技术领域之间的专利文本相似度本身较低，全样本计算会引入大量噪声。限定在同一 IPC 小类内计算，既能大幅降低计算量，又能使相似度比较更有技术针对性。每个专利可能属于多个 IPC 小类，此时分别在各小类内计算，再取均值聚合到专利级别。
1. 指标来源与计算方法
参照冉征、刘修岩、陈露（2025）发表于《中国工业经济》2025 年第 10 期的论文《技术集群结构与颠覆式创新——兼论关联性”陷阱”的突破路径》，本文基于 Kelly et al.（2021）设计的文本相似度法，通过专利文本的前后对比测度每项专利的颠覆性指标。
1.1 核心思想
颠覆式创新聚焦突破原有技术模式，形成全新的生产和价值创造模式，即一方面突破已有技术的限制，另一方面对后续的创新活动产生深远影响（Kerr, 2010）。基于这一内涵，一项专利如果：
- 与此前的专利关联性较小（新颖性高）
- 与此后的专利关联性较大（影响力大）
则说明该项专利突破了已有技术的框架，形成了新的技术模式，具有更强的颠覆性。
1.2 计算步骤
1.3 IPC 小类内计算的改进
与全样本计算不同，本文将相似度计算限定在同一 IPC 小类内。IPC（International Patent Classification）是国际专利分类系统，其层级结构为：部（1 位字母）→ 大类（2 位数字）→ 小类（1 位字母）→ 大组/小组。例如 F04D13/02 的 IPC 小类为 F04D。
改进思路：
- 提取每个专利的 IPC 小类：取 IPC 代码前 4 位作为小类标识。一个专利可能有多个 IPC 代码，用 ; 分隔。
- 展开为长格式：将一个专利的多个 IPC 小类展开为多行，每行对应一个 (专利, IPC小类) 对。
- 小类内计算：对每个 IPC 小类，在该小类内的专利中构建 TFBIDF 矩阵并计算 BPS/FPS。
- 聚合到专利级别：一个专利有多个 IPC 小类时，取各小类结果的均值作为该专利的最终指标。
1.4 两种计算方案
1.5 颠覆性专利筛选
考虑到 radical 指数是连续指标且可以跨时期对比，按照论文方法设置前 5% 作为颠覆式创新的识别区间，即全样本中颠覆性指数位于前 5% 的专利定义为颠覆式创新专利。
2. 数据读取与预处理
加载相关 R 包：
required_packages <- c(
"tidyverse",
"tidytext",
"jiebaR",
"Matrix",
"haven"
)
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 位为年份）、标题、摘要、公开公告号、申请号、IPC。
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(
newipzlid = as.character(newipzlid),
年份 = as.integer(str_sub(newipzlid, 1, 4))
)
cat(sprintf("年份范围: %d - %d\n", min(df$年份, na.rm = TRUE), max(df$年份, na.rm = TRUE)))
|
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) %>%
distinct(年份, 申请号, .keep_all = TRUE)
cat(sprintf("去重后: %d 行\n", nrow(df)))
|
2.3 文本清洗
合并专利的标题和摘要作为完整文本，去除标点、数字、英文及多余空格：
此处代码需下载讲义材料查看～
2.4 中文分词
使用 jiebaR 进行中文分词，过滤长度小于 2 的词和非中文字符：
此处代码需下载讲义材料查看～
2.5 提取 IPC 小类
IPC 代码格式如 F04D13/02，小类为前 4 位（部 + 大类 + 小类），即 F04D。每个专利可能有多个 IPC，用 ; 分隔，需拆分后提取各小类：
此处代码需下载讲义材料查看～
2.6 展开为 (专利, IPC小类) 长格式
一个专利有多个 IPC 小类时，展开为多行，每行对应一个 (专利, IPC小类) 对：
df_long <- df_words %>%
select(newipzlid, 年份, 标题, 摘要, 公开公告号, 申请号, words, ipc_subclass) %>%
unnest(ipc_subclass) %>%
rename(ipc_sub = ipc_subclass)
cat(sprintf("展开为 (专利, IPC小类) 长格式后: %d 行\n", nrow(df_long)))
cat(sprintf("IPC小类总数: %d\n", n_distinct(df_long$ipc_sub)))
df_long
|
3. 辅助函数：IPC 小类内 TFBIDF 矩阵与颠覆性指数
3.1 在 IPC 小类内构建时变 TF-IDF 矩阵
build_tfidf_by_subclass <- function(df_long, ipc_sub, year_range) {
corpus <- df_long %>%
filter(ipc_sub == .env$ipc_sub, 年份 %in% year_range)
if (nrow(corpus) == 0) return(NULL)
tidy_corpus <- corpus %>%
select(newipzlid, words) %>%
unnest(words) %>%
rename(word = words) %>%
count(newipzlid, word, name = "n")
if (nrow(tidy_corpus) == 0) return(NULL)
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 在 IPC 小类内计算颠覆性指数
对某一年某一 IPC 小类，确定前后窗口内的专利索引，计算后向相似度（BPS）和前向相似度（FPS），并同时输出两种方案所需的总和与均值：
#' 计算某一年在指定 IPC 小类内的颠覆性指数
#' @param df_long (专利, IPC小类) 长格式数据
#' @param ipc_sub IPC 小类代码
#' @param target_year 目标年份
#' @param tau 计算窗口大小（默认 3 年）
#' @return tibble: newipzlid, 年份, ipc_sub, BPS_sum, FPS_sum, BPS_avg, FPS_avg
# 此处代码需下载讲义材料查看～
|
4. 逐年、逐 IPC 小类计算颠覆性指数
target_years <- 2003:2007
tau <- 3
all_subclasses <- df_long %>%
pull(ipc_sub) %>%
unique() %>%
sort()
cat("\n===== 计算颠覆性创新指数（IPC小类内）=====\n")
cat(sprintf("目标年份: %s\n", paste(target_years, collapse = ", ")))
cat(sprintf("计算窗口: tau = %d 年\n", tau))
cat(sprintf("IPC小类总数: %d\n", length(all_subclasses)))
all_results <- list()
for (yr in target_years) {
cat(sprintf("\n--- 正在计算 %d 年 ---\n", yr))
year_results <- map_dfr(all_subclasses, function(sc) {
compute_radical_by_subclass(df_long, sc, yr, tau = tau)
})
cat(sprintf(" 专利-IPC小类对数: %d\n", nrow(year_results)))
cat(sprintf(" 涉及专利数: %d\n", n_distinct(year_results$newipzlid)))
all_results[[as.character(yr)]] <- year_results
}
df_radical_long <- bind_rows(all_results)
cat(sprintf("\n总计 专利-IPC小类对数: %d\n", nrow(df_radical_long)))
|
5. 聚合到专利级别与筛选颠覆性专利
5.1 计算 radical 指数
df_radical_long <- df_radical_long %>%
mutate(
radical_sum = ifelse(BPS_sum > 0, FPS_sum / BPS_sum, NA_real_),
radical_avg = ifelse(BPS_avg > 0, FPS_avg / BPS_avg, NA_real_)
)
|
5.2 聚合到专利级别
一个专利有多个 IPC 小类时，取各 IPC 小类结果的均值作为该专利的最终指标：
# 数据处理：微信公众号 RStata
# 此处代码需下载讲义材料查看～
|
5.3 标记颠覆性专利
在全样本期内，将颠覆性指数位于前 5% 的专利定义为颠覆式创新，分别对两种方案计算阈值并标记：
# 数据处理：微信公众号 RStata
# 此处代码需下载讲义材料查看～
|
5.4 合并原始专利信息
df_final <- df_words %>%
select(newipzlid, 年份, 标题, 摘要, 公开公告号, 申请号) %>%
filter(年份 %in% target_years) %>%
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_words)))
cat(sprintf("目标年份专利数: %d\n", nrow(df_final)))
cat(sprintf("计算了 radical 指数的专利数: %d\n", sum(!is.na(df_final$radical_avg))))
|
6.2 各年颠覆性专利分布（方案一：求和法）
此处代码需下载讲义材料查看～
6.3 各年颠覆性专利分布（方案二：均值法）
cat("\n--- 各年颠覆性专利分布（方案二：均值法）---\n")
df_final %>%
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))
if (both + only_sum + only_avg > 0) {
cat(sprintf(" 一致率: %.1f%%\n", both / (both + only_sum + only_avg) * 100))
}
|
6.5 IPC 小类数量分布
cat("\n--- 专利涉及 IPC 小类数量分布 ---\n")
df_final %>%
filter(!is.na(n_ipc_sub)) %>%
summarise(
均值 = round(mean(n_ipc_sub), 2),
中位数 = median(n_ipc_sub),
最大值 = max(n_ipc_sub),
最小值 = min(n_ipc_sub)
) %>%
knitr::kable(caption = "专利涉及 IPC 小类数量分布")
|
7. 保存结果
将计算结果保存为 Stata 格式（.dta）：
output_file <- "patent_disruptive_index_ipc_subclass.dta"
df_output <- df_final %>%
select(newipzlid, 年份, 标题, 摘要, 公开公告号, 申请号,
BPS_sum, FPS_sum, radical_sum, 颠覆性_sum,
BPS_avg, FPS_avg, radical_avg, 颠覆性_avg, n_ipc_sub) %>%
mutate(across(where(is.numeric), as.numeric)) %>%
mutate(across(c(颠覆性_sum, 颠覆性_avg, n_ipc_sub), as.integer))
write_dta(df_output, output_file, label = "数据处理：微信公众号 RStata")
|
点击这里跳转到 RStata 短书平台获取附件：名师讲堂｜使用 R 语言计算专利颠覆性创新指数及筛选颠覆性专利（同小类内计算）
评论