Question

我正在编写一个函数来计算三个时期之间重叠的持续时间，但我无法找到如何有效地编程，所以希望有人可以帮助我。

我有一个随着时间的推移被跟踪的人的数据集。参与者之间的开始日期以及研究所花费的时间不同。对于每个参与者，我想计算他们在特定年份的研究中有多少天以及在哪个5岁年龄组中。例如，如果有人在01-01-2000至01-06-2001期间参加研究，并且他出生于15-06-1965，他将在2000年为30-34岁年龄组贡献166天，200在2000年的35-39岁年龄段和2001年的35-39岁年龄段的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岁年龄组）。

希望我能够清楚地解释我的问题。

非常感谢提前！

Answer 1

我找到了解决方案（见下文）。代码看起来相当麻烦，因此可能会更高效。欢迎任何建议！

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的功能错误。

如何量化三个时期之间的重叠？

1 个答案: