如何为没有同时观察和不同数量的事件和观察的事件创建虚拟变量？答案

【问题标题】：How to create a dummy variable for events without simultaneous observation and different number of events and observations?如何为没有同时观察和不同数量的事件和观察的事件创建虚拟变量？
【发布时间】：2021-10-17 11:04:33
【问题描述】：

关于我的数据集，我需要您的帮助。我有以下问题：我有一个包含事件数据的数据集和一个包含观察的数据集。我需要合并两者，但问题是一些事件发生在没有观察到事件的同时，但是在接下来的一分钟/小时/天/周....所以我需要 R 选择接下来是事件发生后的观察。我有两个面板数据集。第一个数据集（Observations）如下所示：

name    date
EAC  2021-03-04 15:20:00
EAC  2021-05-05 06:30:37
EAC  2021-08-05 06:32:00
EAC  2021-08-05 06:34:37
BBB  2020-01-28 07:00:33
BBB  2020-05-07 07:05:54
BBB  2020-08-04 07:23:30
BBB  2020-11-05 07:12:30
BBB  2020-11-05 07:19:30
BBB  2020-11-05 07:21:54
CCC  2020-01-30 07:00:37
CCC  2021-08-05 09:06:44
CCC  2021-12-11 06:40:04
CCC  2021-12-11 08:42:04

在第二个数据集（事件）中是这种格式的事件：

   name date
EAC  2021-05-05 06:30:37
EAC  2021-08-05 06:31:00
BBB  2020-01-28 07:00:33
BBB  2020-05-05 07:00:54
BBB  2020-08-04 07:19:30
BBB  2020-11-05 07:12:30
CCC  2020-01-30 07:00:37
CCC  2021-08-05 06:05:44
CCC  2021-12-11 06:40:04

在数据集中，变量日期的格式为 POSIXct。我现在正在尝试将第二个数据集中的事件与第一个数据集的观察结果相匹配。当没有事件时，应该有“NA”。数据集应如下所示：

  name    date               Event
EAC  2021-03-04 15:20:00     NA
EAC  2021-05-05 06:30:37     1
EAC  2021-08-05 06:32:00     1
EAC  2021-08-05 06:34:37     NA
BBB  2020-01-28 07:00:33     1
BBB  2020-05-07 07:05:54     1
BBB  2020-08-04 07:23:30     1
BBB  2020-11-05 07:12:30     1
BBB  2020-11-05 07:19:30     NA
BBB  2020-11-05 07:21:54     NA
CCC  2020-01-30 07:00:37     1
CCC  2021-08-05 09:06:44     1
CCC  2021-12-11 06:40:04     1
CCC  2021-12-11 08:42:04     NA

我尝试了 left_join，但这与缺少观察的事件不匹配。而且可能有更多的观察结果，所以我不能手动完成......

Eventdates <- read_xlsx("Events123.xlsx")
library(stringi)
Eventdates$date <- stri_sub(Eventdates$date, 1, -4)
Eventdates <- tidyr::separate(Eventdates, "date", c('date', 'time'), sep = '\\s')
Eventdates$date <- as.Date(Eventdates$date)
Eventdates$time <- as.ITime(Eventdates$time)
Eventdates$Event <- as.POSIXct(paste(Eventdates$date, Eventdates$time), format="%Y-%m-%d %H:%M")


Observations <- read_xlsx("Observations123.xlsx")
library(stringi)
Observations$date <- stri_sub(Observations$date, 1, -4)
Observations <- tidyr::separate(Observations, "date", c('date', 'time'), sep = '\\s')
Observations$date <- as.Date(Observations$date)
Observations$time <- as.ITime(Observations$time)
Observations$Date <- as.POSIXct(paste(Observations$date, Observations$time), format="%Y-%m-%d %H:%M")


Matched_data <- left_join(Observations, Eventdates, by = c("name", "Date" = "Event"))

你有什么想法吗？

这是我对两个数据集的输入：

> dput(Observations)
structure(list(name = c("EAC", "EAC", "EAC", "EAC", "BBB", "BBB", 
"BBB", "BBB", "BBB", "BBB", "CCC", "CCC", "CCC", "CCC"), date = structure(c(18690, 
18752, 18844, 18844, 18655, 18389, 18478, 18571, 18571, 18571, 
18291, 18844, 18758, 18758), class = "Date"), time = structure(c(55200L, 
23400L, 23520L, 23640L, 25200L, 25500L, 26580L, 25920L, 26340L, 
26460L, 25200L, 32760L, 24000L, 31320L), class = "ITime"), Date = structure(c(1614867600, 
1620189000, 1628137920, 1628138040, 1611813600, 1588827900, 1596518580, 
1604556720, 1604557140, 1604557260, 1580364000, 1628147160, 1620708000, 
1620715320), class = c("POSIXct", "POSIXt"), tzone = "")), row.names = c(NA, 
-14L), class = c("tbl_df", "tbl", "data.frame"))

> dput(Eventdates)
structure(list(name = c("EAC", "EAC", "BBB", "BBB", "BBB", "BBB", 
"CCC", "CCC", "CCC"), date = structure(c(18844, 18752, 18655, 
18571, 18478, 18387, 18291, 18844, 18758), class = "Date"), time = structure(c(23460L, 
23400L, 25200L, 25920L, 26340L, 25200L, 25200L, 21900L, 24000L
), class = "ITime"), Event = structure(c(1628137860, 1620189000, 
1611813600, 1604556720, 1596518340, 1588654800, 1580364000, 1628136300, 
1620708000), class = c("POSIXct", "POSIXt"), tzone = "")), row.names = c(NA, 
-9L), class = c("tbl_df", "tbl", "data.frame"))

【问题讨论】：

是的，当然。我刚刚从我的两条记录中添加了数据 - 你的意思是这种格式吗？
你有什么想法吗？
非常感谢您的帮助！
糟糕我忘记了，我今天一定会这样做。谢谢提醒

标签： r date events dummy-variable

【解决方案1】：

您可以这样做或进一步优化它。（可能由于 tz，data/dput 与您共享的略有不同）

创建一个虚拟列以将Events 与Observations 分开
bind_rows（联合）两个集合
合理安排
应用给定条件
再次过滤观察结果

OBS <- structure(list(name = c("EAC", "EAC", "EAC", "EAC", "BBB", "BBB", 
                               "BBB", "BBB", "BBB", "BBB", "CCC", "CCC", "CCC", "CCC"), date = structure(c(18690, 
                                                                                                           18752, 18844, 18844, 18655, 18389, 18478, 18571, 18571, 18571, 
                                                                                                           18291, 18844, 18758, 18758), class = "Date"), time = structure(c(55200L, 
                                                                                                                                                                            23400L, 23520L, 23640L, 25200L, 25500L, 26580L, 25920L, 26340L, 
                                                                                                                                                                            26460L, 25200L, 32760L, 24000L, 31320L), class = "ITime"), Date = structure(c(1614867600, 
                                                                                                                                                                                                                                                          1620189000, 1628137920, 1628138040, 1611813600, 1588827900, 1596518580, 
                                                                                                                                                                                                                                                          1604556720, 1604557140, 1604557260, 1580364000, 1628147160, 1620708000, 
                                                                                                                                                                                                                                                          1620715320), class = c("POSIXct", "POSIXt"), tzone = "")), row.names = c(NA, 
                                                                                                                                                                                                                                                                                                                                   -14L), class = c("tbl_df", "tbl", "data.frame"))
EVT <- structure(list(name = c("EAC", "EAC", "BBB", "BBB", "BBB", "BBB", 
                        "CCC", "CCC", "CCC"), date = structure(c(18844, 18752, 18655, 
                                                                 18571, 18478, 18387, 18291, 18844, 18758), class = "Date"), time = structure(c(23460L, 
                                                                                                                                                23400L, 25200L, 25920L, 26340L, 25200L, 25200L, 21900L, 24000L
                                                                 ), class = "ITime"), Date = structure(c(1628137860, 1620189000, 
                                                                                                          1611813600, 1604556720, 1596518340, 1588654800, 1580364000, 1628136300, 
                                                                                                          1620708000), class = c("POSIXct", "POSIXt"), tzone = "")), row.names = c(NA, 
                                                                                                                                                                                   -9L), class = c("tbl_df", "tbl", "data.frame"))


library(tidyverse)

OBS %>% mutate(E = 'O') %>%
  bind_rows(EVT %>% mutate(E = 'E')) %>%
  select(-date, -time) %>%
  group_by(name) %>%
  arrange(Date, E, .by_group = TRUE) %>%
  mutate(Event = ifelse(E == 'O' & lag(E) == 'E', 1, NA)) %>%
  filter(E == 'O') %>%
  select(-E)

#> # A tibble: 14 x 3
#> # Groups:   name [3]
#>    name  Date                Event
#>    <chr> <dttm>              <dbl>
#>  1 BBB   2020-05-07 10:35:00     1
#>  2 BBB   2020-08-04 10:53:00     1
#>  3 BBB   2020-11-05 11:42:00     1
#>  4 BBB   2020-11-05 11:49:00    NA
#>  5 BBB   2020-11-05 11:51:00    NA
#>  6 BBB   2021-01-28 11:30:00     1
#>  7 CCC   2020-01-30 11:30:00     1
#>  8 CCC   2021-05-11 10:10:00     1
#>  9 CCC   2021-05-11 12:12:00    NA
#> 10 CCC   2021-08-05 12:36:00     1
#> 11 EAC   2021-03-04 19:50:00    NA
#> 12 EAC   2021-05-05 10:00:00     1
#> 13 EAC   2021-08-05 10:02:00     1
#> 14 EAC   2021-08-05 10:04:00    NA

^{由reprex package (v2.0.0) 于 2021-08-23 创建}

【讨论】：