Nothing
#' @describeIn ghype
#' Print method for ghype object.
#'
#' @param x ghype model
#' @param ... further arguments passed to or from other methods.
#' @param suppressCall boolean, suppress print of the call
#'
#' @export
#'
#' @examples
#' data('adj_karate')
#' model <- scm(adj_karate, FALSE, FALSE)
#' print(model)
#'
print.ghype <- function(x, suppressCall = FALSE,
...) {
# print method for ghype class
if (!suppressCall) {
cat("Call:\n")
print(x$call)
}
directed <- 'undirected'
if(x$directed)
directed <- 'directed'
selfloops <- 'no selfloops'
if(x$selfloops)
selfloops <- 'selfloops'
out <- paste('ghype',directed,',',selfloops,'\n')
cat(out)
out <- paste(x$n[1], 'vertices,', x$m, 'edges','\n')
cat(out)
cat('Loglikelihood:\n')
cat(x$loglikelihood)
cat(paste("\ndf:",x$df,'\n'))
invisible()
}
#' @describeIn bccm
#' Print method for elements of class \code{'bccm'}.
#'
#' @param x object of class \code{'bccm'}
#' @param suppressCall logical, indicating whether to print the call that generated x
#' @param \dots optional arguments to print or plot methods.
#' @seealso \code{\link{bccm}}
#' @export
#' @examples
#' data('adj_karate')
#' data('vertexlabels')
#' bcc.model <- bccm(adj_karate, labels=vertexlabels, directed=FALSE, selfloops=FALSE)
#' print(bcc.model)
#'
print.bccm <- function(x, suppressCall = FALSE,
...) {
# print method for ghypeBlock class
if (!suppressCall) {
cat("Call:\n")
print(x$call)
}
directed <- 'undirected'
if(x$directed)
directed <- 'directed'
selfloops <- 'no selfloops'
if(x$selfloops)
selfloops <- 'selfloops'
out <- paste('block ghype',directed,',',selfloops,'\n')
cat(out)
out <- paste(x$n[1], 'vertices,', x$m, 'edges','\n')
cat(out)
cat('Loglikelihood:\n')
cat(x$loglikelihood)
cat(paste("\ndf:",x$df,'\n'))
cat("\nCoefficients:\n")
cmat <- cbind(x$coef, x$ci[,
3])
cmat <- cbind(cmat, abs(cmat[,
1])/cmat[, 2])
cmat <- cbind(cmat, 2 * stats::pnorm(-cmat[,
3]))
colnames(cmat) <- c("Estimate",
"Std.Err", "t value", "Pr(>t)")
stats::printCoefmat(cmat)
invisible()
}
#' @describeIn nrm
#' Print method for elements of class \code{'nrm'}.
#'
#' @param x object of class \code{'nrm'}
#' @param suppressCall logical, indicating whether to print the call that generated x
#' @param \dots optional arguments to print or plot methods.
#' @author Giona Casiraghi
#' @seealso \code{\link{nrm}}
#' @export
print.nrm <- function(x, suppressCall = FALSE,
...) {
# print method for nrm class
if (!suppressCall) {
cat("Call:\n")
print(x$call)
}
cat("\nCoefficients:\n")
cmat <- cbind(x$coef, x$confint[,
3])
cmat <- cbind(cmat, abs(cmat[,
1])/cmat[, 2])
cmat <- cbind(cmat, 2 * stats::pnorm(-cmat[,
3]))
colnames(cmat) <- c("Estimate",
"Std.Err", "t value", "Pr(>t)")
stats::printCoefmat(cmat)
cat("\nR2:\n")
print(c(`McFadden R2` = x$R2,
`Cox Snell R2` = x$csR2))
invisible()
}
#' @describeIn nrm_selection
#' Print method for elements of class \code{'nrm_selection'}.
#'
#' @param x object of class \code{'nrm_selection'}.
#' @param \dots optional arguments to print or plot methods.
#' @author Giona Casiraghi
#' @seealso \code{nrm_selection}
#' @export
print.nrm_selection <- function(x,
...) {
# print method for nrm class
cat("Call:\n")
print(x$call)
id <- which(x$csR2step[-1] <
0.05)[1] - 1
if (id <= 1)
id <- 1
print(x$models[[id]], suppressCall = TRUE)
aics <- x$AIC[c(1, id, length(x$AIC))]
es <- c(NA, x$csR2[id], coxsnellR2(x$models[[id]],
x$models[[length(x$models)]],
m = x$M))
names(aics) <- names(es) <- c("null",
"sel", "full")
cat("\nAIC:\n")
print(aics[2])
cat("\nNull AIC and full model AIC:\n")
out <- cbind(aics[c(1, 3)],
es[c(1, 3)])
colnames(out) <- c("AIC", "effect.s")
print(out)
invisible()
}
#' Summary method for elements of class \code{'nrm_selection'}.
#'
#' @param object an object of class 'nrm_selection', usually, a result of a call to \code{nrm_selection}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return The function \code{\link{summary.nrm_selection}} computes and
#' returns a list of summary statistics of the fitted
#' \code{\link{nrm_selection}} model given in \code{object}.
#' @export
#'
summary.nrm_selection <- function(object,
...) {
# summmary method for nrm class
results <- cbind(mcR2 = round(object$mcR2,
digits = 4), csR2 = round(object$csR2,
digits = 4), AIC = round(object$AIC),
effect.s = round(object$csR2step,
digits = 4))
# likelihood ratio tests
if (length(object$nms) > 0)
rownames(results) <- c("-",
object$nms)
ans <- list(object=object,results=results)
class(ans) <- "summary.nrm_selection"
ans
}
#' @rdname summary.nrm_selection
#'
#' @param x object of class `summary.nrm_selection` returned by [summary.nrm._selection()].
#' @param ... further arguments passed to or from other methods.
#' @export
print.summary.nrm_selection <- function (x, ...){
# summmary method for nrm class
print(x[['object']])
cat("\n----------------------\n")
cat("\nAIC selection:\n")
print(x[['results']])
cat("\nFull model:\n")
print(x[['object']]$models[[length(x[['object']]$models)]],
suppressCall = TRUE)
invisible(x)
}
#' Summary method for elements of class \code{'nrm'}.
#'
#' Currently it provides the same output as \code{'print.nrm'}
#'
#' @param object an object of class 'nrm', usually, a result of a call to \code{nrm}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return The function \code{\link{summary.nrm}} computes and
#' returns a list of summary statistics of the fitted
#' \code{\link{nrm}} model given in \code{object}.
#'
#' @export
#'
summary.nrm <- function(object,
...) {
# summmary method for nrm class
ans <- list(object=object)
class(ans) <- "summary.nrm"
ans
}
#' @rdname summary.nrm
#'
#' @param x object of class `summary.nrm` returned by [summary.nrm()].
#' @param ... further arguments passed to or from other methods.
#' @export
print.summary.nrm <- function (x, ...){
print(x[['object']])
invisible(x)
}
#' Extraction method for coefficients of models of class \code{'nrm'}.
#'
#' @param object object of class \code{'nrm'}.
#' @param \dots optional arguments to print methods.
#' @return coefficients of nrm model.
#' @author Giona Casiraghi
#' @seealso \code{\link{nrm}}
#' @export
#' @importFrom stats coef predict residuals
coef.nrm <- function(object, ...) {
# coef method for nrm class
object$coef
}
## texreg package
## Texreg: does not (yet) support nrm or gyhpe-class
# use the extract()-function to make this available
#' Extract details from statistical models for table construction. The function has methods for a range of statistical models.
#'
#' @param model A statistical model object.
#' @param ... Custom parameters, which are handed over to subroutines. The arguments are usually passed to the summary function, but in some cases to other functions.
#'
#' @return The function returns a texreg object.
#' @export
#' @importFrom texreg extract screenreg texreg htmlreg
#' @author L. Brandenberger, G. Casiraghi
extract.nrm.cluster <- function(model, ...){
# calculate SE, tvalues and pvalues
coeffic <- as.numeric(model$coef)
stderr <- model$confint[,3]
tvalues = abs(coeffic/stderr)
pval <- 2 * stats::pnorm(-tvalues)
# then create and return a texreg object (replace NULL with actual values):
tr <- texreg::createTexreg(
coef.names = names(model$coef), # character vector of coefficient labels
coef = coeffic, # numeric vector with coefficients
se = stderr, # numeric vector with standard error values
pvalues = pval, # numeric vector with p-values
gof.names = c("AIC", "McFadden $R^2$"), # character vector with goodness-of-fit labels
gof = c(model$AIC, model$R2) # numeric vector of goodness-of-fit statistics
#gof.decimal = NULL # logical vector: GOF statistic has decimal points?
)
return(tr)
}
setMethod(texreg::extract, signature = className("nrm", "ghype"),
definition = extract.nrm.cluster)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.