speeded up R quantile function

quantile_speed.R

#speeded up R quantile function
#code is based on the original quantile function {stats}: https://svn.r-project.org/R/trunk/src/library/stats/R/quantile.R

#This modifed function only supports the 'type 7' quantile algorithm
#The following features were removed (to increase perfomance) : 
# - output quantile names
# - error handling such as check if x are factors, or if probs lie outside the [0-1] range

#this makes the speeded up function much more prone to errors, but at the same time faster:
#  x <- runif(10000)
#  
#  microbenchmark(
#    quantile_speed(x, probs = c(0.1,0.9)),
#    quantile(x, probs = c(0.1,0.9)))
#Unit: microseconds
#                                   expr     min       lq     mean  median       uq      max neval cld
# quantile_speed(x, probs = c(0.1, 0.9)) 208.867 215.2470 237.8325 219.190 236.8685  449.400   100  a 
#       quantile(x, probs = c(0.1, 0.9)) 354.409 361.9085 460.5398 381.675 417.6300 3615.009   100   b  

# any further improvements that speed up the code are more than welcome

quantile_speed <- function(x, probs = c(0.1, 0.9), na.rm = F) {
    
  if (na.rm) x <- x[!is.na(x)]
    
  n <- length(x)
  index <- 1 + (n - 1) * probs
    
  lo    <- floor(index)
  hi    <- ceiling(index)
        
  x  <- sort(x, partial = unique(c(lo, hi)))
  qs <- x[lo]
    
  i     <- 1:length(probs) 
  h     <- index - lo
  qs    <- (1 - h) * qs + h * x[hi]
  qs
  
}