[Robast-commits] r756 - branches/robast-1.0/pkg/RobAStBase/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2014-07-22 19:22:06 +0200 (Tue, 22 Jul 2014)
New Revision: 756

Modified:
   branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R
   branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R
Log:
RobAStBase: introduced automatic scaling of points in comparePlot.R and infoPlot.R

Modified: branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R	2014-07-18 12:52:53 UTC (rev 755)
+++ branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R	2014-07-22 17:22:06 UTC (rev 756)
@@ -253,9 +253,14 @@
                  return(.SelectOrderData(data, fct.aI, which.lbs, which.Order))}
                  
             sel1 <- def.sel(IC1); sel2 <- def.sel(IC2)
+            selAlly <- c(sel1$y,sel2$y)
 
-            if(is(obj3, "IC")) sel3 <- def.sel(IC3)
-            if(is(obj4, "IC")) sel4 <- def.sel(IC4)
+            if(is(obj3, "IC")){ sel3 <- def.sel(IC3)
+                                selAlly <- c(selAlly,sel3$y)
+                              }
+            if(is(obj4, "IC")){ sel4 <- def.sel(IC4)
+                                selAlly <- c(selAlly,sel4$y)
+                              }
 
             dots.points <- .makedotsLowLevel(dots)
             dots.points$col <- dots.points$cex <- dots.points$pch <- NULL
@@ -275,7 +280,7 @@
 
                      col.l <- if(is.na(al0[j.l])) col0[j.l] else
                                  addAlphTrsp2col(col0[j.l], al0[j.l])
-                     cex.l <- log(sel.l$y+1)*3*cex0[j.l]
+                     cex.l <- .cexscale(sel.l$y,selAlly,cex=cex0[j.l])   ##.cexscale in infoPlot.R
                      do.call(points, args=c(list(rescd$X, rescd$Y, cex = cex.l,
                              col = col.l, pch = pch.pts.l), dwo0))
                      if(with.lab0)

Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R	2014-07-18 12:52:53 UTC (rev 755)
+++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R	2014-07-22 17:22:06 UTC (rev 756)
@@ -357,8 +357,8 @@
                       ICy0cr1 <- jitter(ICy0cr1, factor = jitter.fac0[2])
                    }
 
-                   f1 <- log(ICy0+1)*3*cex0[1]
-                   f1c <- log(ICy0c+1)*3*cex0[2]
+                   f1 <- .cexscale(ICy0,ICy0c,cex=cex0[1])
+                   f1c <- .cexscale(ICy0c,ICy0,cex=cex0[2])
 
                    col.pts <- if(!is.na(al0)) sapply(col0,
                               addAlphTrsp2col, alpha=al0) else col0
@@ -398,8 +398,8 @@
                               scaleX, scaleX.fct, scaleX.inv,
                               FALSE, scaleY.fct, dots$xlim, dots$ylim, dotsP0)
 
-                   f1 <- resc.rel$scy*0.3*cex0[1]
-                   f1c <- resc.rel.c$scy*0.3*cex0[2]
+                   f1 <- .cexscale(resc.rel$scy,resc.rel.c$scy,cex=cex0[1])
+                   f1c <- .cexscale(resc.rel.c$scy,resc.rel$scy,cex=cex0[2])
 
                    do.pts(resc.rel$X, resc.rel$Y, f1,col.pts[1],pch0[,1])
                    do.pts(resc.rel.c$X, resc.rel.c$Y, f1c,col.pts[2],pch0[,2])
@@ -535,4 +535,15 @@
         invisible()
         }
     )
+ 
+ .cexscale <- function(y, y1=y, maxcex=4,mincex=0.05,cex, fun=NULL){
+         if(is.null(fun)) fun <- function(x) log(1+abs(x))
+         ly <- fun(y)
+         ly1 <- fun(unique(c(y,y1)))
+         my <- min(ly1,na.rm=TRUE)
+         My <- max(ly1,na.rm=TRUE)
+         ly0 <- (ly-my)/My
+         ly1 <- ly0*(maxcex-mincex)+mincex
+         return(cex*ly1)
+ }
  
\ No newline at end of file