求r中多项式分布之间的总变化距离

我比较了多项分布中的贝叶斯估计和最大似然估计。我使用rmultinom从特定的多项式分布中抽取随机样本，使用

rmultinom(400, size = 30, prob = c(5,7,10,8,14,10,15,12,10,9))

对于400个样本中的每一个，我计算十个概率参数的MLE和Bayes估计。现在我想找出每种情况下，真实分布和估计量定义的分布之间的总变化距离

mle <- result/30
mle.dist <- rmultinom(10^6, 30, mle)
p.true.e2 <- mean(apply(true.dist, 2, function(x)
  dmultinom(x, 30, true) - dmultinom(x, 30, mle) > 0))
p.mle.e2 <- mean(apply(mle.dist, 2, function(x)
  dmultinom(x, 30, true) - dmultinom(x, 30, mle) > 0))
p.true.e2 - p.mle.e2
## [1] 0.968301

因为对于30号和10号垃圾箱，有超过2亿种可能的安排，我不认为使用理论定义是一个好主意

该包有一个函数“TotalVarDist（）”，但它只能用于包中定义的分布，多项式不是其中之一。有定义它们的方向（请参阅和），但选项是通过明确列出支持来定义离散分布（同样，我认为这不是一个好选项，因为支持的大小超过2亿），或者从零开始使用与创建发行包相同的方法，这超出了我目前的能力

---

关于如何使用上述软件包或以完全不同的方式实现这一点，您有什么想法吗？

我的答案是关于如何使用base R计算这一点

