Question

我有一个包含107列和745000行的数据框（比我的例子大得多）。

案例是，我想要分隔的字符类型列，因为它们似乎包含一些在每个序列末尾结束的类型。

我想将这些类型结束部分用于新列。

我已经制定了自己的解决方案，但是对于遍历所有745000行53次来说似乎太慢了。

所以我将我的解决方案嵌入到以下代码中，包含一些任意数据：

set.seed(1)
code_1 <- paste0(round(runif(5000, 100000, 999999)), "_", round(runif(1000, 1, 15)))
code_2 <- sample(c(paste0(round(runif(10, 100000, 999999)), "_", round(runif(10, 1, 15))), NA), 5000, replace = TRUE)
code_3 <- sample(c(paste0(round(runif(3, 100000, 999999)), "_", round(runif(3, 1, 15))), NA), 5000, replace = TRUE)
code_4 <- sample(c(paste0(round(runif(1, 100000, 999999)), "_", round(runif(1, 1, 15))), NA), 5000, replace = TRUE)

code_type_1 <- rep(NA, 5000)
code_type_2 <- rep(NA, 5000)
code_type_3 <- rep(NA, 5000)
code_type_4 <- rep(NA, 5000)

df <- data.frame(cbind(code_1, 
                       code_2, 
                       code_3, 
                       code_4, 
                       code_type_1, 
                       code_type_2, 
                       code_type_3, 
                       code_type_4), 
                 stringsAsFactors = FALSE)

df_new <- data.frame(code_1 = character(),
                     code_2 = character(),
                     code_3 = character(),
                     code_4 = character(),
                     code_type_1 = character(),
                     code_type_2 = character(),
                     code_type_3 = character(),
                     code_type_4 = character(),
                     stringsAsFactors = FALSE)

for (i in 1:4) {
  i_t <- i + 4
  temp <- strsplit(df[, c(i)], "[_]")
  for (j in 1:nrow(df)) {
    df_new[c(j), c(i)] <- unlist(temp[j])[1]
    df_new[c(j), c(i_t)] <- ifelse(is.na(unlist(temp[j])[1]), NA, unlist(temp[j])[2])
  }
  print(i)
}

for (i in 1:8) {
 df_new[, c(i)] <- factor(df_new[, c(i)])
}

有没有人有一些想法如何在这里加快速度？

Answer 1

首先，我们将结果data.frame预分配到所需的最终长度。这是非常重要的;见The R Inferno, Circle 2。然后我们矢量化内循环。我们还使用fixed = TRUE并避免strsplit中的正则表达式。

system.time({
  df_new1 <- data.frame(code_1 = character(nrow(df)),
                       code_2 = character(nrow(df)),
                       code_3 = character(nrow(df)),
                       code_4 = character(nrow(df)),
                       code_type_1 = character(nrow(df)),
                       code_type_2 = character(nrow(df)),
                       code_type_3 = character(nrow(df)),
                       code_type_4 = character(nrow(df)),
                       stringsAsFactors = FALSE)

  for (i in 1:4) {
    i_t <- i + 4
    temp <- do.call(rbind, strsplit(df[, c(i)], "_", fixed = TRUE))

    df_new1[, i] <- temp[,1]
    df_new1[, i_t] <- ifelse(is.na(temp[,1]), NA, temp[,2])
  }

  df_new1[] <- lapply(df_new1, factor)
})
#   user      system     elapsed 
#  0.029       0.000       0.029 

all.equal(df_new, df_new1)
#[1] TRUE

当然，有一些方法可以让它更快，但这与您原来的方法很接近，应该足够了。

Answer 2

这是另一种方法，在自定义函数中使用gsub并结合purrr::dmap() - 相当于lapply，但输出data.frame而不是{{1} }}

list

请注意此处library(purrr) # Define function which gets rid of everything after and including "_" replace01 <- function(df, ptrn = "_.*") dmap(df[,1:4], gsub, pattern = ptrn, replacement = "") # Because "pattern" is argument we can change it to get 2nd part, then cbind() test <- cbind(replace01(df), replace01(df, ptrn = ".*_"))列的输出，如果您愿意，可以随时将它们转换为因子。

Answer 3

另一种可能性：

setNames(do.call(rbind.data.frame, lapply(1:nrow(df), function(i) {
  x <- stri_split_fixed(df[i, 1:4], "_", 2, simplify=TRUE)
  y <- c(x[,1], x[,2])
  y[y==""] <- NA
  y
})), colnames(df)) -> df_new

或

setNames(do.call(rbind.data.frame, lapply(1:nrow(df), function(i) {
  x <- stri_split_fixed(df[i, 1:4], "_", 2, simplify=TRUE)
  c(x[,1], x[,2])
})), colnames(df)) -> df_new
df_new[df_new==""] <- NA
df_new

稍快一点：

Unit: milliseconds
     expr      min       lq     mean   median       uq      max neval cld
 na_after 669.8357 718.1301 724.8803 723.5521 732.9998 790.1405    10  a 
 na_inner 719.3362 738.1569 766.4267 762.1594 791.6198 825.0269    10   b

在R中分割字符串列FAST

3 个答案: