dropone.lme: Refit a model dropping one observation or one cluster at a...

In gmonette/spida15: Collection of miscellaneous functions for mixed models etc. prepared for SPIDA 2009+ (development version)

Description

Refits a model droping one observation or cluster at a time and returns a data frame with the sesulting fitted parameters.

Usage

dropone(fit, by, verbose = FALSE, ...)


dropone.lme(fit, by, verbose = FALSE, ...)

Arguments

fit	The fitted object from which observations are dropped.
by	an optional formula giving the variable to be used to drop observations. If missing observations are dropped one at at time.
verbose	produce verbose output (default FALSE).
...

Value

A data frame with cluster-level variables and the values of 'drop one' estimated parameters.

Examples

##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--	or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function (fit, by, verbose = FALSE, ...) 
{
    getSummary <- function(x) {
        re <- getVarCov(x)
        rn <- expand.grid(dimnames(re))
        rn <- array(apply(rn, 1, paste, collapse = "+"), dim = dim(re))
        re <- re[col(re) <= row(re)]
        names(re) <- rn[col(rn) <= row(rn)]
        ff <- fixef(x)
        names(ff) <- paste("b", names(ff), sep = ".")
        c(ff, dvcov = det(vcov(x)), re, sigma2 = fit$sigma^2)
    }
    data <- getData(fit)
    if (missing(by)) 
        by <- 1:nrow(data)
    if (inherits(by, "formula")) {
        by <- model.frame(by, data, na.action = na.include)
        by <- apply(by, 1, paste, collapse = "/")
    }
    by <- as.character(by)
    levs <- unique(by)
    data$.drop <- by
    data.ret <- up(data, ~.drop)
    names(levs) <- levs
    ret <- lapply(levs, function(x) {
        try(getSummary(update(fit, data = data[by != x, ])))
    })
    ret <- lapply(ret, function(x) if (inherits(x, "try-error")) 
        NA
    else x)
    ret <- do.call(rbind, ret)
    disp(dim(ret))
    ret <- as.data.frame(ret)
    ret$.drop <- levs
    disp(dim(ret))
    disp(dim(data.ret))
    ret <- merge(data.ret, ret, by = ".drop")
  }

gmonette/spida15 documentation built on May 17, 2019, 7:26 a.m.