R/bootTable.R In bootnet: Bootstrap Methods for Various Network Estimation Routines

Defines functions statTable

```# Compute tidy table from bootnetResult object:
# Result in data frame with entries:
# original (logical)
# name
# type
# node1
# node2
# value

statTable <- function(x, name, alpha = 1, computeCentrality = TRUE,statistics = c("edge","strength","closeness","betweenness"), directed = FALSE){
# Statistics can be:
if (!all(statistics %in% c("intercept","edge","length","distance","closeness","betweenness","strength"))){
stop("'statistics' must be 'edge', 'intercept', 'length', 'distance', 'closeness', 'betweenness' or 'strength'")
}

type <- NULL
value <- NULL

stopifnot(is(x, "bootnetResult"))
tables <- list()
if (is.null(x[['labels']])){
x[['labels']] <- seq_len(ncol(x[['graph']]))
}

# edges:
if (!directed){
index <- upper.tri(x[['graph']], diag=FALSE)
ind <- which(index, arr.ind=TRUE)
} else {
index <- diag(ncol(x[['graph']]))!=1
ind <- which(index, arr.ind=TRUE)
}

# Weights matrix:
Wmat <- qgraph::getWmat(x)

if ("edge" %in% statistics){
tables\$edges <- dplyr::tbl_df(data.frame(
name = name,
type = "edge",
node1 = x[['labels']][ind[,1]],
node2 = x[['labels']][ind[,2]],
value = Wmat[index],
stringsAsFactors = FALSE
))
}

if ("length" %in% statistics){
tables\$length <- dplyr::tbl_df(data.frame(
name = name,
type = "length",
node1 = x[['labels']][ind[,1]],
node2 = x[['labels']][ind[,2]],
value = abs(1/abs(Wmat[index])),
stringsAsFactors = FALSE
))
}

# Intercepts:
if (!is.null(x[['intercepts']])){
tables\$intercepts <- dplyr::tbl_df(data.frame(
name = name,
type = "intercept",
node1 = x[['labels']],
node2 = '',
value = x[['intercepts']],
stringsAsFactors = FALSE
))
}

if (computeCentrality){
# Centrality analysis:
if (all(x[['graph']]==0)){
cent <- list(
OutDegree = rep(0,ncol(x[['graph']])),
InDegree = rep(0,ncol(x[['graph']])),
Closeness = rep(0,ncol(x[['graph']])),
Betweenness = rep(0,ncol(x[['graph']])),
ShortestPathLengths = matrix(Inf,ncol(x[['graph']]),ncol(x[['graph']]))
)
} else {
cent <- qgraph::centrality(Wmat, alpha = alpha, all.shortest.paths = FALSE)

}

# strength:
if ("strength" %in% statistics){

tables\$strength <- dplyr::tbl_df(data.frame(
name = name,
type = "strength",
node1 = x[['labels']],
node2 = '',
value = cent[['OutDegree']],
stringsAsFactors = FALSE
))
}

# closeness:
if ("closeness" %in% statistics){
tables\$closeness <- dplyr::tbl_df(data.frame(
name = name,
type = "closeness",
node1 = x[['labels']],
node2 = '',
value = cent[['Closeness']],
stringsAsFactors = FALSE
))
}

# betweenness:
if ("betweenness" %in% statistics){
tables\$betweenness <- dplyr::tbl_df(data.frame(
name = name,
type = "betweenness",
node1 = x[['labels']],
node2 = '',
value = cent[['Betweenness']],
stringsAsFactors = FALSE
))
}

if ("distance" %in% statistics){
tables\$sp <- dplyr::tbl_df(data.frame(
name = name,
type = "distance",
node1 = x[['labels']][ind[,1]],
node2 = x[['labels']][ind[,2]],
value = cent[['ShortestPathLengths']][index],
stringsAsFactors = FALSE
))
}

}
#   for (i in seq_along(tables)){
#     tables[[i]]\$id <- ifelse(tables[[i]]\$node2=='',paste0("N: ",tables[[i]]\$node1),paste0("E: ",tables[[i]]\$node1, "--", tables[[i]]\$node2))
#   }

for (i in seq_along(tables)){
tables[[i]]\$id <- ifelse(tables[[i]]\$node2=='',tables[[i]]\$node1,paste0(tables[[i]]\$node1, ifelse(directed,"->","--"), tables[[i]]\$node2))
}

tab <- dplyr::bind_rows(tables)
tab\$nNode <- x\$nNodes
tab\$nPerson <- x\$nPerson

# Compute rank:
tab <- tab %>% group_by(type) %>%
mutate(rank_avg = rank(value,ties.method = "average"),
rank_min = rank(value,ties.method = "min"),
rank_max = rank(value,ties.method = "max"))

return(tab)
}
```

Try the bootnet package in your browser

Any scripts or data that you put into this service are public.

bootnet documentation built on Sept. 6, 2017, 5:03 p.m.