ルックアップアルゴリズムの効率を向上させるR

Question

Rコードを最適化するのは興味深い作業だと思います。私と一緒にいらしてください。

私はデータショップdf_redを持っており、ウェブショップの注文書に詳しく記載されています。それぞれの製品（ean）について、私は12個の最も可能性が高い他の製品をそのバスケットに入れたいと思っています。

これが設定され、そのようなデータを生成するためのサンプルコードです：

library(tidyverse) 

# create a vector with 1400 products (characterized by their EANs) 
eans <- sample(1e5:1e6, 1400, replace = FALSE) 
# create a vector with 200k orders 
basket_nr <- 1:2e5 

# a basket can have up to 4 items, it's most likely to have 3 items 
n_prod_per_basket <- sample(x = 1:4, length(basket_nr), prob = c(0.2, 0.2, 0.5, 0.1), replace = TRUE) 

# create df_red, each line of which correspond to a product with it's respective basket number 
df <- data_frame(basket_nr, n_prod_per_basket) 

df_red <- data_frame(basket_nr = rep(basket_nr, n_prod_per_basket)) 
df_red$ean <- sample(x = eans, nrow(df_red), replace = TRUE) 

私は、このタスクを達成するために使用していたコードは以下の通りです。しかし、私はそれが効率的ではないと確信しています。どうすればプログラムのスピードを上げることができますか？

ean <- unique(df_red$ean) 

out <- list() 

for (i in 1:length(ean)){ 

ean1 <- ean[i] 
# get all basket_nr that contain the ean in question 
basket_nr <- df_red[df_red$ean == ean1, ]$basket_nr 

# get products that were together in the same basket with the ean in question 
boo <- (df_red$ean != ean1) & (df_red$basket_nr %in% basket_nr) 
prod <- df_red[boo, ] 

# get top most frequent 
top12 <- prod %>% 
group_by(ean) %>% 
summarise(n = n()) %>% 
arrange(desc(n)) %>% 
filter(row_number() %in% 1:12) 

# skip products that weren't together in a basket with at least 12 different other products 
if(nrow(top12) == 12) out[[i]] <- data_frame(ean = ean1, recom = top12$ean, freq = top12$n) 

if(i %% 100 == 0) print(paste0(round(i/length(ean)*100, 2), '% is complete')) 

} 

Answer 1

パフォーマンスの改善は、もちろん程度の問題です。それが改善される前にどこまで行くべきか「十分」とは言い難い。ただし、コードを機能化し、サブセット化ロジックをクリーンアップすることで、実行時間を約25％短縮できます。あなたのコードから始める：

#added a timer 
start.time <- Sys.time() 
for (i in 1:length(ean)){ 

    ean1 <- ean[i] 
    # get all basket_nr that contain the ean in question 
    basket_nr <- df_red[df_red$ean == ean1, ]$basket_nr 

    # get products that were together in the same basket with the ean in question 
    boo <- (df_red$ean != ean1) & (df_red$basket_nr %in% basket_nr) 
    prod <- df_red[boo, ] 

    # get top most frequent 
    top12 <- prod %>% 
    group_by(ean) %>% 
    summarise(n = n()) %>% 
    arrange(desc(n)) %>% 
    filter(row_number() %in% 1:12) 

    # skip products that weren't together in a basket with at least 12 different other products 
    if(nrow(top12) == 12) out[[i]] <- data_frame(ean = ean1, recom = top12$ean, freq = top12$n) 

    if(i %% 100 == 0) print(paste0(round(i/length(ean)*100, 2), '% is complete')) 

} 
Sys.time() - start.time 

私のマシンでは30〜34秒かかります。しかし、我々はそうのような関数としてそれを書き換えることができます：

my.top12.func <- function(id, df_red) { 
    #improved subsetting logic - using which is faster and we can remove some code by 
    #removing the ean that is being iterated in the filter step below 
    prod <- df_red[df_red$basket_nr %in% df_red$basket_nr[which(df_red$ean == id)], ] 

    # set cutoff from 12 to 13 since the specific ean will always be one of the top 12 
    top12 <- prod %>% 
    group_by(ean) %>% 
    summarise(n = n()) %>% 
    arrange(desc(n)) %>% 
    filter(row_number() %in% 1:13 & ean != id) #additional filter required 

    # skip products that weren't together in a basket with at least 12 different other products 
    if(nrow(top12) == 12) return(data_frame(ean = id, recom = top12$ean, freq = top12$n)) 
} 

今、私たちが行うことによって、このアプローチの速さと正確さをテストすることができます。

start.time <- Sys.time() 
my.out <- lapply(ean, my.top12.func, df_red = df_red) 
Sys.time() - start.time 

#test for equality 
all.equal(out, my.out) 

を25％で約24〜26秒でどの+改善。

Answer 2

私はループを使用しないと考えます。

df_red$k <- 1 
df_s  <- left_join(df_red, df_red, by = "k") %>% 
      filter(ean.x != ean.y & basket_nr.x == basket_nr.y) %>% 
      group_by(ean.x) %>% 
      summarise(n = n()) %>% 
      arrange(desc(n)) %>% 
      filter(row_number() %in% 1:13) 

df_s.ct <- df_s %>% filter(row_number() == 12) 
df_s.fin <- df_s[df_s$ean.x %in% df_s.ct$ean.x, ] 

この中律速段階は、指数関数的に大きなデータセットを作成し、それ自体にデータセットをマージしleft_joinである（あなたが50,000ポイントを持っている場合、あなたは2.5Bポイントで新しいデータセットを作成することになります）。これは、データを保存して操作する最善の方法がdata.tableを使用していることを示しています。これは、特にdplyrと組み合わせた場合、この手順の速度を向上させます。