modeltools/ 0000755 0001762 0000144 00000000000 12211102241 012415 5 ustar ligges users modeltools/inst/ 0000755 0001762 0000144 00000000000 12211071523 013402 5 ustar ligges users modeltools/inst/NEWS 0000644 0001762 0000144 00000006610 12211071516 014106 0 ustar ligges users
CHANGES IN `modeltools' VERSION 0.2-21
o export ParseFormula
CHANGES IN `modeltools' VERSION 0.2-20
o fix NAMESPACE issues
CHANGES IN `modeltools' VERSION 0.2-19
o added model.matrix.survReg
CHANGES IN `modeltools' VERSION 0.2-17
o COPYING -> LICENSE
CHANGES IN `modeltools' VERSION 0.2-16
o inputs make be NULL (in complete.cases.*)
CHANGES IN `modeltools' VERSION 0.2-16
o new generic `relabel'
CHANGES IN `modeltools' VERSION 0.2-15
o `Predict' didn't pass ... to `predict'
o new generic and method `empty'
o the `show' method now prints the number of columns if a data
object has no colnames.
o renamed `cluster' to `clusters' to avoid conflict with `cluster'
from package survival
CHANGES IN `modeltools' VERSION 0.2-14
o `object' in `Predict(object)' might be an S4 object and $ can't be used.
CHANGES IN `modeltools' VERSION 0.2-13
o new generic Lapply
CHANGES IN `modeltools' VERSION 0.2-12
o fix Rd problems
CHANGES IN `modeltools' VERSION 0.2-11
o added argument newdata to generic cluster()
o LazyLoad: yes
CHANGES IN `modeltools' VERSION 0.2-10
o Added several generic functions: ICL, KLdiv, cluster, getModel, parameters,
posterior, prior, refit, info, infoCheck
o fix problems with evaluating subset arguments
CHANGES IN `modeltools' VERSION 0.2-9
o the following code didn't work
tmp <- function(formula, data = list(), subset = NULL)
ModelEnvFormula(formula, data, subset = subset, frame = parent.frame())
foo <- function(x, y, ...) tmp(y ~ x, ...)
a <- 1:10
b <- 1:10
stopifnot(identical(foo(a, b, subset = 1:5)@get("response")[[1]],1:5))
### was: couldn't find `y' when `frame' wasn't specified
x <- 1
y <- 2
stopifnot(identical(foo(a, b, subset = 1:5)@get("response")[[1]],1:5))
### was: found `x' and `y' in .GlobalEnv when `frame' wasn't specified
CHANGES IN `modeltools' VERSION 0.2-8
o ModelEnvFormula(y ~ 1) works now
o new function MEapply (only roughly documented, more to come)
CHANGES IN `modeltools' VERSION 0.2-7
o add methods and stats to Depends:
CHANGES IN `modeltools' VERSION 0.2-6
o fix codetools problems
CHANGES IN `modeltools' VERSION 0.2-5
o import(stats)
CHANGES IN `modeltools' VERSION 0.2-4
o add survReg objects as an interface to survival::survreg
CHANGES IN `modeltools' VERSION 0.2-3
o checkData does no longer insist that columns of a new data frame
are in the same order as in the original data frame.
o fxied a bug in the show() method for ModelEnv objects
o new ModelEnv creator function ModelEnvMatrix
o `linearModel@fit' now returns an object of class `linearModel'
o `glinearModel' object added
o S3 methods for (g)linearModel objects added (fitted, model.matrix, ...)
CHANGES IN `modeltools' VERSION 0.2-2
o remove special code for `Surv' objects in ParseFormula
CHANGES IN `modeltools' VERSION 0.2-0
o `Predict' checks for `StatModel' objects being available
o `linearModel@fit' now returns an object of class `statmodel_lm'
which inherits from `lm' and has its own `predict' method (in S3)
o prepare for CRAN submission
CHANGES IN `modeltools' VERSION 0.1-2
o `set' and `get' functions have an additional `envir' argument. This is
now used by `clone', for example.
o lmfit now returns a `lm' object with element `predict_response' for
computing predictions.
modeltools/tests/ 0000755 0001762 0000144 00000000000 12211071523 013567 5 ustar ligges users modeltools/tests/regtest.R 0000644 0001762 0000144 00000004754 11455333772 015421 0 ustar ligges users
library(modeltools)
d <- data.frame(x = rnorm(100), y = rnorm(100), z = runif(100))
d[["x"]][1:10] <- NA
a <- linearModel@dpp(y ~ x + z - 1, data = d, na.action = na.pass)
b <- na.omit(a)
mod1 <- linearModel@fit(b)
mod2 <- lm(y ~ x + z - 1, data = d)
nd <- data.frame(x = rnorm(100), z = runif(100))
stopifnot(identical(mod1$predict_response(nd), predict(mod2, newdata = nd)))
stopifnot(identical(coef(mod1), coef(mod2)))
u <- linearModel@fit
system.time(for (i in 1:100) mod1 <- u(b))
system.time(for (i in 1:100) mod2 <- lm(y ~ x + z - 1, data = d))
dn <- data.frame(x = rnorm(100), y = rnorm(100), z = runif(100))
all.equal(Predict(mod1, dn), Predict(mod2, dn))
system.time(for (i in 1:100) p1 <- Predict(mod1, dn))
system.time(for (i in 1:100) p2 <- Predict(mod2, dn))
system.time(for (i in 1:100) p1 <- predict(mod1, dn))
system.time(for (i in 1:100) p2 <- predict(mod2, dn))
### check bug fix: non-misssing `data' argument
df <- data.frame(y = 1:10, x = 1:10 + 1, z = 1:10 + 2)
mf <- ModelEnvFormula(y ~ x, data = df, other = list(part = ~ z))
stopifnot(isTRUE(all.equal(mf@get("part")$z, df[["z"]])))
df2 <- df + 1
stopifnot(isTRUE(all.equal(mf@get("part", data = df2)$z, df2[["z"]])))
### ~ 1
df <- data.frame(y = 1:10)
mf <- ModelEnvFormula(y ~ 1, data = df)
x <- mf@get("designMatrix")
stopifnot(nrow(x) == 10 && all(x[,1] == 1))
### bugfix: subset was not correctly interpreted in `frame'
tmp <- function(formula, data = list(), subset = NULL)
ModelEnvFormula(formula, data, subset = subset, frame = parent.frame())
foo <- function(x, y, subset, ...) tmp(y ~ x, subset = subset, ...)
a <- 1:10
b <- 1:10
stopifnot(identical(foo(a, b, subset = 1:5)@get("response")[[1]],1:5))
x <- 1
y <- 2
stopifnot(identical(foo(a, b, subset = 1:5)@get("response")[[1]],1:5))
### subset problems
menv <- ModelEnvFormula(Species ~ ., data = iris,
subset = (iris$Species != "virginica"))
stopifnot(nrow(menv@get("input")) == 100)
stopifnot(nrow(menv@get("input", data = iris)) == 150)
menv <- ModelEnvFormula(Species ~ ., data = iris,
subset = (iris$Species != "virginica"),
keep.subset = TRUE)
stopifnot(nrow(menv@get("input")) == 100)
stopifnot(nrow(menv@get("input", data = iris)) == 150)
###**********************************************************
stopifnot(!empty(menv))
menv1 <- new("ModelEnv")
stopifnot(empty(menv1))
### fixed in 0.2-17
dpp(linearModel, Sepal.Length ~ 1, data = iris, na.action = na.omit)
modeltools/NAMESPACE 0000644 0001762 0000144 00000001761 12211071314 013647 0 ustar ligges users import(methods)
import(stats)
import(stats4)
export(ModelEnvFormula, ModelEnvMatrix, linearModel, glinearModel,
survReg, Predict, ICL, KLdiv, Lapply, clusters, getModel,
parameters, posterior, prior, refit, info, infoCheck, relabel,
ParseFormula)
exportClasses("ModelEnv", "FormulaParts", "ModelEnvFormula", "StatModel",
"StatModelCapabilities")
exportMethods("subset", "show", "dimension", "clone", "has", "initialize",
"fit", "dpp", "na.omit", "na.fail", "na.pass", "subset",
"MEapply", "info", "empty", "relabel")
S3method(fitted, linearModel)
S3method(model.matrix, linearModel)
S3method(predict, linearModel)
S3method(print, linearModel)
S3method(weights, linearModel)
S3method(fitted, glinearModel)
S3method(model.matrix, glinearModel)
S3method(predict, glinearModel)
S3method(print, glinearModel)
S3method(fitted, survReg)
S3method(logLik, survReg)
S3method(print, survReg)
S3method(weights, survReg)
S3method(model.matrix, survReg)
modeltools/NEWS 0000644 0001762 0000144 00000006610 12211071516 013131 0 ustar ligges users
CHANGES IN `modeltools' VERSION 0.2-21
o export ParseFormula
CHANGES IN `modeltools' VERSION 0.2-20
o fix NAMESPACE issues
CHANGES IN `modeltools' VERSION 0.2-19
o added model.matrix.survReg
CHANGES IN `modeltools' VERSION 0.2-17
o COPYING -> LICENSE
CHANGES IN `modeltools' VERSION 0.2-16
o inputs make be NULL (in complete.cases.*)
CHANGES IN `modeltools' VERSION 0.2-16
o new generic `relabel'
CHANGES IN `modeltools' VERSION 0.2-15
o `Predict' didn't pass ... to `predict'
o new generic and method `empty'
o the `show' method now prints the number of columns if a data
object has no colnames.
o renamed `cluster' to `clusters' to avoid conflict with `cluster'
from package survival
CHANGES IN `modeltools' VERSION 0.2-14
o `object' in `Predict(object)' might be an S4 object and $ can't be used.
CHANGES IN `modeltools' VERSION 0.2-13
o new generic Lapply
CHANGES IN `modeltools' VERSION 0.2-12
o fix Rd problems
CHANGES IN `modeltools' VERSION 0.2-11
o added argument newdata to generic cluster()
o LazyLoad: yes
CHANGES IN `modeltools' VERSION 0.2-10
o Added several generic functions: ICL, KLdiv, cluster, getModel, parameters,
posterior, prior, refit, info, infoCheck
o fix problems with evaluating subset arguments
CHANGES IN `modeltools' VERSION 0.2-9
o the following code didn't work
tmp <- function(formula, data = list(), subset = NULL)
ModelEnvFormula(formula, data, subset = subset, frame = parent.frame())
foo <- function(x, y, ...) tmp(y ~ x, ...)
a <- 1:10
b <- 1:10
stopifnot(identical(foo(a, b, subset = 1:5)@get("response")[[1]],1:5))
### was: couldn't find `y' when `frame' wasn't specified
x <- 1
y <- 2
stopifnot(identical(foo(a, b, subset = 1:5)@get("response")[[1]],1:5))
### was: found `x' and `y' in .GlobalEnv when `frame' wasn't specified
CHANGES IN `modeltools' VERSION 0.2-8
o ModelEnvFormula(y ~ 1) works now
o new function MEapply (only roughly documented, more to come)
CHANGES IN `modeltools' VERSION 0.2-7
o add methods and stats to Depends:
CHANGES IN `modeltools' VERSION 0.2-6
o fix codetools problems
CHANGES IN `modeltools' VERSION 0.2-5
o import(stats)
CHANGES IN `modeltools' VERSION 0.2-4
o add survReg objects as an interface to survival::survreg
CHANGES IN `modeltools' VERSION 0.2-3
o checkData does no longer insist that columns of a new data frame
are in the same order as in the original data frame.
o fxied a bug in the show() method for ModelEnv objects
o new ModelEnv creator function ModelEnvMatrix
o `linearModel@fit' now returns an object of class `linearModel'
o `glinearModel' object added
o S3 methods for (g)linearModel objects added (fitted, model.matrix, ...)
CHANGES IN `modeltools' VERSION 0.2-2
o remove special code for `Surv' objects in ParseFormula
CHANGES IN `modeltools' VERSION 0.2-0
o `Predict' checks for `StatModel' objects being available
o `linearModel@fit' now returns an object of class `statmodel_lm'
which inherits from `lm' and has its own `predict' method (in S3)
o prepare for CRAN submission
CHANGES IN `modeltools' VERSION 0.1-2
o `set' and `get' functions have an additional `envir' argument. This is
now used by `clone', for example.
o lmfit now returns a `lm' object with element `predict_response' for
computing predictions.
modeltools/R/ 0000755 0001762 0000144 00000000000 12211071523 012626 5 ustar ligges users modeltools/R/Utilities.R 0000644 0001762 0000144 00000001414 11455333772 014744 0 ustar ligges users MEapply <- function(object, FUN, clone = TRUE, ...) standardGeneric(MEapply)
setMethod("MEapply", "ModelEnv",
function(object, FUN, clone = TRUE, ...)
{
## If we check here, we don't have to check for the existence
## of hook collections every time
if(is.null(FUN))
return(object)
z <- object
if (clone)
z <- clone(object, copydata = FALSE)
for (name in ls(object@env)){
if(is.list(FUN)){
if(name %in% names(FUN)){
assign(name,
FUN[[name]](object@get(name), ...),
envir = z@env)
}
} else {
assign(name,
FUN(object@get(name), ...),
envir = z@env)
}
}
return(z)
})
modeltools/R/Data.R 0000644 0001762 0000144 00000017215 11455333772 013650 0 ustar ligges users
### Parse and evaluate a formula, return the data as object of class
### `ModelEnv'
ModelEnvFormula <- function(formula, data = list(), subset = NULL,
na.action = NULL, frame = NULL,
enclos = sys.frame(sys.nframe()),
other = list(), designMatrix = TRUE,
responseMatrix = TRUE,
setHook = NULL, ...)
{
mf <- match.call(expand.dots = FALSE)
m <- match(c("formula", "data", "subset", "na.action"),
names(mf), 0)
mf <- mf[c(1, m)]
mf[[1]] <- as.name("model.frame")
### NA-handling will for the ModelFrame objects later on...
mf$na.action <- stats::na.pass
MEF <- new("ModelEnvFormula")
MEF@formula <- c(ParseFormula(formula, data=data)@formula, other)
MEF@hooks$set <- setHook
if (is.null(frame)) frame <- parent.frame()
mf$subset <- try(subset)
if (inherits(mf$subset, "try-error")) mf$subset <- NULL
MEF@get <- function(which, data=NULL, frame=parent.frame(), envir = MEF@env)
{
if(is.null(data))
RET <- get(which, envir = envir, inherits=FALSE)
else{
oldData <- get(which, envir = envir, inherits=FALSE)
if (!use.subset) mf$subset <- NULL
mf$data <- data
mf$formula <- MEF@formula[[which]]
RET <- eval(mf, frame, enclos = enclos)
checkData(oldData, RET)
}
return(RET)
}
MEF@set <- function(which = NULL, data = NULL, frame = parent.frame(),
envir = MEF@env)
{
if (is.null(which)) which <- names(MEF@formula)
if (any(duplicated(which)))
stop("Some model terms used more than once")
for (name in which){
if (length(MEF@formula[[name]]) != 2)
stop("Invalid formula for ", sQuote(name))
mf$data <- data
mf$formula <- MEF@formula[[name]]
if (!use.subset) mf$subset <- NULL
MF <- eval(mf, frame, enclos = enclos)
if (exists(name, envir = envir, inherits = FALSE))
checkData(get(name, envir = envir, inherits = FALSE), MF)
assign(name, MF, envir = envir)
mt <- attr(MF, "terms")
##
## maybe we don't want to save input and response
## in the cases below?
##
if (name == "input" && designMatrix) {
assign("designMatrix",
model.matrix(mt, data = MF, ...),
envir = envir)
}
if (name == "response" && responseMatrix) {
attr(mt, "intercept") <- 0
assign("responseMatrix",
model.matrix(mt, data=MF, ...),
envir = envir)
}
}
MEapply(MEF, MEF@hooks$set, clone=FALSE)
}
use.subset <- TRUE
MEF@set(which = NULL, data = data, frame = frame)
use.subset <- FALSE
### handle NA's
if (!is.null(na.action))
MEF <- na.action(MEF)
MEF
}
### compare basic properties of two data.frames
checkData <- function(old, new) {
if (!is.null(old)){
if(!all(names(old) %in% names(new)))
stop("New data must contain the same columns as the original data")
if (!identical(lapply(old, class), lapply(new[names(old)], class)))
stop("Classes of new data do not match original data")
if (!identical(lapply(old, levels), lapply(new[names(old)], levels)))
stop("Levels in factors of new data do not match original data")
}
}
### parse a formula and return the different pieces as `FormulaParts'
### object
ParseFormula <- function(formula, data = list()) {
formula <- terms(formula, data = data)
attributes(formula) <- NULL
if (length(formula) == 3) {
fresponse <- formula[c(1,2)]
frhs <- formula[c(1,3)]
### if (frhs[[2]] == "1") frhs <- NULL
}
if (length(formula) == 2) {
fresponse <- NULL
frhs <- formula
}
finput <- frhs
fblocks <- frhs
###
### will fail for `y ~ . | blocks' constructs
###
if (!is.null(frhs) && length(frhs[[2]]) > 1) {
if (deparse(frhs[[2]][[1]]) == "|") {
finput[[2]] <- frhs[[2]][[2]]
fblocks[[2]] <- frhs[[2]][[3]]
} else {
fblocks <- NULL
}
} else {
fblocks <- NULL
}
RET = new("FormulaParts")
RET@formula$response <- fresponse
RET@formula$input <- finput
RET@formula$blocks <- fblocks
return(RET)
}
###**********************************************************
## A simple model environment where designMatrix and responseMatrix
## are directly specified. Usefull for models without a formula
## interface. This is much more limited than ModelEnvFormula, but can
## be faster because no formula parsing is necessary. The subset
## argument needs to be a indexing vector into the design and response
## matrix, respectively. Funny things may happen if the matrices have
## no column names and the @[gs]et slots are used in combination with
## new data is proper handling of that case possible?
ModelEnvMatrix <- function(designMatrix=NULL, responseMatrix=NULL,
subset = NULL, na.action = NULL,
other=list(), ...)
{
MEM <- new("ModelEnv")
N <- max(nrow(designMatrix), nrow(responseMatrix))
if(is.null(subset) && N>0) subset <- 1:N
if(!is.null(designMatrix))
assign("designMatrix",
as.matrix(designMatrix)[subset,,drop=FALSE],
envir = MEM@env)
if(!is.null(responseMatrix))
assign("responseMatrix",
as.matrix(responseMatrix)[subset,,drop=FALSE],
envir = MEM@env)
for(n in names(other)){
if(is.matrix(other[[n]]))
assign(n,
other[[n]][subset,,drop=FALSE],
envir = MEM@env)
else
assign(n,
other[[n]][subset],
envir = MEM@env)
}
MEM@get <- function(which, data=NULL, frame=NULL, envir = MEM@env)
{
if(is.null(data))
RET <- get(which, envir = envir, inherits=FALSE)
else
{
if(is.null(colnames(data)))
colnames(data) <- createColnames(data)
oldNames <- colnames(get(which, envir = envir,
inherits=FALSE))
RET <- data[,oldNames,drop=FALSE]
}
return(RET)
}
MEM@set <- function(which = NULL, data = NULL, frame=NULL,
envir = MEM@env)
{
if(is.null(which))
which <- c("designMatrix", "responseMatrix")
if(is.null(data))
stop("No data specified")
if (any(duplicated(which)))
stop("Some model terms used more than once")
if(is.null(colnames(data)))
colnames(data) <- createColnames(data)
for (name in which){
oldNames <- colnames(get(name, envir = envir,
inherits=FALSE))
assign(name, as.matrix(data[,oldNames,drop=FALSE]),
envir = envir)
}
}
## handle NA's
if (!is.null(na.action))
MEM <- na.action(MEM)
MEM
}
## Make sure that every matrix has column names
createColnames <- function(data)
{
paste("V",1:ncol(data),sep=".")
}
modeltools/R/linearModel.R 0000644 0001762 0000144 00000004737 11455333772 015237 0 ustar ligges users
### an example for an unfitted statistical model: linear model
lmfit <- function(object, weights = NULL, ...){
### extract design and response matrix from the `ModelEnv' object
### and call the usual fit methods
if (is.null(weights)) {
z <- lm.fit(object@get("designMatrix"),
object@get("responseMatrix"),
...)
} else {
z <- lm.wfit(object@get("designMatrix"),
object@get("responseMatrix"), weights, ...)
}
### returns a model inheriting from `mlm' or / and `lm'
class(z) <- c("linearModel", if (is.matrix(z$fitted)) "mlm", "lm")
z$offset <- 0
z$contrasts <- attr(object@get("designMatrix"), "contrasts")
z$xlevels <- attr(object@get("designMatrix"), "xlevels")
z$terms <- attr(object@get("input"), "terms")
### predict.lm will fails since we cannot provide
### correct $call and $terms elements.
z$predict_response <- function(newdata = NULL) {
if (!is.null(newdata)) {
penv <- new.env()
object@set("input", data = newdata, env = penv)
dm <- get("designMatrix", envir = penv, inherits = FALSE)
} else {
dm <- object@get("designMatrix")
}
pr <- dm %*% coef(z)
if (ncol(pr) == 1) pr <- drop(pr)
return(pr)
}
z$addargs <- list(...)
z$ModelEnv <- object
z$statmodel <- linearModel
z
}
### an object of class `StatModel' representing unfitted linear models
linearModel <- new("StatModel",
capabilities = new("StatModelCapabilities"),
name = "linear regression model",
dpp = ModelEnvFormula,
fit = lmfit,
predict = function(object, newdata = NULL, ...)
#### simply call the predict_response element
object$predict_response(newdata = newdata)
)
### we would like to advocate `Predict', but anyway
predict.linearModel <- function(object, newdata = NULL, ...)
linearModel@predict(object, newdata = newdata)
fitted.linearModel <- function(object, ...)
object$predict_response()
weights.linearModel <- function(object, ...) {
if(is.null(object$weights)) rep(1, NROW(object$residuals)) else object$weights
}
print.linearModel <- function(x, digits = max(3, getOption("digits") - 3), ...)
{
cat("Linear model with coefficients:\n")
print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE)
invisible(x)
}
model.matrix.linearModel <- function(object, ...)
object$ModelEnv@get("designMatrix")
modeltools/R/glinearModel.R 0000644 0001762 0000144 00000004311 11455333772 015372 0 ustar ligges users glinearModel <- new("StatModel",
capabilities = new("StatModelCapabilities"),
name = "generalized linear regression model",
dpp = ModelEnvFormula,
fit = function(object, weights = NULL, ...){
if (is.null(weights)) {
z <- glm.fit(x = object@get("designMatrix"),
y = object@get("response")[,1],
intercept = all(object@get("designMatrix")[,1] == 1),
...)
} else {
z <- glm.fit(x = object@get("designMatrix"),
y = object@get("response")[,1],
weights = weights,
intercept = all(object@get("designMatrix")[,1] == 1),
...)
}
class(z) <- c("glinearModel", "glm", "lm")
z$offset <- 0
z$contrasts <- attr(object@get("designMatrix"), "contrasts")
## terms should be there, but still need to
## be worked around in predictions
z$terms <- attr(object@get("input"), "terms")
z$predict_response <- function(newdata = NULL) {
if (!is.null(newdata)) {
penv <- new.env()
object@set("input", data = newdata, env = penv)
dm <- get("designMatrix", envir = penv, inherits = FALSE)
} else {
dm <- object@get("designMatrix")
}
pr <- z$family$linkinv(drop(dm %*% z$coef))
return(pr)
}
z$addargs <- list(...)
z$ModelEnv <- object
z
},
predict = function(object, newdata = NULL, ...)
object$predict_response(newdata = newdata)
)
predict.glinearModel <- function(object, newdata = NULL, ...)
object$predict_response(newdata = newdata)
fitted.glinearModel <- function(object, ...)
object$predict_response()
print.glinearModel <- function(x, digits = max(3, getOption("digits") - 3), ...)
{
fam <- x$family$family
substr(fam, 1, 1) <- toupper(substr(fam, 1, 1))
cat(paste(fam, "GLM with coefficients:\n"))
print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE)
invisible(x)
}
model.matrix.glinearModel <- function(object, ...)
object$ModelEnv@get("designMatrix")
modeltools/R/NAhandling.R 0000644 0001762 0000144 00000001465 11455333772 015002 0 ustar ligges users
### NA handling for objects of class `ModelEnv'
complete.cases.ModelEnv <- function(x) {
do.call("complete.cases", as.data.frame(lapply(ls(x@env), function(o) x@get(o))))
}
# setGeneric("na.fail", useAsDefault = na.fail)
setMethod("na.fail", signature = "ModelEnv", definition = function(object, ...) {
cc <- complete.cases.ModelEnv(object)
if (!all(cc)) return(FALSE)
return(object)
})
# setGeneric("na.pass", useAsDefault = na.pass)
setMethod("na.pass", signature = "ModelEnv", definition = function(object, ...) {
return(object)
})
# setGeneric("na.omit", useAsDefault = na.omit)
setMethod("na.omit", signature = "ModelEnv", definition = function(object, ...) {
cc <- complete.cases.ModelEnv(object)
if (!all(cc)) return(subset(object, cc, ...))
return(object)
})
modeltools/R/survReg.R 0000644 0001762 0000144 00000003012 11712020131 014374 0 ustar ligges users survReg <- new("StatModel",
capabilities = new("StatModelCapabilities"),
name = "survival regression",
dpp = ModelEnvFormula,
fit = function(object, weights = NULL, ...){
mydata <- cbind(object@get("response"), object@get("input"))
names(mydata)[[1]] <- "y"
if (!is.null(weights)) {
mydata <- mydata[weights > 0, ]
weights <- weights[weights > 0]
}
RET <- survreg(y ~ ., data = mydata, weights = weights, ...)
RET$addargs <- list(...)
RET$ModelEnv <- object
RET$weights <- weights
class(RET) <- c("survReg", "survreg")
RET
}
)
fitted.survReg <- function(object, ...) predict(object)
weights.survReg <- function(object, ...) {
if(is.null(object$weights)) rep(1, NROW(residuals(object))) else object$weights
}
print.survReg <- function(x, digits = max(3, getOption("digits") - 3), ...)
{
dist <- x$dist
substr(dist, 1, 1) <- toupper(substr(dist, 1, 1))
cat(paste(dist, "survival regression",
paste("(scale = ", paste(format(x$scale, digits = digits), sep = ", "), ")", sep = ""),
"with coefficients:\n"))
print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE)
invisible(x)
}
logLik.survReg <- function(object, ...) {
structure(object$loglik[2], df = NCOL(object$var), class = "logLik")
}
model.matrix.survReg <- function(object, data, ...) {
if(missing(data)) return(model.matrix(object, model.frame(object), ...))
NextMethod()
}
modeltools/R/Methods.R 0000644 0001762 0000144 00000012700 11455333772 014374 0 ustar ligges users
### Definition and construction method for class `ModelEnv'
setMethod("initialize", signature = "ModelEnv",
definition = function(.Object) {
### a new environment: all data are stored here
.Object@env <- new.env()
### extract a variable names `which' from the environment
.Object@get <-
function(which) get(which, envir = .Object@env,
inherits = FALSE)
### set a variable
.Object@set <-
function(which, data) assign(which, data, .Object@env)
return(.Object)
}
)
### some utility methods for ModelEnv onjects
setMethod("show", signature = "ModelEnv",
definition = function(object) {
cat("\n")
cat("A", class(object), "with \n\n")
n <- NULL
if (has(object, "response")) {
cat(" response variable(s): ",
colnamesnum(object@get("response")), "\n")
n <- nrow(object@get("response"))
}
else if (has(object, "responseMatrix")) {
cat(" response matrix column(s): ",
colnamesnum(object@get("responseMatrix")), "\n")
n <- nrow(object@get("responseMatrix"))
}
if (has(object, "input")) {
cat(" input variable(s): ",
colnamesnum(object@get("input")), "\n")
n <- nrow(object@get("input"))
}
else if (has(object, "designMatrix")) {
cat(" design matrix column(s): ",
colnamesnum(object@get("designMatrix")), "\n")
n <- nrow(object@get("designMatrix"))
}
if (is.null(n))
cat(" no observations\n")
else
cat(" number of observations:", n, "\n")
if(length(object@hooks)>0){
for(n in 1:length(object@hooks)){
if(n==1)
cat(" hooks : ")
else
cat(" ")
cat(paste(names(object@hooks)[n],"(",
paste(names(object@hooks[[n]]), collapse=", "),
")", sep=""), "\n")
}
}
cat("\n")
})
## Utility function: return either names or number of columns
colnamesnum <- function(x)
{
if(is.null(colnames(x)))
return(ncol(x))
else
return(colnames(x))
}
setGeneric("has", function(object, which) standardGeneric("has"))
setMethod("has", signature(object = "ModelEnv", which = "character"),
definition = function(object, which) {
exists(which, envir = object@env, inherits = FALSE)
}
)
setGeneric("dimension", function(object, which) standardGeneric("dimension"))
setMethod("dimension", signature(object = "ModelEnv", which = "character"),
definition = function(object, which) {
if (has(object, which))
eval(parse(text = paste("dim(",which,")")) , envir = object@env)
else
NULL
}
)
setGeneric("empty", function(object) standardGeneric("empty"))
setMethod("empty", signature(object = "ModelEnv"),
definition = function(object) length(ls(object@env))==0)
###**********************************************************
setGeneric("clone", function(object, ...) standardGeneric("clone"))
## the set() method of ModelEnvFormula objects uses lexical scope on
## various bits and pieces, hence cloning currently returns only a
## ModelEnv object, which only has a trivial get method and no set
## method
setMethod("clone", signature = "ModelEnv",
definition = function(object, copydata = TRUE) {
z <- new(class(object))
if (extends(class(object), "ModelEnvFormula"))
z@formula <- object@formula
### call set and get from object, however, they work in z@env
### what about parent.frame() ???
z@set <- function(which = NULL, data = NULL, frame = parent.frame(),
envir = z@env)
object@set(which = which, data = data, frame = frame, env = envir)
z@get <- function(which, data = NULL, frame = parent.frame(),
envir = z@env)
object@get(which = which, data = data, frame = frame, env = envir)
###
if (copydata) {
for (name in ls(object@env))
assign(name, object@get(name), envir = z@env)
}
return(z)
})
setGeneric("subset", function(x, ...) standardGeneric("subset"))
setMethod("subset", signature = "ModelEnv",
definition = function(x, subset, clone = TRUE, ...)
{
MYSUBSET <- function(x, subset, ...){
if (is(x, "matrix"))
x[subset,,drop=FALSE]
else
subset(x, subset, ...)
}
z <- MEapply(x, MYSUBSET, clone=clone, subset=subset, ...)
if (!clone)
invisible(z)
else
return(z)
})
### dpp, fit and predict generics for StatModel objects
setGeneric("fit", function(model, data, ...) standardGeneric("fit"))
setMethod("fit", signature = signature(model = "StatModel",
data = "ModelEnv"),
definition = function(model, data, ...)
model@fit(data, ...)
)
setGeneric("dpp", function(model, ...) standardGeneric("dpp"))
setMethod("dpp", signature = "StatModel",
definition = function(model, ...)
model@dpp(...)
)
### don't want to redefine stats:::predict, but ...
Predict <- function(object, ...) {
if ("statmodel" %in% names(object)) {
if (is(object$statmodel, "StatModel"))
return(object$statmodel@predict(object, ...))
}
return(predict(object, ...))
}
modeltools/R/Generics.R 0000644 0001762 0000144 00000002545 11455333772 014536 0 ustar ligges users #
# Copyright (C) 2006 Torsten Hothorn, Friedrich Leisch
# $Id: Generics.R 4119 2008-09-22 14:49:39Z leisch $
#
## generics used in flexmix and flexclust which may also be useful in
## other packages
setGeneric("ICL", function(object, ...) standardGeneric("ICL"))
setGeneric("KLdiv", function(object, ...) standardGeneric("KLdiv"))
setGeneric("Lapply", function(object, FUN, ...) standardGeneric("Lapply"))
setGeneric("clusters", function(object, newdata, ...) standardGeneric("clusters"))
setGeneric("getModel", function(object, ...) standardGeneric("getModel"))
setGeneric("parameters", function(object, ...) standardGeneric("parameters"))
setGeneric("posterior", function(object, newdata, ...) standardGeneric("posterior"))
setGeneric("prior", function(object, ...) standardGeneric("prior"))
setGeneric("refit", function(object, newdata, ...) standardGeneric("refit"))
setGeneric("relabel", function(object, by, ...) standardGeneric("relabel"))
###**********************************************************
setGeneric("info",
function(object, which, ...) standardGeneric("info"))
setMethod("info", signature(object="ANY", which="missing"),
function(object, which, ...)
{
info(object, which="help")
})
infoCheck <- function(object, which, ...)
{
which %in% info(object, "help")
}
###**********************************************************
modeltools/R/Classes.R 0000644 0001762 0000144 00000001515 11455333772 014370 0 ustar ligges users
### a class for model environments
setClass("ModelEnv",
representation(
env = "environment",
get = "function",
set = "function",
hooks = "list"))
### a class for formulae
setClass("FormulaParts",
representation(
formula = "list"
)
)
### model environments given by formulae
setClass("ModelEnvFormula", contains = c("ModelEnv", "FormulaParts"))
### A prototype for a model class in R
setClass("StatModelCapabilities",
representation(
weights = "logical",
subset = "logical"),
prototype(weights = TRUE, subset = TRUE)
)
setClass("StatModel",
representation(
name = "character",
dpp = "function",
fit = "function",
predict = "function",
capabilities = "StatModelCapabilities")
)
modeltools/MD5 0000644 0001762 0000144 00000002427 12211102241 012732 0 ustar ligges users b112f91f32decd4204d8f3bca44b82bd *DESCRIPTION
932ac81bb8847a7866a13da3edfa7a14 *NAMESPACE
9bf74ec5f562e66c954e760ab6885602 *NEWS
99b6734440cad39e56ed14ac4c740bcb *R/Classes.R
1ca1ffcc984e93b3185efb2ad615ce27 *R/Data.R
e21d9a9d062e718657469b6b4ad865e1 *R/Generics.R
335e1e4f95fda622bb9905754bd61484 *R/Methods.R
867eb2b17e1d6558776cb81de5244e97 *R/NAhandling.R
a9ac8e736c398ebe21044c42453bc989 *R/Utilities.R
c084f8e5901f15a9fc11c6c7ca87c8ce *R/glinearModel.R
051a4e63b878135c7f45b88b3d9025f3 *R/linearModel.R
9786af07523e99459be0da9ab9eb9e04 *R/survReg.R
2f72294636aa061155691040fbb7a44c *cleanup
9bf74ec5f562e66c954e760ab6885602 *inst/NEWS
7ba7a41bd50d0f5d6e7559b32e2b19f7 *man/FormulaParts-class.Rd
348dd81908fcd2c1911055c32e3e9b7b *man/Generics.Rd
8ce916220d99450f2e5aafca06213229 *man/MEapply.Rd
d7a43273ab9d5a4c431aa527d82655d1 *man/ModelEnv-class.Rd
a99f8f3bf0102b4892abaf38a1ca39aa *man/ModelEnvFormula-class.Rd
e3b4967a5a7d08e9ad4547f6c3203cd6 *man/ModelEnvFormula.Rd
f02f9cd4e6dde9d109e2ce2e889c3ee7 *man/ModelEnvMatrix.Rd
79350daf144623693ae87d067c3367ad *man/Predict.Rd
d450b33ccdd37a00c3bd5c94f825b6ec *man/StatModel-class.Rd
621929155df3769f53f49d01979453cf *man/StatModelCapabilities-class.Rd
6a9e660b7eb99c578e668b9137cf9ed4 *man/info.Rd
159531167804a69a155cf7cc20f311ac *tests/regtest.R
modeltools/DESCRIPTION 0000644 0001762 0000144 00000001473 12211102241 014130 0 ustar ligges users Package: modeltools
Title: Tools and Classes for Statistical Models
Date: 2013-09-02
Version: 0.2-21
Author: Torsten Hothorn, Friedrich Leisch, Achim Zeileis
Maintainer: Torsten Hothorn
Description: A collection of tools to deal with statistical models.
The functionality is experimental and the user interface is likely to
change in the future. The documentation is rather terse, but packages `coin'
and `party' have some working examples. However, if you find the
implemented ideas interesting we would be very interested in a discussion
of this proposal. Contributions are more than welcome!
Depends: stats, stats4
Imports: methods
LazyLoad: yes
License: GPL-2
Packaged: 2013-09-02 11:15:31 UTC; hothorn
NeedsCompilation: no
Repository: CRAN
Date/Publication: 2013-09-02 14:29:21
modeltools/man/ 0000755 0001762 0000144 00000000000 12211071523 013200 5 ustar ligges users modeltools/man/Predict.Rd 0000644 0001762 0000144 00000001402 11455333772 015076 0 ustar ligges users \name{Predict}
\alias{Predict}
\title{ Model Predictions }
\description{
A function for predictions from the results of various model
fitting functions.
}
\usage{
Predict(object, ...)
}
\arguments{
\item{object}{ a model object for which prediction is desired. }
\item{\dots}{ additional arguments affecting the predictions produced. }
}
\details{
A somewhat improved version of \code{\link[stats]{predict}} for models
fitted with objects of class \code{\link{StatModel-class}}.
}
\value{
Should return a vector of the same type as the response variable specified
for fitting \code{object}.
}
\examples{
df <- data.frame(x = runif(10), y = rnorm(10))
mf <- dpp(linearModel, y ~ x, data = df)
Predict(fit(linearModel, mf))
}
\keyword{misc}
modeltools/man/FormulaParts-class.Rd 0000644 0001762 0000144 00000000726 11455333772 017236 0 ustar ligges users \name{FormulaParts-class}
\docType{class}
\alias{FormulaParts-class}
\title{Class "FormulaParts"}
\description{A class describing the parts of a formula.}
\section{Objects from the Class}{
Objects can be created by calls of the form \code{new("FormulaParts", ...)}.
}
\section{Slots}{
\describe{
\item{\code{formula}:}{Object of class \code{"list"}.}
}
}
\section{Methods}{
No methods defined with class "FormulaParts" in the signature.
}
\keyword{classes}
modeltools/man/ModelEnvFormula.Rd 0000644 0001762 0000144 00000006646 11455333772 016562 0 ustar ligges users \name{ModelEnvFormula}
\alias{ModelEnvFormula}
\title{ Generate a model environment from a
classical formula based interface. }
\description{
A flexible implementation of the classical formula based interface.
}
\usage{
ModelEnvFormula(formula, data = list(), subset = NULL,
na.action = NULL, frame = NULL,
enclos = sys.frame(sys.nframe()), other = list(),
designMatrix = TRUE, responseMatrix = TRUE,
setHook = NULL, ...)
}
\arguments{
\item{formula}{ a symbolic description of the model to be fit. }
\item{data}{ an optional data frame containing the variables in the model.
If not found in \code{data}, the variables are taken from
\code{frame}, by default the environment from which
\code{ModelEnvFormula} is called.}
\item{subset}{ an optional vector specifying a subset of observations to
be used in the fitting process. }
\item{na.action}{ a function which indicates what should happen when the data
contain \code{NA}'s. }
\item{frame}{ an optional environment \code{formula} is evaluated in. }
\item{enclos}{ specifies the enclosure passed to \code{\link{eval}} for
evaluating the model frame. The model frame is evaluated in
\code{envir = frame} with \code{enclos = enclos},
see \code{\link{eval}}.}
\item{other}{ an optional named list of additional formulae. }
\item{designMatrix}{ a logical indicating whether the design matrix
defined by the right hand side of \code{formula}
should be computed. }
\item{responseMatrix}{ a logical indicating whether the design matrix
defined by the left hand side of \code{formula}
should be computed. }
\item{setHook}{ a list of functions to \code{\link{MEapply}} every
time \code{set} is called on the object. }
\item{\dots}{ additional arguments for be passed to function, for example
\code{contrast.arg} to \code{\link{model.matrix}}. }
}
\details{
This function is an attempt to provide a flexible infrastucture for the
implementation of classical formula based interfaces. The arguments
\code{formula}, \code{data}, \code{subset} and \code{na.action} are well
known and are defined in the same way as in \code{\link{lm}}, for example.
\code{ModelEnvFormula} returns an object of class
\code{\link{ModelEnvFormula-class}} - a high level object for storing
data improving upon the capabilities of \code{data.frame}s.
}
\value{
An object of class \code{\link{ModelEnvFormula-class}}.
}
\examples{
### the `usual' interface
data(iris)
mf <- ModelEnvFormula(Species ~ ., data = iris)
mf
### extract data from the ModelEnv object
summary(mf@get("response"))
summary(mf@get("input"))
dim(mf@get("designMatrix"))
### contrasts
mf <- ModelEnvFormula(Petal.Width ~ Species, data = iris,
contrasts.arg = list(Species = contr.treatment))
attr(mf@get("designMatrix"), "contrasts")
mf <- ModelEnvFormula(Petal.Width ~ Species, data = iris,
contrasts.arg = list(Species = contr.sum))
attr(mf@get("designMatrix"), "contrasts")
### additional formulae
mf <- ModelEnvFormula(Petal.Width ~ Species, data = iris,
other = list(pl = ~ Petal.Length))
ls(mf@env)
identical(mf@get("pl")[[1]], iris[["Petal.Length"]])
}
\keyword{misc}
modeltools/man/StatModelCapabilities-class.Rd 0000644 0001762 0000144 00000001115 11455333772 021016 0 ustar ligges users \name{StatModelCapabilities-class}
\docType{class}
\alias{StatModelCapabilities-class}
\title{Class "StatModelCapabilities" }
\description{ A class describing capabilities of a statistical model. }
\section{Objects from the Class}{
Objects can be created by calls of the form \code{new("StatModelCapabilities", ...)}.
}
\section{Slots}{
\describe{
\item{\code{weights}:}{Object of class \code{"logical"}}
\item{\code{subset}:}{Object of class \code{"logical"}}
}
}
\section{Methods}{
No methods defined with class "StatModelCapabilities" in the signature.
}
\keyword{classes}
modeltools/man/StatModel-class.Rd 0000644 0001762 0000144 00000005550 11455333772 016513 0 ustar ligges users \name{StatModel-class}
\docType{class}
\alias{StatModel-class}
\alias{fit,StatModel,ModelEnv-method}
\alias{fit}
\alias{dpp,StatModel-method}
\alias{dpp}
\alias{linearModel}
\alias{predict.linearModel}
\alias{fitted.linearModel}
\alias{print.linearModel}
\alias{weights.linearModel}
\alias{model.matrix.linearModel}
\alias{glinearModel}
\alias{predict.glinearModel}
\alias{fitted.glinearModel}
\alias{print.glinearModel}
\alias{model.matrix.glinearModel}
\alias{survReg}
\alias{fitted.survReg}
\alias{logLik.survReg}
\alias{print.survReg}
\alias{weights.survReg}
\title{Class "StatModel"}
\description{ A class for unfitted statistical models. }
\section{Objects from the Class}{
Objects can be created by calls of the form \code{new("StatModel", ...)}.
}
\section{Slots}{
\describe{
\item{\code{name}:}{Object of class \code{"character"}, the name of the
model.}
\item{\code{dpp}:}{Object of class \code{"function"}, a function for
data preprocessing (usually formula-based). }
\item{\code{fit}:}{Object of class \code{"function"}, a function for
fitting the model to data.}
\item{\code{predict}:}{Object of class \code{"function"}, a function for
computing predictions.}
\item{\code{capabilities}:}{Object of class
\code{"StatModelCapabilities"}.}
}
}
\section{Methods}{
\describe{
\item{fit}{\code{signature(model = "StatModel", data = "ModelEnv")}:
fit \code{model} to \code{data}.}
}
}
\section{Details}{
This is an attempt to provide unified infra-structure for unfitted
statistical models. Basically, an unfitted model provides a function for
data pre-processing (\code{dpp}, think of generating design matrices),
a function for fitting the specified model to data (\code{fit}), and
a function for computing predictions (\code{predict}).
Examples for such unfitted models are provided by \code{linearModel} and
\code{glinearModel} which provide interfaces in the \code{"StatModel"} framework
to \code{\link[stats]{lm.fit}} and \code{\link[stats]{glm.fit}}, respectively. The functions
return objects of S3 class \code{"linearModel"} (inheriting from \code{"lm"}) and
\code{"glinearModel"} (inheriting from \code{"glm"}), respectively. Some
methods for S3 generics such as \code{predict}, \code{fitted}, \code{print}
and \code{model.matrix} are provided to make use of the \code{"StatModel"}
structure. (Similarly, \code{survReg} provides an experimental interface to
\code{\link[survival]{survreg}}.)
}
\examples{
### linear model example
df <- data.frame(x = runif(10), y = rnorm(10))
mf <- dpp(linearModel, y ~ x, data = df)
mylm <- fit(linearModel, mf)
### equivalent
print(mylm)
lm(y ~ x, data = df)
### predictions
Predict(mylm, newdata = data.frame(x = runif(10)))
}
\keyword{classes}
modeltools/man/MEapply.Rd 0000644 0001762 0000144 00000001612 11455333772 015056 0 ustar ligges users \name{MEapply}
\alias{MEapply,ModelEnv-method}
\alias{MEapply}
\title{Apply functions to Data in Object of Class "ModelEnv"}
\description{Apply a single function or a collection of functions to the
data objects stored in a model environment.}
\usage{
\S4method{MEapply}{ModelEnv}(object, FUN, clone = TRUE, ...)
}
\arguments{
\item{object}{Object of class \code{"ModelEnv"}.}
\item{FUN}{Function or list of functions.}
\item{clone}{If \code{TRUE}, return a clone of the original object, if
\code{FALSE}, modify the object itself.}
\item{\dots}{Passed on to \code{FUN}.}
}
\examples{
data("iris")
me <- ModelEnvFormula(Species+Petal.Width~.-1, data=iris,
subset=sample(1:150, 10))
me1 <- MEapply(me, FUN=list(designMatrix=scale,
response=function(x) sapply(x, as.numeric)))
me@get("designMatrix")
me1@get("designMatrix")
}
\keyword{methods}
modeltools/man/ModelEnvMatrix.Rd 0000644 0001762 0000144 00000004003 11455333772 016402 0 ustar ligges users \name{ModelEnvMatrix}
\alias{ModelEnvMatrix}
\title{Generate a model environment from design and response matrix}
\description{
A simple model environment creator function working off matrices for
input and response. This is much simpler and more limited than
formula-based environments, but faster and easier to use, if only
matrices are allowed as input.
}
\usage{
ModelEnvMatrix(designMatrix=NULL, responseMatrix=NULL,
subset = NULL, na.action = NULL, other=list(), ...)
}
\arguments{
\item{designMatrix}{design matrix of input}
\item{responseMatrix}{matrix of responses}
\item{subset}{ an optional vector specifying a subset of observations to
be used in the fitting process. }
\item{na.action}{ a function which indicates what should happen when the data
contain \code{NA}'s. }
\item{other}{ an optional named list of additional formulae. }
\item{\dots}{currently not used}
}
\details{
\code{ModelEnvMatrix} returns an object of class
\code{\link{ModelEnv-class}} - a high level object for storing
data improving upon the capabilities of simple data matrices.
Funny things may happen if the inpiut and response matrices do not have
distinct column names and the data new data are supplied via the
\code{get} and \code{set} slots.
}
\value{
An object of class \code{\link{ModelEnv-class}}.
}
\examples{
### use Sepal measurements as input and Petal as response
data(iris)
me <- ModelEnvMatrix(iris[,1:2], iris[,3:4])
me
### extract data from the ModelEnv object
dim(me@get("designMatrix"))
summary(me@get("responseMatrix"))
### subsets and missing values
iris[1,1] <- NA
me <- ModelEnvMatrix(iris[,1:2], iris[,3:4], subset=1:5, na.action=na.omit)
## First case is not complete, so me contains only cases 2:5
me
me@get("designMatrix")
me@get("responseMatrix")
## use different cases
me@set(data=iris[10:20,])
me@get("designMatrix")
## these two should be the same
stopifnot(all.equal(me@get("responseMatrix"), as.matrix(iris[10:20,3:4])))
}
\keyword{misc}
modeltools/man/info.Rd 0000644 0001762 0000144 00000001551 11455333772 014444 0 ustar ligges users %
% Copyright (C) 2005 Friedrich Leisch
% $Id: info.Rd 1849 2005-10-10 06:15:57Z leisch $
%
\name{info}
\alias{info}
\alias{infoCheck}
\alias{info,ANY,missing-method}
\title{Get Information on Fitted Objects}
\description{
Returns descriptive information about fitted objects.
}
\usage{
info(object, which, ...)
\S4method{info}{ANY,missing}(object, which, ...)
infoCheck(object, which, ...)
}
\arguments{
\item{object}{fitted object.}
\item{which}{which information to get. Use \code{which="help"} to list
available information.}
\item{\dots}{passed to methods.}
}
\details{
Function \code{info} can be used to access slots of fitted
objects in a portable way.
Function \code{infoCheck} returns a logical value that is \code{TRUE}
if the requested information can be computed from the \code{object}.
}
\author{Friedrich Leisch}
\keyword{methods}
modeltools/man/Generics.Rd 0000644 0001762 0000144 00000003744 12211071463 015241 0 ustar ligges users \name{Generics}
\alias{ICL}
\alias{KLdiv}
\alias{Lapply}
\alias{clusters}
\alias{getModel}
\alias{parameters}
\alias{posterior}
\alias{prior}
\alias{refit}
\alias{relabel}
\alias{ParseFormula}
\title{Generic Utility Functions}
\description{
A collection of standard generic functions for which other packages
provide methods.
}
\usage{
ICL(object, \dots)
KLdiv(object, \dots)
Lapply(object, FUN, \dots)
clusters(object, newdata, \dots)
getModel(object, \dots)
parameters(object, \dots)
posterior(object, newdata, \dots)
prior(object, \dots)
refit(object, newdata, \dots)
relabel(object, by, \dots)
ParseFormula(formula, data = list())
}
\arguments{
\item{object}{S4 classed object.}
\item{formula}{A model formula.}
\item{data}{An optional data frame.}
\item{FUN}{The function to be applied.}
\item{newdata}{Optional new data.}
\item{by}{Typically a character string specifying how to relabel the object.}
\item{\dots}{Some methods for these generic function may take
additional, optional arguments.}
}
\details{
\describe{
\item{ICL:}{Integrated Completed Likelihood criterion for model
selection.}
\item{KLdiv:}{Kullback-Leibler divergence.}
\item{Lapply:}{S4 generic for \code{lapply}}
\item{clusters:}{Get cluster membership information from a model or
compute it for new data.}
\item{getModel:}{Get single model from a collection of models.}
\item{parameters:}{Get parameters of a model (similar to but more
general than \code{\link{coefficients}}).}
\item{posterior:}{Get posterior probabilities from a model or
compute posteriors for new data.}
\item{prior:}{Get prior probabilities from a model.}
\item{refit:}{Refit a model (usually to obtain additional
information that was not computed or stored during the initial
fitting process).}
\item{relabel:}{Relabel a model (usually to obtain a new permutation
of labels in mixture models or cluster objects).}
}
}
\keyword{methods}
\author{Friedrich Leisch}
modeltools/man/ModelEnv-class.Rd 0000644 0001762 0000144 00000006301 11455333772 016323 0 ustar ligges users \name{ModelEnv-class}
\docType{class}
\alias{ModelEnv-class}
\alias{clone}
\alias{clone,ModelEnv-method}
\alias{dimension}
\alias{dimension,ModelEnv,character-method}
\alias{empty}
\alias{empty,ModelEnv-method}
\alias{has}
\alias{has,ModelEnv,character-method}
\alias{initialize,ModelEnv-method}
\alias{show,ModelEnv-method}
\alias{subset,ModelEnv-method}
\alias{subset}
\alias{na.pass,ModelEnv-method}
\alias{na.pass}
\alias{na.fail,ModelEnv-method}
\alias{na.fail}
\alias{na.omit,ModelEnv-method}
\alias{na.omit}
\title{Class "ModelEnv"}
\description{ A class for model environments.}
\section{Objects from the Class}{
Objects can be created by calls of the form \code{new("ModelEnv", ...)}.
}
\section{Slots}{
\describe{
\item{\code{env}:}{Object of class \code{"environment"}.}
\item{\code{get}:}{Object of class \code{"function"} for extracting
objects from environment \code{env}.}
\item{\code{set}:}{Object of class \code{"function"} for setting
object in environment \code{env}.}
\item{\code{hooks}:}{A list of hook collections.}
}
}
\section{Methods}{
\describe{
\item{clone}{\code{signature(object = "ModelEnv")}: copy an object. }
\item{dimension}{\code{signature(object = "ModelEnv", which = "character")}:
get the dimension of an object. }
\item{empty}{\code{signature(object = "ModelEnv")}: Return
\code{TRUE}, if the model environment contains no data.}
\item{has}{\code{signature(object = "ModelEnv", which = "character")}:
check if an object \code{which} is available in \code{env}. }
\item{initialize}{\code{signature(.Object = "ModelEnv")}: setup new
objects.}
\item{show}{\code{signature(object = "ModelEnv")}: show object. }
\item{subset}{\code{signature(x = "ModelEnv")}: extract subsets from an
object. }
\item{na.pass}{\code{\link{na.action}} method for \code{ModelEnv} objects.}
\item{na.fail}{\code{\link{na.action}} method for \code{ModelEnv} objects.}
\item{na.omit}{\code{\link{na.action}} method for \code{ModelEnv} objects.}
}
}
\details{
Objects of class \code{ModelEnv} basically consist of an
\code{\link{environment}} for data storage as well as \code{get} and
\code{set} methods.
\code{na.fail} returns \code{FALSE} when at least one missing value occurs
in \code{object@env}. \code{na.pass} returns \code{object} unchanged and
\code{na.omit} returns a copy of \code{object} with all missing values
removed.
}
\examples{
### a new object
me <- new("ModelEnv")
## the new model environment is empty
empty(me)
### define a bivariate response variable
me@set("response", data.frame(y = rnorm(10), x = runif(10)))
me
## now it is no longer empty
empty(me)
### check if a response is available
has(me, "response")
### the dimensions
dimension(me, "response")
### extract the data
me@get("response")
df <- data.frame(x = rnorm(10), y = rnorm(10))
## hook for set method:
mf <- ModelEnvFormula(y ~ x-1, data = df, setHook=list(designMatrix=scale))
mf@get("designMatrix")
mf@set(data=df[1:5,])
mf@get("designMatrix")
### NA handling
df$x[1] <- NA
mf <- ModelEnvFormula(y ~ x, data = df, na.action = na.pass)
mf
na.omit(mf)
}
\keyword{classes}
modeltools/man/ModelEnvFormula-class.Rd 0000644 0001762 0000144 00000001643 11455333772 017655 0 ustar ligges users \name{ModelEnvFormula-class}
\docType{class}
\alias{ModelEnvFormula-class}
\title{Class "ModelEnvFormula"}
\description{A class for formula-based model environments.}
\section{Objects from the Class}{
Objects can be created by calls of the form \code{new("ModelEnvFormula", ...)}.
}
\section{Slots}{
\describe{
\item{\code{env}:}{Object of class \code{"environment"}.}
\item{\code{get}:}{Object of class \code{"function"} for extracting
objects from environment \code{env}.}
\item{\code{set}:}{Object of class \code{"function"} for setting
object in environment \code{env}.}
\item{\code{formula}:}{Object of class \code{"list"}.}
\item{\code{hooks}:}{A list of hook collections.}
}
}
\section{Extends}{
Class \code{"ModelEnv"}, directly.
Class \code{"FormulaParts"}, directly.
}
\section{Methods}{
No methods defined with class "ModelEnvFormula" in the signature.
}
\keyword{classes}
modeltools/cleanup 0000755 0001762 0000144 00000000671 11455333772 014026 0 ustar ligges users #!/bin/bash
for f in ./R/*~; do
rm -f $f
done
for f in ./R/*.ps; do
rm -f $f
done
for f in ./man/*~; do
rm -f $f
done
for f in ./man/*.ps; do
rm -f $f
done
#for f in ./inst/*~; do
# rm -f $f
#done
#
#for f in ./tests/*~; do
# rm -f $f
#done
for f in ./tests/*.ps; do
rm -f $f
done
for f in ./tests/*~; do
rm -f $f
done
for f in *~; do
rm -f $f
done
find . -name "DEADJOE" -exec rm -f {} \;
exit 0