KL Divergence & Rcpp

kl_divergence_example.R

li(ggplot2)
theme_set(theme_classic())

kld <- function(p, q) sum(p * log(p / q))
n <- 1e6
p <- c(0.6, 0.4)
q1 <- runif(n)
q2 <- 1 - q1
z <- matrix(c(q1, q2), ncol = 2)
kl <- apply(z, 1, kld, p = p)
qplot(q1, kl, geom = "line") +
  xlab("Probability") +
  ylab("KL Divergence") +
  geom_vline(xintercept = p[1], colour = "grey")

# C++
apply_kld <- rcpp_apply_generator('return sum(p * log(p / x));', 
  additional = '
  // [[Rcpp::plugins("cpp11")]]
  NumericVector p   {0.6, 0.4};')

bm <- bench::mark(
  base = apply(z, 1, kld, p = p),
  rcpp = apply_kld(z, 1)
)

summary(bm)
summary(bm, relative = T)