# Calculating calendar year for a student based on DOB

I've written this brief function for calculating which calendar year a student would be in Year 1 based on their DOB (date of birth). In 1998 there was a change in the DOB cut points for starting Year 1, hence the need for a function.

year1 <- function(x){
if(x <= as.Date("1996-12-31")) {out <- as.numeric(format(x, "%Y")) +6}
if(x >= as.Date("1997-07-01")) {ifelse(as.numeric(format(x, "%m")) >=07 , out <- as.numeric(format(as.Date(x), "%Y")) + 7, out <- as.numeric(format(x, "%Y")) + 6)}
if(x >= as.Date("1997-01-01") & x <= as.Date("1997-06-30")) {out <- 2003}
return(out)
}


An example of the results:

> year1(as.Date("1996-02-15"))
[1] 2002
> year1(as.Date("1999-02-15"))
[1] 2006


I plan to run it like this:

> test <- c(as.Date("1985-09-15"),as.Date("1999-02-15"),as.Date("2004-08-15"))
> sapply(test,year1)
[1] 1991 2006 2011


I have a lot of data to run this over, and the use of so many ifs and assigning the result to out just to write it seems pretty redundant, but I couldn't think of a better way to do it.

• I see, primary school in Australia for children six to seven years old is called year 1. – minopret Mar 22 '12 at 4:32
• it's different in different states, in WA it used to be a case that at the start (say January) of Year 1 kids were aged between 5 and 6, with the change in 1997 it is now the case that kids are aged between 5.5 and 6.5 at the start of Year 1. – nzcoops Mar 22 '12 at 4:36

Your first and third condition can be collapsed into one, which just leaves a single split point. As such, you can use ifelse.

year1 <- function(x) {
year <- as.numeric(format(x, "%Y"))
ifelse(x <= as.Date("1997-06-30"), year+6, year+7)
}


This is also vectorized, so you can use it like:

test <- as.Date(c("1985-09-15", "1999-02-15", "2004-08-15", "1996-02-15"))
year1(test)


which gives

> year1(test)
[1] 1991 2006 2011 2002


EDIT:

The code I gave was wrong; it did not agree with the original code in many of the cases. Here is an updated version which does:

year1 <- function(x){
year <- as.numeric(format(x, "%Y"))
ifelse(x <= as.Date("1997-06-30"),
year + 6,
ifelse(as.numeric(format(x, "%m")) >=07 ,
year + 7,
year + 6))
}


You can squeeze a little more out of it by not bothering with the assignment to year and factoring that out of the ifelse

year1 <- function(x){
as.numeric(format(x, "%Y")) +
ifelse(x <= as.Date("1997-06-30"),
6,
ifelse(as.numeric(format(x, "%m")) >=07 ,
7,
6))
}


Benchmarking:

year1.nzcoops <- function(x){
if(x <= as.Date("1996-12-31")) {out <- as.numeric(format(x, "%Y")) +6}
if(x >= as.Date("1997-07-01")) {ifelse(as.numeric(format(x, "%m")) >=07 , out <- as.numeric(format(as.Date(x), "%Y")) + 7, out <- as.numeric(format(x, "%Y")) + 6)}
if(x >= as.Date("1997-01-01") & x <= as.Date("1997-06-30")) {out <- 2003}
return(out)
}
year1.Brian <- function(x){
year <- as.numeric(format(x, "%Y"))
ifelse(x <= as.Date("1997-06-30"),
year + 6,
ifelse(as.numeric(format(x, "%m")) >=07 ,
year + 7,
year + 6))
}

year1.BrianB <- function(x){
as.numeric(format(x, "%Y")) +
ifelse(x <= as.Date("1997-06-30"),
6,
ifelse(as.numeric(format(x, "%m")) >=07 ,
7,
6))
}

year1.minopret <- function(dob) as.numeric(format(dob, "%Y")) + 6 +
(as.Date("1997-07-01") <= dob & 7 <= as.numeric(format(dob, "%m")))


More comprehensive test data:

test <- as.Date("1985-09-15")+(0:10000)


Checking results:

res.nzcoops <- sapply(test, year1.nzcoops)
res.Brian <- year1.Brian(test)
res.BrianB <- year1.BrianB(test)
res.minopret <- year1.minopret(test)

> identical(res.nzcoops, res.Brian)
[1] TRUE
> identical(res.nzcoops, res.BrianB)
[1] TRUE
> identical(res.nzcoops, res.minopret)
[1] TRUE


Timing comparisons:

> library("rbenchmark")
> benchmark(sapply(test, year1.nzcoops),
+           year1.Brian(test),
+           year1.BrianB(test),
+           year1.minopret(test),
+           order = "relative",
+           replications = 10)
test replications elapsed   relative user.self
4        year1.minopret(test)           10    0.12   1.000000      0.12
3          year1.BrianB(test)           10    0.14   1.166667      0.14
2           year1.Brian(test)           10    0.16   1.333333      0.14
1 sapply(test, year1.nzcoops)           10   74.95 624.583333     74.85
sys.self user.child sys.child
4     0.00         NA        NA
3     0.00         NA        NA
2     0.01         NA        NA
1     0.02         NA        NA

• Cheers, I have so many timelines written down working out start/finish ages for difference calendar years and school years I couldn't see the forest for the trees. – nzcoops Mar 22 '12 at 6:36

I think this is equivalent to your function.

year1 <- function(dob) as.numeric(format(dob, "%Y")) + 6 +
(as.Date("1997-07-01") <= dob & 7 <= as.numeric(format(dob, "%m")))


You would run it like this.

> test <- c(as.Date("1985-09-15"),as.Date("1999-02-15"),as.Date("2004-08-15"))
> year1(test)

• It is also worth pointing out that this function is vectorized where the original wasn't. You demonstrate that in the example, but I wanted to point it out explicitly. – Brian Diggs Mar 22 '12 at 5:38