将分布拟合到R中的给定频率值

我的频率值随时间变化（

x

轴单位），如下图所示。在一些标准化之后，这些值可以被视为某些分布的密度函数的数据点

Q:假设这些频率点来自威布尔分布

T

，我如何将最佳威布尔密度函数拟合到这些点，从而从中推断分布

T

参数

sample <- c(7787,3056,2359,1759,1819,1189,1077,1080,985,622,648,518,
            611,1037,727,489,432,371,1125,69,595,624)

plot(1:length(sample), sample, type = "l")
points(1:length(sample), sample)

并在

集合上使用
fitdistr
。值

：

f2 <- fitdistr(set.values, 'weibull')
f2

---

f2假设数据来自威布尔分布，可以得到形状和比例参数的估计值，如下所示：

sample <- c(7787,3056,2359,1759,1819,1189,1077,1080,985,622,648,518,
        611,1037,727,489,432,371,1125,69,595,624)
 f<-fitdistr(sample, 'weibull')
 f

p值不重要，因此您不会拒绝数据来自威布尔分布的假设

更新：威布尔或指数直方图看起来与您的数据非常匹配。我认为指数分布更适合你。帕累托分布是另一种选择

f<-fitdistr(sample, 'weibull')
z<-rweibull(10000, shape= f$estimate[1],scale= f$estimate[2])
hist(z)

f<-fitdistr(sample, 'exponential')
z = rexp(10000, f$estimate[1]) 
hist(z)

f


这里有一个更好的尝试，就像以前一样，它使用
optim
查找约束到框中一组值的最佳值（由
optim
调用中的
lower
和
upper
向量定义）。请注意，除了Weibull分布形状参数外，它还将x和y作为优化的一部分进行缩放，因此我们有3个参数需要优化

不幸的是，当使用所有的点时，它几乎总是在约束框的边缘发现一些东西，这向我表明，也许Weibull并不适合所有的数据。问题在于两点——它们太大了。您可以在第一个绘图中看到尝试对所有数据进行拟合

如果我放弃了前两分，把剩下的都补上，我们会得到更好的补上。您可以在第二个绘图中看到这一点。我认为这是一个很好的拟合，它在任何情况下都是约束框内部的局部最小值

library(optimx)
sample <- c(60953,7787,3056,2359,1759,1819,1189,1077,1080,985,622,648,518,
            611,1037,727,489,432,371,1125,69,595,624)
t.sample <- 0:22

s.fit <- sample[3:23]
t.fit <- t.sample[3:23]

wx <- function(param) { 
  res <- param[2]*dweibull(t.fit*param[3],shape=param[1])
  return(res)
} 
minwx <- function(param){
  v <- s.fit-wx(param)
  sqrt(sum(v*v))
}

p0 <- c(1,200,1/20)
paramopt <- optim(p0,minwx,gr=NULL,lower=c(0.1,100,0.01),upper=c(1.1,5000,1))

popt <- paramopt$par
popt
rms <- paramopt$value
tit <- sprintf("Weibull - Shape:%.3f xscale:%.1f  yscale:%.5f rms:%.1f",popt[1],popt[2],popt[3],rms)

plot(t.sample[2:23], sample[2:23], type = "p",col="darkred")
lines(t.fit, wx(popt),col="blue")
title(main=tit)

库（optimx）
sample您可以直接计算最大似然参数，如下所述

