指标来源与背景

关键核心技术突破（CKTB，Critical and Key Technology Breakthrough）指标体系来源于王海花等（2026）发表于《科学学研究》的论文：《专精特新企业技术专业化与关键核心技术突破》。

该研究以我国前五批上市的专精特新小巨人企业中新一代信息技术产业为研究对象，深入探索技术专业化对关键核心技术突破的作用效应，在实证研究中使用专利数据构建了 CKTB 综合评分指标。

理论依据

关键核心技术具有以下三个核心特征：

特征维度	含义
基础性	技术的科学根基深厚、知识积累丰富，体现研究与开发的深度
体系性	技术在产业体系中的地位，体现与上下游关联的广度与合作
竞争性	技术在国际市场中的差异化竞争力，体现技术覆盖与保护范围

测度指标

基于三大特征维度，论文构建了如下 7 个专利层面指标：

library(knitr)
ind_df <- data.frame(
  特征维度 = c("基础性", "基础性", "基础性",
               "体系性", "体系性",
               "竞争性", "竞争性"),
  测度指标 = c("科学关联度", "技术累积度", "权利要求",
               "社会价值", "合作范围",
               "同族专利", "技术覆盖范围"),
  专利指标 = c("npl（非专利文献引用量）",
               "bwd_cite（引用专利数量）",
               "claims（权利要求数量）",
               "fwd_cite（3年内被引用次数）",
               "assignees（专利权人数量）",
               "family（同族成员数量）",
               "ipc_cover（跨IPC部分类号数量）")
)
kable(ind_df, align = "lll")

指标说明：

非专利文献引用量（npl）：专利引用的科技文献（如学术论文）数量，反映专利的科学知识根基深度
引用专利数量（bwd_cite）：专利引用的在先专利数量（向后引用），体现技术积累程度
权利要求数量（claims）：专利权利要求条款数，条款越多代表技术覆盖越精细
3年内被引次数（fwd_cite）：专利申请后3年内被其他专利引用的次数，体现技术社会价值
专利权人数量（assignees）：联合申请人数量，反映合作创新程度
同族成员数量（family）：在其他国家/地区提交的同族专利数，体现国际竞争布局
IPC覆盖（ipc_cover）：企业当年专利跨越的 IPC 部（section）数量，反映技术领域多样性

熵权法原理

**熵权法（Entropy Weight Method）**是一种客观赋权方法，不依赖专家主观判断，而是根据各指标的信息量来自动决定权重。其核心思想是：

如果某个指标在所有样本中的取值差异很大，说明它包含的信息量多，应给予更高权重；
反之，若某指标的取值在所有样本中基本相同（无差异），则该指标对区分样本无帮助，权重接近 0。

计算步骤

熵权法函数实现

entropy_weight <- function(X) {
  # 参数 X: n × m 矩阵，n=样本数量，m=指标数量
  X <- as.matrix(X)
  X[is.na(X)] <- 0  # 兜底：将NA视为0
  n <- nrow(X)
  m <- ncol(X)

  # Step 1: 极差标准化
  X_min  <- apply(X, 2, min)
  X_max  <- apply(X, 2, max)
  denom  <- X_max - X_min
  denom[denom == 0] <- 1e-10      # 极差为 0 时防止除零
  X_norm <- sweep(X - rep(X_min, each = n), 2, denom, "/")
  X_norm <- X_norm + 1e-10        # 避免 log(0)

  # Step 2: 计算信息熵
  col_sum <- colSums(X_norm)
  P <- sweep(X_norm, 2, col_sum, "/")
  k <- 1 / log(n)                 # 调节系数
  E <- -k * colSums(P * log(P + 1e-10))
  E <- pmin(E, 1)                 # 熵值上限为 1

  # Step 3: 差异系数
  D <- 1 - E

  # Step 4: 权重
  W <- D / sum(D)

  # Step 5: 综合得分
  scores <- as.vector(X_norm %*% W)

  list(scores = scores, weights = W, E = E)
}

数据准备

本讲义使用的数据文件：

文件	说明
`2010~2012年上市公司与专利数据匹配结果_含引用与被引用信息.csv`	主数据：专利-企业匹配，含各类引用信息（约 1 GB）
`1985~2024年各专利当年～十一年内的被自引、被他引数量统计.csv`	被引统计：专利被他引的分年统计（约 979 MB）
`拓展专利信息.csv`	拓展信息：权利要求数量、同族专利（约 1.5 GB）

上市公司数据来自：

1985～2024 年上市公司与专利数据匹配结果（版本3，含申请、授权信息）: https://rstata.duanshu.com/#/brief/course/04100321f88b411f90429be934934bff

被自引、被他引数量统计数据来自：

