大任务在 R 中,如何避免循环更快 运行

Big tasks In R, how to avoid for loops to run faster

我的代码是 运行ning 但非常非常慢。所以这是一个大问题,它必须 运行 更快。所以这是任务: 我有一个包含电信记录的数据集,我想对每个客户的所有记录应用多个函数,并将结果放在另一个数据框中。

所以 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 更为复杂,因此我选择此模式搜索 cutsomer 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 循环运行 更快呢?

我会使用 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)

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

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

我们将通过使用(快得多的)应用函数来执行此操作,这将使我们能够在每一列上并行执行操作,而不是逐一执行。创建一个对每一列进行此类操作的函数。我们将把这个应用于每个 ID。

为了求均值和求和,我们可以使用(very fast)colMeanscolSums

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

你的 df1df2 示例中的 CUSTOMER_ID 我有一些空白问题,假设你没有。为了解决这个问题,我使用了

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