在r中不规则分组聚合数据（有更好的标题吗？）

我有这样一个数据框：

ship_schedule<-c(1,0,1,0,1,0,0,
             1,0,0,1,0,1,0,
             0,1,0,1,0,1,0,
             0,1,0,0,1,1,0,
             1,0,0,1,0,1,0,
             1,0,1,0,1,1,0,
             0,1,0,1,1,1,0,
             1,0,1,1,0,1,0,
             1,0,1,1,1,1,0,
             0,1,1,1,1,1,0,
             0,1,1,1,1,1,1,
             1,0,1,1,1,1,1,
             1,1,1,1,1,1,0,
             1,1,1,1,1,1,1)

store <- rep(1:2, each=7*14*2)
type <- rep(c("a", "b"), each=7*14, times=2)
template <- rep(1:14, each=7, times=4) # I have 14 schedules and each one associated with 7 days
schedule <- rep(ship_schedule, times=4)
day <- rep(1:7, times=2*14*2)
demand<-sample(1:2,392,replace=T)
data <- data.frame(store, type, template, schedule, demand)

---

ship\u schedule我仍然不确定我是否完全理解，但无论如何，这里有一个尝试，可能会有所帮助：

set.seed(101) ##before copy-pasting your code

首先，我们可以定义一个函数，用于查找1及其直接连续的1，并进行主要计算（至少这是我从问题中理解的）：

ff我根本不明白你对“1010100”的描述。每个数字对应一天吗？从什么开始？@MrFlick是的，这是模板1在数据中的样子。有7天，每天的时间表是0或1。但这仍然不能解释任何事情，也不能解释它与船舶有什么关系。“1010100”==“第一艘船的装运是周二和周三的总需求量”周二/周三是连续的。它们是最后两个零吗？你的模板是从星期二开始的吗？这没有任何意义。这个问题确实需要做一些工作。请假设我们对您的内容区域一无所知。我在数据中看不到一周中的任何一天。我不知道你想要什么。同时显示您想要的输出可能会有所帮助。否则，这个问题可能会被解决，因为很难理解你想要的是什么。@flick先生，周一的第一批货是满足周二和周三需求的最好办法。它是这样设计的。是的，模板可以从星期二开始。我的想法是计算两个1之间的指数差距，并将需求加总到第一个1。
set.seed(101) ##before copy-pasting your code

ff <- function(sched, dem)                                          
{
   inds <- which(as.logical(sched))
   sched2 <- rep(sched, 2)
   dem2 <- rep(dem, 2)
   res <- sapply(inds, 
            function(z) sum(dem2[(z + 1) : (which.max(tail(sched2, -z)) + z)]))
   ret <- numeric(7)
   ret[inds] <- res
   return(ret)
}
##test with the sample output shown
ff(c(1,0,1,0,1,0,0), c(1,2,2,1,1,2,1))
#[1] 4 0 2 0 4 0 0
ff(c(1,0,0,1,0,1,0), c(1,2,1,1,1,1,2))
#[1] 4 0 0 2 0 3 0

spl_data = split(data, 
                 interaction(data$store, data$type, data$template, drop = T))
new_data = do.call(rbind, lapply(spl_data, 
                                 function(x) {
                                   x$sum_dem = ff(x$schedule, x$demand)
                                   return(x)
                                 }))

rbind.data.frame(head(new_data, 7), "...", tail(new_data, 7))
#           store type template schedule demand sum_dem
#1.a.1.1        1    a        1        1      1       3
#1.a.1.2        1    a        1        0      1       0
#1.a.1.3        1    a        1        1      2       3
#1.a.1.4        1    a        1        0      2       0
#1.a.1.5        1    a        1        1      1       4
#1.a.1.6        1    a        1        0      1       0
#1.a.1.7        1    a        1        0      2       0
#8            ... <NA>      ...      ...    ...     ...
#2.b.14.386     2    b       14        1      2       2
#2.b.14.387     2    b       14        1      2       1
#2.b.14.388     2    b       14        1      1       1
#2.b.14.389     2    b       14        1      1       2
#2.b.14.390     2    b       14        1      2       1
#2.b.14.391     2    b       14        1      1       1
#2.b.14.392     2    b       14        1      1       2
#Warning message:
#In `[<-.factor`(`*tmp*`, ri, value = "...") :
#  invalid factor level, NA generated