Skip to content

Commit

Permalink
fixes for cran
Browse files Browse the repository at this point in the history
  • Loading branch information
gi0na committed Feb 18, 2019
1 parent 95a603c commit 8dcdd5f
Show file tree
Hide file tree
Showing 41 changed files with 333 additions and 476 deletions.
15 changes: 7 additions & 8 deletions DESCRIPTION
@@ -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)
Expand All @@ -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
2 changes: 0 additions & 2 deletions NAMESPACE
Expand Up @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions R/auxilliary.R
Expand Up @@ -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
Expand All @@ -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`
Expand Down
26 changes: 2 additions & 24 deletions R/blockmodel.R
@@ -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.
Expand Down Expand Up @@ -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)
Expand Down
11 changes: 9 additions & 2 deletions R/computexi.R
Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand All @@ -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
Expand Down
79 changes: 19 additions & 60 deletions R/ghype.R
Expand Up @@ -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
#'
Expand Down Expand Up @@ -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)
Expand All @@ -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, ...){
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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)
}
Expand All @@ -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
Expand All @@ -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)
}
45 changes: 21 additions & 24 deletions R/igraphintegration.R
@@ -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)){
Expand Down Expand Up @@ -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)
Expand All @@ -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
#'
Expand Down Expand Up @@ -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
Expand All @@ -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',
Expand Down Expand Up @@ -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, ...)
Expand Down

0 comments on commit 8dcdd5f

Please sign in to comment.