Skip to content

Instantly share code, notes, and snippets.

@k-barton
Last active November 20, 2020 11:03
Show Gist options
  • Save k-barton/4ab58302080b1e4c4d919259b4fdd3a7 to your computer and use it in GitHub Desktop.
Save k-barton/4ab58302080b1e4c4d919259b4fdd3a7 to your computer and use it in GitHub Desktop.
Compute/plot a weighted histogram using base graphics.
weighted.histogram <-
function() {
cl <- match.call()
cl$w <- NULL
cl[[1L]] <- as.name("hist.default")
cl$plot <- FALSE
h <- eval.parent(cl)
f <- factor(findInterval(x, h$breaks, left.open = TRUE,
rightmost.closed = TRUE,
all.inside = TRUE),
levels = seq.int(length(h$breaks) - 1L))
y <- tapply(w, f, sum, na.rm = TRUE)
y[is.na(y)] <- 0
h$counts <- y * length(f)
h$density <- y / diff(h$breaks)
if (plot) {
if (is.null(freq))
freq <- if (!missing(probability))
!as.logical(probability) else h$equidist
breaks <- h$breaks
xname <- h$xname
plot(h, freq = freq, col = col, border = border, angle = angle,
density = density, main = main, xlim = xlim, ylim = ylim,
xlab = xlab, ylab = ylab, axes = axes, labels = labels,
...)
invisible(h)
} else h
}
formals(weighted.histogram) <-
append(formals(hist.default), alist(w = ), after = 1)
formals(weighted.histogram)['main'] <- alist(paste("Weighted histogram of", xname))
@k-barton
Copy link
Author

k-barton commented Oct 1, 2020

This function modifies hist.default by adding a weights argument (w, 2-nd position). The usage is as in hist.default.

x <- rpois(100, 10)
wts <- runif(100)
par(mfrow = c(1,2))
hist(x)
weighted.histogram(x, wts)

obraz

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment