循环仅对第一行数据有效

为什么要另一个答案?

这个 OP has stated :

我已经开始工作了,但只是经过一个漫长的过程 (分裂,重塑为长和回到宽)。这个环是我的 试图缩短进程[…]

如果“longish”和“shorting the process”指的是运行时间,那么下面的方法比循环方法(通过 基准 .

重塑 tstrsplit() , melt() , dcast()

xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))

library(data.table)
library(magrittr)
setDT(xmpl) %>% 
  .[, c(tstrsplit(x, "(?<=[0-9]{2})", perl = TRUE, names = TRUE, type.convert = TRUE), 
        .(x = x))] %>% 
  melt(id.var = "x", measure.vars = list(seq(1, ncol(.) - 1, 2), seq(2, ncol(.) - 1, 2)), 
       value.name = c("item", "val")) %>% 
  dcast(x ~ sprintf("Item%02i", item), value.var = "val")

              x Item01 Item02 Item03 Item06 Item10 Item11 Item12
1: 015410661242     54     NA     NA     NA     66     NA     42
2: 022406391116     NA     24     NA     39     NA     16     NA
3: 034506611298     NA     NA     45     61     NA     NA     98

• tstrsplit() 使用带lookbehind的正则表达式在每两位数字后进行拆分,然后将结果转置以创建转换为整数的列。
• 熔化() 重塑 二 从宽到长同时测量变量。奇数列是项,偶数列是值。
• 最后, dcast() 用于将形状重塑回宽形状。新列名是使用 sprintf() 以确保10以下的列具有前导 0 以确保正确的列顺序。

基准

对于基准测试,给定的数据集太小。因此,我为不同的参数范围创建了虚拟数据:

• 决定 x 从3到10不等。
• 行数从10到1000不等。

我已经分别测试了(这里没有显示),项目的最大数量对基准时间的影响较小,因此固定在15。

到目前为止发布的大多数代码都对参数进行了硬编码,无法修改以使用其他参数。因此,包括三种不同的方法:

• 循环法 snoram
• snoram's reshape approach
• 这个答案中的重塑版本

这些代码稍加修改,以处理各种参数。

library(bench)
bm <- press(
  n_pair = c(3, 5, 10),
  n_row = 10^(1:3),
  {
    set.seed(1)
    max_items <- 15L
    xmpl0 <- 
      sapply(seq_len(n_row), function(x) {
        sprintf("%02i%02i", 
                sample(max_items, n_pair, FALSE),
                sample(99, n_pair, TRUE)) %>% 
          paste0(collapse = "") 
      }) %>% 
      data.frame(x = ., stringsAsFactors = FALSE)
    mark(
      snoram_loop = {
        xmpl <- copy(xmpl0)
        nc <- max_items
        xmpl[1 + 1:nc] <- vector(mode = "integer", length = 3)
        names(xmpl) <- c(names(xmpl)[1], sprintf("item%02i", 1:nc))
        np <- max(nchar(xmpl$x)) / 4
        # Iterate through the df row by row
        for (row in seq_len(nrow(xmpl))) { 
          # Iterate through each entry which has 3 item_number-value pairs
          for (pair in seq_len(np)) {
            item_number <- as.integer(
              substr(xmpl[["x"]][row], 4 * (pair - 1) + 1, 4 * (pair - 1) + 2)
            )
            value <- as.integer(
              substr(xmpl[["x"]][row], 4 * (pair - 1) + 3, 4 * (pair - 1) + 4)
            )
            xmpl[row, sprintf("item%02i", item_number)] <- value 
          }
        }
        xmpl
      },
      snoram_reshape = {
        xmpl <- copy(xmpl0)
        xmplsp <- gsub("(\\d{2})", "\\1 ", xmpl$x) %>% strsplit(" ")
        np <- max(lengths(xmplsp)) / 2
        xmpl2 <- data.frame(
          x       = rep(xmpl$x, each = np),
          item_no = lapply(xmplsp, function(x) x[seq(1, 2*np, 2)]) %>% unlist(),
          value   = lapply(xmplsp, function(x) x[-seq(1, 2*np, 2)]) %>% unlist() %>% as.integer()
        )
        result <- dcast(xmpl2, x ~ paste0("item", item_no))
        result
      },
      uwe_reshape = {
        xmpl <- copy(xmpl0)
        result <- setDT(xmpl) %>% 
          .[, c(tstrsplit(x, "(?<=[0-9]{2})", perl = TRUE, names = TRUE, type.convert = TRUE), 
                .(x = x))] %>% 
          melt(id.var = "x", measure.vars = list(seq(1, ncol(.) - 1, 2), seq(2, ncol(.) - 1, 2)), 
               value.name = c("item", "val")) %>% 
          dcast(x ~ sprintf("item%02i", item), value.var = "val")
        result
      },
      check = FALSE
    )
  })

