Рассчитать разницу между датами в часах с ближайшими условными строками на группу в R

У меня есть следующий пример фрейма данных с именем df (dput ниже):

   group                date indicator
1      A 2022-11-01 01:00:00     FALSE
2      A 2022-11-01 03:00:00     FALSE
3      A 2022-11-01 04:00:00      TRUE
4      A 2022-11-01 05:00:00     FALSE
5      A 2022-11-01 06:00:00      TRUE
6      A 2022-11-01 07:00:00     FALSE
7      A 2022-11-01 10:00:00     FALSE
8      A 2022-11-01 12:00:00     FALSE
9      B 2022-11-01 01:00:00     FALSE
10     B 2022-11-01 02:00:00     FALSE
11     B 2022-11-01 03:00:00     FALSE
12     B 2022-11-01 06:00:00      TRUE
13     B 2022-11-01 07:00:00     FALSE
14     B 2022-11-01 08:00:00     FALSE
15     B 2022-11-01 11:00:00      TRUE
16     B 2022-11-01 13:00:00     FALSE

Я хотел бы рассчитать разницу в часах между датами с их ближайшими условными строками, которые имеют indicator == TRUE на группу. Кроме того, строки с TRUE должны возвращать 0 в качестве вывода. Здесь вы можете увидеть желаемый вывод с именем df_desired:

   group                date indicator diff_hours
1      A 2022-11-01 01:00:00     FALSE          3
2      A 2022-11-01 03:00:00     FALSE          1
3      A 2022-11-01 04:00:00      TRUE          0
4      A 2022-11-01 05:00:00     FALSE          1
5      A 2022-11-01 06:00:00      TRUE          0
6      A 2022-11-01 07:00:00     FALSE          1
7      A 2022-11-01 10:00:00     FALSE          4
8      A 2022-11-01 12:00:00     FALSE          6
9      B 2022-11-01 01:00:00     FALSE          5
10     B 2022-11-01 02:00:00     FALSE          4
11     B 2022-11-01 03:00:00     FALSE          3
12     B 2022-11-01 06:00:00      TRUE          0
13     B 2022-11-01 07:00:00     FALSE          1
14     B 2022-11-01 08:00:00     FALSE          2
15     B 2022-11-01 11:00:00      TRUE          0
16     B 2022-11-01 13:00:00     FALSE          2

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


Здесь dput df и df_desired:

df <- structure(list(group = c("A", "A", "A", "A", "A", "A", "A", "A", 
"B", "B", "B", "B", "B", "B", "B", "B"), date = structure(c(1667260800, 
1667268000, 1667271600, 1667275200, 1667278800, 1667282400, 1667293200, 
1667300400, 1667260800, 1667264400, 1667268000, 1667278800, 1667282400, 
1667286000, 1667296800, 1667304000), class = c("POSIXct", "POSIXt"
), tzone = ""), indicator = c(FALSE, FALSE, TRUE, FALSE, TRUE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, 
TRUE, FALSE)), class = "data.frame", row.names = c(NA, -16L))

df_desired <- structure(list(group = c("A", "A", "A", "A", "A", "A", "A", "A", 
"B", "B", "B", "B", "B", "B", "B", "B"), date = structure(c(1667260800, 
1667268000, 1667271600, 1667275200, 1667278800, 1667282400, 1667293200, 
1667300400, 1667260800, 1667264400, 1667268000, 1667278800, 1667282400, 
1667286000, 1667296800, 1667304000), class = c("POSIXct", "POSIXt"
), tzone = ""), indicator = c(FALSE, FALSE, TRUE, FALSE, TRUE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, 
TRUE, FALSE), diff_hours = c(3, 1, 0, 1, 0, 1, 4, 6, 5, 4, 3, 
0, 1, 2, 0, 2)), class = "data.frame", row.names = c(NA, -16L
))
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
12
0
679
5
Перейти к ответу Данный вопрос помечен как решенный

Ответы 5

Вы можете попробовать data.table, как показано ниже (должны быть варианты более эффективные, чем мои)

  • Использование findInterval или roll = "nearest"
setDT(df)[
  ,
  diff_hours := abs(
    difftime(date,
      date[indicator][pmax(1, findInterval(date, date[indicator]))],
      units = "hours"
    )
  ),
  group
][]

