R/bootnetResultsMethods.R

In bootnet: Bootstrap Methods for Various Network Estimation Routines

# bootnetResult methods:
# print.bootnetResult <- function(x, ...){
#   print(x[['graph']])
# }

summary.bootnetResult <- function(object, ...){
  print(object, ...)
  # directed <- object$directed
  # 
  # if (directed){
  #   ind <- matrix(TRUE,ncol(object$graph),ncol(object$graph))
  # } else {
  #   ind <- upper.tri(object$graph,diag=FALSE)
  # }
  # 
  # 
  # cat("\nNumber of nodes:",nrow(object[['graph']]),
  #     "\nNumber of non-zero edges:",sum(object[['graph']][ind]!=0),"/",sum(ind),
  #     "\nDensity:",mean(object[['graph']][ind]) 
  #     # "\nNumber of estimated intercepts:",NROW(object[['intercepts']])
  #     )
}

plot.bootnetResult <- function(x, graph, 
                               weighted, signed, directed, labels,
                               layout = "spring",
                               parallelEdge = TRUE, cut = 0,
                               theme = "colorblind", 
                               bootIncludeOverwrite = TRUE, ...){

  if (missing(weighted)){
    weighted <- x$weighted
  }
  if (missing(signed)){
    signed <- x$signed
  }

  
  if (is.list(x$graph)){
    if (missing(graph)){
      stop("Object contains multiple networks; 'graph' may not be missing.")
    }
    wMat <- x[['graph']][[graph]]
    if (missing(directed)){
      directed <- x$directed[[graph]]
    }
  } else {
    wMat <- x[['graph']]    
    if (missing(directed)){
      directed <- x$directed
    }
  }

  if (!isTRUE(weighted)){
    wMat <- sign(wMat)
  }
  if (!isTRUE(signed)){
    wMat <- abs(wMat)
  }
  
  if (missing(labels)){
    labels <- x[['labels']]
  }
  
  if (bootIncludeOverwrite && isTRUE(x$bootInclude)){
    qgraph::qgraph(wMat,labels=labels,directed=directed,
                   parallelEdge = parallelEdge,
                   theme = theme,
                   cut = cut, layout = layout,
                   edge.color = "black", maximum = 1,
                   diag = TRUE,...)
  } else if (!is.null(x$edgeColors) && isTRUE(signed) && !("edge.color" %in% names(list(...)))) {
    # Two-pass plot: first get qgraph's default theme-aware colors, then override unsigned edges to gray
    q <- qgraph::qgraph(wMat, labels = labels, directed = directed,
                        parallelEdge = parallelEdge,
                        theme = theme,
                        cut = cut, layout = layout, DoNotPlot = TRUE, ...)
    edgeCols <- q$graphAttributes$Edges$color
    fromNodes <- q$Edgelist$from
    toNodes <- q$Edgelist$to
    for (e in seq_along(fromNodes)) {
      i <- fromNodes[e]
      j <- toNodes[e]
      ec_ij <- x$edgeColors[i, j]
      ec_ji <- x$edgeColors[j, i]
      if ((!is.na(ec_ij) && ec_ij == "gray") || (!is.na(ec_ji) && ec_ji == "gray")) {
        edgeCols[e] <- "gray"
      }
    }
    q$graphAttributes$Edges$color <- edgeCols
    plot(q)
  } else {

    qgraph::qgraph(wMat,labels=labels,directed=directed,
                   parallelEdge = parallelEdge,
                   theme = theme,
                   cut = cut, layout = layout,  ...)
  }

}