我正在编写一个函数来计算三个周期之间重叠的持续时间,但我很难找到如何有效地编程,所以希望有人能帮我。
我有一个随着时间的推移被跟踪的人的数据集。研究的开始日期以及在研究中花费的时间因参与者而异。对于每个参与者,我想计算他们在特定年份参加研究的天数,以及属于哪一个5年年龄组。例如,如果有人在2000年1月1日至2001年6月1日期间参加研究,并且他出生于1965年6月15日,那么他在2000年将为30-34岁年龄组贡献166天,在2000年为35-39岁年龄组奉献200天,在2001年为35-38岁年龄组提供151天,而他在所有其他类别中都花费了0天。
换句话说:我想量化这些时期之间的重叠:
A=进入研究到结束研究(参与者不同,但参与者内固定值)
B=从特定年份开始到特定年份结束(不同参与者相同,不同参与者不同)
C=进入特定的5岁年龄类别到退出特定的5年年龄类别(参与者不同,参与者不同)
我的数据看起来像这样:
dat <- data.frame(lapply(
data.frame("Birth"=c("1965-06-15","1960-02-01","1952-05-02"),
"Begin"=c("2000-01-01","2003-08-14","2007-12-05"),
"End"=c("2001-06-01","2006-10-24","2012-03-01")),as.Date))
到目前为止,我想出了这个,但现在不知道如何继续(或者我是否应该采取完全不同的方法)…
spec.fu <- function(years,birth,begin,end,age.cat,data){
birth <- data[,birth]
start.A <- data[,begin]
end.A <- data[,end]
for (i in years){
start.B <- as.Date(paste(i,"01-01",sep="-"))
end.B <- as.Date(paste(i+1,"01-01",sep="-"))
for (j in age.cat){
start.C <- paste((as.numeric(format(birth, "%Y"))+j),
format(birth,"%m-%d"), sep="-")
end.C <- paste((as.numeric(format(birth, "%Y"))+j+5),
format(birth,"%m-%d"), sep="-")
result <- ?????
data[,ncol(data)+?????] <- result
colnames(data)[ncol(data)+?????] <- paste("fu",j,"in",i,sep="")
}
}
return(data)
}
并像这样使用:
newdata <- spec.fu(years=2000:2001,birth="Birth",begin="Begin",
end="End",age.cat=seq(30,35,5),data=dat)
因此,在这种情况下,我想为每个参与者制作2(年龄类别的数量)*2(年份的数量)=4个新列,每个列都包含某人在该特定类别的研究中度过的天数(例如,2001年年龄类别30-34)。
希望我能清楚地解释我的问题。
非常感谢!
我找到了一个解决方案(见下文)。不过,代码看起来相当繁琐,因此可能会提高效率。欢迎任何建议!
spec.fu <- function(years,birth,begin,end,age.cat,data){
birth <- data[,birth]
start.A <- data[,begin]
end.A <- data[,end]
if (any(sapply(c(birth,start.A,end.A),FUN=function(x) class(x)!="Date"))) {
stop("'birth', 'begin' and 'end' must be of class 'Date''") }
# ifelse-function that saves Date class in vectors
# (http://stackoverflow.com/questions/6668963)
safe.ifelse <- function(cond, yes, no) {
structure(ifelse(cond, yes, no), class = class(yes))}
for (i in years){
start.B <- rep(as.Date(paste(i,"01-01",sep="-")),nrow(data))
end.B <- rep(as.Date(paste(i+1,"01-01",sep="-")),nrow(data))
start.AB <- safe.ifelse((start.A <= end.B & start.B <= end.A) &
start.A >= start.B, start.A,
safe.ifelse((start.A <= end.B & start.B <= end.A) &
start.B >= start.A, start.B,
as.Date("1000-01-01")))
#in latter case overlap is zero, but a Date is required later on
end.AB <- safe.ifelse((start.A <= end.B & start.B <= end.A) &
end.A <= end.B, end.A,
safe.ifelse((start.A <= end.B & start.B <= end.A) &
end.B <= end.A, end.B,
as.Date("1000-01-01")))
for (j in age.cat){
start.C <- safe.ifelse(format(birth,"%m")=="02" & format(birth,
"%d")=="29",
as.Date(paste((as.numeric(format(birth,
"%Y"))+j),format(birth,"%m"),
"28", sep="-")),
as.Date(paste((as.numeric(format(birth,
"%Y"))+j), format(birth,"%m-%d"),
sep="-")))
end.C <- safe.ifelse(format(birth,"%m")=="02" & format(birth,
"%d")=="29",
as.Date(paste((as.numeric(format(birth,
"%Y"))+j+5),format(birth,"%m"),
"28", sep="-")),
as.Date(paste((as.numeric(format(birth,
"%Y"))+j+5),format(birth,"%m-%d"),
sep="-")))
start.ABC <- safe.ifelse((start.AB <= end.C & start.C <= end.AB) &
start.AB >= start.C, start.AB,
safe.ifelse((start.AB <= end.C & start.C <= end.AB) &
start.C >= start.AB, start.C,
as.Date("1000-01-01")))
end.ABC <- safe.ifelse((start.AB <= end.C & start.C <= end.AB) &
end.AB <= end.C, end.AB,
safe.ifelse((start.AB <= end.C & start.C <= end.AB) &
end.C <= end.AB, end.C,
as.Date("1000-01-01")))
result <- as.numeric(difftime(end.ABC,start.ABC,units="days"))
data <- cbind(data,result)
colnames(data) <- c(colnames(data)[1:(ncol(data)-1)],
paste("fu",j,"in",i,sep=""))
}
}
return(data)
}
该功能可按如下方式使用:
newdata <- spec.fu(years=2000:2001,birth="Birth",begin="Begin",
end="End",age.cat=seq(30,35,5),data=dat)
它给出了以下结果(新列4:7):
> newdata
Birth Begin End fu30in2000 fu35in2000 fu30in2001 fu35in2001
1 1965-06-15 2000-01-01 2001-06-01 166 200 0 151
2 1960-02-01 2003-08-14 2006-10-24 0 0 0 0
3 1952-05-02 2007-12-05 2012-03-01 0 0 0 0
更新(2013年8月6日):修复了函数中导致NA出生日期为闰日的错误。