3
\$\begingroup\$

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.

\$\endgroup\$
2
  • \$\begingroup\$ I see, primary school in Australia for children six to seven years old is called year 1. \$\endgroup\$ Commented Mar 22, 2012 at 4:32
  • \$\begingroup\$ 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. \$\endgroup\$ Commented Mar 22, 2012 at 4:36

2 Answers 2

Reset to default
2
\$\begingroup\$

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
\$\endgroup\$
1
  • \$\begingroup\$ 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. \$\endgroup\$ Commented Mar 22, 2012 at 6:36
3
\$\begingroup\$

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)
\$\endgroup\$
1
  • \$\begingroup\$ 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. \$\endgroup\$ Commented Mar 22, 2012 at 5:38

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.