Fixed weighted binMeans() due mess up in merging etc.

.Rbuildignore

@@ -5,6 +5,7 @@
 ^.git
 ^.make
 README[.]md
+OVERVIEW[.]md
 
 #----------------------------
 # Travis-CI et al.

R/binMeans.R

@@ -12,6 +12,7 @@
 # \arguments{
 #   \item{y}{A @numeric @vector of K values to calculate means on.}
 #   \item{x}{A @numeric @vector of K positions for to be binned.}
+#   \item{w}{(Optional) A @numeric @vector of K non-negative weights.}
 #   \item{bx}{A @numeric @vector of B+1 ordered positions specifying
 #      the B bins \code{[bx[1],bx[2])}, \code{[bx[2],bx[3])}, ...,
 #      \code{[bx[B],bx[B+1])}.}
@@ -63,25 +64,25 @@
 #
 # @keyword "univar"
 #*/############################################################################
-binMeans <- function(y, x, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...) {
+binMeans <- function(y, x, w=NULL, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...) {
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Validate arguments
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Argument 'y':
   if (!is.numeric(y)) {
-    stop("Argument 'y' is not numeric: ", mode(y))
+    stop("Argument 'y' is not numeric: ", mode(y));
   }
   if (any(is.infinite(y))) {
-    stop("Argument 'y' must not contain Inf values.")
+    stop("Argument 'y' must not contain Inf values.");
   }
-  n <- length(y)
+  n <- length(y);
 
   # Argument 'x':
   if (!is.numeric(x)) {
-    stop("Argument 'x' is not numeric: ", mode(x))
+    stop("Argument 'x' is not numeric: ", mode(x));
   }
   if (length(x) != n) {
-    stop("Argument 'y' and 'x' are of different lengths: ", length(y), " != ", length(x))
+    stop("Argument 'y' and 'x' are of different lengths: ", length(y), " != ", length(x));
   }
 
   # Argument 'w':
@@ -103,54 +104,54 @@ binMeans <- function(y, x, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...) {
 
   # Argument 'bx':
   if (!is.numeric(bx)) {
-    stop("Argument 'bx' is not numeric: ", mode(bx))
+    stop("Argument 'bx' is not numeric: ", mode(bx));
   }
   if (any(is.infinite(bx))) {
-    stop("Argument 'bx' must not contain Inf values.")
+    stop("Argument 'bx' must not contain Inf values.");
   }
   if (is.unsorted(bx)) {
-    stop("Argument 'bx' is not ordered.")
+    stop("Argument 'bx' is not ordered.");
   }
 
   # Argument 'na.rm':
   if (!is.logical(na.rm)) {
-    stop("Argument 'na.rm' is not logical: ", mode(na.rm))
+    stop("Argument 'na.rm' is not logical: ", mode(na.rm));
   }
 
   # Argument 'count':
   if (!is.logical(count)) {
-    stop("Argument 'count' is not logical: ", mode(count))
+    stop("Argument 'count' is not logical: ", mode(count));
   }
 
   # Argument 'right':
-  right <- as.logical(right)
+  right <- as.logical(right);
 
 
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  # Preprocessing of (x,y)
+  # Preprocessing of (x,y,w)
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Drop missing values in 'x'
-  keep <- which(!is.na(x))
+  keep <- which(!is.na(x));
   if (length(keep) < n) {
-    x <- x[keep]
-    y <- y[keep]
+    x <- x[keep];
+    y <- y[keep];
     if (hasWeights) w <- w[keep]
-    n <- length(y)
+    n <- length(y);
   }
-  keep <- NULL # Not needed anymore
+  keep <- NULL; # Not needed anymore
 
   # Drop missing values in 'y'?
   if (na.rm) {
-    # Drop missing values in 'y'?
-    keep <- which(!is.na(y))
+    keep <- which(!is.na(y));
     if (length(keep) < n) {
-      x <- x[keep]
-      y <- y[keep]
+      x <- x[keep];
+      y <- y[keep];
       if (hasWeights) w <- w[keep]
+      n <- length(y)
     }
-    keep <- NULL # Not needed anymore
+    keep <- NULL; # Not needed anymore
 
-    # Drop missing values in 'z'?
+    # Drop missing values in 'w'?
     if (hasWeights) {
       keep <- which(!is.na(w))
       if (length(keep) < n) {
@@ -165,19 +166,19 @@ binMeans <- function(y, x, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...) {
   # Order (x,y) by increasing x.
   # If 'x' is already sorted, the overhead of (re)sorting is
   # relatively small.
-  x <- sort.int(x, method="quick", index.return=TRUE)
-  y <- y[x$ix]
+  x <- sort.int(x, method="quick", index.return=TRUE);
+  y <- y[x$ix];
   if (hasWeights) w <- w[x$ix]
-  x <- x$x
+  x <- x$x;
 
 
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   # Bin
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  y <- as.numeric(y)
-  x <- as.numeric(x)
-  bx <- as.numeric(bx)
-  count <- as.logical(count)
+  y <- as.numeric(y);
+  x <- as.numeric(x);
+  bx <- as.numeric(bx);
+  count <- as.logical(count);
 
   if (hasWeights) {
     w <- as.numeric(w)
@@ -194,7 +195,7 @@ binMeans <- function(y, x, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...) {
     # Weighted mean per bin
     bwy / bw
   } else {
-    .Call("binMeans", y, x, bx, count, right, PACKAGE="matrixStats")
+    .Call("binMeans", y, x, bx, count, right, PACKAGE="matrixStats");
   }
 } # binMeans()
 
@@ -220,4 +221,3 @@ binMeans <- function(y, x, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...) {
 #   Martin Morgan, Fred Hutchinson Cancer Research Center, Seattle.
 # o Created.
 ############################################################################
-

man/binMeans.Rd

@@ -13,7 +13,7 @@
 \title{Fast mean calculations in non-overlapping bins}
 
 \usage{
-binMeans(y, x, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...)
+binMeans(y, x, w=NULL, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...)
 }
 
 \description{
@@ -23,6 +23,7 @@ binMeans(y, x, bx, na.rm=TRUE, count=TRUE, right=FALSE, ...)
 \arguments{
   \item{y}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} of K values to calculate means on.}
   \item{x}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} of K positions for to be binned.}
+  \item{w}{(Optional) A \code{\link[base]{numeric}} \code{\link[base]{vector}} of K non-negative weights.}
   \item{bx}{A \code{\link[base]{numeric}} \code{\link[base]{vector}} of B+1 ordered positions specifying
      the B bins \code{[bx[1],bx[2])}, \code{[bx[2],bx[3])}, ...,
      \code{[bx[B],bx[B+1])}.}