R/InternalsTIC.R

In TICM: Testing the Validity of the Independent Component Model Assumption

# boot function
# takes a matrix with n rows and p columns 
# Bootstraps each column independently
# returns permuted matrix
bootS <- function(Z)
{
  n <- nrow(Z)
  apply(Z, 2, SampFunction, n = n)
}

# JADE boot function
# takes a matrix with n rows and p columns 
# Bootstraps each column independently
# applies then JADE and returns estimated ICs
# maxiter: maxiter for JADE
# eps: eps for JADE
bootZjade <- function(Z, eps = 1e-06, maxiter = 100)
{
  n <- nrow(Z)
  JADE(apply(Z, 2, SampFunction, n = n), eps = eps, maxiter = maxiter)$S
}

# FOBI boot function
# takes a matrix with n rows and p columns 
# Bootstraps each column independently
# applies then FOBI and returns estimated ICs
bootZfobi <- function(Z)
{
  n <- nrow(Z)
  FOBI(apply(Z, 2, SampFunction, n = n))$S
}

# FastICA boot function
# takes a matrix with n rows and p columns 
# Bootstraps each column independently
# applies then FastICA and returns estimated ICs
# additional arguments passed on to fICA
bootZfICA <- function(Z, g = "tanh", method = "sym", inR = FALSE, maxiter = 500, eps=1e-06, n.init=2)
{
  fICA(apply(Z, 2, SampFunction, n = nrow(Z)), g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)$S
}

# Bootstrap prep functions
# Functions takes as input a vector and its length n
# Returns a bootstrap sample of the vector with same length 
SampFunction <- function (x, n)  x[sample(1:n, replace = TRUE)]

# Permutation prep functions

PermFunction <- function (x, n)  x[sample(1:n)]
# Functions takes as input a vector and its length n
# Returns a permuted version of the vector with same length 

# boot function
# takes a matrix with n rows and p columns 
# permutes elements of each column independently
# returns permuted matrix
permS <- function(Z)
{
  n <- nrow(Z)
  apply(Z, 2, PermFunction, n = n)
}



# JADE permutation function
# takes a matrix with n rows and p columns 
# permutes elements of each column independently
# applies then JADE and returns estimated ICs
# maxiter: maxiter for JADE
# eps: eps for JADE
permZjade <- function(Z, eps = 1e-06, maxiter = 100)
{
  n <- nrow(Z)
  JADE(apply(Z, 2, PermFunction, n = n), eps = eps, maxiter = maxiter)$S
}

# FOBI permutation function
# takes a matrix with n rows and p columns 
# permutes elements of each column independently
# applies then FOBI and returns estimated ICs
permZfobi <- function(Z)
{
  n <- nrow(Z)
  FOBI(apply(Z, 2, PermFunction, n = n))$S
}

# FastICA permutation function
# takes a matrix with n rows and p columns 
# permutes elements of each column independently
# applies then FastICA and returns estimated ICs
# additional arguments passed on to fICA
permZfICA <- function(Z, g = "tanh", method = "sym", inR = FALSE, maxiter = 500, eps=1e-06, n.init=2)
{
  fICA(apply(Z, 2, PermFunction, n = nrow(Z)), g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)$S
}

# marginal ranks and scaled
# takes a matrix with n rows and p columns
# computes the ranks for each column
# then scales to ranks to fall within [0,1]
RANKS <- function(X) apply(X,2,rank)/(nrow(X)+1)

# marginal VdW scores
# takes a matrix with n rows and p columns
# computes the van der Warden scores for each column
VdW <- function(X) qnorm(RANKS(X))

# Helper function to set up and manage parallel environment
setup_parallel <- function(ncores, iseed) {
  if (!is.null(ncores) && ncores > 1) {
    if (!is.null(iseed)) {
      set.seed(iseed)  # Set seed for reproducibility
    }
    cl <- makeCluster(ncores, type = "PSOCK")
    clusterSetRNGStream(cl, iseed)
    return(cl)
  }
  return(NULL)
}

# Function to perform bootstrapping in parallel
parallel_boot <- function(cl, n.boot, func) {
  if (!is.null(cl)) {
    Tboot <- parSapply(cl, seq_len(n.boot), func)
    stopCluster(cl)
  } else {
    Tboot <- replicate(n.boot, func())
  }
  return(Tboot)
}