由于循环方法也为非现有项和使用创建列,所以该检查已被关闭。 零 而不是 NA .

ggplot2::autoplot(bm)

使用的方法 tstrsplit() , 熔化() , dcast() 几乎总是更快,循环方法几乎总是比其他方法慢-除了有10行的情况。请注意对数时间刻度。

下表还显示了内存分配。循环方法分配的内存最多是整形方法的20倍。

tail(bm, 9)

# A tibble: 9 x 16
  expression n_pair n_row      min     mean   median     max `itr/sec` mem_alloc  n_gc n_itr total_time result
  <chr>       <dbl> <dbl> <bch:tm> <bch:tm> <bch:tm> <bch:t>     <dbl> <bch:byt> <dbl> <int>   <bch:tm> <list>
1 snoram_lo~      3  1000 145.04ms 148.78ms 148.67ms 152.8ms      6.72   12.27MB     4     4      595ms <data~
2 snoram_re~      3  1000  49.18ms  57.54ms  53.49ms  82.6ms     17.4     1.63MB     3     9      518ms <data~
3 uwe_resha~      3  1000   8.11ms   9.09ms   8.87ms  13.9ms    110.    925.19KB     0    56      509ms <data~
4 snoram_lo~      5  1000 246.04ms 248.31ms 247.39ms 251.5ms      4.03   19.96MB     5     3      745ms <data~
5 snoram_re~      5  1000  54.67ms  59.71ms  58.14ms  69.5ms     16.7     2.41MB     2     9      537ms <data~
6 uwe_resha~      5  1000  11.43ms  12.84ms  12.55ms  21.1ms     77.9     1.12MB     1    39      501ms <data~
7 snoram_lo~     10  1000 500.29ms 500.29ms 500.29ms 500.3ms      2.00   39.33MB     3     1      500ms <data~
8 snoram_re~     10  1000  65.59ms   69.1ms  66.53ms  77.4ms     14.5     4.41MB     2     8      553ms <data~
9 uwe_resha~     10  1000  18.41ms  20.71ms  20.61ms    29ms     48.3     1.88MB     1    25      518ms <data~
# ... with 3 more variables: memory <list>, time <list>, gc <list>

以下是您也可以考虑的味道:

library(magrittr) # for %>% which I use just for readability
library(data.table) # for dcast()

xmplsp <- gsub("(\\d{2})", "\\1 ", xmpl$x) %>% strsplit(" ")
xmpl2 <- data.frame(
  x       = rep(xmpl$x, each = 3),
  item_no = lapply(xmplsp, function(x) x[c(1,3,5)]) %>% unlist(),
  value   = lapply(xmplsp, function(x) x[-c(1,3,5)]) %>% unlist() %>% as.integer()
)
xmpl2
             x item_no value
1 022406391116      02    24
2 022406391116      06    39
3 022406391116      11    16
4 034506611298      03    45
5 034506611298      06    61
6 034506611298      12    98
7 015410661242      01    54
8 015410661242      10    66
9 015410661242      12    42

dcast(xmpl2, x ~ paste0("item", item_no))

             x item01 item02 item03 item06 item10 item11 item12
1 015410661242     54     NA     NA     NA     66     NA     42
2 022406391116     NA     24     NA     39     NA     16     NA
3 034506611298     NA     NA     45     61     NA     NA     98

所以逻辑建立在strsplit()而不是substr()之上,但我首先使用gsub()在值之间添加空格。

回答问题(1)当前循环有什么问题,以及(2)如何通过循环完成(尽管这可能不是最佳解决方案)。

(一)

if() 只接受一个值,而不是向量,因此将每个值强制放入第一个值所属的列中。

(二)

下面是一个循环的例子。逻辑是逐行处理,然后处理该行中的每个项-值对。

# Preset the vector
xmpl[1 + 1:12] <- vector(mode = "integer", length = 3)
names(xmpl) <- c(names(xmpl)[1], paste0("item", 1:12))


