Рассмотрим следующий набор данных:
df <- tibble(
interval = rep(1:10, 4),
channel = rep(1:2, each = 20),
date = parse_date(rep(c("2020-07-01", "2020-07-02", "2020-07-03", "2020-07-04"),
times = 2, each = 5)),
time = parse_time(
rep(format(seq.POSIXt(as.POSIXct(Sys.Date() + 0.05),
as.POSIXct(Sys.Date() + 0.95), length.out = 5),
"%H:%M:%S", tz="GMT"), 8), format = "%H:%M:%S"),
trigger = c(rep(0,5), # Ch 1, day 1; no max
0, 2, 0, 2, 0, # Ch 1, day 2; 2 maxes
rep(0, 5), # Ch 1, day 3; no max
0, 0, 2, 0, 0, # Ch 1, day 4
0, 0, 10, 0, 0, # Ch 2, day 1
10, rep(0, 4), # Ch 2, day 2; max at head
rep(0, 4), 10, # Ch 2, day 3; max at tail
4, 10, 4, 10, 0) # Ch 2, day 4; 2 maxes
)
# A tibble: 40 x 5
interval channel date time trigger
<int> <int> <date> <time> <dbl>
1 1 1 2020-07-01 01:12 0
2 2 1 2020-07-01 06:36 0
3 3 1 2020-07-01 12:00 0
4 4 1 2020-07-01 17:24 0
5 5 1 2020-07-01 22:48 0
6 6 1 2020-07-02 01:12 0
7 7 1 2020-07-02 06:36 2
8 8 1 2020-07-02 12:00 0
9 9 1 2020-07-02 17:24 2
10 10 1 2020-07-02 22:48 0
# ... with 30 more rows
Мои данные содержат более 10 000 строк от датчика, ежедневно регистрирующего, сколько раз он срабатывает за интервал времени. Я хочу использовать slice () для фильтрации 2-часового интервала вокруг времени пиковых триггеров для каждого дня. У меня есть код, который работает, но выдает предупреждения для определенных ситуаций, которые я вскоре объясню. Хотя предупреждения не влияют на результаты, я бы чувствовал себя более комфортно, если бы у меня их не было. Мне нужно учесть следующие условия:
- Датчик не срабатывает более 1 дня (триггер = 0)
- Триггеры, достигающие пика в начале или в конце дня
- Пик срабатывания триггера происходит более одного раза в день (тот же максимум в разное время)
В основном я использую функции tidyverse и lubridate. На данный момент мой лучший рабочий код выглядит следующим образом:
df %>%
group_by(date, channel) %>%
slice(abs(which.max(trigger) + (-1:1))) %>% # Simplifying my interval with 1 row around the peak
ungroup() %>%
arrange(channel) %>%
print()
# A tibble: 20 x 5
interval channel date time trigger
<int> <int> <date> <time> <dbl>
1 1 1 2020-07-01 01:12 0
2 2 1 2020-07-01 06:36 0
3 6 1 2020-07-02 01:12 0
4 7 1 2020-07-02 06:36 2
5 8 1 2020-07-02 12:00 0
6 1 1 2020-07-03 01:12 0
7 2 1 2020-07-03 06:36 0
8 7 1 2020-07-04 06:36 0
9 8 1 2020-07-04 12:00 2
10 9 1 2020-07-04 17:24 0
11 2 2 2020-07-01 06:36 0
12 3 2 2020-07-01 12:00 10
13 4 2 2020-07-01 17:24 0
14 6 2 2020-07-02 01:12 10
15 7 2 2020-07-02 06:36 0
16 4 2 2020-07-03 17:24 0
17 5 2 2020-07-03 22:48 10
18 6 2 2020-07-04 01:12 4
19 7 2 2020-07-04 06:36 10
20 8 2 2020-07-04 12:00 4
Я решил разрезать по интервалам, а не по пикам, но интервалы не всегда бывают последовательными; это зависит от того, когда я сбросил свои программы. Если есть 2 или более пика, я бы не отказался от фильтрации по первому пику. Если бы я мог определить, где есть несколько пиков, это был бы плюс! Наконец, если для дня нет триггеров, я бы не хотел включать этот день. Я думаю, что могу постфильтровать бездействие, но все равно буду получать предупреждения.
Краткое резюме:
Моя цель - отфильтровать 2-часовой интервал во время пиковых триггеров. Если вы можете порекомендовать решения tidyverse / lubridate (или любые другие!), Я был бы признателен за помощь. Спасибо!
1 ответ
Вы можете написать собственную функцию для проверки различных условий, чтобы не генерировать предупреждения.
custom_fun <- function(trigger) {
#trigger value greater than 0
inds <- trigger > 0
#If any value greater than 0
if(any(inds)) {
#return the 2-hour interval
vals <- which.max(trigger) + -1:1
#remove values during head and tail of the day
return(vals[vals > 0 & vals <= length(trigger)])
}
#Don't select anything if no trigger > 0
else return(0)
}
А затем примените его для каждого date и channel.
library(dplyr)
df %>%
group_by(date, channel) %>%
#If multiple peaks present.
mutate(mulitple_peak = sum(trigger == max(trigger)) > 1) %>%
slice(custom_fun(trigger)) %>%
ungroup()
# A tibble: 16 x 6
# interval channel date time trigger mulitple_peak
# <int> <int> <date> <time> <dbl> <lgl>
# 1 2 2 2020-07-01 06:36 0 FALSE
# 2 3 2 2020-07-01 12:00 10 FALSE
# 3 4 2 2020-07-01 17:24 0 FALSE
# 4 6 1 2020-07-02 01:12 0 TRUE
# 5 7 1 2020-07-02 06:36 2 TRUE
# 6 8 1 2020-07-02 12:00 0 TRUE
# 7 6 2 2020-07-02 01:12 10 FALSE
# 8 7 2 2020-07-02 06:36 0 FALSE
# 9 4 2 2020-07-03 17:24 0 FALSE
#10 5 2 2020-07-03 22:48 10 FALSE
#11 7 1 2020-07-04 06:36 0 FALSE
#12 8 1 2020-07-04 12:00 2 FALSE
#13 9 1 2020-07-04 17:24 0 FALSE
#14 6 2 2020-07-04 01:12 4 TRUE
#15 7 2 2020-07-04 06:36 10 TRUE
#16 8 2 2020-07-04 12:00 4 TRUE
Похожие вопросы
Новые вопросы
r
R — это бесплатный язык программирования с открытым исходным кодом и программная среда для статистических вычислений, биоинформатики, визуализации и общих вычислений. Пожалуйста, используйте минимально воспроизводимые примеры, которые другие могут запустить с помощью копирования и вставки. Показать желаемый результат полностью. Используйте dput() для данных и укажите все небазовые пакеты с помощью library(). Не вставляйте изображения для данных или кода, вместо этого используйте блоки кода с отступом. Для вопросов по статистике используйте https://stats.stackexchange.com.