R的Jensen Shannon分歧

Question

我是R的新手并且正在尝试找到一个计算R中JS散度的函数.我可以看到R有KLdiv用于计算KL散度,但有没有可用于JS分歧的东西？

Answer 1

我一直在寻找JS分歧的简单实现 而不是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)

Jensen-Shannon的分歧是:

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

对于超过2个分布(这里已经讨论过),我们需要一个函数来计算熵:

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是输入分布为列的矩阵.

Answer 2

如果有人还在寻找答案(我当时),有一个函数可以在R包phyloseq中计算出来:http://www.plosone.org/article/info%3Adoi%2F10.1371%2Fjournal.pone 0.0061217

我还发现本教程很有用:http://enterotype.embl.de/enterotypes.html

Answer 3

根据维基百科，Jensen-Shannon 散度是 KL 散度的变换。应用定义中的公式应该会给你 JS 散度，然后......

请参阅：http ://en.wikipedia.org/wiki/Jensen%E2%80%93Shannon_divergence