tidyr 从宽到长：重复措施和效率
tidyr wide to long: repeated measures and efficiency
此问题与有关，由阿克伦回答。
我有带嵌套列的宽数据，我正在将其转换为长格式。数据采用以下部分长格式：
id var value
1 diag1 m
1 diag2 h
1 diag3 k
1 diag4 r
1 diag5 c
1 diag6 f
1 opa1 s
1 opa2 f
并且我希望以以下真正的长格式获取它们：
id diag number value
1 diag 1 m
1 diag 2 h
1 diag 3 k
1 diag 4 r
1 diag 5 c
1 diag 6 f
1 opa 1 s
1 opa 2 f
以下代码针对较少的行数实现了这一点，但我的数据有点复杂（15 位 id、5 位 value），我有 6.34 亿行。
对于我的数据，100 行大约需要 3 秒，超过 1,000 行就会崩溃。
这是一些示例，可重现的代码，带时序
library(tidyr)
set.seed(10)
n = 100
diags <- paste("diag", 1:25, sep="")
poas <-paste("poa", 1:25, sep="")
var <- c(diags, poas)
dat <- data.frame(id = rep(1:50, each=n), var = rep(var, 5), value = letters[sample(1:25,25*n, replace = T)])
datlong <- dat %>%
extract(var, c('diag', 'number'),
'([a-z]+)([0-9]+)')
n user system elapsed
10^2 0.011 0.006 0.026
10^3 0.041 0.010 0.066
10^4 0.366 0.055 0.421
10^5 3.969 0.445 4.984
10^6 40.777 13.840 60.969
我的数据框如下所示：
str(realdata)
'data.frame': 634358112 obs. of 3 variables:
$ visitId: Factor w/ 12457767 levels "---------_1981-07-28",..: 8333565 5970358 158415 5610904 3422522 10322908 10973353 10921570 919501 4639482 ...
$ var : Factor w/ 48 levels "odiag1","odiag2",..: 1 1 1 1 1 1 1 1 1 1 ...
$ value : chr "42732" "0389" "20280" "9971" ...
我也试过将值字段转换为因子，结果相似。
有没有更有效的方法来完成这项工作？
更新：
根据@Richard
的建议，结果为 separate
n user system elapsed
10^2 0.010 0.001 0.010
10^3 0.081 0.003 0.084
10^4 0.797 0.011 0.811
10^5 9.703 0.854 11.041
10^6 138.401 6.301 146.613
Akrun
建议的 data.table 结果
n user system elapsed
10^2 0.018 0.001 0.019
10^3 0.074 0.002 0.076
10^4 0.598 0.024 0.619
10^5 6.478 0.348 6.781
10^6 73.581 2.661 75.749
Akrun
建议的 fread 结果
n user system elapsed
10^2 0.019 0.001 0.019
10^3 0.065 0.003 0.067
10^4 0.547 0.011 0.547
10^5 5.321 0.164 5.446
10^6 52.362 1.363 53.312
我们可以尝试使用 tstrsplit 从 data.table
library(data.table)#v1.9.6+
setDT(df1)[, c('diag', 'number') := tstrsplit(var,
'(?<=[^0-9])(?=[0-9])', perl=TRUE)]
或者在字符和数字元素之间创建一个分隔符，然后用fread
读取
fread(paste(sub('(\d+)$', ',\1', df1$var), collapse='\n'),
col.names=c('diag', 'number'))
我们可以通过以下方法进行一些预处理，从而加快实际转换速度。这样我们只做一次 strsplit，然后使用查找来获取值。
在行数较少时速度较慢，但在 5*10^5
时快约 6 倍
我假设 var 列是一个因素。如果没有，请尝试
dat$var <- as.factor(dat$var)
首先，拆分因素的水平：
diag <- sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[1]])
number <- as.numeric(sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[2]]))
然后通过将 dat$var 强制转换为数字来为每个人抓取正确的：
dat$number <- number[as.numeric(dat$var)]
dat$diag <- diag[as.numeric(dat$var)]
这是 5*10^6 的基准：
set.seed(10)
n = 10000
diags <- paste("diag", 1:25, sep="")
poas <-paste("poa", 1:25, sep="")
var <- c(diags, poas)
dat <- data.frame(id = rep(1:50, each=n), var = rep(var, 5), value = letters[sample(1:25,25*n, replace = T)])
microbenchmark::microbenchmark(
factors = {
diag <- sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[1]])
number <- as.numeric(sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[2]]))
dat$number <- number[as.numeric(dat$var)]
dat$diag <- diag[as.numeric(dat$var)]
},
extract = {
dat %>% extract(var, c('diag', 'number'),'([a-z]+)([0-9]+)')
}
)
Unit: milliseconds
expr min lq mean median uq max neval cld
factors 51.70709 67.46106 110.5191 77.67737 169.0687 304.3777 100 a
extract 599.76868 635.70298 702.1213 660.78699 748.7519 1111.4843 100 b
我会分两步解决这个问题。获得示例数据后：
library(tidyr)
library(dplyr)
n <- 1e5
vars <- paste0(c("diag", "poa"), rep(1:25, each = 2))
dat <- data_frame(
id = rep(1:50, each = n / 50),
var = rep(vars, length = n),
value = letters[sample(25, n, replace = TRUE)]
)
提取唯一变量名，并使用您原来的方法：
labels <- dat %>%
select(var) %>%
distinct() %>%
extract(var, c('diag', 'number'), '([a-z]+)([0-9]+)', remove = FALSE)
labels
#> Source: local data frame [50 x 3]
#>
#> var diag number
#> (chr) (chr) (chr)
#> 1 diag1 diag 1
#> 2 poa1 poa 1
#> 3 diag2 diag 2
#> 4 poa2 poa 2
#> 5 diag3 diag 3
#> 6 poa3 poa 3
#> 7 diag4 diag 4
#> 8 poa4 poa 4
#> 9 diag5 diag 5
#> 10 poa5 poa 5
#> .. ... ... ...
然后使用连接将其添加回原始数据集：
dat <- dat %>%
left_join(labels) %>%
select(-var)
#> Joining by: "var"
dat
#> Source: local data frame [100,000 x 4]
#>
#> id value diag number
#> (int) (chr) (chr) (chr)
#> 1 1 h diag 1
#> 2 1 s poa 1
#> 3 1 x diag 2
#> 4 1 q poa 2
#> 5 1 x diag 3
#> 6 1 e poa 3
#> 7 1 t diag 4
#> 8 1 b poa 4
#> 9 1 n diag 5
#> 10 1 t poa 5
#> .. ... ... ... ...
此问题与
我有带嵌套列的宽数据，我正在将其转换为长格式。数据采用以下部分长格式：
id var value
1 diag1 m
1 diag2 h
1 diag3 k
1 diag4 r
1 diag5 c
1 diag6 f
1 opa1 s
1 opa2 f
并且我希望以以下真正的长格式获取它们：
id diag number value
1 diag 1 m
1 diag 2 h
1 diag 3 k
1 diag 4 r
1 diag 5 c
1 diag 6 f
1 opa 1 s
1 opa 2 f
以下代码针对较少的行数实现了这一点，但我的数据有点复杂（15 位 id、5 位 value），我有 6.34 亿行。
对于我的数据，100 行大约需要 3 秒，超过 1,000 行就会崩溃。
这是一些示例，可重现的代码，带时序
library(tidyr)
set.seed(10)
n = 100
diags <- paste("diag", 1:25, sep="")
poas <-paste("poa", 1:25, sep="")
var <- c(diags, poas)
dat <- data.frame(id = rep(1:50, each=n), var = rep(var, 5), value = letters[sample(1:25,25*n, replace = T)])
datlong <- dat %>%
extract(var, c('diag', 'number'),
'([a-z]+)([0-9]+)')
n user system elapsed
10^2 0.011 0.006 0.026
10^3 0.041 0.010 0.066
10^4 0.366 0.055 0.421
10^5 3.969 0.445 4.984
10^6 40.777 13.840 60.969
我的数据框如下所示：
str(realdata)
'data.frame': 634358112 obs. of 3 variables:
$ visitId: Factor w/ 12457767 levels "---------_1981-07-28",..: 8333565 5970358 158415 5610904 3422522 10322908 10973353 10921570 919501 4639482 ...
$ var : Factor w/ 48 levels "odiag1","odiag2",..: 1 1 1 1 1 1 1 1 1 1 ...
$ value : chr "42732" "0389" "20280" "9971" ...
我也试过将值字段转换为因子，结果相似。
有没有更有效的方法来完成这项工作？
更新： 根据@Richard
的建议，结果为separate
n user system elapsed
10^2 0.010 0.001 0.010
10^3 0.081 0.003 0.084
10^4 0.797 0.011 0.811
10^5 9.703 0.854 11.041
10^6 138.401 6.301 146.613
Akrun
建议的data.table 结果
n user system elapsed
10^2 0.018 0.001 0.019
10^3 0.074 0.002 0.076
10^4 0.598 0.024 0.619
10^5 6.478 0.348 6.781
10^6 73.581 2.661 75.749
Akrun
建议的fread 结果
n user system elapsed
10^2 0.019 0.001 0.019
10^3 0.065 0.003 0.067
10^4 0.547 0.011 0.547
10^5 5.321 0.164 5.446
10^6 52.362 1.363 53.312
我们可以尝试使用 tstrsplit 从 data.table
library(data.table)#v1.9.6+
setDT(df1)[, c('diag', 'number') := tstrsplit(var,
'(?<=[^0-9])(?=[0-9])', perl=TRUE)]
或者在字符和数字元素之间创建一个分隔符，然后用fread
fread(paste(sub('(\d+)$', ',\1', df1$var), collapse='\n'),
col.names=c('diag', 'number'))
我们可以通过以下方法进行一些预处理，从而加快实际转换速度。这样我们只做一次 strsplit，然后使用查找来获取值。
在行数较少时速度较慢，但在 5*10^5
时快约 6 倍我假设 var 列是一个因素。如果没有，请尝试
dat$var <- as.factor(dat$var)
首先，拆分因素的水平：
diag <- sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[1]])
number <- as.numeric(sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[2]]))
然后通过将 dat$var 强制转换为数字来为每个人抓取正确的：
dat$number <- number[as.numeric(dat$var)]
dat$diag <- diag[as.numeric(dat$var)]
这是 5*10^6 的基准：
set.seed(10)
n = 10000
diags <- paste("diag", 1:25, sep="")
poas <-paste("poa", 1:25, sep="")
var <- c(diags, poas)
dat <- data.frame(id = rep(1:50, each=n), var = rep(var, 5), value = letters[sample(1:25,25*n, replace = T)])
microbenchmark::microbenchmark(
factors = {
diag <- sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[1]])
number <- as.numeric(sapply(levels(dat$var), function(x) strsplit(x, '(?<=[^0-9])(?=[0-9])', perl=TRUE)[[1]][[2]]))
dat$number <- number[as.numeric(dat$var)]
dat$diag <- diag[as.numeric(dat$var)]
},
extract = {
dat %>% extract(var, c('diag', 'number'),'([a-z]+)([0-9]+)')
}
)
Unit: milliseconds
expr min lq mean median uq max neval cld
factors 51.70709 67.46106 110.5191 77.67737 169.0687 304.3777 100 a
extract 599.76868 635.70298 702.1213 660.78699 748.7519 1111.4843 100 b
我会分两步解决这个问题。获得示例数据后：
library(tidyr)
library(dplyr)
n <- 1e5
vars <- paste0(c("diag", "poa"), rep(1:25, each = 2))
dat <- data_frame(
id = rep(1:50, each = n / 50),
var = rep(vars, length = n),
value = letters[sample(25, n, replace = TRUE)]
)
提取唯一变量名，并使用您原来的方法：
labels <- dat %>%
select(var) %>%
distinct() %>%
extract(var, c('diag', 'number'), '([a-z]+)([0-9]+)', remove = FALSE)
labels
#> Source: local data frame [50 x 3]
#>
#> var diag number
#> (chr) (chr) (chr)
#> 1 diag1 diag 1
#> 2 poa1 poa 1
#> 3 diag2 diag 2
#> 4 poa2 poa 2
#> 5 diag3 diag 3
#> 6 poa3 poa 3
#> 7 diag4 diag 4
#> 8 poa4 poa 4
#> 9 diag5 diag 5
#> 10 poa5 poa 5
#> .. ... ... ...
然后使用连接将其添加回原始数据集：
dat <- dat %>%
left_join(labels) %>%
select(-var)
#> Joining by: "var"
dat
#> Source: local data frame [100,000 x 4]
#>
#> id value diag number
#> (int) (chr) (chr) (chr)
#> 1 1 h diag 1
#> 2 1 s poa 1
#> 3 1 x diag 2
#> 4 1 q poa 2
#> 5 1 x diag 3
#> 6 1 e poa 3
#> 7 1 t diag 4
#> 8 1 b poa 4
#> 9 1 n diag 5
#> 10 1 t poa 5
#> .. ... ... ... ...