From spencer.graves at pdf.com  Sat May 31 11:05:45 2003
From: spencer.graves at pdf.com (Spencer Graves)
Date: Sat May 31 19:06:04 2003
Subject: [Rd] fac.design & mean.default(..., weights)
Message-ID: <3ED8E0E9.1090205@pdf.com>

Dear R-Developers:

	  I had a need for a weighted mean, so I added a "weights" argument to 
"mean.default", similar to the "weights" argument in "lm".  The 
resulting code is copied below, in case any of you might find this an 
interesting and useful option to include in a future release.

	  Is this something you like to hear about, or is this email a waste of 
your time and mine?

	  Thanks for your valuable work on the R project.

Best Wishes,
Spencer Graves
####################################
mean.default <-
function (x, trim = 0, na.rm = FALSE,
	weights=NULL, ...)
{
#	mean.default with a "weights" argument
     if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
         warning("argument is not numeric or logical: returning NA")
         return(as.numeric(NA))
     }
	 if(is.null(weights)) weights <- rep(1, length(x))
     if (na.rm) {
	     rm.na <- !(is.na(x)|is.na(weights))
	     weights <- weights[rm.na]
         x <- x[rm.na]
  	 }
     trim <- trim[1]
     n <- length(c(x, recursive = TRUE))
     if (trim > 0 && n > 0) {
         if (is.complex(x))
             stop("trimmed means are not defined for complex data")
         if (trim >= 0.5)
             return(median(x, na.rm = FALSE))
         lo <- floor(n * trim) + 1
         hi <- n + 1 - lo
#       x <- sort(x, partial = unique(c(lo, hi)))[lo:hi]
		  iord <- order(x)
		  x <- x[iord][lo:hi]
		  weights <- weights[iord][lo:hi]
         n <- hi - lo + 1
     }
     if (is.integer(x))
         sum(weights*as.numeric(x))/sum(weights)
     else sum(weights*x)/sum(weights)
}


[Rd] fac.design & mean.default(..., weights)
Spencer Graves