[Robast-commits] r175 - branches/robast-0.7/pkg/RobAStBase/R branches/robast-0.7/pkg/RobAStBase/man pkg/ROptEst/chm pkg/RobAStBase/R pkg/RobAStBase/chm pkg/RobAStBase/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Oct 11 01:29:11 CEST 2008
Author: ruckdeschel
Date: 2008-10-11 01:29:11 +0200 (Sat, 11 Oct 2008)
New Revision: 175
Modified:
branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R
branches/robast-0.7/pkg/RobAStBase/R/AllPlot.R
branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R
branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R
branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd
pkg/ROptEst/chm/ROptEst.chm
pkg/RobAStBase/R/AllGeneric.R
pkg/RobAStBase/R/AllPlot.R
pkg/RobAStBase/R/comparePlot.R
pkg/RobAStBase/R/infoPlot.R
pkg/RobAStBase/chm/RobAStBase.chm
pkg/RobAStBase/chm/infoPlot.html
pkg/RobAStBase/man/infoPlot.Rd
Log:
plots in RobAStBase now can digest ..., in particular panel.first=grid().
Modified: branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R 2008-10-06 22:07:19 UTC (rev 174)
+++ branches/robast-0.7/pkg/RobAStBase/R/AllGeneric.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -97,7 +97,7 @@
setGeneric("locMEstimator", function(x, IC, ...) standardGeneric("locMEstimator"))
}
if(!isGeneric("infoPlot")){
- setGeneric("infoPlot", function(object) standardGeneric("infoPlot"))
+ setGeneric("infoPlot", function(object,...) standardGeneric("infoPlot"))
}
if(!isGeneric("optIC")){
setGeneric("optIC", function(model, risk, ...) standardGeneric("optIC"))
Modified: branches/robast-0.7/pkg/RobAStBase/R/AllPlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/AllPlot.R 2008-10-06 22:07:19 UTC (rev 174)
+++ branches/robast-0.7/pkg/RobAStBase/R/AllPlot.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -1,5 +1,10 @@
setMethod("plot", "IC",
function(x,y=NULL,...){
+
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
+
L2Fam <- eval(x at CallL2Fam)
e1 <- L2Fam at distribution
if(!is(e1, "UnivariateDistribution")) stop("not yet implemented")
@@ -24,6 +29,14 @@
}
}
+
+ if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
+ if(!is.null(dots[["type"]])) dots["type"] <- NULL
+ if(!is.null(dots[["main"]])) dots["main"] <- NULL
+ if(!is.null(dots[["sub"]])) dots["sub"] <- NULL
+ if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
+ if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
+
dims <- nrow(L2Fam at param@trafo)
IC1 <- as(diag(dims) %*% x at Curve, "EuclRandVariable")
@@ -33,20 +46,33 @@
nrows <- trunc(sqrt(dims))
ncols <- ceiling(dims/nrows)
par(mfrow = c(nrows, ncols))
+
+ if(is.null(dots[["cex.main"]])) dots["cex.main"] <- 0.8
+
for(i in 1:dims){
- plot(x.vec, sapply(x.vec, IC1 at Map[[i]]), type = plty, lty = lty,
- xlab = "x", ylab = "(partial) IC")
+ do.call(plot, args=c(list(x.vec, sapply(x.vec, IC1 at Map[[i]]),
+ type = plty, lty = lty,
+ xlab = "x", ylab = "(partial) IC"),
+ dots))
if(is(e1, "DiscreteDistribution")){
x.vec1 <- seq(from = min(x.vec), to = max(x.vec), length = 1000)
- lines(x.vec1, sapply(x.vec1, IC1 at Map[[i]]), lty = "dotted")
+ do.call(lines,args=c(list(x.vec1, sapply(x.vec1, IC1 at Map[[i]]),
+ lty = "dotted"), dots))
}
if(is.null(L2Fam at param@nuisance))
- title(paste("Component", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title,args=c(list(paste("Component", i,
+ "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "),
+ ")")), dots))
else
- title(paste("Component", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title,args=c(list(paste("Component", i,
+ "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "),
+ ")\nand nuisance parameter (",
+ paste(round(L2Fam at param@nuisance, 3), collapse = ", "),
+ ")")), dots))
}
par(opar)
options(w0)
Modified: branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2008-10-06 22:07:19 UTC (rev 174)
+++ branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -1,5 +1,30 @@
setMethod("comparePlot", signature("IC","IC"),
function(obj1,obj2, obj3 = NULL, obj4 = NULL, ...){
+
+ xc1 <- as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj1))
+ xc2 <- as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj2))
+ xc <- c(xc1,xc2)
+ if(!is.null(obj3))
+ xc <- c(xc,as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj3)))
+ if(!is.null(obj4))
+ xc <- c(xc,as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj4)))
+
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
+ ncomp <- 2+ !is.null(obj3) + !is.null(obj4)
+
+ if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
+ if(!is.null(dots[["type"]])) dots["type"] <- NULL
+ if(!is.null(dots[["main"]])) dots["main"] <- NULL
+ if(!is.null(dots[["sub"]])) dots["sub"] <- NULL
+ if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
+ if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
+ if(is.null(dots[["col"]])) dots$"col" <- 1:ncomp
+ if(is.null(dots[["cex.main"]])) dots$"cex.main" <- 0.8
+ if(is.null(dots[["lwd"]])) dots$"lwd" <- 1
+
+
L2Fam <- eval(obj1 at CallL2Fam)
L2Fam1c <- obj1 at CallL2Fam
L2Fam2c <- obj2 at CallL2Fam
@@ -66,26 +91,33 @@
if(is(obj4, "IC"))
matp <- cbind(matp,sapply(x.vec, IC4 at Map[[i]]))
- matplot(x.vec, matp,
+ do.call(matplot, args=c(list( x= x.vec, y=matp,
type = plty, lty = lty,
- xlab = "x", ylab = "(partial) IC")
+ xlab = "x", ylab = "(partial) IC"), dots))
if(is(e1, "DiscreteDistribution")){
matp1 <- cbind(sapply(x.vec1, IC1 at Map[[i]]),sapply(x.vec1, IC2 at Map[[i]]))
if(is(obj3, "IC"))
matp1 <- cbind(matp1,sapply(x.vec1, IC3 at Map[[i]]))
if(is(obj4, "IC"))
matp1 <- cbind(matp1,sapply(x.vec1, IC4 at Map[[i]]))
- matlines(x.vec1, matp1, lty = "dotted")
+ do.call(matlines, c(list(x.vec1, matp1, lty = "dotted"),dots))
}
if(is.null(L2Fam at param@nuisance))
- title(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, c(list(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
+ "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")")),
+ dots))
else
- title(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
+ do.call(title, c(list(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
"\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"), cex.main = 0.8)
+ ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")")),
+ dots))
}
+
+ legend("bottomright",
+ legend = xc, col = eval(dots[["col"]]),
+ cex=0.75, lwd=eval(dots[["lwd"]])*1.5)
+
par(opar)
options(w0)
invisible()
Modified: branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2008-10-06 22:07:19 UTC (rev 174)
+++ branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -1,6 +1,26 @@
setMethod("infoPlot", "IC",
- function(object){
+ function(object, ...){
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
L2Fam <- eval(object at CallL2Fam)
+
+ if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
+ if(!is.null(dots[["type"]])) dots["type"] <- NULL
+ if(!is.null(dots[["main"]])) dots["main"] <- NULL
+ if(!is.null(dots[["sub"]])) dots["sub"] <- NULL
+ if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
+ if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
+ if(!is.null(dots[["xlim"]])) dots["xlim"] <- NULL
+ if(!is.null(dots[["ylim"]])) dots["ylim"] <- NULL
+ if(is.null(dots[["colA"]])) dots$"colA" <- grey(0.5)
+ if(is.null(dots[["colB"]])) dots$"colB" <- par("col")
+ if(is.null(dots[["lwdA"]])) dots$"lwdA" <- par("lwd")
+ if(is.null(dots[["lwdB"]])) dots$"lwdB" <- 2
+ if(is.null(dots[["cex.main"]])) dots$"cex.main" <- 0.8
+
+
+
e1 <- L2Fam at distribution
if(!is(e1, "UnivariateDistribution") | is(e1, "CondDistribution"))
stop("not yet implemented")
@@ -45,21 +65,32 @@
absInfo <- t(IC1) %*% QF %*% IC1
absInfo <- sapply(x.vec, absInfo at Map[[1]])
- plot(x.vec, absInfoClass, type = plty, lty = "dashed",
+ dots["col"] <- dots[["colA"]]
+ dots["lwd"] <- dots[["lwdA"]]
+ do.call(plot, args=c(list(x.vec, absInfoClass, type = plty,
+ lty = "dashed",
ylim = c(0, 2*max(absInfo, na.rm = TRUE)), xlab = "x",
- ylab = "absolute information", col = grey(0.5))
- lines(x.vec, absInfo, type = plty, lty = lty, lwd = 2)
+ ylab = "absolute information"), dots))
+ dots["col"] <- dots[["colB"]]
+ dots["lwd"] <- dots[["lwdB"]]
+ do.call(lines, args=c(list(x.vec, absInfo, type = plty, lty = lty),
+ dots))
legend(max(x.vec), 0, xjust = 1, yjust = 0,
- legend = c("class. opt. IC"), lty = "dashed", col = c(grey(0.5)), cex=0.75)
+ legend = c("class. opt. IC"), lty = "dashed",
+ col = c(dots[["colA"]]), cex=0.75)
if(is.null(L2Fam at param@nuisance))
- title(paste("Absolute information of (partial) IC for", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, args=c(list(paste("Absolute information of (partial) IC for",
+ name(L2Fam)[1], "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "), ")")),
+ dots))
else
- title(paste("Absolute information of (partial) IC for", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"),
- cex.main = 0.8)
+ do.call(title, args=c(list(paste("Absolute information of (partial) IC for",
+ name(L2Fam)[1], "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "),
+ ")\nand nuisance parameter (",
+ paste(round(L2Fam at param@nuisance, 3), collapse = ", "),
+ ")")), dots))
if(dims > 1){
nrows <- trunc(sqrt(dims))
@@ -73,22 +104,38 @@
classIC.i.5 <- QFc.5%*%classIC
for(i in 1:dims){
y.vec <- sapply(x.vec, IC1.i.5 at Map[[i]])^2/absInfo
- plot(x.vec, y.vec, type = plty, lty = lty, lwd = 2,
- xlab = "x", ylab = "relative information", ylim = c(0, 1.1))
+ dots["col"] <- dots[["colB"]]
+ dots["lwd"] <- dots[["lwdA"]]
+ do.call(plot, args=c(list(x.vec, y.vec, type = plty,
+ lty = lty, xlab = "x",
+ ylab = "relative information",
+ ylim = c(0, 1.1)), dots))
yc.vec <- sapply(x.vec, classIC.i.5 at Map[[i]])^2/absInfoClass
- lines(x.vec, yc.vec, type = plty,
- lty = "dashed", col = grey(0.5))
+ dots["col"] <- dots[["colA"]]
+ dots["lwd"] <- dots[["lwdB"]]
+ do.call(lines, args=c(list(x.vec, yc.vec, type = plty,
+ lty = "dashed"),dots))
legend(max(x.vec), 1.1, xjust = 1, cex = 0.6,
- legend = c("class. opt. IC"), lty = "dashed", col = c(grey(0.5)))
+ legend = c("class. opt. IC"), lty = "dashed",
+ col = c(dots[["colA"]]))
if(is.null(L2Fam at param@nuisance))
- title(paste("Relative information of\ncomponent", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, args=c(list(paste("Relative information of\ncomponent",
+ i, "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3),
+ collapse = ", "), ")")),
+ dots))
else
- title(paste("Relative information of\ncomponent", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"),
- cex.main = 0.8)
+ do.call(title, args=c(list(paste("Relative information of\ncomponent",
+ i, "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3),
+ collapse = ", "),
+ ")\nand nuisance parameter (",
+ paste(round(L2Fam at param@nuisance, 3),
+ collapse = ", "), ")")),
+ dots))
}
}
par(opar)
Modified: branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd 2008-10-06 22:07:19 UTC (rev 174)
+++ branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd 2008-10-10 23:29:11 UTC (rev 175)
@@ -6,10 +6,11 @@
Plot absolute and relative information of influence curves.
}
\usage{
-infoPlot(object)
+infoPlot(object, ...)
}
\arguments{
\item{object}{ object of class \code{"InfluenceCurve"} }
+ \item{\dots} {further parameters for \code{plot}}
}
\details{
Absolute information is defined as the square of the length
Modified: pkg/ROptEst/chm/ROptEst.chm
===================================================================
(Binary files differ)
Modified: pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- pkg/RobAStBase/R/AllGeneric.R 2008-10-06 22:07:19 UTC (rev 174)
+++ pkg/RobAStBase/R/AllGeneric.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -97,7 +97,7 @@
setGeneric("locMEstimator", function(x, IC, ...) standardGeneric("locMEstimator"))
}
if(!isGeneric("infoPlot")){
- setGeneric("infoPlot", function(object) standardGeneric("infoPlot"))
+ setGeneric("infoPlot", function(object,...) standardGeneric("infoPlot"))
}
if(!isGeneric("optIC")){
setGeneric("optIC", function(model, risk, ...) standardGeneric("optIC"))
Modified: pkg/RobAStBase/R/AllPlot.R
===================================================================
--- pkg/RobAStBase/R/AllPlot.R 2008-10-06 22:07:19 UTC (rev 174)
+++ pkg/RobAStBase/R/AllPlot.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -1,5 +1,10 @@
setMethod("plot", "IC",
function(x,y=NULL,...){
+
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
+
L2Fam <- eval(x at CallL2Fam)
e1 <- L2Fam at distribution
if(!is(e1, "UnivariateDistribution")) stop("not yet implemented")
@@ -24,6 +29,14 @@
}
}
+
+ if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
+ if(!is.null(dots[["type"]])) dots["type"] <- NULL
+ if(!is.null(dots[["main"]])) dots["main"] <- NULL
+ if(!is.null(dots[["sub"]])) dots["sub"] <- NULL
+ if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
+ if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
+
dims <- nrow(L2Fam at param@trafo)
IC1 <- as(diag(dims) %*% x at Curve, "EuclRandVariable")
@@ -33,20 +46,33 @@
nrows <- trunc(sqrt(dims))
ncols <- ceiling(dims/nrows)
par(mfrow = c(nrows, ncols))
+
+ if(is.null(dots[["cex.main"]])) dots["cex.main"] <- 0.8
+
for(i in 1:dims){
- plot(x.vec, sapply(x.vec, IC1 at Map[[i]]), type = plty, lty = lty,
- xlab = "x", ylab = "(partial) IC")
+ do.call(plot, args=c(list(x.vec, sapply(x.vec, IC1 at Map[[i]]),
+ type = plty, lty = lty,
+ xlab = "x", ylab = "(partial) IC"),
+ dots))
if(is(e1, "DiscreteDistribution")){
x.vec1 <- seq(from = min(x.vec), to = max(x.vec), length = 1000)
- lines(x.vec1, sapply(x.vec1, IC1 at Map[[i]]), lty = "dotted")
+ do.call(lines,args=c(list(x.vec1, sapply(x.vec1, IC1 at Map[[i]]),
+ lty = "dotted"), dots))
}
if(is.null(L2Fam at param@nuisance))
- title(paste("Component", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title,args=c(list(paste("Component", i,
+ "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "),
+ ")")), dots))
else
- title(paste("Component", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title,args=c(list(paste("Component", i,
+ "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "),
+ ")\nand nuisance parameter (",
+ paste(round(L2Fam at param@nuisance, 3), collapse = ", "),
+ ")")), dots))
}
par(opar)
options(w0)
Modified: pkg/RobAStBase/R/comparePlot.R
===================================================================
--- pkg/RobAStBase/R/comparePlot.R 2008-10-06 22:07:19 UTC (rev 174)
+++ pkg/RobAStBase/R/comparePlot.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -1,5 +1,30 @@
setMethod("comparePlot", signature("IC","IC"),
function(obj1,obj2, obj3 = NULL, obj4 = NULL, ...){
+
+ xc1 <- as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj1))
+ xc2 <- as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj2))
+ xc <- c(xc1,xc2)
+ if(!is.null(obj3))
+ xc <- c(xc,as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj3)))
+ if(!is.null(obj4))
+ xc <- c(xc,as.character(deparse(match.call(call = sys.call(sys.parent(1)))$obj4)))
+
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
+ ncomp <- 2+ !is.null(obj3) + !is.null(obj4)
+
+ if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
+ if(!is.null(dots[["type"]])) dots["type"] <- NULL
+ if(!is.null(dots[["main"]])) dots["main"] <- NULL
+ if(!is.null(dots[["sub"]])) dots["sub"] <- NULL
+ if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
+ if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
+ if(is.null(dots[["col"]])) dots$"col" <- 1:ncomp
+ if(is.null(dots[["cex.main"]])) dots$"cex.main" <- 0.8
+ if(is.null(dots[["lwd"]])) dots$"lwd" <- 1
+
+
L2Fam <- eval(obj1 at CallL2Fam)
L2Fam1c <- obj1 at CallL2Fam
L2Fam2c <- obj2 at CallL2Fam
@@ -66,26 +91,33 @@
if(is(obj4, "IC"))
matp <- cbind(matp,sapply(x.vec, IC4 at Map[[i]]))
- matplot(x.vec, matp,
+ do.call(matplot, args=c(list( x= x.vec, y=matp,
type = plty, lty = lty,
- xlab = "x", ylab = "(partial) IC")
+ xlab = "x", ylab = "(partial) IC"), dots))
if(is(e1, "DiscreteDistribution")){
matp1 <- cbind(sapply(x.vec1, IC1 at Map[[i]]),sapply(x.vec1, IC2 at Map[[i]]))
if(is(obj3, "IC"))
matp1 <- cbind(matp1,sapply(x.vec1, IC3 at Map[[i]]))
if(is(obj4, "IC"))
matp1 <- cbind(matp1,sapply(x.vec1, IC4 at Map[[i]]))
- matlines(x.vec1, matp1, lty = "dotted")
+ do.call(matlines, c(list(x.vec1, matp1, lty = "dotted"),dots))
}
if(is.null(L2Fam at param@nuisance))
- title(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, c(list(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
+ "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")")),
+ dots))
else
- title(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
+ do.call(title, c(list(paste("Component", i, "of (partial) ICs\nfor", name(L2Fam)[1],
"\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"), cex.main = 0.8)
+ ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")")),
+ dots))
}
+
+ legend("bottomright",
+ legend = xc, col = eval(dots[["col"]]),
+ cex=0.75, lwd=eval(dots[["lwd"]])*1.5)
+
par(opar)
options(w0)
invisible()
Modified: pkg/RobAStBase/R/infoPlot.R
===================================================================
--- pkg/RobAStBase/R/infoPlot.R 2008-10-06 22:07:19 UTC (rev 174)
+++ pkg/RobAStBase/R/infoPlot.R 2008-10-10 23:29:11 UTC (rev 175)
@@ -1,6 +1,26 @@
setMethod("infoPlot", "IC",
- function(object){
+ function(object, ...){
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
L2Fam <- eval(object at CallL2Fam)
+
+ if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
+ if(!is.null(dots[["type"]])) dots["type"] <- NULL
+ if(!is.null(dots[["main"]])) dots["main"] <- NULL
+ if(!is.null(dots[["sub"]])) dots["sub"] <- NULL
+ if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
+ if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
+ if(!is.null(dots[["xlim"]])) dots["xlim"] <- NULL
+ if(!is.null(dots[["ylim"]])) dots["ylim"] <- NULL
+ if(is.null(dots[["colA"]])) dots$"colA" <- grey(0.5)
+ if(is.null(dots[["colB"]])) dots$"colB" <- par("col")
+ if(is.null(dots[["lwdA"]])) dots$"lwdA" <- par("lwd")
+ if(is.null(dots[["lwdB"]])) dots$"lwdB" <- 2
+ if(is.null(dots[["cex.main"]])) dots$"cex.main" <- 0.8
+
+
+
e1 <- L2Fam at distribution
if(!is(e1, "UnivariateDistribution") | is(e1, "CondDistribution"))
stop("not yet implemented")
@@ -45,21 +65,32 @@
absInfo <- t(IC1) %*% QF %*% IC1
absInfo <- sapply(x.vec, absInfo at Map[[1]])
- plot(x.vec, absInfoClass, type = plty, lty = "dashed",
+ dots["col"] <- dots[["colA"]]
+ dots["lwd"] <- dots[["lwdA"]]
+ do.call(plot, args=c(list(x.vec, absInfoClass, type = plty,
+ lty = "dashed",
ylim = c(0, 2*max(absInfo, na.rm = TRUE)), xlab = "x",
- ylab = "absolute information", col = grey(0.5))
- lines(x.vec, absInfo, type = plty, lty = lty, lwd = 2)
+ ylab = "absolute information"), dots))
+ dots["col"] <- dots[["colB"]]
+ dots["lwd"] <- dots[["lwdB"]]
+ do.call(lines, args=c(list(x.vec, absInfo, type = plty, lty = lty),
+ dots))
legend(max(x.vec), 0, xjust = 1, yjust = 0,
- legend = c("class. opt. IC"), lty = "dashed", col = c(grey(0.5)), cex=0.75)
+ legend = c("class. opt. IC"), lty = "dashed",
+ col = c(dots[["colA"]]), cex=0.75)
if(is.null(L2Fam at param@nuisance))
- title(paste("Absolute information of (partial) IC for", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, args=c(list(paste("Absolute information of (partial) IC for",
+ name(L2Fam)[1], "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "), ")")),
+ dots))
else
- title(paste("Absolute information of (partial) IC for", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"),
- cex.main = 0.8)
+ do.call(title, args=c(list(paste("Absolute information of (partial) IC for",
+ name(L2Fam)[1], "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3), collapse = ", "),
+ ")\nand nuisance parameter (",
+ paste(round(L2Fam at param@nuisance, 3), collapse = ", "),
+ ")")), dots))
if(dims > 1){
nrows <- trunc(sqrt(dims))
@@ -73,22 +104,38 @@
classIC.i.5 <- QFc.5%*%classIC
for(i in 1:dims){
y.vec <- sapply(x.vec, IC1.i.5 at Map[[i]])^2/absInfo
- plot(x.vec, y.vec, type = plty, lty = lty, lwd = 2,
- xlab = "x", ylab = "relative information", ylim = c(0, 1.1))
+ dots["col"] <- dots[["colB"]]
+ dots["lwd"] <- dots[["lwdA"]]
+ do.call(plot, args=c(list(x.vec, y.vec, type = plty,
+ lty = lty, xlab = "x",
+ ylab = "relative information",
+ ylim = c(0, 1.1)), dots))
yc.vec <- sapply(x.vec, classIC.i.5 at Map[[i]])^2/absInfoClass
- lines(x.vec, yc.vec, type = plty,
- lty = "dashed", col = grey(0.5))
+ dots["col"] <- dots[["colA"]]
+ dots["lwd"] <- dots[["lwdB"]]
+ do.call(lines, args=c(list(x.vec, yc.vec, type = plty,
+ lty = "dashed"),dots))
legend(max(x.vec), 1.1, xjust = 1, cex = 0.6,
- legend = c("class. opt. IC"), lty = "dashed", col = c(grey(0.5)))
+ legend = c("class. opt. IC"), lty = "dashed",
+ col = c(dots[["colA"]]))
if(is.null(L2Fam at param@nuisance))
- title(paste("Relative information of\ncomponent", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, args=c(list(paste("Relative information of\ncomponent",
+ i, "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3),
+ collapse = ", "), ")")),
+ dots))
else
- title(paste("Relative information of\ncomponent", i, "of (partial) IC\nfor", name(L2Fam)[1],
- "\nwith main parameter (", paste(round(L2Fam at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(L2Fam at param@nuisance, 3), collapse = ", "), ")"),
- cex.main = 0.8)
+ do.call(title, args=c(list(paste("Relative information of\ncomponent",
+ i, "of (partial) IC\nfor", name(L2Fam)[1],
+ "\nwith main parameter (",
+ paste(round(L2Fam at param@main, 3),
+ collapse = ", "),
+ ")\nand nuisance parameter (",
+ paste(round(L2Fam at param@nuisance, 3),
+ collapse = ", "), ")")),
+ dots))
}
}
par(opar)
Modified: pkg/RobAStBase/chm/RobAStBase.chm
===================================================================
(Binary files differ)
Modified: pkg/RobAStBase/chm/infoPlot.html
===================================================================
--- pkg/RobAStBase/chm/infoPlot.html 2008-10-06 22:07:19 UTC (rev 174)
+++ pkg/RobAStBase/chm/infoPlot.html 2008-10-10 23:29:11 UTC (rev 175)
@@ -23,7 +23,7 @@
<h3>Usage</h3>
<pre>
-infoPlot(object)
+infoPlot(object, ...)
</pre>
@@ -33,7 +33,12 @@
<tr valign="top"><td><code>object</code></td>
<td>
object of class <code>"InfluenceCurve"</code> </td></tr>
+<tr valign="top"><td><code>...</code></td>
+<td>
+</td></tr>
</table>
+<p>
+ {further parameters for <code>plot</code>}</p>
<h3>Details</h3>
Modified: pkg/RobAStBase/man/infoPlot.Rd
===================================================================
--- pkg/RobAStBase/man/infoPlot.Rd 2008-10-06 22:07:19 UTC (rev 174)
+++ pkg/RobAStBase/man/infoPlot.Rd 2008-10-10 23:29:11 UTC (rev 175)
@@ -6,10 +6,11 @@
Plot absolute and relative information of influence curves.
}
\usage{
-infoPlot(object)
+infoPlot(object, ...)
}
\arguments{
\item{object}{ object of class \code{"InfluenceCurve"} }
+ \item{\dots} {further parameters for \code{plot}}
}
\details{
Absolute information is defined as the square of the length
More information about the Robast-commits
mailing list