Possible to use qgraph or weights matrix as input in bootnet? about bootnet

[SachaEpskamp]

Hi! Indeed you can use the fun argument for specifying a custom estimation function! Please make sure that the input to EBICglasso is the sample variance-covariance matrix and not a matrix with artificially changed values - such a matrix would no longer lead to the correct Gaussian likelihood of the data making the EBICglasso function not work at all.

[mvanaman]

It turns out that the example above actually does not work: that is, setting a correlation to zero does not guarantee that its edges will be absent in the estimated weights matrix.

However, with respect to the original question, I finally found an answer to this question in the documentation. It turns out that as long as your function returns a results object i.e. a weights matrix, then you can just use this function with the estimateNetwork() function with the additional argument fun = my_function.

Again: in my case, the actual rationale for modifying this correlation matrix does not make sense. However, for those who might have have a case where the process of estimating a weights matrix is too idiosyncratic to automate with bootnet, perhaps you will find it helpful to know that you can stipulate how you want your weight matrix to be calculated by intervening with that fun argument.

Here is how I accomplished this for my specific situation:

library(psych)
library(qgraph)
library(dplyr)
#> Warning: package 'dplyr' was built under R version 4.1.2
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(bootnet)
#> Loading required package: ggplot2
#> 
#> Attaching package: 'ggplot2'
#> The following objects are masked from 'package:psych':
#> 
#>     %+%, alpha
#> This is bootnet 1.5
#> For questions and issues, please see github.com/SachaEpskamp/bootnet.

# get data
network_data <- bfi %>% select(contains("1") | contains("2"))

# get correlation matrix (for input into unconstrained model)
cors <- cor_auto(network_data, detectOrdinal = TRUE)
#> Variables detected as ordinal: A1; C1; E1; N1; O1; A2; C2; E2; N2; O2

# set correlations to zero (for input into constrained model)
cors_constrained <- cors
cors_constrained[6, 1] <- 0
cors_constrained[7, 2] <- 0
cors_constrained[1, 6] <- 0
cors_constrained[2, 7] <- 0

constrained_weights <- EBICglasso(S = cors_constrained, n = nrow(network_data))
#> Warning in EBICglassoCore(S = S, n = n, gamma = gamma, penalize.diagonal =
#> penalize.diagonal, : A dense regularized network was selected (lambda < 0.1 *
#> lambda.max). Recent work indicates a possible drop in specificity. Interpret the
#> presence of the smallest edges with care. Setting threshold = TRUE will enforce
#> higher specificity, at the cost of sensitivity.

# plot network with qgraph
qgraph(constrained_weights, edge.labels = TRUE, curveAll = TRUE, title = "constrained", layout = "spring")

# achieve same network with bootnet
my_fun <- function(data){
  set.seed(352)
  cor_example <- cor_auto(data)
  n <- nrow(data)
  cors_constrained <- cor_example
  cors_constrained[6, 1] <- 0
  cors_constrained[7, 2] <- 0
  cors_constrained[1, 6] <- 0
  cors_constrained[2, 7] <- 0
  
  # estimate weights matrix
  graph <- EBICglasso(S = cors_constrained, n = n)

  return(graph = graph)
}
estimateNetwork(network_data, fun = my_fun) %>% plot(edge.labels = TRUE, layout = "spring")
#> Variables detected as ordinal: A1; C1; E1; N1; O1; A2; C2; E2; N2; O2
#> Warning in EBICglassoCore(S = S, n = n, gamma = gamma, penalize.diagonal =
#> penalize.diagonal, : A dense regularized network was selected (lambda < 0.1 *
#> lambda.max). Recent work indicates a possible drop in specificity. Interpret the
#> presence of the smallest edges with care. Setting threshold = TRUE will enforce
#> higher specificity, at the cost of sensitivity.

^{Created on 2022-08-24 by the reprex package (v2.0.1)}

[mvanaman]

Thank you for replying, and for the heads up about the likelihood!!