Вычисление разницы, которая начинается заново, когда чередуется двухуровневый коэффициент

Question

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

Давайте рассмотрим x как отметку времени, а ant - как антенну, которая обнаруживает человека.

Надеюсь, мои данные для примера прояснят это.

Используя dplyr, я попробовал group_by(ant), но это не возвращает разницу к нулю, когда человек впоследствии обнаруживается на другой антенне.

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

Я не привязан к dplyr, но я ищу помощь в сохранении этого масштабируемого.

set.seed(14)
test <-  data.frame(x = sort(x= round(runif(20,0, 10), 2), decreasing = 
                    F),
                    ant = sample(c("n", "s"), replace = T, size = 20))

library(dplyr)
test %>%
    group_by(ant) %>%
    mutate(diff = x - lag(x))

Результат, который я ищу:

   x    ant diff
1.64    n   0
2.54    n   0.9
3.53    s   0
3.82    s   0.29
4.28    s   0.46
4.74    s   0.46
4.86    n   0
5.11    s   0
5.53    s   0.42
5.95    n   0
6.38    s   0
6.73    n   0
 7.4    s   0
8.51    s   1.11
8.52    s   0.01
8.57    n   0
8.91    s   0
9.33    n   0
9.57    s   0
9.83    s   0.26

Здесь я смогу выяснить, как получить кумулятивную сумму для каждого фактора.

Answer 1

ОП запросил

, чтобы вычислить разницу, а затем в конечном итоге кумулятивную сумму разностей переменной.Расчеты [...] необходимо начинать заново, когда коэффициент чередуется взад-вперед.

Вычисление различий

Функция rleid() из пакета data.table может использоваться для выявления изменений в ant:

library(data.table)
setDT(test)[, diff := c(0, diff(x)), by = rleid(ant)]
test

       x ant diff
 1: 1.64   n 0.00
 2: 2.54   n 0.90
 3: 3.53   s 0.00
 4: 3.82   s 0.29
 5: 4.28   s 0.46
 6: 4.74   s 0.46
 7: 4.86   n 0.00
 8: 5.11   s 0.00
 9: 5.53   s 0.42
10: 5.95   n 0.00
11: 6.38   s 0.00
12: 6.73   n 0.00
13: 7.40   s 0.00
14: 8.51   s 1.11
15: 8.52   s 0.01
16: 8.57   n 0.00
17: 8.91   s 0.00
18: 9.33   n 0.00
19: 9.57   s 0.00
20: 9.83   s 0.26

Или, используя shift():

setDT(test)[, diff := x - shift(x, fill = x[1]), by = rleid(ant)]

Вычисление совокупных сумм напрямую

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

Это может быть сделано непосредственно, потому что накопительныйсумма разностей x равна x минус первое значение x для каждой полосы идентичных значений ant:

setDT(test)[, cumsum := x - x[1L], by = rleid(ant)]
test

       x ant diff cumsum
 1: 1.64   n 0.00   0.00
 2: 2.54   n 0.90   0.90
 3: 3.53   s 0.00   0.00
 4: 3.82   s 0.29   0.29
 5: 4.28   s 0.46   0.75
 6: 4.74   s 0.46   1.21
 7: 4.86   n 0.00   0.00
 8: 5.11   s 0.00   0.00
 9: 5.53   s 0.42   0.42
10: 5.95   n 0.00   0.00
11: 6.38   s 0.00   0.00
12: 6.73   n 0.00   0.00
13: 7.40   s 0.00   0.00
14: 8.51   s 1.11   1.11
15: 8.52   s 0.01   1.12
16: 8.57   n 0.00   0.00
17: 8.91   s 0.00   0.00
18: 9.33   n 0.00   0.00
19: 9.57   s 0.00   0.00
20: 9.83   s 0.26   0.26

Answer 2

Решение, аналогичное Uwe, но использующее только функции tidyverse:

library(tidyverse)
test %>%
  mutate(seq_chg = ant != lag(ant)) %>%
  replace_na(list(seq_chg = TRUE)) %>%
  mutate(seq_id = cumsum(seq_chg)) %>%
  group_by(seq_id) %>%
  mutate(diff = x - lag(x)) %>%
  replace_na(list(diff = 0))

Результат

# A tibble: 20 x 5
# Groups:   seq_id [12]
       x ant   seq_chg seq_id    diff
   <dbl> <fct> <lgl>    <int>   <dbl>
 1  1.64 n     TRUE         1 0      
 2  2.54 n     FALSE        1 0.9    
 3  3.53 s     TRUE         2 0      
 4  3.82 s     FALSE        2 0.29   
 5  4.28 s     FALSE        2 0.46   
 6  4.74 s     FALSE        2 0.46   
 7  4.86 n     TRUE         3 0      
 8  5.11 s     TRUE         4 0      
 9  5.53 s     FALSE        4 0.420  
10  5.95 n     TRUE         5 0      
11  6.38 s     TRUE         6 0      
12  6.73 n     TRUE         7 0      
13  7.4  s     TRUE         8 0      
14  8.51 s     FALSE        8 1.11   
15  8.52 s     FALSE        8 0.01000
16  8.57 n     TRUE         9 0      
17  8.91 s     TRUE        10 0      
18  9.33 n     TRUE        11 0      
19  9.57 s     TRUE        12 0      
20  9.83 s     FALSE       12 0.260  

Answer 3

Нам нужно сгруппировать по run-length-id из 'ant', чтобы создать уникальный идентификатор всякий раз, когда значение 'ant' переключается на другое значение.

library(tidyverse)
library(data.table)
test %>% 
  group_by(grp = rleid(ant)) %>% # rleid from data.table
  mutate(diff1 = c(0, diff(x))) %>% 
  #or use the OP's code
  # mutate(diff1 = x - lag(x, default = first(x))) %>% 
  ungroup %>% 
  select(-grp) # remove the created grp column
# A tibble: 20 x 4
#       x ant    diff diff1
#   <int> <chr> <int> <int>
# 1     1 n         0     0
# 2     2 s         0     0
# 3     3 s         1     1
# 4     4 n         0     0
# 5     5 s         0     0
# 6     6 n         0     0
# 7     7 s         0     0
# 8     8 s         1     1
# 9     9 s         1     1
#10    10 s         1     1
#11    11 s         1     1
#12    12 n         0     0
#13    13 s         0     0
#14    14 n         0     0
#15    15 s         0     0
#16    16 n         0     0
#17    17 n         1     1
#18    18 n         1     1
#19    19 n         1     1
#20    20 s         0     0

data

test <- structure(list(x = 1:20, ant = c("n", "s", "s", "n", "s", "n", 
"s", "s", "s", "s", "s", "n", "s", "n", "s", "n", "n", "n", "n", 
"s"), diff = c(0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 
 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L)), class = "data.frame", 
 row.names = c(NA, -20L))