Skip to content

Instantly share code, notes, and snippets.

@mattbaggott
Created November 2, 2012 06:09
Show Gist options
  • Save mattbaggott/3998999 to your computer and use it in GitHub Desktop.
Save mattbaggott/3998999 to your computer and use it in GitHub Desktop.
gastwirth estimator, weighted median
gastwirth <- function(x,...){
# gastwirth's location estimator
# discussed in Ronald Pearson's Exploring Data in Engineering, the Sciences, and Medicine
# and at http://exploringdatablog.blogspot.com/2012/03/gastwirths-location-estimator.html
ordstats = quantile(x, probs=c(1/3,1/2,2/3),...)
weights = c(0.3,0.4,0.3)
sum(weights*ordstats)
#
}
wmedian <- function(x, weights, na.rm = FALSE) {
if (missing(weights))
weights <- rep.int(1, length(x)) else {
if (any(is.na(weights)))
stop("Weights cannot contain NA")
if (length(weights) != length(x))
stop("weights not same length as values")
if (any(weights < 0))
stop("Weights must be non-negative")
}
if (is.integer(weights))
weights <- as.numeric(weights)
if (na.rm) {
weights <- weights[i <- !is.na(x)]
x <- x[i]
}
if (all(weights == 0)) {
warning("Weights are all zero")
return(NA)
}
x <- x[order(x)]
weights <- weights[order(x)]
p <- cumsum(weights)/sum(weights)
n <- sum(p < 0.5)
if (p[n + 1] > 0.5)
x[n + 1] else (x[n + 1] + x[n + 2])/2
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment