There are a at least a couple of ways of programming the function, which I show below. The first is to write several if/else statements and the second is to make one very large call to ifelse()
.
Depending on how you are using the function you could call the function in a couple of ways as well. The first would be to use apply
, which will then generate a vector of values computed based on the formula applied to the rows. Each element in the output will be from the corresponding matrix row. You could also compute the values row-by-row using a for
loop. Depending on the size of the data you might want to compare the time of each of these methods to determine which is the fastest.
# function to evaluate all the if/else conditions
f1 <- function(x){
if(x[3] >= 70 && is.na(x[3]) == F){
out <- 1
}else if(x[4] >= 70 && is.na(x[4]) == F){
out <- -1
}else if(x[5] >= 70 && is.na(x[5]) == F){
out <- -1
}else if(x[6] >= 70 && is.na(x[6]) == F){
out <- 0
}else if(x[7] >= 70 && is.na(x[7]) == F){
out <- -1
}else if(x[8] >= 70 && is.na(x[8]) == F){
out <- 1
}else if (x[9] >= 70 && is.na(x[9]) == F){
out <- 0
}else{
out <- 999
}
return(out)
}
# function with a single large function call
f2 <- function(x){
out <- ifelse(x[3]>=70&& is.na(x[3]) == F,1,ifelse(x[4]>=70&& is.na(x[4]) == F,-1,ifelse(x[5]>=70&& is.na(x[5]) == F,-1,ifelse(x[6]>=70&& is.na(x[6]) == F,0,ifelse(x[7]>=70&& is.na(x[7]) == F,-1,ifelse(x[8]>=70&& is.na(x[8]) == F,1,ifelse(x[9]>=70&& is.na(x[9]) == F,0,999)))))))
}
# sample data to test function
# A B C D E F G H I
x <- matrix(c( 0, 0, 71, 0, 0, 0, 0, 0, 0,
0, 0, 0, 70, 0, 0, 0, 0, 0,
0, 10, 1, 0, 71, 0, 10, 90, 0,
99, 0, 0, 69, 67, 90, 99, 1, 0,
0, 0, 0, 0, 0, 0, 70, 0, 0,
0, 0, 0, 0, 0, 0, 0, 71, 0,
0, 0, 0, 0, 0, 0, 0, 0, 72,
0, 0, 0, 0, 0, 0, 0, 0, 1,
NA, NA, NA, NA, 1, 70, 0, NA, 0,
NA, NA, NA, NA, NA, NA, NA, NA, NA),nrow=10,ncol=9,byrow=T)
# method 1: using apply and avoiding loop, with timing
ptm <- proc.time()
out_f1_m1 <- apply(X=x,MARGIN=1,FUN=f1)
time_f1_m1 <- proc.time() - ptm
ptm <- proc.time()
out_f2_m1 <- apply(X=x,MARGIN=1,FUN=f2)
time_f2_m1 <- proc.time() - ptm
# method 2: using a for loop
out_f1_m2 <- rep(NA,nrow(x))
out_f2_m2 <- rep(NA,nrow(x))
ptm <- proc.time()
for(i in 1:nrow(x)){
out_f1_m2[i] <- f1(x[i,])
}
time_f1_m2 <- proc.time() - ptm
ptm <- proc.time()
for(i in 1:nrow(x)){
out_f2_m2[i] <- f2(x[i,])
}
time_f2_m2 <- proc.time() - ptm