名师讲堂｜使用 R 语言测算区域技术专业化

2063 字 约 7 分钟 名师讲堂 区域经济R 语言

今天给大家分享使用 R 语言测算区域技术专业化的方法。该方法参考自林原(2018)《技术流动对区域技术专业化的影响研究》，通过 IPC 专利分类和 RTA 指数来综合测度区域的技术专业化程度。

附件中提供了该参考文献的 PDF 文件（林原，2018），感兴趣的小伙伴可以阅读原文。

指标来源与计算原理

区域技术专业化（Regional Technological Specialization）

区域技术专业化是衡量地区在特定技术领域集聚程度的重要指标。该方法的核心思想是：

  1. IPC 专利分类：利用世界知识产权组织（WIPO）的 IPC 与技术领域对照表，将专利按 IPC 代码归类到 35 个技术领域
  2. RTA 指数（Revealed Technological Advantage）：计算区域在特定技术领域的相对优势
  3. CV（变异系数）：用调整后 RTA 的变异系数衡量区域技术专业化的整体程度

R 语言代码实现

Step 1: 加载数据

首先加载 2010 年的专利数据：

library(tidyverse)
library(data.table)

cat("=== Step 1: 加载数据 ===\n")

df_raw <- read_csv("2010.csv", locale = locale(encoding = "UTF-8"))
cat(sprintf("原始数据行数: %d\n", nrow(df_raw)))

# 查看数据前几行
df_raw %>%
  select(省, 市, 县, 公开公告号, IPC, newipzlid) %>%
  head(5)

Step 2: 按地区去重

专利数据可能存在重复，需要按地区（省、市、县）和不同标识进行逐级去重：

cat("\n=== Step 2: 按地区去重 ===\n")

# 清理公开公告号（去除末尾的字母，如 A、B、U 等）
df_raw <- df_raw %>%
  mutate(公开公告号_clean = str_remove(公开公告号, "[A-Z]$"))

# 按地区 + 公告号去重
df_raw <- df_raw %>%
  distinct(省, 市, 县, 公开公告号_clean, .keep_all = TRUE)
cat(sprintf("按地区+公告号去重后: %d 行\n", nrow(df_raw)))

# 按地区 + 申请号去重
df_raw <- df_raw %>%
  distinct(省, 市, 县, 申请号, .keep_all = TRUE)
cat(sprintf("按地区+申请号去重后: %d 行\n", nrow(df_raw)))

# 按地区 + 专利ID去重
df_raw <- df_raw %>%
  distinct(省, 市, 县, newipzlid, .keep_all = TRUE)
cat(sprintf("按地区+专利ID去重后: %d 行\n", nrow(df_raw)))

代码讲解：

  • str_remove(公开公告号, “[A-Z]$”)：去除公告号末尾的字母（如 CN12345A → CN12345）
  • distinct()：按指定变量去重，.keep_all = TRUE 保留所有变量
  • 三级去重确保同一专利在同一地区只计算一次

Step 3: 读取 WIPO 表并构建 IPC 查找表

WIPO（世界知识产权组织）提供了 IPC 代码与 35 个技术领域的对照表。我们需要构建查找表，将专利的 IPC 代码映射到技术领域。

cat("\n=== Step 3: 构建IPC查找表 ===\n")

wipo <- read_csv("WIPO_IPC_and_Technology_Concordance_Table.csv",
                 locale = locale(encoding = "UTF-8"))

# 查看WIPO表结构
wipo %>%
  select(序号, 大类, IPC代码) %>%
  head(5)

# 辅助函数：将WIPO格式转换为前缀
# WIPO格式：B01D-01## 或 B01D-01#
# 标准格式：B01D01/00
pattern_to_prefix <- function(pattern) {
  prefix <- str_remove(pattern, "##")
  prefix <- str_remove(prefix, "#")
  prefix <- str_remove_all(prefix, "-")
  return(prefix)
}

# 构建IPC前缀到技术领域的映射
# 此处代码需下载讲义材料查看～

代码讲解：

  • pattern_to_prefix()：将 WIPO 格式（B01D-01##）转换为前缀格式（B01D01）
  • build_ipc_lookup()：遍历 WIPO 表的每一行，构建 前缀 → 技术领域 的映射
  • 排除规则：某些技术领域有排除规则（如”包含 A01D-15 但不包括 A01D-15-2”）
  • 按前缀长度降序排序：确保先匹配更具体的前缀（如 G06F19 优先于 G06F）

Step 4: 定义 IPC 匹配函数

定义函数将 IPC 代码匹配到技术领域：

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

代码讲解：

  • 专利可能有多个 IPC 代码（用分号分隔），需要逐一匹配
  • normalized：去除 / 后面的小组号，只保留大类+主组
  • 排除规则检查：如果匹配到的技术领域有排除规则，需要检查该专利的 IPC 是否命中排除前缀

Step 5: 批量匹配 IPC 到技术领域

对数据中的所有唯一 IPC 代码进行批量匹配，建立查找表：

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

代码优化说明：

  • 先对唯一 IPC 建立查找表，再应用到全部数据，避免重复计算
  • 一个专利可能匹配到多个技术领域（用分号分隔）

