Формирование бина в R data.frame

Я не мог придумать чистый способ сделать это с помощью apply/data.table и т. д., поскольку у вас есть зависимость между строками и фрейм данных изменяющегося размера. Вероятно, вы можете сделать это итеративно/рекурсивно, но я чувствовал, что будет быстрее понять, просто написать цикл. Одна из проблем заключается в том, что трудно узнать окончательный размер вашего объекта, поэтому это, вероятно, будет медленным. Вы можете несколько смягчить проблему, переключившись с df на матрицу (код должен работать нормально, за исключением битов преобразования), если производительность в этом приложении является проблемой.

fun <- function(df, binsize){
  df$cumsum <- cumsum(df$quantity)
  df$bin <- 1
  i <- 1
  repeat {
    if((extra <- (df[i, "cumsum"] - binsize)) > 0) { # Bin finished halfway through
      top <- if(i > 1L) df[1L:(i - 1L), ] else df[0L, ]
      mid <- transform(df[i, ], quantity=quantity-extra, cumsum=cumsum-extra)
      bot <- transform(df[i, ], quantity=extra, cumsum=extra, bin=bin + 1L)
      end <- if(i >= nrow(df)) df[0L, ] else df[(i + 1L):nrow(df), ]
      end <- transform(end, cumsum=cumsum(end$quantity) + extra, bin=bin + 1L)
      df <- rbind(top, mid, bot, end)
    } else if (extra == 0 && nrow(df) > i) {  # Bin finished cleanly
      df[(i + 1L):nrow(df), ]$cumsum <- df[(i + 1L):nrow(df), ]$cumsum - binsize
      df[(i + 1L):nrow(df), ]$bin <- df[(i + 1L):nrow(df), ]$bin + 1L
    }
    if(nrow(df) < (i <- i + 1)) break
  }
  rownames(df) <- seq(len=nrow(df))
  df
}
fun(df, binsize) 

#    category quantity cumsum bin
# 1         a       20     20   1
# 2         b       30     50   1
# 3         c       50     50   2
# 4         c       50     50   3
# 5         d       10     10   4
# 6         e        1     11   4
# 7         f       23     34   4
# 8         g        3     37   4
# 9         h       13     50   4
# 10        h       50     50   5
# 11        h       50     50   6
# 12        h       50     50   7
# 13        h       37     37   8

Другое решение с циклом:

DF <- read.table(text="category quantity
a          20
b          30
c          100
d          10
e          1
f          23
g          3
h          200", header=TRUE)

bin_size <- 50
n_bin <- ceiling(sum(DF$quantity)/bin_size)

DF$bin <- findInterval(cumsum(DF$quantity)-1, c(0, seq_len(n_bin)*50))
DF$cumsum <- cumsum(DF$quantity)

result <- lapply(seq_along(DF[,1]), function(i, df) {
  if (i==1) {
    d <- df[i, "bin"]
  } else {
    d <- df[i, "bin"]-df[i-1, "bin"]
  }
  if (d > 1) {    
    res <- data.frame(
      category = df[i, "category"],
      bin_nbr = df[i, "bin"]-seq_len(d+1)+1
    )        
    res[,"quantity"] <- bin_size
    if (i!=1) {
      res[nrow(res),"quantity"] <- df[i-1, "bin"]*bin_size-df[i-1, "cumsum"]
    }  else {
      res[nrow(res),"quantity"] <- 0
    }
    res[1,"quantity"] <- df[i, "quantity"]-sum(res[-1,"quantity"])
    return(res[res$quantity > 0,])
  } else {
    return(data.frame(
      category = df[i, "category"],
      quantity = df[i, "quantity"],
      bin_nbr = df[i, "bin"]
    ))
  }
}, df=DF)

res <- do.call(rbind, result)
res <- res[order(res$category, res$bin_nbr),]
library(plyr)
res <- ddply(res, .(bin_nbr), transform, cumsum=cumsum(quantity))
res

#    category quantity bin_nbr cumsum
# 1         a       20       1     20
# 2         b       30       1     50
# 3         c       50       2     50
# 4         c       50       3     50
# 5         d       10       4     10
# 6         e        1       4     11
# 7         f       23       4     34
# 8         g        3       4     37
# 9         h       13       4     50
# 10        h       50       5     50
# 11        h       50       6     50
# 12        h       50       7     50
# 13        h       37       8     37

Это сводится к объединению границ бинов с данными, которые дают это решение без петель:

library(zoo)

fun <- function(DF, binsize = 50) {
  nr <- nrow(DF)
  DF2 <- data.frame(cumsum = seq(0, sum(DF$quantity), binsize) + binsize, bin_nbr = 1:nr)
  DF.cs <- transform(DF, cumsum = cumsum(DF$quantity))
  m <- na.locf(merge(DF.cs, DF2, all = TRUE), fromLast = TRUE)
  m$bin_nbr <- as.numeric(m$bin_nbr)
  cs <- as.numeric(m$cumsum)
  m$quantity <- c(cs[1], diff(cs))
  m$cumsum <- ave(m$quantity, m$bin_nbr, FUN = cumsum)
  na.omit(m)[c("category", "quantity", "cumsum", "bin_nbr")]
}

давая:

> fun(DF)
   category quantity cumsum bin_nbr
1         a       20     20       1
2         b       30     50       1
3         c       50     50       2
4         c       50     50       3
5         d       10     10       4
6         e        1     11       4
7         f       23     34       4
8         g        3     37       4
9         h       13     50       4
10        h       50     50       5
11        h       50     50       6
12        h       50     50       7
13        h       37     37       8

Примечание. Для воспроизведения приведенного выше результата мы использовали следующие входные данные:

Lines <- "category quantity
a          20
b          30
c          100
d          10
e          1
f          23
g          3
h          200
"
DF <- read.table(text = Lines, header = TRUE, as.is = TRUE)

REVISION Исправлена ​​ошибка в коде.