[R-gregmisc-commits] r2134 - in pkg/gplots: . R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Aug 12 19:34:11 CEST 2016


Author: warnes
Date: 2016-08-12 19:34:11 +0200 (Fri, 12 Aug 2016)
New Revision: 2134

Added:
   pkg/gplots/.Rbuildignore
Modified:
   pkg/gplots/R/space.R
Log:
Improve method of spacing points in the same bin.

Added: pkg/gplots/.Rbuildignore
===================================================================
--- pkg/gplots/.Rbuildignore	                        (rev 0)
+++ pkg/gplots/.Rbuildignore	2016-08-12 17:34:11 UTC (rev 2134)
@@ -0,0 +1,3 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^\.RData

Modified: pkg/gplots/R/space.R
===================================================================
--- pkg/gplots/R/space.R	2016-08-12 17:18:32 UTC (rev 2133)
+++ pkg/gplots/R/space.R	2016-08-12 17:34:11 UTC (rev 2134)
@@ -7,6 +7,7 @@
 
 space <-  function(x,y,s=1/50, na.rm=TRUE, direction="x")
   {
+    # to avoid duplicating code for direction="y", swap x and y temporarily...
     if(direction!='x')
       {
         tmp <- y
@@ -35,29 +36,45 @@
     x <- x[ord]
     y <- y[ord]
 
-    startsame <- 1
-    same.x <- x[1]
-    same.y <- y[1]
+    # split into groups within the same interval
+    sames.x <- c(FALSE, within(x[1:(length(x)-1)],
+                               x[-1],
+                               delta=spacing.x)
+                 )
+    sames.y <- c(FALSE, within(y[1:(length(y)-1)],
+                               y[-1],
+                               delta=spacing.y)
+    )
+    sames <- sames.x & sames.y
+    groups <- cumsum(!sames)
+    xList <- split(x, groups)
+    yList <- split(y, groups)
 
-    for( i in 1:length(x) )
+
+    for( i in 1:max(groups) )
       {
-        if(i>1 &&
-           within(x[i],same.x,spacing.x) &&
-           within(y[i],same.y,spacing.y) )
-          {
-            if(x[startsame] == same.x )
-              x[startsame] <- x[startsame]
+      len <- length(xList[[i]])
+      if(len==1)
+        next
 
-            cumrun <- i - startsame
+      m <- mean(xList[[i]])
+      s <- len/2 * spacing.x
+      deltas <- seq(from=-s, to=+s, length.out=len)
+      order <- "permute"
+      if (order=="permute")
+        deltas <- sample(deltas)
+      else if (order=="A")
+        deltas <- deltas[order(abs(deltas), decreasing=TRUE)]
+      else if (order=="V")
+        deltas <- deltas[order(abs(deltas), decreasing=FALSE)]
 
-            x[i] <- x[i] + (-1)^(cumrun+1) * floor((cumrun+1) /2) * spacing.x
-          } else {
-            startsame <- i
-            same.x <- x[i]
-            same.y <- y[i]
-          }
-      }
+      xList[[i]] <- xList[[i]] + deltas
+    }
 
+    x <- unlist(xList)[undo]
+    y <- unlist(yList)[undo]
+
+    # undo swap of x and y.
     if(direction!='x')
       {
         tmp <- y
@@ -65,6 +82,6 @@
         x <- tmp
       }
 
-    return( list(x=x[undo], y=y[undo]) )
+    return( list(x=x, y=y) )
 }
 



More information about the R-gregmisc-commits mailing list