See ?weighted.mean
On Sat, 31 May 2003, Spencer Graves wrote:
> 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?
Looks like the latter.
BTW, please use sort.list instead of order when the first is appropriate,
as it is more efficient (slightly).
> 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)
> }
>
> ______________________________________________
> R-devel@stat.math.ethz.ch mailing list
> https://www.stat.math.ethz.ch/mailman/listinfo/r-devel
>
--
Brian D. Ripley, ripley@stats.ox.ac.uk
Professor of Applied Statistics, http://www.stats.ox.ac.uk/~ripley/
University of Oxford, Tel: +44 1865 272861 (self)
1 South Parks Road, +44 1865 272866 (PA)
Oxford OX1 3TG, UK Fax: +44 1865 272595