R-Squared-Profile Function for Parametric Lifetime Distributions with Threshold

This function evaluates the coefficient of determination with respect to a given threshold parameter of a parametric lifetime distribution. In terms of Rank Regression this function can be optimized (optim) to estimate the threshold parameter.

# S3 method for default
r_squared_profiling(
  x,
  y,
  thres,
  distribution = c("weibull3", "lognormal3", "loglogistic3", "exponential2"),
  direction = c("x_on_y", "y_on_x"),
  ...
)

Arguments

x

A numeric vector which consists of lifetime data. Lifetime data could be every characteristic influencing the reliability of a product, e.g. operating time (days/months in service), mileage (km, miles), load cycles.

y

A numeric vector which consists of estimated failure probabilities regarding the lifetime data in x.

thres

A numeric value for the threshold parameter.

distribution

Supposed parametric distribution of the random variable.

direction

Direction of the dependence in the regression model.

...

Further arguments passed to or from other methods. Currently not used.

Value

Returns the coefficient of determination with respect to the threshold parameter thres.

See also

r_squared_profiling

Examples

# Vectors:
cycles <- alloy$cycles
status <- alloy$status

# Probability estimation:
prob_tbl <- estimate_cdf(
  x = cycles,
  status = status,
  method = "johnson"
)

# Determining the optimal coefficient of determination:
## Range of threshold parameter must be smaller than the first failure:
threshold <- seq(
  0,
  min(cycles[status == 1]) - 0.1,
  length.out = 100
)

## Coefficient of determination with respect to threshold values:
profile_r2 <- r_squared_profiling(
  x = prob_tbl$x[prob_tbl$status == 1],
  y = prob_tbl$prob[prob_tbl$status == 1],
  thres = threshold,
  distribution = "weibull3"
)

## Threshold value (among the candidates) that maximizes the
## coefficient of determination:
threshold[which.max(profile_r2)]
#> [1] 88.20909

## plot:
plot(
  threshold,
  profile_r2,
  type = "l"
)
abline(
  v = threshold[which.max(profile_r2)],
  h = max(profile_r2),
  col = "red"
)