mrc-ide / SIMPLEGEN

Compare c4c4659 ... +20 ... 65691e3

No flags found

Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.

e.g., #unittest #integration

#production #enterprise

#frontend #backend

Learn more about Codecov Flags here.


@@ -82,6 +82,11 @@
Loading
82 82
  std::vector<double> inc_infection;
83 83
  std::vector<double> inc_acute;
84 84
  std::vector<double> inc_chronic;
85 +
  std::vector<double> detect_microscopy_acute ;
86 +
  std::vector<double> detect_microscopy_chronic ;
87 +
  std::vector<double> detect_PCR_acute;
88 +
  std::vector<double> detect_PCR_chronic;
89 +
85 90
  
86 91
  // number of active inoculations
87 92
  std::vector<double> n_inoc;

@@ -579,7 +579,7 @@
Loading
579 579
    age_distributions <- do.call(rbind, mapply(function(j) {
580 580
      ret <- do.call(rbind, mapply(function(i) {
581 581
        ret <- do.call(rbind, output_raw$age_distributions[[j]][[i]])
582 -
        colnames(ret) <- c("S", "E", "A", "C", "P", "inc_infection", "inc_acute", "inc_chronic")
582 +
        colnames(ret) <- c("S", "E", "A", "C", "P", "inc_infection", "inc_acute", "inc_chronic","detect_microscopy_acute","detect_microscopy_chronic", "detect_PCR_acute", "detect_PCR_chronic" )
583 583
        data.frame(cbind(deme = i, age = seq_len(nrow(ret)) - 1, ret))
584 584
      }, seq_along(output_raw$age_distributions[[j]]), SIMPLIFY = FALSE))
585 585
      cbind(sample_time = j, ret)

@@ -179,3 +179,88 @@
Loading
179 179
  writeLines(s, file_path)
180 180
  
181 181
}
182 +
183 +
#-----------------------------
184 +
#' @title Retrieve prevalence
185 +
#' 
186 +
#' @Description Function to add detection layer to estimated prevalence
187 +
#'
188 +
#' @param data  Model output from SIMPLEGEN sim_epi() function epi_output$daily_values
189 +
#' @param case_detection Method of case detection, "Active" or "Passive"
190 +
#' @param diagnosis Method of diagnosis, "Microscopy" or "PCR"
191 +
#' @param sampling_time Sampling time, currently input should be a numeric day e.g. 100 would represent the 100th day of simulation.
192 +
#' @param sampled TO DO - sample from bernoulli distribution to generate simulated numbers of cases detected on each day - done in SIMPLEGEN internally already
193 +
#' @param deme deme of interest - currently assumes just a single deme analysed - i.e. can't pool results of multiple demes
194 +
#'
195 +
#' @importFrom stats aggregate
196 +
#' @return returns named vector :  c("annual_EIR", "prevalence_true", "prevalence_detected")
197 +
#' @export
198 +
199 +
200 +
retrieve_prev <-
201 +
  function(data,
202 +
           case_detection,
203 +
           diagnosis,
204 +
           sampling_time,
205 +
           sampled = FALSE,
206 +
           deme = 1) {
207 +
    results<-vector(length=3)
208 +
    names(results) <-
209 +
      c("annual_EIR", "prevalence_true", "prevalence_detected")
210 +
    
211 +
    # Calculating Annual EIR --------------------------------------------------
212 +
    
213 +
    # subset to desired rows and columns
214 +
    df_wide <-
215 +
      data[, c("time", "deme", "EIR")]
216 +
    df_wide <- df_wide[df_wide$deme == deme,]
217 +
    
218 +
    df_wide$year <-
219 +
      lubridate::year(lubridate::as_date(df_wide$time, origin = lubridate::origin))
220 +
    
221 +
    annual_EIR <-
222 +
      stats::aggregate(EIR ~ year + deme, data = df_wide, FUN = "sum")
223 +
    #annual_A<-aggregate(A~year + deme,data=df_wide, FUN= "mean" )
224 +
    
225 +
    sample_year<-lubridate::year(lubridate::as_date(sampling_time, origin = lubridate::origin))
226 +
    
227 +
    results["annual_EIR"] <- annual_EIR[which(annual_EIR$year==sample_year),"EIR"]
228 +
    
229 +
    
230 +
    # Calculating true prevalence ---------------------------------------------
231 +
    data<-data[data$time==sampling_time,]
232 +
    
233 +
    
234 +
    results["prevalence_true"]<- sum(data$C,data$A)/data$H
235 +
    
236 +
    # Calculating observed prevalence -----------------------------------------
237 +
    
238 +
    if(case_detection == "Active") {
239 +
      if (diagnosis == "PCR") {
240 +
        results["prevalence_detected"] <-
241 +
          sum(data$A_detectable_PCR, data$C_detectable_PCR) / data$H
242 +
      }
243 +
      else if (diagnosis == "Microscopy") {
244 +
        results["prevalence_detected"] <-
245 +
          sum(data$A_detectable_microscopy,data$C_detectable_microscopy) / data$H
246 +
        
247 +
      } else{
248 +
        warning("diagnosis type not recognized, please enter Microscopy or PCR")
249 +
      }
250 +
    } else if (case_detection == "Passive") {
251 +
      if (diagnosis == "PCR") {
252 +
        results["prevalence_detected"] <- data$A_detectable_PCR/data$H
253 +
      }
254 +
      else if (diagnosis == "Microscopy") {
255 +
        results["prevalence_detected"] <- data$A_detectable_microscopy/data$H
256 +
        
257 +
      } else {
258 +
        warning("diagnosis type not recognized, please enter Microscopy or PCR")
259 +
      }
260 +
      
261 +
    } else {
262 +
      warning("case_detection type not recognized, please enter Active or Passive")
263 +
    }
264 +
    
265 +
    return(results)
266 +
  }

@@ -272,3 +272,54 @@
Loading
272 272
}
273 273
274 274
275 +
276 +
#function to plot model output EIR versus prevalence------------------------------------------------
277 +
278 +
#' @title Plot EIR versus prevalence
279 +
#'
280 +
#' @description Plots relationship between annual EIR and prevalence
281 +
#'
282 +
#' @param data dataset produced by the retrieve_prev function
283 +
#' @param plot_studies logical argument whether to plot data from previous empirical studies (currently Hay et al., 2005)
284 +
#' @param scale_x linear or log scale for x axis
285 +
#'
286 +
#' @importFrom ggsci scale_color_lancet
287 +
#' @importFrom rlang .data
288 +
#' @export
289 +
#' 
290 +
#' 
291 +
#' 
292 +
plot_EIR_prevalence<-function(data, plot_studies = TRUE, scale_x="linear"){
293 +
  
294 +
  
295 +
  data("EIRprev_hay2005")
296 +
  data("EIRprev_beier1999")
297 +
  
298 +
  EIRprev<-tidyr::gather(as.data.frame(EIRprev),key = "detection_type", value ="prevalence", -1 )
299 +
  
300 +
  #remove zeros to avoid issues when logging
301 +
  EIRprev<-EIRprev[is.finite(log(EIRprev[,"annual_EIR"])),]
302 +
  
303 +
  if (plot_studies == TRUE){
304 +
    EIRprev_hay2005$detection_type<-rep("Hay et al., 2005", length.out= nrow( EIRprev_hay2005))
305 +
    EIRprev_beier1999$detection_type<-rep("Beier et al., 1999", length.out= nrow( EIRprev_beier1999))
306 +
    EIRprev<-rbind( EIRprev, EIRprev_hay2005)
307 +
    EIRprev<-rbind(EIRprev,EIRprev_beier1999)
308 +
  }else {} 
309 +
  if(scale_x == "linear"){
310 +
    p<-ggplot2::ggplot(data=as.data.frame(EIRprev), ggplot2::aes(.data$annual_EIR, .data$prevalence, colour = .data$detection_type)) + ggplot2::theme_bw() + ggsci::scale_color_lancet()+
311 +
      ggplot2::geom_point() +
312 +
      ggplot2::labs(title = "Annual EIR and Prevalence", x = "Annual EIR", y = "Prevalence") +
313 +
      ggplot2::coord_cartesian(ylim=c(0,1),xlim= c(0,400))
314 +
    
315 +
    
316 +
  }else if(scale_x == "log"){
317 +
    p<-ggplot2::ggplot(as.data.frame(EIRprev),ggplot2::aes(.data$annual_EIR, .data$prevalence, colour = .data$detection_type)) + ggplot2::theme_bw() +
318 +
      ggplot2::geom_point() + ggplot2::scale_x_log10() + ggsci::scale_color_lancet()+
319 +
      ggplot2::labs(title = "Annual EIR (log scale) and Prevalence", x = "Annual EIR", y = "Prevalence")+
320 +
      #ggplot2::geom_smooth(method = "lm")+
321 +
      ggplot2::coord_cartesian(ylim=c(0,1))
322 +
  } else { warning("scale_x must be log or linear")}
323 +
  print(p)
324 +
}
325 +

@@ -122,14 +122,18 @@
Loading
122 122
  // age distributions. Final level: 0 = Sh, 1 = Eh, 2 = Ah, 3 = Ch, 4 = Ph
123 123
  age_distributions = vector<vector<vector<vector<double>>>>(params->n_output_age_times,
124 124
                              vector<vector<vector<double>>>(params->n_demes,
125 -
                                      vector<vector<double>>(params->n_life_table, vector<double>(8))));
125 +
                                      vector<vector<double>>(params->n_life_table, vector<double>(12))));
