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)
}
fac.design & mean.default(..., weights)
2 messages · Spencer Graves, Brian Ripley
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