Условная кумулятивная сумма: сброс счетчика - R [дубликат]

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

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 , и группировка суммами & lt; = 10 жестко кодируется. Разумеется, эту функцию можно обобщить, чтобы справиться с этими ограничениями.

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

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

Вы можете определить свою собственную функцию, а затем использовать ее в инструкции 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()

Мы можем воспользоваться функцией cumsumbinning из пакета MESS, который выполняет эту задачу:

library(MESS)
df %>%
  group_by(group_10 = cumsumbinning(value, 10)) %>%
  mutate(cumsum_10 = cumsum(value)) 

Выход

# A tibble: 15 x 5
# Groups:   group_10 [7]
      id order value group_10 cumsum_10
   <int> <int> <dbl>    <int>     <dbl>
 1     6     1     4        1         4
 2    10     2     5        1         9
 3     1     3     7        2         7
 4     5     4     3        2        10
 5     3     5     8        3         8
 6     9     6     1        3         9
 7    14     7     2        4         2
 8    11     8     5        4         7
 9    15     9     3        4        10
10     8    10     6        5         6
11    12    11     2        5         8
12     2    12     6        6         6
13     4    13     3        6         9
14     7    14     1        6        10
15    13    15     4        7         4

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

Вы можете сделать это 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

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