R/outputer.R

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

#' Output
#' Generates outputs
#' 
#' @param pop.vac This is the output of the vacgen function.
#' @param adm.setting This determines at what level the information is output. Accepts any combination of adm0 (country level), adm1 and adm2 as an input.
#' @param format This changes the format of the output. Accepts "csv" or "rdata".
#' @param savemodifier This adds a user generated string to the end of the name of the produced outputs.
#' outputer(popvac)
#' @keywords internal

outputer<-function(popvac,adm.setting="adm2",format="csv",rdata.output=F,savemodifier=NA,genvals,popdf){
  
  #Unpacking
  dndf<-genvals$dndf
  dn2<-genvals$dn2
  dn3<-genvals$dn3
  dn1.0<-dndf$adm0
  dn1.1<-dndf$adm1
  dn1.2<-dndf$adm2
  dn1.0.name<-dndf$dn1.0.name
  dn1.1.name<-dndf$dn1.1.name
  dn1.2.name<-dndf$dn1.2.name
  dn1.1_gadm1<-dndf$dn1.1_gadm1
  dn1.2_gadm1<-dndf$dn1.2_gadm1
  pop1.adm2<-genvals$pop1.adm2

  dn1.a1<-names(table(dn1.1))  

  #Generate blank arrays for filling
  popvac.adm1<-pop1.adm1<-array(NA, dim=c(length(dn1.a1),dim(pop1.adm2)[2:3]))

  for(i in 1:length(dn1.a1)) {
    adm1<-dn1.a1[i]
    whi<-which(dn1.1==adm1)
    if(length(whi)==1) {
      pop1.adm1[i,,]<-pop1.adm2[whi,,]
      popvac.adm1[i,,]<-pop1.adm2[whi,,]*popvac[whi,,]/pop1.adm1[i,,]
    } else {
      pop1.adm1[i,,]<-apply(pop1.adm2[whi,,],c(2,3),sum)
      popvac.adm1[i,,]<-apply(pop1.adm2[whi,,]*popvac[whi,,],c(2,3),sum)/pop1.adm1[i,,]
    }
  }

  if(is.na(savemodifier)) savemod<-"" else savemod<-savemodifier
  
  
  ###################################
  ###       Exporting things      ###
  ###################################

  
  if(is.element("adm2",adm.setting)){
    
    #Set to NULL
    vc.out<-NULL
    
    #This generates the vaccination coverage
    vc.out.unprocessed<-sapply(1:dim(pop1.adm2)[1], function(i){
      vc.out<-data.frame(country=dn1.0[i], adm1=dn1.1[i], adm2=dn1.2[i], year=dn2, popvac[i,,])
      
      vc.out$country<-as.character(vc.out$country)
      vc.out$adm1<-as.character(vc.out$adm1)
      vc.out$adm2<-as.character(vc.out$adm2)
      vc.out$year<-as.numeric(vc.out$year)
      # print(i)
      vc.out
    })
    
    #Throw them back into the right format
    vc.out<-data.frame(matrix(unlist(t(vc.out.unprocessed)),ncol=105,byrow=FALSE),stringsAsFactors=FALSE)
    colnames(vc.out)[1:4]<-c("country","adm1","adm2","year")
    #Do this for correct year values - can fix later this is a quick fix
    vc.out$year<-rep(1950:2050,dim(pop1.adm2)[1])
    
    #Changing numbers to numeric format
    for(x in which(names(vc.out) %in% c("country","adm1","adm2","year")==FALSE)){
      vc.out[,x]<-as.numeric(vc.out[,x])
    }
    
    #The first output - a 2D table by adm2-year and age
    if(is.element("rds",format)) saveRDS(vc.out, file=paste("output/vc_adm2_combined_",savemod,"_",gsub("-","",Sys.Date()),".rds",sep="")) 
    if(is.element("csv",format)) write.csv(vc.out, file=paste("output/vc_adm2_combined_",savemod,"_",gsub("-","",Sys.Date()),".csv",sep="")) 
    
  }
  
  if(is.element("adm1",adm.setting)){
    
    #Outputting the vaccination coverage at adm1 level
    vacc.outadm1<-data.frame(popvac.adm1[1,,])
    if(length(length(dn1.a1)>1)) for(i in 2:length(dn1.a1)) vacc.outadm1<-rbind(vacc.outadm1, data.frame(popvac.adm1[i,,]))
    names(vacc.outadm1)<-dn3
    vacc.outadm1<-cbind(country = dn1.0[match(rep(dn1.a1,each=dim(popvac.adm1)[2]),dn1.1)],adm1 = rep(dn1.a1,each=dim(popvac.adm1)[2]),year = rep(dn2, times=dim(popvac.adm1)[1]), vacc.outadm1)
    
    # write.csv(vacc.outadm1, paste("output/vaccination_coverage_by_adm1_year_age_combined_",savemod,"_",tag,"_",savemod,"_",GAVI.switch,"_skew",skew,"_",savemod,"_",gsub("-","",Sys.Date()),".csv",sep=""), row.names=F)
    if(is.element("rds",format)) saveRDS(vacc.outadm1, file=paste("output/vc_adm1_combined_",savemod,"_",gsub("-","",Sys.Date()),".rds",sep="")) 
    if(is.element("csv",format)) write.csv(vacc.outadm1, file=paste("output/vc_adm1_combined_",savemod,"_",gsub("-","",Sys.Date()),".csv",sep="")) 
    
  }
  
  if(is.element("adm0",adm.setting)){
    
    #Aggregating vaccination coverage by country
    dn1.a0<-names(table(dn1.0))
    popvac.adm0<-pop1.adm0<-array(NA, dim=c(length(dn1.a0),dim(pop1.adm2)[2:3]))
    for(i in 1:length(dn1.a0)) {
      adm0<-dn1.a0[i]
      whi<-which(dn1.0==adm0)
      if(length(whi)==1) {
        pop1.adm0[i,,]<-pop1.adm2[whi,,]
        popvac.adm0[i,,]<-pop1.adm2[whi,,]*popvac[whi,,]/pop1.adm0[i,,]
      } else {
        pop1.adm0[i,,]<-apply(pop1.adm2[whi,,],c(2,3),sum)
        popvac.adm0[i,,]<-apply(pop1.adm2[whi,,]*popvac[whi,,],c(2,3),sum)/pop1.adm0[i,,]
      }
    }
    
    #Outputting the vaccination coverage at the country level
    vacc.out <- data.frame(popvac.adm0[1,,])
    if(length(dn1.a0)>1) for(i in 2:length(dn1.a0)) vacc.out <- rbind(vacc.out, data.frame(popvac.adm0[i,,]))
    names(vacc.out)<-dn3
    vacc.out<-cbind(country = rep(dn1.a0,each=dim(popvac.adm0)[2]),year = rep(dn2, times=dim(popvac.adm0)[1]), vacc.out)
    vacc.out[is.na(vacc.out)]<-0
    
    if(is.element("rds",format)) saveRDS(vacc.out, file=paste("output/vc_adm0_combined_",savemod,"_",gsub("-","",Sys.Date()),".rds",sep="")) 
    if(is.element("csv",format)) write.csv(vacc.out, file=paste("output/vc_adm0_combined_",savemod,"_",gsub("-","",Sys.Date()),".csv",sep="")) 
    
  }
  
  
  if(rdata.output==T && length(table(is.element(c("adm1","adm2"),adm.setting)))>1){
    
    #Set up population dataframe
    pop.outadm<-if(adm.setting=="adm1") pop1.adm1 else if(adm.setting=="adm2") pop1.adm2
    dn1.number<-if(adm.setting=="adm1") dn1.a1 else if(adm.setting=="adm2") dn1.2
    
    pop.outadm.alt<-data.frame(pop.outadm[1,,])
    if(length(dn1.number)>1) for(i in 2:length(dn1.number)) pop.outadm.alt <- rbind(pop.outadm.alt, data.frame(pop.outadm[i,,]))
    names(pop.outadm.alt)<-dn3
    vc2d<-cbind(adm0 = rep(dn1.0[1],length(dn1.number)),
                 adm1or2 = rep(dn1.number,each=dim(pop.outadm.alt)[2]),
                 year = rep(dn2, times=length(dn1.number)),
                 pop.outadm.alt)
    
    #To the third dimension!
    vc3d<-transform_into_vc3d(vc2d=vc2d,adm=adm.setting)
    
    #Set out values
    dnvalue<-if(adm.setting=="adm1") dn1.number else if(adm.setting=="adm2") dn1.2
    yearvalues<-dn2
    agesvalues<-paste("a",0:100,sep="")
    
    #Set up matrix
    pop3dmat<-if(adm.setting=="adm1") pop1.adm1 else if(adm.setting=="adm2") pop1.adm2
    p_prop3dmat<-if(adm.setting=="adm1") popvac.adm1 else if(adm.setting=="adm2") popvac
    P_tot_2dmat<-sapply(1:dim(pop3dmat)[2], function(x) rowSums(pop3dmat[,x,]))
    
    #Name stuff
    dimnames(pop3dmat)<-list(dnvalue,yearvalues,agesvalues)
    dimnames(p_prop3dmat)<-list(dnvalue,yearvalues,agesvalues)
    dimnames(P_tot_2dmat)<-list(dnvalue,yearvalues)
    
    #Saving .Rdata
    save(pop3dmat, p_prop3dmat, P_tot_2dmat, vc3d, file = paste("output/vaccination_data_combined_",savemod,"_",gsub("-","",Sys.Date()),".Rdata",sep=""))

  }
  
}