Skip to content
Permalink
Browse files

made major fixes for release —> ghypernet

  • Loading branch information...
gi0na committed Jan 30, 2019
1 parent 887f0fa commit 6a599003cdef2359eebc1a37c9fed74362f9b12e
@@ -1,2 +1,4 @@
^.*\.Rproj$
^\.Rproj\.user$
^.*\.Rhistory$
^.*\.gitignore$
@@ -1,6 +1,8 @@
inst/doc
.Rproj.user
.Rhistory
.RData
.Ruserdata
/ghypner.Rproj
/.DS_Store
/vignettes/.gitignore
@@ -1,7 +1,7 @@
Package: hypernets
Package: ghypernet
Type: Package
Title: An implementation of the Generalised Hypergeometric Ensemble of Random Graphs
Version: 0.3.16012019
Version: 0.3.20190130
Date: as.POSIXlt(2019-01-16)
Authors@R: c(
person("Giona", "Casiraghi", email = "giona@ethz.ch",
@@ -13,12 +13,17 @@ URL: https://ghyper.net
Description: An implementation of the Generalised Hypergeometric Ensemble of Random Graphs.
It provides functions for model fitting and selection of gHypEGs.
The package is based on the research developed at the Chair of Systems Design, ETH Zurich.
1. Casiraghi, G., Nanumyan, V., Scholtes, I., Schweitzer, F. Generalized Hypergeometric Ensembles: Statistical Hypothesis Testing in Complex Networks. arXiv Prepr. arXiv1607.02441 (2016). at <http://arxiv.org/abs/1607.02441>
2. Casiraghi, G., Nanumyan, V., Scholtes, I., Schweitzer, F. in 111-120 (Springer Verlag, 2017). doi:10.1007/978-3-319-67256-4_11
3. Casiraghi, G., Nanumyan, V. Generalised hypergeometric ensembles of random graphs: the configuration model as an urn problem. (2018). at <http://arxiv.org/abs/1810.06495>
4. Casiraghi, G. Analytical Formulation of the Block-Constrained Configuration Model. (2018). at <http://arxiv.org/abs/1811.05337>
Depends: R (>= 3.3.1)
License: AGPL-3
1. Casiraghi, G., Nanumyan, V., Scholtes, I., Schweitzer, F. Generalized Hypergeometric
Ensembles:
Statistical Hypothesis Testing in Complex Networks. arXiv1607.02441 (2016).
2. Casiraghi, G., Nanumyan, V., Scholtes, I., Schweitzer, F. in 111-120 (Springer Verlag,
(2017). doi:10.1007/978-3-319-67256-4_11
3. Casiraghi, G., Nanumyan, V. Generalised hypergeometric ensembles of random graphs:
the configuration model as an urn problem. (2018). arXiv1810.06495
4. Casiraghi, G. Analytical Formulation of the Block-Constrained Configuration Model.
(2018). arXiv1811.05337
Depends: R (>= 3.0)
License: AGPL-3 | file LICENSE
Imports: parallel,
plyr,
numbers,
@@ -5,6 +5,8 @@ S3method(ghype,default)
S3method(ghype,igraph)
S3method(ghype,matrix)
S3method(logLik,ghype)
S3method(logl,ghype)
S3method(logl,matrix)
S3method(print,bccm)
S3method(print,ghype)
export(BootstrapProperty)
@@ -17,6 +19,7 @@ export(bccm)
export(conf.test)
export(fitBlockModel)
export(ghype)
export(gof.test)
export(isNetwork)
export(linkSignificance)
export(logl)
@@ -19,7 +19,7 @@ updateModel <- function(model, adj){
}
if(length(grep('ghype', callname))>0){
callname <- 'ghype'
newcall <- call(name = callname, object=adj, directed=model$directed, selfloops=model$selfloops, xi=xi, unbiased=all(model$omega==1), regular=model$regular)
newcall <- call(name = callname, graph=adj, directed=model$directed, selfloops=model$selfloops, xi=xi, unbiased=all(model$omega==1), regular=model$regular)
} else{
if(length(grep('bccm', callname))>0){
callname <- 'bccm'
@@ -73,3 +73,24 @@ check_specs.matrix <- function(object, ...){
}
return(c('directed'=directed, 'selfloops'=selfloops))
}

########
## documentation for data in Vignette

#' Zachary's Karate Club graph
#'
#' The weighted adjacency reparting interactions among
#' 34 nodes.
#'
#' @format a 34x34 matrix
#' @source package `igraphdata`
"adj_karate"

#' Zachary's Karate Club vertex faction assignment
#'
#' The weighted adjacency reparting interactions among
#' 34 nodes.
#'
#' @format a 34 vector with the assignment of nodes to faction 1 or 2
#' @source package `igraphdata`
"vertexlabels"
@@ -191,7 +191,7 @@ bccm <- function(adj, labels, directed = NULL, selfloops = NULL, directedBlocks
omega <- vec2mat(omegav,directed,selfloops,nrow(adj))

# generate and return ensemble
model <- ghype(object = adj, directed = directed, selfloops = selfloops, xi = xi, omega = omega, regular = regular)
model <- ghype(graph = adj, directed = directed, selfloops = selfloops, xi = xi, omega = omega, regular = regular)

# generate block omega matrix for reference
if( (!homophily) & (!inBlockOnly)){
@@ -6,8 +6,8 @@
#' that the expected graph from the fitted model is the one passed to the
#' function.
#'
#' @param object either an adjacency matrix or an igraph graph.
#' @param directed a boolean argument specifying whether object is directed or not.
#' @param graph either an adjacency matrix or an igraph graph.
#' @param directed a boolean argument specifying whether graph is directed or not.
#' @param selfloops a boolean argument specifying whether the model should incorporate selfloops.
#' @param xi an optional matrix defining the combinatorial matrix of the model.
#' @param omega an optional matrix defining the propensity matrix of the model.
@@ -21,7 +21,7 @@
#' @export
#'
#'
ghype <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular=FALSE, ...){
ghype <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular=FALSE, ...){
UseMethod('ghype')
}

@@ -34,8 +34,8 @@ ghype <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbiased=FAL
#' that the expected graph from the fitted model is the one passed to the
#' function.
#'
#' @param object either an adjacency matrix or an igraph graph.
#' @param directed a boolean argument specifying whether object is directed or not.
#' @param graph either an adjacency matrix or an igraph graph.
#' @param directed a boolean argument specifying whether graph is directed or not.
#' @param selfloops a boolean argument specifying whether the model should incorporate selfloops.
#' @param xi an optional matrix defining the combinatorial matrix of the model.
#' @param omega an optional matrix defining the propensity matrix of the model.
@@ -49,34 +49,34 @@ ghype <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbiased=FAL
#' @export
#'
#'
ghype.matrix <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular=FALSE, ...){
ghype.matrix <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular=FALSE, ...){

df <- NULL

if(is.null(xi)){
xi=ComputeXi(object,directed,selfloops, regular = regular)
xi=ComputeXi(graph,directed,selfloops, regular = regular)
df <- regular + (1-regular)*nrow(xi)*(1+directed)
}

if(is.null(omega)){
if(unbiased){
omega <- matrix(1,nrow(object), ncol(object))
omega <- matrix(1,nrow(graph), ncol(graph))
} else{
omega <- FitOmega(adj = object, xi = xi, directed = directed, selfloops = selfloops)
omega <- FitOmega(adj = graph, xi = xi, directed = directed, selfloops = selfloops)
df <- df + sum(mat2vec.ix(omega,directed,selfloops)) - 1
}
}

if(nrow(object)==ncol(object)){
n <- nrow(object)
if(nrow(graph)==ncol(graph)){
n <- nrow(graph)
} else{
n <- c(nrow(object)+ncol(object),nrow(object),ncol(object))
n <- c(nrow(graph)+ncol(graph),nrow(graph),ncol(graph))
}

m <- sum(object[mat2vec.ix(object, directed, selfloops)])
m <- sum(graph[mat2vec.ix(graph, directed, selfloops)])

model <- as.ghype(list(call = match.call(),
'adj' = object,
'adj' = graph,
'xi'= xi,
'omega' = omega,
'n' = n,
@@ -98,8 +98,8 @@ ghype.matrix <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbia
#' that the expected graph from the fitted model is the one passed to the
#' function.
#'
#' @param object either an adjacency matrix or an igraph graph.
#' @param directed a boolean argument specifying whether object is directed or not.
#' @param graph either an adjacency matrix or an igraph graph.
#' @param directed a boolean argument specifying whether graph is directed or not.
#' @param selfloops a boolean argument specifying whether the model should incorporate selfloops.
#' @param xi an optional matrix defining the combinatorial matrix of the model.
#' @param omega an optional matrix defining the propensity matrix of the model.
@@ -113,19 +113,19 @@ ghype.matrix <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbia
#' @export
#'
#'
ghype.default <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular = FALSE, ...){
ghype.default <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular = FALSE, ...){

if(is.null(omega)){
if(unbiased){
omega <- matrix(1,nrow(object), ncol(object))
omega <- matrix(1,nrow(graph), ncol(graph))
}
}

n <- nrow(xi)
m <- sqrt(sum(xi))

model <- as.ghype(list(call = match.call(),
'adj' = object,
'adj' = graph,
'xi'= xi,
'omega' = omega,
'n' = n,
@@ -184,7 +184,7 @@ as.ghype.list <- function(object, ...){
'df' = object$df
)
if(is.null(model$loglikelihood) & !is.null(model$adj)){
model$loglikelihood <- logl(adj=model$adj, xi=model$xi,
model$loglikelihood <- logl(object=model$adj, xi=model$xi,
omega=model$omega, directed=model$directed,
selfloops=model$selfloops)
}
@@ -196,31 +196,31 @@ as.ghype.list <- function(object, ...){
#'
#' scm is wrapper for \link{ghype} that allows to specify a soft-configuration model.
#'
#' @param object either an adjacency matrix or an igraph graph
#' @param directed optional boolean, if not specified detected from object
#' @param selfloops optional boolean, if not specified detected from object
#' @param graph either an adjacency matrix or an igraph graph
#' @param directed optional boolean, if not specified detected from graph
#' @param selfloops optional boolean, if not specified detected from graph
#' @param ... additional parameters
#'
#' @return ghype object
#' @export
#'
scm <- function(object, directed = NULL, selfloops = NULL, ...){
scm <- function(graph, directed = NULL, selfloops = NULL, ...){

if(is.null(directed) | is.null(selfloops)){
specs <- check_specs(object)
specs <- check_specs(graph)
if(is.null(directed)) directed <- specs[1]
if(is.null(selfloops)) selfloops <- specs[2]
}

if(is.matrix(object)){
if(!directed & !isSymmetric(object)){
if(is.matrix(graph)){
if(!directed & !isSymmetric(graph)){
warning('Trying to compute undirected ensemble for asymmetric adjacency matrix.
Adjacency matrix symmetrised as adj <- adj + t(adj)')
object <- object + t(object)
graph <- graph + t(graph)
}
}

model <- ghype(object, directed=directed, selfloops=selfloops, unbiased = TRUE, regular = FALSE)
model <- ghype(graph, directed=directed, selfloops=selfloops, unbiased = TRUE, regular = FALSE)
model$df <- nrow(model$xi)*(1+directed)
return(model)
}
@@ -230,31 +230,31 @@ scm <- function(object, directed = NULL, selfloops = NULL, ...){
#' regularm is wrapper for \link{ghype} that allows to specify a gnm regular model.
#' i.e. where all entries of the combinatorial matrix Xi are the same.
#'
#' @param object either an adjacency matrix or an igraph graph
#' @param directed optional boolean, if not specified detected from object
#' @param selfloops optional boolean, if not specified detected from object
#' @param graph either an adjacency matrix or an igraph graph
#' @param directed optional boolean, if not specified detected from graph
#' @param selfloops optional boolean, if not specified detected from graph
#' @param ... additional parameters
#'
#' @return ghype object
#' @export
#'
regularm <- function(object, directed = NULL, selfloops = NULL, ...){
regularm <- function(graph, directed = NULL, selfloops = NULL, ...){

if(is.null(directed) | is.null(selfloops)){
specs <- check_specs(object)
specs <- check_specs(graph)
if(is.null(directed)) directed <- specs[1]
if(is.null(selfloops)) selfloops <- specs[2]
}

if(is.matrix(object)){
if(!directed & !isSymmetric(object)){
if(is.matrix(graph)){
if(!directed & !isSymmetric(graph)){
warning('Trying to compute undirected ensemble for asymmetric adjacency matrix.
Adjacency matrix symmetrised as adj <- adj + t(adj)')
object <- object + t(object)
graph <- graph + t(graph)
}
}

model <- ghype(object, directed=directed, selfloops=selfloops, unbiased = TRUE, regular = TRUE)
model <- ghype(graph, directed=directed, selfloops=selfloops, unbiased = TRUE, regular = TRUE)
model$df <- 1
return(model)
}
@@ -19,7 +19,6 @@ check_specs.igraph <- function(object, ...){
return(c('directed'=directed, 'selfloops'=selfloops))
}


#' Convert a list of adjacency matrices to a list of igraph graphs.
#'
#' @param adjlist a list of adjacency matrices
@@ -51,7 +50,7 @@ CreateIgGraphs <- function(adjlist, directed, selfloops, weighted=NULL){
#' that the expected graph from the fitted model is the one passed to the
#' function.
#'
#' @param object either an adjacency matrix or an igraph graph.
#' @param graph either an adjacency matrix or an igraph graph.
#' @param directed a boolean argument specifying whether object is directed or not.
#' @param selfloops a boolean argument specifying whether the model should incorporate selfloops.
#' @param xi an optional matrix defining the combinatorial matrix of the model.
@@ -66,11 +65,11 @@ CreateIgGraphs <- function(adjlist, directed, selfloops, weighted=NULL){
#' @export
#'
#'
ghype.igraph <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular=FALSE, ...){
if(igraph::is_bipartite(object)){
adj <- igraph::get.incidence(graph = object, sparse = FALSE)
ghype.igraph <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular=FALSE, ...){
if(igraph::is_bipartite(graph)){
adj <- igraph::get.incidence(graph = graph, sparse = FALSE)
} else{
adj <- igraph::get.adjacency(graph = object, type = "upper", sparse = FALSE)
adj <- igraph::get.adjacency(graph = graph, type = "upper", sparse = FALSE)
if(!directed)
adj <- adj + t(adj)
}
@@ -127,9 +126,11 @@ ghype.igraph <- function(object, directed, selfloops, xi=NULL, omega=NULL, unbia
#' @param ... other parameters to pass to `property`
#'
#' @return
#'
#' vector of length nsamples
#'
#' @export
#'
#' @examples
BootstrapProperty <- function(graph, property, directed, selfloops, nsamples=1000, xi=NULL, omega=NULL, model=NULL, m=NULL, seed=NULL, ...){

functionslist <- c(
@@ -157,7 +158,7 @@ BootstrapProperty <- function(graph, property, directed, selfloops, nsamples=100
m <- length(igraph::E(graph))

if(is.null(model))
model <- ghype(object = graph, directed, selfloops, xi, omega)
model <- ghype(graph = graph, directed, selfloops, xi, omega)

rsamples <- RandomGraph(nsamples, model, m, seed=seed)
gsamples <- CreateIgGraphs(adjlist = rsamples, directed = directed, selfloops = selfloops)
Oops, something went wrong.

0 comments on commit 6a59900

Please sign in to comment.
You can’t perform that action at this time.