2017-05-15 4 views
3

는 IF/다른 기능을 내가 노력하고의 mutate() 나는 예 dataframe에게이

df <- data.frame(cust = sample(1:100, 1000, TRUE), 
      channel = sample(c("WEB", "POS"), 1000, TRUE)) 

이 문제없이 작은 dataframes에서 작동
get_channels <- function(data) { 
    d <- data 
    if(unique(d) %>% length() == 2){ 
     d <- "Both" 
    } else { 
     if(unique(d) %>% length() < 2 && unique(d) == "WEB") { 
      d <- "Web" 
     } else { 
      d <- "POS" 
      } 
     } 
    return(d) 
} 

, 그것은 더 소요 변이 없습니다 시간. 데이터 프레임> 1000000 이상 cust의 순서에, 말하자면, 오히려 커질 0.34602 초

그러나

,의

start.time <- Sys.time() 

df %>% 
    group_by(cust) %>% 
    mutate(chan = get_channels(channel)) %>% 
    group_by(cust) %>% 
    slice(1) %>% 
    group_by(chan) %>% 
    summarize(count = n()) %>% 
    mutate(perc = count/sum(count)) 

end.time <- Sys.time() 
time.taken <- end.time - start.time 
time.taken 

시간 차이는 내 기본 if/else FX는 많이 소요 많이입니다.

어떻게하면이 기능을 간소화하여 더 빨리 실행할 수 있습니까?

답변

5

이 경우 data.table을 사용해야합니다.

setDT(df) 
t1 = Sys.time() 
df = df[ , .(channels = ifelse(uniqueN(channel) == 2, "both", as.character(channel[1]))), by = .(cust)] 

> Sys.time() - t1 
Time difference of 0.00500083 secs 

> head(df) 
    cust channels 
1: 37  both 
2: 45  both 
3: 74  both 
4: 20  both 
5: 1  both 
6: 68  both 
+0

감사합니다. 이것이'dplyr' 프레임 워크에서 가속화 될 수 있다면 어떨까요? – Steven

+0

@Steven 죄송합니다, 저는 dplyr에 대해 많은 경험이 없습니다. data.table은 일반적으로 더 빠릅니다. – Kristofersen

1

약 1/3 시간이 필요하지만, 여전히 아마 데이터 테이블 버전보다 느린 속도 dplyr 버전. uniqueN @ 크리스토퍼슨 대답에서 빌려 왔습니다.

내가 모두 dplyrdata.table의 세 가지 대안을 시도 ...

get_channels <- function(data) { 
    ud <- unique(data) 
    udl <- length(ud) 
    if(udl == 2) { 
     r <- "Both" 
    } else { 
     if(udl < 2 && ud == "WEB") { 
     r <- "Web" 
     } else { 
     r <- "POS" 
     } 
    } 
    return(r) 
    } 
1

그리고 어떤 타이밍 : 또한

df %>% 
    group_by(cust) %>% 
    summarize(chan = if_else(uniqueN(channel) == 2, "Both", as.character(channel[1]))) %>% 
    group_by(chan) %>% 
    summarize(n = n()) %>% 
    mutate(perc = n /sum(n)) 

, 당신의 orginal 한이 같은 함수를 최적화하여 크게 향상 될 수있다 : (1) ifelse (@ Kristofersen의 대답 참조), (2) if/ else ( test의 길이가 1이므로), (3) 벡터 인덱싱. 놀랍지 만 주된 차이점은 dplyrdata.table 사이이며 다른 1-3은 그렇지 않습니다.

1000 고객의 경우 data.table은 약 7 배 빠릅니다. 10000 고객의 경우 약 30 배 빠릅니다. 1e6 고객은 data.table 만 테스트했는데 대안 사이에는 큰 차이가 없었습니다.

# 1000 customers, 2*1000 registrations 
df <- data.frame(cust = sample(1e3, 2e3, replace = TRUE), 
       channel = sample(c("WEB", "POS"), 2e3, TRUE)) 

library(microbenchmark) 
library(dplyr) 
library(data.table) 

microbenchmark(dp1 = df %>% 
       group_by(cust) %>% 
       summarise(res = ifelse(n_distinct(channel) == 1, channel[1], "both")), 
       dp2 = df %>% 
       group_by(cust) %>% 
       summarise(res = if(n_distinct(channel) == 1) channel[1] else "both"), 
       dp3 = df %>% 
       group_by(cust) %>% 
       summarise(res = c("both", channel[1])[(n_distinct(channel) == 1) + 1]), 
       dt1 = setDT(df)[ , .(channels = ifelse(uniqueN(channel) == 2, "both", channel[1])), by = cust], 
       dt2 = setDT(df)[ , .(channels = if(uniqueN(channel) == 2) "both" else channel[1]), by = cust], 
       dt3 = setDT(df)[ , .(res = c("both", channel[1])[(uniqueN(channel) == 1) + 1]), by = cust], 
       times = 5, unit = "relative") 

# 1e3 customers 
# Unit: relative 
# expr  min  lq  mean median  uq  max neval 
# dp1 7.8985477 8.176139 7.9355234 7.676534 8.0359975 7.9166933  5 
# dp2 7.8882707 8.018000 7.8965098 8.731935 7.8414478 7.3560530  5 
# dp3 8.0851402 8.934831 7.7540060 7.653026 6.8305012 7.6887950  5 
# dt1 1.1713088 1.180870 1.0350482 1.209861 1.0523597 0.7650059  5 
# dt2 0.8272681 1.223387 0.9311628 1.047773 0.9028017 0.7795579  5 
# dt3 1.0000000 1.000000 1.0000000 1.000000 1.0000000 1.0000000  5 

# 1e4 customers 
# Unit: relative 
# expr  min   lq  mean median  uq  max neval 
# dp1 40.8725204 39.5297108 29.5755838 38.996075 38.246103 17.2784642  5 
# dp2 40.7396141 39.4299918 27.4476811 38.819577 37.886320 12.7265756  5 
# dp3 41.0940358 39.7819673 27.5532964 39.260488 38.317899 12.4685386  5 
# dt1 1.0905470 1.0661613 0.7422082 1.053786 1.034642 0.3428945  5 
# dt2 0.9052739 0.9008761 1.2813458 2.111642 2.356008 0.9005391  5 
# dt3 1.0000000 1.0000000 1.0000000 1.000000 1.000000 1.0000000  5 

# 1e6 customers, data.table only 
# Unit: relative 
# expr  min  lq  mean median  uq  max neval 
# dt1 1.146757 1.147152 1.155497 1.164471 1.156244 1.161660  5 
# dt2 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000  5 
# dt3 1.084442 1.079734 1.253568 1.106833 1.098766 1.799935  5 
3

당신은 그런 식으로 뭔가를 사용하여 기본 R에서 작업을 수행 할 수 있습니다

web_cust <- unique(df$cust[df$channel=="WEB"]) 
pos_cust <- unique(df$cust[df$channel=="POS"]) 

both <- length(intersect(web_cust, pos_cust)) 
web_only <- length(setdiff(web_cust, pos_cust)) 
pos_only <- length(setdiff(pos_cust, web_cust)) 

데이터 : 응답에 대한

set.seed(1) 
df <- data.frame(cust = sample(2e6, 1e7, TRUE), 
       channel = sample(c("WEB", "POS"), 1e7, TRUE), 
       stringsAsFactors = F) 
관련 문제