https://github.com/cran/MuMIn
Tip revision: 28fb044e18526531e7cfad4dd6a95ae5ce31bf7f authored by Kamil BartoĊ on 14 January 2012, 09:00:08 UTC
version 1.6.6
version 1.6.6
Tip revision: 28fb044
model.sel.R
#TODO: checking if models are fitted to the same dataset <- model.avg
`model.sel` <-
`mod.sel` <-
function (object, ...) UseMethod("mod.sel")
`mod.sel.model.selection` <-
function (object, rank = NULL, rank.args = NULL, ...) {
#if(!is.null(rank)) .NotYetUsed("rank")
if(!is.null(rank)) {
models <- get.models(object, seq.int(nrow(object)))
ret <- mod.sel.default(models, rank = .getRank(rank,
rank.args = rank.args, object = models[[1L]]))
return(ret)
} else {
return(object)
}
}
`mod.sel.default` <-
function(object, ..., rank = NULL, rank.args = NULL) {
if (missing(object) && length(models <- list(...)) > 0L) {
object <- models[[1L]]
} else if (inherits(object, "list")) {
if(length(object) == 0L) stop("at least one model must be given")
models <- object
object <- models[[1L]]
} else {
models <- list(object, ...)
names(models)[1L] <- deparse(substitute(object))
}
if(length(models) == 0L) stop("at least one model must be given")
.checkModels(models, FALSE)
if(is.null(names(models)) || any(is.na(names(models))))
names(models) <- seq_along(models)
names(models) <- make.unique(names(models), sep = "")
rank <- .getRank(rank, rank.args = rank.args, object = object)
ICname <- deparse(attr(rank, "call")[[1L]])
all.terms <- unique(unlist(lapply(models, getAllTerms, intercept = TRUE)))
all.coef <- fixCoefNames(unique(unlist(lapply(lapply(models, coeffs), names))))
logLik <- .getLogLik()
j <- !(all.terms %in% all.coef)
d <- as.data.frame(t(sapply(models, matchCoef, all.terms=all.terms)))
d[,j] <- lapply(d[,j, drop=FALSE], function(x) factor(is.nan(x),
levels=c(F, T), labels=c("", "+")))
ret <- as.data.frame(t(vapply(models, function(x) {
ll <- logLik(x)
c(attr(ll, "df"), ll, rank(x))
}, structure(double(3L), names=c("df", "logLik", ICname)))))
ret <- cbind(d, ret)
ret[, "delta"] <- ret[, ICname] - min(ret[, ICname])
ret[, "weight"] <- Weights(ret[,ICname])
o <- order(ret[, "delta"], decreasing = FALSE)
rownames(ret) <- names(models)
ret <- ret[o, ]
attr(ret, "terms") <- all.terms
attr(ret, "calls") <- lapply(models, .getCall)[o]
attr(ret, "order") <- o
attr(ret, "rank") <- rank
attr(ret, "rank.call") <- attr(rank, "call")
attr(ret, "call") <- match.call(expand.dots = TRUE)
class(ret) <- c("model.selection", "data.frame")
ret
}