R/vacgen.R

In arranhamlet/popvac_package: Generate population level vaccination data from a csv template.

#' Generates vaccination coverages from cleaned vaccination campaigns dataframe.
#' 
#' @param vacc_schedule This is the processed dataframe of GADM1 and GADM2 entries of vaccination campaigns.
#' @param skew This affects how vaccination campaigns are applied. If the skew is set to -1 then campaigns are applied to the whole population, regardless of prior vaccination status. If the skew is set to 0 then campaigns are applied only to the unvaccinated population.
#' @param genvals This is the output from popandvac
#' @param countryiso This is a vector of the ISO codes for all countries you want to generate population vaccination coverage for.
#' @examples
#' vacgen(vacc_schedule,0,genvals,"AGO")
#' @keywords internal


vacgen<-function(vacc_schedule,skew,genvals,countryiso){
  
  #Subset vacc_schedule to the countryiso
  vacc_schedule_sub<-vacc_schedule[vacc_schedule$country.code %in% countryiso,]
  
  pop1.adm2<-genvals[["pop1.adm2"]]
  
  #Unpacking
  dndf<-genvals$dndf
  vacc.cov<-genvals$vacc.cov
  
  mycov<-vacc_schedule_sub$coverage.survey
  mycov[is.na(mycov)] = vacc_schedule_sub$coverage.adm[is.na(mycov)]
  mycov[is.na(mycov)] = vacc_schedule_sub$coverage.planned[is.na(mycov)]
  
  # print("GADM1 and GADM2 re-combined now deciding which coverage to use")
  dfsummary<-data.frame(NA,NA,NA,NA,NA,NA)
  colnames(dfsummary)<-names(summary(vacc.cov))
  
  #This generates the vaccination coverage by age
  for(vid in as.numeric(names(table(vacc_schedule_sub$vac.id)))) {
    y<-as.numeric(as.character(vacc_schedule_sub$year[match(vid,vacc_schedule_sub$vac.id)]))
    adm2<-vacc_schedule_sub$adm2[vacc_schedule_sub$vac.id==vid]
    
    #Because of the way doses are assigned, sometimes you get small numbers that are not correct - so we'll assume <100 doses are a
    #byproduct of this and so set them to NA.  Same with coverage
    vacc_schedule_sub$target.pop[vacc_schedule_sub$target.pop <100]<-NA
    vacc_schedule_sub$doses[vacc_schedule_sub$doses <100]<-NA
    
    ccov<-mycov[which(as.numeric(as.character(vacc_schedule_sub$vac.id)) %in% vid)]
    ccov[ccov>1]<-1
    ccov[ccov<0.1]<-NA
    
    mdos<-pmin(vacc_schedule_sub$doses[which(as.numeric(as.character(vacc_schedule_sub$vac.id)) %in% vid)],
               vacc_schedule_sub$target.pop[which(as.numeric(as.character(vacc_schedule_sub$vac.id)) %in% vid)],na.rm=TRUE)
    
    if(!is.finite(mdos)) mdos<-0
    ami<-as.numeric(as.character(vacc_schedule_sub$agemin[match(vid,vacc_schedule_sub$vac.id)]))
    ama<-as.numeric(as.character(vacc_schedule_sub$agemax[match(vid,vacc_schedule_sub$vac.id)]))
    if(is.na(ami)) ami<-as.numeric(1)
    if(is.na(ama)) ama<-as.numeric(100)
    if(vacc_schedule_sub$scenario[vacc_schedule_sub$vac.id==vid][1] == "future.GAVI") {
      campaign.skew<--1
    } else {
      campaign.skew<-skew
    }
    vacc.cov<-add.vacc.campaign(dndf,pop1.adm2,vacc.cov,year=y,adm2=adm2,coverage=ccov,doses=mdos,agemin=ami,agemax=ama,skew=campaign.skew)# this will take the coverage value by default and only use the doses if is.na(ccov).
    dfsummary[which(as.numeric(names(table(vacc_schedule_sub$vac.id))) %in% vid),]<-summary(vacc.cov)
    
  }
  vacc.cov
}