Reputation: 11
I am attempting to take monthly data on enrollment in different programs and turn it into durations/spells for each "idnum". For example:
row idnum date program
1 00001 201301 1
2 00001 201302 1
3 00001 201303 1
4 00001 201306 1
5 00001 201307 1
6 00002 201301 1
7 00002 201302 1
8 00002 201304 1
9 00002 201305 1
10 00002 201307 1
11 00002 201308 1
"idnum" 00001 is enrolled in program "1" from 201301 to 201303 (duration of 3 months) and from 201306 to 201307 (duration of 2 months).
"idnum" 00002 is enrolled in program "1" from 201301 to 201302 (2 months), from 201304 to 201305 (2 months), and from 201307 to 201308 (2 months).
What I would like to have is a result akin to the following:
idnum program start duration
00001 1 201301 3
00001 1 201306 2
00002 1 201301 2
00002 1 201304 2
00002 1 201307 2
Any help would be greatly appreciated! Thanks in advance for your advice.
Upvotes: 0
Views: 321
Reputation: 4615
I like using the data.table
package when trying to compare different rows.
require("data.table")
#Create fake data
data <- data.table(row=1:11,idnum=c(rep("00001",5),rep("00002",6)),
date=c(201301:201303,201306:201307,201301:201302,201304:201305,201307:201308),program=1)
#Develop order by id
data[,order:=seq(1,.N),by="idnum"]
#Calculate date difference within each id for each date
data[,date.diff:=(date[order+1]-date[order]),by="idnum"]
#Lag date diff
data[,date.diff2:=c(NA,date.diff[-.N])]
data[is.na(date.diff2),date.diff2:=0]
#Develop new start variable to account for interuptions within id
data[,new.start:=1*(date.diff2>1)]
data[,start.group:=cumsum(new.start)]
#Develop result
result <- data[,list(idnum=idnum[1],program=program[1],start=date[1],duration=(date[.N]-date[1]+1)),
by=c("idnum","start.group")]
result
idnum start.group idnum program start duration
1: 00001 0 00001 1 201301 3
2: 00001 1 00001 1 201306 2
3: 00002 1 00002 1 201301 2
4: 00002 2 00002 1 201304 2
5: 00002 3 00002 1 201307 2
Upvotes: 1
Reputation: 206197
It's not super easy in base R to aggregate by different functions, and your date values are super easy to find gaps in that form, but here's one strategy
#helper function to convert date to continuous integer
tomonthseq<-function(x) {
x<-as.character(x)
yr<-as.numeric(substr(x,1,4))
mo<-as.numeric(substr(x,5,6))
ryr<-min(yr)
mo+(yr-ryr)*12
}
#find ID for each id/prog/date seq
sq<-with(dd,ave(tomonthseq(as.character(date)), idnum, program, FUN=function(x) {
cumsum(c(0, diff(x)!=1))
}))
#do the aggregation
xx <- aggregate(date~sq+program+idnum, dd,
function(x) {cbind(x[1], length(x))})
#clean up after aggregation mess
xx <- cbind(xx[, 3:2],
structure(xx[, 4], .Dimnames=list(NULL, c("start","duration"))))
And the output is
idnum program start duration
1 00001 1 201301 3
2 00001 1 201306 2
3 00002 1 201301 2
4 00002 1 201304 2
5 00002 1 201307 2
Upvotes: 0