将长格式数据“重塑”为两个序列答案

【问题标题】："Reshape" long format data into sequences of two将长格式数据“重塑”为两个序列
【发布时间】：2017-02-26 11:55:19
【问题描述】：

我有一个数据框，其中列出了观察到的行为（“观察”）、观察到的对象（“代码”）和观察时间（“天”和“时间”）：

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

新变量“夜”表示两次观察之间是否有一个夜晚，即第二次观察是否在第二天进行。（请注意，不是一个主题的第一个或最后一个观察值如何在新数据框中出现两次，因为它既是一个观察值中的前一个观察值，也是另一个两个观察值系列中的下一个观察值.)

我想编写一个循环，逐行遍历原始数据帧，然后查看下一行并比较“代码”和“日期”，然后在代码相同时创建一个新行，并且当“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))
    }
}

【问题讨论】：

标签： r reshape

【解决方案1】：

这是一个使用 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

【讨论】：

【解决方案2】：

你可以试试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 的 cmets

【讨论】：

【解决方案3】：

更新：我想出了如何使用 reshape 来做到这一点，因此替换了之前的部分解决方案

要回答您的问题，是的，可以使用 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

【讨论】：