通过连接长度不均匀的子字符串来创建数据帧答案

【问题标题】：Creating a dataframe by concatenating substrings of non-uniform lengths通过连接长度不均匀的子字符串来创建数据帧
【发布时间】：2017-03-25 16:12:06
【问题描述】：

原始数据 (.txt) 文件有 65926 个元素，每个元素包含 142 个字符串。

这是原始数据文件的dropbox link。

任务是将这 142 个字符串分成 37 个较小的字符串（每个子字符串是一个单独的字符变量），每个字符串从以下位置顺序开始： 1,4,9,11,14,15,16,19,21,24,26,27,28,32,33,34,36,38,43,45,46,47,48,52,56, 60,66,72,75,76,77,78,79,80,127,130,133

最终输出必须是 65926 x 37 的数据帧。这是输出数据帧的快照：

这是我正在使用的代码：

x <- readLines("R71252L01.TXT")
a <- c(1,4,9,11,14,15,16,19,21,24,26,27,28,32,33,34,36,38,43,45,46,47,48,52,56,60,66,72,75,76,77,78,79,80,127,130,133)
z <- data.frame(matrix(nrow = length(x), ncol = length(a)), stringsAsFactors = FALSE)
for (i in 1:length(x) ) {
z[i,] <- (list(
            (c(substr(x[i], 1, 3),substr(x[i], 4, 8),substr(x[i], 9, 10),
               substr(x[i], 11, 13),substr(x[i], 14, 14),substr(x[i], 15, 15),
               substr(x[i], 16, 18),substr(x[i], 19, 20),substr(x[i], 21, 23),
               substr(x[i], 24, 25),substr(x[i], 26, 26),substr(x[i], 27, 27),
               substr(x[i], 28, 31),substr(x[i], 32, 32),substr(x[i], 33, 33),
               substr(x[i], 34, 35),substr(x[i], 36, 37),substr(x[i], 38, 42),
               substr(x[i], 43, 44),substr(x[i], 45, 45),substr(x[i], 46, 46),
               substr(x[i], 47, 47),substr(x[i], 48, 51),substr(x[i], 52, 55),
               substr(x[i], 56, 56),substr(x[i], 60, 65),substr(x[i], 66, 71),
               substr(x[i], 72, 74),substr(x[i], 75, 75),substr(x[i], 76, 76),
               substr(x[i], 77, 77),substr(x[i], 78, 78),substr(x[i], 79, 79),
               substr(x[i], 80, 126),substr(x[i], 127, 129),substr(x[i], 130, 132),
               substr(x[i], 133, 142)
            ) )
        )    )
i <- i+1
}

代码有效，但有两个问题：

substr() 的开始和停止索引必须手动输入。有什么方法可以利用矢量a 来代替所有的体力劳动？

代码需要 30 多分钟才能执行。检查时间：

> system.time(source('Hitesh_Script.R'))
    user   system  elapsed 
4452.464    9.440 4476.018

这可以更快地完成吗？

我必须对几个原始数据文件执行此任务，每个文件都有一个不同的向量a。因此，任何其他关于效率的建议也将受到赞赏。非常感谢！

【问题讨论】：

如果您能分享一小部分“z”样本供我们研究，那就太好了！
一般来说，如果有矢量化替代方案，请避免在大型数据帧（for (i in 1:length(x) ) 或 for (i in seq_along(x) )）上使用 for 循环。

标签： r dataframe vectorization substring variable-length

【解决方案1】：

我只是模拟了一个临时数据并分享了一个简单的代码

a <- c(1,4,9,11,14,15,16,19,21,24,26,27,28,32,33,34,36,38,43,45,46,47,48,52,
       56,60,66,72,75,76,77,78,79,80,127,130,133)
df = data.frame(
  x = c("uiagdsjgcjkh bijacydgasxdhsfkajdh,cnfwkeyrg,urnyhvguirwljbhgkjgjgdkgkdgkgdkgdkgdkgdkgdkgdkgdkdgkdgkdgkdgkjdgkdwjbiuayeiuy ke,ynh lgdiyl", 
        "kjhfkjsdlfkojjhgckjasnhjhckjsybsanhdsabtgchbtsjahasijhcndkuysefiuwyhsnidxjnkausetfba jwf,mycaiusftbbawubbctejdgkjdghjgdduiacwyftacbm"))

# > df
# x
# 1 uiagdsjgcjkh bijacydgasxdhsfkajdh,cnfwkeyrg,urnyhvguirwljbhgkjgjgdkgkdgkgdkgdkgdkgdkgdkgdkgdkdgkdgkdgkdgkjdgkdwjbiuayeiuy ke,ynh lgdiyl
# 2 kjhfkjsdlfkojjhgckjasnhjhckjsybsanhdsabtgchbtsjahasijhcndkuysefiuwyhsnidxjnkausetfba jwf,mycaiusftbbawubbctejdgkjdghjgdduiacwyftacbm

