时间戳

首页 > 解决方案 > 有没有更快的方法通过比较 R 中第 i 行和第 i-1 行的 4 个其他向量来创建新向量？

r - 有没有更快的方法通过比较 R 中第 i 行和第 i-1 行的 4 个其他向量来创建新向量？

问题描述

想象一下，您有一个客户数据集，其中包含他们的购买历史。

数据按客户和他们的活动（即购买）日期订购

目标是计算他们的购买频率，但速度很快

Data <- tibble(Customer = c("Person A", "Person A", "Person A", "Person A", "Person A", "Person A","Person B", "Person C","Person C"),
           First_Activity_Date = c(1,1,1,1,1,1,1,1,1),   # imagine these numbers as dates
           Activity_Date = c(1,2,3,4,5,6,1,1,2),         
           Last_Activity_Date =c(6,6,6,6,6,6,1,2,2)
           )

View(Data)

tic()
h <- vector( "integer", length = 9)
f <- function(x, y, z, q){
     for( i in 1:length(x)){
         if ( identical(z[i],y[i])) { h[i] <- 1 }
         else if ( identical(x[i],x[i-1]) && (z[i]<=q[i])) { h[i] <- (h[i-1]+1) }
       }
     return(h)
     }

Data <- mutate(Data, Frequency = f(Customer, First_Activity_Date, 
Activity_Date, Last_Activity_Date) )

View(Data)
toc()



#Data <- select( Data, Customer, First_Activity_Date, Activity_Date, Last_Activity_Date) 
#remove(h)
#remove(f)

它适用于填充数字的小型数据集，但如果行号超过 50K 并填充日期，则需要大约 2 分钟。

有没有办法向量化这个函数/计算？

标签： rfor-loopif-statementvectorcomparison

解决方案

让我们建立一个替代解决方案

f1 <- function(x, y, z, q) {

使用传递给函数的参数在函数内部分配结果向量

    h <- integer(length(x)) # allocate the result inside the function

您的循环由可以“矢量化”的部分组成（一个函数调用，而不是循环的每次迭代的函数调用）。编写矢量化版本

    tst_1 <- z == y        # 'hoist' outside loop as vectorized comparison
    h[tst_1] <- 1L         # update h; '1L': integer, not '1': numeric

条件的else部分有一个错误 when i == 1，因为人们试图与x[1]不存在的进行比较x[0]。假设我们从不输入条件 for i == 1，所以向量化版本是

    tst_2 <- !tst_1 & c(FALSE, tail(x, -1) == head(x, -1)) & z <= q

实现更新的最直接的方法h是一个简单的循环，如

    for (i in which(tst_2))
        h[i] <- h[i - 1] + 1L

最后返回结果

    h
}

稍作调整的完整功能是

f1 <- function(x, y, z, q) {
    h <- integer(length(x)) # allocate the result inside the function
    ## if (...)
    h[z == y] <- 1L
    ## else if (...)
    tst <- !h & c(FALSE, x[-1] == x[-length(x)]) & z <= q
    for (i in which(tst))
        h[i] <- h[i - 1] + 1L
    h
}

通过关注剩余的循环可以进一步提高性能for()，但也许这已经让您获得所需的性能，而不会太神秘？

还可以更清晰地分离选择相关事件的“过滤”操作

keep <- (y >= z) & (z <= q)
x0 <- x[keep]

从对每个组的操作过程中。在这里，您正在创建一个从 1 到组成员数的分组序列。几种方法是

h0 <- ave(seq_along(x0), x0, FUN=seq_along)

或者

grp_size = rle(x0)$lengths
offset = rep(cumsum(c(0L, grp_size[-length(grp_size)])), grp_size)
h0 <- seq_len(sum(grp_size)) - offset

或者

grp_size = tabulate(match(x0, unique(x0)))
offset = rep(cumsum(c(0L, grp_size[-length(grp_size)])), grp_size)
h0 <- seq_len(sum(grp_size)) - offset

这个问题的其他解决方案可以在 StackOverflow 的其他地方找到。最后一步是创建返回值

h <- integer(length(x))
h[keep] <- h0
h

Data是一个小标题，所以也许你对 dplyr 很熟悉。以可理解但不一定有效的方式实现结果的一种方法是

d0 <- Data %>%
    filter(
        Activity_Date >= First_Activity_Date, 
        Activity_Date <= Last_Activity_Date
    ) %>% 
    group_by(Customer) %>%
    mutate(Frequency = seq_along(Customer))
left_join(Data, d0)

推荐阅读