#r #dplyr #purrr #lubridate
#r #dplyr #мурлыканье #lubridate
Вопрос:
Я пытаюсь создать графики для набора фильтров, которые работают с опережением / запаздыванием.
Краткое описание опережения / задержки:
Когда новый фильтр включается, он переводится в положение задержки, что означает, что вода проходит через него после того, как она проходит через основной (он же ведущий) фильтр. Когда опережающий фильтр засорен, текущий фильтр задержки перемещается в опережающее положение. Подводя итог, фильтр запускается в позиции задержки, а затем перемещается в позицию опережения.
Визуально вы можете представить это так:
Что мне нужно сделать, так это «отменить» (из-за отсутствия лучшего слова) периоды времени, когда происходит перекрытие. Другими словами, я хотел бы, чтобы каждый фильтр имел последовательный прогон временных меток, независимо от позиции опережения / задержки, в которой он находится.
Структура данных выглядит следующим образом:
data <- structure(list(record_timestamp = structure(c(1608192000, 1608192060, 1608192120, 1608192180, 1608192240, 1608192300, 1608192360, 1608192420, 1608192480, 1608192540, 1608192600, 1608192660, 1608192720, 1608192780, 1608192840, 1608192900, 1608192960, 1608193020, 1608193080, 1608193140, 1608193200, 1608193260, 1608193320, 1608193380, 1608193440, 1608193500, 1608193560, 1608193620, 1608193680, 1608193740, 1608193800), class = c("POSIXct", "POSIXt"), tzone = "UTC"), flow = c(20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10), lag_start = structure(c(1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260), class = c("POSIXct", "POSIXt"), tzone = "UTC"), lead_start = structure(c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260), class = c("POSIXct", "POSIXt"), tzone = "UTC"), changeout_interval = new("Interval", .Data = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 660, 0, 0, 0, 0, 0, 0, 0, 0, 0, 600, 0, 0, 0, 0, 0, 0, 0, 0, 0, NA), start = structure(c(1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192000, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260, 1608193260 ), tzone = "UTC", class = c("POSIXct", "POSIXt")), tzone = "UTC")), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"), row.names = c(NA, -31L), spec = structure(list( cols = list(record_timestamp = structure(list(), class = c("collector_character", "collector")), flow = structure(list(), class = c("collector_double", "collector")), polish_start = structure(list(), class = c("collector_character", "collector")), lead_start = structure(list(), class = c("collector_character", "collector"))), default = structure(list(), class = c("collector_guess", "collector")), skip = 1), class = "col_spec"))
Как я представляю конечный результат, будут выглядеть данные:
end_data <- structure(list(record_timestamp = structure(c(1608192000, 1608192060,1608192120, 1608192180, 1608192240, 1608192300, 1608192360, 1608192420,1608192480, 1608192540, 1608192600, 1608192660, 1608192720, 1608192780,1608192840, 1608192900, 1608192960, 1608193020, 1608193080, 1608193140,1608193200, 1608192660, 1608192720, 1608192780, 1608192840, 1608192900,1608192960, 1608193020, 1608193080, 1608193140, 1608193200, 1608193260,1608193320, 1608193380, 1608193440, 1608193500, 1608193560,1608193620,1608193680, 1608193740, 1608193800), class = c("POSIXct", "POSIXt"), tzone = "UTC"), flow = c(20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), lag_start = structure(c(1608192000, 1608192000, 1608192000,1608192000, 1608192000, 1608192000, 1608192000, 1608192000,1608192000,1608192000, 1608192000, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660, 1608192660,1608192660, 1608192660, 1608192660, 1608192660, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), class = c("POSIXct", "POSIXt"), tzone = "UTC"), lead_start = structure(c(NA, NA, NA, NA, NA, NA, NA, NA,NA, NA, NA, 1608192660, 1608192660, 1608192660, 1608192660,1608192660, 1608192660, 1608192660, 1608192660, 1608192660,1608192660, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1608193260,1608193260, 1608193260, 1608193260, 1608193260, 1608193260,1608193260, 1608193260, 1608193260, 1608193260), class = c("POSIXct","POSIXt"), tzone = "UTC"), filter_id = c(1, 1, 1, 1, 1, 1,1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"), row.names = c(NA, -41L), spec = structure(list(cols = list(record_timestamp = structure(list(), class = c("collector_character","collector")), flow = structure(list(), class = c("collector_double","collector")), polish_start = structure(list(), class = c("collector_character","collector")), lead_start = structure(list(), class = c("collector_character", "collector")), filter_id = structure(list(), class = c("collector_double","collector"))), default = structure(list(), class = c("collector_guess","collector")), skip = 1), class = "col_spec"))
Это удвоило бы временные метки, но это позволило бы упростить построение графика, потому что я могу group_by использовать столбец filter_id.
То, что у меня есть до сих пор, — это набор временных интервалов для каждого фильтра, от начала до конца, с учетом задержки. Вот этот код:
intervals <- data %>%
distinct(lag_start, .keep_all = TRUE) %>%
mutate(changeout_interval = interval(lag_start, lead(lag_start, 2))) %>%
select(record_timestamp, changeout_interval)
Оттуда, как я могу отфильтровать все временные метки, которые попадают в каждый из этих интервалов? Почти как условное pivot_longer .
Конечная цель — иметь возможность отображать полный срок службы фильтра, как опережающий, так и запаздывающий, всего за несколько строк ggplot2 . Вот что я представляю для сюжета:
grouped_data <- data %>%
group_by(lag_start) %>%
mutate(elapsed_time = difftime(record_timestamp,
record_timestamp[1],
units = "mins"),
total_flow = cumsum(flow))
ggplot(grouped_data, aes(x = elapsed_time, y = total_flow))
geom_line(aes(color = as.factor(lag_start)))
Но этот график не включает в себя поток для каждого фильтра, когда он переводится в исходное положение.
Ответ №1:
Используется dense_rank для группировки фильтров lag_start и последующего создания одной записи для каждого фильтра. Это оставляет информацию в широком формате, поскольку interval и end_data имеет разные структуры данных.
library(dplyr)
library(lubridate)
data %>%
select(-changeout_interval) %>% # example only as interval appeared to calculate this
mutate(filter_id = dense_rank(lag_start)) %>%
group_by(filter_id) %>%
slice(1) %>%
ungroup() %>%
mutate(lead_start = lead(lead_start), lead_end = lead(lead_start), changeout_interval = interval(lag_start, lead_end))
# A tibble: 3 x 7
record_timestamp flow lag_start lead_start filter_id lead_end
<dttm> <dbl> <dttm> <dttm> <int> <dttm>
1 2020-12-17 08:00:00 20 2020-12-17 08:00:00 2020-12-17 08:11:00 1 2020-12-17 08:21:00
2 2020-12-17 08:11:00 15 2020-12-17 08:11:00 2020-12-17 08:21:00 2 NA
3 2020-12-17 08:21:00 10 2020-12-17 08:21:00 NA 3 NA
Обновлено в ответ на уточняющие дополнения к вопросу. Использует тот же подход dense_rank , а затем переключается на длинный формат через pivot_longer , чтобы упростить cumsum отображение требования.
library(dplyr)
library(tidyr)
library(ggplot2)
plot_data <- data %>%
select(-changeout_interval) %>% # example only as interval appeared to calculate this
mutate(filter_lag = dense_rank(lag_start),
filter_lead = filter_lag - 1) %>%
select(-lag_start, -lead_start) %>%
pivot_longer(cols = starts_with("filter_"),
names_to = "position",
names_prefix = "filter_",
values_to = "filter") %>%
filter(filter > 0) %>% # drops the starting filter as data shows no lead filter?
group_by(filter) %>%
mutate(elapsed_time = difftime(record_timestamp, record_timestamp[1], units = "mins"),
rolling_flow = cumsum(flow))
Построение elapsed_time графика и rolling_flow
ggplot(plot_data, aes(x = as.numeric(elapsed_time),
y = rolling_flow,
color = factor(filter)))
geom_line()
Комментарии:
1. Я добавил к вопросу, чтобы помочь уточнить. Я хочу расширить данные, чтобы упростить построение графика
2. @setty обновленный ответ для создания графика с кумулятивным потоком как для задержки, так и для опережения
3. Блестяще! Это именно то, что мне было нужно. Спасибо за ответы на обновления!