Условная cumsum с reset

У меня есть фрейм данных, фрейм данных уже отсортирован по мере необходимости, но теперь мне захочется "нарезать его" в группах.

Эти группы должны иметь максимальное кумулятивное значение 10. Если кумулятивное значение > 10, оно должно reset суммарная сумма и начать снова заново

library(dplyr)
id <- sample(1:15)
order <- 1:15
value  <- c(4, 5, 7, 3, 8, 1, 2, 5, 3, 6, 2, 6, 3, 1, 4)
df  <- data.frame(id, order, value)
df

Это результат, который я ищу (я сделал это "вручную" )

cumsum_10  <- c(4, 9, 7, 10, 8, 9, 2, 7, 10, 6, 8, 6, 9, 10, 4)
group_10 <- c(1, 1, 2, 2, 3, 3, 4, 4, 4, 5, 5, 6, 6, 6, 7)
df1  <- data.frame(df, cumsum_10, group_10)
df1

Итак, у меня есть 2 проблемы

Как создать кумулятивную переменную, которая сбрасывается каждый раз, когда она проходит верхний предел (в этом случае 10)
Как считать/группировать каждую группу

В первой части я пытался несколько комбинаций group_by и cumsum без везения

df1 <- df %>% group_by(cumsum(c(False, value < 10)))

Я предпочел бы решение pipe (% > %) вместо цикла for

Спасибо

Ответ 1

Я думаю, что это нелегко истолковывается.... по крайней мере, я не знаю, как это сделать.

Вы можете сделать это by hand с помощью:

my_cumsum <- function(x){
  grp = integer(length(x))
  grp[1] = 1
  for(i in 2:length(x)){
    if(x[i-1] + x[i] <= 10){
      grp[i] = grp[i-1]
      x[i] = x[i-1] + x[i]
    } else {
      grp[i] = grp[i-1] + 1
    }
  }
  data.frame(grp, x)
}

Для ваших данных это дает:

> my_cumsum(df$value)
   grp  x
1    1  4
2    1  9
3    2  7
4    2 10
5    3  8
6    3  9
7    4  2
8    4  7
9    4 10
10   5  6
11   5  8
12   6  6
13   6  9
14   6 10
15   7  4

Также для моего "встречного примера" это дает:

> my_cumsum(c(10,6,4))
  grp  x
1   1 10
2   2  6
3   2 10

Как заметил @Hhashaa, это можно реализовать более эффективно с помощью Rcpp. Он связан с этим ответом Как ускорить или векторизовать цикл for?, который я считаю очень полезным

Ответ 2

В приведенной ниже функции используется рекурсия для построения вектора с длинами каждой группы. Это быстрее, чем цикл для небольших векторов данных (длина меньше, чем около ста значений), но медленнее для более длинных. Он принимает три аргумента:

1) vec: вектор значений, которые мы хотим сгруппировать.

2) i: индекс начального положения в vec.

3) glv: вектор групповых длин. Это возвращаемое значение, но нам нужно его инициализировать и передать через каждую рекурсию.

# Group a vector based on consecutive values with a cumulative sum <= 10
gf = function(vec, i, glv) {

  ## Break out of the recursion when we get to the last group
  if (sum(vec[i:length(vec)]) <= 10) {
    glv = c(glv, length(i:length(vec)))
    return(glv)
  }

  ## Keep recursion going if there are at least two groups left
  # Calculate length of current group
  gl = sum(cumsum(vec[i:length(vec)]) <= 10)

  # Append to previous group lengths
  glv.append = c(glv, gl)

  # Call function recursively 
  gf(vec, i + gl, glv.append)
}

Запустите функцию, чтобы вернуть вектор длины группы:

group_vec = gf(df$value, 1, numeric(0))
[1] 2 2 2 3 2 3 1

Чтобы добавить столбец в df с длиной группы, используйте rep:

df$group10 = rep(1:length(group_vec), group_vec)

В его текущей форме функция будет работать только на векторах, которые не имеют значений больше 10, и группировка суммами <= 10 жестко кодируется. Разумеется, эту функцию можно обобщить, чтобы справиться с этими ограничениями.

Функция может быть несколько ускорена, выполняя кумулятивные суммы, которые смотрят в будущее только на определенное количество значений, а не на оставшуюся длину вектора. Например, если значения всегда положительны, вам нужно только посмотреть десять значений вперед, так как вам не нужно будет суммировать более десяти чисел, чтобы достичь значения 10. Это тоже может быть обобщено для любого целевого значения. Даже с этой модификацией функция все еще медленнее, чем петля для вектора с более чем сотней значений.

Я раньше не работал с рекурсивными функциями в R и был бы заинтересован в любых комментариях и предложениях относительно того, имеет ли рекурсия смысл для этого типа проблемы и может ли она быть улучшена, особенно скорость выполнения.

Ответ 3

Вы можете определить свою собственную функцию, а затем использовать ее внутри инструкции dplyr mutate следующим образом:

df %>% group_by() %>%
  mutate(
    cumsum_10 = cumsum_with_reset(value, 10),
    group_10 = cumsum_with_reset_group(value, 10)
  ) %>% 
  ungroup()

Функция cumsum_with_reset() принимает столбец и пороговое значение, которое сбрасывает сумму. cumsum_with_reset_group() аналогичен, но идентифицирует строки, которые были сгруппированы вместе. Определения следующие:

# group rows based on cumsum with reset
cumsum_with_reset_group <- function(x, threshold) {
  cumsum <- 0
  group <- 1
  result <- numeric()

  for (i in 1:length(x)) {
    cumsum <- cumsum + x[i]

    if (cumsum > threshold) {
      group <- group + 1
      cumsum <- x[i]
    }

    result = c(result, group)

  }

  return (result)
}

# cumsum with reset
cumsum_with_reset <- function(x, threshold) {
  cumsum <- 0
  group <- 1
  result <- numeric()

  for (i in 1:length(x)) {
    cumsum <- cumsum + x[i]

    if (cumsum > threshold) {
      group <- group + 1
      cumsum <- x[i]
    }

    result = c(result, cumsum)

  }

  return (result)
}

# use functions above as window functions inside mutate statement
df %>% group_by() %>%
  mutate(
    cumsum_10 = cumsum_with_reset(value, 10),
    group_10 = cumsum_with_reset_group(value, 10)
  ) %>% 
  ungroup()