[Robast-commits] r246 - in branches/robast-0.7/pkg/RobAStBase: R chm man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jan 28 08:53:50 CET 2009
Author: ruckdeschel
Date: 2009-01-28 08:53:50 +0100 (Wed, 28 Jan 2009)
New Revision: 246
Modified:
branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R
branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R
branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html
branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html
branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd
branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd
Log:
fixed some bugs with lty[I], lwd[I], col[I] in comparePlot and infoPlot
Modified: branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2009-01-28 05:45:19 UTC (rev 245)
+++ branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2009-01-28 07:53:50 UTC (rev 246)
@@ -2,6 +2,7 @@
function(obj1,obj2, obj3 = NULL, obj4 = NULL,
..., withSweave = getdistrOption("withSweave"),
main = FALSE, inner = TRUE, sub = FALSE,
+ col = par("col"), lwd = par("lwd"), lty,
col.inner = par("col.main"), cex.inner = 0.8,
bmar = par("mar")[1], tmar = par("mar")[3],
mfColRow = TRUE, to.draw.arg = NULL){
@@ -17,15 +18,16 @@
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
- ncomp <- 2+ !is.null(obj3) + !is.null(obj4)
+ ncomp <- 2+ (!missing(obj3)|!is.null(obj3)) +
+ (!missing(obj4)|!is.null(obj4))
- if(is.null(dots[["col"]])) dots$"col" <- 1:ncomp
- if(is.null(dots[["lwd"]])) dots$"lwd" <- 1
+ if(missing(col)) col <- 1:ncomp
+ else col <- rep(col, length.out = ncomp)
+ if(missing(lwd)) lwd <- rep(1,ncomp)
+ else lwd <- rep(lwd, length.out = ncomp)
+ if(!missing(lty)) rep(lty, length.out = ncomp)
- col <- dots[["col"]]
- lwd <- dots[["lwd"]]
- if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
if(!is.null(dots[["type"]])) dots["type"] <- NULL
if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
@@ -76,7 +78,7 @@
h <- upper - lower
x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000)
plty <- "l"
- lty <- "solid"
+ if(missing(lty)) lty <- "solid"
}else{
if(is(e1, "DiscreteDistribution")) x.vec <- support(e1)
else{
@@ -84,7 +86,7 @@
x.vec <- sort(unique(x.vec))
}
plty <- "p"
- lty <- "dotted"
+ if(missing(lty)) lty <- "dotted"
if(!is.null(xlim)) x.vec <- x.vec[(x.vec>=xm) & (x.vec<=xM)]
}
ylim <- eval(dots$ylim)
@@ -231,23 +233,26 @@
for(i in 1:dims0){
indi <- to.draw[i]
if(!is.null(ylim)) dotsP$ylim <- ylim[,i]
- matp <- cbind(sapply(x.vec, IC1 at Map[[indi]]),sapply(x.vec, IC2 at Map[[indi]]))
+ matp <- cbind(sapply(x.vec, IC1 at Map[[indi]]),
+ sapply(x.vec, IC2 at Map[[indi]]))
if(is(obj3, "IC"))
matp <- cbind(matp,sapply(x.vec, IC3 at Map[[indi]]))
if(is(obj4, "IC"))
matp <- cbind(matp,sapply(x.vec, IC4 at Map[[indi]]))
do.call(matplot, args=c(list( x= x.vec, y=matp,
- type = plty, lty = lty,
+ type = plty, lty = lty, col = col, lwd = lwd,
xlab = "x", ylab = "(partial) IC"), dotsP))
if(is(e1, "DiscreteDistribution")){
- matp1 <- cbind(sapply(x.vec1, IC1 at Map[[indi]]),sapply(x.vec1, IC2 at Map[[indi]]))
+ matp1 <- cbind(sapply(x.vec1, IC1 at Map[[indi]]),
+ sapply(x.vec1, IC2 at Map[[indi]]))
if(is(obj3, "IC"))
matp1 <- cbind(matp1,sapply(x.vec1, IC3 at Map[[indi]]))
if(is(obj4, "IC"))
matp1 <- cbind(matp1,sapply(x.vec1, IC4 at Map[[indi]]))
- do.call(matlines, c(list(x.vec1, matp1, lty = "dotted"),dotsL))
+ do.call(matlines, c(list(x.vec1, matp1, lty = lty,
+ col = col, lwd = lwd), dotsL))
}
if(innerL)
@@ -255,9 +260,8 @@
line = lineT, cex.main = cex.inner, col.main = col.inner))
}
- legend("bottomright",
- legend = xc, col = eval(dots[["col"]]),
- cex=0.75, lwd=eval(dots[["lwd"]])*1.5)
+ legend("bottomright", legend = xc, col = col,
+ cex = 0.75, lwd = lwd*1.5, lty = lty)
if(!hasArg(cex.main)) cex.main <- par("cex.main") else cex.main <- dots$"cex.main"
if(!hasArg(col.main)) col.main <- par("col.main") else col.main <- dots$"col.main"
Modified: branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2009-01-28 05:45:19 UTC (rev 245)
+++ branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2009-01-28 07:53:50 UTC (rev 246)
@@ -1,6 +1,7 @@
setMethod("infoPlot", "IC",
function(object, ..., withSweave = getdistrOption("withSweave"),
- colI = grey(0.5), lwdI = 0.7*par("lwd"),
+ col = par("col"), lwd = par("lwd"), lty,
+ colI = grey(0.5), lwdI = 0.7*par("lwd"), ltyI = "dotted",
main = FALSE, inner = TRUE, sub = FALSE,
col.inner = par("col.main"), cex.inner = 0.8,
bmar = par("mar")[1], tmar = par("mar")[3],
@@ -13,10 +14,7 @@
L2Fam <- eval(object at CallL2Fam)
- if(!hasArg(col)) col <- par("col") else col <- dots$col
- if(!hasArg(lwd)) lwd <- par("lwd") else lwd <- dots$lwd
- if(!is.null(dots[["lty"]])) dots["lty"] <- NULL
if(!is.null(dots[["type"]])) dots["type"] <- NULL
if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
@@ -65,7 +63,7 @@
h <- upper - lower
x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000)
plty <- "l"
- lty <- "solid"
+ if(missing(lty)) lty <- "solid"
}else{
if(is(e1, "DiscreteDistribution")) x.vec <- support(e1)
else{
@@ -73,7 +71,7 @@
x.vec <- sort(unique(x.vec))
}
plty <- "p"
- lty <- "dotted"
+ if(missing(lty)) lty <- "dotted"
if(!is.null(xlim)) x.vec <- x.vec[(x.vec>=xm) & (x.vec<=xM)]
}
}
@@ -86,6 +84,8 @@
}
dotsP <- dotsL <- dotsT <- dots
+ dotsL$lwd <- dotsL$col <- dotsL$lty <- NULL
+ dotsP$lwd <- dotsP$col <- dotsP$lty <- NULL
dotsP$xlim <- xlim
trafo <- trafo(L2Fam at param)
@@ -217,20 +217,18 @@
- dotsP["col"] <- NULL
- dotsP["lwd"] <- NULL
if(!is.null(ylim))
dotsP$ylim <- ylim[,1]
if(1 %in% to.draw){
do.call(plot, args=c(list(x.vec, absInfoClass, type = plty,
- lty = "dashed", col = colI, lwd = lwdI,
+ lty = ltyI, col = colI, lwd = lwdI,
xlab = "x", ylab = "absolute information"), dotsP))
- do.call(lines, args=c(list(x.vec, absInfo, type = plty, lty = lty),
- dotsL))
+ do.call(lines, args=c(list(x.vec, absInfo, type = plty,
+ lty = lty, lwd = lwd, col = col), dotsL))
legend("top",
legend = c("class. opt. IC", objectc),
- lty = c(lty,"dashed"), col = c(colI, col),
- lwd=c(lwdI, lwd), cex = 0.75)
+ lty = c(ltyI, lty), col = c(colI, col),
+ lwd = c(lwdI, lwd), cex = 0.75)
dotsT["main"] <- NULL
dotsT["cex.main"] <- NULL
@@ -265,15 +263,15 @@
do.call(plot, args=c(list(x.vec, y.vec, type = plty,
lty = lty, xlab = "x",
ylab = "relative information",
- col = colI, lwd = lwdI), dotsP))
+ col = col, lwd = lwd), dotsP))
yc.vec <- sapply(x.vec, classIC.i.5 at Map[[indi]])^2/absInfoClass
do.call(lines, args=c(list(x.vec, yc.vec, type = plty,
- lty = "dashed"), dotsL))
+ lty = ltyI, col = colI, lwd = lwdI), dotsL))
legend("topright",
- legend = c("class. opt. IC", objectc), lty = c(lty,"dashed"),
- col = c(colI, col), lwd=c(lwdI, lwd),
- cex = 0.6)
+ legend = c("class. opt. IC", objectc),
+ col = c(colI, col), lwd = c(lwdI, lwd),
+ lty = c(ltyI, lty), cex = 0.6)
if(innerL)
do.call(title, args=c(list(main = innerT[[1+indi]]), dotsT,
line = lineT, cex.main = cex.inner, col.main = col.inner))
Modified: branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
===================================================================
(Binary files differ)
Modified: branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html 2009-01-28 05:45:19 UTC (rev 245)
+++ branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html 2009-01-28 07:53:50 UTC (rev 246)
@@ -30,6 +30,7 @@
comparePlot(obj1, obj2, obj3 = NULL, obj4 = NULL,
..., withSweave = getdistrOption("withSweave"),
main = FALSE, inner = TRUE, sub = FALSE,
+ col = par("col"), lwd = par("lwd"), lty,
col.inner = par("col.main"), cex.inner = 0.8,
bmar = par("mar")[1], tmar = par("mar")[3],
mfColRow = TRUE, to.draw.arg = NULL)
@@ -59,6 +60,15 @@
<td>
logical: is a main title to be used? or <br>
just as argument <code>main</code> in <code><a onclick="findlink('graphics', 'plotdefault.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.default</a></code>.</td></tr>
+<tr valign="top"><td><code>col</code></td>
+<td>
+color[s] of ICs in arguments <code>obj1</code> [,...,<code>obj4</code>].</td></tr>
+<tr valign="top"><td><code>lwd</code></td>
+<td>
+linewidth[s] of ICs in arguments <code>obj1</code> [,...,<code>obj4</code>].</td></tr>
+<tr valign="top"><td><code>lty</code></td>
+<td>
+line-type[s] of ICs in arguments <code>obj1</code> [,...,<code>obj4</code>].</td></tr>
<tr valign="top"><td><code>inner</code></td>
<td>
logical: do panels have their own titles? or <br>
@@ -201,10 +211,13 @@
trafo(G2) <- mtrafo
G2
G2.Rob1 <- InfRobModel(center = G2, neighbor = ContNeighborhood(radius = 0.5))
-IC1 <- optIC(model = G2, risk = asCov())
-IC2 <- optIC(model = G2.Rob1, risk = asMSE())
-comparePlot(IC1,IC2)
+system.time(IC1 <- optIC(model = G2, risk = asCov()))
+system.time(IC2 <- optIC(model = G2.Rob1, risk = asMSE()))
+system.time(IC2.i <- optIC(model = G2.Rob1, risk = asMSE(normtype=InfoNorm())))
+system.time(IC2.s <- optIC(model = G2.Rob1, risk = asMSE(normtype=SelfNorm())))
+comparePlot(IC1,IC2, IC2.i, IC2.s)
+
}
</pre>
Modified: branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html 2009-01-28 05:45:19 UTC (rev 245)
+++ branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html 2009-01-28 07:53:50 UTC (rev 246)
@@ -28,7 +28,8 @@
infoPlot(object, ...)
## S4 method for signature 'IC':
infoPlot(object, ..., withSweave = getdistrOption("withSweave"),
- colI = grey(0.5), lwdI = 0.7*par("lwd"),
+ col = par("col"), lwd = par("lwd"), lty,
+ colI = grey(0.5), lwdI = 0.7*par("lwd"), ltyI = 3,
main = FALSE, inner = TRUE, sub = FALSE,
col.inner = par("col.main"), cex.inner = 0.8,
bmar = par("mar")[1], tmar = par("mar")[3],
@@ -70,12 +71,24 @@
<tr valign="top"><td><code>bmar</code></td>
<td>
bottom margin – useful for non-standard sub title sizes</td></tr>
+<tr valign="top"><td><code>col</code></td>
+<td>
+color of IC in argument <code>object</code>.</td></tr>
+<tr valign="top"><td><code>lwd</code></td>
+<td>
+linewidth of IC in argument <code>object</code>.</td></tr>
+<tr valign="top"><td><code>lty</code></td>
+<td>
+line-type of IC in argument <code>object</code>.</td></tr>
<tr valign="top"><td><code>colI</code></td>
<td>
color of the classically optimal IC</td></tr>
<tr valign="top"><td><code>lwdI</code></td>
<td>
linewidth of the classically optimal IC</td></tr>
+<tr valign="top"><td><code>ltyI</code></td>
+<td>
+line-type of the classically optimal IC</td></tr>
<tr valign="top"><td><code>cex.inner</code></td>
<td>
magnification to be used for inner titles relative
Modified: branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd 2009-01-28 05:45:19 UTC (rev 245)
+++ branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd 2009-01-28 07:53:50 UTC (rev 246)
@@ -13,6 +13,7 @@
\S4method{comparePlot}{IC,IC}(obj1, obj2, obj3 = NULL, obj4 = NULL,
..., withSweave = getdistrOption("withSweave"),
main = FALSE, inner = TRUE, sub = FALSE,
+ col = par("col"), lwd = par("lwd"), lty,
col.inner = par("col.main"), cex.inner = 0.8,
bmar = par("mar")[1], tmar = par("mar")[3],
mfColRow = TRUE, to.draw.arg = NULL)
@@ -26,6 +27,9 @@
no extra device is opened}
\item{main}{logical: is a main title to be used? or \cr
just as argument \code{main} in \code{\link{plot.default}}.}
+ \item{col}{color[s] of ICs in arguments \code{obj1} [,\ldots,\code{obj4}].}
+ \item{lwd}{linewidth[s] of ICs in arguments \code{obj1} [,\ldots,\code{obj4}].}
+ \item{lty}{line-type[s] of ICs in arguments \code{obj1} [,\ldots,\code{obj4}].}
\item{inner}{logical: do panels have their own titles? or \cr
character vector of / cast to length 'number of plotted
dimensions';
@@ -128,10 +132,13 @@
trafo(G2) <- mtrafo
G2
G2.Rob1 <- InfRobModel(center = G2, neighbor = ContNeighborhood(radius = 0.5))
-IC1 <- optIC(model = G2, risk = asCov())
-IC2 <- optIC(model = G2.Rob1, risk = asMSE())
-comparePlot(IC1,IC2)
+system.time(IC1 <- optIC(model = G2, risk = asCov()))
+system.time(IC2 <- optIC(model = G2.Rob1, risk = asMSE()))
+system.time(IC2.i <- optIC(model = G2.Rob1, risk = asMSE(normtype=InfoNorm())))
+system.time(IC2.s <- optIC(model = G2.Rob1, risk = asMSE(normtype=SelfNorm())))
+comparePlot(IC1,IC2, IC2.i, IC2.s)
+
}
}
\keyword{robust}
Modified: branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd 2009-01-28 05:45:19 UTC (rev 245)
+++ branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd 2009-01-28 07:53:50 UTC (rev 246)
@@ -10,7 +10,8 @@
\usage{
infoPlot(object, ...)
\S4method{infoPlot}{IC}(object, ..., withSweave = getdistrOption("withSweave"),
- colI = grey(0.5), lwdI = 0.7*par("lwd"),
+ col = par("col"), lwd = par("lwd"), lty,
+ colI = grey(0.5), lwdI = 0.7*par("lwd"), ltyI = 3,
main = FALSE, inner = TRUE, sub = FALSE,
col.inner = par("col.main"), cex.inner = 0.8,
bmar = par("mar")[1], tmar = par("mar")[3],
@@ -34,8 +35,12 @@
just as argument \code{sub} in \code{\link{plot.default}}.}
\item{tmar}{top margin -- useful for non-standard main title sizes}
\item{bmar}{bottom margin -- useful for non-standard sub title sizes}
+ \item{col}{color of IC in argument \code{object}.}
+ \item{lwd}{linewidth of IC in argument \code{object}.}
+ \item{lty}{line-type of IC in argument \code{object}.}
\item{colI}{color of the classically optimal IC}
\item{lwdI}{linewidth of the classically optimal IC}
+ \item{ltyI}{line-type of the classically optimal IC}
\item{cex.inner}{magnification to be used for inner titles relative
to the current setting of \code{cex}; as in
\code{\link[stats]{par}}}
More information about the Robast-commits
mailing list