## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----------------------------------------------------------------------------- library(UniLindleyApprox) # Weibull PDF, CDF, Survival (theta = c(shape, scale)) dweibull_custom <- function(x, theta) dweibull(x, shape = theta[1], scale = theta[2]) pweibull_custom <- function(x, theta) pweibull(x, shape = theta[1], scale = theta[2]) sweibull_custom <- function(x, theta) 1 - pweibull(x, shape = theta[1], scale = theta[2]) # Independent Gamma log-prior for shape and scale logprior_weibull <- function(theta) { if (theta[1] <= 0 || theta[2] <= 0) return(-Inf) dgamma(theta[1], shape = 2, rate = 1, log = TRUE) + dgamma(theta[2], shape = 2, rate = 1, log = TRUE) } # Simulated progressive Type-II data obs <- c(0.5, 1.2, 1.8, 2.5, 3.1) R <- c(2, 0, 1, 0, 2) data_prog <- list(observed = obs, removal_scheme = R, n_total = 10) fit_weibull <- lindley_fit( data = data_prog, pdf = dweibull_custom, cdf = pweibull_custom, survival = sweibull_custom, log_prior = logprior_weibull, theta0 = c(1.5, 2.0), scheme = "progressive_type2", loss = "SELF", control = lindley.control(verbose = FALSE) ) summary(fit_weibull) ## ----------------------------------------------------------------------------- dlindley_custom <- function(x, theta) { th <- theta[1] if (th <= 0 || any(x <= 0)) return(rep(0, length(x))) (th^2 / (1 + th)) * (1 + x) * exp(-th * x) } plindley_custom <- function(x, theta) { th <- theta[1] 1 - (1 + (th * x) / (1 + th)) * exp(-th * x) } slindley_custom <- function(x, theta) 1 - plindley_custom(x, theta) set.seed(123) x_lindley <- rexp(40, rate = 1.5) fit_lindley <- lindley_fit( data = x_lindley, pdf = dlindley_custom, cdf = plindley_custom, survival = slindley_custom, log_prior = function(th) dgamma(th[1], 2, 1, log = TRUE), theta0 = c(1.0), scheme = "complete", loss = "LINEX", control = lindley.control(verbose = FALSE) ) print(fit_lindley)