R中的大任务，如何避免for循环运行得更快

Question

我的代码正在运行，但非常非常缓慢。所以这是一个大问题，它必须运行得更快。所以这里是任务： 我有一个包含电信记录的数据集，我想对每个客户的所有记录应用多种功能，并将结果放入另一个数据框中。

所以df1 是数据框，其中每一行都有一个唯一的客户 ID 和带有一些配置文件信息的列。 df2 是一个非常大的数据框，其中包含通过客户 ID 识别的大约 800 000 条电信记录。现在我想计算例如df2 中每个客户的平均数据使用量，并将结果保存在 df1 中。

df1 看起来像

df1 <- read.table(header = TRUE, sep=",",
       text="CUSTOMER_ID,Age,ContractType, Gender
       ID1,45,Postpaid,m
       ID2,50,Postpaid,f
       ID3,35,Postpaid,f
       ID4,44,Postpaid,m
       ID5,32,Postpaid,m
       ID6,48,Postpaid,f
       ID7,50,Postpaid,m
       ID8,51,Postpaid,f")

df2 看起来像

 df2 <- read.table(header = TRUE, sep=",",
   text="CUSTOMER_ID,EVENT,VOLUME, DURATION, MONTH
   ID1,100,500,200,201505
   ID1,50,400,150,201506
   ID1,80,600,50,201507
   ID2,40,800,45,201505
   ID2,25,650,120,201506
   ID2,65,380,250,201507
   ID3,30,950,110,201505
   ID3,25,630,85,201506
   ID3,15,780,60,201507")

我的代码是这样的

USAGE <-  c("EVENT", "VOLUME", "DURATION") #column names of df2

我想在df2上应用的函数列表

 StatFunctions <- list(  
      max = function(x) max(x), 
      mean = function(x) mean(x), 
      sum = function(x) sum(x)
      )

在我的原始数据集中，客户 ID 更复杂，因此我选择此模式搜索切割者 ID。这只是我的代码的一部分。但其余的问题与 for 循环相同。

func.num <- function(prefix, target.df, n) {
    active.df <- get(target.df)
    return(StatFunctions[[n]](active.df[grep(pattern = prefix, 
    x = active.df$CUSTOMER_ID), USAGE[m]]))
  }


 for (x in df1$CUSTOMER_ID) {    
      for (m in 1:length(USAGE)) {    
        for (n in 1:length(StatFunctions)) {        
          df1[df1$CUSTOMER_ID == x, paste(names(StatFunctions[n]), 
          USAGE[m], sep = "_")] <- func.num(prefix = x, target.df = "df2",n)      
        }
    }
  }

我知道代码很复杂，应该简化一下。

我想要一个这样的数据框

Customer_ID Age contractType Gender max_EVENT mean_EVENT sum_EVENT ... sum_DURATION
ID1         45     Postpaid      m     100       76        230     ...     400

那么我怎样才能避免 for 循环运行得更快呢？

Answer 1

我会使用 dplyr 包按客户 ID 汇总 df2，然后与 df1 合并。

df1 <- read.table(header = TRUE, sep=",",
                  text="CUSTOMER_ID,Age,ContractType, Gender
       ID1,45,Postpaid,m
       ID2,50,Postpaid,f
       ID3,35,Postpaid,f
       ID4,44,Postpaid,m
       ID5,32,Postpaid,m
       ID6,48,Postpaid,f
       ID7,50,Postpaid,m
       ID8,51,Postpaid,f")


df2 <- read.table(header = TRUE, sep=",",
                  text="CUSTOMER_ID,EVENT,VOLUME, DURATION, MONTH
   ID1,100,500,200,201505
   ID1,50,400,150,201506
   ID1,80,600,50,201507
   ID2,40,800,45,201505
   ID2,25,650,120,201506
   ID2,65,380,250,201507
   ID3,30,950,110,201505
   ID3,25,630,85,201506
   ID3,15,780,60,201507")

df1$CUSTOMER_ID <- gsub(" ", "", df1$CUSTOMER_ID)
df2$CUSTOMER_ID <- gsub(" ", "", df2$CUSTOMER_ID)

library(dplyr)
USAGE <- c("EVENT", "VOLUME", "DURATION")
FUNC  <- c("max", "mean", "sum")
dots <- lapply(USAGE, function(u) sprintf("%s(%s)", FUNC, u)) %>% unlist()
dots <- setNames(dots, sub("\\)", "", sub("\\(", "_", dots)))
sum_df <- df2 %>% group_by(CUSTOMER_ID) %>%
  summarize_(.dots = dots) %>% 
  ungroup()

df1$CUSTOMER_ID <- as.character(df1$CUSTOMER_ID)
sum_df$CUSTOMER_ID <- as.character(sum_df$CUSTOMER_ID)
df1 <- left_join(df1, sum_df)

Answer 2

首先我们获取要操作的列和ID

mycols <- c("EVENT","VOLUME","DURATION")
id <- levels(df2$CUSTOMER_ID)

我们将通过使用（快得多的）应用函数来做到这一点，这将允许我们在每一列上并行执行操作，而不是一一进行。创建一个对每一列进行此类操作的函数。我们将应用于每个 ID。

为了取平均值和求和，我们可以使用 (very fast) colMeans 和 colSums。

applyfun <- function(i,FUN){
    FUN(df2[df2$CUSTOMER_ID == i,mycols])
}

为了最大化，我们创建一个类似的函数

colMax <- function (colData) {
    apply(colData, MARGIN=c(2), max)
}

应用三个功能

outmean <- sapply(id,applyfun,colMeans)
outsum <- sapply(id,applyfun,colSums)
outmax <- sapply(id,applyfun,colMax)

out <- data.frame(CUSTOMER_ID = rownames(t(outmean)), 
                  mean = t(outmean),
                  sum = t(outsum),
                  max = t(outmax))

将数据合并到df1

merge(df1,out,key = "CUSTOMER_ID",all.x = TRUE)

给出输出：

  CUSTOMER_ID Age ContractType Gender mean.EVENT ... max.DURATION
1         ID1  45     Postpaid      m   76.66667 ...          200
2         ID2  50     Postpaid      f   43.33333 ...          250
3         ID3  35     Postpaid      f   23.33333 ...          110
4         ID4  44     Postpaid      m         NA ...           NA

---

我在您的df1 和df2 示例中遇到了CUSTOMER_ID 的一些空白问题，假设您没有。为了解决这个问题，我使用了

df1$CUSTOMER_ID <- as.factor(trimws(df1$CUSTOMER_ID))
df2$CUSTOMER_ID <- as.factor(trimws(df2$CUSTOMER_ID))