Skip to content

Commit

Permalink
Merge pull request #106 from KateJohnson/master
Browse files Browse the repository at this point in the history 
Changes to case detection components
  • Loading branch information
@KateJohnson
KateJohnson authored Oct 16, 2019
2 parents 194ea8d + 65a9d6c commit 20ab03e
Show file tree
Hide file tree
Showing 2 changed files with 69 additions and 46 deletions.
50 changes: 31 additions & 19 deletions R/input.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ init_input <- function() {
input_ref$agent$height_0_sd <- ""


input_help$agent$weight_0_betas <- "Regressoin coefficients for estimating weiight (in Kg) at baseline"
input_help$agent$weight_0_betas <- "Regression coefficients for estimating weiight (in Kg) at baseline"
input$agent$weight_0_betas <- t(as.matrix(c(intercept = 50, sex = -5, age = 0.1, age2 = 0, sex_age = 0, height = 1, year = 0.01)))
input_ref$agent$weight_0_betas <- ""

Expand Down Expand Up @@ -411,7 +411,7 @@ init_input <- function() {
input_ref$outpatient$ln_rate_gpvisits_nonCOPD_by_sex <- "Kate's regression on CanCOLD, provided on 2019-05-29"
input$outpatient$dispersion_gpvisits_nonCOPD <- 0.4093

# Extras
# Extras - DISABLED
input$outpatient$rate_doctor_visit <- 0.1
input$outpatient$p_specialist <- 0.1

Expand All @@ -434,17 +434,29 @@ init_input <- function() {
input$diagnosis$min_cd_pack_years <- 0
input_ref$diagnosis$min_cd_pack_years <- ""

input_help$diagnosis$min_cd_smokers <- "Set to 1 if only current smokers should recieve case detection"
input$diagnosis$min_cd_smokers <- 0
input_ref$diagnosis$min_cd_smokers <- ""
input_help$diagnosis$min_cd_symptoms <- "Set to 1 if only patients with symptoms should recieve case detection at baseline"
input$diagnosis$min_cd_symptoms <- 0
input_ref$diagnosis$min_cd_symptoms <- ""

input_help$diagnosis$case_detection_methods <- "Sensitivity and specificity of possible case detection methods"
input$diagnosis$case_detection_methods <- cbind(None=c(0, 0),
CDQ195= c(2.3848, 3.7262),
CDQ165= c(3.7336, 4.8098),
FlowMeter= c(3.1677, 2.6657),
FlowMeter_CDQ= c(2.8545, 0.8779))
input_ref$diagnosis$case_detection_methods <- "Haroon et al. BMJ Open 2015"
input_help$diagnosis$case_detection_methods <- "Sensitivity, specificity, and cost of case detection methods in the total population"
input$diagnosis$case_detection_methods <- cbind(None=c(0, 0, 0),
CDQ17= c(4.1013, 4.394, 73.03),
FlowMeter= c(3.174, 1.6025, 91.19),
FlowMeter_CDQ= c(2.7321, 0.8779, 91.19))
input_ref$diagnosis$case_detection_methods_eversmokers <- "Sichletidis et al 2011"

input_help$diagnosis$case_detection_methods_eversmokers <- "Sensitivity, specificity, and cost of case detection methods among ever smokers"
input$diagnosis$case_detection_methods_eversmokers <- cbind(None=c(0, 0, 0),
CDQ195= c(2.3848, 3.7262, 73.03),
CDQ165= c(3.7336, 4.8098, 73.03),
FlowMeter= c(3.1677, 2.6657, 85.30),
FlowMeter_CDQ= c(2.8545, 0.8779, 91.19))
input_ref$diagnosis$case_detection_methods_eversmokers <- "Haroon et al. BMJ Open 2015"

input_help$diagnosis$case_detection_methods_symptomatic <- "Sensitivity, specificity, and cost of case detection methods among ever smokers"
input$diagnosis$case_detection_methods_symptomatic <- cbind(None=c(0, 0, 0),
FlowMeter= c(3.2705, 2.2735, 85.30))
input_ref$diagnosis$case_detection_methods_symptomatic <- "CanCOLD analysed on Sept 9, 2019"


## Diagnosis;
Expand Down Expand Up @@ -487,10 +499,10 @@ init_input <- function() {

# adherence to medication
input_help$medication$medication_adherence <- "Proportion adherent to medication"
input$medication$medication_adherence <- 1
input$medication$medication_adherence <- 0.7
input_ref$medication$medication_adherence <- ""

# medication log-hazard regression matrix for initiation of each medication
# medication log-hazard regression matrix for rate reduction in exacerbations
input_help$medication$medication_ln_hr_exac <- "Rate reduction in exacerbations due to treatment"
input$medication$medication_ln_hr_exac<-c(None=0, SABA=0, LABA=log((1-0.20)^input$medication$medication_adherence),
SABA_LABA=log((1-0.20)^input$medication$medication_adherence),
Expand Down Expand Up @@ -534,7 +546,7 @@ init_input <- function() {
input$medication$ln_rr_exac_by_class <- rep(log(1), length(medication_classes)) #TODO: update this to represent different medication effect


### comorbidity mi
### comorbidity mi - not implemented
input$comorbidity$logit_p_mi_betas_by_sex = cbind(male = c(intercept = -3000, age = 0.001, age2 = 0, pack_years = 0.01, smoking = 0.001,
calendar_time = 0, bmi = 0, gold = 0.05), female = c(intercept = -3000, age = 0.001, age2 = 0, pack_years = 0.01, smoking = 0.001,
calendar_time = 0, bmi = 0, gold = 0.05))
Expand All @@ -544,7 +556,7 @@ init_input <- function() {
input$comorbidity$p_mi_death <- 0.05


#stroke
#stroke - not implemented
input$comorbidity$logit_p_stroke_betas_by_sex=cbind(
male=c(intercept=-3000, age=0.001, age2=0, pack_years=0.01, smoking=0.001, calendar_time=0, b_mi=0, gold=0.05, b_mi=0, n_mi=0),
female=c(intercept=-3000, age=0.001, age2=0, pack_years=0.01, smoking=0.001, calendar_time=0, bmi=0.01, gold=0.05, b_mi=0, n_mi=0)
Expand All @@ -556,7 +568,7 @@ init_input <- function() {
input$comorbidity$p_stroke_death<-0.18;


#hf
#hf - not implemented
input$comorbidity$logit_p_hf_betas_by_sex=cbind(
male=c(intercept=-3000, age=0.001, age2=0, pack_years=0.01, smoking=0.001, calendar_time=0, bmi=0.01, gold=0.05, b_mi=0, n_mi=0.01, b_stroke=0, n_stroke=0),
female=c(intercept=-3000, age=0.001, age2=0, pack_years=0.01, smoking=0.001, calendar_time=0, bmi=0.01, gold=0.05, b_mi=0, n_mi=0.01, b_stroke=0, n_stroke=0)
Expand All @@ -575,10 +587,10 @@ init_input <- function() {
input$cost$exac_dcost=t(as.matrix(c(mild=29,moderate=726,severe=9212, verysevere=20170)))
input_help$cost$exac_dcost="Incremental direct costs of exacerbations by severity levels"

input$cost$cost_case_detection <- 18.9
input$cost$cost_case_detection <- input$diagnosis$case_detection_methods[3,"None"]
input_help$cost$cost_case_detection <- "Cost of case detection"

input$cost$cost_outpatient_diagnosis <- 26.91
input$cost$cost_outpatient_diagnosis <- 98.89
input_help$cost$cost_outpatient_diagnosis <- "Cost of diagnostic spirometry"

#input$cost$doctor_visit_by_type<-t(as.matrix(c(50,150)))
Expand Down
65 changes: 38 additions & 27 deletions src/model.WIP.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -581,8 +581,10 @@ struct input
int years_btw_case_detection;
double min_cd_age;
double min_cd_pack_years;
int min_cd_smokers;
double case_detection_methods[2][5];
int min_cd_symptoms;
double case_detection_methods[3][4];
double case_detection_methods_eversmokers[3][5];
double case_detection_methods_symptomatic[3][2];
} diagnosis;

struct
Expand Down Expand Up @@ -761,8 +763,10 @@ List Cget_inputs()
Rcpp::Named("years_btw_case_detection")=input.diagnosis.years_btw_case_detection,
Rcpp::Named("min_cd_age")=input.diagnosis.min_cd_age,
Rcpp::Named("min_cd_pack_years")=input.diagnosis.min_cd_pack_years,
Rcpp::Named("min_cd_smokers")=input.diagnosis.min_cd_smokers,
Rcpp::Named("case_detection_methods")=AS_MATRIX_DOUBLE(input.diagnosis.case_detection_methods)
Rcpp::Named("min_cd_symptoms")=input.diagnosis.min_cd_symptoms,
Rcpp::Named("case_detection_methods")=AS_MATRIX_DOUBLE(input.diagnosis.case_detection_methods),
Rcpp::Named("case_detection_methods_eversmokers")=AS_MATRIX_DOUBLE(input.diagnosis.case_detection_methods_eversmokers),
Rcpp::Named("case_detection_methods_symptomatic")=AS_MATRIX_DOUBLE(input.diagnosis.case_detection_methods_symptomatic)
),

Rcpp::Named("comorbidity")=Rcpp::List::create(
Expand Down Expand Up @@ -895,8 +899,10 @@ int Cset_input_var(std::string name, NumericVector value)
if(name=="diagnosis$years_btw_case_detection") {input.diagnosis.years_btw_case_detection=value[0]; return(0);};
if(name=="diagnosis$min_cd_age") {input.diagnosis.min_cd_age=value[0]; return(0);};
if(name=="diagnosis$min_cd_pack_years") {input.diagnosis.min_cd_pack_years=value[0]; return(0);};
if(name=="diagnosis$min_cd_smokers") {input.diagnosis.min_cd_smokers=value[0]; return(0);};
if(name=="diagnosis$min_cd_symptoms") {input.diagnosis.min_cd_symptoms=value[0]; return(0);};
if(name=="diagnosis$case_detection_methods") READ_R_MATRIX(value,input.diagnosis.case_detection_methods);
if(name=="diagnosis$case_detection_methods_eversmokers") READ_R_MATRIX(value,input.diagnosis.case_detection_methods_eversmokers);
if(name=="diagnosis$case_detection_methods_symptomatic") READ_R_MATRIX(value,input.diagnosis.case_detection_methods_symptomatic);

if(name=="symptoms$covariance_COPD") READ_R_MATRIX(value, input.symptoms.covariance_COPD);
if(name=="symptoms$covariance_nonCOPD") READ_R_MATRIX(value, input.symptoms.covariance_nonCOPD);
Expand Down Expand Up @@ -1052,7 +1058,7 @@ struct agent
int years_btw_case_detection;
double min_cd_age;
double min_cd_pack_years;
int min_cd_smokers;
int min_cd_symptoms;

double re_cough; //random effects for symptoms
double re_phlegm;
Expand Down Expand Up @@ -1853,31 +1859,34 @@ double apply_case_detection(agent *ag)

if ((((*ag).age_at_creation+(*ag).local_time) >= input.diagnosis.min_cd_age) &&
((*ag).pack_years >= input.diagnosis.min_cd_pack_years) &&
((*ag).smoking_status>= input.diagnosis.min_cd_smokers) &&
((*ag).gpvisits!=0) &&
((*ag).diagnosis==0)) {

if ((*ag).last_case_detection == 0)
{
if(((*ag).cough+(*ag).phlegm+(*ag).wheeze+(*ag).dyspnea) >= input.diagnosis.min_cd_symptoms)
{
p_detection = input.diagnosis.p_case_detection;
}
}

else if (((*ag).local_time - (*ag).last_case_detection) >= input.diagnosis.years_btw_case_detection)
{
p_detection = 1;
p_detection = input.diagnosis.p_case_detection;
}

if (rand_unif() < p_detection) {

(*ag).case_detection = 1;
(*ag).cumul_cost+=input.cost.cost_case_detection/pow(1+input.global_parameters.discount_cost,(*ag).local_time+calendar_time);
(*ag).last_case_detection = (*ag).local_time;
(*ag).cumul_cost+=input.cost.cost_case_detection/pow(1+input.global_parameters.discount_cost,(*ag).local_time+calendar_time);

} else {

(*ag).case_detection = 0;
}
}
}
}

return(0);
}

Expand Down Expand Up @@ -2675,8 +2684,8 @@ DataFrame Cget_all_events() //Returns all events from all agents;
// [[Rcpp::export]]
NumericMatrix Cget_all_events_matrix()
{
NumericMatrix outm(event_stack_pointer,31);
CharacterVector eventMatrixColNames(31);
NumericMatrix outm(event_stack_pointer,30);
CharacterVector eventMatrixColNames(30);

// eventMatrixColNames = CharacterVector::create("id", "local_time","sex", "time_at_creation", "age_at_creation", "pack_years","gold","event","FEV1","FEV1_slope", "FEV1_slope_t","pred_FEV1","smoking_status", "localtime_at_COPD", "age_at_COPD", "weight_at_COPD", "height","followup_after_COPD", "FEV1_baseline");
// 'create' helper function is limited to 20 enteries
Expand Down Expand Up @@ -2707,11 +2716,10 @@ NumericMatrix Cget_all_events_matrix()
eventMatrixColNames(23) = "dyspnea";
eventMatrixColNames(24) = "gpvisits";
eventMatrixColNames(25) = "diagnosis";
eventMatrixColNames(26) = "time_at_diagnosis";
eventMatrixColNames(27) = "medication_status";
eventMatrixColNames(28) = "case_detection";
eventMatrixColNames(29) = "cumul_cost";
eventMatrixColNames(30) = "cumul_qaly";
eventMatrixColNames(26) = "medication_status";
eventMatrixColNames(27) = "case_detection";
eventMatrixColNames(28) = "cumul_cost";
eventMatrixColNames(29) = "cumul_qaly";


colnames(outm) = eventMatrixColNames;
Expand Down Expand Up @@ -2744,11 +2752,10 @@ NumericMatrix Cget_all_events_matrix()
outm(i,23)=(*ag).dyspnea;
outm(i,24)=(*ag).gpvisits;
outm(i,25)=(*ag).diagnosis;
outm(i,26)=(*ag).time_at_diagnosis;
outm(i,27)=(*ag).medication_status;
outm(i,28)=(*ag).case_detection;
outm(i,29)=(*ag).cumul_cost;
outm(i,30)=(*ag).cumul_qaly;
outm(i,26)=(*ag).medication_status;
outm(i,27)=(*ag).case_detection;
outm(i,28)=(*ag).cumul_cost;
outm(i,29)=(*ag).cumul_qaly;
}

return(outm);
Expand Down Expand Up @@ -3463,16 +3470,20 @@ agent *event_fixed_process(agent *ag)
(*ag).weight+=input.agent.weight_0_betas[6];
(*ag).weight_LPT=(*ag).local_time;

lung_function_LPT(ag);

smoking_LPT(ag);
exacerbation_LPT(ag);
payoffs_LPT(ag);
medication_LPT(ag);

update_symptoms(ag); //updating in the annual event
update_gpvisits(ag);
update_diagnosis(ag);

lung_function_LPT(ag);
exacerbation_LPT(ag);
payoffs_LPT(ag);
medication_LPT(ag);



#ifdef OUTPUT_EX
update_output_ex(ag);
#endif
Expand Down

0 comments on commit 20ab03e

Please sign in to comment.