или

setDT(df)[
  ,
  diffhours := abs(
    difftime(date,
      .SD[indicator][.SD,
        date,
        by = group,
        on = "date",
        roll = "nearest",
        mult = "first"
      ][, date],
      units = "hours"
    )
  )
][]

который дает

    group                date indicator diff_hours
 1:     A 2022-11-01 01:00:00     FALSE    3 hours
 2:     A 2022-11-01 03:00:00     FALSE    1 hours
 3:     A 2022-11-01 04:00:00      TRUE    0 hours
 4:     A 2022-11-01 05:00:00     FALSE    1 hours
 5:     A 2022-11-01 06:00:00      TRUE    0 hours
 6:     A 2022-11-01 07:00:00     FALSE    1 hours
 7:     A 2022-11-01 10:00:00     FALSE    4 hours
 8:     A 2022-11-01 12:00:00     FALSE    6 hours
 9:     B 2022-11-01 01:00:00     FALSE    5 hours
10:     B 2022-11-01 02:00:00     FALSE    4 hours
11:     B 2022-11-01 03:00:00     FALSE    3 hours
12:     B 2022-11-01 06:00:00      TRUE    0 hours
13:     B 2022-11-01 07:00:00     FALSE    1 hours
14:     B 2022-11-01 08:00:00     FALSE    2 hours
15:     B 2022-11-01 11:00:00      TRUE    0 hours
16:     B 2022-11-01 13:00:00     FALSE    2 hours
  • Использование outer (неэффективно из-за использования apply)
setDT(df)[
  ,
  diff_hours := apply(abs(outer(date, date[indicator], `-`)), 1, min) / 3600,
  group
][]

и ты увидишь

    group                date indicator diff_hours
 1:     A 2022-11-01 01:00:00     FALSE          3
 2:     A 2022-11-01 03:00:00     FALSE          1
 3:     A 2022-11-01 04:00:00      TRUE          0
 4:     A 2022-11-01 05:00:00     FALSE          1
 5:     A 2022-11-01 06:00:00      TRUE          0
 6:     A 2022-11-01 07:00:00     FALSE          1
 7:     A 2022-11-01 10:00:00     FALSE          4
 8:     A 2022-11-01 12:00:00     FALSE          6
 9:     B 2022-11-01 01:00:00     FALSE          5
10:     B 2022-11-01 02:00:00     FALSE          4
11:     B 2022-11-01 03:00:00     FALSE          3
12:     B 2022-11-01 06:00:00      TRUE          0
13:     B 2022-11-01 07:00:00     FALSE          1
14:     B 2022-11-01 08:00:00     FALSE          2
15:     B 2022-11-01 11:00:00      TRUE          0
16:     B 2022-11-01 13:00:00     FALSE          2
Ответ принят как подходящий

С map_dbl:

library(dplyr)
library(purrr)
df %>% 
  group_by(group) %>% 
  mutate(diff_hours = map_dbl(date, ~ min(abs(.x - date[indicator]))))

вывод

# A tibble: 16 × 4
# Groups:   group [2]
   group date                indicator diff_hours
   <chr> <dttm>              <lgl>          <dbl>
 1 A     2022-11-01 01:00:00 FALSE              3
 2 A     2022-11-01 03:00:00 FALSE              1
 3 A     2022-11-01 04:00:00 TRUE               0
 4 A     2022-11-01 05:00:00 FALSE              1
 5 A     2022-11-01 06:00:00 TRUE               0
 6 A     2022-11-01 07:00:00 FALSE              1
 7 A     2022-11-01 10:00:00 FALSE              4
 8 A     2022-11-01 12:00:00 FALSE              6
 9 B     2022-11-01 01:00:00 FALSE              5
10 B     2022-11-01 02:00:00 FALSE              4
11 B     2022-11-01 03:00:00 FALSE              3
12 B     2022-11-01 06:00:00 TRUE               0
13 B     2022-11-01 07:00:00 FALSE              1
14 B     2022-11-01 08:00:00 FALSE              2
15 B     2022-11-01 11:00:00 TRUE               0
16 B     2022-11-01 13:00:00 FALSE              2

Если кто-то хочет сохранить исходную разницу (не абсолютную):

