我有一个数据框,列出观察到的行为("观察"),观察到的主题("代码")和观察时间("日"和"时间"):
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
根据这些数据,我想在一个主题中创建一个新的数据框,其中每个观察与其后面的观察结果配对。对于样本数据,生成的新数据框应如下所示:
reshape()
新变量" night"说明两次观察之间是否有一个夜晚,即第二次观察是否在第二天进行。 (请注意每个不是第一个或最后一个主题的观察在新数据框中出现两次,因为它既是前一个观察中的一个,另一个是两个观察中的后续观察。)
我想编写一个循环,逐行遍历原始数据框,然后查看下一行并比较"代码"和#34; day"然后在代码相同时创建一个新行并设置" night"到" TRUE"当" day"变化。类似下面的示例数据中的代码。
有没有比循环数据更好的方法?
例如,是否可以通过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))
}
}
?
示例数据
@XMLAttribute
答案 0 :(得分:5)
使用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
答案 1 :(得分:3)
您可以尝试使用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的评论
答案 2 :(得分:0)
更新:我想出了如何通过重塑来做到这一点所以已经取代了之前的部分解决方案
要回答你的问题,是的,可以用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