Nothing
inst/slowtests/test.dots.R
In plotmo: Plot a Model's Residuals, Response, and Partial Dependence Plots
# test.dots.R
source("test.prolog.R")
cat0("=== test dotindex\n")
test.dotindex <- function(expected, ARGNAME, ..., EX=FALSE)
{
dotindex <- plotmo:::dotindex(ARGNAME=ARGNAME, EX=EX, ...)
stopifnot(all.equal(dotindex, expected))
}
test.dotindex(NA, "x") # empty dots
test.dotindex(NA, "x", a=10, b=20)
test.dotindex(1, "a", a=10, b=20)
test.dotindex(2, "b", a=10, b=20)
test.dotindex(1, "a1", a=10, b=20)
test.dotindex(NA, "a", a1=10, a2=20)
expect.err(try(test.dotindex(1, nonesuch, a=10, a=20)), "object 'nonesuch' not found")
expect.err(try(test.dotindex(1, "a1", a=10, a=20)), "argument 'a' for test.dotindex() is duplicated")
expect.err(try(test.dotindex(1, "aa1", a=10, aa=20)), "arguments 'a' and 'aa' both match 'aa1' in test.dotindex")
stopifnot(is.na(plotmo:::dotindex("a", EX=1, a1=10, a2=20)))
stopifnot(plotmo:::dotindex("a2", EX=1, a1=10, a2=20) == 2)
# multiple argnames
test.dotindex(NA, c("a", "b")) # empty dots
test.dotindex(1, c("a", "b"), a=2, c=3)
test.dotindex(1, c("a", "b"), a=5, b=6)
test.dotindex(2, c("a", "b"), x=1, a=5, b=6)
test.dotindex(3, c("b,a"), x=1, a=5, b=6)
test.dotindex(1, c("a b"), b=3, c=4)
test.dotindex(2, c(" a b "), c=3, b=4)
test.dotindex(NA, c("a", "b"), c=3)
stopifnot(plotmo:::dotindex(c("x", "a1"), EX=1, a1=10, a2=20) == 1)
test.dota <- function(expected, ARGNAME, ..., DEF=NA, EX=FALSE)
{
if(is.na(DEF))
dot <- plotmo:::dota(ARGNAME, EX=EX, ...)
else
dot <- plotmo:::dota(ARGNAME, EX=EX, DEF=DEF, ...)
stopifnot(all.equal(dot, expected))
}
cat0("=== test dot\n")
test.dota(NA, "x") # empty dots
test.dota(NA, "x", a=10, b=20)
test.dota(10, "a", a=10, b=20)
test.dota(20, "b", a=10, b=20)
test.dota(99, DEF=99, "nonesuch", a=10, b=20)
test.dota(NA, "a", a1=10, a2=20)
expect.err(try(test.dota(1, "a1", a=10, a=20)), "argument 'a' for test.dota() is duplicated")
expect.err(try(test.dota(1, 99, a=10, a=20)), "is.character(argname) is not TRUE")
expect.err(try(test.dota(1, test.dota, a=10, a=20)), "is.character(argname) is not TRUE")
expect.err(try(test.dota(1, "", a=10, a=20)), "empty string in ARGNAME")
expect.err(try(test.dota(1, "x^x", a=10, a=20)), "illegal character \"^\" in ARGNAME")
test.dota(10, "abc", EX=T, abc=10)
test.dota(NA, "a", EX=T, a1=10, a2=20)
expect.err(try(test.dota(1, "a1", a1=10, a1=20)), "argument 'a1' for test.dota() is duplicated")
stopifnot(is.na(plotmo:::dota("a", EX=1, a1=1, a2=2)))
stopifnot(plotmo:::dota("a2", EX=1, a1=10, a2=20, a3=30) == 20)
foo <- function(func, x) func(x)
foo(mean, 33)
foo(function(...) plotmo:::dota("x", ...), 33)
foo(function(...) plotmo:::dota("x99", ...), 33)
foo(function(...) { plotmo:::dota("nonesuch", ...) }, 33)
test.dota(1, "a", EX=T, a=1)
test.dota(2, "b", EX=T, a=1, b=2, c=3)
test.dota(NA, "x", EX=T, a=1, b=2, c=3)
test.dota(2, "a", EX=T, ab=1, a=2)
test.dota(2, "a", EX=T, aa=1, a=2)
test.dota(NA, "a", EX=T, aa=1, ab=2)
expect.err(try(test.dota(2, "a", EX=T, aa=1, a=2, a=3)), "argument 'a' for test.dota() is duplicated")
expect.err(try(test.dota(2, "a", EX=T, a=none.such)), "cannot evaluate 'a'")
# multiple argnames
test.dota(2, c("a", "b"), a=2, c=3)
test.dota(5, c("a", "b"), a=5, b=6)
test.dota(5, c("a", "b"), x=1, a=5, b=6)
test.dota(3, c("a", "b"), b=3, c=4)
test.dota(4, c("a", "b"), c=3, b=4)
test.dota(NA, c("a", "b"), c=3)
expect.err(try(test.dota(1, c("b", "aa1"), a=10, aa=20)), "arguments 'a' and 'aa' both match 'aa1' in test.dota")
expect.err(try(test.dota(1, c("x", ""), a=10, b=20)), "empty string in ARGNAME")
stopifnot(plotmo:::dota(c("x", "a2", "y"), EX=1, a1=10, a2=20, a3=30) == 20)
test.dota(NA, c("a", "b"), aa=2, cc=3, EX=T)
test.dota(2, c("aa", "b"), aa=2, cc=3, EX=T)
test.dota(3, c("bb", "b"), bb=3, cc=4, EX=T)
test.dota(NA, c("a", "b"), c=3, EX=T)
foo.x <- function(...) { plotmo:::dota("x", ..., DEF="default", EX=FALSE) }
stopifnot(foo.x(x=3) == 3)
stopifnot(foo.x(y=3) == "default")
foo2 <- function(funcarg, ...) funcarg(...)
stopifnot(is.na(foo2(function(...) plotmo:::dota("x", ...), 3))) # 3 is unnamed
stopifnot(foo2(function(...) plotmo:::dota("x", EX=0, ...), x=3) == 3)
stopifnot(foo2(function(...) plotmo:::dota("x99", EX=0, ...), x=3) == 3)
stopifnot(foo2(function(...) { plotmo:::dota("x", DEF="default", EX=FALSE, ...) }, x=3) == 3)
stopifnot(foo2(function(...) { plotmo:::dota("y", DEF="default", EX=FALSE, ...) }, x=3) == "default")
# expect.err(try(foo2(function(...) { plotmo:::dota("y", DEF="default", EX=FALSE, ...) }, 3)), "unnamed arguments in ... are not allowed for funcarg()")
stopifnot(foo2(foo.x, x=3) == 3)
stopifnot(foo2(foo.x, y=3) == "default")
test.is.dot <- function(expected, ARGNAME, ...)
{
present <- plotmo:::is.dot(ARGNAME, ...)
stopifnot(all.equal(present, expected))
}
cat0("=== test is.dot\n")
test.is.dot(FALSE, "x") # empty dots
test.is.dot(FALSE, "x", EX=0, a=10, b=20)
test.is.dot(TRUE, "a", EX=0, a=10, b=20)
test.is.dot(TRUE, "b", EX=0, a=10, b=20)
test.is.dot(TRUE, "a1", EX=0, a=10, b=20)
test.is.dot(FALSE, "a", EX=0, a1=10, a2=20)
expect.err(try(test.is.dot(TRUE, "a1", EX=0, a=10, a=20)), "argument 'a' for test.is.dot() is duplicated")
expect.err(try(test.is.dot(TRUE, "a", EX=0, a=10, a=20)), "argument 'a' for test.is.dot() is duplicated")
stopifnot(plotmo:::is.dot("a", EX=1, a1=10, a2=20, a3=30) == FALSE)
stopifnot(plotmo:::is.dot("x", EX=1, a1=10, a2=20, a3=30) == FALSE)
stopifnot(plotmo:::is.dot("a3", EX=1, a1=10, a2=20, a3=30) == TRUE)
# multiple argnames
test.is.dot(TRUE, EX=0, c("a1", "b1"), a=2, c=3)
test.is.dot(TRUE, EX=0, c("a1", "b1"), b=3, c=4)
test.is.dot(TRUE, EX=0, c("a1", "b1"), c=3, b=4)
test.is.dot(FALSE, EX=0, c("a1", "b1"), c=3)
expect.err(try(test.is.dot(FALSE, c("aa1", "b"), EX=0, a=10, aa=20)), "arguments 'a' and 'aa' both match 'aa1' in test.is.dot")
stopifnot(plotmo:::is.dot(c("x", "a", "y"), EX=1, a1=10, a2=20, a3=30) == FALSE)
stopifnot(plotmo:::is.dot(c("x", "a2", "y"), EX=1, a1=10, a2=20, a3=30) == TRUE)
cat0("=== test expand.drop\n")
# nchar is used an example func, it has formals "x", "type", "allowNA"
stopifnot(is.null(plotmo:::expand.drop(NULL, prefix="prefix.", func=nchar)))
stopifnot(plotmo:::expand.drop("a", prefix="prefix.", func=nchar) == ">PREFIX|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a", prefix="prefix.", func=nchar, include.standard.prefixes=TRUE) == ">STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^prefix\\.|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=base::nchar) == ">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT")
stopifnot(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=base::nchar, include.standard.prefixes=TRUE) == ">FORMALS|^x|^type|^allowNA|^keepNA|>STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^prefix\\.|>EXPLICIT")
expect.err(try(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=NULL)), "\"FORMALS\" specified in DROP, but FUNC is NULL")
expect.err(try(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=base::c)), "\"FORMALS\" specified but formals(FUNC) returned no formal arguments")
foo99 <- function(...) NULL
expect.err(try(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=foo99)), "\"FORMALS\" specified but formals(FUNC) returned only \"...\"")
stopifnot(plotmo:::expand.drop("a,FORMALS", prefix="prefix.", func=base::nchar) == ">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a,FORMALS", prefix="prefix.", func=base::nchar, include.standard.prefixes=TRUE) == ">FORMALS|^x|^type|^allowNA|^keepNA|>STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^prefix\\.|>EXPLICIT|^a")
expect.err(try(plotmo:::expand.drop("", prefix="prefix.", func=base::nchar)), "DROP is an empty string")
stopifnot(plotmo:::expand.drop("a", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a", "lines.a", prefix="lines.", func=base::nchar, include.standard.prefixes=TRUE) == ">STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^lines\\.|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a*", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a.*")
stopifnot(plotmo:::expand.drop("a.*", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a\\..*")
stopifnot(plotmo:::expand.drop("a$", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a$")
stopifnot(plotmo:::expand.drop("a$,b*,c*$", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a$|^b.*|^c.*$")
stopifnot(plotmo:::expand.drop(c("a", "b,c", " d e$ f ", "g h$, i"), prefix="lines.", func=base::nchar) ==
">PREFIX|>EXPLICIT|^a|^b|^c|^d|^e$|^f|^g|^h$|^i")
stopifnot(plotmo:::expand.drop("PLOT.ARGS", prefix="lines.", func=base::nchar) ==
">PREFIX|>EXPLICIT|>PLOT_ARGS|^add$|^adj$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^family$|^font$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lend$|^ljoin$|^lmitre$|^lty$|^lwd$|^main$|^pch$|^srt$|^xaxp$|^xaxs$|^xaxt$|^xlab$|^xlim$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylab$|^ylim$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,PLOT.ARGS", prefix="lines.", func=base::nchar) ==
">PREFIX|>EXPLICIT|^abc|>PLOT_ARGS|^add$|^adj$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^family$|^font$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lend$|^ljoin$|^lmitre$|^lty$|^lwd$|^main$|^pch$|^srt$|^xaxp$|^xaxs$|^xaxt$|^xlab$|^xlim$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylab$|^ylim$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,FORMALS,PLOT.ARGS", prefix="lines.", func=base::nchar) ==
">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^abc|>PLOT_ARGS|^add$|^adj$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^family$|^font$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lend$|^ljoin$|^lmitre$|^lty$|^lwd$|^main$|^pch$|^srt$|^xaxp$|^xaxs$|^xaxt$|^xlab$|^xlim$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylab$|^ylim$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,FORMALS,PAR.ARGS", prefix="lines.", func=base::nchar) ==
">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^abc|>PAR_ARGS|^adj$|^ann$|^ask$|^bg$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^err$|^family$|^fg$|^fig$|^fin$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lab$|^las$|^lend$|^lheight$|^ljoin$|^lmitre$|^lty$|^mai$|^mar$|^mex$|^mfcol$|^mfg$|^mfrow$|^mgp$|^mkh$|^new$|^oma$|^omd$|^omi$|^pch$|^pin$|^plt$|^ps$|^pty$|^srt$|^tck$|^tcl$|^usr$|^xaxp$|^xaxs$|^xaxt$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylbias$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,FORMALS,PLOTMO.ARGS", prefix="lines.", func=base::nchar) ==
">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^abc|>PLOTMO_ARGS|^caption\\.|^cex\\.|^col\\.|^contour\\.|^cum\\.|^degree1\\.|^degree2\\.|^density\\.|^filled\\.contour\\.|^font\\.|^func\\.|^grid\\.|^heatmap\\.|^image\\.|^jitter\\.|^legend\\.|^label\\.|^level\\.|^line\\.|^lines\\.|^lty\\.|^lty\\.|^lwd\\.|^main\\.|^mtext\\.|^nresiduals|^par\\.|^pch\\.|^persp\\.|^plot\\.|^plotmath\\.|^prednames\\.|^qq\\.|^qqline\\.|^pt\\.|^response\\.|^rug\\.|^smooth\\.|^text\\.|^title\\.|^vfont\\.")
test.deprefix <- function(expected, ..., FNAME="test.deprefix", KEEP=NULL)
{
args <- plotmo:::deprefix(..., FNAME=FNAME, KEEP=KEEP, CALLARGS="")
# can't use all.equal because it complains about names
# cat("args:\n")
# print(args)
# cat("expected:\n")
# print(expected)
stopifnot(length(args) == length(expected))
for(i in seq_len(length(expected))) {
stopifnot(names(args)[i] == names(expected)[i])
stopifnot(args[[i]] == expected[[i]])
}
}
cat0("=== test deprefix\n")
test.deprefix(
expected=list(a=1, b=2), DROP="*",
PREFIX="predict.", def.a=1, predict.b=2, c=3)
test.deprefix(TRACE=2,
expected=list(b="predict.b", d="def.d", c="predict.c", e="predict.e"),
PREFIX="predict.", DROP="*",
a="a", b="b", c="c", w1.xlab="xlab",
def.b="def.b", def.d="def.d",
predict.b="predict.b", predict.c="predict.c", predict.e="predict.e")
test.deprefix(TRACE=2,
expected=list(b="predict.b", d="def.d", a="a", c="predict.c", e="predict.e"),
KEEP=NULL, PREFIX="predict.", DROP="w1.",
a="a", b="b", c="c", w1.xlab="xlab",
def.b="def.b", def.d="def.d",
predict.b="predict.b", predict.c="predict.c", predict.e="predict.e")
test.deprefix(
expected=list(a="predict.a"),
KEEP=NULL, PREFIX="predict.", DROP="w1.",
a="plain.a", predict.a="predict.a")
test.deprefix(expected=list(a="aa1"),
KEEP=NULL, PREFIX="predict.", a="aa1")
test.deprefix(expected=list(a="aa2"),
KEEP=NULL, PREFIX="predict.", def.a="aa2")
test.deprefix(expected=list(a="aa3", b="bb3"),
KEEP=NULL, PREFIX="predict.", def.a="aa3", b="bb3")
test.deprefix(expected=list(10, 20), TRACE=2,
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon2=20, force.anon1=10)
test.deprefix(expected=list(10, 20, a=3), TRACE=2,
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon2=20, force.anon1=10,
a=3)
expect.err(try(test.deprefix(expected=list(10, 20, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon=10, force.anon=20,
a=3, predict.a=4)),
"argument 'force.anon' for test.deprefix() is duplicated")
expect.err(try(test.deprefix(expected=list(10, 20, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.", FNAME="foobar",
force.anon=10, force.anon=20,
a=3, predict.a=4)),
"argument 'force.anon' for foobar() is duplicated")
test.deprefix(expected=list(10, 20, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20,
a=3, predict.a=4)
test.deprefix(expected=list(10, 20, b=3, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20, def.b=3,
a=3, predict.a=4)
test.deprefix(expected=list(10, 20, b=5, a=3),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20, def.b=3,
a=3, predict.b=5)
test.deprefix(expected=list(10, 20, b=6, a=3),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20, def.b=3,
a=3, b=6)
expect.err(try(test.deprefix(expected=NULL, KEEP=NULL, PREFIX="predict.", DROP="w1\\.")), "illegal character \"\\\" in DROP = \"w1\\.\"")
test.deprefix(expected=list(b="predict.b", d="def.d", a="a", c="predict.c", w1.xl="xlab2", e="predict.e"),
PREFIX="predict.", DROP="w1.xlab$",
a="a", b="b", c="c",
w1.xlab="xlab1", # will be dropped (exact match)
w1.xl="xlab2", # will be kept (not an exact match)
def.b="def.b", def.d="def.d",
predict.b="predict.b", predict.c="predict.c", predict.e="predict.e")
# expect.err(try(plotmo:::deprefix(FNAME="test.deprefix", PREFIX="predict.", UPPER.CASE123=99,
# def.a=1, predict.b=2, c=3)),
# "uppercase argument names like \"UPPER.CASE123\" are not allowed for test.deprefix()")
test.expand.dotnames <- function(expected, PREFIX, FUNC=NULL,
FNAME="test.expand.dotnames", FORMALS=NULL, ...)
{
dots <- as.list(match.call(expand.dots=FALSE)$...)
args <- plotmo:::expand.dotnames(dots, PREFIX, FUNC, FNAME, FORMALS)
# can't use all.equal because it complains about named list versus unnamed list
stopifnot(length(args) == length(expected))
for(i in seq_len(length(expected))) {
stopifnot(names(args)[i] == names(expected)[i])
stopifnot(eval(args[[i]]) == expected[[i]])
}
}
cat0("=== test expand.dotnames\n")
test.expand.dotnames(expected=list(x=9, persp.shade=3),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.sh=3)
test.expand.dotnames(expected=list(x=9, persp.shade=3, persp.nonesuch=4),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.sh=3, persp.nonesuch=4)
test.expand.dotnames(expected=list(x=9, persp.col=3),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.c=3)
# TODO not sure why this works as it does
test.expand.dotnames(expected=list(x=9, persp.x=3),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.x=3)
expect.err(try(test.expand.dotnames(expected=NULL,
"persp.", graphics:::persp.default, "persp.default", x=9, persp.l=3)),
"'l' matches both the 'ltheta' and 'lphi' arguments of persp.default()")
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xlim=c(1,2))
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xli=c(1,2))
expect.err(try(test.expand.dotnames(expected=NULL,
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xl=c(1,2))),
"'xl' matches both the 'xlim' and 'xlab' arguments of plot.default()")
foo3 <- function(aaa=1, aa=2, bb=3, bba=4, cca=5, ccb=6, def=7)
cat0("foo3: aaa=", aaa, " aa=", aa, ", bb=", bb, " bba=", bba,
" cca=", cca, " ccb=", ccb, " def=", def, "\n")
# --- above tests again but using formals ---
# formal args for graphics:::persp.default (R version 3.2.0)
formals <- c( "x", "y", "z", "xlim", "zlim", "xlab", "ylab", "zlab",
"main", "sub", "theta", "phi", "r", "d", "scale", "expand", "col",
"border", "ltheta", "lphi", "shade", "box", "axes", "nticks",
"ticktype")
test.expand.dotnames(expected=list(x=9, persp.shade=3),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.sh=3)
test.expand.dotnames(expected=list(x=9, persp.shade=3, persp.nonesuch=4),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.sh=3, persp.nonesuch=4)
test.expand.dotnames(expected=list(x=9, persp.col=3),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.c=3)
# TODO not sure why this works as it does
test.expand.dotnames(expected=list(x=9, persp.x=3),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.x=3)
expect.err(try(test.expand.dotnames(expected=NULL,
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.l=3)),
"'l' matches both the 'ltheta' and 'lphi' arguments of persp()")
# done formals tests
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xlim=c(1,2))
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xli=c(1,2))
expect.err(try(test.expand.dotnames(expected=NULL,
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xl=c(1,2))),
"'xl' matches both the 'xlim' and 'xlab' arguments of plot.default()")
test.expand.dotnames(expected=list(foo3.aa=99),
"foo3.", foo3, "foo3", foo3.aa=99)
expect.err(try(plotmo:::call.plot(foo3, "foo3.", foo3.aa=99)), "Unnamed arguments are not allowed here\n The argument's value is \"foo3.\"")
expect.err(try(plotmo:::call.plot(foo3, foo, foo3.aa=99)),
"Unnamed arguments are not allowed here\n The argument's value is function.object")
expect.err(try(plotmo:::call.plot(foo3, NULL, foo3.aa=99)), "Unnamed arguments are not allowed here\n The argument's value is NULL")
expect.err(try(plotmo:::call.plot(foo3, stop("stop was called"), foo3.aa=99)), "Unnamed arguments are not allowed here (argument ..1 is unnamed)")
expect.err(try(plotmo:::call.plot(foo3, cat("side effect\n"), foo3.aa=99)), "Unnamed arguments are not allowed here\n The argument's value is NULL")
expect.err(try(plotmo:::call.plot(foo3, nonesuch1=1, nonesuch2, foo3.aa=99)), "Unnamed arguments are not allowed here (argument ..2 is unnamed)")
plotmo:::call.plot(foo3, PREFIX="foo3.", foo3.aa=99)
test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.aaa=99)
plotmo:::call.plot(foo3, foo3.aaa=99)
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.aa=88, foo3.aa=99)),
"'foo3.aa' for foo3() is duplicated")
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.a=88, foo3.aa=99)),
"'a' matches both the 'aaa' and 'aa' arguments of foo3()")
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.aaa=88, foo3.aaa=99)),
"'foo3.aaa' for foo3() is duplicated")
test.expand.dotnames(expected=list(foo3.bbb=88, foo3.bba=99),
"foo3.", foo3, "foo3", foo3.bbb=88, foo3.bba=99)
expect.err(try(plotmo:::call.plot(foo3, foo3.bbb=88, foo3.bba=99)),
"unused argument (bbb = 88)")
# same as above but with TRACE (so don't use try in call.dots)
expect.err(try(plotmo:::call.plot(foo3, foo3.bbb=88, foo3.bba=99, TRACE=T)),
"unused argument (bbb = 88)")
test.expand.dotnames(expected=list(foo3.bb=88),
"foo3.", foo3, "foo3", foo3.bb=88)
plotmo:::call.plot(foo3, foo3.bb=88)
# test with FUNC=NULL
test.expand.dotnames(expected=list(foo3.aa=99),
"foo3.", NULL, "foo3", foo3.aa=99)
plotmo:::call.plot(foo3, foo3.aa=99)
test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", NULL, "foo3", foo3.aaa=99)
plotmo:::call.plot(foo3, foo3.aaa=99)
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", NULL, "foo3", foo3.aa=88, foo3.aa=99)),
"argument 'foo3.aa' for foo3() is duplicated")
test.expand.dotnames(expected=list(foo3.a=88, foo3.aa=99),
"foo3.", NULL, "foo3", foo3.a=88, foo3.aa=99)
expect.err(try(plotmo:::call.plot(foo3, foo3.a=88, foo3.aa=99)),
"'a' matches both the 'aaa' and 'aa' arguments of foo3()")
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", NULL, "foo3", foo3.aaa=88, foo3.aaa=99)),
"argument 'foo3.aaa' for foo3() is duplicated")
test.expand.dotnames(expected=list(foo3.bbb=88, foo3.bba=99),
"foo3.", NULL, "foo3", foo3.bbb=88, foo3.bba=99)
expect.err(try(plotmo:::call.plot(foo3, PREFIX="foo3.", foo3.bbb=88, foo3.bba=99)),
"unused argument (bbb = 88)")
test.expand.dotnames(expected=list(foo3.bb=88),
"foo3.", NULL, "foo3", foo3.bb=88)
plotmo:::call.plot(foo3, foo3.bb=88)
test.expand.dotnames(expected=list(foo3.bbx=88),
"foo3.", NULL, "foo3", foo3.bbx=88)
expect.err(try(plotmo:::call.plot(foo3, foo3.bbx=88)),
"unused argument (bbx = 88)")
test.expand.dotnames(expected=list(foo3.cc=77),
"foo3.", NULL, "foo3", foo3.cc=77)
expect.err(try(plotmo:::call.plot(foo3, foo3.cc=77)),
"'cc' matches both the 'cca' and 'ccb' arguments of foo3()")
# following two directly compare FUNC=NULL to FUNC=foo3
test.expand.dotnames(expected=list(foo3.cc=77),
"foo3.", FUNC=NULL, "foo3", foo3.cc=77)
expect.err(try(test.expand.dotnames(expected=NULL,
"foo3.", FUNC=foo3, "foo3", foo3.cc=77)),
"'cc' matches both the 'cca' and 'ccb' arguments of foo3()")
test.expand.dotnames(expected=list(), "foo3.", foo3, "foo3", d=88, de=99)
expect.err(try(plotmo:::call.plot(graphics::plot, x=1:3, y=1:3, 99)),
"Unnamed arguments are not allowed here\n The argument's value is 99\n plotmo:::call.plot via try called call.dots(FUNC=plot, PREFIX=PREFIX, ...")
# test TRACE
print(plotmo:::deprefix(FUNC=nchar, PREFIX="foo3.", TRACE=TRUE, FNAME="nchar", allowN=1, b=2, foo3.c=3))
print(plotmo:::deprefix(FUNC=nchar, PREFIX="foo3.", TRACE=2, allowN=1, b=2, foo3.c=3))
print(plotmo:::deprefix(FUNC=nchar, PREFIX="foo3.", TRACE=3, allowN=1, b=2, foo3.c=3))
expect.err(try(plotmo:::call.plot(foo3, foo3.d=88, foo3.de=99)),
"'foo3.d' and 'foo3.de' both match the 'def' argument of foo3()")
cat0("=== test stop.if.dots\n")
foo3 <- function(x=1, ...) plotmo:::stop.if.dots(...)
foo3(1) # ok
expect.err(try(foo3(10, y=2)), "foo3: unrecognized argument 'y'")
expect.err(try(foo3(10, 99)), "foo3: unrecognized unnamed argument\n The call was foo3(x=10, 99)")
expect.err(try(foo3(10, y=plot)), "foo3: unrecognized argument 'y'")
expect.err(try(foo3(10, plot)),
"foo3: unrecognized unnamed argument\n The call was foo3(x=10, plot)")
expect.err(try(foo3(20, c(1,2,3), plot)),
"foo3: unrecognized unnamed argument\n The call was foo3(x=20, c(1,2,3), plot)")
expect.err(try(foo3(20, c(1,2,3,4,5,6,7,8,9,10,11,12), plot)),
"foo3: unrecognized unnamed argument\n The call was foo3(x=20, c(1,2,3,4,5,6,7,8,9,10,11,12), plot)")
# test that we don't crash because we eval the argument
expect.err(try(foo3(20, y=stop("stop was called"))), "foo3: unrecognized argument 'y'")
expect.err(try(foo3(20, stop("stop was called"))), "foo3: unrecognized unnamed argument")
expect.err(try(foo3(20, cat("side effect\n"))),
"foo3: unrecognized unnamed argument\n The call was foo3(x=20, cat(")
foo2 <- function(...) plotmo:::stop.if.dots(...)
foo2() # ok
expect.err(try(foo2(y=2)), "foo2: unrecognized argument 'y'")
expect.err(try(foo2(2)), "foo2: unrecognized unnamed argument\n The call was foo2(2)")
expect.err(try(foo2(y=plot)), "foo2: unrecognized argument 'y'")
expect.err(try(foo2(plot)),
"foo2: unrecognized unnamed argument\n The call was foo2(plot)")
foo2a <- function(funcarg, ...) funcarg(...)
expect.err(try(foo2a(function(x=1, ...) plotmo:::stop.if.dots(...), x=1, y=2)), "funcarg: unrecognized argument 'y'")
cat0("=== test warn.if.dots\n")
options(warn=2) # treat warnings as errors
foo3 <- function(x=1, ...) plotmo:::warn.if.dots(...)
foo3(1) # ok
expect.err(try(foo3(1, y=2)), "foo3 ignored argument 'y'")
expect.err(try(foo3(1, 2)), "foo3 ignored unnamed argument\n The call was foo3(x=1, 2)")
expect.err(try(foo3(1, y=plot)), "foo3 ignored argument 'y'")
# TODO would like to improve this error messsage
expect.err(try(foo3(1, plot)),
"(converted from warning) foo3 ignored unnamed argument\n The call was foo3(x=1, plot)")
foo4 <- function(...) plotmo:::warn.if.dots(...)
foo4() # ok
expect.err(try(foo4(y=2)), "foo4 ignored argument 'y'")
expect.err(try(foo4(2)), "foo4 ignored unnamed argument\n The call was foo4(2)")
expect.err(try(foo4(y=plot)), "foo4 ignored argument 'y'")
expect.err(try(foo4(plot)),
"(converted from warning) foo4 ignored unnamed argument\n The call was foo4(plot)")
options(warn=1)
foo3(1, nonesuch=12, nonesuch2=12, 999) # expect three warnings
cat0("=== test using sample functions that invoke call.dots\n")
x <- 1:10
y <- x * x
lmfit <- lm(y~x)
par(mfrow=c(3, 2))
par(oma=c(0, 0, 3, 0))
# plot1: simple example
# we choose to use predict() here rather than fitted() because nearly all
# models have a fitted() method, but many don't have a fitted() method.
plot1 <- function(object, ...)
{
residuals <- residuals(object, ...)
fitted <- predict(object, ...)
plot(fitted, residuals, ...)
}
plot1(lmfit)
mtext("example plot functions using prefixed dots", outer=TRUE, font=2, line=1, cex=1)
# Following causes error in predict.lm(). The type argument meant for
# residuals() is also sent to predict.lm(), where it is rejected.
expect.err(try(plot1(lmfit, type="pearson")), "'arg' should be one of \"response\", \"terms\"")
# plot2: use prefixed args
plot2 <- function(object, ..., TRACE=2)
{
resids <- plotmo:::call.dots(residuals, object=object, ..., TRACE=TRACE)
fitted <- plotmo:::call.dots(predict, object=object, ..., TRACE=TRACE)
plotmo:::call.plot(plot, x=fitted, y=resids, ..., TRACE=TRACE)
}
# we can now direct args using the prefixes "residuals.", "predict.", or "plot.")
plot2(lmfit, residuals.type="pearson")
# We can also use the usual plot arguments like ylab: call.dots drops
# them; call.plot recognizes them and passes them to lines().
plot2(lmfit, residuals.type="pearson", ylab="pearson residuals", main="plot2")
# plot3: further refinements
# o namespace added to FUNC arg
# o full name for plot.default
# o force. and def. prefixes
# o explicit xlab and ylab for call.plot
# o unprefixed args are passed to residuals()
plot3 <- function(object, ..., TRACE=2)
{
resids <- plotmo:::call.dots(stats::residuals,
DROP="plotmo:::PLOTARGS,predict.,plot.",
TRACE=TRACE, force.object=object, ...)
fitted <- plotmo:::call.dots(stats::predict,
force.object=object, TRACE=TRACE, ...)
plotmo:::call.plot(graphics::plot.default, force.x=fitted, force.y=resids,
def.xlab="fitted", def.ylab="residuals",
TRACE=TRACE, ...)
}
plot3(lmfit, type="pearson", main="plot3a") # type goes only to pearson, no prefix needed
plot3(lmfit, type="pearson", predict.type="response", main="plot3b")
cat0("=== test callers.name\n")
test.callers.name <- function(x) {
caller0 <- plotmo:::callers.name(0) # test.callers.name
caller1 <- plotmo:::callers.name(1) # caller of test.callers.name
caller99 <- plotmo:::callers.name(99) # sys.call(-n) : not that many frames on the stack
s <- sprint("0 %s 1 %s 99 %s", caller0, caller1, caller99)
cat(s, "\n", sep="")
s
}
print(plotmo:::callers.name()) # "eval"
myfunc <- function(func) func()
stopifnot(myfunc(function(x) test.callers.name(99)) == "0 test.callers.name 1 func 99 unknown")
stopifnot(test.callers.name() == "0 test.callers.name 1 stopifnot 99 unknown")
source("test.epilog.R")
Try the plotmo package in your browser
Any scripts or data that you put into this service are public.
plotmo documentation built on May 22, 2022, 1:05 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# test.dots.R
source("test.prolog.R")
cat0("=== test dotindex\n")
test.dotindex <- function(expected, ARGNAME, ..., EX=FALSE)
{
dotindex <- plotmo:::dotindex(ARGNAME=ARGNAME, EX=EX, ...)
stopifnot(all.equal(dotindex, expected))
}
test.dotindex(NA, "x") # empty dots
test.dotindex(NA, "x", a=10, b=20)
test.dotindex(1, "a", a=10, b=20)
test.dotindex(2, "b", a=10, b=20)
test.dotindex(1, "a1", a=10, b=20)
test.dotindex(NA, "a", a1=10, a2=20)
expect.err(try(test.dotindex(1, nonesuch, a=10, a=20)), "object 'nonesuch' not found")
expect.err(try(test.dotindex(1, "a1", a=10, a=20)), "argument 'a' for test.dotindex() is duplicated")
expect.err(try(test.dotindex(1, "aa1", a=10, aa=20)), "arguments 'a' and 'aa' both match 'aa1' in test.dotindex")
stopifnot(is.na(plotmo:::dotindex("a", EX=1, a1=10, a2=20)))
stopifnot(plotmo:::dotindex("a2", EX=1, a1=10, a2=20) == 2)
# multiple argnames
test.dotindex(NA, c("a", "b")) # empty dots
test.dotindex(1, c("a", "b"), a=2, c=3)
test.dotindex(1, c("a", "b"), a=5, b=6)
test.dotindex(2, c("a", "b"), x=1, a=5, b=6)
test.dotindex(3, c("b,a"), x=1, a=5, b=6)
test.dotindex(1, c("a b"), b=3, c=4)
test.dotindex(2, c(" a b "), c=3, b=4)
test.dotindex(NA, c("a", "b"), c=3)
stopifnot(plotmo:::dotindex(c("x", "a1"), EX=1, a1=10, a2=20) == 1)
test.dota <- function(expected, ARGNAME, ..., DEF=NA, EX=FALSE)
{
if(is.na(DEF))
dot <- plotmo:::dota(ARGNAME, EX=EX, ...)
else
dot <- plotmo:::dota(ARGNAME, EX=EX, DEF=DEF, ...)
stopifnot(all.equal(dot, expected))
}
cat0("=== test dot\n")
test.dota(NA, "x") # empty dots
test.dota(NA, "x", a=10, b=20)
test.dota(10, "a", a=10, b=20)
test.dota(20, "b", a=10, b=20)
test.dota(99, DEF=99, "nonesuch", a=10, b=20)
test.dota(NA, "a", a1=10, a2=20)
expect.err(try(test.dota(1, "a1", a=10, a=20)), "argument 'a' for test.dota() is duplicated")
expect.err(try(test.dota(1, 99, a=10, a=20)), "is.character(argname) is not TRUE")
expect.err(try(test.dota(1, test.dota, a=10, a=20)), "is.character(argname) is not TRUE")
expect.err(try(test.dota(1, "", a=10, a=20)), "empty string in ARGNAME")
expect.err(try(test.dota(1, "x^x", a=10, a=20)), "illegal character \"^\" in ARGNAME")
test.dota(10, "abc", EX=T, abc=10)
test.dota(NA, "a", EX=T, a1=10, a2=20)
expect.err(try(test.dota(1, "a1", a1=10, a1=20)), "argument 'a1' for test.dota() is duplicated")
stopifnot(is.na(plotmo:::dota("a", EX=1, a1=1, a2=2)))
stopifnot(plotmo:::dota("a2", EX=1, a1=10, a2=20, a3=30) == 20)
foo <- function(func, x) func(x)
foo(mean, 33)
foo(function(...) plotmo:::dota("x", ...), 33)
foo(function(...) plotmo:::dota("x99", ...), 33)
foo(function(...) { plotmo:::dota("nonesuch", ...) }, 33)
test.dota(1, "a", EX=T, a=1)
test.dota(2, "b", EX=T, a=1, b=2, c=3)
test.dota(NA, "x", EX=T, a=1, b=2, c=3)
test.dota(2, "a", EX=T, ab=1, a=2)
test.dota(2, "a", EX=T, aa=1, a=2)
test.dota(NA, "a", EX=T, aa=1, ab=2)
expect.err(try(test.dota(2, "a", EX=T, aa=1, a=2, a=3)), "argument 'a' for test.dota() is duplicated")
expect.err(try(test.dota(2, "a", EX=T, a=none.such)), "cannot evaluate 'a'")
# multiple argnames
test.dota(2, c("a", "b"), a=2, c=3)
test.dota(5, c("a", "b"), a=5, b=6)
test.dota(5, c("a", "b"), x=1, a=5, b=6)
test.dota(3, c("a", "b"), b=3, c=4)
test.dota(4, c("a", "b"), c=3, b=4)
test.dota(NA, c("a", "b"), c=3)
expect.err(try(test.dota(1, c("b", "aa1"), a=10, aa=20)), "arguments 'a' and 'aa' both match 'aa1' in test.dota")
expect.err(try(test.dota(1, c("x", ""), a=10, b=20)), "empty string in ARGNAME")
stopifnot(plotmo:::dota(c("x", "a2", "y"), EX=1, a1=10, a2=20, a3=30) == 20)
test.dota(NA, c("a", "b"), aa=2, cc=3, EX=T)
test.dota(2, c("aa", "b"), aa=2, cc=3, EX=T)
test.dota(3, c("bb", "b"), bb=3, cc=4, EX=T)
test.dota(NA, c("a", "b"), c=3, EX=T)
foo.x <- function(...) { plotmo:::dota("x", ..., DEF="default", EX=FALSE) }
stopifnot(foo.x(x=3) == 3)
stopifnot(foo.x(y=3) == "default")
foo2 <- function(funcarg, ...) funcarg(...)
stopifnot(is.na(foo2(function(...) plotmo:::dota("x", ...), 3))) # 3 is unnamed
stopifnot(foo2(function(...) plotmo:::dota("x", EX=0, ...), x=3) == 3)
stopifnot(foo2(function(...) plotmo:::dota("x99", EX=0, ...), x=3) == 3)
stopifnot(foo2(function(...) { plotmo:::dota("x", DEF="default", EX=FALSE, ...) }, x=3) == 3)
stopifnot(foo2(function(...) { plotmo:::dota("y", DEF="default", EX=FALSE, ...) }, x=3) == "default")
# expect.err(try(foo2(function(...) { plotmo:::dota("y", DEF="default", EX=FALSE, ...) }, 3)), "unnamed arguments in ... are not allowed for funcarg()")
stopifnot(foo2(foo.x, x=3) == 3)
stopifnot(foo2(foo.x, y=3) == "default")
test.is.dot <- function(expected, ARGNAME, ...)
{
present <- plotmo:::is.dot(ARGNAME, ...)
stopifnot(all.equal(present, expected))
}
cat0("=== test is.dot\n")
test.is.dot(FALSE, "x") # empty dots
test.is.dot(FALSE, "x", EX=0, a=10, b=20)
test.is.dot(TRUE, "a", EX=0, a=10, b=20)
test.is.dot(TRUE, "b", EX=0, a=10, b=20)
test.is.dot(TRUE, "a1", EX=0, a=10, b=20)
test.is.dot(FALSE, "a", EX=0, a1=10, a2=20)
expect.err(try(test.is.dot(TRUE, "a1", EX=0, a=10, a=20)), "argument 'a' for test.is.dot() is duplicated")
expect.err(try(test.is.dot(TRUE, "a", EX=0, a=10, a=20)), "argument 'a' for test.is.dot() is duplicated")
stopifnot(plotmo:::is.dot("a", EX=1, a1=10, a2=20, a3=30) == FALSE)
stopifnot(plotmo:::is.dot("x", EX=1, a1=10, a2=20, a3=30) == FALSE)
stopifnot(plotmo:::is.dot("a3", EX=1, a1=10, a2=20, a3=30) == TRUE)
# multiple argnames
test.is.dot(TRUE, EX=0, c("a1", "b1"), a=2, c=3)
test.is.dot(TRUE, EX=0, c("a1", "b1"), b=3, c=4)
test.is.dot(TRUE, EX=0, c("a1", "b1"), c=3, b=4)
test.is.dot(FALSE, EX=0, c("a1", "b1"), c=3)
expect.err(try(test.is.dot(FALSE, c("aa1", "b"), EX=0, a=10, aa=20)), "arguments 'a' and 'aa' both match 'aa1' in test.is.dot")
stopifnot(plotmo:::is.dot(c("x", "a", "y"), EX=1, a1=10, a2=20, a3=30) == FALSE)
stopifnot(plotmo:::is.dot(c("x", "a2", "y"), EX=1, a1=10, a2=20, a3=30) == TRUE)
cat0("=== test expand.drop\n")
# nchar is used an example func, it has formals "x", "type", "allowNA"
stopifnot(is.null(plotmo:::expand.drop(NULL, prefix="prefix.", func=nchar)))
stopifnot(plotmo:::expand.drop("a", prefix="prefix.", func=nchar) == ">PREFIX|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a", prefix="prefix.", func=nchar, include.standard.prefixes=TRUE) == ">STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^prefix\\.|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=base::nchar) == ">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT")
stopifnot(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=base::nchar, include.standard.prefixes=TRUE) == ">FORMALS|^x|^type|^allowNA|^keepNA|>STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^prefix\\.|>EXPLICIT")
expect.err(try(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=NULL)), "\"FORMALS\" specified in DROP, but FUNC is NULL")
expect.err(try(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=base::c)), "\"FORMALS\" specified but formals(FUNC) returned no formal arguments")
foo99 <- function(...) NULL
expect.err(try(plotmo:::expand.drop("FORMALS", prefix="prefix.", func=foo99)), "\"FORMALS\" specified but formals(FUNC) returned only \"...\"")
stopifnot(plotmo:::expand.drop("a,FORMALS", prefix="prefix.", func=base::nchar) == ">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a,FORMALS", prefix="prefix.", func=base::nchar, include.standard.prefixes=TRUE) == ">FORMALS|^x|^type|^allowNA|^keepNA|>STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^prefix\\.|>EXPLICIT|^a")
expect.err(try(plotmo:::expand.drop("", prefix="prefix.", func=base::nchar)), "DROP is an empty string")
stopifnot(plotmo:::expand.drop("a", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a", "lines.a", prefix="lines.", func=base::nchar, include.standard.prefixes=TRUE) == ">STANDARDPREFIXES|^force\\.|^def\\.|^drop\\.|>PREFIX|^lines\\.|>EXPLICIT|^a")
stopifnot(plotmo:::expand.drop("a*", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a.*")
stopifnot(plotmo:::expand.drop("a.*", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a\\..*")
stopifnot(plotmo:::expand.drop("a$", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a$")
stopifnot(plotmo:::expand.drop("a$,b*,c*$", prefix="lines.", func=base::nchar) == ">PREFIX|>EXPLICIT|^a$|^b.*|^c.*$")
stopifnot(plotmo:::expand.drop(c("a", "b,c", " d e$ f ", "g h$, i"), prefix="lines.", func=base::nchar) ==
">PREFIX|>EXPLICIT|^a|^b|^c|^d|^e$|^f|^g|^h$|^i")
stopifnot(plotmo:::expand.drop("PLOT.ARGS", prefix="lines.", func=base::nchar) ==
">PREFIX|>EXPLICIT|>PLOT_ARGS|^add$|^adj$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^family$|^font$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lend$|^ljoin$|^lmitre$|^lty$|^lwd$|^main$|^pch$|^srt$|^xaxp$|^xaxs$|^xaxt$|^xlab$|^xlim$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylab$|^ylim$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,PLOT.ARGS", prefix="lines.", func=base::nchar) ==
">PREFIX|>EXPLICIT|^abc|>PLOT_ARGS|^add$|^adj$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^family$|^font$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lend$|^ljoin$|^lmitre$|^lty$|^lwd$|^main$|^pch$|^srt$|^xaxp$|^xaxs$|^xaxt$|^xlab$|^xlim$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylab$|^ylim$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,FORMALS,PLOT.ARGS", prefix="lines.", func=base::nchar) ==
">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^abc|>PLOT_ARGS|^add$|^adj$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^family$|^font$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lend$|^ljoin$|^lmitre$|^lty$|^lwd$|^main$|^pch$|^srt$|^xaxp$|^xaxs$|^xaxt$|^xlab$|^xlim$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylab$|^ylim$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,FORMALS,PAR.ARGS", prefix="lines.", func=base::nchar) ==
">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^abc|>PAR_ARGS|^adj$|^ann$|^ask$|^bg$|^bty$|^cex$|^cex\\.axis$|^cex\\.lab$|^cex\\.main$|^cex\\.sub$|^col\\.axis$|^col\\.lab$|^col\\.main$|^col\\.sub$|^crt$|^err$|^family$|^fg$|^fig$|^fin$|^font$|^font\\.axis$|^font\\.lab$|^font\\.main$|^font\\.sub$|^lab$|^las$|^lend$|^lheight$|^ljoin$|^lmitre$|^lty$|^mai$|^mar$|^mex$|^mfcol$|^mfg$|^mfrow$|^mgp$|^mkh$|^new$|^oma$|^omd$|^omi$|^pch$|^pin$|^plt$|^ps$|^pty$|^srt$|^tck$|^tcl$|^usr$|^xaxp$|^xaxs$|^xaxt$|^xlog$|^xpd$|^yaxp$|^yaxs$|^yaxt$|^ylbias$|^ylog$")
stopifnot(plotmo:::expand.drop("abc,FORMALS,PLOTMO.ARGS", prefix="lines.", func=base::nchar) ==
">FORMALS|^x|^type|^allowNA|^keepNA|>PREFIX|>EXPLICIT|^abc|>PLOTMO_ARGS|^caption\\.|^cex\\.|^col\\.|^contour\\.|^cum\\.|^degree1\\.|^degree2\\.|^density\\.|^filled\\.contour\\.|^font\\.|^func\\.|^grid\\.|^heatmap\\.|^image\\.|^jitter\\.|^legend\\.|^label\\.|^level\\.|^line\\.|^lines\\.|^lty\\.|^lty\\.|^lwd\\.|^main\\.|^mtext\\.|^nresiduals|^par\\.|^pch\\.|^persp\\.|^plot\\.|^plotmath\\.|^prednames\\.|^qq\\.|^qqline\\.|^pt\\.|^response\\.|^rug\\.|^smooth\\.|^text\\.|^title\\.|^vfont\\.")
test.deprefix <- function(expected, ..., FNAME="test.deprefix", KEEP=NULL)
{
args <- plotmo:::deprefix(..., FNAME=FNAME, KEEP=KEEP, CALLARGS="")
# can't use all.equal because it complains about names
# cat("args:\n")
# print(args)
# cat("expected:\n")
# print(expected)
stopifnot(length(args) == length(expected))
for(i in seq_len(length(expected))) {
stopifnot(names(args)[i] == names(expected)[i])
stopifnot(args[[i]] == expected[[i]])
}
}
cat0("=== test deprefix\n")
test.deprefix(
expected=list(a=1, b=2), DROP="*",
PREFIX="predict.", def.a=1, predict.b=2, c=3)
test.deprefix(TRACE=2,
expected=list(b="predict.b", d="def.d", c="predict.c", e="predict.e"),
PREFIX="predict.", DROP="*",
a="a", b="b", c="c", w1.xlab="xlab",
def.b="def.b", def.d="def.d",
predict.b="predict.b", predict.c="predict.c", predict.e="predict.e")
test.deprefix(TRACE=2,
expected=list(b="predict.b", d="def.d", a="a", c="predict.c", e="predict.e"),
KEEP=NULL, PREFIX="predict.", DROP="w1.",
a="a", b="b", c="c", w1.xlab="xlab",
def.b="def.b", def.d="def.d",
predict.b="predict.b", predict.c="predict.c", predict.e="predict.e")
test.deprefix(
expected=list(a="predict.a"),
KEEP=NULL, PREFIX="predict.", DROP="w1.",
a="plain.a", predict.a="predict.a")
test.deprefix(expected=list(a="aa1"),
KEEP=NULL, PREFIX="predict.", a="aa1")
test.deprefix(expected=list(a="aa2"),
KEEP=NULL, PREFIX="predict.", def.a="aa2")
test.deprefix(expected=list(a="aa3", b="bb3"),
KEEP=NULL, PREFIX="predict.", def.a="aa3", b="bb3")
test.deprefix(expected=list(10, 20), TRACE=2,
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon2=20, force.anon1=10)
test.deprefix(expected=list(10, 20, a=3), TRACE=2,
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon2=20, force.anon1=10,
a=3)
expect.err(try(test.deprefix(expected=list(10, 20, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon=10, force.anon=20,
a=3, predict.a=4)),
"argument 'force.anon' for test.deprefix() is duplicated")
expect.err(try(test.deprefix(expected=list(10, 20, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.", FNAME="foobar",
force.anon=10, force.anon=20,
a=3, predict.a=4)),
"argument 'force.anon' for foobar() is duplicated")
test.deprefix(expected=list(10, 20, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20,
a=3, predict.a=4)
test.deprefix(expected=list(10, 20, b=3, a=4),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20, def.b=3,
a=3, predict.a=4)
test.deprefix(expected=list(10, 20, b=5, a=3),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20, def.b=3,
a=3, predict.b=5)
test.deprefix(expected=list(10, 20, b=6, a=3),
KEEP=NULL, DROP="w1.,persp.,xlab.",
PREFIX="predict.",
force.anon1=10, force.anon2=20, def.b=3,
a=3, b=6)
expect.err(try(test.deprefix(expected=NULL, KEEP=NULL, PREFIX="predict.", DROP="w1\\.")), "illegal character \"\\\" in DROP = \"w1\\.\"")
test.deprefix(expected=list(b="predict.b", d="def.d", a="a", c="predict.c", w1.xl="xlab2", e="predict.e"),
PREFIX="predict.", DROP="w1.xlab$",
a="a", b="b", c="c",
w1.xlab="xlab1", # will be dropped (exact match)
w1.xl="xlab2", # will be kept (not an exact match)
def.b="def.b", def.d="def.d",
predict.b="predict.b", predict.c="predict.c", predict.e="predict.e")
# expect.err(try(plotmo:::deprefix(FNAME="test.deprefix", PREFIX="predict.", UPPER.CASE123=99,
# def.a=1, predict.b=2, c=3)),
# "uppercase argument names like \"UPPER.CASE123\" are not allowed for test.deprefix()")
test.expand.dotnames <- function(expected, PREFIX, FUNC=NULL,
FNAME="test.expand.dotnames", FORMALS=NULL, ...)
{
dots <- as.list(match.call(expand.dots=FALSE)$...)
args <- plotmo:::expand.dotnames(dots, PREFIX, FUNC, FNAME, FORMALS)
# can't use all.equal because it complains about named list versus unnamed list
stopifnot(length(args) == length(expected))
for(i in seq_len(length(expected))) {
stopifnot(names(args)[i] == names(expected)[i])
stopifnot(eval(args[[i]]) == expected[[i]])
}
}
cat0("=== test expand.dotnames\n")
test.expand.dotnames(expected=list(x=9, persp.shade=3),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.sh=3)
test.expand.dotnames(expected=list(x=9, persp.shade=3, persp.nonesuch=4),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.sh=3, persp.nonesuch=4)
test.expand.dotnames(expected=list(x=9, persp.col=3),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.c=3)
# TODO not sure why this works as it does
test.expand.dotnames(expected=list(x=9, persp.x=3),
"persp.", graphics:::persp.default, "persp.default", x=9, persp.x=3)
expect.err(try(test.expand.dotnames(expected=NULL,
"persp.", graphics:::persp.default, "persp.default", x=9, persp.l=3)),
"'l' matches both the 'ltheta' and 'lphi' arguments of persp.default()")
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xlim=c(1,2))
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xli=c(1,2))
expect.err(try(test.expand.dotnames(expected=NULL,
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xl=c(1,2))),
"'xl' matches both the 'xlim' and 'xlab' arguments of plot.default()")
foo3 <- function(aaa=1, aa=2, bb=3, bba=4, cca=5, ccb=6, def=7)
cat0("foo3: aaa=", aaa, " aa=", aa, ", bb=", bb, " bba=", bba,
" cca=", cca, " ccb=", ccb, " def=", def, "\n")
# --- above tests again but using formals ---
# formal args for graphics:::persp.default (R version 3.2.0)
formals <- c( "x", "y", "z", "xlim", "zlim", "xlab", "ylab", "zlab",
"main", "sub", "theta", "phi", "r", "d", "scale", "expand", "col",
"border", "ltheta", "lphi", "shade", "box", "axes", "nticks",
"ticktype")
test.expand.dotnames(expected=list(x=9, persp.shade=3),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.sh=3)
test.expand.dotnames(expected=list(x=9, persp.shade=3, persp.nonesuch=4),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.sh=3, persp.nonesuch=4)
test.expand.dotnames(expected=list(x=9, persp.col=3),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.c=3)
# TODO not sure why this works as it does
test.expand.dotnames(expected=list(x=9, persp.x=3),
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.x=3)
expect.err(try(test.expand.dotnames(expected=NULL,
"persp.", graphics:::persp, "persp", FORMALS=formals, x=9, persp.l=3)),
"'l' matches both the 'ltheta' and 'lphi' arguments of persp()")
# done formals tests
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xlim=c(1,2))
test.expand.dotnames(expected=list(x=9, plot.foo=3, plot.xlim=c(1,2)),
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xli=c(1,2))
expect.err(try(test.expand.dotnames(expected=NULL,
"plot.", graphics:::plot.default, "plot.default", x=9, plot.foo=3, plot.xl=c(1,2))),
"'xl' matches both the 'xlim' and 'xlab' arguments of plot.default()")
test.expand.dotnames(expected=list(foo3.aa=99),
"foo3.", foo3, "foo3", foo3.aa=99)
expect.err(try(plotmo:::call.plot(foo3, "foo3.", foo3.aa=99)), "Unnamed arguments are not allowed here\n The argument's value is \"foo3.\"")
expect.err(try(plotmo:::call.plot(foo3, foo, foo3.aa=99)),
"Unnamed arguments are not allowed here\n The argument's value is function.object")
expect.err(try(plotmo:::call.plot(foo3, NULL, foo3.aa=99)), "Unnamed arguments are not allowed here\n The argument's value is NULL")
expect.err(try(plotmo:::call.plot(foo3, stop("stop was called"), foo3.aa=99)), "Unnamed arguments are not allowed here (argument ..1 is unnamed)")
expect.err(try(plotmo:::call.plot(foo3, cat("side effect\n"), foo3.aa=99)), "Unnamed arguments are not allowed here\n The argument's value is NULL")
expect.err(try(plotmo:::call.plot(foo3, nonesuch1=1, nonesuch2, foo3.aa=99)), "Unnamed arguments are not allowed here (argument ..2 is unnamed)")
plotmo:::call.plot(foo3, PREFIX="foo3.", foo3.aa=99)
test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.aaa=99)
plotmo:::call.plot(foo3, foo3.aaa=99)
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.aa=88, foo3.aa=99)),
"'foo3.aa' for foo3() is duplicated")
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.a=88, foo3.aa=99)),
"'a' matches both the 'aaa' and 'aa' arguments of foo3()")
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", foo3, "foo3", foo3.aaa=88, foo3.aaa=99)),
"'foo3.aaa' for foo3() is duplicated")
test.expand.dotnames(expected=list(foo3.bbb=88, foo3.bba=99),
"foo3.", foo3, "foo3", foo3.bbb=88, foo3.bba=99)
expect.err(try(plotmo:::call.plot(foo3, foo3.bbb=88, foo3.bba=99)),
"unused argument (bbb = 88)")
# same as above but with TRACE (so don't use try in call.dots)
expect.err(try(plotmo:::call.plot(foo3, foo3.bbb=88, foo3.bba=99, TRACE=T)),
"unused argument (bbb = 88)")
test.expand.dotnames(expected=list(foo3.bb=88),
"foo3.", foo3, "foo3", foo3.bb=88)
plotmo:::call.plot(foo3, foo3.bb=88)
# test with FUNC=NULL
test.expand.dotnames(expected=list(foo3.aa=99),
"foo3.", NULL, "foo3", foo3.aa=99)
plotmo:::call.plot(foo3, foo3.aa=99)
test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", NULL, "foo3", foo3.aaa=99)
plotmo:::call.plot(foo3, foo3.aaa=99)
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", NULL, "foo3", foo3.aa=88, foo3.aa=99)),
"argument 'foo3.aa' for foo3() is duplicated")
test.expand.dotnames(expected=list(foo3.a=88, foo3.aa=99),
"foo3.", NULL, "foo3", foo3.a=88, foo3.aa=99)
expect.err(try(plotmo:::call.plot(foo3, foo3.a=88, foo3.aa=99)),
"'a' matches both the 'aaa' and 'aa' arguments of foo3()")
expect.err(try(test.expand.dotnames(expected=list(foo3.aaa=99),
"foo3.", NULL, "foo3", foo3.aaa=88, foo3.aaa=99)),
"argument 'foo3.aaa' for foo3() is duplicated")
test.expand.dotnames(expected=list(foo3.bbb=88, foo3.bba=99),
"foo3.", NULL, "foo3", foo3.bbb=88, foo3.bba=99)
expect.err(try(plotmo:::call.plot(foo3, PREFIX="foo3.", foo3.bbb=88, foo3.bba=99)),
"unused argument (bbb = 88)")
test.expand.dotnames(expected=list(foo3.bb=88),
"foo3.", NULL, "foo3", foo3.bb=88)
plotmo:::call.plot(foo3, foo3.bb=88)
test.expand.dotnames(expected=list(foo3.bbx=88),
"foo3.", NULL, "foo3", foo3.bbx=88)
expect.err(try(plotmo:::call.plot(foo3, foo3.bbx=88)),
"unused argument (bbx = 88)")
test.expand.dotnames(expected=list(foo3.cc=77),
"foo3.", NULL, "foo3", foo3.cc=77)
expect.err(try(plotmo:::call.plot(foo3, foo3.cc=77)),
"'cc' matches both the 'cca' and 'ccb' arguments of foo3()")
# following two directly compare FUNC=NULL to FUNC=foo3
test.expand.dotnames(expected=list(foo3.cc=77),
"foo3.", FUNC=NULL, "foo3", foo3.cc=77)
expect.err(try(test.expand.dotnames(expected=NULL,
"foo3.", FUNC=foo3, "foo3", foo3.cc=77)),
"'cc' matches both the 'cca' and 'ccb' arguments of foo3()")
test.expand.dotnames(expected=list(), "foo3.", foo3, "foo3", d=88, de=99)
expect.err(try(plotmo:::call.plot(graphics::plot, x=1:3, y=1:3, 99)),
"Unnamed arguments are not allowed here\n The argument's value is 99\n plotmo:::call.plot via try called call.dots(FUNC=plot, PREFIX=PREFIX, ...")
# test TRACE
print(plotmo:::deprefix(FUNC=nchar, PREFIX="foo3.", TRACE=TRUE, FNAME="nchar", allowN=1, b=2, foo3.c=3))
print(plotmo:::deprefix(FUNC=nchar, PREFIX="foo3.", TRACE=2, allowN=1, b=2, foo3.c=3))
print(plotmo:::deprefix(FUNC=nchar, PREFIX="foo3.", TRACE=3, allowN=1, b=2, foo3.c=3))
expect.err(try(plotmo:::call.plot(foo3, foo3.d=88, foo3.de=99)),
"'foo3.d' and 'foo3.de' both match the 'def' argument of foo3()")
cat0("=== test stop.if.dots\n")
foo3 <- function(x=1, ...) plotmo:::stop.if.dots(...)
foo3(1) # ok
expect.err(try(foo3(10, y=2)), "foo3: unrecognized argument 'y'")
expect.err(try(foo3(10, 99)), "foo3: unrecognized unnamed argument\n The call was foo3(x=10, 99)")
expect.err(try(foo3(10, y=plot)), "foo3: unrecognized argument 'y'")
expect.err(try(foo3(10, plot)),
"foo3: unrecognized unnamed argument\n The call was foo3(x=10, plot)")
expect.err(try(foo3(20, c(1,2,3), plot)),
"foo3: unrecognized unnamed argument\n The call was foo3(x=20, c(1,2,3), plot)")
expect.err(try(foo3(20, c(1,2,3,4,5,6,7,8,9,10,11,12), plot)),
"foo3: unrecognized unnamed argument\n The call was foo3(x=20, c(1,2,3,4,5,6,7,8,9,10,11,12), plot)")
# test that we don't crash because we eval the argument
expect.err(try(foo3(20, y=stop("stop was called"))), "foo3: unrecognized argument 'y'")
expect.err(try(foo3(20, stop("stop was called"))), "foo3: unrecognized unnamed argument")
expect.err(try(foo3(20, cat("side effect\n"))),
"foo3: unrecognized unnamed argument\n The call was foo3(x=20, cat(")
foo2 <- function(...) plotmo:::stop.if.dots(...)
foo2() # ok
expect.err(try(foo2(y=2)), "foo2: unrecognized argument 'y'")
expect.err(try(foo2(2)), "foo2: unrecognized unnamed argument\n The call was foo2(2)")
expect.err(try(foo2(y=plot)), "foo2: unrecognized argument 'y'")
expect.err(try(foo2(plot)),
"foo2: unrecognized unnamed argument\n The call was foo2(plot)")
foo2a <- function(funcarg, ...) funcarg(...)
expect.err(try(foo2a(function(x=1, ...) plotmo:::stop.if.dots(...), x=1, y=2)), "funcarg: unrecognized argument 'y'")
cat0("=== test warn.if.dots\n")
options(warn=2) # treat warnings as errors
foo3 <- function(x=1, ...) plotmo:::warn.if.dots(...)
foo3(1) # ok
expect.err(try(foo3(1, y=2)), "foo3 ignored argument 'y'")
expect.err(try(foo3(1, 2)), "foo3 ignored unnamed argument\n The call was foo3(x=1, 2)")
expect.err(try(foo3(1, y=plot)), "foo3 ignored argument 'y'")
# TODO would like to improve this error messsage
expect.err(try(foo3(1, plot)),
"(converted from warning) foo3 ignored unnamed argument\n The call was foo3(x=1, plot)")
foo4 <- function(...) plotmo:::warn.if.dots(...)
foo4() # ok
expect.err(try(foo4(y=2)), "foo4 ignored argument 'y'")
expect.err(try(foo4(2)), "foo4 ignored unnamed argument\n The call was foo4(2)")
expect.err(try(foo4(y=plot)), "foo4 ignored argument 'y'")
expect.err(try(foo4(plot)),
"(converted from warning) foo4 ignored unnamed argument\n The call was foo4(plot)")
options(warn=1)
foo3(1, nonesuch=12, nonesuch2=12, 999) # expect three warnings
cat0("=== test using sample functions that invoke call.dots\n")
x <- 1:10
y <- x * x
lmfit <- lm(y~x)
par(mfrow=c(3, 2))
par(oma=c(0, 0, 3, 0))
# plot1: simple example
# we choose to use predict() here rather than fitted() because nearly all
# models have a fitted() method, but many don't have a fitted() method.
plot1 <- function(object, ...)
{
residuals <- residuals(object, ...)
fitted <- predict(object, ...)
plot(fitted, residuals, ...)
}
plot1(lmfit)
mtext("example plot functions using prefixed dots", outer=TRUE, font=2, line=1, cex=1)
# Following causes error in predict.lm(). The type argument meant for
# residuals() is also sent to predict.lm(), where it is rejected.
expect.err(try(plot1(lmfit, type="pearson")), "'arg' should be one of \"response\", \"terms\"")
# plot2: use prefixed args
plot2 <- function(object, ..., TRACE=2)
{
resids <- plotmo:::call.dots(residuals, object=object, ..., TRACE=TRACE)
fitted <- plotmo:::call.dots(predict, object=object, ..., TRACE=TRACE)
plotmo:::call.plot(plot, x=fitted, y=resids, ..., TRACE=TRACE)
}
# we can now direct args using the prefixes "residuals.", "predict.", or "plot.")
plot2(lmfit, residuals.type="pearson")
# We can also use the usual plot arguments like ylab: call.dots drops
# them; call.plot recognizes them and passes them to lines().
plot2(lmfit, residuals.type="pearson", ylab="pearson residuals", main="plot2")
# plot3: further refinements
# o namespace added to FUNC arg
# o full name for plot.default
# o force. and def. prefixes
# o explicit xlab and ylab for call.plot
# o unprefixed args are passed to residuals()
plot3 <- function(object, ..., TRACE=2)
{
resids <- plotmo:::call.dots(stats::residuals,
DROP="plotmo:::PLOTARGS,predict.,plot.",
TRACE=TRACE, force.object=object, ...)
fitted <- plotmo:::call.dots(stats::predict,
force.object=object, TRACE=TRACE, ...)
plotmo:::call.plot(graphics::plot.default, force.x=fitted, force.y=resids,
def.xlab="fitted", def.ylab="residuals",
TRACE=TRACE, ...)
}
plot3(lmfit, type="pearson", main="plot3a") # type goes only to pearson, no prefix needed
plot3(lmfit, type="pearson", predict.type="response", main="plot3b")
cat0("=== test callers.name\n")
test.callers.name <- function(x) {
caller0 <- plotmo:::callers.name(0) # test.callers.name
caller1 <- plotmo:::callers.name(1) # caller of test.callers.name
caller99 <- plotmo:::callers.name(99) # sys.call(-n) : not that many frames on the stack
s <- sprint("0 %s 1 %s 99 %s", caller0, caller1, caller99)
cat(s, "\n", sep="")
s
}
print(plotmo:::callers.name()) # "eval"
myfunc <- function(func) func()
stopifnot(myfunc(function(x) test.callers.name(99)) == "0 test.callers.name 1 func 99 unknown")
stopifnot(test.callers.name() == "0 test.callers.name 1 stopifnot 99 unknown")
source("test.epilog.R")
Try the plotmo package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.