[Robast-commits] r1174 - branches/robast-1.2/pkg/RobAStBase/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 26 19:59:07 CET 2019
Author: ruckdeschel
Date: 2019-02-26 19:59:07 +0100 (Tue, 26 Feb 2019)
New Revision: 1174
Modified:
branches/robast-1.2/pkg/RobAStBase/R/AllPlot.R
branches/robast-1.2/pkg/RobAStBase/R/comparePlot.R
branches/robast-1.2/pkg/RobAStBase/R/ddPlot_utils.R
branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R
branches/robast-1.2/pkg/RobAStBase/R/plotWrapper.R
Log:
[RobAStBase] branch 1.2 - fixed a number of bugs:
- in ddPlot_utils, argument main was not passed through
- in plot-method for ICs, legend is now recylced when given as argument
- possible double argument lwd is caught in plot-method for ICs, in comparePlot, and in infoPlot
- x.vecD was not used as list in comparePlot, arguments x, y were not named in call to matlines in comparePlot
- in plotWrappers, legend is now adapted to different wrappers, cex.lab=1, in PlotIC argument y was not passed
Modified: branches/robast-1.2/pkg/RobAStBase/R/AllPlot.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/AllPlot.R 2019-02-26 12:45:41 UTC (rev 1173)
+++ branches/robast-1.2/pkg/RobAStBase/R/AllPlot.R 2019-02-26 18:59:07 UTC (rev 1174)
@@ -176,7 +176,10 @@
}
if(is.null(legend)){
legend <- vector("list",dims0)
+# legend <- .fillList(as.list(xc),dims0)
legend <- .fillList(as.list(xc),dims0)
+ }else{
+ if(!is.list(legend)) legend <- .fillList(legend,dims0)
}
}
@@ -298,9 +301,11 @@
y.vecD <- rescD$Y
dotsL$lty <- NULL
- do.call(lines,args=c(list(x.vecD, y.vecD, lwd = lwd,
+
+ if(is.null(dotsL$lwd)) dotsL$lwd <- lwd
+ do.call(lines,args=c(list(x.vecD, y.vecD,
lty = "dotted"), dotsL))
- plotInfo$PlotLinesD[[i]] <- c(list(x.vecD, y.vecD, lwd = lwd,
+ plotInfo$PlotLinesD[[i]] <- c(list(x.vecD, y.vecD,
lty = "dotted"), dotsL)
}
do.call(title,args=c(list(main = innerT[i]), dotsT, line = lineT,
Modified: branches/robast-1.2/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/comparePlot.R 2019-02-26 12:45:41 UTC (rev 1173)
+++ branches/robast-1.2/pkg/RobAStBase/R/comparePlot.R 2019-02-26 18:59:07 UTC (rev 1174)
@@ -619,6 +619,7 @@
col = col), dots.points)
}
+ if(!is.null(dotsL$lwd)) dotsL$lwd <- NULL
do.call(matlines, args = c(list( x = resc1$X, y = matp,
lty = lty, col = col, lwd = lwd), dotsL))
plotInfo$PlotLines[[i]] <- c(list( x = resc1$X, y = matp,
@@ -645,7 +646,7 @@
}
if(is(distr, "DiscreteDistribution")){
- rescD.args <- c(list(x.vecD, "fc"=fct1, scaleX[i], scaleX.fct[[i]],
+ rescD.args <- c(list(x.vecD[[i]], "fc"=fct1, scaleX[i], scaleX.fct[[i]],
scaleX.inv[[i]], scaleY[i], scaleY.fct[[i]], xlim[,i],
ylim[,i], dotsP[[i]]))
resc1D <- do.call(.rescalefct, rescD.args)
@@ -667,9 +668,11 @@
plotInfo$resc.D[[(i-1)*ncomp+4]] <- resc4D
matpD <- cbind(matpD, resc4D$Y)
}
- do.call(matlines, c(list(resc1D$X, matpD, lty = lty,
+
+ if(!is.null(dotsL$lwd)) dotsL$lwd <- NULL
+ do.call(matlines, c(list(x=resc1D$X, y=matpD, lty = lty,
col = col, lwd = lwd), dotsL))
- plotInfo$PlotLinesD[[i]] <- c(list(resc1D$X, matpD, lty = lty,
+ plotInfo$PlotLinesD[[i]] <- c(list(x=resc1D$X, y=matpD, lty = lty,
col = col, lwd = lwd), dotsL)
}
Modified: branches/robast-1.2/pkg/RobAStBase/R/ddPlot_utils.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/ddPlot_utils.R 2019-02-26 12:45:41 UTC (rev 1173)
+++ branches/robast-1.2/pkg/RobAStBase/R/ddPlot_utils.R 2019-02-26 18:59:07 UTC (rev 1174)
@@ -139,6 +139,14 @@
if((missing(font.abline)|| is.null(font.abline)) && !is.null(dots$font)) font.abline <- dots$font
if((missing(font.abline)|| is.null(font.abline))) font.abline <- par("font")
+ titdots <- NULL
+ titdots$main <- dots$main
+ titdots$sub <- dots$sub
+ titdots$col.main <- dots$col.main
+ titdots$col.sub <- dots$col.sub
+ titdots$outer <- dots$outer
+ titdots$line <- dots$line
+
pdots <- .makedotsLowLevel(dots)
pdots$pch <- if(is.null(dots$pch)) "." else dots$pch
pdots$cex <- cex.pts
@@ -279,7 +287,7 @@
if(doplot){
plotInfo<- list("plotArgs"=NULL)
- plotInfo$PlotArgs <- c(list(x = ndata.x0, y=ndata.y0, type = "p"), pdots)
+ plotInfo$PlotArgs <- c(list(x = ndata.x0, y=ndata.y0, type = "p"), pdots, titdots)
plotInfo$BoxArgs <- c(adots)
do.call(plot, args = plotInfo$PlotArgs)
Modified: branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R 2019-02-26 12:45:41 UTC (rev 1173)
+++ branches/robast-1.2/pkg/RobAStBase/R/infoPlot.R 2019-02-26 18:59:07 UTC (rev 1174)
@@ -183,6 +183,8 @@
legend <- vector("list",dims1)
legend <- .fillList(list(as.list(c("class. opt. IC", objectc))),
dims1)
+ }else{
+ if(!is.list(legend)) legend <- .fillList(legend,dims1)
}
}
@@ -772,10 +774,11 @@
plotInfo <- get("plotInfo", envir = trEnv)
plotInfo$absPlotUsr <- par("usr")
+ if(!is.null(dotsL$lwd)) dotsL$lwd <- NULL
do.call(lines, args=c(list(resc$X, resc$Y, type = plty,
- lty = lty, lwd = lwd, col = col), dotsL))
+ lty = lty, col = col, lwd = lwd), dotsL))
plotInfo$absPlotCArgs <- c(list(resc$X, resc$Y, type = plty,
- lty = lty, lwd = lwd, col = col), dotsL)
+ lty = lty, col = col, lwd = lwd), dotsL)
x.ticks0 <- if(xaxt0[1]!="n") x.ticks[[1]] else NULL
y.ticks0 <- if(yaxt0[1]!="n") y.ticks[[1]] else NULL
@@ -898,6 +901,7 @@
plotInfo <- get("plotInfo", envir = trEnv)
plotInfo$relPlotUsr[[i]] <- par("usr")
+ if(!is.null(dotsL$lwd)) dotsL$lwd <- NULL
plotInfo$relPlotCArgs[[i]] <- c(list(resc.C$X, resc.C$Y, type = plty,
lty = ltyI, col = colI, lwd = lwdI), dotsL)
do.call(lines, args = c(list(resc.C$X, resc.C$Y, type = plty,
Modified: branches/robast-1.2/pkg/RobAStBase/R/plotWrapper.R
===================================================================
--- branches/robast-1.2/pkg/RobAStBase/R/plotWrapper.R 2019-02-26 12:45:41 UTC (rev 1173)
+++ branches/robast-1.2/pkg/RobAStBase/R/plotWrapper.R 2019-02-26 18:59:07 UTC (rev 1174)
@@ -134,7 +134,7 @@
,tmar = substitute(par("mar")[3])
,with.automatic.grid = substitute(TRUE)
,with.legend = substitute(TRUE)
- ,legend = substitute(NULL)
+ ,legend = c("class. opt. IC",as.character(deparse(match.call()$IC)))
,legend.bg = substitute("white")
,legend.location = substitute("bottomright")
,legend.cex = substitute(0.8)
@@ -171,7 +171,7 @@
,ylab.rel= substitute("relative information")
,adj = substitute(0.5)
,cex.main = substitute(1.5)
- ,cex.lab = substitute(1.5)
+ ,cex.lab = substitute(1)
,cex = substitute(1.5)
,bty = substitute("o")
,panel.first= substitute(NULL)
@@ -319,7 +319,7 @@
,tmar = substitute(par("mar")[3])
,with.automatic.grid = substitute(TRUE)
,with.legend = substitute(TRUE)
- ,legend = substitute(NULL)
+ ,legend = as.character(deparse(match.call()$IC))
,legend.bg = substitute("white")
,legend.location = substitute("bottomright")
,legend.cex = substitute(0.8)
@@ -341,14 +341,14 @@
,to.draw.arg = substitute(NULL)
,adj = substitute(0.5)
,cex.main = substitute(1.5)
- ,cex.lab = substitute(1.5)
+ ,cex.lab = substitute(1)
,cex = substitute(1.5)
,bty = substitute("o")
,panel.first= substitute(NULL)
,panel.last= substitute(NULL)
,withSubst = substitute(TRUE)
), scaleList)
- if(!missing(y)){c(argsList, y = substitute(y)
+ if(!missing(y)){argsList <- c(argsList, list(y = substitute(y)
,cex.pts = substitute(1)
,cex.pts.fun = substitute(NULL)
,col.pts = substitute(addAlphTrsp2col(rgb(0,255,0,maxColorValue=255), substitute(alpha.trsp)))
@@ -371,12 +371,11 @@
,attr.pre = substitute(FALSE)
,adj = substitute(0.5)
,cex.main = substitute(1.5)
- ,cex.lab = substitute(1.5)
+ ,cex.lab = substitute(1)
,cex = substitute(1.5)
- ,bty = substitute("o"))
+ ,bty = substitute("o")))
}
-
##parameter for plotting
if(mc$with.legend)
{
@@ -514,10 +513,16 @@
## Scaling of the axes
scaleList <- rescaleFunction(eval(IC1 at CallL2Fam), iny, rescale)
- argsList <- .merge.lists(list(obj1 = substitute(IC1)
- ,obj2 = substitute(IC2)
- ,obj3 = NULL
- ,obj4 = NULL
+ leg <- c(as.character(deparse(mc$IC1)),
+ as.character(deparse(mc$IC2)))
+ if(!is.null(mc$IC3)) leg <- c(leg, as.character(deparse(mc$IC3)))
+ if(!is.null(mc$IC4)) leg <- c(leg, as.character(deparse(mc$IC4)))
+
+
+ argsList <- .merge.lists(list(obj1 = IC1
+ ,obj2 = IC2
+ ,obj3 = if(is.null(mc$IC3)) NULL else mc$IC3
+ ,obj4 = if(is.null(mc$IC4)) NULL else mc$IC4
,forceSameModel = FALSE
,data = NULL
,lwd = substitute(par("lwd"))
@@ -532,7 +537,7 @@
,tmar = substitute(par("mar")[3])
,with.automatic.grid = substitute(TRUE)
,with.legend = substitute(FALSE)
- ,legend = substitute(NULL)
+ ,legend = leg
,legend.bg = substitute("white")
,legend.location = substitute("bottomright")
,legend.cex = substitute(0.8)
@@ -573,7 +578,7 @@
,return.Order = substitute(FALSE)
,adj = substitute(0.5)
,cex.main = substitute(1.5)
- ,cex.lab = substitute(1.5)
+ ,cex.lab = substitute(1)
,cex = substitute(1.5)
,bty = substitute("o")
,col = substitute("blue")
More information about the Robast-commits
mailing list