【问题标题】:Maximum Likelihood Estimation for three-parameter Weibull distribution in rr 中三参数 Weibull 分布的最大似然估计
【发布时间】:2016-07-30 17:03:25
【问题描述】:

我想估计 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 

这对于形状参数大于 1 的情况非常有效。不幸的是,我的方法应该处理形状参数可能小于 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 估计的问题。

最好的问候, 蒂姆

【问题讨论】:

    标签: r weibull mle


    【解决方案1】:

    设置受约束的 MLE 并不难。我将在bbmle::mle2 中执行此操作;您也可以在 stats4::mle 中执行此操作,但 bbmle 有一些附加功能。

    更大的问题是,当估计值位于允许空间的边界时,理论上很难定义估计值的抽样方差; Wald 方差估计背后的理论崩溃了。您仍然可以通过可能性分析来计算置信区间......或者您可以引导。我在做这个的时候遇到了各种各样的优化问题......我还没有真正考虑过是否有具体的原因

    重新格式化三参数 Weibull 函数以供 mle2 使用(以 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)
    

    拟合模型:为了方便和稳定,我在对数尺度上拟合参数,但您也可以使用零边界。

    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
    

    这是 log-scaled 变量的方差-协方差矩阵。如果要转换为原始尺度上的方差-协方差矩阵,则需要按 (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 - 上面的方差估计会非常小心。 (可能太接近边界而无法进行理查森外推?)

    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 获取一些提示。

    【讨论】:

    • 感谢您的帮助。我已经了解如何使用受约束的 MLE 解决 3p weibull 案例中阈值参数的最大化问题。获取参数的置信区间也非常有帮助。不幸的是,我需要估计的方差-协方差矩阵,因为我还想为 3p weibull 构建“Fisher 矩阵置信界限”[reliawiki.org/index.php/…。 mle2 是否有机会处理审查数据?
    • 你真的帮了我很多。我试图计算正常尺度的方差-协方差矩阵(这是我正在寻找的)来计算可靠性和时间的 Fisher-Matrix-Confidence-Bounds,这在上面的链接中进行了描述。我所期望的是,计算的 var-cov-matrix(从对数刻度 var-cov-matrix 转换)应该接近我的问题中的 var-cov-matrix,因为对于这个特定的参数选择,过程与“fitdistr”包有效。不幸的是,事实并非如此。一项突出的任务是对审查数据做同样的事情。
    • 我不得不提一下,即使设置了阈值的约束,ml 优化方法 bbmle::mle2 也不适用于低于 1 的形状参数。 set.seed(1) dat &lt;- data.frame(x = rweibull(1000, .53, 365) + 100) tmin &lt;- log(0.99 * min(dat$x)) m1 &lt;- 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") optim 中的错误(par = ... L-BFGS-B 需要 'fn' 的有限值
    【解决方案2】:

    另一种可能的解决方案是进行贝叶斯推理。使用形状和比例参数的比例先验以及位置参数的统一先验,您可以轻松地运行 Metropolis-Hastings,如下所示。建议根据 log(shape)、log(scale) 和 log(y_min - location) 重新参数化,因为某些参数的后验变得严重偏斜,特别是对于 location 参数。请注意,下面的输出显示了反向转换参数的后验。

    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
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2021-11-01
      • 1970-01-01
      • 2011-08-26
      • 2023-03-07
      • 2019-02-24
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多