[Robast-commits] r336 - in branches/robast-0.7/pkg/RobAStBase: R chm man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Aug 11 04:00:54 CEST 2009
Author: ruckdeschel
Date: 2009-08-11 04:00:54 +0200 (Tue, 11 Aug 2009)
New Revision: 336
Modified:
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/chm/00Index.html
branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.hhp
branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.toc
branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html
branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html
branches/robast-0.7/pkg/RobAStBase/chm/plot-methods.html
branches/robast-0.7/pkg/RobAStBase/man/comparePlot.Rd
branches/robast-0.7/pkg/RobAStBase/man/infoPlot.Rd
branches/robast-0.7/pkg/RobAStBase/man/plot-methods.Rd
Log:
RobAStBase: plot functions gain data argument:
plot(IC, numeric), for comparePlot, infoPlot it is argument "data"
Modified: branches/robast-0.7/pkg/RobAStBase/R/AllPlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/AllPlot.R 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/R/AllPlot.R 2009-08-11 02:00:54 UTC (rev 336)
@@ -224,3 +224,60 @@
invisible()
})
+
+
+setMethod("plot", signature(x = "IC",y = "numeric"),
+ function(x, y, ..., cex.pts = 1, col.pts = par("col"),
+ pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = NULL){
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
+ n <- if(!is.null(dim(y))) nrow(y) else length(y)
+ oN <- 1:n
+ if (n==length(y)) {oN <- order(y); y <- sort(y)}
+ if(is.null(lab.pts)) lab.pts <- paste(oN)
+
+ L2Fam <- eval(x at CallL2Fam)
+ trafO <- trafo(L2Fam at param)
+ dims <- nrow(trafO)
+ dimm <- length(L2Fam at param)
+ QF <- diag(dims)
+
+ if(is(x,"ContIC") & dims>1 )
+ {if (is(normtype(x),"QFNorm")) QF <- QuadForm(normtype(x))}
+
+ IC1 <- as(diag(dims) %*% x at Curve, "EuclRandVariable")
+ absInfo <- t(IC1) %*% QF %*% IC1
+ ICMap <- IC1 at Map
+
+ absInfo <- sapply(y, absInfo at Map[[1]])
+ absInfo <- absInfo/max(absInfo)
+
+ dots.without <- dots
+ dots.without$col <- dots.without$cex <- dots.without$pch <- NULL
+
+ pL <- expression({})
+ if(!is.null(dots$panel.last))
+ pL <- dots$panel.last
+ dots$panel.last <- NULL
+
+ pL <- substitute({
+ ICy <- sapply(y0,ICMap0[[indi]])
+ if(is(e1, "DiscreteDistribution"))
+ ICy <- jitter(ICy, factor = jitter.fac0)
+ do.call(points, args=c(list(y0, ICy, cex = log(absy0+1)*3*cex0,
+ col = col0, pch = pch0), dwo0))
+ if(with.lab0){
+ text(x = y0, y = ICy, labels = lab.pts0,
+ cex = log(absy0+1)*1.5*cex0, col = col0)
+ }
+ pL0
+ }, list(pL0 = pL, ICMap0 = ICMap, y0 = y, absy0 = absInfo,
+ dwo0 = dots.without, cex0 = cex.pts, pch0 = pch.pts,
+ col0 = col.pts, with.lab0 = with.lab, lab.pts0 = lab.pts,
+ jitter.fac0 = jitter.fac
+ ))
+
+ do.call("plot", args = c(list(x = x, panel.last = pL), dots))
+})
Modified: branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/R/comparePlot.R 2009-08-11 02:00:54 UTC (rev 336)
@@ -1,12 +1,15 @@
setMethod("comparePlot", signature("IC","IC"),
- function(obj1,obj2, obj3 = NULL, obj4 = NULL,
+ function(obj1,obj2, obj3 = NULL, obj4 = NULL, data = 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],
legend.location = "bottomright",
- mfColRow = TRUE, to.draw.arg = NULL){
+ mfColRow = TRUE, to.draw.arg = NULL,
+ cex.pts = 1, col.pts = par("col"),
+ pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = 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))
@@ -27,8 +30,9 @@
if(missing(lwd)) lwd <- rep(1,ncomp)
else lwd <- rep(lwd, length.out = ncomp)
if(!missing(lty)) rep(lty, length.out = ncomp)
+ if(missing(col.pts)) col.pts <- 1:ncomp
+
-
if(!is.null(dots[["type"]])) dots["type"] <- NULL
if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
@@ -234,19 +238,113 @@
dotsT["col.main"] <- NULL
dotsT["line"] <- NULL
+ pL <- expression({})
+ if(!is.null(dotsP$panel.last))
+ pL <- dotsP$panel.last
+ dotsP$panel.last <- NULL
+
+ if(!is.null(data)){
+ n <- if(!is.null(dim(data))) nrow(data) else length(data)
+ oN <- 1:n
+ if (n==length(data)) {oN <- order(data); data <- sort(data)}
+
+ cex.pts <- rep(cex.pts, length.out=ncomp)
+ col.pts <- rep(col.pts, length.out=ncomp)
+ pch.pts <- matrix(rep(pch.pts, length.out=ncomp*n),n,ncomp)
+ jitter.fac <- rep(jitter.fac, length.out=ncomp)
+ with.lab <- rep(with.lab, length.out=ncomp)
+ lab.pts <- if(is.null(lab.pts))
+ matrix(paste(rep(oN,ncomp)),n,ncomp)
+ else matrix(rep(lab.pts, length.out = ncomp*n), n, ncomp)
+ lab.font <- rep(lab.font, length.out=ncomp)
+
+
+ absInfoEval <- function(x,object){
+ QF <- diag(dims)
+ if(is(object,"ContIC") & dims>1 )
+ {if (is(normtype(object),"QFNorm"))
+ QF <- QuadForm(normtype(object))}
+
+ IC1 <- as(diag(dims) %*% object at Curve, "EuclRandVariable")
+ absInfo.f <- t(IC1) %*% QF %*% IC1
+ return(sapply(x, absInfo.f at Map[[1]]))}
+
+ aI1 <- absInfoEval(x=data,object=obj1)
+ aI2 <- absInfoEval(x=data,object=obj2)
+ aI3 <- if(is.null(obj3)) NULL else absInfoEval(x=data,object=obj3)
+ aI4 <- if(is.null(obj4)) NULL else absInfoEval(x=data,object=obj4)
+
+ dots.points <- dots
+ dots.points$col <- dots.points$cex <- dots.points$pch <- NULL
+
+
+ pL <- substitute({
+ ICy1 <- sapply(y0,IC1 at Map[[indi]])
+ ICy2 <- sapply(y0,IC2 at Map[[indi]])
+ if(!is.null(obj30))
+ ICy3 <- sapply(y0,IC3 at Map[[indi]])
+ if(!is.null(obj40))
+ ICy3 <- sapply(y0,IC4 at Map[[indi]])
+
+ if(is(e1, "DiscreteDistribution")){
+ ICy1 <- jitter(ICy1, factor = jitter.fac0[1])
+ ICy2 <- jitter(ICy2, factor = jitter.fac0[2])
+ if(!is.null(obj30))
+ ICy3 <- jitter(ICy3, factor = jitter.fac0[3])
+ if(!is.null(obj40))
+ ICy4 <- jitter(ICy4, factor = jitter.fac0[4])
+ }
+ do.call(points, args=c(list(y0, ICy1, cex = log(aI10+1)*3*cex0[1],
+ col = col0[1], pch = pch0[,1]), dwo0))
+ do.call(points, args=c(list(y0, ICy2, cex = log(aI20+1)*3*cex0[2],
+ col = col0[2], pch = pch0[,2]), dwo0))
+ if(!is.null(obj30))
+ do.call(points, args=c(list(y0, ICy3, cex = log(aI30+1)*3*cex0[3],
+ col = col0[3], pch = pch0[,3]), dwo0))
+ if(!is.null(obj40))
+ do.call(points, args=c(list(y0, ICy4, cex = log(aI40+1)*3*cex0[4],
+ col = col0[4], pch = pch0[,4]), dwo0))
+ if(with.lab0){
+ text(x = y0, y = ICy1, labels = lab.pts0[,1],
+ cex = log(aI10+1)*1.5*cex0[1], col = col0[1])
+ text(x = y0, y = ICy2, labels = lab.pts0[,2],
+ cex = log(aI20+1)*1.5*cex0[2], col = col0[2])
+ if(!is.null(obj30))
+ text(x = y0, y = ICy3, labels = lab.pts0[,3],
+ cex = log(aI30+1)*1.5*cex0[3], col = col0[3])
+ if(!is.null(obj40))
+ text(x = y0, y = ICy4, labels = lab.pts0[,4],
+ cex = log(aI40+1)*1.5*cex0[4], col = col0[4])
+ }
+ pL0
+ }, list(pL0 = pL, y0 = data, aI10 = aI1, aI20 = aI2,
+ aI30 = aI3, aI40 = aI4, obj10 = obj1, obj20 = obj2,
+ obj30 = obj3, obj40 = obj4,
+ dwo0 = dots.points, cex0 = cex.pts, pch0 = pch.pts,
+ col0 = col.pts, with.lab0 = with.lab,
+ lab.pts0 = lab.pts, n0 = n,
+ jitter.fac0 = jitter.fac
+ ))
+
+ }
+
+
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]]))
+
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, col = col, lwd = lwd,
- xlab = "x", ylab = "(partial) IC"), dotsP))
+ do.call(plot, args=c(list( x = x.vec, y = matp[,1],
+ type = plty, lty = lty, col = col[1], lwd = lwd,
+ xlab = "x", ylab = "(partial) IC"), dotsP, list(panel.last = pL)))
+ do.call(matlines, args = c(list( x = x.vec, y = matp[,-1],
+ lty = lty, col = col[-1], lwd = lwd), dotsL))
if(is(e1, "DiscreteDistribution")){
matp1 <- cbind(sapply(x.vec1, IC1 at Map[[indi]]),
Modified: branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/R/infoPlot.R 2009-08-11 02:00:54 UTC (rev 336)
@@ -1,12 +1,16 @@
setMethod("infoPlot", "IC",
- function(object, ..., withSweave = getdistrOption("withSweave"),
+ function(object, data = NULL,
+ ..., withSweave = getdistrOption("withSweave"),
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],
legend.location = "bottomright",
- mfColRow = TRUE, to.draw.arg = NULL){
+ mfColRow = TRUE, to.draw.arg = NULL,
+ cex.pts = 1, col.pts = par("col"),
+ pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = NULL){
objectc <- match.call(call = sys.call(sys.parent(1)))$object
dots <- match.call(call = sys.call(sys.parent(1)),
@@ -15,7 +19,7 @@
L2Fam <- eval(object at CallL2Fam)
-
+
if(!is.null(dots[["type"]])) dots["type"] <- NULL
if(!is.null(dots[["xlab"]])) dots["xlab"] <- NULL
if(!is.null(dots[["ylab"]])) dots["ylab"] <- NULL
@@ -200,11 +204,19 @@
if (is(normtype(object),"SelfNorm")|is(normtype(object),"InfoNorm"))
QFc <- QFc0
}
+
+ absInfoEval <- function(x,y, withNorm = FALSE){
+ aI <- sapply(x, y at Map[[1]])
+ if(withNorm) aI <- aI / max(aI)
+ return(aI)
+ }
+
+
QFc.5 <- sqrt(PosSemDefSymmMatrix(QFc))
classIC <- as(trafo %*% solve(L2Fam at FisherInfo) %*% L2Fam at L2deriv, "EuclRandVariable")
- absInfoClass <- t(classIC) %*% QFc %*% classIC
- absInfoClass <- sapply(x.vec, absInfoClass at Map[[1]])
+ absInfoClass.f <- t(classIC) %*% QFc %*% classIC
+ absInfoClass <- absInfoEval(x.vec, absInfoClass.f)
QF <- diag(dims)
if(is(object,"ContIC") & dims>1 )
@@ -212,10 +224,10 @@
QF.5 <- sqrt(PosSemDefSymmMatrix(QF))
IC1 <- as(diag(dims) %*% object at Curve, "EuclRandVariable")
- absInfo <- t(IC1) %*% QF %*% IC1
- absInfo <- sapply(x.vec, absInfo at Map[[1]])
+ absInfo.f <- t(IC1) %*% QF %*% IC1
+ absInfo <- absInfoEval(x.vec, absInfo.f)
-
+
w0 <- getOption("warn")
options(warn = -1)
on.exit(options(warn = w0))
@@ -229,13 +241,95 @@
do.call(par,args=parArgs)
-
+ pL.rel <- pL.abs <- pL <- expression({})
+ if(!is.null(dotsP$panel.last))
+ {pL.rel <- pL.abs <- pL <- dotsP$panel.last}
+ dotsP$panel.last <- NULL
+
+ if(!is.null(data)){
+ n <- if(!is.null(dim(data))) nrow(data) else length(data)
+ oN <- 1:n
+ if (n==length(data)) {oN <- order(data); data <- sort(data)}
+
+ cex.pts <- rep(cex.pts, length.out=2)
+ if(missing(col.pts)) col.pts <- c(col, colI)
+ col.pts <- rep(col.pts, length.out=2)
+ pch.pts <- matrix(rep(pch.pts, length.out=2*n),n,2)
+ jitter.fac <- rep(jitter.fac, length.out=2)
+ with.lab <- rep(with.lab, length.out=2)
+ lab.pts <- if(is.null(lab.pts))
+ matrix(paste(rep(oN,2)),n,2)
+ else matrix(rep(lab.pts, length.out=2*n),n,2)
+ lab.font <- rep(lab.font, length.out=2)
+
+ absInfoClass.data <- absInfoEval(data,absInfoClass.f)
+ aIC.data.m <- max(absInfoClass.data)
+ absInfo.data <- absInfoEval(data,absInfo.f)
+ aI.data.m <- max(absInfo.data)
+
+ dots.points <- dots
+ dots.points$col <- dots.points$cex <- dots.points$pch <- NULL
+
+ pL.abs <- substitute({
+ if(is(e1, "DiscreteDistribution")){
+ ICy0 <- jitter(ICy0, factor = jitter.fac0[1])
+ ICy0c <- jitter(ICy0c, factor = jitter.fac0[2])
+ }
+ do.call(points, args=c(list(y0, ICy0, cex = log(ICy0+1)*3*cex0[1],
+ col = col0[1], pch = pch0[,1]), dwo0))
+ do.call(points, args=c(list(y0, ICy0c, cex = log(ICy0c+1)*3*cex0[2],
+ col = col0[2], pch = pch0[,2]), dwo0))
+ if(with.lab0){
+ text(x = y0, y = ICy0, labels = lab.pts0[,1],
+ cex = log(ICy0+1)*1.5*cex0[1], col = col0[1])
+ text(x = y0, y = ICy0c, labels = lab.pts0[,2],
+ cex = log(ICy0+1)*1.5*cex0[2], col = col0[2])
+ }
+ pL0
+ }, list(ICy0 = absInfo.data, ICy0c = absInfoClass.data,
+ pL0 = pL, y0 = data,
+ dwo0 = dots.points, cex0 = cex.pts, pch0 = pch.pts,
+ col0 = col.pts, with.lab0 = with.lab,
+ lab.pts0 = lab.pts, n0 = n,
+ jitter.fac0 = jitter.fac, aIC.data.m0=aIC.data.m,
+ aI.data.m0=aI.data.m
+ ))
+
+ pL.rel <- substitute({
+ y0.vec <- sapply(y0, IC1.i.5 at Map[[indi]])^2/ICy0
+ y0c.vec <- sapply(y0, classIC.i.5 at Map[[indi]])^2/ICy0c
+ if(is(e1, "DiscreteDistribution")){
+ y0.vec <- jitter(y0.vec, factor = jitter.fac0[1])
+ y0c.vec <- jitter(y0c.vec, factor = jitter.fac0[2])
+ }
+ do.call(points, args=c(list(y0, y0.vec, cex = log(ICy0+1)*3*cex0[1],
+ col = col0[1], pch = pch0[,1]), dwo0))
+ do.call(points, args=c(list(y0, y0c.vec, cex = log(ICy0c+1)*3*cex0[2],
+ col = col0[2], pch = pch0[,2]), dwo0))
+ if(with.lab0){
+ text(x = y0, y = y0.vec, labels = lab.pts0[,1],
+ cex = log(ICy0+1)*1.5*cex0[1], col = col0[1])
+ text(x = y0, y = y0c.vec, labels = lab.pts0[,2],
+ cex = log(ICy0c+1)*1.5*cex0[2], col = col0[2])
+ }
+ pL0
+ }, list(ICy0c = absInfoClass.data, ICy0 = absInfo.data,
+ pL0 = pL, y0 = data,
+ dwo0 = dots.points, cex0 = cex.pts, pch0 = pch.pts,
+ col0 = col.pts, with.lab0 = with.lab,
+ lab.pts0 = lab.pts, n0 = n,
+ jitter.fac0 = jitter.fac
+ ))
+ }
+
+
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 = ltyI, col = colI, lwd = lwdI,
- xlab = "x", ylab = "absolute information"), dotsP))
+ xlab = "x", ylab = "absolute information", panel.last = pL.abs),
+ dotsP))
do.call(lines, args=c(list(x.vec, absInfo, type = plty,
lty = lty, lwd = lwd, col = col), dotsL))
legend(legend.location[[1]],
@@ -276,7 +370,7 @@
do.call(plot, args=c(list(x.vec, y.vec, type = plty,
lty = lty, xlab = "x",
ylab = "relative information",
- col = col, lwd = lwd), dotsP))
+ col = col, lwd = lwd, panel.last = pL.rel), 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,
Modified: branches/robast-0.7/pkg/RobAStBase/chm/00Index.html
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/00Index.html 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/chm/00Index.html 2009-08-11 02:00:54 UTC (rev 336)
@@ -493,6 +493,8 @@
<td>Methods for Function plot in Package 'RobAStBase'</td></tr>
<tr><td width="25%"><a href="plot-methods.html">plot,IC,missing-method</a></td>
<td>Methods for Function plot in Package 'RobAStBase'</td></tr>
+<tr><td width="25%"><a href="plot-methods.html">plot,IC,numeric-method</a></td>
+<td>Methods for Function plot in Package 'RobAStBase'</td></tr>
<tr><td width="25%"><a href="plot-methods.html">plot-methods</a></td>
<td>Methods for Function plot in Package 'RobAStBase'</td></tr>
</table>
Modified: branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.chm
===================================================================
(Binary files differ)
Modified: branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.hhp
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.hhp 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.hhp 2009-08-11 02:00:54 UTC (rev 336)
@@ -12,54 +12,6 @@
[FILES]
00Index.html
-0RobAStBase-package.html
-ALEstimate-class.html
-BdStWeight-class.html
-BoundedWeight-class.html
-ContIC-class.html
-ContIC.html
-ContNeighborhood-class.html
-ContNeighborhood.html
-FixRobModel-class.html
-FixRobModel.html
-HampIC-class.html
-HampelWeight-class.html
-IC-class.html
-IC.html
-InfRobModel-class.html
-InfRobModel.html
-InfluenceCurve-class.html
-InfluenceCurve.html
-MEstimate-class.html
-Neighborhood-class.html
-RobAStBaseOptions.html
-RobAStControl-class.html
-RobModel-class.html
-RobWeight-class.html
-TotalVarIC-class.html
-TotalVarIC.html
-TotalVarNeighborhood-class.html
-TotalVarNeighborhood.html
-UncondNeighborhood-class.html
-checkIC.html
-comparePlot.html
-cutoff-class.html
-cutoff.html
-ddPlot-methods.html
-evalIC.html
-generateIC.html
-generateICfct.html
-getBiasIC.html
-getRiskIC.html
-getweight.html
-infoPlot.html
+
internals.html
internals_ddPlot.html
-kStepEstimate-class.html
-kStepEstimator.html
-locMEstimator.html
-makeIC-methods.html
-oneStepEstimator.html
-optIC.html
-outlyingPlotIC.html
-plot-methods.html
Modified: branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.toc
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.toc 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/chm/RobAStBase.toc 2009-08-11 02:00:54 UTC (rev 336)
@@ -766,6 +766,10 @@
<param name="Local" value="plot-methods.html">
</OBJECT>
<LI> <OBJECT type="text/sitemap">
+<param name="Name" value="plot,IC,numeric-method">
+<param name="Local" value="plot-methods.html">
+</OBJECT>
+<LI> <OBJECT type="text/sitemap">
<param name="Name" value="plot-methods">
<param name="Local" value="plot-methods.html">
</OBJECT>
Modified: branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/chm/comparePlot.html 2009-08-11 02:00:54 UTC (rev 336)
@@ -1,10 +1,10 @@
<html><head><title>Compare - Plots</title>
-<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<link rel="stylesheet" type="text/css" href="Rchm.css">
-</head>
-<body>
+</head><body>
-<table width="100%"><tr><td>comparePlot-methods(RobAStBase)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<table width="100%"><tr><td>comparePlot-methods(RobAStBase)</td><td align="right">R Documentation</td></tr></table>
+<object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
<param name="keyword" value="R: comparePlot">
<param name="keyword" value="R: comparePlot-methods">
<param name="keyword" value="R: comparePlot,IC,IC-method">
@@ -26,15 +26,18 @@
<pre>
comparePlot(obj1, obj2, ... )
-## S4 method for signature 'IC, IC':
+## S4 method for signature 'IC,IC':
comparePlot(obj1, obj2, obj3 = NULL, obj4 = NULL,
- ..., withSweave = getdistrOption("withSweave"),
+ data = 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],
legend.location = "bottomright",
- mfColRow = TRUE, to.draw.arg = NULL)
+ mfColRow = TRUE, to.draw.arg = NULL,
+ cex.pts = 1, col.pts = par("col"),
+ pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = NULL)
</pre>
@@ -43,24 +46,27 @@
<table summary="R argblock">
<tr valign="top"><td><code>obj1</code></td>
<td>
-object of class <code>"InfluenceCurve"</code> </td></tr>
+ object of class <code>"InfluenceCurve"</code> </td></tr>
<tr valign="top"><td><code>obj2</code></td>
<td>
-object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
+ object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
<tr valign="top"><td><code>obj3</code></td>
<td>
-optional: object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
+ optional: object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
<tr valign="top"><td><code>obj4</code></td>
<td>
-optional: object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
+ optional: object of class <code>"InfluenceCurve"</code> to be compared with <code>obj1</code></td></tr>
+<tr valign="top"><td><code>data</code></td>
+<td>
+optional data argument — for plotting observations into the plot;</td></tr>
<tr valign="top"><td><code>withSweave</code></td>
<td>
-logical: if <code>TRUE</code> (for working with <CODE>Sweave</CODE>)
+logical: if <code>TRUE</code> (for working with <CODE>Sweave</CODE>)
no extra device is opened</td></tr>
<tr valign="top"><td><code>main</code></td>
<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>
+just as argument <code>main</code> in <code><a href="../../graphics/html/plotdefault.html">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>
@@ -78,11 +84,11 @@
if argument <code>to.draw.arg</code> is used, this refers to
a vector of length <code>length(to.draw.arg)</code>, the
actually plotted dimensions. For further information, see also
-description of 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>
+description of argument <code>main</code> in <code><a href="../../graphics/html/plotdefault.html">plot.default</a></code>.</td></tr>
<tr valign="top"><td><code>sub</code></td>
<td>
logical: is a sub-title to be used? or <br>
-just as argument <code>sub</code> in <code><a onclick="findlink('graphics', 'plotdefault.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.default</a></code>.</td></tr>
+just as argument <code>sub</code> in <code><a href="../../graphics/html/plotdefault.html">plot.default</a></code>.</td></tr>
<tr valign="top"><td><code>tmar</code></td>
<td>
top margin – useful for non-standard main title sizes</td></tr>
@@ -93,13 +99,13 @@
<td>
magnification to be used for inner titles relative
to the current setting of <code>cex</code>; as in
-<code><a onclick="findlink('graphics', 'par.html')" style="text-decoration: underline; color: blue; cursor: hand">par</a></code></td></tr>
+<code><a href="../../graphics/html/par.html">par</a></code></td></tr>
<tr valign="top"><td><code>col.inner</code></td>
<td>
-character or integer code; color for the inner title</td></tr>
+character or integer code; color for the inner title</td></tr>
<tr valign="top"><td><code>legend.location</code></td>
<td>
-a valid argument <code>x</code> for <code><a onclick="findlink('graphics', 'legend.html')" style="text-decoration: underline; color: blue; cursor: hand">legend</a></code> —
+a valid argument <code>x</code> for <code><a href="../../graphics/html/legend.html">legend</a></code> —
the place where to put the legend on the last issued
plot</td></tr>
<tr valign="top"><td><code>mfColRow</code></td>
@@ -118,11 +124,35 @@
vector <code>"dim<dimnr>"</code>, <code>dimnr</code> running through
the number of rows of the trafo matrix.
</td></tr>
+<tr valign="top"><td><code>cex.pts</code></td>
+<td>
+size of the points of the <code>data</code> argument plotted</td></tr>
+<tr valign="top"><td><code>col.pts</code></td>
+<td>
+color of the points of the <code>data</code> argument plotted</td></tr>
+<tr valign="top"><td><code>pch.pts</code></td>
+<td>
+symbol of the points of the <code>data</code> argument plotted</td></tr>
+<tr valign="top"><td><code>with.lab</code></td>
+<td>
+logical; shall labels be plotted to the observations?</td></tr>
+<tr valign="top"><td><code>lab.pts</code></td>
+<td>
+character or NULL; labels to be plotted to the observations; if <code>NULL</code>
+observation indices;</td></tr>
+<tr valign="top"><td><code>lab.font</code></td>
+<td>
+font to be used for labels</td></tr>
+<tr valign="top"><td><code>jitter.fac</code></td>
+<td>
+jittering factor used in case of a <code>DiscreteDistribution</code>
+for plotting points of the <code>data</code> argument in a jittered fashion.</td></tr>
<tr valign="top"><td><code>...</code></td>
<td>
further arguments to be passed to <code>plot</code></td></tr>
</table>
+
<h3>Details</h3>
<p>
@@ -142,14 +172,18 @@
Of course, if <code>main</code> / <code>inner</code> / <code>sub</code> are <code>character</code>, this
is used for the title; in case of <code>inner</code> it is then checked whether it
has correct length. In all title arguments, the following patterns are substituted:
+
<ul>
-<dt><code>"%C1"</code>,<code>"%C2"</code>,[<code>"%C3"</code>,][<code>"%C4"</code>]</dt><dd>class of argument
-<code>obj<i></code>, i=1,..4</dd>
-<dt><code>"%A1"</code>,<code>"%A2"</code>,[<code>"%A3"</code>,][<code>"%A4"</code>]</dt><dd>deparsed argument
-<code>obj<i></code>, i=1,..4</dd>
-<dt><code>"%D"</code></dt><dd>time/date-string when the plot was generated</dd>
+<li><code>"%C1"</code>,<code>"%C2"</code>,[<code>"%C3"</code>,][<code>"%C4"</code>]class of argument
+<code>obj<i></code>, i=1,..4
+</li>
+<li><code>"%A1"</code>,<code>"%A2"</code>,[<code>"%A3"</code>,][<code>"%A4"</code>]deparsed argument
+<code>obj<i></code>, i=1,..4
+</li>
+<li><code>"%D"</code>time/date-string when the plot was generated
</ul>
+</p>
<p>
If argument <code>...</code> contains argument <code>ylim</code>, this may either be
as in <code>plot.default</code> (i.e. a vector of length 2) or a vector of
@@ -161,9 +195,7 @@
<h3>Author(s)</h3>
-<p>
-Peter Ruckdeschel <a href="mailto:Peter.Ruckdeschel at itwm.fraunhofer.de">Peter.Ruckdeschel at itwm.fraunhofer.de</a>
-</p>
+<p>Peter Ruckdeschel <a href="mailto:Peter.Ruckdeschel at itwm.fraunhofer.de">Peter.Ruckdeschel at itwm.fraunhofer.de</a></p>
<h3>References</h3>
@@ -176,9 +208,7 @@
<h3>See Also</h3>
-<p>
-<code><a onclick="findlink('distrMod', 'L2ParamFamily-class.html')" style="text-decoration: underline; color: blue; cursor: hand">L2ParamFamily-class</a></code>, <code><a href="IC-class.html">IC-class</a></code>, <code><a onclick="findlink('base', 'plot.html')" style="text-decoration: underline; color: blue; cursor: hand">plot</a></code>
-</p>
+<p><code><a href="../../distrMod/html/L2ParamFamily-class.html">L2ParamFamily-class</a></code>, <code><a href="../../RobAStBase/html/IC-class.html">IC-class</a></code>, <code><a href="../../base/html/plot.html">plot</a></code></p>
<h3>Examples</h3>
@@ -194,6 +224,9 @@
comparePlot(IC1,IC2)
+data <- r(N0)(30)
+comparePlot(IC1, IC2, data=data, with.lab = TRUE)
+
## selection of subpanels for plotting
par(mfrow=c(1,1))
comparePlot(IC1, IC2 ,mfColRow = FALSE, to.draw.arg=c("mean"),
@@ -224,6 +257,7 @@
comparePlot(IC1,IC2, IC2.i, IC2.s)
+
}
</pre>
@@ -237,7 +271,5 @@
}
</script>
-
<hr><div align="center">[Package <em>RobAStBase</em> version 0.7 <a href="00Index.html">Index</a>]</div>
-
</body></html>
Modified: branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html 2009-08-04 17:22:22 UTC (rev 335)
+++ branches/robast-0.7/pkg/RobAStBase/chm/infoPlot.html 2009-08-11 02:00:54 UTC (rev 336)
@@ -1,10 +1,10 @@
<html><head><title>Plot absolute and relative information</title>
-<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<link rel="stylesheet" type="text/css" href="Rchm.css">
-</head>
-<body>
+</head><body>
-<table width="100%"><tr><td>infoPlot(RobAStBase)</td><td align="right">R Documentation</td></tr></table><object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
+<table width="100%"><tr><td>infoPlot(RobAStBase)</td><td align="right">R Documentation</td></tr></table>
+<object type="application/x-oleobject" classid="clsid:1e2a7bd0-dab9-11d0-b93a-00c04fc99f9e">
<param name="keyword" value="R: infoPlot">
<param name="keyword" value="R: infoPlot-methods">
<param name="keyword" value="R: infoPlot,IC-method">
@@ -27,14 +27,18 @@
<pre>
infoPlot(object, ...)
## S4 method for signature 'IC':
-infoPlot(object, ..., withSweave = getdistrOption("withSweave"),
+infoPlot(object, data = NULL, ...,
+ withSweave = getdistrOption("withSweave"),
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],
legend.location = "bottomright",
- mfColRow = TRUE, to.draw.arg = NULL)
+ mfColRow = TRUE, to.draw.arg = NULL,
+ cex.pts = 1, col.pts = par("col"),
+ pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ lab.pts = NULL, lab.font = NULL)
</pre>
@@ -44,6 +48,9 @@
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 336
More information about the Robast-commits
mailing list