R/auxilliary.R

Defines functions check_specs.matrix check_specs lrtohtest updateModel

updateModel <- function(model, adj){

  callname <- as.character(model$call[1])

  xi <- NULL

  newcall <- NULL

  if(length(grep('function', callname))>0){
    if(length(grep('block', callname))>0 | length(grep('labels', callname))>0){
      callname <- 'bccm'
    } else{
      callname <- 'ghype'
    }
  } else{
    fixXi <- length(grep('xi', deparse(model$call, width.cutoff = 500)))>0
    if(fixXi)
      xi <- model$xi
  }
  if(length(grep('ghype', callname))>0){
    callname <- 'ghype'
    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'
      newcall <- call(name = callname, adj=adj, labels=model$labels, directed=model$directed, selfloops=model$selfloops, xi=xi, regular=model$regular, directedBlocks=model$directedBlocks, homophily=model$homophily,inBlockOnly=model$inBlockOnly)
    }
    if(length(grep('nrm', callname))>0){
      callname <- 'nrm'
      newcall <- call(name = callname, w=model$predictors, adj=adj, directed=model$directed,
                      selfloops=model$selfloops, xi=xi, init = c(model$coef[-length(model$coef)],0.01), ci=FALSE, regular=model$regular)
    }
  }

  return(newcall)
}

lrtohtest <- function(statistic, parameter, p.value, conf.int, alternative, method, data.name){
  val <- list(statistic=statistic, parameter=parameter,
              p.value=p.value, conf.int=conf.int, alternative=alternative,
              method=method, data.name=data.name)
  class(val) <- 'htest'
  return(val)
}

check_specs <- function(object, ...){
  UseMethod('check_specs')
}

check_specs.matrix <- function(object, ...){
  if(is.matrix(object)){
    if(is.null(directed)){
      if(isSymmetric(object)){
        directed <- FALSE
      } else{
        directed <- TRUE
      }
    } else{
      if(!directed & !isSymmetric(object)){
        warning('Trying to compute undirected ensemble for asymmetric adjacency matrix.
              Adjacency matrix symmetrised as adj <- adj + t(adj)')
        object <- object + t(object)
      }
    }

    if(is.null(selfloops)){
      if(all(diag(object)==0)){
        selfloops <- FALSE
      } else{
        selfloops <- TRUE
      }
    }
  }
  return(c('directed'=directed, 'selfloops'=selfloops))
}

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

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

#' Zachary's Karate Club vertex faction assignment
#'
#' 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`
"vertexlabels"

#' Swiss MPs committee similarity matrix.
#'
#' **onlinesim_mat**: a similarity matrix of how similar two MPs are in their online
#' social media presence (shared supportees).
#'
#' @docType data
#'
#' @usage data(onlinesim_mat)
#'
#' @format 163x163 similarity matrix
#'
#' @keywords datasets
#'
# #' @references 
# #' (\href{}{})
#'
# #' @source \href{}{}
#'
"onlinesim_mat"

#' Swiss MPs committee affiliation data frame.
#'
#' **dtcommittee**: a list of committees each MP was part of during their stay in 
#' parliament
#'
#' @docType data
#'
#' @usage data(dtcommittee)
#'
#' @format 163x2 data.frame
#'
#' @keywords datasets
#'
# #' @references 
# #' (\href{}{})
#'
# #' @source \href{}{}
#'
"dtcommittee"

#' Swiss MPs attribute data frame.
#'
#' **dt**: contains different attributes of the 163 MPs, such as their names, 
#' their party affiliation (variable: *party*), their parliamentary group
#' affiliation (variable: *parlGroup*), the Canton (or state) they represent
#' (variable: *canton*), their gender  (variable: *gender*)
#' and date of birth  (variable: *birthdate*).
#'
#' @docType data
#'
#' @usage data(dt)
#'
#' @format 163x8 data.frame
#'
#' @keywords datasets
#'
# #' @references 
# #' (\href{}{})
#'
# #' @source \href{}{}
#'
"dt"

#' Swiss MPs network adjacency matrix
#'
#' **cospons_mat**: contains the adjacency matrix of 163 x 163 MPs.
#'
#' @docType data
#'
#' @usage data(cospons_mat)
#'
#' @format 163x163 adjacency matrix
#'
#' @keywords datasets
#'
# #' @references 
# #' (\href{}{})
#'
# #' @source \href{}{}
#'
"cospons_mat"
gi0na/ghypernet documentation built on Sept. 2, 2019, 10:30 a.m.