R 三年宽到长:重复措施和效率

R 三年宽到长:重复措施和效率,r,data.table,tidyr,R,Data.table,Tidyr,该问题与Akrun有关,并由Akrun回答 我有嵌套列的宽数据,我正在转换为长格式。数据采用以下部分长格式: 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

该问题与Akrun有关,并由Akrun回答

我有嵌套列的宽数据,我正在转换为长格式。数据采用以下部分长格式:

  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
我想把它们做成以下真正的长格式:

  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秒钟,超过1000行的数据就会崩溃

下面是一些带有计时功能的示例代码

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 
我也尝试过将值字段转换为因子,结果类似

有没有更有效的方法来完成这项工作

更新: 按照@Richard的建议,使用
单独的
进行结果

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建议的
数据表

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
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 
按照Akrun的建议,使用
fread
获得结果

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
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 

我们可以从
data.table

library(data.table)#v1.9.6+
setDT(df1)[, c('diag', 'number') := tstrsplit(var,
             '(?<=[^0-9])(?=[0-9])', perl=TRUE)]

这里有一种方法,我们可以做一些预处理,从而加快实际的转换。这样我们只做一次strsplit,然后使用查找来获取值

行数较少时速度较慢,但在5*10^5时速度约为6倍

我假设列
var
是一个因素。如果没有,请尝试

dat$var <- as.factor(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
set.seed(10)
n=10000

diags我将分两步解决这个问题。获得样本数据后:

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)]
)
library(tidyr)
图书馆(dplyr)
n来源:本地数据帧[50 x 3]
#> 
#>var诊断数
#>(chr)(chr)(chr)
#>1诊断1诊断1
#>2 poa1 poa 1
#>3诊断2诊断2
#>4 poa2 poa2
#>5诊断3诊断3
#>6 poa3 poa 3
#>7诊断4诊断4
#>8 poa4 poa4
#>9诊断5诊断5
#>10 poa5 poa5
#> ..   ...   ...    ...
然后使用联接将其添加回原始数据集:

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
#> ..   ...   ...   ...    ...
dat%
左联合(标签)%>%
选择(-var)
#>加入者:“var”
dat
#>来源:本地数据帧[100000 x 4]
#> 
#>id值诊断号
#>(内部)(中央)(中央)(中央)(中央)(中央)
#>1小时诊断1
#>二○○一年度小一
#>3 1 x诊断2
#>4.1季度poa 2
#>5 1 x诊断3
#>6 1 e poa 3
#>7 1 t诊断4
#>8.1 b小行动纲领4
#>9 1 n诊断5
#>10.1吨poa 5
#> ..   ...   ...   ...    ...

我认为使用strsplit
可能更快。i、 e.
strsplit(df1$var,”(
sep(dat,var,c(“diag”,“number”),sep=”怎么样(?@jeremycg我不需要拆分固定长度的
id
value
字段,但是
var
字段不是固定长度这是您的
var
始终
odiag
poa
?然后您可以执行:
dat%>%提取(var,c('diag',number'),'(odiag | poa)())
这比alternatives@jeremycg是的,我的数据总是
odiag
poa
…我曾试图概括这个问题,以防其他人发现它有用。将尝试你的方法我不知道为什么,但上面的代码(以及其他人提供的所有示例)在上面的示例数据上工作得很好,但是当我使用实际数据多达1000行时,会挂起我的R会话。对于几百行,一切正常,但是>1k,它挂起。由于我的标签是可预测的,在这种情况下,我刚刚生成了一个数据帧,跳过@hadley的第一步,然后对于2亿行,连接只需要16秒
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
#> ..   ...   ...   ...    ...