df %>% 
  group_by(group) %>% 
  mutate(diff_hours = map_dbl(date, ~ (.x - date[indicator])[which.min(abs(.x - date[indicator]))]))

Вы не против объяснить это? Не могу понять, как ему удалось захватить правильный индикатор

Tom 15.11.2022 14:47

Привет @Maël, спасибо за ответ! Знаете ли вы, можно ли сделать diff_hours отрицательным, если даты стоят перед ближайшими условными строками? Таким образом, первые строки в этом случае должны иметь -3 вместо 3. Знаете ли вы, легко ли это возможно с вашим кодом?

Quinten 15.11.2022 15:49

Конечно! Просто уберите функцию abs

Maël 15.11.2022 16:01

Да, я подумал так же, удалив абс, но тогда я получаю какой-то странный вывод, например, -7200 для строки 3 и -5 для строки 1, что должно быть -3. Вы знаете, почему это происходит?

Quinten 15.11.2022 16:11

Правда, это потому, что функция min ищет минимальное значение, а не ближайшее к 0. Вы можете индексировать абсолютный минимум с исходной разницей, проверьте редактирование

Maël 15.11.2022 16:29

@TomHoel Конечно. Итак, операция выполняется группой. Для каждого date мы вычисляем разницу этой даты со всеми другими датами, для которых indicator является ИСТИННЫМ (при индексации логического вектора с [ нет необходимости указывать == TRUE, так же как мы не делаем mtcars[(mpg > 10) == TRUE)]), тогда мы получаем абсолютную значение этой разницы и выбрать минимум.

Maël 15.11.2022 16:33

Решение на основе tidyr::fill():

library(dplyr)
library(tidyr)

df %>%
  arrange(group, date) %>%
  mutate(
    ind_prev = if_else(indicator, date, as.POSIXct(NA)),
    ind_next = ind_prev
  ) %>%
  group_by(group) %>%
  fill(ind_prev, .direction = "down") %>%
  fill(ind_next, .direction = "up") %>%
  ungroup() %>%
  mutate(
    across(
      ind_prev:ind_next,
      ~ abs(as.numeric(date - .x, unit = "hours"))
    ),
    diff_hours = pmin(ind_prev, ind_next, na.rm = TRUE)
  ) %>%
  select(!ind_prev:ind_next)
# A tibble: 16 × 4
   group date                indicator diff_hours
   <chr> <dttm>              <lgl>          <dbl>
 1 A     2022-11-01 00:00:00 FALSE              3
 2 A     2022-11-01 02:00:00 FALSE              1
 3 A     2022-11-01 03:00:00 TRUE               0
 4 A     2022-11-01 04:00:00 FALSE              1
 5 A     2022-11-01 05:00:00 TRUE               0
 6 A     2022-11-01 06:00:00 FALSE              1
 7 A     2022-11-01 09:00:00 FALSE              4
 8 A     2022-11-01 11:00:00 FALSE              6
 9 B     2022-11-01 00:00:00 FALSE              5
10 B     2022-11-01 01:00:00 FALSE              4
11 B     2022-11-01 02:00:00 FALSE              3
12 B     2022-11-01 05:00:00 TRUE               0
13 B     2022-11-01 06:00:00 FALSE              1
14 B     2022-11-01 07:00:00 FALSE              2
15 B     2022-11-01 10:00:00 TRUE               0
16 B     2022-11-01 12:00:00 FALSE              2

Вот несколько из предыдущих подходов в базе R:

#Maël answer in base R
by(df, df$group, \(d) transform(
  d, diff_hours = sapply(d$date, \(x) min(abs(x - d$date[d[["indicator"]]])))
  )) |>
  do.call(what = rbind.data.frame)
