R/scoreyjpn.R

In fsdaR: Robust Data Analysis Through Monitoring and Dynamic Visualization

######
##  VT::11.05.2026
##
##
##  roxygen2::roxygenise("C:/users/valen/onedrive/myrepo/R/fsdaR", load_code=roxygen2:::load_installed)
##
#'  Computes the score test for YJ transformation for pos and neg observations
#'
#' @description The transformations for negative and positive responses were determined
#'  by Yeo and Johnson (2000) by imposing the smoothness condition that the
#'  second derivative of \code{zYJ(lambda)} with respect to \code{y} be smooth at \code{y = 0}. However,
#'  some authors, for example Weisberg (2005), query the physical
#'   interpretability of this constraint which is often violated in data
#'   analysis. Accordingly, Atkinson et al (2019) and (2020) extend the
#'   Yeo-Johnson transformation to allow two values of the transformations
#'   parameter: \code{lambda N} for negative observations and \code{lambda P} for non-negative ones.
#'   ScoreYJpn computes:
#'  \itemize{
#'  \item 1) the t test associated with the constructed variable computed assuming
#'   a different transformation for positive observations keeping the value of
#'   the transformation parameter for negative observations fixed. In short, we
#'   call this test 'test for positive observations'.
#'   \item 2) the t test associated with the constructed variable computed assuming
#'   a different transformation for negative observations keeping the value of
#'   the transformation parameter for positive observations fixed. In short, we
#'  call this test 'test for negative observations'. 
#'   \item 3) the F test for the joint presence of the two constructed variables
#'   described in points 1) and 2).
#'  }
#'
#' @param y Response variable. A vector with \code{n} elements that
#'  contains the response variable.
#'
#' @param x An \code{n x p} data matrix (\code{n} observations and \code{p} variables).
#'  Rows of \code{x} represent observations, and 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 intercept wheather to use constant term (default is \code{intercept=TRUE}
#'
#' @param la values of the transformation parameter for which it is necessary
#'  to compute the score test. Default value of lambda is
#'  \code{la=c(-1, -0.5, 0, 0.5, 1)}, i.e., the five most common values of lambda.
#'
#' @param nocheck Whether to check input arguments. If \code{nocheck=TRUE} no check is performed
#'  on matrix \code{y} and matrix \code{X}. Notice that \code{y} and \code{X}
#'  are left unchanged. In other words the additional column of ones for the
#'  intercept is not added. The default is \code{nocheck=FALSE}.
#'
#' @param trace Whether to print intermediate results. Default is \code{trace=FALSE}.
#' @param \dots potential further arguments passed to lower level functions.
#'
#' @return  An S3 object of class \code{\link{scoreYJpn.object}} will be returned which is basically a list
#'  containing the following elements:
#'  \itemize{
#'  \item \code{la}: vector containing the values of lambda for which the test is computed
#'  \item \code{Score}: Matrix of size \code{length(lambda)-by-3} that contains the value 
#'      of the score test for each value of lambda specified in optional input parameter \code{la}. 
#'      The first column refers to the test for positive observations, the second column 
#'      refers to the test for negative observations and the third column refers to
#'      the F test for the joint presence of the two constructed variables. If \code{la} 
#'      is not specified, the number of rows of the matrix \code{Score} is equal to 5 
#'      and will contain the values of the score test for the 5 most common values of \code{lambda}.
#'  }
#'
#' @references
#'  Yeo, I.K. and Johnson, R. (2000), A new family of power
#'   transformations to improve normality or symmetry, "Biometrika", Vol. 87,  pp. 954-959.
#'
#'   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
#'

#' @examples
#'
#'  \dontrun{
#'  ##  Example in which positive and negative observations require the same lambda
#'      set.seed(1234)
#'      n <- 100
#'      y <- rnorm(n)
    
#'      ## Transform the value to find out if we can recover the true value of
#'      ## the transformation parameter.
#'      la <- 0.5
#'      ytra <- normYJ(y, la=la, inverse=TRUE)
#'      
#'      ## Start the analysis
#'      X <- rep(1, n)
#'      outSC <- scoreYJ(X, ytra, intercept=FALSE)
#'      outSCpn <- scoreYJpn(X, ytra, intercept=FALSE)
#'      la <- c(-1, -0.5, 0, 0.5, 1)
#'      print(cbind(la,  outSCpn$Score[,1], outSC$Score, outSCpn$Score[,2]))
#'
#'      ##  Comment: if we consider the 5 most common values of lambda,
#'      ##  the value of the score test when lambda=0.5 is the only one which is not
#'      ##  significant. Both values of the score test for positive and negative
#'      ##  observations confirm that this value of the transformation parameter is
#'      ##   OK for both sides of the distribution.
#'
#'  }
#'
#' @export
#' @author FSDA team, \email{valentin.todorov@@chello.at}

scoreYJpn <- function(x, y, intercept=TRUE, la=c(-1, -0.5, 0, 0.5, 1), nocheck=FALSE, trace=FALSE, ...)
{
    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")

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

    storage.mode(x) <- "double"
    storage.mode(y) <- "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)

    control <- list()
    control$intercept <- ifelse(intercept, 1, 0)
    control$la <- la

    if(!is.numeric(nocheck) && !is.logical(nocheck) || length(nocheck) != 1)
        stop("'nocheck' must be logical or numeric of length 1!")
    control$nocheck <- ifelse(nocheck, 1, 0)

    outclass <- "scoreYJpn"

    parlist = c(.jarray(y, dispatch=TRUE), .jarray(x, 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("ScoreYJpn", "[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 ScoreYJpn().  Fields returned by MATLAB: \n")
        print(arr$fieldNames())
    }

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

    la_names <- c(paste0("la=", format(la, digits=2, nsmall=2)))
    if(!is.null(Score)) {
        rownames(Score) <- la_names
        colnames(Score) <- c("positive", "negative", "F-test")
    }

    ans <- list(call=match.call(), la=la, Score=Score)

    freeMatlabResources(out)

    class(ans) <- outclass
    return (ans)
}