1

3 つの期間の重複期間を計算する関数を作成していますが、これを効率的にプログラムする方法を見つけるのに苦労しているので、誰かが私を助けてくれることを願っています。

長い間フォローされてきた人々のデータセットがあります。開始日、および調査に費やされる時間は、参加者によって異なります。各参加者について、特定の年に研究に参加した日数と、それがどの 5 歳のカテゴリに属していたかを計算したいと思います。たとえば、誰かが 2000 年 1 月 1 日から 2001 年 1 月 6 日まで調査に参加し、1965 年 6 月 15 日生まれの場合、2000 年の 30 歳から 34 歳の年齢カテゴリに 166 日貢献します。 2000 年には 35 ～ 39 歳のカテゴリで 151 日、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 に答える