"Reshape" 长格式数据转换为两个序列

Question

我有一个数据框，其中列出了观察到的行为 ("observation")、观察到的对象 ("code") 和观察时间（"day" 和 "time"） :

code   day   time       observation
A1     1     07:30:00   w
A1     1     12:15:00   f
A1     1     18:40:00   v
B2     1     08:12:00   q
B2     1     09:33:00   s
B2     2     14:10:00   a
B2     2     20:20:00   g

根据这些数据，我想创建一个新的数据框，其中每个观察结果都与它后面的观察结果配对，在一个主题中。对于示例数据，生成的新数据框应如下所示：

code   night   obs.1   obs.2
A1     FALSE   w       f
A1     FALSE   f       v
B2     FALSE   q       s
B2     TRUE    s       a
B2     FALSE   a       g

新变量"night"表示两次观察之间是否隔夜，即第二次观察是否在第二天进行。（请注意每个不是第一个或最后一个对象的观察结果如何在新数据框中出现两次，因为它既是一个序列中的前一个观察结果又是另一个系列中的后一个观察结果两个观察结果。）

我想写一个循环，逐行遍历原始数据框，然后查看下一行并比较 "code" 和 "day" 然后创建一个新行代码是相同的，当 "day" 更改时将 "night" 设置为 "TRUE"。类似于下面示例数据中的代码。

有没有比遍历数据更好的方法？

例如，是否可以通过 reshape()?

之类的方式实现此目的

示例数据

dat <- read.table(textConnection("
code day time observation
A1 1 07:30:00 w
B2 2 14:10:00 a
A1 1 12:15:00 f
A1 1 18:40:00 v
B2 1 08:12:00 q
B2 1 09:33:00 s
B2 2 20:20:00 g
"), header = TRUE, as.is = TRUE)

dat$code <- as.factor(dat$code)
dat$day <- as.factor(dat$day)
dat$time <- strptime(dat$time, "%T")

dat <- dat[with(dat, order(code, day, time)), ]  # so we can loop

dat.pairs <- data.frame(
                            code = character(),
                            night = logical(),
                            obs.1 = character(),
                            obs.2 = character(),
                            stringsAsFactors = FALSE
                       )

for (i in 1:(nrow(dat)-1)) {
    if (dat[i, ]$code == dat[i+1, ]$code) {
        if (dat[i, ]$day == dat[i+1, ]$day) {
            n = FALSE
        } else {
            n = TRUE
        }
        dat.pairs <- rbind(dat.pairs, data.frame(code = dat[i, ]$code, night = n, obs.1 = dat[i, ]$observation, obs.2 = dat[i+1, ]$observation))
    }
}

Answer 1

你可以试试 dplyr

library(dplyr)
dat$day<-as.numeric(as.character(dat$day)) #to turn into numeric
dat$time<-as.POSIXct(dat$time) #dplyr can't work with POSIXlt
dat%>%
  group_by(code)%>%
  rename(obs.1=observation)%>%
  mutate(obs.2=lead(obs.1),night=lead(day)>day)%>%
  filter(!is.na(obs.2))%>%
  select(code,night,obs.1,obs.2)

它适用于示例：

Source: local data frame [5 x 4]
Groups: code [2]

    code night obs.1 obs.2
  <fctr> <lgl> <chr> <chr>
1     A1 FALSE     w     f
2     A1 FALSE     f     v
3     B2 FALSE     q     s
4     B2  TRUE     s     a
5     B2 FALSE     a     g

编辑： 考虑了 juod 和 Sotos 的评论

Answer 2

这是一个非常直接的选项，使用 data.table

library(data.table)
setDT(df)[, 
          .(
            night = diff(day) == 1,
            obs.1 = head(observation, -1),
            obs.2 = tail(observation, -1)
           ),
          by = code]

#    code night obs.1 obs.2
# 1:   A1 FALSE     w     f
# 2:   A1 FALSE     f     v
# 3:   B2 FALSE     q     s
# 4:   B2  TRUE     s     a
# 5:   B2 FALSE     a     g

Answer 3

更新：我想出了如何通过重塑来做到这一点，所以已经替换了之前的部分解决方案

为了回答您的问题，是的，可以使用 reshape() 来实现。请注意，我指的是 stats::reshape() 函数。

dat$night <- unlist(by(dat, 
                       dat$code, 
                       FUN=function(x) c((x[2:nrow(x), 2] - x[1:(nrow(x)-1), 2])==1, FALSE)))

dat$id.1 <- unlist(by(dat, 
                      dat$code, 
                      FUN=function(x) c(rep(1:nrow(x), each=2))[1:nrow(x)]))
dat$id.2 <- unlist(by(dat, 
                      dat$code, 
                      FUN=function(x) c(0, rep(1:nrow(x), each=2))[1:nrow(x)]))
dat$visit.1 <- unlist(by(dat, 
                         dat$code, 
                         FUN=function(x) rep(c(1,2), nrow(x))[1:nrow(x)]))
dat$visit.2 <- unlist(by(dat, 
                         dat$code, 
                         FUN=function(x) c(0, rep(c(1,2), nrow(x)))[1:nrow(x)]))
dat

rows1 <- na.omit(reshape(dat, 
                         timevar = "visit.1", 
                         idvar = c("code", "id.1"), 
                         direction = "wide", 
                         v.names = "observation", 
                         drop = c("day", "visit.2")))
rows2 <- na.omit(reshape(dat[dat$visit.2 != 0,], 
                         timevar = "visit.2", 
                         idvar = c("code", "id.2"), 
                         direction = "wide", 
                         v.names = "observation", 
                         drop = c("day", "visit.1")))

dat.pairs <- rbind(rows1, rows2)
dat.pairs[order(dat.pairs$code, dat.pairs$time), c("code", "night", "observation.1", "observation.2")]
  code night observation.1 observation.2
1   A1 FALSE             w             f
3   A1 FALSE             f             v
5   B2 FALSE             q             s
6   B2  TRUE             s             a
2   B2 FALSE             a             g

这是一种使用基本 R 函数的替代方法，它也可以避免循环遍历数据：

dat$day <- as.numeric(as.character(dat$day))
dat$night <- unlist(by(dat, 
                       dat$code, 
                       FUN=function(x) c((x[2:nrow(x), 2] - x[1:(nrow(x)-1), 2])==1, FALSE)))

dat$obs.1 <- dat$observation
dat$obs.2 <- unlist(by(dat, 
                       dat$code, 
                       FUN=function(x) c(x[2:nrow(x), 4], NA)))

dat.pairs <- dat[!is.na(dat$obs.2), c("code", "night", "obs.1", "obs.2")]
dat.pairs$code <- as.character(dat.pairs$code)

这将重现示例结果：

dat.pairs
  code night obs.1 obs.2
1   A1 FALSE     w     f
3   A1 FALSE     f     v
5   B2 FALSE     q     s
6   B2  TRUE     s     a
2   B2 FALSE     a     g

"Reshape" 长格式数据转换为两个序列

"Reshape" long format data into sequences of two

r

reshape