[Rd] bug and a proposed fix for model.tables. (PR#7132)
rmh at temple.edu
rmh at temple.edu
Sun Jul 25 09:52:50 CEST 2004
# Your mailer is set to "none" (default on Windows),
# hence we cannot send the bug report directly from R.
# Please copy the bug report (after finishing it) to
# your favorite email program and send it to
#
# r-bugs at r-project.org
#
######################################################
Here is a bug and a proposed fix for model.tables.
I can't fully test the fix because I haven't figured out how
to make my function take precedence over the one inside the namespace.
Rich
##############################################################
## bug fix for R 1.9.1 and earlier
## donated to The R Foundation for Statistical Computing by HH
## See cc135.s for an example.
## model.tables(a1c, type="means") doesn't work because one of the columns
## of prjs is all 0, hence removed by the calling function model.tables.aov.
## assign("make.tables.aovproj", envir=environment("make.tables.aovproj"),
make.tables.aovproj <-
function (proj.cols, mf.cols, prjs, mf,
fun = "mean", prt = FALSE, ...)
{
tables <- vector(mode = "list", length = length(proj.cols))
names(tables) <- names(proj.cols)
for (i in seq(length(tables))) {
terms <- proj.cols[[i]]
terms <- terms[match(terms, dimnames(prjs)[[2]], 0)] ## new line
data <- if (length(terms) == 1)
prjs[, terms]
else prjs[, terms] %*% as.matrix(rep.int(1, length(terms)))
tables[[i]] <- tapply(data, mf[mf.cols[[i]]], get(fun,
mode = "function"))
class(tables[[i]]) <- "mtable"
if (prt)
print(tables[i], ..., quote = FALSE)
}
tables
}
## )
## <environment: namespace:stats>
##############################################################
##############################################################
tmp <- data.frame(y=rnorm(8),
aa=factor(c(1,1,1,1,2,2,2,2)),
bb=factor(c(1,1,2,2,1,1,2,2)),
cc=factor(c(1,2,3,4,1,2,3,4)))
tmp.aov <- aov(y ~ cc + bb/aa, data=tmp)
anova(tmp.aov)
model.tables(tmp.aov) ## this works correctly
model.tables(tmp.aov, type="means") ## bug in make.tables.aovproj
attr(terms(y ~ cc + bb/aa), "term.labels") ## "bb" is present
dimnames(proj(tmp.aov))[[2]] ## "bb" is absent
##############################################################
--please do not edit the information below--
Version:
platform = i386-pc-mingw32
arch = i386
os = mingw32
system = i386, mingw32
status = Patched
major = 1
minor = 9.0
year = 2004
month = 04
day = 27
language = R
Windows NT 4.0 (build 1381) Service Pack 6
Search Path:
.GlobalEnv, package:methods, package:stats, package:graphics, package:utils,
file:c:/users/rmh28285/data/rmh/hh/splus.library/HH/.RData, package:lattice, package:grid,
Autoloads, package:base
More information about the R-devel
mailing list