Суммирование данных глубины (последовательных строк) в R
Как можно суммировать последовательные данные глубины с помощью R? Например:
a <- data.frame(label = as.factor(c("Air","Air","Air","Air","Air","Air","Wood","Wood","Wood","Wood","Wood","Air","Air","Air","Air","Stone","Stone","Stone","Stone","Air","Air","Air","Air","Air","Wood","Wood")),
depth = as.numeric(c(1,2,3,-1,4,5,4,5,4,6,8,9,8,9,10,9,10,11,10,11,12,10,12,13,14,14)))
Данный вывод должен быть примерно таким:
Label Depth
Air 7
Wood 3
Stone 1
Сначала удаление отрицательных значений выполняется с cummax()потому что глубина может только увеличиться в этом частном случае. Следовательно:
label depth
1 Air 1
2 Air 2
3 Air 3
4 Air 3
5 Air 4
6 Air 5
7 Wood 5
8 Wood 5
9 Wood 5
10 Wood 6
11 Wood 8
12 Air 9
13 Air 9
14 Air 9
15 Air 10
16 Stone 10
17 Stone 10
18 Stone 11
19 Stone 11
20 Air 11
21 Air 12
22 Air 12
23 Air 12
24 Air 13
25 Wood 14
26 Wood 14
Теперь через max-min вы получите увеличение глубины для каждого последовательного ряда: (вопрос в том, как сделать этот шаг)
label depth
1 Air 4
2 Wood 3
3 Air 1
4 Stone 1
5 Air 2
5 Wood 0
И, наконец, суммируя эти максимальные и минимальные значения, получаем результат, представленный выше.
Шаги пытались добиться результата:
Первое очевидное решение было бы, например, для Air:
diff(cummax(a[a$label=="Air",]$depth))
Это решение избавляет от негативных данных, которые необходимы из-за ожидаемого постоянного увеличения глубины. Проблема в том, что выходные данные также учитывают большие шаги между каждым последовательным подмножеством. Следовательно, сумма для Air будет 12 вместо 7.
[1] 1 1 0 1 1 4 0 0 1 1 1 0 0 1
Еще хуже было бы решение с aggreagte, например:
aggregate(depth~label, a, FUN=function(x){sum(x>0)})
Примечание: решения с фильтрацией больших скачков - это не то, что я ищу. Конечно, вы можете еще раз жестко закодировать ограничение для экземпляра <2 для примера Air:
sum(diff(cummax(a[a$label=="Air",]$depth))[diff(cummax(a[a$label=="Air",]$depth))<2])
Дает вам почти правильный результат, но не работает так, как ожидается здесь. Я уверен, что уже есть функция для того, что я ищу, потому что это не редкая проблема для многих различных задач.
Я предполагаю, что взятие минимального и максимального значения каждого набора последовательных строк на материал и суммирование их было бы одним из возможных решений, но я не уверен, как применить функцию только к последовательным подмножествам.
3 ответа
Ты можешь использовать data.table::rleid быстро сгруппировать бегом или восстановить его с rle если тебе действительно нравится После этого агрегирование достаточно просто в любой грамматике. В дплыр,
library(dplyr)
a <- data.frame(label = c("Air","Air","Air","Air","Air","Air","Wood","Wood","Wood","Wood","Wood","Air","Air","Air","Air","Stone","Stone","Stone","Stone","Air","Air","Air","Air","Air","Wood","Wood"),
depth = c(1,2,3,-1,4,5,4,5,4,6,8,9,8,9,10,9,10,11,10,11,12,10,12,13,14,14))
a2 <- a %>%
# filter to rows where previous value is lower, equal, or NA
filter(depth >= lag(depth) | is.na(lag(depth))) %>%
# group by label and its run
group_by(label, run = data.table::rleid(label)) %>%
summarise(depth = max(depth) - min(depth)) # aggregate
a2 %>% arrange(run) # sort to make it pretty
#> # A tibble: 6 x 3
#> # Groups: label [3]
#> label run depth
#> <fctr> <int> <dbl>
#> 1 Air 1 4
#> 2 Wood 2 3
#> 3 Air 3 1
#> 4 Stone 4 1
#> 5 Air 5 2
#> 6 Wood 6 0
a3 <- a2 %>% summarise(depth = sum(depth)) # a2 is still grouped, so aggregate more
a3
#> # A tibble: 3 x 2
#> label depth
#> <fctr> <dbl>
#> 1 Air 7
#> 2 Stone 1
#> 3 Wood 3
Основной метод R с использованием aggregate является
aggregate(cbind(val=cummax(a$depth)),
list(label=a$label, ID=c(0, cumsum(diff(as.integer(a$label)) != 0))),
function(x) diff(range(x)))
Первый аргумент для агрегирования вычисляет совокупный максимум, как OP делает выше для входного вектора, использование cbind обеспечить окончательный вывод рассчитанного вектора. Второй аргумент является аргументом группировки. Это использует другой метод, чем rle, которая рассчитывает совокупную сумму разниц. Наконец, третий аргумент предоставляет функцию, которая вычисляет желаемый результат, беря разницу в диапазоне для каждой группы.
Это возвращает
label ID val
1 Air 0 4
2 Wood 1 3
3 Air 2 1
4 Stone 3 1
5 Air 4 2
6 Wood 5 0
data.table путь (частично заимствуя из @alistaire):
setDT(a)
a[, depth := cummax(depth)]
depth_gain <- a[,
list(
depth = max(depth) - depth[1], # Only need the starting and max values
label = label[1]
),
by = rleidv(label)
]
result <- depth_gain[, list(depth = sum(depth)), by = label]