1985~2024 年各专利当年～十一年内的被自引、被他引数量统计: https://rstata.duanshu.com/#/brief/course/51e62d1eae074a4d8174a3969f5025c6

拓展专利信息.csv 是我又从原始专利数据提取补充的一些变量：

1985～2024 年专利申请与授权数据（版本 3，含申请人所处的省市区县）: https://rstata.duanshu.com/#/brief/course/2397451274c546d3a36e156ffc865988

library(dplyr)
library(readr)
library(stringr)
library(knitr)

# 设置文件路径（请根据实际情况修改）
PATH_MATCH  <- "2010~2012年上市公司与专利数据匹配结果_含引用与被引用信息.csv"
PATH_CITE   <- "1985~2024年各专利当年～十一年内的被自引、被他引数量统计.csv"
PATH_EXTEND <- "拓展专利信息.csv"

单公司演示：以凯莱英（002821）2012 年为例

为了清晰演示 CKTB 的计算过程，我们以凯莱英（股票代码：002821）2012 年的数据为例，逐步演示每个步骤。凯莱英是一家以化学合成和医药研发为核心的创新型企业，2012 年共申请了 23 件专利，样本量适中，演示效果清晰。

演示时使用 n_max = 300000 读取前 30 万行数据（凯莱英记录最远至第 295539 行），确保能完整捕获该公司所有专利。全量计算见下一节。

第一步：读取主数据

# 读取前 300000 行（演示用，覆盖凯莱英全部记录）
df_main_raw <- read_csv(
  PATH_MATCH,
  n_max = 300000,
  col_select = c("股票代码", "股票名称", "newipzlid", "年份",
                 "引证科技文献", "引证专利", "当前权利人",
                 "IPC", "公开公告号", "申请号"),
  show_col_types = FALSE
)

df_main_raw <- df_main_raw %>%
  rename(
    firm_id    = "股票代码",
    patent_id  = "newipzlid",
    apply_year = "年份"
  )

cat(sprintf("读取完成：%d 条专利记录（演示用 30 万行）\n", nrow(df_main_raw)))
cat(sprintf("涉及企业数：%d 家，年份：%s\n",
            n_distinct(df_main_raw$firm_id),
            paste(sort(unique(df_main_raw$apply_year)), collapse = "、")))

第二步：专利去重

同一专利可能因为多源数据拼接而产生重复记录，需要去重。策略：优先保留在被引用统计表中出现的专利（因为该专利有更完整的引用信息）。

# 读取被引用统计中的专利 ID 集合（用于去重时优先保留）
cite_ids <- read_csv(
  PATH_CITE,
  col_select = "newipzlid",
  n_max = 200000,
  show_col_types = FALSE
) %>%
  distinct(newipzlid) %>%
  pull(newipzlid)

cat(sprintf("被引用统计中的专利数（前 20 万行去重后）：%d\n", length(cite_ids)))

# 打标：是否在被引用统计表中出现
df_main_raw <- df_main_raw %>%
  mutate(
    in_cite          = patent_id %in% cite_ids,
    公开公告号_clean = str_replace(公开公告号, "[A-Z]$", "")
  )

# 去重函数：优先保留 in_cite=TRUE 的记录
dedup_keep_cite <- function(df, group_vars) {
  df %>%
    arrange(firm_id, apply_year, desc(in_cite)) %>%
    distinct(across(all_of(group_vars)), .keep_all = TRUE)
}

df_main <- df_main_raw %>%
  dedup_keep_cite(c("firm_id", "apply_year", "公开公告号_clean")) %>%
  dedup_keep_cite(c("firm_id", "apply_year", "申请号"))

cat(sprintf("去重前：%d 条 → 去重后：%d 条\n", nrow(df_main_raw), nrow(df_main)))

# 筛选凯莱英 2012 年的数据
df_demo <- df_main %>%
  filter(firm_id == "002821", apply_year == 2012)

cat(sprintf("凯莱英（002821）2012 年专利数：%d 条\n", nrow(df_demo)))

第三步：读取拓展信息并合并

df_extend <- read_csv(
  PATH_EXTEND,
  col_select = c("newipzlid", "权利要求数量", "扩展同族"),
  n_max = 200000,
  show_col_types = FALSE
) %>%
  rename(
    patent_id  = newipzlid,
    claims_ext = 权利要求数量
  )

df_demo <- df_demo %>%
  left_join(df_extend, by = "patent_id")

cat(sprintf("拓展信息合并后：%d 条记录\n", nrow(df_demo)))

第四步：提取专利层面 CKTB 指标

此处代码需下载讲义材料查看～

各指标描述性统计：

