# Can plot points colored according to known pdf:
set.seed(1)
df <- data.frame(x = rexp(1000), y = rexp(1000))
f <- function(x, y) dexp(x) * dexp(y)
ggplot(df, aes(x, y)) +
geom_hdr_points_fun(fun = f, xlim = c(0, 10), ylim = c(0, 10))
# Also allows for hdrs of a custom parametric model
# generate example data
n <- 1000
th_true <- c(3, 8)
rdata <- function(n, th) {
gen_single_obs <- function(th) {
rchisq(2, df = th) # can be anything
}
df <- replicate(n, gen_single_obs(th))
setNames(as.data.frame(t(df)), c("x", "y"))
}
data <- rdata(n, th_true)
# estimate unknown parameters via maximum likelihood
likelihood <- function(th) {
th <- abs(th) # hack to enforce parameter space boundary
log_f <- function(v) {
x <- v[1]; y <- v[2]
dchisq(x, df = th[1], log = TRUE) + dchisq(y, df = th[2], log = TRUE)
}
sum(apply(data, 1, log_f))
}
(th_hat <- optim(c(1, 1), likelihood, control = list(fnscale = -1))$par)
# plot f for the give model
f <- function(x, y, th) dchisq(x, df = th[1]) * dchisq(y, df = th[2])
ggplot(data, aes(x, y)) +
geom_hdr_points_fun(fun = f, args = list(th = th_hat))
ggplot(data, aes(x, y)) +
geom_hdr_points_fun(aes(fill = after_stat(probs)), shape = 21, color = "black",
fun = f, args = list(th = th_hat), na.rm = TRUE) +
geom_hdr_lines_fun(aes(color = after_stat(probs)), alpha = 1, fun = f, args = list(th = th_hat)) +
lims(x = c(0, 15), y = c(0, 25))
Run the code above in your browser using DataLab