Skip to content
Permalink
Browse files

fixes for cran

  • Loading branch information...
gi0na committed Feb 18, 2019
1 parent 95a603c commit 8dcdd5ff62f589c9c22216597ee5f3af77f3195a
@@ -1,23 +1,22 @@
Package: ghypernet
Type: Package
Title: R Implementation of the Generalised Hypergeometric Ensemble of Random Graphs
Version: 0.5.1000
Date: 2019-02-01
Version: 0.5.1
Date: 2019-02-15
Authors@R: c(
person("Giona", "Casiraghi", email = "giona@ethz.ch",
role = c("aut", "cre"), comment = c(ORCID = "0000-0003-0233-5747")),
person("Vahan", "Nanumyan", email = "vahan@ethz.ch",
role = c('aut'), comment = c(ORCID = "0000-0001-9054-3217"))
)
URL: http://ghyper.net
Description: R implementation of the Generalised Hypergeometric Ensemble of Random Graphs.
It provides functions for model fitting and selection of gHypEGs.
Description: Provides functions for model fitting and selection of gHypEGs.
To learn how to use it, check the vignettes for a quick tutorial.
Please reference its use as DOI: 10.5281/zenodo.2555300 together with the references
listed below.
Please reference its use as Casiraghi, G., Nanumyan, V. (2019) <doi:10.5281/zenodo.2555300>
together with those relevant references from the one listed below.
The package is based on the research developed at the Chair of Systems Design, ETH Zurich.
Casiraghi, G., Nanumyan, V., Scholtes, I., Schweitzer, F. (2016) <arXiv:1607.02441>.
Casiraghi, G., Nanumyan, V., Scholtes, I., Schweitzer, F. (2017) <https://link.springer.com/chapter/10.1007/978-3-319-67256-4_11>.
Casiraghi, G., Nanumyan, V., Scholtes, I., Schweitzer, F. (2017) <doi:10.1007/978-3-319-67256-4_11>.
Casiraghi, G., Nanumyan, V. (2018) <arXiv:1810.06495>.
Casiraghi, G. (2018) <arXiv:1811.05337>.
Depends: R (>= 3.0)
@@ -30,5 +29,5 @@ Imports: parallel,
Suggests: BiasedUrn, igraph, knitr, rmarkdown
VignetteBuilder: knitr
Encoding: UTF-8
RoxygenNote: 6.1.0
RoxygenNote: 6.1.1
Language: en-GB
@@ -13,11 +13,9 @@ export(BootstrapProperty)
export(ComputeXi)
export(CreateIgGraphs)
export(FitOmega)
export(RandomGraph)
export(as.ghype)
export(bccm)
export(conf.test)
export(fitBlockModel)
export(ghype)
export(gof.test)
export(isNetwork)
@@ -79,7 +79,7 @@ check_specs.matrix <- function(object, ...){

#' Zachary's Karate Club graph
#'
#' The weighted adjacency reporting interactions among
#' Weighted adjacency matrix reporting interactions among
#' 34 nodes.
#'
#' @format a 34x34 matrix
@@ -88,7 +88,7 @@ check_specs.matrix <- function(object, ...){

#' Zachary's Karate Club vertex faction assignment
#'
#' The assignment of nodes to communities.
#' Vector reporting the assignment of nodes to communities.
#'
#' @format a 34-vector with the assignment of nodes to faction 1 or 2
#' @source package `igraphdata`
@@ -1,34 +1,11 @@
#' Fitting bccm models (deprecated)
#'
#' bccm is used to fit a block-constrained configuration model.
#'
#'
#' @param adj the adjacency matrix of the graph.
#' @param labels vector, the vertex labels to generate the blocks in the bccm.
#' @param directed a boolean argument specifying whether object is directed or not.
#' @param selfloops boolean argument specifying whether the model should incorporate selfloops.
#' @param directedBlocks boolean argument specifying whether the model should incorporate directed blocks. Default to FALSE.
#' @param homophily boolean argument specifying whether the model should fit only homophily blocks. Default to FALSE.
#' @param inBlockOnly boolean argument specifying whether the model should fit only blocks over the diagonal. Default to FALSE.
#' @param xi an optional matrix defining the combinatorial matrix of the model.
#'
#' @return
#' bccm returns an object of class 'bccm' and 'ghype'.
#' 'bccm' objects expand 'ghype' objects incorporating the parameter estimates.
#' @export
#'
fitBlockModel <- function(adj, labels, directed, selfloops, directedBlocks = FALSE, homophily = FALSE, inBlockOnly = FALSE, xi = NULL){
bccm(adj, labels, directed, selfloops, directedBlocks, homophily, inBlockOnly, xi)
}

#' Fitting bccm models
#'
#' bccm is used to fit a block-constrained configuration model.
#'
#'
#' @param adj the adjacency matrix of the graph.
#' @param labels vector, the vertex labels to generate the blocks in the bccm.
#' @param directed a boolean argument specifying whether object is directed or not.
#' @param directed a boolean argument specifying whether the graph is directed or not.
#' @param selfloops boolean argument specifying whether the model should incorporate selfloops.
#' @param directedBlocks boolean argument specifying whether the model should incorporate directed blocks. Default to FALSE.
#' @param homophily boolean argument specifying whether the model should fit only homophily blocks. Default to FALSE.
@@ -217,6 +194,7 @@ JnBlock <- function(omegaBlocks, xiBlocks, mBlocks, m) {


# Confidence intervals for block models.
# Based on Fisher information matrix
blockmodel.ci <- function(omegaBlocks, xiBlocks, mBlocks, m,
pval=.05) {
jn <- JnBlock(omegaBlocks, xiBlocks, mBlocks, m)
@@ -4,14 +4,18 @@
#' configuration model or 'regular' gnp model.
#'
#' @param adj adjacency matrix
#' @param directed boolean
#' @param selfloops boolean
#' @param directed boolean, whether the model is for a directed network
#' @param selfloops boolean, whether the model contains selfloops
#' @param regular boolean. Is the combinatorial matrix computed for configuration model or for regular gnp model? default FALSE.
#'
#' @return
#' combinatorial matrix
#'
#' @export
#'
#' @examples
#' data('adj_karate')
#' xi = ComputeXi(adj_karate, directed = FALSE, selfloops = FALSE)
#'
ComputeXi <- function(adj, directed, selfloops, regular = FALSE) {
# returns the matrix xi according to the nodes degrees
@@ -54,6 +58,7 @@ ComputeXi <- function(adj, directed, selfloops, regular = FALSE) {
if(!directed){
xi <- xi + t(xi) - diag(diag(xi))
if(!selfloops){
# Temporary workaround
ix <- mat2vec.ix(adj, directed, selfloops)
sdiag <- sum(diag(xi))
toadd <- ceiling(sdiag/sum(Kin)*Kin/(nrow(adj)-1))
@@ -70,6 +75,8 @@ ComputeXi <- function(adj, directed, selfloops, regular = FALSE) {
}


# auxilliary function: redistribute selfloops
# temporary workaround
vxi <- function(idx, diagxir, vbas, xi, adj){
v <- rep(0, ncol(adj)-1)
v[sample(ncol(adj)-1, diagxir[idx])] <- 1
@@ -29,25 +29,7 @@ ghype <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALS
}


#' Fitting gHypEG models
#'
#' ghype is used to fit gHypEG models when the propensity matrix is known.
#' It can be used to estimate a null model (soft configuration model), or
#' the benchmark 'full-model', where the propensity matrix is fitted such
#' that the expected graph from the fitted model is the one passed to the
#' function.
#'
#' @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.
#' @param unbiased a boolean argument specifying whether to model the hypergeometric ensemble (no propensity), defaults to FALSE.
#' @param regular a boolean argument specifying whether to model the 'gnp' ensemble (no xi), defaults to FALSE.
#' @param ... additional arguments to be passed to the low level fitting functions.
#'
#' @return
#' ghype return an object of class "ghype".
#' @describeIn ghype Fitting ghype models from an adjacency matrix
#'
#' @export
#'
@@ -88,40 +70,20 @@ ghype.matrix <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbias
'selfloops' = selfloops,
'regular' = regular,
'unbiased' = unbiased,
'df' = df))
'df' = df), ...)
return(model)
}


#' Fitting gHypEG models
#'
#' ghype is used to fit gHypEG models when the propensity matrix is known.
#' It can be used to estimate a null model (soft configuration model), or
#' the benchmark 'full-model', where the propensity matrix is fitted such
#' that the expected graph from the fitted model is the one passed to the
#' function.
#'
#' @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.
#' @param unbiased a boolean argument specifying whether to model the hypergeometric ensemble (no propensity), defaults to FALSE.
#' @param regular a boolean argument specifying whether to model the 'gnp' ensemble (no xi), defaults to FALSE.
#' @param ... additional arguments to be passed to the low level fitting functions.
#'
#' @return
#' ghype return an object of class "ghype".
#' @describeIn ghype Generating a ghype model from given xi and omega
#'
#' @export
#'
#'
ghype.default <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbiased=FALSE, regular = FALSE, ...){

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

n <- nrow(xi)
@@ -147,28 +109,25 @@ ghype.default <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbia
#' Manually map a list to a ghype object
#'
#' @param object list object to map to ghype.
#' @param ... additional arguments to be passed to the low level functions.
#' @param ... additional arguments to be passed to logl function.
#'
#' @return
#' an object of class "ghype"
#'
#' @export
#'
#' @examples
#' ll <- list(call = NULL, 'adj' = NULL, 'xi'= matrix(36,4,4), 'omega' = matrix(1,4,4),
#' 'n' = 4, 'm' = 12, 'directed' = TRUE, 'selfloops' = TRUE,
#' 'regular' = TRUE, 'unbiased' = TRUE, 'df' = 1)
#' model <- as.ghype(ll)
#'
as.ghype <- function(object, ...){
UseMethod('as.ghype')
}


#' Map list to ghype object
#'
#' Manually map a list to a ghype object
#'
#' @param object list object to map to ghype.
#' @param ... additional arguments to be passed to the low level functions.
#'
#' @return
#' an object of class "ghype"
#'
#' @describeIn as.ghype Map list to ghype
#' @export
#'
as.ghype.list <- function(object, ...){
@@ -186,10 +145,10 @@ as.ghype.list <- function(object, ...){
'unbiased' = object$unbiased,
'df' = object$df
)
if(is.null(model$loglikelihood) & !is.null(model$adj)){
if(is.null(model$loglikelihood) & !is.null(model$adj) & !is.null(model$xi) & !is.null(model$omega)){
model$loglikelihood <- logl(object=model$adj, xi=model$xi,
omega=model$omega, directed=model$directed,
selfloops=model$selfloops)
selfloops=model$selfloops, ...)
}
class(model) <- 'ghype'
return(model)
@@ -202,7 +161,7 @@ as.ghype.list <- function(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
#' @param ... additional parameters passed to the ghype function
#'
#' @return ghype object
#' @export
@@ -227,7 +186,7 @@ scm <- function(graph, directed = NULL, selfloops = NULL, ...){
}
}

model <- ghype(graph, 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)
}
@@ -240,7 +199,7 @@ scm <- function(graph, directed = NULL, selfloops = NULL, ...){
#' @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
#' @param ... additional parameters passed to the ghype function
#'
#' @return ghype object
#' @export
@@ -265,7 +224,7 @@ regularm <- function(graph, directed = NULL, selfloops = NULL, ...){
}
}

model <- ghype(graph, directed=directed, selfloops=selfloops, unbiased = TRUE, regular = TRUE)
model <- ghype(graph, directed=directed, selfloops=selfloops, unbiased = TRUE, regular = TRUE, ...)
model$df <- 1
return(model)
}
@@ -1,3 +1,4 @@
# auxiliary function for to extract igraph properties
check_specs.igraph <- function(object, ...){
if(requireNamespace("igraph", quietly = TRUE) && igraph::is.igraph(object)){
if(is.null(directed)){
@@ -31,6 +32,11 @@ check_specs.igraph <- function(object, ...){
#' list of igraph graphs.
#'
#' @export
#'
#' @examples
#' data('adj_karate')
#' adj_list <- list(adj_karate)
#' glist <- CreateIgGraphs(adj_list, FALSE, FALSE)
#'
CreateIgGraphs <- function(adjlist, directed, selfloops, weighted=NULL){
if(directed)
@@ -42,25 +48,7 @@ CreateIgGraphs <- function(adjlist, directed, selfloops, weighted=NULL){
}


#' Fitting gHypEG models
#'
#' ghype is used to fit gHypEG models when the propensity matrix is known.
#' It can be used to estimate a null model (soft configuration model), or
#' the benchmark 'full-model', where the propensity matrix is fitted such
#' that the expected graph from the fitted model is the one passed to the
#' function.
#'
#' @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.
#' @param omega an optional matrix defining the propensity matrix of the model.
#' @param unbiased a boolean argument specifying whether to model the hypergeometric ensemble (no propensity), defaults to FALSE.
#' @param regular a boolean argument, defaults to FALSE
#' @param ... additional arguments to be passed to the low level fitting functions.
#'
#' @return
#' ghype return an object of class "ghype".
#' @describeIn ghype Fitting ghype models from an igraph graph
#'
#' @export
#'
@@ -106,12 +94,12 @@ ghype.igraph <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbias
'selfloops' = selfloops,
'regular' = regular,
'unbiased' = unbiased,
'df' = df))
'df' = df), ...)
return(model)
}


#' BootstrapProperty compute igraph analytics function on ensemble
#' BootstrapProperty computes igraph analytics function on ensemble
#'
#' @param graph igraph graph
#' @param property igraph function that can be applied to a graph
@@ -130,8 +118,17 @@ ghype.igraph <- function(graph, directed, selfloops, xi=NULL, omega=NULL, unbias
#' vector of length nsamples
#'
#' @export
#'
BootstrapProperty <- function(graph, property, directed, selfloops, nsamples=1000, xi=NULL, omega=NULL, model=NULL, m=NULL, seed=NULL, ...){
#'
#' @examples
#' \dontrun{
#' library(igraph)
#' data('adj_karate')
#' result <- BootstrapProperty(adj_karate, page_rank, FALSE, FALSE, nsamples=100)
#' }
#'
BootstrapProperty <- function(graph, property, directed,
selfloops, nsamples=1000, xi=NULL, omega=NULL,
model=NULL, m=NULL, seed=NULL, ...){

functionslist <- c(
'page_rank',
@@ -160,7 +157,7 @@ BootstrapProperty <- function(graph, property, directed, selfloops, nsamples=100
if(is.null(model))
model <- ghype(graph = graph, directed, selfloops, xi, omega)

rsamples <- RandomGraph(nsamples, model, m, seed=seed)
rsamples <- rghype(nsamples, model, m, seed=seed)
gsamples <- CreateIgGraphs(adjlist = rsamples, directed = directed, selfloops = selfloops)
if(as.character(substitute(property)) %in% functionslist){
dproperty <- sapply(X = gsamples, FUN = function(graph, directed, ...){match.fun(FUN = property)(graph, directed=directed, ...)$vector}, directed=directed, ...)

0 comments on commit 8dcdd5f

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