1# File src/library/stats/R/weighted.mean.R 2# Part of the R package, https://www.R-project.org 3# 4# Copyright (C) 1995-2012 The R Core Team 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# (at your option) any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# A copy of the GNU General Public License is available at 17# https://www.R-project.org/Licenses/ 18 19weighted.mean <- function(x, w, ...) UseMethod("weighted.mean") 20 21weighted.mean.default <- function(x, w, ..., na.rm = FALSE) 22{ 23 if(missing(w)) { 24 ## avoid creating weights vector 25 if (na.rm) x <- x[!is.na(x)] 26 return(sum(x)/length(x)) 27 } 28 if (length(w) != length(x)) 29 stop("'x' and 'w' must have the same length") 30 if (na.rm) { i <- !is.na(x); w <- w[i]; x <- x[i] } 31 sum((x*w)[w != 0])/sum(w) # --> NaN in empty case 32} 33 34## see note for ?mean.Date 35weighted.mean.Date <- function (x, w, ...) 36 .Date(weighted.mean(unclass(x), w, ...)) 37 38weighted.mean.POSIXct <- function (x, w, ...) 39 .POSIXct(weighted.mean(unclass(x), w, ...), attr(x, "tzone")) 40 41weighted.mean.POSIXlt <- function (x, w, ...) 42 as.POSIXlt(weighted.mean(as.POSIXct(x), w, ...)) 43 44weighted.mean.difftime <- function (x, w, ...) 45 .difftime(weighted.mean(unclass(x), w, ...), attr(x, "units")) 46