之前给大家讲解了如何使用 Stata 测算数实融合水平，尽管使用了大量的 Mata 代码，不过这个指标使用 Stata 计算的效率还是很低，使用 R 语言效率会高很多。
今天给大家分享一下「新质生产力背景下数实融合的测算与时空比较——基于专利共分类方法的研究」一文中的数实融合水平指标的 Stata 计算方法，不过由于论文中关于指标计算的一些细节描述的较为含糊，所以计算过程中的一些处理方法还有待探讨，感兴趣的小伙伴也可以说说自己的想法。
按照论文的介绍，数实融合水平的测算过程如下所示：
由于内容较多，本课程会分三次进行讲解：
- 使用 R 语言测算数实融合水平（一）：基于示例数据
- 使用 R 语言测算数实融合水平（二）：基于真实专利数据
- 使用 R 语言测算数实融合水平（三）：分城市、产业计算数实融合
今天我们先从最简单的示例开始。
准备示例数据
按照上面的示意图。计算数实融合需要下面三个数据：
一是各个专利的分类号：
library(tidyverse)
patent_data <- tibble(
id = c("P1", "P2", "P3"),
ipc = c("IPC1;IPC3", "IPC1;IPC2", "IPC1;IPC2;IPC3")
)
patent_data
|
二是 IPC 分类号与产业对照表：
ipc_industry1 <- tibble(
uniq_ipc = c("IPC1", "IPC2", "IPC3"),
industry = c("I1", "I2;I3", "I3;I4")
)
ipc_industry1
|
不过使用下面的表达方式处理起来会更简单：
ipc_industry2 <- tibble(
uniq_ipc = c("IPC1", "IPC2", "IPC2", "IPC3", "IPC3"),
industry = c("I1", "I2", "I3", "I3", "I4")
)
ipc_industry2
|
这样样式也更接近我们后面使用的真实专利数据。
industry_class <- tibble(
uniq_industry = c("I1", "I2", "I3", "I4"),
class = c("数字产业", "数字产业", "实体产业", "实体产业")
)
industry_class
|
计算 IPC 融合矩阵
根据文献的介绍，IPC 融合矩阵的结果就是如果两个 IPC 号出现在一个专利的分类号上，返回 1，否则返回 0。
首先展开专利的 IPC 分类号：
patent_expanded <- patent_data %>%
mutate(ipc_list = str_split(ipc, ";")) %>%
unnest(ipc_list) %>%
mutate(freq = 1)
patent_expanded
|
生成所有 IPC 组合：
patent_expanded %>%
group_by(id) %>%
summarize(
ipc1 = list(ipc_list),
ipc2 = list(ipc_list),
freq = first(freq)
) %>%
mutate(
combinations = map2(ipc1, ipc2, ~ crossing(ipc1 = .x, ipc2 = .y))
) %>%
select(-ipc1, -ipc2) %>%
unnest(combinations) %>%
ungroup() -> ipc_combinations
ipc_combinations
|
计算 IPC 共现频次：
ipc_matrix <- ipc_combinations %>%
filter(ipc1 != ipc2) %>%
group_by(ipc1, ipc2) %>%
summarize(value = sum(freq), .groups = "drop")
ipc_matrix
|
计算行业共现矩阵
分别把两个 ipc 变量和 ipc_industry2 匹配即可：
ipc_matrix %>%
rename(uniq_ipc = ipc1) %>%
left_join(ipc_industry2, by = "uniq_ipc") %>%
rename(industry1 = industry) %>%
select(-uniq_ipc) -> industry_matrix1
industry_matrix1 %>%
rename(uniq_ipc = ipc2) %>%
left_join(ipc_industry2, by = "uniq_ipc") %>%
rename(industry2 = industry) %>%
select(-uniq_ipc) -> industry_matrix2
industry_matrix2 %>%
filter(industry1 != industry2) %>%
group_by(industry1, industry2) %>%
summarize(value = sum(value), .groups = "drop") -> industry_matrix
|
计算数实融合
然后我们就可以根据公式计算数实融合水平了：
industry_matrix %>%
rename(uniq_industry = industry1) %>%
left_join(industry_class, by = "uniq_industry") %>%
rename(industry1 = uniq_industry, class1 = class) -> fusion_step1
fusion_step1 %>%
rename(uniq_industry = industry2) %>%
left_join(industry_class, by = "uniq_industry") %>%
rename(industry2 = uniq_industry, class2 = class) -> fusion_step2
fusion_step2
fusion_step2 %>%
filter(value > 0) -> fusion_filtered
fusion_filtered %>%
distinct(industry1, class1) %>%
group_by(class1) %>%
summarize(freq1 = n_distinct(industry1)) %>%
ungroup() -> industry_counts
fusion_filtered %>%
left_join(industry_counts, by = "class1") %>%
left_join(industry_counts %>%
rename(class2 = class1, freq2 = freq1),
by = "class2") -> fusion_withfreq
fusion_withfreq %>%
group_by(class1, class2) %>%
summarize(
value = sum(value),
freq1 = first(freq1),
freq2 = first(freq2),
.groups = "drop"
) -> fusion_summary
fusion_summary %>%
mutate(
RH = value / (freq1 * freq2),
class = case_when(
class1 != class2 ~ "数实融合",
class1 == "数字产业" & class2 == "数字产业" ~ "数数融合",
class1 == "实体产业" & class2 == "实体产业" ~ "实实融合",
TRUE ~ NA_character_
)
) %>%
select(class, RH) %>%
distinct() -> fusion_result
print(fusion_result)
|
这样我们就计算出来该示例数据的数实融合水平为 2，数数融合水平为 1，实实融合水平为 0.5。
下次课我们再继续讲解基于真实专利数据的计算。
点击这里跳转到 RStata 短书平台获取附件：名师讲堂｜使用 R 语言测算数实融合水平（一）：基于示例数据
评论