# Iterate through the df row by row
for (row in seq_len(nrow(xmpl))) { 
  # Iterate through each entry which has 3 item_number-value pairs
  for (pair in seq_len(3)) {
    item_number <- as.integer(
      substr(xmpl[["x"]][row], 4 * (pair - 1) + 1, 4 * (pair - 1) + 2)
    )
    value <- as.integer(
      substr(xmpl[["x"]][row], 4 * (pair - 1) + 3, 4 * (pair - 1) + 4)
    )
    xmpl[row, paste0("item", item_number)] <- value 
  }
}
xmpl
             x item1 item2 item3 item4 item5 item6 item7 item8 item9 item10 item11 item12
1 022406391116     0    24     0     0     0    39     0     0     0      0     16      0
2 034506611298     0     0    45     0     0    61     0     0     0      0      0     98
3 015410661242    54     0     0     0     0     0     0     0     0     66      0     42

在基R中:

xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))

want <- do.call(rbind, lapply(strsplit(as.character(xmpl$x), ""), 
                              function(x) {
                                res <- t(matrix(unlist(x), nrow = 4))
                                items <- paste0(res[,1], res[,2])
                                values <- paste0(res[,3], res[,4])
                                id <- paste(x, collapse = "")
                                res <- data.frame(x = id, items = items,
                                                  values = as.numeric(values))
                            res
                          }))

library(reshape2)
want <- dcast(want, x ~ paste0("item", items), value.var = "values")
want

#             x item01 item02 item03 item06 item10 item11 item12
#1 022406391116     NA     24     NA     39     NA     16     NA
#2 034506611298     NA     NA     45     61     NA     NA     98
#3 015410661242     54     NA     NA     NA     66     NA     42

# modified:

xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))

dummy <- matrix(strsplit(paste(as.character(xmpl$x), collapse = ""), "")[[1]], nrow = 4)
want <- data.frame(x = rep(as.character(xmpl$x), each = 3), 
                   items = paste0(dummy[1,], dummy[2,]),
                   values = paste0(dummy[3,], dummy[4,]))
library(reshape2)
(want <- dcast(want, x ~ paste0("item", items), value.var = "values"))

#              x item01 item02 item03 item06 item10 item11 item12
#1 015410661242     54   <NA>   <NA>   <NA>     66   <NA>     42
#2 022406391116   <NA>     24   <NA>     39   <NA>     16   <NA>
#3 034506611298   <NA>   <NA>     45     61   <NA>   <NA>     98

在某些地方很复杂,但这是有效的:

require(tidyverse)
require(stringr)

xmpl <- data_frame(x = c("022406391116","034506611298", "015410661242"))

fn <- function(x, strt, end) {str_sub(x, strt, end) %>% as.integer()}

tmp <- xmpl %>% 
  mutate(
  key_1 = str_sub(x, 1,2),
  val_1 = fn(x, 3,4),
  key_2 = str_sub(x, 5,6),
  val_2 = fn(x, 7,8),
  key_3 = str_sub(x, 9,10),
  val_3 = fn(x, 11,12)
)

long <- reduce(
  .x = list(
   tmp %>% select(x, key = key_1, val = val_1),
   tmp %>% select(x, key = key_2, val = val_2),
   tmp %>% select(x, key = key_3, val = val_3)  ),
  bind_rows
) 

long %>% 
  transmute(x = x ,item = paste0("item_", key), val = val) %>% 
  spread(item, val)

# A tibble: 3 x 8 x item_01 item_02 item_03 item_06 item_10 item_11 item_12 <chr> <int> <int> <int> <int> <int> <int> <int> 1 015410661242 54 NA NA NA 66 NA 42 2 022406391116 NA 24 NA 39 NA 16 NA 3 034506611298 NA NA 45 61 NA NA 98

我不确定我是否完全理解您希望如何分配数字,但如果只是成对的数字,我会这样做:

xmpl <- data.frame(x = c("022406391116","034506611298", "015410661242"))
mytable <- do.call(rbind, lapply(xmpl$x, substring, seq(1,11,2), seq(2,12,2)))
colnames(mytable) <- paste("Item",1:6)
cbind(xmpl, mytable)

             x Item 1 Item 2 Item 3 Item 4 Item 5 Item 6
1 022406391116     02     24     06     39     11     16
2 034506611298     03     45     06     61     12     98
3 015410661242     01     54     10     66     12     42