Improving R code - remove redundant if's and assignments

Question

I've written this brief function, it's to do with calculating which calendar year a student would be in Year 1 based on their DOB. 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 if's 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.

Thoughts?

Answer 1

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

Answer 2

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)