Add Credibility Factors

Add credibility factors for an expstudy's expecteds metric variable. The credibility calculation uses a classical credibility approach also known as limited fluctuation partial credibility. Under this approach, the credibility factor is calculated so that actuals are within \(k\)\ of expecteds with probability \(p\).

Credibility range parameter \(k\) and probability level \(p\) are set using the function arguments .cred_k and .cred_p, respectively.

Usage

add_credibility(
  expstudy,
  .cred_k = 0.05,
  .cred_p = 0.95,
  .cred_nms = "CREDIBILITY"
)

Arguments

expstudy

an expstudy

.cred_k

number within range (0, 1); range parameter of credibility equation

.cred_p

number within range (0, 1); probability parameter of credibility equation

.cred_nms

character vector of column names for the added credibility column. If more than one credibility column will be created, you can distinguish them here.

Value

An expstudy with added credibility factors.

Examples

  es <- expstudy(
    data = mortexp,
    actuals = ACTUAL_DEATHS,
    expecteds = EXPECTED_DEATHS,
    exposures =  EXPOSURE,
    variances = VARIANCE_DEATHS
  )

   es %>%
     aggregate(ATTAINED_AGE) %>%
     add_credibility
#> Source: local data table [83 x 6]
#> Call:   `_DT1`[, .(ACTUAL_DEATHS = sum(ACTUAL_DEATHS), EXPECTED_DEATHS = sum(EXPECTED_DEATHS), 
#>     EXPOSURE = sum(EXPOSURE), VARIANCE_DEATHS = sum(VARIANCE_DEATHS)), 
#>     keyby = .(ATTAINED_AGE)][, `:=`(CREDIBILITY = pmin(1, 0.05 * 
#>     EXPECTED_DEATHS/sqrt(1.95996398454005 * VARIANCE_DEATHS)))]
#> 
#>   ATTAINED_AGE ACTUAL_DEATHS EXPECTED_DEATHS EXPOSURE VARIANCE_DEATHS
#>          <dbl>         <dbl>           <dbl>    <dbl>           <dbl>
#> 1           19             0           0.214     21.7           0.214
#> 2           20             0           0.565     56.5           0.565
#> 3           21             0           0.662     65.5           0.661
#> 4           22             0           0.713     69.9           0.712
#> 5           23             0           0.828     80.3           0.827
#> 6           24             0           0.884     84.9           0.884
#> # ℹ 77 more rows
#> # ℹ 1 more variable: CREDIBILITY <dbl>
#> 
#> # Use as.data.table()/as.data.frame()/as_tibble() to access results

   es %>%
     aggregate(
       UNDERWRITING_CLASS,
       GENDER,
       SMOKING_STATUS
     ) %>%
     add_credibility
#> Source: local data table [12 x 8]
#> Call:   `_DT1`[, .(ACTUAL_DEATHS = sum(ACTUAL_DEATHS), EXPECTED_DEATHS = sum(EXPECTED_DEATHS), 
#>     EXPOSURE = sum(EXPOSURE), VARIANCE_DEATHS = sum(VARIANCE_DEATHS)), 
#>     keyby = .(UNDERWRITING_CLASS, GENDER, SMOKING_STATUS)][, 
#>     `:=`(CREDIBILITY = pmin(1, 0.05 * EXPECTED_DEATHS/sqrt(1.95996398454005 * 
#>         VARIANCE_DEATHS)))]
#> 
#>   UNDERWRITING_CLASS GENDER SMOKING_STATUS ACTUAL_DEATHS EXPECTED_DEATHS
#>   <fct>              <fct>  <fct>                  <dbl>           <dbl>
#> 1 PREFERRED          FEMALE NON-SMOKER                 9            7.74
#> 2 PREFERRED          FEMALE SMOKER                     3            2.86
#> 3 PREFERRED          MALE   NON-SMOKER                17           10.7 
#> 4 PREFERRED          MALE   SMOKER                     7            4.48
#> 5 SELECT             FEMALE NON-SMOKER                22           20.7 
#> 6 SELECT             FEMALE SMOKER                     8            7.68
#> # ℹ 6 more rows
#> # ℹ 3 more variables: EXPOSURE <dbl>, VARIANCE_DEATHS <dbl>, CREDIBILITY <dbl>
#> 
#> # Use as.data.table()/as.data.frame()/as_tibble() to access results