1

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

我有一个随着时间的推移被跟踪的人的数据集。参与者之间的开始日期以及研究花费的时间不同。对于每个参与者，我想计算他们在特定年份参与研究的天数以及所处的 5 岁年龄段。例如，如果某人在 01-01-2000 到 01-06-2001 的研究中，并且他出生于 1965 年 6 月 15 日，他将在 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))

到目前为止，我想出了这个，但现在不知道如何进行（或者我是否应该采取完全不同的方法）......</p> 

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 岁的年龄类别）。

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

提前谢谢了！

4

1 回答 1

0

我找到了一个解决方案（见下文）。虽然代码看起来相当繁琐，所以可能会变得更有效率。欢迎任何建议！

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 的函数错误。

于 2013-08-01T12:56:19.837 回答