R语言 联接(合并)表时在开始和结束时间间隔内复制数据

dojqjjoe  于 2022-12-06  发布在  其他
关注(0)|答案(4)|浏览(114)

我有两个数据框需要连接。但在连接这两个数据表时,我希望复制开始时间和结束时间内df2的每一行。新数据框的其余行应显示为NA
我尝试使用left join,但它不复制开始和结束时间内的行。

df <- dplyr::left_join(df1, df2, by = "Session_start")

两个数据框如下所示。

head(df1)
#         Session_start Robot_ID
# 1 2022-07-07 00:05:19       R1
# 2 2022-07-07 00:05:20       R2
# 3 2022-07-07 00:05:21       R3
# 4 2022-07-07 00:05:22       R4
# 5 2022-07-07 00:05:23       R5
# 6 2022-07-07 00:05:24       R6

df2
#         Session_start         Session_End Animal_ID
# 1 2022-07-07 00:05:19 2022-07-07 00:05:21       ID1
# 2 2022-07-07 00:05:24 2022-07-07 00:05:26       ID2
# 3 2022-07-07 00:05:27 2022-07-07 00:05:31       ID3
# 4 2022-07-07 00:05:33 2022-07-07 00:05:34       ID4

所需输出为:
| 会话开始(_S)|机器人_ID|工作阶段结束(_E)|动物ID|
| - -|- -|- -|- -|
| 2022年7月7日00:05:19| R1接口|2022年7月7日00:05:21|识别码1|
| 2022年7月7日00:05:20| R2接口|2022年7月7日00:05:21|识别码1|
| 2022年7月7日00:05:21|第三代|2022年7月7日00:05:21|识别码1|
| 2022年7月7日00:05:22|第四章|不适用|不适用|
| 2022年7月7日00:05:23|第五章|不适用|不适用|
| 2022年7月7日00:05:24| R6接口|2022年7月7日00:05:26|识别码1|
| 2022年7月7日00:05:25|第七章|2022年7月7日00:05:26|识别码2|
| 2022年7月7日00:05:26| R8系列|2022年7月7日00:05:26|识别码2|
| 2022年7月7日00:05:27|第九章|2022年7月7日00:05:31| ID 3识别码|
| 2022年7月7日00:05:28|第十章|2022年7月7日00:05:31| ID 3识别码|
| 2022年7月7日00:05:29|第十一章|2022年7月7日00:05:31| ID 3识别码|
| 2022年7月7日00:05:30|第十二章|2022年7月7日00:05:31| ID 3识别码|
| 2022年7月7日00:05:31|第十三章|2022年7月7日00:05:31| ID 3识别码|
| 2022年7月7日00:05:32|十四|不适用|不适用|
| 2022年7月7日00:05:33|十五|2022年7月7日00:05:34| ID 4识别码|
| 2022年7月7日00:05:34|十六|2022年7月7日00:05:34| ID 4识别码|
我如何使用R来做这件事?
数据

df1 <- data.frame(Session_start=c("2022-07-07 00:05:19", "2022-07-07 00:05:20", "2022-07-07 00:05:21", 
                                  "2022-07-07 00:05:22", "2022-07-07 00:05:23", "2022-07-07 00:05:24", 
                                  "2022-07-07 00:05:25", "2022-07-07 00:05:26", "2022-07-07 00:05:27", 
                                  "2022-07-07 00:05:28", "2022-07-07 00:05:29", "2022-07-07 00:05:30", 
                                  "2022-07-07 00:05:31", "2022-07-07 00:05:32", "2022-07-07 00:05:33", 
                                  "2022-07-07 00:05:34"), 
                  Robot_ID =c("R1", "R2", "R3", "R4", "R5", "R6", "R7", "R8", "R9", "R10", 
                              "R11", "R12", "R13", "R14", "R15", "R16"))

df2 <- data.frame(Session_start=c("2022-07-07 00:05:19", "2022-07-07 00:05:24", 
                                  "2022-07-07 00:05:27", "2022-07-07 00:05:33"), 
                  Session_End=c("2022-07-07 00:05:21", "2022-07-07 00:05:26", 
                                "2022-07-07 00:05:31", "2022-07-07 00:05:34"), 
                  Animal_ID =c("ID1", "ID2", "ID3", "ID4"))
c8ib6hqw

c8ib6hqw1#

  • data.table* 与一个不相等的update-join连接可能会使这一点变得更好:
library(data.table)
setDT(df1)
setDT(df2)
df1[
    df2,
    on=.(Session_start>=Session_start, Session_start<=Session_End),
    c("Animal_ID","Session_End") := .(i.Animal_ID, i.Session_End)
]
df1
##          Session_start Robot_ID Animal_ID         Session_End
## 1: 2022-07-07 08:05:19       R1       ID1 2022-07-07 08:05:21
## 2: 2022-07-07 08:05:20       R2       ID1 2022-07-07 08:05:21
## 3: 2022-07-07 08:05:21       R3       ID1 2022-07-07 08:05:21
## 4: 2022-07-07 08:05:22       R4      <NA>                <NA>
## 5: 2022-07-07 08:05:23       R5      <NA>                <NA>
## 6: 2022-07-07 08:05:24       R6       ID2 2022-07-07 08:05:26
## 7: 2022-07-07 08:05:25       R7       ID2 2022-07-07 08:05:26
## 8: 2022-07-07 08:05:26       R8       ID2 2022-07-07 08:05:26
## 9: 2022-07-07 08:05:27       R9       ID3 2022-07-07 08:05:31
##10: 2022-07-07 08:05:28      R10       ID3 2022-07-07 08:05:31
##11: 2022-07-07 08:05:29      R11       ID3 2022-07-07 08:05:31
##12: 2022-07-07 08:05:30      R12       ID3 2022-07-07 08:05:31
##13: 2022-07-07 08:05:31      R13       ID3 2022-07-07 08:05:31
##14: 2022-07-07 08:05:32      R14      <NA>                <NA>
##15: 2022-07-07 08:05:33      R15       ID4 2022-07-07 08:05:34
##16: 2022-07-07 08:05:34      R16       ID4 2022-07-07 08:05:34
k10s72fa

k10s72fa2#

首先,使用outer()找到索引w,其中df的会话开始位于df2的会话间隔之间。接下来,使用cbind将它们分配到相应的切片。最后,使用merge计算余数。

w <- outer(df1[, 1], as.data.frame(t(df2[1:2])), 
           Vectorize(\(x, y) x >= y[1] & x <= y[2])) |>
  apply(2, which)

Map(\(x, y) cbind(df1[x, ], df2[y, -1]), w, seq_len(nrow(df2))) |>
  do.call(what=rbind) |> merge(df1, all=TRUE)
#          Session_start Robot_ID         Session_End Animal_ID
# 1  2022-07-07 00:05:19       R1 2022-07-07 00:05:21       ID1
# 2  2022-07-07 00:05:20       R2 2022-07-07 00:05:21       ID1
# 3  2022-07-07 00:05:21       R3 2022-07-07 00:05:21       ID1
# 4  2022-07-07 00:05:22       R4                <NA>      <NA>
# 5  2022-07-07 00:05:23       R5                <NA>      <NA>
# 6  2022-07-07 00:05:24       R6 2022-07-07 00:05:26       ID2
# 7  2022-07-07 00:05:25       R7 2022-07-07 00:05:26       ID2
# 8  2022-07-07 00:05:26       R8 2022-07-07 00:05:26       ID2
# 9  2022-07-07 00:05:27       R9 2022-07-07 00:05:31       ID3
# 10 2022-07-07 00:05:28      R10 2022-07-07 00:05:31       ID3
# 11 2022-07-07 00:05:29      R11 2022-07-07 00:05:31       ID3
# 12 2022-07-07 00:05:30      R12 2022-07-07 00:05:31       ID3
# 13 2022-07-07 00:05:31      R13 2022-07-07 00:05:31       ID3
# 14 2022-07-07 00:05:32      R14                <NA>      <NA>
# 15 2022-07-07 00:05:33      R15 2022-07-07 00:05:34       ID4
# 16 2022-07-07 00:05:34      R16 2022-07-07 00:05:34       ID4

**注意:**即使解决方案不使用"POSIXct"(日期是按字母顺序比较的),您在使用日期时间时也应该始终使用"POSIXct"。如果您还没有"POSIXct",请转换它:

df1$Session_start <- as.POSIXct(df1$Session_start)
df2[1:2] <- lapply(df2[1:2], as.POSIXct)
3yhwsihp

3yhwsihp3#

这个答案比邮件和jay.sf的要长得多,但我还是会把它贴出来,这样你就有更多的想法了。
我的方法是使用辅助变量,使用lubridate来确保我使用的是正确的格式,然后开始传播Animal_ID和Session_End数据。

# Loading libraries -------------------------------------------------------

library(dplyr)
library(lubridate)

# Defining datasets -------------------------------------------------------

Session_start <-
  c(
    "2022-07-07 00:05:19",
    "2022-07-07 00:05:24",
    "2022-07-07 00:05:27",
    "2022-07-07 00:05:33"
  )

Session_End <-
  c(
    "2022-07-07 00:05:21",
    "2022-07-07 00:05:26",
    "2022-07-07 00:05:31",
    "2022-07-07 00:05:34"
  )

Animal_ID <- c("ID1", "ID2", "ID3", "ID4")

df2 <- data.frame(Session_start, Session_End, Animal_ID)

Session_start <-
  c(
    "2022-07-07 00:05:19",
    "2022-07-07 00:05:20",
    "2022-07-07 00:05:21",
    "2022-07-07 00:05:22",
    "2022-07-07 00:05:23",
    "2022-07-07 00:05:24",
    "2022-07-07 00:05:25",
    "2022-07-07 00:05:26",
    "2022-07-07 00:05:27",
    "2022-07-07 00:05:28",
    "2022-07-07 00:05:29",
    "2022-07-07 00:05:30",
    "2022-07-07 00:05:31",
    "2022-07-07 00:05:32",
    "2022-07-07 00:05:33",
    "2022-07-07 00:05:34"
  )

Robot_ID <-
  c(
    "R1",
    "R2",
    "R3",
    "R4",
    "R5",
    "R6",
    "R7",
    "R8",
    "R9",
    "R10",
    "R11",
    "R12",
    "R13",
    "R14",
    "R15",
    "R16"
  )

df1 <- data.frame(Session_start, Robot_ID)

# Joining with data propagation -------------------------------------------

df <-
  dplyr::left_join(df1, df2, by = "Session_start") |>
  arrange(Session_start) |>
  mutate(
    Session_start =
      Session_start |>
      lubridate::as_datetime(),
    Session_End =
      Session_End |>
      lubridate::as_datetime()
  ) |>
  mutate(
    is_na_Session_End = if_else(
      condition = is.na(Session_End),
      true = FALSE,
      false = TRUE
    ),
    number_of_non_NA_Session_End = cumsum(is_na_Session_End)
  ) |>
  group_by(number_of_non_NA_Session_End) |>
  mutate(Session_End =
           Session_End |>
           first(),
         Animal_ID =
           Animal_ID |>
           first()) |>
  mutate(
    Session_End = if_else(
      condition = Session_start <= Session_End,
      true = Session_End,
      false = NA_POSIXct_
    ),
    Animal_ID = if_else(
      condition = Session_start <= Session_End,
      true = Animal_ID,
      false = NA_character_
    )
  ) |>
  ungroup() |>
  select(-is_na_Session_End,
         -number_of_non_NA_Session_End) |>
  as.data.frame()

df
ttisahbt

ttisahbt4#

这是我的答案。它有点简单,但它可以很好地用于您的数据集:

# Package needed
library(dplyr)

# First, preprocess the data
df1 <- df1 %>% 
  mutate_at(vars(Session_start), as.POSIXct)

df2 <- df2 %>% 
  mutate_at(vars(Session_start, Session_End), as.POSIXct)

df3 <- merge(df1, df2, all = TRUE)

# Then, fill the voids 
for (i in 1:nrow(df3)) {
  
  if (!is.na(df3$Session_End[i])) {
    
    session_end1 <- df3$Session_End[i]
    animal_id1 <- df3$Animal_ID[i]
    
  } else {
    
    if (i < nrow(df3)) {
      
      if (df3$Session_start[i] < df3$Session_start[i+1]) {
        
        df3$Session_End[i] <- session_end1
        df3$Animal_ID[i] <- animal_id1
        
      }
      
    } else if (i == nrow(df3)) {
      
      df3$Session_End[i] <- session_end1
      df3$Animal_ID[i] <- animal_id1
      
    }
    
  }
  
}

相关问题