r - R 中的 Jensen Shannon 散度

Question

我是 R 新手，试图找到一个计算 R 中 JS 散度的函数。我可以看到R有KLdiv用于计算KL散度，但是有什么可用于JS散度吗？

Answer 1

我正在寻找 JS divergence 的简单实现而不是 R 库。由于我没有在任何回复中看到任何回复，因此我提出了以下回复。

假设我们有以下输入分布:

# p & q are distributions so their elements should sum up to 1
p <- c(0.00029421, 0.42837957, 0.1371827, 0.00029419, 0.00029419,
       0.40526004, 0.02741252, 0.00029422, 0.00029417, 0.00029418)

q <- c(0.00476199, 0.004762, 0.004762, 0.00476202, 0.95714168,
       0.00476213, 0.00476212, 0.00476202, 0.00476202, 0.00476202)

詹森-香农散度为:

n <- 0.5 * (p + q)
JS <- 0.5 * (sum(p * log(p / n)) + sum(q * log(q / n)))
> JS
[1] 0.6457538

对于超过 2 个分布(已经讨论过 here )，我们需要一个函数来计算 Entropy :

H <- function(v) {
      v <- v[v > 0]
      return(sum(-v * log(v)))
}

那么 JS 分歧将是:

JSD <- function(w, m) {
  return(H(m %*% w) - apply(m, 2, H) %*% w)
}

> JSD(w = c(1/3, 1/3, 1/3), m = cbind(p, q, n))
          [,1]
[1,] 0.4305025

其中 w 是一个权重向量，其总和应为 1，m 是一个以输入分布为列的矩阵。