#>      group                date indicator diff_hours
#> A.1      A 2022-10-31 20:00:00     FALSE          3
#> A.2      A 2022-10-31 22:00:00     FALSE          1
#> A.3      A 2022-10-31 23:00:00      TRUE          0
#> A.4      A 2022-11-01 00:00:00     FALSE          1
#> A.5      A 2022-11-01 01:00:00      TRUE          0
#> A.6      A 2022-11-01 02:00:00     FALSE          1
#> A.7      A 2022-11-01 05:00:00     FALSE          4
#> A.8      A 2022-11-01 07:00:00     FALSE          6
#> B.9      B 2022-10-31 20:00:00     FALSE          5
#> B.10     B 2022-10-31 21:00:00     FALSE          4
#> B.11     B 2022-10-31 22:00:00     FALSE          3
#> B.12     B 2022-11-01 01:00:00      TRUE          0
#> B.13     B 2022-11-01 02:00:00     FALSE          1
#> B.14     B 2022-11-01 03:00:00     FALSE          2
#> B.15     B 2022-11-01 06:00:00      TRUE          0
#> B.16     B 2022-11-01 08:00:00     FALSE          2

#ThomasIsCoding answer in base
transform(df, diff_hours = apply(abs(outer(df$date, df$date[df$indicator], `-`))/3600, 1, min))
#>    group                date indicator diff_hours
#> 1      A 2022-10-31 20:00:00     FALSE          3
#> 2      A 2022-10-31 22:00:00     FALSE          1
#> 3      A 2022-10-31 23:00:00      TRUE          0
#> 4      A 2022-11-01 00:00:00     FALSE          1
#> 5      A 2022-11-01 01:00:00      TRUE          0
#> 6      A 2022-11-01 02:00:00     FALSE          1
#> 7      A 2022-11-01 05:00:00     FALSE          1
#> 8      A 2022-11-01 07:00:00     FALSE          1
#> 9      B 2022-10-31 20:00:00     FALSE          3
#> 10     B 2022-10-31 21:00:00     FALSE          2
#> 11     B 2022-10-31 22:00:00     FALSE          1
#> 12     B 2022-11-01 01:00:00      TRUE          0
#> 13     B 2022-11-01 02:00:00     FALSE          1
#> 14     B 2022-11-01 03:00:00     FALSE          2
#> 15     B 2022-11-01 06:00:00      TRUE          0
#> 16     B 2022-11-01 08:00:00     FALSE          2

Базовое решение R с использованием семейства функций apply. Сначала split набор по группам, затем сравните все даты с индикатором == ИСТИННЫЕ даты, затем выберите min.

cbind(df, diff_hours = unlist(lapply(split(df, df$group), function(grp)
  apply(sapply(grp[grp$indicator == T, "date"], function(date_T) 
    abs(difftime(date_T, grp$date, u = "hour"))), 1, min))))
   group                date indicator diff_hours
A1     A 2022-11-01 01:00:00     FALSE          3
A2     A 2022-11-01 03:00:00     FALSE          1
A3     A 2022-11-01 04:00:00      TRUE          0
A4     A 2022-11-01 05:00:00     FALSE          1
A5     A 2022-11-01 06:00:00      TRUE          0
A6     A 2022-11-01 07:00:00     FALSE          1
A7     A 2022-11-01 10:00:00     FALSE          4
A8     A 2022-11-01 12:00:00     FALSE          6
B1     B 2022-11-01 01:00:00     FALSE          5
B2     B 2022-11-01 02:00:00     FALSE          4
B3     B 2022-11-01 03:00:00     FALSE          3
B4     B 2022-11-01 06:00:00      TRUE          0
B5     B 2022-11-01 07:00:00     FALSE          1
B6     B 2022-11-01 08:00:00     FALSE          2
B7     B 2022-11-01 11:00:00      TRUE          0
B8     B 2022-11-01 13:00:00     FALSE          2

Другие вопросы по теме

Похожие вопросы

Как преобразовать логические столбцы в числовые в R с помощью dplyr?
Есть ли способ построить пакет pscl результатов модели препятствий или способ построить счет - нулевая усеченная часть негбина модели препятствий в r?
Определить, какая группа содержит последовательность ненулевых значений
Pivot_longer для фрейма данных больших временных рядов
Удалить строки из фреймов данных в блестящем с помощью DataTable (на стороне сервера)
Создание переменной в зависимости от значений двух разных параметров
Поиск перекрывающихся единиц на основе времени начала и окончания
Поиск ближайшего значения в векторе для каждого значения в том же векторе, исключая рассматриваемый элемент в R?
Добавить/сопоставить строки с NA в матрицу на основе отсутствующих уникальных идентификаторов
Ошибка: ! Проблема при преобразовании geom в grob. ℹ Произошла ошибка на 1-м слое