df1 <- data.frame(lapply(df, function(x) lapply(seq_along(a), function(i){
                                              if (i==length(a))
                                                substr(x,a[i],nchar(as.character(x)))
                                              else
                                                substr(x,a[i],a[i+1]-1)}
                                        )))
colnames(df1)=paste0("x",1:dim(df1)[2])

df1
#    x1    x2 x3  x4 x5 x6  x7 x8  x9 x10 x11 x12  x13 x14 x15 x16 x17   x18 x19 x20 x21
# 1 uia gdsjg cj kh   b  i jac yd gas  xd   h   s fkaj   d   h  ,c  nf wkeyr  g,   u   r
# 2 kjh fkjsd lf koj  j  h gck ja snh  jh   c   k jsyb   s   a  nh  ds abtgc  hb   t   s

#   x22  x23  x24  x25    x26    x27 x28 x29 x30 x31 x32 x33
# 1   n yhvg uirw ljbh gkjgjg dkgkdg kgd   k   g   d   k   g
# 2   j ahas ijhc ndku ysefiu wyhsni dxj   n   k   a   u   s

#                                               x34 x35 x36 x37
# 1 dkgdkgdkgdkgdkdgkdgkdgkdgkjdgkdwjbiuayeiuy ke,y nh  lgd iyl
# 2 etfba jwf,mycaiusftbbawubbctejdgkjdghjgdduiacwy fta cbm

【讨论】：

不错。什么是运行时？使用stringi 会更快吗？
@smci 因为 OP 没有共享样本数据，我只是在一个非常小的数据上运行（仅 2 个 obs）！！所以没有必要在此运行 system.time()
这仅显示前 36 列，最后一列由于某种原因丢失。但运行时间只有 2 秒！哇！请帮助最后一英里。我并不完全熟悉所有这些命令，因此需要一段时间才能理解。
@90.hitesh 请分享您的数据样本，以便我可以运行并比较速度
@joel.wilson 已共享数据。但是任务完成了！运行时间为 2 秒。非常感谢。

【解决方案2】：

似乎readr 包（Hadley 的 tidyverse 的一部分）提供了一种更快的解决方案，可以一次性读取和拆分固定宽度的文件。

dropbox 上的给定示例文件在我的系统上花费了 0.17 秒的运行时间来读入并返回 65,926 × 37 的 data.frame。

library(readr)

a <- c(1,4,9,11,14,15,16,19,21,24,26,27,28,32,33,34,36,38,43,45,46,47,48,52,56,60,66,72,
       75,76,77,78,79,80,127,130,133)

z <- read_fwf("R71252L01.TXT", fwf_widths(diff(c(a, 142))),
              col_types = stringr::str_dup("c", length(a)))

输出是一个tibble，一个改进的data.frame：

print(z, n = 3, width = Inf)

# A tibble: 65,926 × 37
     X1    X2    X3    X4    X5    X6    X7    X8    X9   X10
  <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1   000 37773    71   252     1     1   012    05   005    01
2   000 37773    71   252     1     1   012    05   005    01
3   000 37773    71   252     1     1   012    05   005    01
    X11   X12   X13   X14   X15   X16   X17   X18   X19   X20
  <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1     1     2  0110     1     2    01    01 00000    01     1
2     1     2  0110     1     2    02    01 00000    01     1
3     1     2  0110     1     2    03    01 00000    01     1
    X21   X22   X23   X24   X25    X26    X27   X28   X29   X30
  <chr> <chr> <chr> <chr> <chr>  <chr>  <chr> <chr> <chr> <chr>
1     1  <NA>  6538  4001  <NA> 120314 310314   115     2     2
2     1  <NA>  6538  4001  <NA> 120314 310314    90     2     2
3     1  <NA>  6538  4001  <NA> 130314 310314    90     2     2
    X31   X32   X33   X34   X35   X36   X37
  <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1     2     2     2  <NA>     1     2 21433
2     2     2     2  <NA>     1     2 21433
3     2     2     2  <NA>     1     2 21433

说明

您可以指定字段宽度或字段的开始和结束位置。使用diff 从给定的起始位置a 计算宽度需要更少的编码。但是，必须以任何方式指定结束位置 (142)。
为了与 Q 保持一致，我使用参数 col_types = stringr::str_dup("c", length(a)) 强制所有列的类型为 character。如果 OP 需要其他类型的列，可以根据需要指定或依赖内置的类型识别，参见help("read_fwf")。
我也尝试过read.fwf()，但这速度慢了很多（经过了 32.7 秒的时间）。

【讨论】：