NBR-LME

This vignette documents the implementation of NBR 0.1.2 for linear mixed effect (LME) models applied to a sample level of matrices edges.

library(NBR)
data("voles")
brain_labs <- NBR:::voles_roi
dim(voles)
#> [1]  96 123
head(voles)[1:8]
#>    id Sex Session     ACC.AON     ACC.BLA     AON.BLA    ACC.BNST     AON.BNST
#> 1 F01   F     1st -0.28686306 -0.40153834 -0.14665024 -0.08307386  0.045431614
#> 2 F01   F     2nd -0.31489561  0.01090166 -0.05047274 -0.07112861  0.005440684
#> 3 F01   F     3rd -0.01423683 -0.07658247 -0.01224975 -0.21711713 -0.048013603
#> 4 F02   F     1st -0.17290194 -0.18256430  0.09607568  0.03990079 -0.116842983
#> 5 F02   F     2nd -0.29984543 -0.17029284 -0.19706318 -0.12662968 -0.039984274
#> 6 F02   F     3rd          NA          NA          NA          NA           NA

In this example, there is the information for 48 observations and the first three columns are related to phenotypic information of the subjects, meanwhile the next 120 columns are bivariate physiological data related to a network of 16 brain regions (fMRI functional connectivity). NOTE: for more detail of the dataset execute help(voles).

nnodes <- 16
tri_pos <- which(upper.tri(matrix(nrow = nnodes, ncol = nnodes)), arr.ind = T)
head(tri_pos)
#>      row col
#> [1,]   1   2
#> [2,]   1   3
#> [3,]   2   3
#> [4,]   1   4
#> [5,]   2   4
#> [6,]   3   4

IT’S VERY IMPORTANT that the order of the columns containing the network data must match with the order of the upper triangle of the network size.

Let’s plot the average network.

library(lattice)
avg_mx <- matrix(0, nrow = nnodes, ncol = nnodes)
avg_mx[upper.tri(avg_mx)] <- apply(voles[-(1:3)], 2, function(x) mean(x, na.rm=TRUE))
avg_mx <- avg_mx + t(avg_mx)
# Set max-absolute value in order to set a color range centered in zero.
flim <- max(abs(avg_mx))
levelplot(avg_mx, main = "Average", ylab = "ROI", xlab = "ROI",
          at = seq(-flim, flim, length.out = 100))

The next step is to check the sample inference data to be tested edgewise. In this case we are going to test if the variables Sex, Session, and their interaction (Sex:Session) have an effect related to the edgewise functional connectivity between regions. Since every subject was assessed in three different sessions, we should add the intercept and the Session term as random effects adding the random formula ~ 1+Session|id, where id accounts for the subject label.

We recommend set the argument control to optim (?stats::optim), which is not the default, but it gives less problems of convergence in the permutations.

set.seed(18900217)
before <- Sys.time()
library(nlme)
nbr_result <- nbr_lme_aov(net = volesNA[,-(1:3)],
  nnodes = 16, idata = volesNA[,1:3], nperm = 5,
  mod = "~ Session*Sex", rdm = "~ 1+Session|id",
  na.action = na.exclude,
  control = lmeControl(maxIter = 1000,
                       msMaxIter = 1000,
                       opt = "optim")
  )
after <- Sys.time()
show(after-before)

Although five permutations is faraway for a proper null distribution, we can see that it takes several seconds to performed it. So we suggest to parallel to multiple CPU cores with cores argument.

set.seed(18900217)
before <- Sys.time()
library(nlme)
library(parallel)
nbr_result <- nbr_lme_aov(net = voles[,-(1:3)],
  nnodes = 16, idata = voles[,1:3],
  nperm = 1000, nudist = T,
  mod = "~ Session*Sex", rdm = "~ 1+Session|id",
  cores = detectCores(), expList = "lmeControl",
  na.action = na.exclude,
  control = lmeControl(maxIter = 1000,
                       msMaxIter = 1000,
                       opt = "optim")
  )
after <- Sys.time()
show(after-before)

This will elapse approximately 15 minutes in a Intel(R) Core(TM) i7-8700 CPU @ 3.20GHz with 12 cores. So, better load it instead to repeated again.

nbr_result <- NBR:::voles_nbr
show(nbr_result$fwe)
#> $Session
#>   Component ncomp ncompFWE     strn strnFWE
#> 1         1     9    0.135 28.22975   0.004
#> 
#> $Sex
#>   Component ncomp ncompFWE      strn strnFWE
#> 1         1     2    0.711 4.0351647   0.801
#> 2         2     1    0.980 0.7516185   0.999
#> 3         3     3    0.316 5.2619146   0.587
#> 
#> $`Session:Sex`
#>    Component ncomp ncompFWE       strn strnFWE
#> 1          1     1    0.954 2.78159791   0.846
#> 2          2     1    0.954 0.07695101   0.995
#> 3          3     2    0.821 2.13757157   0.905
#> 4          4     1    0.954 0.77359511   0.985
#> 6          6     1    0.954 0.20354124   0.994
#> 15        15     1    0.954 1.77582539   0.943

If we observed the Family-Wise Error (FWE) probabilities of the observed components, only the component 1 in the Session term is lower than the nominal alpha of p < 0.05. There are the probabilities of the number of connected components and the strength sum of components, which one to choose will depend on the a priori hypothesis, but we usually consider the strength sum because it considers not only the component edges but also their weights.

Let’s display the FWE-corrected component

# Plot significant edges
edge_mat <- array(0, dim(avg_mx))
edge_mat[nbr_result$components$Session[,2:3]] <- 1
levelplot(edge_mat, col.regions = rev(heat.colors(100)),
          main = "Component", ylab = "ROI", xlab = "ROI")

Lastly, if we are not sure if 1000 permutations is enough we can plot the cumulative p-value with its corresponding binomial marginal error. To do so it was needed to set TRUE the return null distribution argument (nudist).

nperm <- 1000
null_ses_str <- nbr_result$nudist[,2]  # Null distribution for Session strength
obs_ses_str <- nbr_result$fwe$Session[,4] # Observed Session strength
cumpval <- cumsum(null_ses_str >= obs_ses_str)/(1:nperm)
# Plot p-value stability
plot(cumpval, type="l", ylim = c(0,0.06), las = 1,
           xlab = "Permutation index", ylab = "p-value",
           main = "Cumulative p-value for Session strength")
      abline(h=0.05, col="red", lty=2)
# Add binomial marginal error
mepval <- 2*sqrt(cumpval*(1-cumpval)/1:nperm)
lines(cumpval+mepval, col = "chartreuse4")
lines(cumpval-mepval, col = "chartreuse4")