Several kinds of means in R

Means.R

# in no particular order (I did Google searches for many of these and found nothing, 
# so here's to mixing wikipedia and R!

# a caveat, most of these are designed to only take x as a vector with 2 values, 
# *even though* there may be generalizations out there for more values in the vector

# also, only a couple of these accept weights, 
# but they can all be properly weighted with very little tinkering

logorithmic.mean <- function(x){
	stopifnot(all(length(x) == 2,x >= 0))
	if (any(x==0)){return(0)}
	if (diff(x)==0) {return(x[1])}
	return(diff(x)/(diff(log(x))))
}

harmonic.mean <- function(x){
	stopifnot(length(x)==2)
	2*(prod(x)/sum(x))
}

# arithmetic-harmonic = contraharmonic-arithmetic (flipped about arithmetic mean):
# i.e. harmonic hugs the smaller number and contraharmonic hugs the bigger number
contraharmonic.mean <- function(x){
	mean(x^2)/mean(x)
}

geometric.mean <- function(x){
	stopifnot(length(x)==2)
	sqrt(prod(x))
}

identric.mean <- function(x){
	stopifnot(length(x)==2)
	if (diff(x)==0){
		return(x[1])
	}
	((1/(exp(1)))*((x[1]^x[1])/(x[2]^x[2]))^(1/diff(rev(x))))
}


arithmeticgeometric.mean <- function(x,tol=1e-10){
	stopifnot(length(x)==2)
	res <- 1
	while(res > tol){
		x <- c(mean(x),sqrt(prod(x)))
		res <- abs(diff(x))
	}
	return(x[1])
}

geometricharmonic.mean <- function(x, tol=1e-10){
	stopifnot(length(x)==2)
	res <- 1
	while(res > tol){
		x <- c(sqrt(prod(x)),2/(sum(1/x)))
		res <- abs(diff(x))
	}
	return(x[1])
}

heronian.mean <- function(x){
	stopifnot(length(x)==2)
	1/3*(sum(x,sqrt(prod(x))))
}

# root mean square, also called quadratic mean:
rms.mean <- function(x){
	sqrt(mean(x^2))
}

# lehmer mean can get to many of the above depending on p
lehmer.mean <- function(x,p,weights){
	if (missing(weights)) weights <- rep(1,length(x))
	stopifnot(length(x)==2)
	stopifnot(length(x)==length(weights))
	sum(weights*x^p)/sum(weights*x^(p-1))
}

# not certain about my implementation of the Stolarsky mean. 
# It captures many of the above according to your choice of r and s.
stolarsky.mean <- function(x,r,s){
	stopifnot(all(length(x) == 2,x >= 0))
	if (r*s*(r-s) != 0){ 
		return(((r/s)*(diff(x^s)/diff(x^r)))^(1/(s-r)))
	}
	if (r==s & !any(c(r,s)==0)){
		return(exp((-1/r)+(diff((x^r)*log(x)))/(diff(x^r))))
	}
	if (r==s & any(c(r,s)==0)){
		return(sqrt(prod(x)))
	}
}

# not certain about my implementation of the gini mean. 
# It captures many of the above according to your choice of r and s.
gini.mean <- function(x,r,s){
	stopifnot(all(length(x) == 2,x >= 0))
	if (r != s){
		return(((sum(x^r)/sum(x^s)))^(1/(r-s)))
	}
	if (r == s ){
		return(exp(sum((x^r)*log(x))/sum(x^r)))
	}
}