RecalibratingEPIC.Rmd
library(epicR)
Assessing calibration of exacerbations with previous EPIC’s (v0.31.3) equations:
inputs <- get_input()$values
inputs$exacerbation$ln_rate_betas = t(as.matrix(c(intercept = -3.4, female = 0, age = 0.04082 * 0.1, fev1 = -0, smoking_status = 0, gold1 = 1.4 , gold2 = 2.0 , gold3 = 2.4 , gold4 = 2.8 , diagnosis_effect = 0.9)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.23
#> exacRateGOLDII = 0.39
#> exacRateGOLDIII = 0.51
#> exacRateGOLDIV = 0.63
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.34
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 304.28
#> Rate in 2017: 228.18
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 0.4
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.26
This equation for exacerbations included a term for diagnosis. As a result, whether a person was diagnosed or not would affect the exacerbation rates, which does not have causal face validity, and is particularly undesirable for case detection studies that assess diagnosis.
If we remove the diagnosis term and go back to the previous calibration, it will look like this:
inputs$exacerbation$ln_rate_betas <- t(as.matrix(c(intercept = 1.7, female = 0, age = 0.04082 * 0.1, fev1 = -1.5, smoking_status = 0, gold1 = 0.6 , gold2 = 0.35 , gold3 = 0.08 , gold4 = -0.35 , diagnosis_effect = 0)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.49
#> exacRateGOLDII = 0.86
#> exacRateGOLDIII = 1.38
#> exacRateGOLDIV = 1.74
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.78
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 745.91
#> Rate in 2017: 697.43
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 1.14
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.5
The following recalibrations were assesses and Recalibration 5 was
implemented in epicR v0.35.0
Let’s try to improve that by lowering GOLD coefficients:
inputs$exacerbation$ln_rate_betas <- t(as.matrix(c(intercept = 1.7, female = 0, age = 0.04082 * 0.1, fev1 = -1.5, smoking_status = 0, gold1 = 0.3 , gold2 = 0.1 , gold3 = 0.08 , gold4 = -0.35 , diagnosis_effect = 0)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.38
#> exacRateGOLDII = 0.69
#> exacRateGOLDIII = 1.38
#> exacRateGOLDIV = 1.55
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.65
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 632.86
#> Rate in 2017: 492.29
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 0.95
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.39
We can now lower GOLD2 coefficient even more and perhaps increase smoking coefficient to compensate for the loss in the diagnosed patients.
inputs$exacerbation$ln_rate_betas <- t(as.matrix(c(intercept = 1.7, female = 0, age = 0.04082 * 0.1, fev1 = -1.5, smoking_status = 0.5, gold1 = 0.3 , gold2 = 0.05 , gold3 = 0.08 , gold4 = -0.35 , diagnosis_effect = 0)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.39
#> exacRateGOLDII = 0.69
#> exacRateGOLDIII = 1.55
#> exacRateGOLDIV = 1.89
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.68
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 656.88
#> Rate in 2017: 637.18
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 1
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.39
Let’s lower GOLD2 dramatically:
inputs$exacerbation$ln_rate_betas <- t(as.matrix(c(intercept = 1.7, female = 0, age = 0.04082 * 0.1, fev1 = -1.5, smoking_status = 0.5, gold1 = 0.3 , gold2 = -0.5 , gold3 = 0.08 , gold4 = -0.35 , diagnosis_effect = 0)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.42
#> exacRateGOLDII = 0.43
#> exacRateGOLDIII = 1.59
#> exacRateGOLDIV = 1.9
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.58
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 586.28
#> Rate in 2017: 443.58
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 0.86
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.31
Bring GOLD2 up a bit:
inputs$exacerbation$ln_rate_betas <- t(as.matrix(c(intercept = 1.7, female = 0, age = 0.04082 * 0.1, fev1 = -1.5, smoking_status = 0.5, gold1 = 0.3 , gold2 = -0.2 , gold3 = 0.08 , gold4 = -0.35 , diagnosis_effect = 0)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.4
#> exacRateGOLDII = 0.57
#> exacRateGOLDIII = 1.56
#> exacRateGOLDIV = 1.8
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.63
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 618.27
#> Rate in 2017: 575.88
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 0.93
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.36
GOLD2 back a bit again.
inputs$exacerbation$ln_rate_betas <- t(as.matrix(c(intercept = 1.7, female = 0, age = 0.04082 * 0.1, fev1 = -1.5, smoking_status = 0.5, gold1 = 0.3 , gold2 = -0.3 , gold3 = 0.08 , gold4 = -0.35 , diagnosis_effect = 0)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.4
#> exacRateGOLDII = 0.52
#> exacRateGOLDIII = 1.56
#> exacRateGOLDIV = 1.87
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.6
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 589.18
#> Rate in 2017: 536.88
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 0.9
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.34
Reducing intercept and adding to the smoking term.
inputs$exacerbation$ln_rate_betas <- t(as.matrix(c(intercept = 1.4, female = 0, age = 0.04082 * 0.1, fev1 = -1.5, smoking_status = 0.7, gold1 = 0.3 , gold2 = -0.3 , gold3 = 0.08 , gold4 = -0.35 , diagnosis_effect = 0)))
validate_exacerbation(5e4, inputs)
#> Initializing the session
#> Terminating the session
#> Exacerbation Rates per GOLD stages for all patients:
#> exacRateGOLDI = 0.31
#> exacRateGOLDII = 0.41
#> exacRateGOLDIII = 1.24
#> exacRateGOLDIV = 1.47
#> Total rate of exacerbation in all patients (0.39 per year in CanCOLD): 0.48
#> Is the rate of severe and very severe exacerbations around 477 per CIHI?
#> Average rate during 20 years: 505.81
#> Rate in 2017: 384.26
#> Total rate of exacerbation in diagnosed patients (1.5 per year in Hoogendoorn): 0.73
#> Total rate of exacerbation in undiagnosed patients (0.30 per year in CanCOLD): 0.27