EvenOdd Function Optimization

[vittorio-g]

As previously discussed with @ryentes, I'm posting the code to optimize the "evenodd" function. This code should compute the values more or less ten times faster than the old function. Hope this helps!

evenodd2 <- function(x,factors){
  
  #objects needed
  odd_means <- data.frame(matrix(nrow = nrow(x),
                      ncol = length(factors)))
  even_means <- data.frame(matrix(nrow = nrow(x),
                       ncol = length(factors)))
  j <- 1
  a <- 0
  for(i in factors){
    #Creating a sequence of odd and even numbers
    even <- seq(2,max(factors),2)
    odd <- seq(1,max(factors),2)
    
    #factor selection
    a <- a+i
    sec <- x[,(a-i+1):a]
    
    #odd and even numbers of items selection
    o <- odd[1:round(i/2)]
    e <- even[1:(round(i/2)-1)]
    
    #row means of sections
    odd_means[,j] <- apply(sec[o],1,mean,na.rm=T)
    even_means[,j] <- apply(sec[e],1,mean,na.rm=T)
    
    j <- j+1  
  }
  
  #Correlation
  corr <- sapply(1:nrow(odd_means), function(i){
    cor(
      as.numeric(odd_means[i,]),
      as.numeric(even_means[i,]),
      use="complete.obs"
    )
  }
  )
  
  #Spearman-Brown and inversion 
  eoi <- -2*corr/(1 + corr)
  eoi
}

[franciscowilhelm]

The code is indeed quite significantly faster! However, I also found that the correlation with the current even odd function are varying depending on the dataset, with ca .4 on our test dataframe 1 and ca .8 on our test dataframe2. Do you have an idea why that might be? The one difference I see without delving deeper into the code is that extreme values of greater 1 are not restrained to 1, but I would be surprised if that explains every difference. Possibly the selections happening in lines 20-25 are also different.

# dataset 1
careless_eo <- evenodd(careless_dataset, rep(5,10))
careless_eo2 <- evenodd2(careless_dataset, rep(5,10))
cor(careless_eo, careless_eo2, use = "pairwise")

# dataset 2
careless_eo_dat2 <- evenodd(careless_dataset2, rep(10,10))
careless_eo2_dat2 <- evenodd2(careless_dataset2, rep(10,10))
cor(careless_eo_dat2, careless_eo2_dat2, use = "pairwise")

hist(careless_eo2)
hist(careless_eo2_dat2)

[vittorio-g]

Hi,

yes, the values greater than 1 are not restrained to 1, but that can be changed if needed. I checked the code and I confirm that the selection of the items had a problem. I should have fixed it, now it correlates 0.68 with careless_dataset and 0.94 with careless_dataset2. I’m still a bit worried about the relatively low correlation with the first dataset, but I suspect it has to do with NAs and values over 1. What do you think?

Anyway, I think we should consider if the time improvement is actually worth changing the function.

I'll leave the updated code below

evenodd2 <- function(x,factors){
  
  #objects needed
  odd_means <- data.frame(matrix(nrow = nrow(x),
                      ncol = length(factors)))
  even_means <- data.frame(matrix(nrow = nrow(x),
                       ncol = length(factors)))
  j <- 1
  a <- 0
  for(i in factors){
    #Creating a sequence of odd and even numbers
    even <- seq(2,max(factors),2)
    odd <- seq(1,max(factors),2)
    
    #factor selection
    a <- a+i
    sec <- x[,(a-i+1):a]
    
    #odd and even numbers of items selection
    o <- odd[1:(ceiling(i/2))]
    e <- even[1:(round(i/2))]
    
    #row means of sections
    odd_means[,j] <- apply(sec[o],1,mean,na.rm=T)
    even_means[,j] <- apply(sec[e],1,mean,na.rm=T)
    
    j <- j+1  
  }
  
  #Correlation
  corr <- sapply(1:nrow(odd_means), function(i){
    cor(
      as.numeric(odd_means[i,]),
      as.numeric(even_means[i,]),
      use="pairwise.complete.obs"
    )
  }
  )
  
  #Spearman-Brown and inversion 
  eoi <- -2*corr/(1 + corr)
  eoi
}

[franciscowilhelm]

Thanks for your quick fix! I took another look and the problem seems to be in the application of the Spearman-Brown to negative even-odd values. Normalizing to -1 results in a perfect correlation with the original evenodd function.

But even better would be to change the denominator of the spearman-brown correction to absolute values - across the old and the new function. This doesn't change the correlation a lot (.99) with or without the new Spearman-Brown, but the values distribution looks smoother and is more 'well-behaved'. Also a 'ormalization of values range is now obsolete.
@ryentes this will also be of interest to you.

I have created the tests and comparisons in the evenodd_updates branch. Below for convenience the update code from Vittorios function.

evenodd2 <- function(x,factors){

   #objects needed
   odd_means <- data.frame(matrix(nrow = nrow(x),
                                  ncol = length(factors)))
   even_means <- data.frame(matrix(nrow = nrow(x),
                                   ncol = length(factors)))
   j <- 1
   a <- 0
   for(i in factors){
       #Creating a sequence of odd and even numbers
       even <- seq(2,max(factors),2)
       odd <- seq(1,max(factors),2)

       #factor selection
       a <- a+i
       sec <- x[,(a-i+1):a]

       #odd and even numbers of items selection
       o <- odd[1:(ceiling(i/2))]
       e <- even[1:(round(i/2))]

       #row means of sections
       odd_means[,j] <- apply(sec[o],1,mean,na.rm=T)
       even_means[,j] <- apply(sec[e],1,mean,na.rm=T)

       j <- j+1
   }

   #Correlation
   corr <- sapply(1:nrow(odd_means), function(i){
       cor(
           as.numeric(odd_means[i,]),
           as.numeric(even_means[i,]),
           use="pairwise.complete.obs"
       )
   }
   )

   #Spearman-Brown and inversion
   eoi <- -2*corr/(1 + abs(corr))
   eoi
}

[vittorio-g]

Alright! Thanks for the fixes, it looks great!