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

Spencer Graves spencer.graves at pdf.com
Sat May 31 11:05:45 MEST 2003


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)
}



More information about the R-devel mailing list