FAST in R

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

別の可能性：

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 

Answer 3

ここpurrr::dmap()との組み合わせでカスタム関数内でgsubを使用して、別の方法です -に相当しますを出力しますが、listの代わりにdata.frameを出力します。ここで、出力character列が、あなたはいつもあなたが好きなら考慮するためにそれらを変換することができ

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 = ".*_")) 

は注意してください。