R/normYJpn.R

In fsdaR: Robust Data Analysis Through Monitoring and Dynamic Visualization

######
##  VT::18.05.2026
##
##
##  roxygen2::roxygenise("C:/users/valen/onedrive/myrepo/R/fsdaR", load_code=roxygen2:::load_installed)
##
#'  Computes (normalized) extended Yeo-Johnson transformation
#'
#' @description Computes (normalized) extended Yeo-Johnson transformation
#' 
#' @details 
#'  The transformations for negative and positive responses were determined
#'  by Yeo and Johnson (2000) by imposing the smoothness condition that the
#'  second derivative of \eqn{zYJ(\lambda)} with respect to \eqn{y} be smooth at \eqn{y = 0}. 
#'  However some authors, for example Weisberg (2005), query the physical
#'  interpretability of this constraint which is oftern violated in data
#'  analysis. Accordingly, Atkinson et al (2019) and (2020) extend the
#'  Yeo-Johnson transformation to allow two values of the transformations
#'  parameter: \eqn{\lambda N} for negative observations and \eqn{\lambda P} 
#'  for non-negative ones.
#'
#'  The Yeo-Johnson transformation is the Box-Cox transformation
#'  of \eqn{y+1} for nonnegative values, and of \eqn{|y|+1} with parameter
#'  \eqn{2-\lambda} for \eqn{y} negative
#'
#' @param X The data matrix: \code{n} observations and \code{p} variables. 
#'  The rows of X represent observations, and the columns represent variables.
#'  Missing values (NA's) and infinite values (Inf's) are allowed, since observations (rows) 
#'  with missing or infinite values will automatically be excluded from the computations.
#'
#' @param Col2Tra Which variables to transform. An integer vector of length \code{k} 
#'  specifying the variables which must be transformed. If it is missing and 
#'  \code{length(la)=p} all variables are transformed
#'
#' @param la Transformation parameters. A \code{k x 2} matrix containing set 
#'  of transformation parameters for the \code{k} \code{Col2Tra} variables.
#'  The first column contains the transformation parameter for positive observations and
#'  the second column the transformation parameter for negative observations.
#'
#' @param inverse Wheather to return the inverse transformation. The default is \code{inverse=FALSE}.
#'
#' @param Jacobian Requested Jacobian of transformed values. If \code{Jacobian=TRUE} 
#'  the default, the transformation is normalized to have Jacobian equal to 1. 
#'  Note that this optional argument is ignored if \code{inverse=TRUE}.
#'
#' @param trace Whether to print intermediate results. Default is \code{trace=FALSE}.
#'
#' @param ... potential further arguments passed to lower level functions.
#'
#' @return The transformed data matrix. 
#'
#' @references
#'  Atkinson, A.C. Riani, M., Corbellini A. (2019), The analysis of
#'  transformations for profit-and-loss data, Journal of the Royal
#'  Statistical Society, Series C, "Applied Statistics",
#'  https://doi.org/10.1111/rssc.12389
#'  
#'  Atkinson, A.C. Riani, M. and Corbellini A. (2021), The Box–Cox
#'  Transformation: Review and Extensions, "Statistical Science", Vol. 36,
#'  pp. 239-255, https://doi.org/10.1214/20-STS778
#'
#'   Yeo, I.K and Johnson, R. (2000), A new family of power transformations to
#'   improve normality or symmetry, "Biometrika", Vol. 87, pp. 954-959.
#'
#' @examples
#'
#'  \dontrun{
#'  
#'  ##  Example of use of normYJ() with all default options.
#'  ##  Transform value -3, -2, ..., 3
#'  y <- (-3):3
#'  lambda <- c(-0.5, 0.5)
#'  y1 <- normYJpn(y, Col2Tra=1, la=lambda)
#'  plot(y, y1, xlab='Original values', ylab='Transformed values') 
#'  
#'  ## Compare Yeo and Johnson with extended Yeo and Yohnson.
#'  ## Transform value -3, -2, ..., 3
#'  k <- 3
#'  y <- seq(from=-k, to=k, by=0.01)
#'  
#'  ## Two values of lambda for extended Yeo and Johnson
#'  lambda <- c(0, 0.5)
#'  Jacobian <- FALSE
#'  ## Just one value of lambda for traditional Yao and Johnson
#'  y1 <- normYJ(y,Col2Tra=1, la=lambda[1], Jacobian=Jacobian)
#'  ypn <- normYJpn(y, Col2Tra=1, la=lambda,Jacobian=Jacobian)
#'  
#'  plot(y, y1, type="l", xlab="Original values", ylab="Transformed values", col="blue")
#'  lines(y, ypn, col="red")
#'  
#'  }
#'
#' @export
#' @author FSDA team, \email{valentin.todorov@@chello.at}

normYJpn <- function(X, Col2Tra, la, Jacobian=TRUE, inverse=FALSE, trace=FALSE, ...) {
    if(missing(X))
        stop("Input data matrix is missing")

    if(is.data.frame(X))
      X <- data.matrix(X)
    else if(!is.matrix(X))
      X <- matrix(X, length(X), 1,
                  dimnames = list(names(X), deparse(substitute(X))))
    if(!is.numeric(X)) stop("X is not a numeric matrix")

    storage.mode(X) <- "double"

    dx <- dim(X)
    xn <- (dnx <- dimnames(X))[[2]]
    xn <- if(!is.null(xn))
        xn
    else if (dx[2] > 1)
        paste("X", 1:dx[2], sep = "")
    else if(dx[2])
        "X"
    dimnames(X) <- list(dnx[[1]], xn)

    n <- nrow(X)
    p <- ncol(X)

    if(missing(la))
        stop("Vector 'la' specifying how to transforme the variables is missing!")

    if(missing(Col2Tra)) {
        if(length(la) == p)
            Col2Tra <- 1:p
        else
            stop("Vector 'Col2Tra' specifying which variables to transform is missing!")
    }
    
    control <- list()
    control$Jacobian <- ifelse(Jacobian, 1, 0)
    control$inverse <- ifelse(inverse, 1, 0)

    parlist = c(.jarray(X, dispatch=TRUE), .jarray(Col2Tra, dispatch=TRUE), .jarray(la, dispatch=TRUE))
    paramNames <- names(control)
    if(trace)
        print(control)

    if(length(paramNames) > 0) {
        for(i in 1:length(paramNames)) {
            paramName = paramNames[i]
            paramValue = control[[i]]

            matlabValue = rType2MatlabType(paramName, paramValue)
            parlist = c(parlist, .jnew("java/lang/String", paramName), matlabValue)
        }
    }

    out <- callFsdaFunction("normYJpn", "[Ljava/lang/Object;", 1, parlist)
    if(is.null(out))
        return(NULL)

##    arr1 = .jcast(out[[1]], "com/mathworks/toolbox/javabuilder/MWStructArray")
##    arr = .jnew("org/jrc/ipsc/globesec/sitaf/fsda/FsdaMWStructArray", arr1)

##    if(trace) {
##        cat("\nReturning from MATLAB normYJ().  Fields returned by MATLAB: \n")
##        print(arr$fieldNames())
##    }

##    Xtra <- if(as.integer(arr$hasField("Ytra", as.integer(1))) != 1) NULL
##            else as.matrix(.jevalArray(arr$get("Ytra", as.integer(1)), "[[D", simplify = TRUE))

    arr <- out[[1]]$toDoubleArray()
    Xtra <- .jevalArray(arr, simplify=TRUE)

    freeMatlabResources(out)

    return (Xtra)
}