#定义隐式函数的错误
k、 我承认这个答案是正确的，恐怕我犯了一个错误。
fitdistr
函数将值（此处：来自
sample
vector的值）视为分布
T
的实现（换句话说：从drom分布
T
绘制的点），而不是：某些分布的密度函数曲线的数据点。请注意，当我使用估计的
shape
和
scale
参数从估计的
T
绘制点，然后绘制该点的密度（这不是我的问题），我最终得到的密度类似于，其中x轴值不正确。你是什么意思：“某些分布密度函数曲线的数据点”？在你的问题中，你说你认为它是威布尔分布。pdf是用于带有估计参数的威布尔分布。如果你想将其与图表进行比较，你需要将其与hist（样本）进行比较。您上面的图表看起来不像pdf。Hi@TinaW，我恳请您参考我刚刚添加到我的问题中的更新。是什么让您认为这是威布尔分布的？我认为只有尾部是。Hi@Mike Wise，感谢您的兴趣和这个完整的示例！正如您所看到的，用这种方式很难拟合曲线-在我看来，曲线fiTET不适合，因为它不是“弯曲”“够了。我相信它应该更像是蓝色卷云，不是吗？哇，我刚刚意识到我认为只有尾巴是威布尔可能是一个非常好的点！非常感谢。我将在几天内进一步研究它和您的解决方案。我还有一些想法，可能会在明天或今晚尝试。尝试同时拟合两个Weibull来处理前两点，但无法收敛。您可以通过稍微更改x和y刻度来获得其他良好拟合。了解更多关于时间尺度（起源等）的信息会有所帮助。如果这是我的项目，我可能会对这些拟合进行引导，以获得参数边界和分布。我用直方图更新了我的答案。你知道密度曲线的第一部分结束和尾部开始的确切值吗？您的示例以值22结束：我可以假设尾部从23开始吗？恐怕我不明白（我不知道这里可以使用“分布尾部”的正式定义）。我的最终目标是计算变量的期望值，它是分布的
T
。也许假设第一部分（上面直方图中1到2点之间的部分）是线性的，而第二部分是威布尔（威布尔是一个假设，我是从提供数据的人那里得到的。我不会为此打赌，但我倾向于这样假设。）你说：“在我的原始问题中，我知道密度曲线第一部分的点。”你说的“第一部分”到底是什么意思？“第一部分”在什么值停止？你还说：“我不知道它的尾巴，我想估计尾巴（和整个密度函数）”。为此，你需要（一个标准）选择尾部开始的位置。我想我已经回答了。我的解决方案在哪方面不是您想要的？它在我运行代码之后才起作用。不知道为什么。错误消息是：k我得到错误消息：错误为。双精度（w）：无法将类型“closure”强制为类型为“double”的向量Hi@user1965813，谢谢您的回答！我能够复制您的代码。我还复制了示例的代码，删除了第一个元素（在讨论中，有一种观点认为第一个点不“适合”其余部分，我倾向于这种想法），然后我比较了的形状，似乎Mike的解决方案在这种情况下给出了更合适的结果。不过，非常感谢您分享这种方法！
f<-fitdistr(sample, 'weibull')
z<-rweibull(10000, shape= f$estimate[1],scale= f$estimate[2])
hist(z)

f<-fitdistr(sample, 'exponential')
z = rexp(10000, f$estimate[1]) 
hist(z)

library(optimx)
sample <- c(60953,7787,3056,2359,1759,1819,1189,1077,1080,985,622,648,518,
            611,1037,727,489,432,371,1125,69,595,624)
t.sample <- 0:22

s.fit <- sample[3:23]
t.fit <- t.sample[3:23]

wx <- function(param) { 
  res <- param[2]*dweibull(t.fit*param[3],shape=param[1])
  return(res)
} 
minwx <- function(param){
  v <- s.fit-wx(param)
  sqrt(sum(v*v))
}

p0 <- c(1,200,1/20)
paramopt <- optim(p0,minwx,gr=NULL,lower=c(0.1,100,0.01),upper=c(1.1,5000,1))

popt <- paramopt$par
popt
rms <- paramopt$value
tit <- sprintf("Weibull - Shape:%.3f xscale:%.1f  yscale:%.5f rms:%.1f",popt[1],popt[2],popt[3],rms)

plot(t.sample[2:23], sample[2:23], type = "p",col="darkred")
lines(t.fit, wx(popt),col="blue")
title(main=tit)

# Defining the error of the implicit function
k.diff <- function(k, vec){
  x2 <- seq(length(vec))
  abs(k^-1+weighted.mean(log(x2), w = sample)-weighted.mean(log(x2), 
                                                            w = x2^k*sample))
}

# Setting the error to "quite zero", fulfilling the equation
k <- optimize(k.diff, vec=sample, interval=c(0.1,5), tol=10^-7)$min

# Calculate lambda, given k
l <- weighted.mean(seq(length(sample))^k, w = sample)

# Plot
plot(density(rep(seq(length(sample)),sample)))
x <- 1:25
lines(x, dweibull(x, shape=k, scale= l))