Credible interval for median of Weibull distribution

Alternative proposed by Varin Sacha using the package weibulltools with delta method (a little bit modified to present only the median and the CI):

library(weibulltools)

x <- rweibull(100000, 2, 2)

data <- reliability_data(x = x, status = 1) 

ml <- ml_estimation(x = data, distribution = "weibull")

conf <- confint_fisher(x = ml, b_lives = 0.5, direction = "x") 

The results are:

> as.numeric(conf[conf$prob == 0.5, c(4, 1, 5)])
[1] 1.657227 1.663275 1.669346

The true median was :

> 2*log(2)^(1/2)
[1] 1.665109

Let try if the average estimate by Fisher method for 1,000 samples is biased or not:

library(weibulltools)
library(pbmcapply)
k <- pbmclapply(1:1000, FUN=function(i) {
x <- rweibull(100000, 2, 2)

data <- reliability_data(x = x, status = 1) 

ml <- ml_estimation(x = data, distribution = "weibull")

conf <- confint_fisher(x = ml, b_lives = 0.5, direction = "x") 
return(as.numeric(conf[conf$prob == 0.5, 1]))
}, mc.cores = 8)

> mean(unlist(k))
[1] 1.66507

It seems to be ok. No bias.

Distribution of median of Weibull using Bayesian MCMC

Marc Girondot

15 février 2022

Download & install packages

if(!require("HelpersMG")){
  
# This first install install the dependencies
  install.packages(
"HelpersMG")
  
# This second install update the package to its last version
  install.packages(
"http://max2.ese.u-psud.fr/epc/conservation/CRAN/HelpersMG.tar.gz"repos=NULLtype="source")
  suppressPackageStartupMessages(require(
"HelpersMG"))
}

library(HelpersMG)

Generate data

<- rweibull(100000,2,2

Plot observations

hist(x)



The likelihood function of Weibull distribution

lnW <- function(par, data) {
  L 
<- -sum(dweibull(x=data, shape=par["shape"], scale = par["scale"], log = TRUE))
  return(L)
}

Fit distribution of scale and shape using MCMC

par <- c(shape=2scale=2)
priors 
<- data.frame(Density=rep("dunif"length(par)), 
                   
Prior1=c(00), 
                   
Prior2=c(55), 
                   
SDProp=c(0.0010.001),            
                   
Min=c(00), 
                   
Max=c(55),
                   
Init=par, stringsAsFactors = FALSE)
  rownames(priors)
<- names(par)
  
  out_MCMC 
<- MHalgoGen(likelihood = lnW, parameters=priors, 
                        
data=x, parameters_name = "par"trace=100
                        
n.adapt = 10n.iter = 10000thin=20
                        
adaptive = TRUE)

## Chain 1: [1] -128801.497439969
## Chain 1: [10001] -128801.910532539
## -128801.178434339: Best likelihood for: 
## c('shape' = 1.9995471453286606, 
##   'scale' = 1.997342902775386)

Distribution of posteriors scale and shape

plot(out_MCMC, parameters="scale")



plot(out_MCMC, parameters="shape")



Posterior predictive median

median_posterior <- apply(out_MCMC$resultMCMC[[1]], MARGIN = 1function(r) r["scale"]*log(2)^(1/r["shape"]))

quantile(median_posterior, 
probs=c(0.0250.50.975))

##     2.5%      50%    97.5% 
## 1.656699 1.663038 1.668994

Commentaires

Posts les plus consultés de ce blog

Standard error from Hessian Matrix... what can be done when problem occurs

stepAIC from package MASS with AICc

Install treemix in ubuntu 20.04