Step 6: 应用查找表到全部专利

将查找表应用到全部专利数据：

cat("\n=== Step 6: 应用查找表到全部专利 ===\n")

# 应用查找表
df_matched <- df_raw %>%
  mutate(
    技术领域 = ipc_results[IPC],
    技术领域 = if_else(is.na(技术领域) | 技术领域 == "", NA_character_, 技术领域),
    tech_count = if_else(is.na(技术领域), 0, 1)
  )

df_matched %>%
  select(newipzlid, IPC, 技术领域, tech_count)

cat(sprintf("有技术领域匹配的专利数: %d\n", sum(df_matched$tech_count > 0, na.rm = TRUE)))
cat(sprintf("无匹配的专利数: %d\n", sum(df_matched$tech_count == 0, na.rm = TRUE)))
cat(sprintf("总专利数: %d\n", nrow(df_matched)))

Step 7: 展开多值 IPC 数据

如果一个专利匹配到多个技术领域，需要展开成多行：

cat("\n=== Step 7: 展开多值IPC ===\n")

# 展开数据（一个专利可能对应多个技术领域）
df_expanded <- df_matched %>%
  filter(!is.na(技术领域)) %>%
  select(省, 省代码, newipzlid, 技术领域) %>%
  separate_rows(技术领域, sep = ";") %>%
  distinct(省, 省代码, newipzlid, 技术领域) %>%
  rename(技术领域序号 = 技术领域)

df_expanded %>%
  filter(!is.na(省))

cat(sprintf("展开后行数: %d\n", nrow(df_expanded)))

代码讲解：

  • separate_rows()：将一个单元格中的多个值（用分号分隔）展开成多行
  • distinct()：去重，避免同一专利在同一技术领域重复计数

Step 8: 按省份和技术领域汇总

统计每个省份在每个技术领域的专利数量：

cat("\n=== Step 8: 按省份和技术领域汇总 ===\n")

tech_by_region <- df_expanded %>%
  group_by(省, 省代码, 技术领域序号) %>%
  summarize(专利数量 = n(), .groups = "drop")

cat(sprintf("汇总后行数: %d\n", nrow(tech_by_region)))
cat(sprintf("涉及省份数: %d\n", n_distinct(tech_by_region$省)))

tech_by_region

Step 9: 计算 RTA 指数

根据 RTA 公式计算每个地区在每个技术领域的相对优势：

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

公式讲解：

  • 专利数量 / tech_total：该地区在该技术领域的专利占比
  • region_total / total_patents：该技术领域的专利在全国的占比
  • RTA = 占比1 / 占比2：相对优势指数
  • Adj_RTA：将 RTA 调整到 [0,1] 区间

Step 10: 计算 CV（变异系数）

按省份计算 Adj_RTA 的变异系数：

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

结果解读：

  • CV 值越大，表示该区域的技术专业化程度越高
  • 技术专业化高的地区：某些技术领域的 RTA 远高于其他领域（技术分布不均匀）
  • 技术专业化低的地区：各技术领域的 RTA 比较均匀（技术分布分散）

Step 11: 保存结果

将计算结果保存到 CSV 文件：

cat("\n=== Step 11: 保存结果 ===\n")

# 添加技术领域名称
tech_names <- wipo %>%
  select(技术领域序号 = 序号, 技术领域名称, 技术领域名称中文) %>%
  mutate(技术领域序号 = as.character(技术领域序号))

tech_df <- tech_by_region %>%
  left_join(tech_names, by = "技术领域序号") %>%
  arrange(省, 技术领域序号) %>%
  filter(!is.na(省))

write_csv(cv_by_region, "区域技术专业化CV.csv", na = "")
cat("已保存: 区域技术专业化CV.csv\n")

write_csv(tech_df, "技术领域按省份汇总.csv", na = "")
cat("已保存: 技术领域按省份汇总.csv\n")

cat("\n=== 完成 ===\n")

结果展示

区域技术专业化 CV 排名（2010年）

cv_results <- read_csv("区域技术专业化CV.csv", show_col_types = FALSE)

cv_results %>%
  arrange(desc(CV)) %>%
  select(省, CV, Total_Patents, Tech_Diversity) %>%
  head(10) %>%
  knitr::kable(digits = 4, caption = "区域技术专业化排名（前10）")

技术多样性分布

cv_results <- read_csv("区域技术专业化CV.csv", show_col_types = FALSE)

ggplot(cv_results, aes(x = Tech_Diversity)) +
  geom_histogram(bins = 20, fill = "#1f77b4", alpha = 0.7) +
  labs(title = "各省技术多样性分布", x = "技术领域数量", y = "省份数")

代码文件说明

本文档配套的 R 语言脚本文件：

文件 说明
main.R 主程序，包含所有计算步骤
WIPO_IPC_and_Technology_Concordance_Table.csv WIPO IPC与技术领对照表
2010.csv 2010年专利数据
区域技术专业化CV.csv 计算结果：各省CV值
技术领域按省份汇总.csv 计算结果：各省各技术领域的专利数量

点击这里跳转到 RStata 短书平台获取附件：名师讲堂｜使用 R 语言测算区域技术专业化

相关文章

评论