R/apply_bcskew0.r

In markanewman/mnmacros: Analysis Macros

#' @title apply_bcskew0
#'
#' @description A first principals implementation of Box-Cox transform
#'
#' @importFrom magrittr "%>%"
#' @importFrom moments agostino.test 
#' @export
#'
#' @param x the Numeric vector to transform
#' @return the transformed vector
#'
#' @author Mark Newman, \email{mark@trinetteandmark.com}
#' @keywords macros
#' @family normalization
#'
#' @examples
#'   \dontshow{
#'     library(moments)
#'     library(mnmacros)}
#'   x <- testdata.apply_bcskew0
#'   x %>% agostino.test()
#'   x2 <-
#'     x %>%
#'     apply_bcskew0
#'   x2 %>% agostino.test()
#'   x2 %>% attributes()
#'
apply_bcskew0 <- function(x) {
  
  stopifnot(!(missing(x) || is.null(x)))
  stopifnot(is.vector(x) && is.numeric(x))
  lx <- length(x)
  stopifnot(8 <= lx && lx <= 46340)
  stopifnot(x %>% unique() %>% length() > 1)
  
  lb <- -5
  ub <- 5
  step <- 1
  bestlamda <- NA
  bestskew <- Inf
  bestx <- x
  
  if((mx <- min(x)) <= 0) { x <- x - mx + 1 }
  
  for(i in 0:5) {
    
    for(lamda in seq(lb, ub, step) %>% round(i)) {
      
      x2 <- if(lamda == 0) { log(x) } else { x^lamda }
      cs <- (x2 %>% agostino.test())$statistic[1] %>% abs()

      if(cs < bestskew) {
        bestskew <- cs
        bestlamda <- lamda
        bestx <- x2
      }
    }
    
    lb <- bestlamda - step
    ub <- bestlamda + step
    step <- step/10
  }
  
  attr(bestx, 'lamda') <- bestlamda
  
  bestx
}