R/logLik.stergm.R

Defines functions logLikNull.stergm logLik.stergm

Documented in logLikNull.stergm logLik.stergm

#  File R/logLik.stergm.R in package tergm, part of the Statnet suite
#  of packages for network analysis, http://statnet.org .
#
#  This software is distributed under the GPL-3 license.  It is free,
#  open source, and has the attribution requirements (GPL Section 7) at
#  http://statnet.org/attribution
#
#  Copyright 2008-2017 Statnet Commons
#######################################################################

logLik.stergm<-function(object, add=FALSE, force.reeval=FALSE, eval.loglik=add || force.reeval, control=control.logLik.stergm(), ...){
  check.control.class("logLik.stergm","logLik.stergm")
  if(object$estimate=="EGMME") stop("Log-likelihood for ",object$estimate," is not meaningful.")
  
  if(!is.null(control$seed))  set.seed(as.integer(control$seed))

  if(add){
    object$formation.fit <- logLik(object$formation.fit, add=add, force.reeval=force.reeval, eval.loglik = add || force.reeval, control=control$control.form)
    object$dissolution.fit <- logLik(object$dissolution.fit, add=add, force.reeval=force.reeval, eval.loglik = add || force.reeval, control=control$control.diss)
    
    object
  }else{
    llk.form <- logLik(object$formation.fit, add=add, force.reeval=force.reeval, eval.loglik = eval.loglik, control=control$control.form)
    llk.diss <- logLik(object$dissolution.fit, add=add, force.reeval=force.reeval, eval.loglik = eval.loglik, control=control$control.diss)

    llk <- llk.form + llk.diss
    class(llk) <- "logLik"
    attr(llk,"df") <- attr(llk.form,"df") + attr(llk.diss,"df")
    attr(llk,"nobs") <- attr(llk.form,"nobs") + attr(llk.diss,"nobs")
    
    llk
  }
}

logLikNull.stergm <- function(object, control=control.logLik.stergm(), ...){
    llk.form <- logLikNull(object$formation.fit, control=control$control.form)
    llk.diss <- logLikNull(object$dissolution.fit, control=control$control.diss)

    llk <- llk.form + llk.diss
    class(llk) <- "logLik"
    attr(llk,"df") <- attr(llk.form,"df") + attr(llk.diss,"df")
    attr(llk,"nobs") <- attr(llk.form,"nobs") + attr(llk.diss,"nobs")
    
    llk
}

Try the tergm package in your browser

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

tergm documentation built on Sept. 12, 2017, 9:02 a.m.