我想估计3p Weibull分布的尺度,形状和阈值参数。
到目前为止我所做的是以下内容:
参阅这篇文章Fitting a 3 parameter Weibull distribution in R
我已经使用了这些功能
EPS = sqrt(.Machine$double.eps) # "epsilon" for very small numbers
llik.weibull <- function(shape, scale, thres, x)
{
sum(dweibull(x - thres, shape, scale, log=T))
}
thetahat.weibull <- function(x)
{
if(any(x <= 0)) stop("x values must be positive")
toptim <- function(theta) -llik.weibull(theta[1], theta[2], theta[3], x)
mu = mean(log(x))
sigma2 = var(log(x))
shape.guess = 1.2 / sqrt(sigma2)
scale.guess = exp(mu + (0.572 / shape.guess))
thres.guess = 1
res = nlminb(c(shape.guess, scale.guess, thres.guess), toptim, lower=EPS)
c(shape=res$par[1], scale=res$par[2], thres=res$par[3])
}
以“预估”我的Weibull参数,这样我就可以将它们用作MASS-Package的“fitdistr”函数中参数“start”的初始值。
您可能会问我为什么要两次估计参数...原因是我需要估计的方差 - 协方差矩阵,这也是由fitdistr函数估计的。
示例:
set.seed(1)
thres <- 450
dat <- rweibull(1000, 2.78, 750) + thres
pre_mle <- thetahat.weibull(dat)
my_wb <- function(x, shape, scale, thres) {
dweibull(x - thres, shape, scale)
}
ml <- fitdistr(dat, densfun = my_wb, start = list(shape = round(pre_mle[1], digits = 0), scale = round(pre_mle[2], digits = 0),
thres = round(pre_mle[3], digits = 0)))
ml
> ml
shape scale thres
2.942548 779.997177 419.996196 ( 0.152129) ( 32.194294) ( 28.729323)
> ml$vcov
shape scale thres
shape 0.02314322 4.335239 -3.836873
scale 4.33523868 1036.472551 -889.497580
thres -3.83687258 -889.497580 825.374029
对于shape参数高于1的情况,这非常有效。不幸的是,我的方法应该处理shape参数可能小于1的情况。
此处描述了小于1的形状参数无法实现此目的的原因:http://www.weibull.com/hotwire/issue148/hottopics148.htm
在案例1中,所有三个参数都是未知的,如下所述:
“将ti的最小失效时间定义为tmin。然后当γ→tmin,ln(tmin-γ)→-∞。如果β小于1,则(β-1)ln(tmin-γ)对于β,η和γ的给定解,我们总能找到另一组解(例如,使γ更接近tmin),这将给出更大的似然值。因此,没有MLE解对于β,η和γ。“
这很有道理。出于这个原因,我想按照他们在此页面上描述的方式进行操作。
“在Weibull ++中,基于梯度的算法用于找到β,η和γ的MLE解.γ范围的上限任意设置为tmin的0.99。根据数据集,要么返回局部最优值或0.99tmin作为γ的MLE解。“
我想为gamma设置一个可行的间隔(在我的代码中称为'thres'),使得解决方案介于(0,.99 * tmin)之间。
有谁知道如何解决这个问题?
在函数fitdistr中,似乎没有机会进行受约束的MLE,约束一个参数。
另一种方法可以是通过得分向量的外积估计渐近方差。得分向量可以从上面使用的函数thetahat.weibul(x)中获得。但是手动计算外部产品(没有功能)似乎非常耗时并且不能解决受约束的ML估计的问题。
祝你好运, 蒂姆
答案 0 :(得分:4)
设置受约束的MLE并不困难。我将在bbmle::mle2
中执行此操作;您也可以在stats4::mle
中执行此操作,但bbmle
还有一些其他功能。
更大的问题是,当它在允许空间的边界上时,很难定义估计的抽样方差理论 瓦尔德方差估计背后的理论破裂了。您仍然可以通过可能性分析来计算置信区间...或者您可以进行自举。这样做时我遇到了各种各样的优化问题......我还没有真正考虑过具体的原因
重新格式化mle2
使用的三参数Weibull函数(将x
作为第一个参数,将log
作为参数):
dweib3 <- function(x, shape, scale, thres, log=TRUE) {
dweibull(x - thres, shape, scale, log=log)
}
启动功能(稍微重新格式化):
weib3_start <- function(x) {
mu <- mean(log(x))
sigma2 <- var(log(x))
logshape <- log(1.2 / sqrt(sigma2))
logscale <- mu + (0.572 / logshape)
logthres <- log(0.5*min(x))
list(logshape = logshape, logsc = logscale, logthres = logthres)
}
生成数据:
set.seed(1)
dat <- data.frame(x=rweibull(1000, 2.78, 750) + 450)
拟合模型:为了方便和稳定,我在参数比例上拟合参数,但你也可以使用0的边界。
tmin <- log(0.99*min(dat$x))
library(bbmle)
m1 <- mle2(x~dweib3(exp(logshape),exp(logsc),exp(logthres)),
data=dat,
upper=c(logshape=Inf,logsc=Inf,
logthres=tmin),
start=weib3_start(dat$x),
method="L-BFGS-B")
vcov(m1)
,它通常应该提供方差 - 协方差估计(除非估计在边界上,这不是这里的情况)给出NaN
值...不确定为什么没有更多的挖掘
library(emdbook)
tmpf <- function(x,y) m1@minuslogl(logshape=x,
logsc=coef(m1)["logsc"],
logthres=y)
tmpf(1.1,6)
s1 <- curve3d(tmpf,
xlim=c(1,1.2),ylim=c(5.9,tmin),sys3d="image")
with(s1,contour(x,y,z,add=TRUE))
h <- lme4:::hessian(function(x) do.call(m1@minuslogl,as.list(x)),coef(m1))
vv <- solve(h)
diag(vv) ## [1] 0.002672240 0.001703674 0.004674833
(se <- sqrt(diag(vv))) ## standard errors
## [1] 0.05169371 0.04127558 0.06837275
cov2cor(vv)
## [,1] [,2] [,3]
## [1,] 1.0000000 0.8852090 -0.8778424
## [2,] 0.8852090 1.0000000 -0.9616941
## [3,] -0.8778424 -0.9616941 1.0000000
这是对数缩放变量的方差 - 协方差矩阵。如果要在原始比例上转换为方差 - 协方差矩阵,则需要按(x_i)*(x_j)(即通过变换exp(x)
的导数)进行缩放。
outer(exp(coef(m1)),exp(coef(m1))) * vv
## logshape logsc logthres
## logshape 0.02312803 4.332993 -3.834145
## logsc 4.33299307 1035.966372 -888.980794
## logthres -3.83414498 -888.980794 824.831463
我不知道为什么这不能与numDeriv
一起使用 - 将非常小心,其中方差估计值高于此值。 (也许Richardson外推的边界太接近了吗?)
library(numDeriv)
hessian()
grad(function(x) do.call(m1@minuslogl,as.list(x)),coef(m1)) ## looks OK
vcov(m1)
配置文件看起来不错......(我们必须提供std.err
,因为Hessian不可逆)
pp <- profile(m1,std.err=c(0.01,0.01,0.01))
par(las=1,bty="l",mfcol=c(1,3))
plot(pp,show.points=TRUE)
confint(pp)
## 2.5 % 97.5 %
## logshape 0.9899645 1.193571
## logsc 6.5933070 6.755399
## logthres 5.8508827 6.134346
或者,我们可以以原始比例执行此操作...一种可能性是使用对数缩放来拟合,然后从原始比例的那些参数开始重新编译。
wstart <- as.list(exp(unlist(weib3_start(dat$x))))
names(wstart) <- gsub("log","",names(wstart))
m2 <- mle2(x~dweib3(shape,sc,thres),
data=dat,
lower=c(shape=0.001,sc=0.001,thres=0.001),
upper=c(shape=Inf,sc=Inf,
thres=exp(tmin)),
start=wstart,
method="L-BFGS-B")
vcov(m2)
## shape sc thres
## shape 0.02312399 4.332057 -3.833264
## sc 4.33205658 1035.743511 -888.770787
## thres -3.83326390 -888.770787 824.633714
all.equal(unname(coef(m2)),unname(exp(coef(m1))),tol=1e-4)
与上述值相同。
如果我们更加小心地束缚参数,我们可以适应小的形状,但现在我们最终会达到阈值的边界,这会给方差计算带来很多问题。
set.seed(1)
dat <- data.frame(x = rweibull(1000, .53, 365) + 100)
tmin <- log(0.99 * min(dat$x))
m1 <- mle2(x ~ dweib3(exp(logshape), exp(logsc), exp(logthres)),
lower=c(logshape=-10,logscale=0,logthres=0),
upper = c(logshape = 20, logsc = 20, logthres = tmin),
data = dat,
start = weib3_start(dat$x), method = "L-BFGS-B")
对于已审查的数据,您需要将dweibull
替换为pweibull
;有关提示,请参阅Errors running Maximum Likelihood Estimation on a three parameter Weibull cdf。
答案 1 :(得分:2)
另一种可能的解决方案是进行贝叶斯推理。在形状和比例参数上使用比例先验和在位置参数上使用统一的先验,您可以轻松地按如下方式运行Metropolis-Hastings。根据对数(形状),对数(比例)和对数(y_min - 位置)进行重新参数化可能是可取的,因为某些参数的后验变得强烈倾斜,特别是对于位置参数。请注意,下面的输出显示了反转换参数的后验。
library(MCMCpack)
logposterior <- function(par,y) {
gamma <- min(y) - exp(par[3])
sum(dweibull(y-gamma,exp(par[1]),exp(par[2]),log=TRUE)) + par[3]
}
y <- rweibull(100,shape=.8,scale=10) + 1
chain0 <- MCMCmetrop1R(logposterior, rep(0,3), y=y, V=.01*diag(3))
chain <- MCMCmetrop1R(logposterior, rep(0,3), y=y, V=var(chain0))
plot(exp(chain))
summary(exp(chain))
这会产生以下输出
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
The Metropolis acceptance rate was 0.43717
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Iterations = 501:20500
Thinning interval = 1
Number of chains = 1
Sample size per chain = 20000
1. Empirical mean and standard deviation for each variable,
plus standard error of the mean:
Mean SD Naive SE Time-series SE
[1,] 0.81530 0.06767 0.0004785 0.001668
[2,] 10.59015 1.39636 0.0098738 0.034495
[3,] 0.04236 0.05642 0.0003990 0.001174
2. Quantiles for each variable:
2.5% 25% 50% 75% 97.5%
var1 0.6886083 0.768054 0.81236 0.8608 0.9498
var2 8.0756210 9.637392 10.50210 11.4631 13.5353
var3 0.0003397 0.007525 0.02221 0.0548 0.1939