R/TestsTICperm.R

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

# Functions for permutation based approaches
# Should also not be for the direct user

ICAtestGauss_jade_perm <- function(X, n.perm = 200, eps = 1e-06, maxiter = 100)
{
  ICA <- JADE(X, eps = eps, maxiter = maxiter)
  T.W <- TmW_Gauss(ICA$S)
  Tperm <- replicate(n.perm, TmW_Gauss(permZjade(ICA$S, eps = eps, maxiter = maxiter)))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestGauss_fobi_perm <- function(X, n.perm = 200)
{
  ICA <- FOBI(X)
  T.W <- TmW_Gauss(ICA$S)
  Tperm <- replicate(n.perm, TmW_Gauss(permZfobi(ICA$S)))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}


# g="tanh", method="sym", inR=FALSE, maxiter=500, n.init=2

ICAtestGauss_fICA_perm <- function(X, n.perm = 200, g = "tanh", method = "sym", inR = FALSE, maxiter = 500, eps=1e-06, n.init=2)
{
  ICA <- fICA(X, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)
  T.W <- TmW_Gauss(ICA$S)
  Tperm <- replicate(n.perm, TmW_Gauss(permZfICA(ICA$S, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestGauss_S_perm <- function(X, n.perm = 200)
{
  S <- scale(X)
  T.W <- TmW_Gauss(S)
  Tperm <- replicate(n.perm, TmW_Gauss(scale(permS(S))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL)
  RES
}

# P2 Test perm

ICAtestLap_jade_perm <- function(X, n.perm = 200, eps = 1e-06, maxiter = 100)
{
  ICA <- JADE(X, eps = eps, maxiter = maxiter)
  T.W <- TmW_Lap(ICA$S)
  Tperm <- replicate(n.perm, TmW_Lap(permZjade(ICA$S, eps = eps, maxiter = maxiter)))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestLap_fobi_perm <- function(X, n.perm = 200)
{
  ICA <- FOBI(X)
  T.W <- TmW_Lap(ICA$S)
  Tperm <- replicate(n.perm, TmW_Lap(permZfobi(ICA$S)))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestLap_fICA_perm <- function(X, n.perm = 200, g = "tanh", method = "sym", inR = FALSE, maxiter = 500, eps=1e-06, n.init=2)
{
  ICA <- fICA(X, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)
  T.W <- TmW_Lap(ICA$S)
  Tperm <- replicate(n.perm, TmW_Lap(permZfICA(ICA$S, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestLap_S_perm <- function(X, n.perm = 200)
{
  S <- scale(X)
  T.W <- TmW_Lap(S)
  Tperm <- replicate(n.perm, TmW_Lap(scale(permS(S))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL)
  RES
}


# C4 Rank Gauss perm

ICAtestRankGauss_jade_perm <- function(X, n.perm = 200, eps = 1e-06, maxiter = 100)
{
  ICA <- JADE(X, eps = eps, maxiter = maxiter)
  n <- nrow(X)
  R <- RANKS(ICA$S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(RANKS(permZjade(ICA$S, eps = eps, maxiter = maxiter))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestRankGauss_fobi_perm <- function(X, n.perm = 200)
{
  ICA <- FOBI(X)
  R <- RANKS(ICA$S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(RANKS(permZfobi(ICA$S))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestRankGauss_fICA_perm <- function(X, n.perm = 200, g = "tanh", method = "sym", inR = FALSE, maxiter = 500, eps=1e-06, n.init=2)
{
  ICA <- fICA(X, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)
  R <- RANKS(ICA$S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(RANKS(permZfICA(ICA$S, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}


ICAtestRankGauss_S_perm <- function(X, n.perm = 200)
{
  S <- scale(X)
  R <- RANKS(S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(RANKS(scale(permS(S)))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL)
  RES
}





# P4 Rank Lap perm

ICAtestRankLap_jade_perm <- function(X, n.perm = 200, eps = 1e-06, maxiter = 100)
{
  ICA <- JADE(X, eps = eps, maxiter = maxiter)
  n <- nrow(X)
  R <- RANKS(ICA$S)
  T.W <- TmW_Lap(R)
  Tperm <- replicate(n.perm, TmW_Lap(RANKS(permZjade(ICA$S, eps = eps, maxiter = maxiter))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestRankLap_fobi_perm <- function(X, n.perm = 200)
{
  ICA <- FOBI(X)
  R <- RANKS(ICA$S)
  T.W <- TmW_Lap(R)
  Tperm <- replicate(n.perm, TmW_Lap(RANKS(permZfobi(ICA$S))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestRankLap_fICA_perm <- function(X, n.perm = 200, g = "tanh", method = "sym", inR = FALSE, maxiter = 500, eps=1e-06, n.init=2)
{
  ICA <- fICA(X, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)
  R <- RANKS(ICA$S)
  T.W <- TmW_Lap(R)
  Tperm <- replicate(n.perm, TmW_Lap(RANKS(permZfICA(ICA$S, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}


ICAtestRankLap_S_perm <- function(X, n.perm = 200)
{
  S <- scale(X)
  R <- RANKS(S)
  T.W <- TmW_Lap(R)
  Tperm <- replicate(n.perm, TmW_Lap(RANKS(scale(permS(S)))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL)
  RES
}



# C5 vdw Gauss perm

ICAtestRankvdW_jade_perm <- function(X, n.perm = 200, eps = 1e-06, maxiter = 100)
{
  ICA <- JADE(X, eps = eps, maxiter = maxiter)
  n <- nrow(X)
  R <- VdW(ICA$S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(VdW(permZjade(ICA$S, eps = eps, maxiter = maxiter))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestRankvdW_fobi_perm <- function(X, n.perm = 200)
{
  ICA <- FOBI(X)
  R <- VdW(ICA$S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(VdW(permZfobi(ICA$S))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}

ICAtestRankvdW_fICA_perm <- function(X, n.perm = 200, g = "tanh", method = "sym", inR = FALSE, maxiter = 500, eps=1e-06, n.init=2)
{
  ICA <- fICA(X, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps)
  R <- VdW(ICA$S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(VdW(permZfICA(ICA$S, g = g, method = method, inR = inR, maxiter = maxiter, n.init=n.init, eps=eps))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL, ICA=ICA)
  RES
}


ICAtestRankvdW_S_perm <- function(X, n.perm = 200)
{
  S <- scale(X)
  R <- VdW(S)
  T.W <- TmW_Gauss(R)
  Tperm <- replicate(n.perm, TmW_Gauss(VdW(scale(permS(S)))))
  PVAL <- (sum(T.W < Tperm) +  1)/(n.perm + 1)
  RES  <- list(T=T.W, Tperm = Tperm, pval=PVAL)
  RES
}