df_demo %>%
  summarise(
    across(c(npl, bwd_cite, claims, assignees, family, ipc_cover),
           list(最小值 = min, 均值 = ~round(mean(.), 2), 最大值 = max))
  ) %>%
  tidyr::pivot_longer(everything(), names_to = "指标_统计量", values_to = "值") %>%
  tidyr::separate("指标_统计量", into = c("指标", "统计量"), sep = "_(?=[^_]+$)") %>%
  tidyr::pivot_wider(names_from = 统计量, values_from = 值) %>%
  kable(caption = "凯莱英 2012 年各指标统计")

第五步：合并 3 年内被引次数

df_cite_sample <- read_csv(
  PATH_CITE,
  n_max = 200000,
  show_col_types = FALSE
)

df_fwd_demo <- df_cite_sample %>%
  filter(引用或被引用 == "被他引信息") %>%
  select(patent_id = newipzlid, cite_year = year, fwd_cite = "三年内") %>%
  mutate(fwd_cite = coalesce(fwd_cite, 0L))

df_demo <- df_demo %>%
  left_join(df_fwd_demo, by = c("patent_id", "apply_year" = "cite_year")) %>%
  mutate(fwd_cite = coalesce(fwd_cite, 0L))

cat(sprintf("fwd_cite — 均值: %.2f，最大值: %.0f\n",
            mean(df_demo$fwd_cite), max(df_demo$fwd_cite)))

第六步：运行熵权法

此处代码需下载讲义材料查看～

熵权法权重结果（基于凯莱英 2012 年内部 r nrow(df_demo) 条专利）：

tibble(
  指标     = INDICATORS,
  含义     = c("非专利文献引用量", "引用专利数量", "权利要求数量",
               "3年内被引次数", "专利权人数量", "同族成员数量", "IPC覆盖"),
  维度     = c("基础性", "基础性", "基础性", "体系性", "体系性", "竞争性", "竞争性"),
  信息熵   = round(res_demo$E, 4),
  差异系数 = round(1 - res_demo$E, 4),
  权重     = round(res_demo$weights, 4)
) %>%
  kable(caption = "熵权法权重（凯莱英 2012 年）", align = "lllrrr")

第七步：汇总到企业-年度

firm_demo <- df_demo %>%
  group_by(firm_id, apply_year) %>%
  summarise(
    CKTB      = round(mean(cktb_score, na.rm = TRUE), 4),
    n_patents = n(),
    ipc_cover = first(ipc_cover),
    .groups   = "drop"
  ) %>%
  rename(year = apply_year) %>%
  left_join(df_demo %>% distinct(firm_id, 股票名称), by = "firm_id")

kable(firm_demo %>% select(股票代码 = firm_id, 股票名称, year, CKTB, n_patents, ipc_cover),
      caption = "凯莱英（002821）2012 年 CKTB 汇总结果")

Top 10% 稳健性指标：

top10_thr <- quantile(df_demo$cktb_score, 0.90)
cat(sprintf("Top10%% 得分门槛（凯莱英 2012 年）：%.4f\n", top10_thr))

n_top10 <- sum(df_demo$cktb_score >= top10_thr)
cat(sprintf("Top10%% 关键核心技术专利数：%d 件（占比 %.1f%%）\n",
            n_top10, 100 * n_top10 / nrow(df_demo)))

全量计算：所有公司、所有年份

上面演示了单家公司的计算逻辑，以下代码对全部数据（2010～2012 年）进行批量计算。

注意：由于原始数据文件约 1～1.5 GB，完整运行需要较多内存（建议 16 GB+ RAM）和时间（约 10～30 分钟）。

完整计算代码

library(dplyr)
library(readr)
library(stringr)
library(haven)

# 设置路径
PATH_MATCH  <- "2010~2012年上市公司与专利数据匹配结果_含引用与被引用信息.csv"
PATH_CITE   <- "1985~2024年各专利当年～十一年内的被自引、被他引数量统计.csv"
PATH_EXTEND <- "拓展专利信息.csv"

# 步骤 1: 读取全量主数据
cat(">>> 步骤1: 读取全量主数据...\n")
df_all <- read_csv(
  PATH_MATCH,
  col_select = c("股票代码", "股票名称", "newipzlid", "年份",
                 "引证科技文献", "引证专利", "当前权利人",
                 "IPC", "公开公告号", "申请号"),
  show_col_types = FALSE
) %>%
  rename(
    firm_id    = "股票代码",
    patent_id  = "newipzlid",
    apply_year = "年份"
  )

cat(sprintf("  全量记录：%d 条\n", nrow(df_all)))

# 步骤 2: 读取引用 ID 集合 + 去重
此处代码需下载讲义材料查看～

# 步骤 3: 合并拓展信息
此处代码需下载讲义材料查看～