我们有两个多项式参数向量，θ和η。总变化距离相当于P_θ（E）-P_η（E），其中E={ω| P_θ（{ω}）>P_η（{ω}），ω是样本计数的向量

我知道有两种方法来评估R基中的p（E）。一种是非常简单的基于模拟的方法。另一种方法根据近似正态分布的计数线性组合来重新构造问题，并使用

pnorm

函数

基于仿真的方法 您模拟每个分布的样本，使用概率质量函数检查它们是否在E中，并计算它们的频率。我将在这里介绍一个示例。我们将根据您的问题假设真实分布：

unnormalized.true <- c(5,7,10,8,14,10,15,12,10,9)
true <- unnormalized.true / sum(unnormalized.true)

用最大似然估计重复这个过程，我们得到了估计量的比较

mle <- result/30
mle.dist <- rmultinom(10^6, 30, mle)
p.true.e2 <- mean(apply(true.dist, 2, function(x)
  dmultinom(x, 30, true) - dmultinom(x, 30, mle) > 0))
p.mle.e2 <- mean(apply(mle.dist, 2, function(x)
  dmultinom(x, 30, true) - dmultinom(x, 30, mle) > 0))
p.true.e2 - p.mle.e2
## [1] 0.968301

注意，我正在比较真实分布和Bayes估计分布。我不能用MLE做这个，因为我的样本计数为零

绘制L的分布并与正态拟合进行比较：

par(mfrow=c(1,2))
L.true.dist.hist <- hist(L.true.dist)
L.true.dist.fit <- function(x)
  length(L.true.dist) * diff(L.true.dist.hist$breaks)[1] *
  dnorm(x, mean(L.true.dist), sd=sd(L.true.dist))
curve(L.true.dist.fit, add=TRUE, n=1000, col='red')
L.dirichlet.dist.hist <- hist(L.dirichlet.dist)
L.dirichlet.dist.fit <- function(x)
  length(L.dirichlet.dist) * diff(L.dirichlet.dist.hist$breaks)[1] *
  dnorm(x, mean(L.dirichlet.dist), sd=sd(L.dirichlet.dist))
curve(L.dirichlet.dist.fit, add=TRUE, n=1000, col='red')
par(mfrow=c(1,1))

然后，分布的Bayes估计下L的均值和方差：

set.seed(939)
true.dist <- rmultinom(10^6, 30, true)
p.true.e <- mean(apply(true.dist, 2, function(x)
                 dmultinom(x, 30, true) - dmultinom(x, 30, dirichlet) > 0))

n <- 30
k <- length(true)
mean.L.true <- sum(lambda * n * true)
# Did we get the mean right?
c(mean.L.true, mean(L.true.dist))
## [1] 3.873509 3.875547
# Covariance matrix assuming the true distribution
sigma.true <- outer(1:k, 1:k, function(i,j)
  ifelse(i==j, n*true[i]*(1-true[i]), -n*true[i]*true[j]))
var.L.true <- t(lambda) %*% sigma.true %*% lambda
# Did we get the standard deviation right?
c(sqrt(var.L.true), sd(L.true.dist))
## [1] 2.777787 2.776945

mean.L.dirichlet <- sum(lambda * n * dirichlet)
# Did we get the mean right?
c(mean.L.dirichlet, mean(L.dirichlet.dist))
## [1] -3.893836 -3.895983
# Covariance matrix assuming the estimated distribution
sigma.dirichlet <- outer(1:k, 1:k, function(i,j)
  ifelse(i==j, n*dirichlet[i]*(1-dirichlet[i]), -n*dirichlet[i]*dirichlet[j]))
var.L.dirichlet <- t(lambda) %*% sigma.dirichlet %*% lambda
# Did we get the standard deviation right?
c(sqrt(var.L.dirichlet), sd(L.dirichlet.dist))
## [1] 2.796348 2.793421

我们得到了三位数的模拟结果

不过，我不知道有什么简单的方法可以扩展正态近似方法来处理零概率。我有一个想法，但我在计算计数的协方差矩阵时遇到了困难，因为特定单元格的计数为0。如果你认为你能有所成就，我可以分享我的进步

par(mfrow=c(1,2))
L.true.dist.hist <- hist(L.true.dist)
L.true.dist.fit <- function(x)
  length(L.true.dist) * diff(L.true.dist.hist$breaks)[1] *
  dnorm(x, mean(L.true.dist), sd=sd(L.true.dist))
curve(L.true.dist.fit, add=TRUE, n=1000, col='red')
L.dirichlet.dist.hist <- hist(L.dirichlet.dist)
L.dirichlet.dist.fit <- function(x)
  length(L.dirichlet.dist) * diff(L.dirichlet.dist.hist$breaks)[1] *
  dnorm(x, mean(L.dirichlet.dist), sd=sd(L.dirichlet.dist))
curve(L.dirichlet.dist.fit, add=TRUE, n=1000, col='red')
par(mfrow=c(1,1))

n <- 30
k <- length(true)
mean.L.true <- sum(lambda * n * true)
# Did we get the mean right?
c(mean.L.true, mean(L.true.dist))
## [1] 3.873509 3.875547
# Covariance matrix assuming the true distribution
sigma.true <- outer(1:k, 1:k, function(i,j)
  ifelse(i==j, n*true[i]*(1-true[i]), -n*true[i]*true[j]))
var.L.true <- t(lambda) %*% sigma.true %*% lambda
# Did we get the standard deviation right?
c(sqrt(var.L.true), sd(L.true.dist))
## [1] 2.777787 2.776945

mean.L.dirichlet <- sum(lambda * n * dirichlet)
# Did we get the mean right?
c(mean.L.dirichlet, mean(L.dirichlet.dist))
## [1] -3.893836 -3.895983
# Covariance matrix assuming the estimated distribution
sigma.dirichlet <- outer(1:k, 1:k, function(i,j)
  ifelse(i==j, n*dirichlet[i]*(1-dirichlet[i]), -n*dirichlet[i]*dirichlet[j]))
var.L.dirichlet <- t(lambda) %*% sigma.dirichlet %*% lambda
# Did we get the standard deviation right?
c(sqrt(var.L.dirichlet), sd(L.dirichlet.dist))
## [1] 2.796348 2.793421

pnorm(0, mean.L.true, sd=sqrt(var.L.true), lower.tail=FALSE) -
  pnorm(0, mean.L.dirichlet, sd=sqrt(var.L.true), lower.tail=FALSE)
## [1] 0.8379193
# Previous result was 0.83737