126 126
  
127 127
  // misc
128 128
  EIR = vector<double>(params->n_demes);
129 129
  prob_infectious_bite = vector<double>(params->n_demes);
130 130
  inc_infection = vector<double>(params->n_demes);
131 131
  inc_acute = vector<double>(params->n_demes);
132 132
  inc_chronic = vector<double>(params->n_demes);
133 +
  detect_microscopy_acute = vector<double>(params->n_demes);
134 +
  detect_microscopy_chronic = vector<double>(params->n_demes);
135 +
  detect_PCR_acute = vector<double>(params->n_demes);
136 +
  detect_PCR_chronic = vector<double>(params->n_demes);
133 137
  
134 138
}
135 139
@@ -593,6 +597,22 @@
Loading
593 597
    age_distributions[t_index][this_deme][this_age][6] += inc1 * inc2;
594 598
    age_distributions[t_index][this_deme][this_age][7] += inc1 * (1.0 - inc2);
595 599
    
600 +
  
601 +
  
602 +
    //detectability by microscopy (expectation) 
603 +
    double detectable_microscopy_a =  host_pop[i].get_detectability_microscopy_acute(t) ;
604 +
    double detectable_microscopy_c =  host_pop[i].get_detectability_microscopy_chronic(t);
605 +
    age_distributions[t_index][this_deme][this_age][8] += detectable_microscopy_a/double(H[this_deme]) ;
606 +
    age_distributions[t_index][this_deme][this_age][9] += detectable_microscopy_c/double(H[this_deme]) ;
607 +
    
608 +
    //detectability by PCR (expectation)  
609 +
    double  detectable_PCR_a = host_pop[i].get_detectability_PCR_acute(t) ;
610 +
    double  detectable_PCR_c = host_pop[i].get_detectability_PCR_chronic(t);
611 +
    age_distributions[t_index][this_deme][this_age][10] += detectable_PCR_a/double(H[this_deme])  ;
612 +
    age_distributions[t_index][this_deme][this_age][11] += detectable_PCR_c/double(H[this_deme])  ;
613 +
614 +
615 +
596 616
  }  // end loop through hosts
597 617
  
598 618
}

Learn more Showing 1 files with coverage changes found.

Changes in src/Host.cpp
-1
+1
Loading file...
Files Coverage
R -4.88% 60.47%
src -0.25% 56.51%
Project Totals (24 files) 57.73%
Loading