# 计算企业-年度 IPC 覆盖
firm_ipc <- df_all %>%
  group_by(firm_id, apply_year) %>%
  summarise(
    ipc_cover = n_distinct(unlist(strsplit(ipc_sections, ","))[nchar(unlist(strsplit(ipc_sections, ","))) > 0]),
    .groups = "drop"
  )

df_all <- df_all %>%
  left_join(firm_ipc, by = c("firm_id", "apply_year"))

# 步骤 5: 合并被引用数据
cat(">>> 步骤5: 读取被引用统计...\n")
df_fwd <- read_csv(PATH_CITE, show_col_types = FALSE) %>%
  filter(引用或被引用 == "被他引信息") %>%
  select(patent_id = newipzlid, cite_year = year, fwd_cite = "三年内") %>%
  mutate(fwd_cite = coalesce(fwd_cite, 0L))

df_all <- df_all %>%
  left_join(df_fwd, by = c("patent_id", "apply_year" = "cite_year")) %>%
  mutate(fwd_cite = coalesce(fwd_cite, 0L))

# 步骤 6: 熵权法
此处代码需下载讲义材料查看～

# 步骤 7: 汇总到企业-年度面板
cat(">>> 步骤7: 汇总到企业-年度面板...\n")
firm_cktb <- df_all %>%
  group_by(firm_id, apply_year) %>%
  summarise(
    CKTB      = mean(cktb_score, na.rm = TRUE),
    n_patents = n(),
    ipc_cover = first(ipc_cover),
    .groups   = "drop"
  ) %>%
  rename(year = apply_year) %>%
  select(firm_id, year, CKTB, n_patents, ipc_cover)

cat(sprintf("企业-年度面板：%d 行，%d 家企业\n",
            nrow(firm_cktb), n_distinct(firm_cktb$firm_id)))

# Top10% 稳健性指标
top10_thr <- quantile(df_all$cktb_score, 0.90)
firm_top10 <- df_all %>%
  mutate(is_top10 = as.integer(cktb_score >= top10_thr)) %>%
  group_by(firm_id, apply_year) %>%
  summarise(CKTB_Top10 = sum(is_top10), .groups = "drop") %>%
  rename(year = apply_year)

firm_cktb <- firm_cktb %>%
  left_join(firm_top10, by = c("firm_id", "year"))

# 步骤 8: 保存
cat(">>> 步骤8: 保存结果...\n")
write_dta(firm_cktb, "firm_cktb_2010_2012.dta")
write_csv(firm_cktb, "firm_cktb_2010_2012.csv")
cat("已保存：firm_cktb_2010_2012.dta 和 firm_cktb_2010_2012.csv\n")

# 步骤 9: 描述性统计
cat("\n===== 按年份统计 =====\n")
print(
  firm_cktb %>%
    group_by(year) %>%
    summarise(
      企业数        = n(),
      均值_CKTB     = round(mean(CKTB), 4),
      标准差_CKTB   = round(sd(CKTB), 4),
      均值_专利数量 = round(mean(n_patents), 1),
      .groups       = "drop"
    )
)

cat("\n===== CKTB Top10 企业（2012 年）=====\n")
print(
  firm_cktb %>%
    filter(year == 2012) %>%
    arrange(desc(CKTB)) %>%
    head(10) %>%
    mutate(CKTB = round(CKTB, 4))
)

变量说明

最终输出的企业-年度面板数据包含以下变量：

tibble(
  变量名 = c("firm_id", "year", "CKTB", "n_patents", "ipc_cover", "CKTB_Top10"),
  说明 = c(
    "股票代码",
    "专利申请年份",
    "熵权法综合得分（企业当年所有专利的均值）",
    "当年有效专利数量",
    "当年专利跨越的 IPC 部（section）数量",
    "得分位于前 10% 的关键核心技术专利数量（稳健性检验）"
  )
) %>%
  kable(align = "ll")

把上市公司专利数据替换成全部年份的就可以计算全部结果了～

点击这里跳转到 RStata 短书平台获取附件：名师讲堂｜使用 R 语言测算上市公司关键核心技术突破指标面板数据（熵权法）

指标来源与背景

理论依据

测度指标

熵权法原理

计算步骤

熵权法函数实现

数据准备

单公司演示：以凯莱英（002821）2012 年为例

第一步：读取主数据

第二步：专利去重

第三步：读取拓展信息并合并

第四步：提取专利层面 CKTB 指标

此处代码需下载讲义材料查看～

第五步：合并 3 年内被引次数

第六步：运行熵权法

第七步：汇总到企业-年度

全量计算：所有公司、所有年份

完整计算代码

变量说明

相关文章

评论