문자열 열을 빠르게 나누기 R

Question

나는 107 개의 열과 745,000 개의 행을 가진 데이터 프레임을 가지고 있습니다 (예제보다 훨씬 큽니다).

대소 문자를 구분할 문자 유형 열이 있습니다. 각 문자 열의 끝 부분에 일부 문자가 포함되어있는 것 같습니다.

이러한 유형 끝 부분을 새 열로 강조하고 싶습니다.

나는 내 자신의 솔루션을 만들었지 만 모든 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을 출력합니다.

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

여기 출력은 character입니다. 원하는 경우 언제든지 인자로 변환 할 수 있습니다.