[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