R 循环 - 有更有效的方法吗？

Question

我有一个数据框，其中每一行都有一个唯一的 ID。我需要根据开始日期和结束日期的最大值以及批准日期之间的天数复制这些行中的每一行。

ID <- c(1,2)

Value <- c(10,20)

StartDate <- c(as.Date("01/01/2015", '%d/%m/%Y'),
    as.Date("01/01/2015", '%d/%m/%Y'))

EndDate <- c(as.Date("31/01/2015", '%d/%m/%Y'), 
    as.Date("15/01/2015", '%d/%m/%Y'))

AppDate <- c(as.Date("15/01/2015", '%d/%m/%Y'), 
    as.Date("15/02/2015", '%d/%m/%Y'))

df <- data.frame(ID, Value, StartDate, EndDate, AppDate)

df <- df[rep(row.names(df), ifelse(as.numeric(df$AppDate) >
    as.numeric(df$EndDate),as.numeric(df$AppDate-df$StartDate),
    as.numeric(df$EndDate-df$StartDate)) + 1),]

然后我需要添加一个顺序列表，从开始日期到结束日期或批准日期的最大值。

我已经通过 2 个循环完成了此操作。外层循环为每个唯一 ID 遍历数据帧。然后第二个循环遍历 ID 并添加日期。一旦第二个循环完成，它将行传递到外循环作为新的起点。

IDs <- unique(df$ID)
df$Days <- rep(as.Date("01/01/1999",'%d/%m/%Y'), nrow(df))
counter <- 1
for (i in 1:length(IDs)) {
    ref <- IDs[i]
    start <- 1
        while (df$ID[counter] == ref) {
            ifelse(start == 1, df$Days[counter] <- df$StartDate[counter],
                df$Days[counter] <- df$StartDate[counter] + start -1)
            ifelse (counter > nrow(df), break, counter <- counter + 1)
            ifelse (counter > nrow(df), break, start <- start + 1)
        }
 }

我的实际数据集有超过 6,000 个 ID，一旦我复制了行，它最终超过 500,000 行。循环花费了超过 15 分钟到运行，所以它显然是非常低效的。

所以我想我有 2 个问题。

1).在 R

中最有效的方法是什么

2).一般来说，最有效的方法是什么，比如说 C++

谢谢

Answer 1

这是一个矢量化的解决方案。注意：您的代码与我尝试做的取 EndDate 和 AppDate 最大值的概念不匹配，但如果这不是您想要的，您可以相应地修改代码。

library(dplyr)
df <- df %>% group_by(ID) %>% mutate(Days = rep(seq(min(StartDate), max(EndDate, df$AppDate), 'days'), ceiling(nrow(df) / n()))[1:n()])

输出如下（仅前几行）：

head(df)
Source: local data frame [6 x 6]
Groups: ID [1]

     ID Value  StartDate    EndDate    AppDate       Days
  (dbl) (dbl)     (date)     (date)     (date)     (date)
1     1    10 2015-01-01 2015-01-31 2015-01-15 2015-01-01
2     1    10 2015-01-01 2015-01-31 2015-01-15 2015-01-02
3     1    10 2015-01-01 2015-01-31 2015-01-15 2015-01-03
4     1    10 2015-01-01 2015-01-31 2015-01-15 2015-01-04
5     1    10 2015-01-01 2015-01-31 2015-01-15 2015-01-05
6     1    10 2015-01-01 2015-01-31 2015-01-15 2015-01-06

tail(df)
Source: local data frame [6 x 6]
Groups: ID [1]

     ID Value  StartDate    EndDate    AppDate       Days
  (dbl) (dbl)     (date)     (date)     (date)     (date)
1     2    20 2015-01-01 2015-01-15 2015-02-15 2015-02-10
2     2    20 2015-01-01 2015-01-15 2015-02-15 2015-02-11
3     2    20 2015-01-01 2015-01-15 2015-02-15 2015-02-12
4     2    20 2015-01-01 2015-01-15 2015-02-15 2015-02-13
5     2    20 2015-01-01 2015-01-15 2015-02-15 2015-02-14
6     2    20 2015-01-01 2015-01-15 2015-02-15 2015-02-15

Answer 2

通常，我会推荐交叉连接 SQL 查询 returns 笛卡尔积（两组之间的所有组合）。但是，您可以使用 merge() 不带任何 by 参数并使用 all=True 在 R 中复制交叉连接。从那里，筛选 EndDate 截止：

# CALCULATE CONDITIONAL END DATE
df$TrueEndDate <- as.Date(ifelse(df$AppDate > df$EndDate,
                                 df$AppDate,
                                 df$EndDate), origin="1970-01-01")

# CREATE A SEQUENTIAL DATES DATA FRAME (HERE IS 60 DAYS FROM 2015-01-01)
dates <- data.frame(Date=as.Date(unlist(lapply(0:60, function(x) 
                                      as.Date("2015-01-01") + x)),                    
                                 origin="1970-01-01"))   

# RUN CROSS JOIN MERGE, PULLING ONLY NEEDED FIELDS
mergedf <- merge(df[c('ID', 'StartDate', 'TrueEndDate')], dates, all=TRUE)

# FILTER OUT DATES PAST ROW'S TRUE END DATE
mergedf <- mergedf[(mergedf$Date <= mergedf$TrueEndDate),]

# CLEANUP
mergedf <- mergedf[with(mergedf, order(ID)), ]     # ORDER BY ID
row.names(mergedf) <- 1:nrow(mergedf)              # RESET ROW NAMES

如果您对等效的交叉连接感到好奇 SQL（您可以在 RDMS 引擎上调用 R 并导入为最终数据框，可能有助于解决性能问题）：

SELECT ID.ID, ID.Value, ID.StartDate, 
       CASE WHEN ID.AppDate > ID.EndDate 
            THEN ID.AppDate 
            ELSE ID.EndDate 
       END As TrueEndDate, 
Dates.Dates
FROM ID, Dates
WHERE  Dates.Dates <= CASE WHEN ID.AppDate > ID.EndDate 
                           THEN ID.AppDate ELSE ID.EndDate 
                      END
ORDER BY ID.ID, Dates.Dates

R 循环 - 有更有效的方法吗？

R loops - is there a more efficient way?

loops

for-loop

r

nested-loops