#---
#title: "pairwise identity from VCF file"
#author: "Tal Dahan-Meir"
#date: "18/08/2021"
#---

library(data.table)

### load and clean vcf ###

vcf=fread("ammiad_845.vcf")
vcf_tab_clean = vcf[,10:ncol(vcf)]
vcf_tab_clean_0_3 = t ( apply (vcf_tab_clean,1,function(x) { as.character(substring(x,1,3)) }) )
vcf_tab_clean_0_3 = replace(vcf_tab_clean_0_3,vcf_tab_clean_0_3 == "./.","none")
colnames(vcf_tab_clean_0_3) = colnames(vcf_tab_clean)

### get heterozygosity ###

homoz_het = vcf_tab_clean_0_3
homoz_het[,]="het"
homoz_het[grepl("0/0|1/1|2/2|3/3",vcf_tab_clean_0_3)] = "hom"
homoz_het[grepl("none",vcf_tab_clean_0_3)] = "none"
homoz_frac = apply(homoz_het,2,function(x){100*(sum(x=="het")/length(x))})
names(homoz_frac) = colnames(homoz_het)
sort(homoz_frac)

### get alternative allele fraction ###

alternative=vcf_tab_clean_0_3
alternative[,]="alt"
alternative[grepl("0/0",vcf_tab_clean_0_3)] = "ref"
alt_frac = apply(alternative,2,function(x){100*(sum(x=="alt")/length(x))})
sort(alt_frac)

### get covered positions per plant ###

covered = vcf_tab_clean_0_3
covered[,]="cov"
covered[grepl("none",vcf_tab_clean_0_3)] = "not"
covered_frac = apply(covered,2,function(x){100*(sum(x=="cov")/length(x))})
covered_sum = apply(covered,2,function(x){sum(x=="cov")})
names(covered_frac) = colnames(covered)

#sort(covered_frac)
#sort(covered_sum)

### calculate pairwise identity ###

vcf_tab_clean_0_3 = replace(vcf_tab_clean_0_3,vcf_tab_clean_0_3 == "none",NA)
similarity.matrix<-apply(vcf_tab_clean_0_3,2,function(x)colSums(x==vcf_tab_clean_0_3, na.rm=TRUE))
Ncomparisons_matrix=apply(vcf_tab_clean_0_3,2,function(x)colSums(!is.na(x==vcf_tab_clean_0_3)))
identity.matrix=similarity.matrix/Ncomparisons_matrix

### plot pairwise identity distribution of Ammiad (removing Zavitan controls) ###

no_z=identity.matrix[!grepl(as.character("Zavitan"),rownames(identity.matrix)),!grepl("Zavitan",colnames(identity.matrix))]
#hist(no_z[lower.tri(no_z)],breaks=60,col="#a1d99b",border="#74C476")

### for every plant, find all plants that has at least X (identity_threshold) identity to it ###

require(igraph)
require(data.table)

identity_threshold=0.981
my_list=list()
for (i in 1:ncol(identity.matrix))
{
relevant_vector = rownames(identity.matrix)[identity.matrix[,i] >= identity_threshold]
my_list[[i]]=relevant_vector
}
names(my_list) = colnames(identity.matrix)

overlap <- function(u, v) length(intersect(u, v)) / min(length(u), length(v)) > 0.8
adj <- sapply(my_list, function(u) sapply(my_list, overlap, u)) + 0
g <- graph_from_adjacency_matrix(adj)
memb <- components(g)$membership
s <- split(my_list, memb)
groups <- lapply(s, function(x) unique(unlist(x)))
cat(paste0("getting info from ",length(groups), " groups\n"))
#length(groups)

### assign names to groups ###

names(groups) <- paste("G",1:length(groups),sep="")
lengths=as.vector(sapply(groups, length))
#sort(lengths)

### make table with groups and levels ###

m1=max(lengths(groups))
d1=as.data.frame(do.call(rbind,lapply(groups,'length<-',m1)),stringsAsFactors=FALSE)
names(d1)=paste0("Level",seq_along(d1))
csv=d1
 group_sizes = apply(csv,2,function(x){sum(!is.na(x))})

groups_vector = c()
for (i in 1:length(group_sizes)){
groups_vector = c(groups_vector,rep(i,group_sizes[i]))}
groups_list = apply(csv,2,function(x){as.character(x)[!is.na(x)]})
names(groups_vector) = unlist(groups_list,use.names=FALSE)


#written and kindly provided by Roger Mundry
glmm.model.stab<-function(model.res, contr=NULL, ind.cases=F, para=F, data=NULL, use=NULL, n.cores=c("all-1", "all"), save.path=NULL, load.lib=T, lib.loc=.libPaths()){
	print("please carefully evaluate whether the result makes sense, and if not, please contact me")
	#function determining stability of GLMMs (run using lmer or glmer) by excluding levels of random effects, one at a time;
	#supports
		#weights, offset terms and random slopes;
	#does not support
		#correlations between random intercepts and random slopes
		#any terms calculated in the model formula (e.g., log, function I, etc.); but interactions do work
	#latest additions/modifications:
		#copes also with data sets where a level of a (fixed effects) factor is entirely dropped from the data
		#new way of catching warnings (are contained in the detailed output table)
		#includes sample size in the detailed output table
		#catches errors
		#use: an argument taking the names of the random effects for which model stability should be evaluated
			#(useful for models with a random effect having a unique case for each level of the data)
	#written by Roger Mundry
	#modified April 2016 (added dealing with glmer.nb; fixed a bug in the output of the random effects of tthe original model)
	#last modified Mar 2017 (added dealing with fixed effects factor levels dropped when dropping levels of random effects)
	#last modified June 14 2017 (fixed dealing with random effects comprising correlation parameters)
	#last modified July 06 2017 (fixed small bug happening when model revealed an error)
	if(load.lib){library(lme4, lib.loc=lib.loc)}
	n.cores=n.cores[1]
  model.eq=as.formula(as.character(model.res@call)[2])
	if(class(model.res)[1]=="lmerMod"){
    REML=model.res@resp$REML==1
    xfam="gaussian"
  }else{
		xfam=model.res@resp$family$family
  }
  if(grepl(x=xfam, pattern="Negative Binomial", fixed=T)){
		xfam="neg.bin"
	}
  weights=model.res@resp$weights
  if(length(data)==0){
		ii.data=model.res@frame
		offs.col=grep(x=names(ii.data), pattern="offset(", fixed=T)
		if(length(offs.col)>0){
			for(i in offs.col){
				#ii.data[,i]=exp(ii.data[,i])
				names(ii.data)[i]=substr(x=names(ii.data)[i], start=8, stop=nchar(names(ii.data)[i]) -1)
			}
		}
		wght.col=grep(x=names(ii.data), pattern="(weights)", fixed=T)
		if(length(wght.col)>0){
			names(ii.data)[wght.col]=gsub(x=names(ii.data)[wght.col], pattern="(", replacement="", fixed=T)
			names(ii.data)[wght.col]=gsub(x=names(ii.data)[wght.col], pattern=")", replacement="", fixed=T)
		}else{
			ii.data$weights=weights
		}
	}else{
		ii.data=data.frame(data, weights)
	}
	if(substr(as.character(model.eq)[2], start=1, stop=6)=="cbind("){
		ii.data$weights=1
	}
  #if(xfam=="binomial"){
  #   response=as.character(model.eq)[2]
  #   if(sum(names(ii.data)==response)==0)
  #}
  ranefs=names(ranef(model.res))
	if(length(use)==0){use=ranefs}
	ranefs=ranefs[ranefs%in%use]
  xlevels=lapply(ranefs, function(x){return(as.vector(unique(ii.data[ ,x])))})
  ranefs=rep(ranefs, unlist(lapply(xlevels, length)))
  to.do=cbind(ranefs, unlist(xlevels))
  if(ind.cases){
    ii.data=data.frame(ii.data, ic=as.factor(1:nrow(ii.data)))
    to.do=rbind(to.do, cbind("ic", levels(ii.data$ic)))
  }
	keepWarnings <- function(expr) {
		localWarnings <- list()
		value <- withCallingHandlers(expr,
			warning = function(w) {
				localWarnings[[length(localWarnings)+1]] <<- w
				invokeRestart("muffleWarning")
			}
		)
		list(value=value, warnings=localWarnings)
	}
	get.ranef<-function(x){#function returning sd associated with random effect in a nicely named vector
		x=as.data.frame(x)
		y=lapply(strsplit(as.character(x$grp), split=""), function(y){
			yy=unlist(lapply(strsplit(names(ranef(model.res)), split=""), function(z){
				if(length(z)<=length(y)){
					y=y[1:length(z)]
					return(paste(y[y==z], collapse=""))
				}else{
					return("")
				}
			}))
			yy=intersect(yy, names(ranef(model.res)))
			if(length(yy)==0){yy=paste(y, collapse="")}
			return(yy)
		})
		x$grp=y
		ires=x$sdcor
		#x$var2[is.na(x$var2)]=""
		names(ires)=apply(x[, 1:3], 1, paste, collapse="@")
		names(ires)[x$grp=="Residual"]="Residual"
		return(ires)
	}
	if(length(contr)==0){
		if(class(model.res)[1]=="lmerMod"){
			contr=lmerControl()
		}else{
			contr=glmerControl()
		}
	}
  ifun=function(x, model.res, to.do, ii.data, contr, get.ranef){
    #sel.ii.data=subset(ii.data, ii.data[,to.do[x, 1]]!=to.do[x, 2])
    sel.ii.data=ii.data[ii.data[,to.do[x, 1]]!=to.do[x, 2], ]
		if(class(model.res)[1]=="lmerMod"){
      sel.ii.res=try(keepWarnings(lmer(model.eq, data=sel.ii.data, weights=weights, REML=REML, control=contr)), silent=T)
    }else if(xfam=="binomial" | xfam=="poisson"){
      sel.ii.res=try(keepWarnings(glmer(model.eq, data=sel.ii.data, family=xfam, control=contr)), silent=T)
    }else{
			sel.ii.res=try(keepWarnings(glmer.nb(model.eq, data=sel.ii.data, control=contr)), silent=T)
		}
		if(length(save.path)>0){
			est.fixed.effects=fixef(sel.ii.res$value)
			est.random.effects=as.data.frame(summary(sel.ii.res$value)$varcor)
			model.warnings=sel.ii.res$warnings
			n=length(residuals(sel.ii.res$value))
			what=to.do[x, ]
			save(file=paste(c(paste(c(paste(c(save.path, "m"), collapse="/"), x), collapse="_"), ".RData"), collapse=""), list=c("what", "est.fixed.effects", "est.random.effects", "model.warnings", "n"))
		}
    if(class(sel.ii.res)!="try-error"){
			#xx=try(list(fere=c(fixef(sel.ii.res$value), get.ranef(summary(sel.ii.res$value)$varcor)), N=length(residuals(sel.ii.res$value)), warnings=paste(unlist(sel.ii.res$warnings)$message, collapse="/")), silent=T)
			#if(class(xx)=="try-error"){browser()}
      return(list(fere=c(fixef(sel.ii.res$value), get.ranef(summary(sel.ii.res$value)$varcor)), N=nrow(sel.ii.res$value@frame), warnings=paste(unlist(sel.ii.res$warnings)$message, collapse="/")))
    }else{
      return(list(fere=rep(NA, length(fixef(model.res))+nrow(as.data.frame(summary(model.res)$varcor))), N=NA, warnings="error"))
    }
  }
  if(para){
		#on.exit(expr = parLapply(cl=cl, X=1:length(cl), fun=function(x){rm(list=ls())}), add = FALSE)
		#on.exit(expr = stopCluster(cl), add = T)
    require(parallel)
    cl <- makeCluster(getOption("cl.cores", detectCores()))
		if(n.cores!="all"){
			if(n.cores=="all-1"){n.cores=length(cl)-1}
			if(n.cores<length(cl)){
				cl=cl[1:n.cores]
			}
		}
    parLapply(cl=cl, 1:length(cl), fun=function(x){
      library(lme4, lib.loc=lib.loc)
      return(invisible(""))
    })
    all.coeffs=parLapply(cl=cl, X=1:nrow(to.do), fun=ifun, model.res=model.res, to.do=to.do, ii.data=ii.data, contr=contr, get.ranef=get.ranef)
    parLapply(cl=cl, 1:length(cl), fun=function(x){
      return(rm(list=ls()))
    })
    stopCluster(cl=cl)
  }else{
    all.coeffs=lapply(1:nrow(to.do), ifun, model.res=model.res, to.do=to.do, ii.data=ii.data, contr=contr, get.ranef=get.ranef)
  }
	all.n=unlist(lapply(all.coeffs, function(x){x$N}))
	all.warnings=unlist(lapply(all.coeffs, function(x){paste(unlist(x$warnings), collapse=", ")}))
	all.warnings[all.warnings==""]="none"
	############################################################################################################################
	############################################################################################################################
	############################################################################################################################
	############################################################################################################################

	xnames=unique(unlist(lapply(all.coeffs, function(x){names(x$fere)})))
	all.coeff.mat=matrix(NA, ncol=length(xnames), nrow=length(all.coeffs))
	colnames(all.coeff.mat)=xnames
	for(i in 1:length(all.coeffs)){
		all.coeff.mat[i, names(all.coeffs[[i]]$fere)]=all.coeffs[[i]]$fere
	}
	#extract results for original model:
	orig=c(fixef(model.res), get.ranef(summary(model.res)$varcor))

  xsum=apply(all.coeff.mat, 2, range, na.rm=T)
  xsum=data.frame(what=colnames(all.coeff.mat), orig=orig[colnames(all.coeff.mat)], t(xsum))
	rownames(xsum)=as.character(xsum$what)
  colnames(to.do)=c("ranef", "level")
  xx=apply(is.na(all.coeff.mat), 1, sum)
  if(sum(xx>0 & xx<ncol(all.coeff.mat))>0){
		warning(paste(c("for", sum(xx>0 & xx<ncol(all.coeff.mat)), "subset(s) the full model could not be fitted because of fixed effects factor levels dropped from the data"), collapse=" "))
	}
  all.coeff.mat=data.frame(to.do, N=all.n, all.coeff.mat, warnings=all.warnings)
  names(xsum)[3:4]=c("min", "max")
  return(list(detailed=all.coeff.mat, summary=xsum))
}


dyn.load('/Library/Java/JavaVirtualMachines/jdk1.8.0_131.jdk/Contents/Home/jre/lib/server/libjvm.dylib')
library(rJava)

setwd("/Users/mengmengjiang/all datas/print")

library(xlsx)

# reading ux and sd

k1<-read.xlsx("dotx.xlsx",sheetName="600",header=TRUE)
k2<-read.xlsx("dotx.xlsx",sheetName="1khz",header=TRUE)
k3<-read.xlsx("dotx.xlsx",sheetName="2khz",header=TRUE)
k4<-read.xlsx("dotx.xlsx",sheetName="2.5khz",header=TRUE)

# errorbar
error.bar <- function(x, y, upper, coll,lower=upper, length=0.05,...){
if(length(x) != length(y) | length(y) !=length(lower) | length(lower) != length(upper))
stop("vectors must be same length")
arrows(x,y+upper, x, y-lower,col=coll, angle=90, code=3, length=length, ...)
}

# color setting

yan<-c("red","blue","black","green3")
pcc<-c(0,1,2,5)

# plot

plot(k1$ux,k1$sdeva, col=0,xlab = expression(italic(U["x"]) (mm/s)),
          ylab = expression(italic(S["d"]) (um)), mgp=c(1.1, 0, 0),tck=0.02,
               main = "", xlim = c(0,300),ylim=c(0,400))

mtext("Droplet space",3,line=0.2,font=2,cex=1.2)

lines(k1$ux,k1$sdeva,lwd=1.5,lty=2,col=yan[1],pch=pcc[1],type="b")
lines(k2$ux,k2$sdeva,lwd=1.5,lty=2,col=yan[2],pch=pcc[2],type="b")
lines(k3$ux,k3$sdeva,lwd=1.5,lty=2,col=yan[3],pch=pcc[3],type="b")
lines(k4$ux,k4$sdeva,lwd=1.5,lty=2,col=yan[4],pch=pcc[4],type="b")

error.bar(k1$ux,k1$sdeva,k1$sdstd/2,col=yan[1])
error.bar(k2$ux,k2$sdeva,k2$sdstd/2,col=yan[2])
error.bar(k3$ux,k3$sdeva,k3$sdstd/2,col=yan[3])
error.bar(k4$ux,k4$sdeva,k4$sdstd/2,col=yan[4])

leg<-c("600Hz","1KHz","2KHz","2.5KHz")

legend("topright",legend=leg,col=yan,pch=pcc,lwd=1.5,lty=2,inset=.02,
bty="n")


#!/usr/bin/Rscript

## Author: David Eccles (gringer), 2007 <programming@gringer.org>

## snpblaster.r -- Calculates location differences to determine which markers can
## be removed without much loss

usage <- function(){
  cat("usage: ./snpblaster.r <file> [-size <windowSize>]\n",
      "Expects a CSV file with headings: [Marker],Delta,Mutation,Chromosome,Location\n",
      sep="");
}

infile = FALSE;

windowSize = 10^6;
argLoc <- 1;

while(!is.na(commandArgs(TRUE)[argLoc])){
  if(file.exists(commandArgs(TRUE)[argLoc])){ # file existence check
    if(infile == FALSE){
      infile <- commandArgs(TRUE)[argLoc];
    } else{
      cat("Error: More than one input file specified\n");
      usage();
      quit(save = "no", status=1);
    }
  } else {
    if(commandArgs(TRUE)[argLoc] == "-window"){
      windowSize <- eval(parse(text = commandArgs(TRUE)[argLoc+1]));
      cat("Setting window size to ",windowSize,"\n",sep="");
      argLoc <- argLoc + 1;
    }
  }
  argLoc <- argLoc + 1;
}

if(infile == FALSE){
  cat("Error: No input file specified\n");
  usage();
  quit(save = "no", status=1);
}

meanstats.location <- read.csv(infile, row.names = 1);

num.rowcol <- dim(meanstats.location)[1];
snpblast.loc <- matrix(meanstats.location$Location, num.rowcol, num.rowcol);
snpblast.cs <- matrix(meanstats.location$Chromosome,num.rowcol, num.rowcol);
snpblast.delta <- matrix(meanstats.location$Delta,num.rowcol, num.rowcol);
snpblast.names <- matrix(rownames(meanstats.location),num.rowcol,
                        num.rowcol);
snpblast.mat <- abs(snpblast.loc-t(snpblast.loc));
snpblast.mat[snpblast.cs != t(snpblast.cs)] <- NA;
snpblast.mat[lower.tri(snpblast.mat, diag = TRUE)] <- NA;

near.markers <- which(snpblast.mat < windowSize);
snpblast.df <- data.frame(Marker1 = snpblast.names[near.markers], Marker2 = t(snpblast.names)[near.markers],
                         Chromosome = as.numeric(snpblast.cs[near.markers]),
                         Location1 = snpblast.loc[near.markers], Location2 = t(snpblast.loc)[near.markers],
                         Delta1 = snpblast.delta[near.markers], Delta2 = t(snpblast.delta)[near.markers],
                         Distance = snpblast.mat[near.markers]);
snpblast.df <- snpblast.df[order(as.numeric(snpblast.df$Chromosome),snpblast.df$Distance),];
snpblast.df$Remove <- as.character(snpblast.df$Marker2);
snpblast.df$Remove[snpblast.df$Delta1 < snpblast.df$Delta2] <-
  as.character(snpblast.df$Marker1[snpblast.df$Delta1 < snpblast.df$Delta2]);

write.csv(snpblast.df, "", row.names = FALSE);


# centroid balls
library(graphics)
library(plotrix)
#
# color transparent darkgreen
cov.color <- rgb(0,100,0, maxColorValue = 255, alpha = 25)
#
# select round in time series
for (d in 1:48){
    #d <- 48 # debug
    message(sprintf("loop %s of %s", d, 48))
    #
    #png(filename = paste("/home/eric/Downloads/Desktop/data/mex/covid-amlo/graph/nytPosCum", d, ".png", sep = ""), width = 20, height = 20, units = "cm", res = 196)
    pdf(file = paste("/home/eric/Downloads/Desktop/data/mex/covid-amlo/graph/nytPosCum", d, ".pdf", sep = ""), width = 10, height = 7)
    par(mar = c(0,0,0,0))
    plot(shave(nat.map, p = .95), lwd = .5, border = "gray")
    title("La punta del iceberg", line = -2)
    title(paste("Pruebas positivas, ingreso a clínica hasta el", dates[d]), line = -3, cex.main = .85)
    tmp.ranges <- par("usr") # keep calculated xy ranges to compute ball radius
    radius.base <- (tmp.ranges[2] - tmp.ranges[1]) / 500 # relative radius
    ## # draw municipal borders
    ## for (i in 1:32){
    ##     plot(mu.map[[i]], lwd = .25, border = "lightgray", add = TRUE)
    ## }
    plot(nat.map, lwd = .5,          border = "darkgray", add = TRUE)
    plot(nat.map, lwd = .5, lty = 3, border = "white", add = TRUE)
    for (i in 1:32){
        #i <- 9 # debug
        #plot(nat.map[nat.map@data$ENT==i,])                                         # debug
        #tmp.ranges <- par("usr") # keep calculated xy ranges to compute ball radius # debug
        #radius.base <- (tmp.ranges[2] - tmp.ranges[1]) / 500 # relative radius      # debug
        sel.col <- which(sub("V([0-9]+)", "\\1", colnames(mu.map[[i]]@data))==d)
        rad <- radius.base * mu.map[[i]]@data[,sel.col]^.5
        rad[rad==0] <- NA # don't draw zeroes
        #rad <- log(rad, base = 10) # log scale
        for (j in 1:nrow(mu.map[[i]])){
            draw.circle(x = coordinates(mu.map[[i]])[j,1],    y = coordinates(mu.map[[i]])[j,2], radius = rad[j],
                        border = "darkgreen", col = cov.color, lwd = .25)
        }
    }
    # legend
    xl <-  -10400000; yl <- 3000000
    incr <- 150000
    draw.circle(x = xl,    y = yl+2*incr, radius = radius.base * 1^.5,
                border = "darkgreen", col = cov.color, lwd = .5)
    text(xl, yl+2*incr, pos = 4, labels = "1", cex = .75)
    draw.circle(x = xl,    y = yl+incr, radius = radius.base * 10^.5,
                border = "darkgreen", col = cov.color, lwd = .5)
    text(xl, yl+incr, pos = 4, labels = "10", cex = .75)
    draw.circle(x = xl,    y = yl, radius = radius.base * 100^.5,
                border = "darkgreen", col = cov.color, lwd = .5)
    text(xl, yl, pos = NULL, labels = "100", cex = .75)
    ## draw.circle(xl,yl-1.5*incr, radius = radius.base * 1000^.5,
    ##                     border = "darkgreen", col = cov.color, lwd = .5)
    ## text(xl, yl-1.5*incr, pos = NULL, labels = "1000", cex = .75)
    text(xl, yl+2.9*incr, labels = "Casos", font = 2)
    text(-13000000, 1550000, labels = "Preparado con datos del Sistema Nacional de Vigilancia Epidemiológica por Eric Magar (@emagar)", col = "lightgray", pos = 4, cex = .65)
    dev.off()
}

setwd("/home/eric/Dropbox/data/mex/covid-amlo/graph/tmp")
saveHTML({
    par(mar = c(3, 3, 1, 0.5), mgp = c(2, 0.5, 0), tcl = -0.3,
        cex.axis = 0.8, cex.lab = 0.8, cex.main = 1)
    ani.options(interval = 0.05, nmax = 150)
    brownian.motion(pch = 21, cex = 5, col = "red", bg = "yellow")
}, img.name = "brownian_motion_b", htmlfile = "index.html", navigator = FALSE,
description = c("Random walk of 10 points on the 2D plane",
                "(without the navigation panel)"))


#!/usr/bin/env Rscript

### Read a CosmoSIS standard output file for a grid sampler, and
### generate a series of 1- and 2-dimensional likelihood density plots.

suppressPackageStartupMessages(library("optparse"))
suppressPackageStartupMessages(library("lattice"))
suppressPackageStartupMessages(library("doBy"))

### Create a dataframe from CosmoSIS grid sampler output. We expect the
### first line of the output to contain the names of the parameters,
### separated by spaces, and with section names separated from parameter
### names by a double-hyphen.

make.data.frame <- function(fname)
{
  d <- read.table(fname)
  first <- readLines(fname, n=1)
  first <- sub("#", "", first)          # Remove comment
  parts <- strsplit(first, "\t")[[1]]   # split on tabs
  cols <- sub("[a-zA-Z_]+--", "", parts) # remove leading section names

  names(d) <- cols
  likes <- exp(d$LIKE)
  norm <- sum(likes)
  d$l <- likes/norm
  return(d)
}

# Make a 1-d posterior density plot for each variable in the dataframe.
# We use bw="nrd", which gives a bandwidth calculation according to:
#    Scott, D. W. (1992) Multivariate Density Estimation: Theory, Practice, and
#    Visualization. Wiley.
make.1d.density.plots <- function(df, prefix, output, device, verbose)
{
  cols <- Filter(function(n) { ! n %in% c("l","LIKE") }, names(dframe))
  for(col in cols)
  {
    if (verbose) cat("Making 1-d density plot for", col, "\n")
    form <- as.formula(paste("l~", col, sep=""))
    df.summary <- summaryBy(form, data = df, FUN=sum)
    names(df.summary)[2] <- "l" # Replace ugly name generated by summaryBy
    dev.fcn <- get(device)
    filename <- file.path(output, paste(prefix, "_", col, ".", device, sep=""))
    p1 <- xyplot( form
                , df.summary
                , type="l"
                , lwd=2
                , ylab = "likelihood"
                , grid = TRUE
                )
    dev.fcn(filename)
    print(p1)
    invisible(dev.off())
  }
}

# Return the likelihood values corresponding to the boundary of the
# regions containing the probability contents 'levels'.
find.contours <- function(df, levels = c(0.68, 0.95))
{
  probs.sorted <- sort(df$l, decreasing=TRUE)
  probs.cs <- cumsum(probs.sorted)
  # Get the indices of the first values greater than the given confidence levels.
  indices <- sapply( levels
                   , function(x) which(probs.cs>x)[1]
                   )
  probs.sorted[indices]
}

## vmat2df will convert the kind of list returned by kde2d (containing two)
## vectors and a matrix, named x, y and z) into a dataframe with columns
## x, y, z.
#vmat2df <- function(u)
#{
#  g = expand.grid(u$x, u$y)
#  data.frame( x = g$Var1, y = g$Var2, z = as.numeric(u$z))
#}

# Make a 2-d density plot of  xcol vs. ycol, using data from df.
make.2d.density.plot <- function( df, xcol, ycol, prefix, output, device
                                , use.color
                                )
{
  form <- as.formula(paste("l~", xcol, "+", ycol, sep=""))
  df.summary <- summaryBy(form, data = df, FUN = sum)
  names(df.summary)[3] <- "l" # replace the ugly name given by summaryBy

  # Find the values of z which correspond to the given confidence levels.
  conf.levels = c(0.68, 0.95)
  zvals = find.contours(df.summary, conf.levels)

  dev.fcn <- get(device)
  filename <- file.path( output
                       , paste(prefix, "_", xcol, "_", ycol, ".", device, sep=""))
  levels <- c(0, zvals, 1)
  labels <- as.character(c(0, conf.levels, 1))
  form <- as.formula(paste("l~", xcol, "*", ycol, sep=""))
  p <- contourplot( form, df.summary, at=levels, labels=labels
                  , panel=function(...){panel.grid(-1,-1); panel.contourplot(...)}
                  , xlab = xcol
                  , ylab = ycol
                  , region = use.color
                  , lwd=2
                  , col.regions = function(n,a) rev(terrain.colors(n,a))
                  , colorkey = FALSE
                  )
  dev.fcn(filename)
  print(p)
  invisible(dev.off())
}

# For each pair, generate the kde2d result matrix.
# Determine the values of z at which the 68% and 95% contour lines lie.
# Transform the matrix to a dataframe.
# Make the contour plot.

make.2d.density.plots <- function(df, prefix, output, device, verbose, use.color)
{
  if (verbose) cat("Making 2-d density plots\n")
  # Go through all pairs of interesting variables (all but 'LIKE' and 'l',
  # the last two columns).
  n.interesting <- ncol(df)-2
  cols <- names(df)[1:n.interesting]
  pairs <- combn(cols, 2, simplify=FALSE)
  for(pair in pairs)
  {
    xcol <- pair[[1]]
    ycol <- pair[[2]]
    if (verbose) cat("Making 2-d density plot of", xcol, "vs.", ycol, "\n")
    make.2d.density.plot(df, xcol, ycol, prefix, output, device, use.color)
  }

}

################################################################################
###
### Start of the main program.

option_list <-
  list( make_option( c("-v", "--verbose")
                   , action="store_true"
                   , default = FALSE
                   , help = "Print extra output [%default]"
                   )
      , make_option( c("-p", "--prefix")
                   , default="plot"
                   , type="character"
                   , help="Prefix for all output files"
                   )
      , make_option( c("-o", "--output")
                   , default="."
                   , type="character"
                   , help="Directory for all output files"
                   )
      , make_option( c("-d", "--device")
                   , default="png"
                   , type="character"
                   , help="Graphics device for plots: png or pdf"
                   )
      , make_option( c("-f", "--fill")
                   , action="store_true"
                   , default=FALSE
                   , help="Color regions in 2-d density plots"
                   )
      , make_option( c("-b", "--burn")
                   , default = 0
                   , type="integer"
                   , help="Number of burn-in samples to ignore [%default]"
                   )
      )

parser <- OptionParser(option_list=option_list, usage="%prog [options] infile")
args   <- parse_args(parser, positional_arguments = TRUE)
opt    <- args$options

if (length(args$args) != 1)
{
  cat("Incorrect number of required arguments\n\n")
  print_help(parser)
  stop()
}

input.file <- as.character(args$args)
if (file.exists(input.file) == FALSE )
{
  cat("Unable to open input file", input.file, "\n")
  stop()
}

if (opt$output != ".")
  if (! file.exists(opt$output))
    dir.create(opt$output, recursive=TRUE)

opt$device <- tolower(opt$device)

if (opt$device %in% c("png", "pdf") == FALSE)
{
  cat("Device", opt$device, "is not supported, using png\n")
  opt$device <- "png"
}

if (opt$verbose)
   cat("Processing file", input.file, "\n")

dframe = make.data.frame(input.file)
make.1d.density.plots(dframe, opt$prefix, opt$output, opt$device, opt$verbose)
if (length(dframe) > 3)
  make.2d.density.plots(dframe, opt$prefix, opt$output, opt$device, opt$verbose, opt$fill)


#########################################################################################
#                                                                                #
#   Copyright (c)   A_B_Life 2011                                                       #
#   Writer:         Chrevan Chen <dongchen@ablife.cc>                                   #
#   Program Date:   2011.9.7                                                            #
#   Modifier:       Chrevan Chen <dongchen@ablife.cc>                                   #
#   Last Modified:  2011.9.16                                                           #
#   This script is used for plotting Pie chart                                          #
#                                                                                #
#########################################################################################

args <- commandArgs(trailingOnly = TRUE)	#get the arguments from the command line
outdir <- args[1]
fileNumber <- args[2]

data <- read.table(file = fileNumber,header=F)
digit <- data[,2]		# The number of each part,we can read them from a file
sum <- sum(digit)			# The sum number of each part
digit <- digit/sum			# The percent
label <- data[,1]	# Label of each part
col <- c('#4682B4','#FF8C00','#A0522D','#87CEEB','#6B8E23','#6A5ACD','#778899','#DAA520','#B22222')
percent <- format(digit*100,digit=2)			# record the first three digit of each percent
percent <- paste(percent,'%',sep='')			# Add the symbol "%"
percent <- paste(label,percent,sep=':')			# Add the symbol "%"
#pdf('Rplot_Pie_Chart.pdf', width = 9, height = 6)
png(file=paste(outdir,'/',fileNumber,'_Pie_Chart.png',sep=''),pointsize=20,width=900,height=600)
par(mar = c(2.1,3.1,3.1,3.1))
#pie(digit,main=fileNumber,labels=percent,edges=400,radius=0.6,col=rainbow(length(digit)),col.lab='blue',font.lab=3,cex.main=2.5,lwd=3)
pie(digit,main=fileNumber,labels=percent,edges=400,radius=0.8,col=col[1:length(digit)],col.lab='blue',font.lab=3,cex.main=2,lwd=3,cex=1.2)
#legend(x='bottomleft',legend=label,col=rainbow(length(digit)),bty='n',text.col=rainbow(length(digit)),pch=15,cex=1)
#dev.off()
#density=1,angle = 45,cex.lab=3,,cex.axis=2,


  grid.logbook = function(x, res) {

    logbook.gridded = grid_lonlat (x, res=res)
    logbook.gridded$gridid = paste(logbook.gridded$lat, logbook.gridded$lon, logbook.gridded$year, sep="~")

    v = "pro_rated_slip_wt_lbs"
      x = logbook.gridded[is.finite(logbook.gridded[,v]),]
      grid = as.data.frame(xtabs( as.integer(x[,v]) ~ as.factor(x[,"gridid"]), exclude="" ))
      names(grid) = c("gridid", "landings")
      grid$landings = grid$landings * 0.45359237  # convert to kg

    v = "num_of_traps"
      x = logbook.gridded[is.finite(logbook.gridded[,v]),]
      effort = as.data.frame(xtabs( as.integer(x[,v]) ~ as.factor(x[,"gridid"]), exclude="" ))
      names(effort) = c("gridid", "notraps")

    grid = merge(grid, effort, by="gridid", all=T, sort=F)
    grid$cpue = grid$landings / grid$notraps

    tmp = matrix(unlist(strsplit(as.character(grid$gridid), "~")), ncol=3, byrow=T)
    grid$lat = as.numeric(tmp[,1])
    grid$lon = as.numeric(tmp[,2])
    grid$yr = as.numeric(tmp[,3])

#    grid = grid[is.finite(grid$yr),]

    return(grid)
  }


#' @export
#' @title legend.bubble
#' @description couldn't accurately describe
#' @param \code{x}
#' @param \code{y} defaults to NULL
#' @param \code{maxradius}  defaults to 1
#' @param \code{n} defaults to 3
#' @param \code{round} defaults to 0
#' @param \code{bty} defaults to "o"
#' @param \code{mab} defaults to 1.2
#' @param \code{bg} defaults to NULL
#' @param \code{inset} defaults to 0
#' @param \code{pch} defaults to 21
#' @param \code{pt.bg} defaults to NULL
#' @param \code{txt.cex} defaults to 1
#' @param \code{txt.col} defaults to NULL
#' @param \code{font} defaults to NULL
#' @family  plotting
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
legend.bubble  <- function (x, y = NULL, z, maxradius = 1, n = 3, round = 0, bty = "o",
                            mab = 1.2, bg = NULL, inset = 0, pch = 21, pt.bg = NULL,
                            txt.cex = 1, txt.col = NULL, font = NULL, ...)
{
  if (length(z) == 1)
    legend <- round((seq(0, sqrt(z), length.out = n + 1)^2)[-1],
                    round)
  else legend <- round(sort(z), round)
  radius <- maxradius * sqrt(legend)/sqrt(max(legend))
  cex <- 2 * radius/par("cxy")[2]/0.375
  box <- legend.box(x, y, maxradius, mab, inset)
  if (bty == "o")
    rect(box[1], box[2], box[3], box[4], col = bg)
  x <- (box[1] + box[3])/2
  y <- box[2] - mab * maxradius + maxradius
  for (i in length(radius):1) {
    ri <- radius[i]
    cex <- 2 * ri/par("cxy")[2]/0.375
    points(x, y - ri, cex = cex, pch = pch, bg = pt.bg, ...)
    text(x, y - ri * 2, legend[i], adj = c(0.5, -0.5), cex = txt.cex,
         col = txt.col, font = font)
  }
}


###VISUALISE MODEL OUTPUTS###
library(tidyverse)
library(ggpubr)
library(kableExtra)
library(magick)

folder <- dirname(rstudioapi::getSourceEditorContext()$path)

####################SUPPLY-DEMAND METRICS
folder <- dirname(rstudioapi::getSourceEditorContext()$path)

data <- read.csv(file.path(folder, '..', 'results', 'decile_mno_results_technology_options.csv'))

names(data)[names(data) == 'GID_0'] <- 'country'

#select desired columns
data <- select(data, country, scenario, strategy, confidence, decile, #population, area_km2,
               population_km2, total_estimated_sites, existing_mno_sites,
               total_estimated_sites_km2, existing_mno_sites_km2,
               phone_density_on_network_km2, sp_density_on_network_km2,
               total_mno_revenue, total_mno_cost, cost_per_network_user,
               # cost_per_sp_user
)

data <- data[(data$confidence == 50),]

data$combined <- paste(data$country, data$scenario, sep="_")

data$country = factor(data$country, levels=c('MWI',
                                             "UGA",
                                             "SEN",
                                             "KEN",
                                             "PAK",
                                             "ALB",
                                             "PER",
                                             "MEX"),
                      labels=c("Malawi","Uganda",
                               "Senegal","Kenya",
                               "Pakistan",
                               "Albania",
                               "Peru",
                               "Mexico"))

demand = data[(
  data$scenario == 'S1_25_10_2' &
    data$strategy == '4G_epc_fiber_baseline_baseline_baseline_baseline'
),]

demand <- select(demand, country, decile, population_km2,
                 phone_density_on_network_km2,
                 sp_density_on_network_km2)

demand <- gather(demand, metric, value, population_km2:sp_density_on_network_km2)

demand$metric = factor(demand$metric,
                       levels=c("population_km2",
                                "phone_density_on_network_km2",
                                "sp_density_on_network_km2"),
                       labels=c("Population Density",
                                "Modeled Network Phone Density",
                                "Modeled Network Smartphone Density"))

demand_densities <- ggplot(demand, aes(x=decile, y=value, colour=metric, group=metric)) +
  geom_line() +
  scale_fill_brewer(palette="Spectral", name = expression('Cost Type'), direction=1) +
  theme( legend.position = "bottom", axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(colour=NULL,
       title = "Demand-Side Density Metrics by Population Decile",
       # subtitle = "Population and user densities",
       x = "Population Decile", y = "Density (per km^2)") +
  scale_x_continuous(expand = c(0, 0.5), breaks = seq(0,100,20)) +
  scale_y_continuous(expand = c(0, 0)) + #, limits = c(0,20)) +
  theme(panel.spacing = unit(0.6, "lines")) + expand_limits(y=0) +
  guides(colour=guide_legend(ncol=3)) +
  facet_wrap(~country, scales = "free", ncol=4)

supply = data[(
  data$scenario == 'S1_25_10_2' &
    data$strategy == '4G_epc_fiber_baseline_baseline_baseline_baseline'
),]

supply <- select(supply, country, decile, total_estimated_sites_km2, existing_mno_sites_km2)

supply <- gather(supply, metric, value, total_estimated_sites_km2:existing_mno_sites_km2)

supply$metric = factor(supply$metric,
                       levels=c("total_estimated_sites_km2",
                                "existing_mno_sites_km2"),
                       labels=c("Total Site Density",
                                "Modeled Network Site Density"))

supply_densities <- ggplot(supply, aes(x=decile, y=value, colour=metric, group=metric)) +
  geom_line() +
  scale_fill_brewer(palette="Spectral", name = expression('Cost Type'), direction=1) +
  theme( legend.position = "bottom", axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(colour=NULL,
       title = "Supply-Side Density Metrics by Population Decile",
       x = "Population decile", y = "Density (per km^2)") +
  scale_x_continuous(expand = c(0, 0.5), breaks = seq(0,100,20)) +
  scale_y_continuous(expand = c(0, 0)) + #, limits = c(0,20)) +
  theme(panel.spacing = unit(0.6, "lines")) + expand_limits(y=0) +
  guides(colour=guide_legend(ncol=3)) +
  facet_wrap(~country, scales = "free", ncol=4)

demand_supply <- ggarrange(demand_densities, supply_densities,
                           ncol = 1, nrow = 2, align = c("hv"))

#export to folder
path = file.path(folder, 'figures_tables', 'a_demand_supply_panel.png')
ggsave(path,  units="in", width=8, height=9, dpi=300)
print(demand_supply)
dev.off()

################################
#technology
data_tech <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_technology_options.csv'))
data_tech <- select(data_tech, GID_0, scenario, strategy, confidence, societal_cost)
data_tech$societal_cost = round(data_tech$societal_cost/1e9,2)
data_tech <- data_tech[(data_tech$confidence == 50),]

baseline <- data_tech %>%
  filter(str_detect(strategy, "_baseline_baseline_baseline_baseline")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
baseline$strategy_summary = 'baseline'

#business model
data_bus_mod <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_business_model_options.csv'))
data_bus_mod <- select(data_bus_mod, GID_0, scenario, strategy, confidence, societal_cost)
data_bus_mod <- data_bus_mod[(data_bus_mod$confidence == 50),]

passive <- data_bus_mod %>%
  filter(str_detect(strategy, "_passive_baseline_baseline_baseline")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
passive$strategy_summary = 'passive'

active <- data_bus_mod %>%
  filter(str_detect(strategy, "_active_baseline_baseline_baseline")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
active$strategy_summary = 'active'

srn <- data_bus_mod %>%
  filter(str_detect(strategy, "_srn_baseline_baseline_baseline")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
srn$strategy_summary = 'srn'

#policy options
data_policy <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_policy_options.csv'))
data_policy <- select(data_policy, GID_0, scenario, strategy, confidence, societal_cost)
data_policy <- data_policy[(data_policy$confidence == 50),]

spectrum_low <- data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_low_baseline")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
spectrum_low$strategy_summary = 'spectrum_low'

spectrum_high <- data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_high_baseline")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
spectrum_high$strategy_summary = 'spectrum_high'

tax_low <- data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_baseline_low")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
tax_low$strategy_summary = 'tax_low'

tax_high <- data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_baseline_high")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
tax_high$strategy_summary = 'tax_high'

#Mixed options
data_mixed <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_mixed_options.csv'))
data_mixed <- data_mixed[(data_mixed$confidence == 50),]
data_mixed <- select(data_mixed, GID_0, scenario, strategy, confidence, societal_cost)

mixed <- data_mixed %>%
  filter(str_detect(strategy, "_srn_baseline_low_low")) %>%
  group_by(GID_0, scenario) %>%
  filter(societal_cost == min(societal_cost))
mixed$strategy_summary = 'mixed'

####################
#Aggregate results
results = rbind(baseline, passive, active, srn,
                spectrum_low, spectrum_high,
                tax_low, tax_high, mixed)

results$tech = sapply(strsplit(results$strategy, "_"), "[", 1)
results$backhaul = sapply(strsplit(results$strategy, "_"), "[", 3)

rm(data_tech, data_bus_mod, data_policy, baseline, passive, active, srn,
   spectrum_low, spectrum_high, tax_low, tax_high)

results$GID_0 = factor(results$GID_0,
               levels=c('MWI', 'UGA', 'SEN', 'KEN', 'PAK', 'ALB', 'PER', 'MEX'),
               labels=c('Malawi', 'Uganda', 'Senegal', 'Kenya', 'Pakistan', 'Albania', 'Peru', 'Mexico'))

results$scenario = factor(results$scenario, levels=c("S1_25_10_2",
                                                     "S2_200_50_5",
                                                     "S3_400_100_10"),
                          labels=c("S1 (<25 Mbps)",
                                   "S2 (<200 Mbps)",
                                   "S3 (<400 Mbps)"))

results = with(results, results[order(GID_0, scenario, strategy_summary),])

results$tech_strategy = with(results, paste0(tech, '_', backhaul))
results$tech_strategy[results$tech_strategy == '4G_microwave'] <- '4G (W)'
results$tech_strategy[results$tech_strategy == '5G_microwave'] <- '5G NSA (W)'

results = select(results, GID_0, scenario, strategy_summary, tech_strategy)

results$strategy_summary = as.factor(results$strategy_summary)
results$tech_strategy = as.factor(results$tech_strategy)

path = file.path(folder, 'vis_results', 'a_cheapest_strategies.csv')
write.csv(results, path, row.names=FALSE)

names(results)[names(results)=="GID_0"] <- "Country"
names(results)[names(results)=="scenario"] <- "Scenario"

results = results %>%
  pivot_wider(names_from = strategy_summary, values_from = tech_strategy)

results = results %>%
  mutate(baseline = cell_spec(baseline, "html",
    color=ifelse(grepl("4G (W)", baseline, fixed = T), "blue", "black"))) %>%
  mutate(passive = cell_spec(passive, "html",
    color=ifelse(grepl("4G (W)", passive, fixed = T), "blue", "black"))) %>%
  mutate(active = cell_spec(active, "html",
     color=ifelse(grepl("4G (W)", active, fixed = T), "blue", "black"))) %>%
  mutate(srn = cell_spec(srn, "html",
     color=ifelse(grepl("4G (W)", srn, fixed = T), "blue", "black"))) %>%
  mutate(spectrum_low = cell_spec(spectrum_low, "html",
     color=ifelse(grepl("4G (W)", spectrum_low, fixed = T), "blue", "black"))) %>%
  mutate(spectrum_high = cell_spec(spectrum_high, "html",
     color=ifelse(grepl("4G (W)", spectrum_high, fixed = T), "blue", "black"))) %>%
  mutate(tax_low = cell_spec(tax_low, "html",
     color=ifelse(grepl("4G (W)", tax_low, fixed = T), "blue", "black"))) %>%
  mutate(tax_high = cell_spec(tax_high, "html",
     color=ifelse(grepl("4G (W)", tax_high, fixed = T), "blue", "black"))) %>%
  mutate(mixed = cell_spec(mixed, "html",
     color=ifelse(grepl("4G (W)", mixed, fixed = T), "blue", "black")))

results = select(results, Country, Scenario, baseline, passive, active, srn,
                 spectrum_low, spectrum_high, tax_low, tax_high, mixed)

names(results)[names(results)=="baseline"] <- "Baseline"
names(results)[names(results)=="passive"] <- "Passive"
names(results)[names(results)=="active"] <- "Active"
names(results)[names(results)=="srn"] <- "SRN"
names(results)[names(results)=="spectrum_low"] <- "Low P."
names(results)[names(results)=="spectrum_high"] <- "High P."
names(results)[names(results)=="tax_low"] <- "Low T."
names(results)[names(results)=="tax_high"] <- "High T."
names(results)[names(results)=="mixed"] <- "Lowest"

results = kable(results, "html", escape = F,
  caption = "Least (Financial) Cost Technology for Universal Coverage") %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  add_header_above(
    c(" "= 3,
      "Infrastructure Sharing" = 3,
      "Spectrum Pricing" = 2,
      "Taxation" = 2,
      "Hybrid" = 1))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(results, file = 'b_best_performing_technology.png', zoom = 1.5)

#################
#Financial Cost = MNO cost + govt cost
folder <- dirname(rstudioapi::getSourceEditorContext()$path)

#technology
data_tech <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_technology_options.csv'))
data_tech <- data_tech[(data_tech$confidence == 50),]

data_tech$strategy_summary = 'baseline'
data_tech$strategy <- as.character(data_tech$strategy)
data_tech$tech = sapply(strsplit(data_tech$strategy, "_"), "[", 1)
data_tech$core = sapply(strsplit(data_tech$strategy, "_"), "[", 2)
data_tech$backhaul = sapply(strsplit(data_tech$strategy, "_"), "[", 3)

data_tech = data_tech[!(data_tech$backhaul == 'fiber' & data_tech$core == "nsa"), ]
data_tech = data_tech[!(data_tech$backhaul == 'microwave' & data_tech$core == "sa"), ]

data_tech$tech = NULL
data_tech$core = NULL
data_tech$backhaul = NULL

#bus_mod
data_bus_mod <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_business_model_options.csv'))
data_bus_mod <- data_bus_mod[(data_bus_mod$confidence == 50),]

data_bus_mod$strategy <- as.character(data_bus_mod$strategy)

data_bus_mod$strategy_summary = sapply(strsplit(data_bus_mod$strategy, "_"), "[", 4)

data_bus_mod = data_bus_mod[!(data_bus_mod$strategy_summary == 'baseline'), ]

#policy
data_policy <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_policy_options.csv'))
data_policy <- data_policy[(data_policy$confidence == 50),]

spectrum_low = data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_low_baseline"))
spectrum_low$strategy_summary = 'spectrum_low'

spectrum_high = data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_high_baseline"))
spectrum_high$strategy_summary = 'spectrum_high'

tax_low = data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_baseline_low"))
tax_low$strategy_summary = 'tax_low'

tax_high = data_policy %>%
  filter(str_detect(strategy, "baseline_baseline_baseline_high"))
tax_high$strategy_summary = 'tax_high'

#mixed
data_mixed <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_mixed_options.csv'))
data_mixed <- data_mixed[(data_mixed$confidence == 50),]

data_mixed$strategy <- as.character(data_mixed$strategy)

data_mixed$strategy_summary = 'mixed'

data_mixed = data_mixed[!(data_mixed$strategy_summary == 'baseline'), ]

#combine
results = rbind(data_tech, data_bus_mod, data_mixed,
                spectrum_low, spectrum_high,
                tax_low, tax_high)

results$strategy = as.character(results$strategy)
results$tech = sapply(strsplit(results$strategy, "_"), "[", 1)
results$core = sapply(strsplit(results$strategy, "_"), "[", 2)
results$backhaul = sapply(strsplit(results$strategy, "_"), "[", 3)

results = results[!(results$backhaul == 'fiber' & results$core == "nsa"), ]
results = results[!(results$backhaul == 'microwave' & results$core == "sa"), ]

results$tech_strategy = with(results, paste0(
  tech, '_', core, '_',backhaul))

rm(data_tech, data_bus_mod, data_policy, data_revenue,
   spectrum_low, spectrum_high, tax_low, tax_high)

results = select(results, GID_0, scenario, tech_strategy, strategy_summary,
                 societal_cost, private_cost, government_cost,
)

results$private_cost = signif(results$private_cost/1e9, 2)
results$government_cost = signif(results$government_cost/1e9, 2)
results$societal_cost = signif(results$societal_cost/1e9, 2)

results$GID_0 = factor(results$GID_0,
                       levels=c('MWI', 'UGA', 'SEN', 'KEN', 'PAK', 'ALB', 'PER', 'MEX'),
                       labels=c('Malawi', 'Uganda', 'Senegal', 'Kenya', 'Pakistan', 'Albania', 'Peru', 'Mexico'))
results$strategy_summary = factor(results$strategy_summary,
                                  levels=c('baseline', 'passive', 'active', 'srn',
                                           'spectrum_low', 'spectrum_high', 'tax_low', 'tax_high', 'mixed'),
                                  labels = c('Baseline', 'Passive', 'Active', 'SRN',
                                             'Low P.', 'High P.', 'Low T.', 'High T.', 'Mixed'))
results$scenario = factor(results$scenario, levels=c("S1_25_10_2",
                                                     "S2_200_50_5",
                                                     "S3_400_100_10"),
                          labels=c("S1 (<25 Mbps)",
                                   "S2 (<200 Mbps)",
                                   "S3 (<400 Mbps)"))
results$tech_strategy = factor(results$tech_strategy,
                               levels=c('4G_epc_microwave', '4G_epc_fiber',
                                        '5G_nsa_microwave', '5G_sa_fiber'),
                               labels=c('4G (W)', '4G (F)', '5G NSA (W)', '5G SA (F)'))

names(results)[names(results)=="GID_0"] <- "Country"
names(results)[names(results)=="scenario"] <- "Scenario"
names(results)[names(results)=="tech_strategy"] <- "Strategy"

path = file.path(folder, 'vis_results', 'societal_costs.csv')
write.csv(results, path, row.names=FALSE)

#######################################
results_wide <- gather(results, Metric, value, societal_cost:government_cost)

results_wide = results_wide %>%
  pivot_wider(names_from = strategy_summary, values_from = value)

results_wide = select(results_wide, Country, Scenario, Strategy, Metric, Baseline)

results_wide = results_wide %>%
  pivot_wider(names_from = Country, values_from = Baseline)

results_wide = with(results_wide, results_wide[order(Scenario, Strategy, Metric),])

results_wide$Metric = factor(results_wide$Metric,
       levels=c('private_cost', 'government_cost', 'societal_cost'),
       labels=c('Private Cost ($Bn)', 'Government Cost ($Bn)','Financial Cost ($Bn)'))

results_wide = select(results_wide, Scenario, Strategy, Metric,
              Malawi, Uganda, Senegal, Kenya, Pakistan, Albania, Peru, Mexico)

cb <- function(x) {
  range <- max(abs(x))
  width <- round(abs(x / range * 50), 2)
  ifelse(
    x > 0,
    paste0(
      '', x, ''
    ),
    paste0(
      '', x, ''
    )
  )
}

table1 = results_wide %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F, caption = 'Full Technology Results by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 3, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Infrastructure Sharing Strategy: Baseline.",
                      "Spectrum Pricing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 2 s.f."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table1, file='sup_baseline_tech_country_costs.png', zoom = 1.5)

######################################
path = file.path(folder, 'vis_results', 'sup_baseline_tech_country_costs.csv')
write.csv(results_wide, path, row.names=FALSE)

results_wide = results_wide[(results_wide$Metric == 'Financial Cost ($Bn)'),]

table1 = results_wide %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F,
  caption = 'Technology Results reported by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 3, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Infrastructure Sharing Strategy: Baseline.",
                      "Spectrum Pricing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 2 s.f."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table1, file='c_baseline_tech_country_costs.png', zoom = 1.5)

#######################################
results_wide <- gather(results, Metric, value, societal_cost:government_cost)

results_wide = results_wide[(results_wide$Strategy == '5G NSA (W)'),]

results_wide = results_wide[
  (results_wide$strategy_summary == "Baseline" |
     results_wide$strategy_summary == "Passive" |
     results_wide$strategy_summary == "Active" |
     results_wide$strategy_summary == "SRN" ), ]

results_wide = results_wide %>%
  pivot_wider(names_from = Country, values_from = value)

results_wide$Strategy = NULL

names(results_wide)[names(results_wide)=="strategy_summary"] <- "Strategy"

results_wide$Metric = factor(results_wide$Metric,
                             levels=c('private_cost', 'government_cost', 'societal_cost'),
                             labels=c('Private Cost ($Bn)', 'Government Cost ($Bn)','Financial Cost ($Bn)'))

results_wide = with(results_wide, results_wide[order(Scenario, Strategy),])

results_wide = select(results_wide, Scenario, Strategy, Metric,
                      Malawi, Uganda, Senegal, Kenya, Pakistan, Albania, Peru, Mexico)

table2 = results_wide %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F, caption = 'Infrastructure Sharing Results by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 3, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Technology Strategy: 5G NSA with Wireless Backhaul.",
                      "Spectrum Pricing Strategy: Baseline.",
                      "Taxation Strategy: Baseline."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table2, file='sup_infra_sharing_country_costs.png', zoom = 1.5)

path = file.path(folder, 'vis_results', 'sup_infra_sharing_country_costs.csv')
write.csv(results_wide, path, row.names=FALSE)

#######################################
results_wide = results_wide[(results_wide$Metric == 'Financial Cost ($Bn)'),]

table2 = results_wide %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F, caption = 'Infrastructure Sharing Results by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 3, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Technology Strategy: 5G NSA with Wireless Backhaul.",
                      "Spectrum Pricing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 2 s.f."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table2, file='d_infra_sharing_country_costs.png', zoom = 1.5)

###############################
results_wide <- gather(results, Metric, value, societal_cost:government_cost)

results_wide = results_wide[(results_wide$Strategy == '5G NSA (W)'),]

results_wide = results_wide[
  (results_wide$strategy_summary == "Baseline" |
     results_wide$strategy_summary == "Low P." |
     results_wide$strategy_summary == "High P."), ]

results_wide = results_wide %>%
  pivot_wider(names_from = Country, values_from = value)

results_wide$Strategy = NULL

names(results_wide)[names(results_wide)=="strategy_summary"] <- "Strategy"

results_wide$Metric = factor(results_wide$Metric,
                             levels=c('private_cost', 'government_cost', 'societal_cost'),
                             labels=c('Private Cost ($Bn)', 'Government Cost ($Bn)','Financial Cost ($Bn)'))

results_wide$Strategy = factor(results_wide$Strategy,
                               levels=c('Low P.', 'Baseline', 'High P.'),
                               labels=c('Low Prices (-75%)', 'Baseline','High Prices (+100%)'))

results_wide = with(results_wide, results_wide[order(Scenario, Strategy),])

results_wide = select(results_wide, Scenario, Strategy, Metric,
                      Malawi, Uganda, Senegal, Kenya, Pakistan, Albania, Peru, Mexico)

table3 = results_wide %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F, caption = 'Spectrum Pricing Results by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 3, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Technology Strategy: 5G NSA with Wireless Backhaul.",
                      "Infrastructure Sharing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 2 s.f."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table3, file='sup_spectrum_pricing_country_costs.png', zoom = 1.5)

path = file.path(folder, 'vis_results', 'sup_spectrum_pricing_country_costs.csv')
write.csv(results_wide, path, row.names=FALSE)

###############################
folder <- dirname(rstudioapi::getSourceEditorContext()$path)
results_S2 = read.csv(file.path(folder, 'spectrum_ratio.csv'))
results_S2$Scenario = NULL
specify_decimal <- function(x, k) trimws(format(round(x, k), nsmall=k))

results_S2$Pakistan = specify_decimal(results_S2$Pakistan, 1)
results_S2$Albania = specify_decimal(results_S2$Albania, 1)
results_S2$Peru = specify_decimal(results_S2$Peru, 1)
results_S2$Mexico = specify_decimal(results_S2$Mexico, 1)

results_S2$Pakistan = as.numeric(results_S2$Pakistan)
results_S2$Albania = as.numeric(results_S2$Albania)
results_S2$Peru = as.numeric(results_S2$Peru)
results_S2$Mexico = as.numeric(results_S2$Mexico)

table4 = results_S2 %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F, caption = 'Spectrum Pricing Results by Country', digits=1) %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  row_spec(which(results_S2$Malawi >6), bold = T, color = "black", background = "lightgrey") %>%
  add_header_above(
    c(" "= 2, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Scenario: S2 (<200 Mbps).",
                      "Technology Strategy: 5G NSA with Wireless Backhaul.",
                      "Infrastructure Sharing Strategy: Baseline.",
                      "Taxation Strategy: Baseline."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table4, file='d_S2_spectrum_costs_ratio.png', zoom = 1.5)

###################NATIONAL COST PROFILE FOR BASELINE

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
data <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_technology_options.csv'))

data <- data[(data$strategy == "5G_nsa_microwave_baseline_baseline_baseline_baseline"),]
# data <- data[(data$scenario == "S2_200_50_5"),]
data <- data[(data$confidence == 50),]

names(data)[names(data) == 'GID_0'] <- 'country'

data <- select(data, scenario, strategy, country, total_ran:total_market_cost)

data = data %>%
  group_by(scenario, strategy, country) %>%
  mutate(
    perc_ran = total_ran / total_market_cost * 100,
    perc_backhaul = total_backhaul_fronthaul / total_market_cost * 100,
    perc_civils = total_civils / total_market_cost * 100,
    perc_core_network = total_core_network / total_market_cost * 100,
    perc_administration = total_administration / total_market_cost * 100,
    perc_spectrum_cost = total_spectrum_cost / total_market_cost * 100,
    perc_tax = total_tax / total_market_cost * 100,
    perc_profit_margin = total_profit_margin / total_market_cost * 100,
  ) %>%
  select(scenario, strategy, country, perc_ran, perc_backhaul, perc_civils,
         perc_core_network, perc_administration, perc_spectrum_cost,
        perc_tax, perc_profit_margin)

data <- gather(data, metric, value, perc_ran:perc_profit_margin)#ran:profit_margin)#

data$metric = factor(data$metric, levels=c(
  'perc_profit_margin',
  'perc_tax',
  'perc_spectrum_cost',
  'perc_administration',
  'perc_core_network',
  'perc_civils',
  'perc_backhaul',
  'perc_ran'
),
labels=c(
  "Profit",
  "Tax",
  "Spectrum",
  "Administration",
  'Core',
  "Civils",
  "Backhaul",
  "RAN"
))

data$scenario = factor(data$scenario, levels=c("S1_25_10_2",
                                                     "S2_200_50_5",
                                                     "S3_400_100_10"),
                          labels=c("S1 (<25 Mbps)",
                                   "S2 (<200 Mbps)",
                                   "S3 (<400 Mbps)"))

data$country = factor(data$country, levels=c(
  'MEX','PER','ALB','PAK','KEN','SEN','UGA','MWI'
),
labels=c(
  'Mexico','Peru', 'Albania', 'Pakistan', 'Kenya', 'Senegal', 'Uganda','Malawi'
))

table5 <- ggplot(data, aes(x=country, y=(value), group=metric, fill=metric)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  scale_fill_brewer(palette="Spectral", name = NULL, direction=1) +
  theme(legend.position = "bottom", axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(title = "Private Cost Composition for 5G NSA (W) by Country", colour=NULL,
       subtitle = "Baseline Infrastructure Sharing, Spectrum Pricing and Taxation",
       x = NULL, y = "Percentage of Total Private Cost (%)") +
  scale_y_continuous(expand = c(0, 0)) +
  theme(panel.spacing = unit(0.6, "lines")) +
  guides(fill=guide_legend(ncol=8, reverse = TRUE)) +
  facet_wrap(~scenario, scales = "free", ncol=3)

path = file.path(folder, 'figures_tables', 'e_percentage_of_total_private_cost.png')
ggsave(path, units="in", width=7, height=4, dpi=300)
print(table5)
dev.off()

###################
folder <- dirname(rstudioapi::getSourceEditorContext()$path)
data <- read.csv(file.path(folder, '..', 'results', 'national_market_cost_results_all_options.csv'))

data <- data[(data$confidence == 50),]

names(data)[names(data) == 'GID_0'] <- 'country'

data <- select(data, scenario, strategy, country, societal_cost)

baseline <- data %>%
  filter(str_detect(strategy, "5G_nsa_microwave")) %>%
  group_by(country, scenario) %>%
  filter(str_detect(strategy, "baseline_baseline_baseline_baseline"))
baseline$type = 'Baseline ($Bn)'

data <- data %>%
  filter(str_detect(strategy, "5G_nsa_microwave")) %>%
  group_by(country, scenario) %>%
  filter(societal_cost == min(societal_cost))
data$type = 'Lowest ($Bn)'

all_data = rbind(data, baseline)

all_data$country = factor(all_data$country,
 levels=c('MWI', 'UGA', 'SEN', 'KEN', 'PAK', 'ALB', 'PER', 'MEX'),
 labels=c('Malawi', 'Uganda', 'Senegal', 'Kenya',
          'Pakistan', 'Albania', 'Peru', 'Mexico'))

all_data$strategy = NULL

all_data = all_data[!duplicated(all_data[c('scenario', 'country', 'type')]),]

all_data$scenario = factor(all_data$scenario, levels=c("S1_25_10_2",
                                                       "S2_200_50_5",
                                                       "S3_400_100_10"),
                           labels=c("S1 (<25 Mbps)",
                                    "S2 (<200 Mbps)",
                                    "S3 (<400 Mbps)"))

all_data$societal_cost = round(all_data$societal_cost / 1e9, 1)

names(all_data)[names(all_data) == 'scenario'] <- 'Scenario'
names(all_data)[names(all_data) == 'type'] <- 'Strategy'

all_data <- spread(all_data, country, societal_cost)

table6 = all_data %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F, caption = '(A) Financial Cost of Universal Access NPV 2020-2030 by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 2, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Technology Strategy: 5G NSA with Wireless Backhaul.",
                      "Infrastructure Sharing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 1 d.p."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table6, file='f_a_social_cost.png', zoom = 1.5)

###################
folder <- dirname(rstudioapi::getSourceEditorContext()$path)
data_revenue <- read.csv(file.path(folder, '..', 'results', 'national_mno_results_all_options.csv'))
data_revenue <- data_revenue[(data_revenue$confidence == 50),]
data_revenue <- select(data_revenue, GID_0, scenario, strategy, total_mno_revenue)

data <- read.csv(file.path(folder, '..', 'results', 'decile_mno_cost_results_all_options.csv'))
data <- data[(data$confidence == 50),]
data <- data %>% filter(str_detect(strategy, "5G_nsa_microwave"))

data <- select(data, GID_0, scenario, strategy, decile, total_mno_cost, required_state_subsidy)

data <- merge(data, data_revenue, by=c('GID_0', 'strategy', 'scenario'))

data <- data[order(data$GID_0, data$scenario, data$strategy, data$decile),]

#get baseline rows
baseline <- data %>% filter(str_detect(strategy, "baseline_baseline_baseline_baseline"))

baseline <- baseline %>%
  group_by(GID_0, scenario) %>%
  mutate(
    total_mno_revenue = total_mno_revenue/1e9,
    cumulative_cost_bn = cumsum(round(total_mno_cost / 1e9, 3)),
    cumulative_subsidy_bn = cumsum(round(required_state_subsidy / 1e9, 2))
    )
baseline$type = 'Baseline (%)'

problems <- baseline %>%
  group_by(GID_0, strategy, scenario) %>%
  filter(total_mno_revenue <= cumulative_cost_bn) %>%
  filter(decile == min(decile))

baseline <- baseline %>%
  group_by(GID_0, strategy, scenario) %>%
  filter(total_mno_revenue >= cumulative_cost_bn)

#get baseline rows
lowest <- filter(data, !strategy %in% "5G_nsa_microwave_baseline_baseline_baseline_baseline")

lowest <- lowest[order(lowest$GID_0, lowest$scenario, lowest$strategy, lowest$decile),]

lowest <- lowest %>%
  group_by(GID_0, strategy, scenario) %>%
  mutate(
    total_mno_revenue = total_mno_revenue/1e9,
    cumulative_cost_bn = cumsum(round(total_mno_cost / 1e9, 3)),
    cumulative_subsidy_bn = cumsum(round(required_state_subsidy / 1e9, 2))
    )
lowest$type = 'Lowest (%)'

lowest <- lowest %>%
  group_by(GID_0, strategy, scenario) %>%
  filter(total_mno_revenue >= cumulative_cost_bn)

all_data = rbind(lowest, baseline)

subsidy_all = all_data
subsidy_all = rbind(subsidy_all, problems)

all_data <- all_data %>%
  group_by(GID_0, scenario, type) %>%
  filter(decile == max(decile))

all_data = rbind(all_data, problems)

all_data$GID_0 = factor(all_data$GID_0,
                        levels=c('MWI', 'UGA', 'SEN', 'KEN', 'PAK', 'ALB', 'PER', 'MEX'),
                        labels=c('Malawi', 'Uganda', 'Senegal', 'Kenya',
                                 'Pakistan', 'Albania', 'Peru', 'Mexico'))

all_data = select(all_data, scenario, GID_0, decile, type)

all_data = all_data[!duplicated(all_data[c('scenario', 'GID_0', 'type')]),]

all_data$scenario = factor(all_data$scenario, levels=c("S1_25_10_2",
                                                       "S2_200_50_5",
                                                       "S3_400_100_10"),
                           labels=c("S1 (<25 Mbps)",
                                    "S2 (<200 Mbps)",
                                    "S3 (<400 Mbps)"))

names(all_data)[names(all_data) == 'scenario'] <- 'Scenario'
names(all_data)[names(all_data) == 'type'] <- 'Strategy'

all_data <- spread(all_data, GID_0, decile)

all_data[is.na(all_data)] <- 0

cb_inverted <- function(x) {
  range <- max(abs(x))
  width <- round(abs(range / x * 5), 2)
  ifelse(
    x < 100,
    paste0(
      '', x, ''
    ),
    paste0(
      '', x, ''
    )

  )
}

table7 = all_data %>%
  mutate(
    Malawi = cb_inverted(Malawi),
    Uganda = cb_inverted(Uganda),
    Senegal = cb_inverted(Senegal),
    Kenya = cb_inverted(Kenya),
    Pakistan = cb_inverted(Pakistan),
    Albania = cb_inverted(Albania),
    Peru = cb_inverted(Peru),
    Mexico = cb_inverted(Mexico)
  ) %>%
  kable(escape = F, caption = '(B) Commercially Viable Population Coverage by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 2, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Technology Strategy: 5G NSA with Wireless Backhaul.",
                      "Infrastructure Sharing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 1 d.p."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table7, file='f_b_viable_coverage.png', zoom = 1.5)

#########################################
subsidy = ungroup(subsidy_all)

subsidy <- subsidy %>%
  group_by(GID_0, scenario, type) %>%
  filter(decile == max(decile))

subsidy = select(subsidy, scenario, strategy, GID_0, cumulative_subsidy_bn, type)

subsidy$strategy = NULL

subsidy = subsidy[!duplicated(subsidy[c('scenario', 'GID_0', 'type')]),]

subsidy$scenario = factor(subsidy$scenario, levels=c("S1_25_10_2",
                                                       "S2_200_50_5",
                                                       "S3_400_100_10"),
                           labels=c("S1 (<25 Mbps)",
                                    "S2 (<200 Mbps)",
                                    "S3 (<400 Mbps)"))

subsidy$GID_0 = factor(subsidy$GID_0,
                        levels=c('MWI', 'UGA', 'SEN', 'KEN', 'PAK', 'ALB', 'PER', 'MEX'),
                        labels=c('Malawi', 'Uganda', 'Senegal', 'Kenya',
                                 'Pakistan', 'Albania', 'Peru', 'Mexico'))

names(subsidy)[names(subsidy) == 'scenario'] <- 'Scenario'
names(subsidy)[names(subsidy) == 'type'] <- 'Strategy'

subsidy$Strategy[subsidy$Strategy == 'Baseline (%)'] <- "Baseline ($Bn)"
subsidy$Strategy[subsidy$Strategy == 'Lowest (%)'] <- 'Lowest ($Bn)'

# subsidy$required_state_subsidy = round(subsidy$required_state_subsidy / 1e9, 3)

subsidy <- spread(subsidy, GID_0, cumulative_subsidy_bn)

table8 = subsidy %>%
  mutate(
    Malawi = cb(Malawi),
    Uganda = cb(Uganda),
    Senegal = cb(Senegal),
    Kenya = cb(Kenya),
    Pakistan = cb(Pakistan),
    Albania = cb(Albania),
    Peru = cb(Peru),
    Mexico = cb(Mexico)
  ) %>%
  kable(escape = F,
        caption = '(C) Government Subsidy to Reach Universal Access NPV 2020-2030 by Country') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 2, "C1" = 2, "C2" = 2, "C3" = 1, "C4" = 1, "C5" = 1, "C6" = 1)) %>%
  footnote(number = c("Technology Strategy: 5G NSA with Wireless Backhaul.",
                      "Infrastructure Sharing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 1 d.p."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table8, file='f_c_subsidy.png', zoom = 1.5)

##################CLUSTER COSTS
#get folder directory
folder <- dirname(rstudioapi::getSourceEditorContext()$path)

results <- read.csv(file.path(folder, '..', 'results', 'national_market_results_technology_options.csv'))
names(results)[names(results) == 'GID_0'] <- 'iso3'
results$metric = 'Baseline'

#mixed
mixed <- read.csv(file.path(folder, '..', 'results', 'national_market_results_mixed_options.csv'))
names(mixed)[names(mixed) == 'GID_0'] <- 'iso3'
mixed$metric = 'Lowest'

results = rbind(results, mixed)

clusters <- read.csv(file.path(folder, 'clustering', 'results', 'data_clustering_results.csv'))
names(clusters)[names(clusters) == 'ISO_3digit'] <- 'iso3'
clusters <- select(clusters, iso3, cluster, country)

results <- merge(results, clusters, x.by='iso3', y.by='iso3', all=FALSE)

results$cost_per_pop = results$total_market_cost / results$population

mean_pop_cost_by_cluster <- select(results, scenario, strategy, confidence, metric,
                                   cost_per_pop, cluster)

mean_pop_cost_by_cluster <- mean_pop_cost_by_cluster %>%
  group_by(scenario, strategy, confidence, metric, cluster) %>%
  summarise(mean_cost_per_pop = round(mean(cost_per_pop)))

results <- merge(clusters, mean_pop_cost_by_cluster, x.by='cluster', y.by='cluster', all=TRUE)

gdp <- read.csv(file.path(folder, 'gdp.csv'))
names(gdp)[names(gdp) == 'iso3'] <- 'iso3'
gdp <- select(gdp, iso3, gdp, income_group)

results <- merge(results, gdp, by='iso3', all=FALSE)

pop <- read.csv(file.path(folder, 'population_2018.csv'))
pop <- select(pop, iso3, population)
pop$iso3 <- as.character(pop$iso3)

results <- merge(results, pop, by='iso3', all=FALSE)

results$total_market_cost <- results$mean_cost_per_pop * results$population

results <- results[(results$confidence == 50),]

results$scenario = factor(results$scenario, levels=c("S1_25_10_2",
                                                     "S2_200_50_5",
                                                     "S3_400_100_10"),
                          labels=c("S1 (<25 Mbps)",
                                   "S2 (<200 Mbps)",
                                   "S3 (<400 Mbps)"))

results$strategy = factor(results$strategy, levels=c(
  "4G_epc_microwave_baseline_baseline_baseline_baseline",
  "4G_epc_fiber_baseline_baseline_baseline_baseline",
  "5G_nsa_microwave_baseline_baseline_baseline_baseline",
  "5G_sa_fiber_baseline_baseline_baseline_baseline",
  '4G_epc_microwave_srn_baseline_low_low',
  '4G_epc_fiber_srn_baseline_low_low',
  '5G_nsa_microwave_srn_baseline_low_low',
  '5G_sa_fiber_srn_baseline_low_low'
  ),
  labels=c(
    "4G (W)",
    "4G (FB)",
    "5G NSA (W)",
    "5G SA (FB)",
    "4G (W)",
    "4G (FB)",
    "5G NSA (W)",
    "5G SA (FB)"))

results <- results[complete.cases(results),]

# results <- results[(results$confidence == 'mean'),]
results$total_market_cost_dc <- round(results$total_market_cost/1e9, 2)

headline_costs <- select(results, country, scenario, strategy,
                  total_market_cost, gdp, metric)
headline_costs <- spread(headline_costs, metric, total_market_cost)

headline_costs <- headline_costs %>%
  group_by(scenario, strategy) %>%
  summarize(
    `Baseline (US$Tn)` = signif(sum(Baseline)/1e12, 2),
    `Lowest (US$Tn)` = signif(sum(Lowest)/1e12, 2),
    `Baseline (GDP%)` = signif((sum(Baseline)/10) / sum(gdp) * 100, 2),
    `Lowest (GDP%)` = signif((sum(Lowest)/10)/ sum(gdp) * 100, 2)
    )

names(headline_costs)[names(headline_costs)=="strategy"] <- "Strategy"
names(headline_costs)[names(headline_costs)=="scenario"] <- "Scenario"

cb <- function(x) {
  range <- max(abs(x))
  width <- round(abs(x / range * 20), 4)
  ifelse(
    x > 0,
    paste0(
      '', x, ''
    ),
    paste0(
      '', x, ''
    )
  )
}

headline_costs = ungroup(headline_costs)

table4 = headline_costs %>%
  mutate(
    `Baseline (US$Tn)` = cb(`Baseline (US$Tn)`),
    `Lowest (US$Tn)` = cb(`Lowest (US$Tn)`),
    `Baseline (GDP%)` = cb(`Baseline (GDP%)`),
    `Lowest (GDP%)` = cb(`Lowest (GDP%)`),
  ) %>%
  kable(escape = F, caption = 'Technology Cost Results for the Developing World') %>%
  kable_classic("striped", full_width = F, html_font = "Cambria") %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" " = 2,
      "Total Cost" = 2,
      "10-Year GDP Share" = 2
    )) %>%
  footnote(number = c("Infrastructure Sharing Strategy: Baseline.",
                      "Spectrum Pricing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 2 s.f."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table4, file='g_costs_by_income_group.png', zoom = 1.5)

path = file.path(folder, 'vis_results', 'headline_costs.csv')
write.csv(headline_costs, path, row.names=FALSE)

inc_group_costs = results[!(results$income_group == 'HIC'),]

inc_group_costs <- select(inc_group_costs, country, scenario, strategy, metric,
                          income_group, total_market_cost, gdp, population)

inc_group_costs = inc_group_costs %>%
  group_by(scenario, strategy, metric, income_group) %>%
  summarize(
    population = sum(population),
    total_market_cost = sum(total_market_cost),
    gdp = sum(gdp)
  )

inc_group_costs = inc_group_costs %>%
                  gather(econ_metric, value, total_market_cost, gdp)

inc_group_costs$value_dc = round(inc_group_costs$value/1e9, 2)

inc_group_costs$combined <- paste(inc_group_costs$income_group, inc_group_costs$metric, sep="_")

inc_group_costs = ungroup(inc_group_costs)

inc_group_costs <- select(inc_group_costs, scenario, strategy,
                          combined, econ_metric, value, population)

inc_group_costs =  inc_group_costs %>% spread(econ_metric, value)

# path = file.path(folder, 'vis_results', 'test.csv')
# write.csv(inc_group_costs, path, row.names=FALSE)

inc_group_costs <- inc_group_costs %>%
  group_by(scenario, strategy, combined) %>%
  summarize(
    `population` = sum(population),
    `total_cost $USDbn` = (sum(total_market_cost)/1e9),
    `(GDP$Bn)` = round(sum(gdp)/1e9),
    `(GDP%)` = signif((sum(total_market_cost)/10) / sum(gdp) * 100, 2),
  )

# path = file.path(folder, 'vis_results', 'test2.csv')
# write.csv(inc_group_costs, path, row.names=FALSE)

inc_group_costs$combined = factor(inc_group_costs$combined,
                levels=c(
                  'LIC_Baseline',
                  'LIC_Lowest',
                  'LMC_Baseline',
                  'LMC_Lowest',
                  'UMC_Baseline',
                  'UMC_Lowest'
                     ),
                labels=c(
                  'Baseline\nLIC',
                  'Lowest\nLIC',
                  'Baseline\nLMIC',
                  'Lowest\nLMIC',
                  'Baseline\nUMIC',
                  'Lowest\nUMIC'
                ))

inc_group_costs <- select(inc_group_costs, scenario, strategy, combined, `(GDP%)`)

inc_group_costs <- spread(inc_group_costs, combined, `(GDP%)`)

names(inc_group_costs)[names(inc_group_costs)=="strategy"] <- "Strategy"
names(inc_group_costs)[names(inc_group_costs)=="scenario"] <- "Scenario"
inc_group_costs = ungroup(inc_group_costs)

cb <- function(x) {
  range <- max(abs(x))
  width <- round(abs(x / range * 20), 4)
  ifelse(
    x > 0,
    paste0(
      '', x, ''
    ),
    paste0(
      '', x, ''
    )
  )
}

table5 = inc_group_costs %>%
  mutate(
    `Baseline\nLIC` = cb(`Baseline\nLIC`),
    `Lowest\nLIC` = cb(`Lowest\nLIC`),
    `Baseline\nLMIC` = cb(`Baseline\nLMIC`),
    `Lowest\nLMIC` = cb(`Lowest\nLMIC`),
    `Baseline\nUMIC` = cb(`Baseline\nUMIC`),
    `Lowest\nUMIC` = cb(`Lowest\nUMIC`)
  ) %>%
  kable(escape = F, caption = 'Technology Cost Results for the Developing World') %>%
  kable_classic("striped", html_font = "Cambria", full_width = FALSE) %>%
  row_spec(0, align = "c") %>%
  add_header_above(
    c(" "= 2,
      "Low\nIncome\n(10-Year GDP%)" = 2,
      "Lower\nMiddle Income\n(10-Year GDP%)" = 2,
      "Upper\nMiddle Income\n(10-Year GDP%)" = 2
      )) %>%
  footnote(number = c("Infrastructure Sharing Strategy: Baseline.",
                      "Spectrum Pricing Strategy: Baseline.",
                      "Taxation Strategy: Baseline.",
                      "Results rounded to 2 s.f."))

folder <- dirname(rstudioapi::getSourceEditorContext()$path)
path = file.path(folder, 'figures_tables')
setwd(path)
kableExtra::save_kable(table5, file='h_costs_by_income_group.png', zoom = 1.5)

path = file.path(folder, 'vis_results', 'costs_by_income_group.csv')
write.csv(inc_group_costs, path, row.names=FALSE)


#' Plot catch curves for catch
#'
#' Creates catch curves to estimate Z from catch data. Useful???
#' @param asap name of the variable that read in the asap.rdat file
#' @param a1 list file produced by grab.aux.files function
#' @param save.plots save individual plots
#' @param od output directory for plots and csv files
#' @param plotf type of plot to save
#' @param first.age youngest age to use in catch curve, -999 finds peak age (defaults to -999)
#' @export

PlotCatchCurvesForCatch <- function(asap,a1,save.plots,od,plotf,first.age=-999){
  # create catch curve plots for catch by fleet
  usr <- par("usr"); on.exit(par(usr))
  par(oma=c(1,1,1,1),mar=c(4,4,1,0.5))
  cohort <- seq(asap$parms$styr-asap$parms$nages-1, asap$parms$endyr+asap$parms$nages-1)
  ages <- seq(1,asap$parms$nages)
  my.col <- rep(c("blue","red","green","orange","gray50"),50)
  for (ifleet in 1:asap$parms$nfleets){
    if (asap$parms$nfleets == 1) title1 = "Catch"
    if (asap$parms$nfleets >= 2) title1 = paste0("Catch for Fleet ",ifleet)

    # set up full age range matrices
    catch.comp.mat.ob <- matrix(0, nrow=asap$parms$nyears, ncol=asap$parms$nages)
    catch.comp.mat.pr <- matrix(0, nrow=asap$parms$nyears, ncol=asap$parms$nages)

    # determine age range for fleet and fill in appropriate ages
    age1 <- asap$fleet.sel.start.age[ifleet]
    age2 <- asap$fleet.sel.end.age[ifleet]
    catch.comp.mat.ob[,age1:age2] <- asap$catch.comp.mats[[(ifleet*4-3)]]
    catch.comp.mat.pr[,age1:age2] <- asap$catch.comp.mats[[(ifleet*4-2)]]

    # get catch at age
    catchob <- wtprop2caa(asap$catch.obs[ifleet,],  asap$WAA.mats[[(ifleet*2-1)]], catch.comp.mat.ob)
    catchpr <- wtprop2caa(asap$catch.pred[ifleet,], asap$WAA.mats[[(ifleet*2-1)]], catch.comp.mat.pr)

    # replace zeros with NA and take logs
    cob <- rep0log(catchob)
    cpr <- rep0log(catchpr)

    # make cohorts
    cob.coh <- makecohorts(cob)
    cpr.coh <- makecohorts(cpr)

    # drop plus group
    cob.coh[,asap$parms$nages] <- NA
    cpr.coh[,asap$parms$nages] <- NA

    first.age.label <- 1
    if (first.age==1) title1 <- paste0(title1," First Age = 1")

    # determine which ages to use for each cohort (default)
    if (first.age == -999){
      cob.coh <- find_peak_age(cob.coh)
      cpr.coh <- find_peak_age(cpr.coh)
      first.age.label <- "find_peak"
      title1 <- paste0(title1," (Peak Age)")
    }

    # or drop youngest ages based on user control
    if (first.age > 1) {
      cob.coh[,1:(first.age-1)] <- NA
      cpr.coh[,1:(first.age-1)] <- NA
      title1 <- paste0(title1," First Age = ",first.age)
      first.age.label <- first.age
    }

    # compute Z by cohort
    z.ob <- calc_Z_cohort(cob.coh)
    z.pr <- calc_Z_cohort(cpr.coh)

    # make the plots
    par(mfrow=c(2,1))
    plot(cohort,cohort,type='n',ylim=range(c(cob.coh,cpr.coh,0),na.rm=T),xlab="",ylab="Log(Catch)",main=paste0(title1," Observed"))
    for (i in 1:length(cob.coh[,1])){
      lines(seq(cohort[i],cohort[i]+asap$parms$nages-1),cob.coh[i,],type='p',lty=1,pch=seq(1,asap$parms$nages),col="gray50")
      lines(seq(cohort[i],cohort[i]+asap$parms$nages-1),cob.coh[i,],type='l',lty=1,col=my.col[i])
    }

    Hmisc::errbar(cohort,z.ob[,1],z.ob[,3],z.ob[,2],xlab="Year Class",ylab="Z",ylim=range(c(z.ob,z.pr,0),na.rm=T))

    if (save.plots) savePlot(paste0(od,"catch_curve_",title1,"_Observed_first_age_",first.age.label,".",plotf), type=plotf)

    plot(cohort,cohort,type='n',ylim=range(c(cob.coh,cpr.coh,0),na.rm=T),xlab="",ylab="Log(Catch)",main=paste0(title1," Predicted"))
    for (i in 1:length(cob.coh[,1])){
      lines(seq(cohort[i],cohort[i]+asap$parms$nages-1),cpr.coh[i,],type='p',lty=1,pch=seq(1,asap$parms$nages),col="gray50")
      lines(seq(cohort[i],cohort[i]+asap$parms$nages-1),cpr.coh[i,],type='l',lty=1,col=my.col[i])
    }

    Hmisc::errbar(cohort,z.pr[,1],z.pr[,3],z.pr[,2],xlab="Year Class",ylab="Z",ylim=range(c(z.ob,z.pr,0),na.rm=T))

    if (save.plots) savePlot(paste0(od,"catch_curve_",title1,"_Predicted_first_age_",first.age.label,".",plotf), type=plotf)

    # write out .csv files for Z, one file for each fleet
    asap.name <- a1$asap.name

    colnames(z.ob) <-c("Z.obs","low.80%", "high.80%")
    write.csv(z.ob, file=paste0(od,"Z.Ob.Fleet",ifleet,"_",asap.name,".csv"), row.names=cohort)

    colnames(z.pr) <-c("Z.pred","low.80%", "high.80%")
    write.csv(z.pr, file=paste0(od,"Z.Pr.Fleet.",ifleet,"_",asap.name,".csv"), row.names=cohort)

  }
  return()
}


#!/usr/bin/Rscript
library(psycho)  # used for SDT analysis
library(lme4)

# both blocks of flowers/insects
flowerFile <- 'data/flower_E5_old_first.csv'
insectFile <- 'data/insect_E5_old_first.csv'

args <- commandArgs(trailingOnly=T)
if (length(args) < 1) {
    args <- c(flowerFile, insectFile)
}

categoryName <- function(isTarget, isFoil) {
    if (isTarget & isFoil) {
        return('both')
    } else if (isTarget) {
        return('learned')
    } else if (isFoil) {
        return('unlearned')
    } else {
        return('neither')
    }
}

memoryData <- function(filename) {
    # read the raw data from the csv
    data <- subset(read.csv(filename, header=T),
		   task=='test', select=c(subject, isTarget, isFoil, isOld, wasCorrect))

    # count the number of correct/incorrect trials for each condition
    nCorrect <- aggregate(wasCorrect ~ subject + isTarget + isFoil + isOld, data, sum)$wasCorrect
    nIncorrect <- aggregate(wasCorrect ~ subject + isTarget + isFoil + isOld, data,
                            function(x) sum(x==0))$wasCorrect

    # average performance for each subject for each trial type
    data <- aggregate(wasCorrect ~ subject + isTarget + isFoil + isOld, data, mean)
    data$wasIncorrect <- apply(data, 1, function(x) 1-x['wasCorrect']);
    data$nCorrect <- nCorrect
    data$nIncorrect <- nIncorrect

    data$isTarget <- as.numeric(data$isTarget)
    data$isFoil <- as.numeric(data$isFoil)
    data$isOld <- as.numeric(data$isOld)

    # rate is for hits (on old trials) and FAs (on new trials)
    data$rate <- apply(data, 1, function(x) ifelse(x['isOld'], x['wasCorrect'], x['wasIncorrect']))
    data$category <- as.factor(apply(data, 1, function(x) categoryName(x['isTarget'], x['isFoil'])))
    data$subject <- as.factor(data$subject)
    data$isTarget <- as.factor(data$isTarget)
    data$isFoil <- as.factor(data$isFoil)

    return(data)
}

# estimates SDT measures of sensitivity & bias for each subject/condition
runSDT <- function(data) {
    # group the old/new stimuli by subject and condition
    data <- merge(subset(data, isOld==1),
                  subset(data, isOld==0),
                  sort=F,
                  by=c('subject', 'isTarget', 'isFoil'),
                  suffixes=c('.old', '.new'))
    write.csv(data, 'sdt.csv')

    # get sensitivty & bias for each subject on each condition
    indices <- psycho::dprime(data$nCorrect.old, data$nIncorrect.new,
                              data$nIncorrect.old, data$nCorrect.new)
    sdtData <- cbind(data, indices)

    # analyze sensitivity (dprime)
    writeLines('\n\nSensitivity (dprime)')
    print(tapply(sdtData$dprime, list(sdtData$isTarget, sdtData$isFoil), mean))
    print(summary(aov(dprime ~ isTarget * isFoil + Error(subject/(isTarget*isFoil)), data=sdtData)))

    # analyze bias (c)
    writeLines('\n\nBias (C)')
    print(tapply(sdtData$c, list(sdtData$isTarget, sdtData$isFoil), mean))
    print(summary(aov(c ~ isTarget * isFoil + Error(subject/(isTarget*isFoil)), data=sdtData)))

    return(sdtData)
}

analyze <- function(data) {
    # Run the ANOVA as 2x2 (isLearned x isFoil)
    print(tapply(data$rate, list(data$isTarget, data$isFoil), mean))
    print(summary(aov(rate ~ isTarget * isFoil + Error(subject/(isTarget*isFoil)), data=data)))
}

# analyze data from each file
for (i in 1:length(args)) {
    filename <- args[i]
    writeLines(args[i])

    memData <- subset(read.csv(filename, header=T), task=='test' & isOld==0,
                      select=c('subject', 'isTarget', 'isFoil', 'wasCorrect', 'isOld'))
    memData$subject <- factor(memData$subject)
    memData$isTarget <- factor(memData$isTarget)
    memData$isFoil <- factor(memData$isFoil)
    memData$wasCorrect <- factor(memData$wasCorrect)

    print(head(memData))
    model <- glmer(wasCorrect ~ isTarget * isFoil
                   + (1 + isTarget|subject) + (1 + isFoil|subject),
                   data=memData, family=binomial(link='logit'))
    print(summary(model))
    quit()

    #data <- memoryData(filename)
    #hits <- subset(data, isOld==1)
    #FAs  <- subset(data, isOld==0)
    #writeLines('\n\nHits')
    #analyze(hits)
    #writeLines('\n\nFAs')
    #analyze(FAs)

    #sdtData <- runSDT(data)
    #writeLines('\n\n\n\n\n')
    #write.csv(sdtData, 'sdt.csv')
}


library(shiny)

# Rely on the 'WorldPhones' dataset in the datasets
# package (which generally comes preloaded).
library(datasets)

# Define a server for the Shiny app
shinyServer(function(input, output) {

        # Fill in the spot we created for a plot
        output$phonePlot <- renderPlot({

                # Render a barplot
                barplot(WorldPhones[,input$region]*1000,
                        main=input$region,
                        ylab="Number of Telephones",
                        xlab="Year")
        })
})


library(ggplot2)
library(reshape2)
library(cowplot)

figWidth<-10
figHeight<-3
textFont<-10

#epoch === repair tool
#losses  === tech(sbfl and profl)
#Subs == patches (correct, plausible noncorrect)
#model == result.txt

Basedir="./"

Subs<-c("correct","incorrectBUTplau","implausible")

losses<-c("SBFL","ProFL")

model<-"result"

epochs<-c("kPar","ACS","FixMiner","TBar","Dynamoth","Arja","jMutRepair","Simfix","jKali","AVATAR")

Metrics<-c("Top1")

for(sub in Subs){
	plot_list = list()
	count=1
	pdf(paste(c("../../Results/FinalResults/RQ3_",sub,".pdf"),collapse=""), width=figWidth, height=figHeight)

		for(me in Metrics){

			combinemet=cbind(epochs)
			for(loss in losses){
				datafile=paste(Basedir,loss,"/",sub,"/",model,".txt",sep="")
				datamodel<-read.table(datafile,sep = " ")
				colnames(datamodel) <- c("Top1","Top3","Top5","MFR","MAR")
				combinemet=cbind(combinemet,datamodel[,me])
			}
			combinemet=data.frame(combinemet)
			#colnames(combinemet) <- c("epochs","within-project","cross-project","cross-validation")
			colnames(combinemet) <- c("Tool","SBFL","ProFL")
			combinemet <- melt(combinemet, id.vars='Tool')
			colnames(combinemet) <- c("Tool","model","value")
			combinemet$value <- as.numeric(as.character(combinemet$value))
			p<-ggplot(combinemet, aes(x=Tool, y=value, group=model, colour=model,shape=model)) +
				geom_line(aes(linetype=model),size=1.1)+geom_point(size=1.7)+ ylab(me)+theme(text=element_text(size=17))
			plot_list[[count]] = p
			count=count+1

		}

		prow<-plot_grid(plot_list[[1]]+theme(legend.position="none"),
						#plot_list[[2]]+theme(legend.position="none"),
						#plot_list[[3]]+theme(legend.position="none"),
						#plot_list[[4]]+theme(legend.position="none"),
						#plot_list[[5]]+theme(legend.position="none"),
						#nrow = 1, align = 'h',labels = sub)
						nrow = 1, align = 'h')
		legend_b <- get_legend(plot_list[[1]] + theme(legend.position=c(0.13,97),legend.title = element_blank(),
														legend.text = element_text( size = 11)))
		p <- plot_grid( prow, legend_b, ncol = 1, rel_heights = c(1.1, .01))
		print(p)
		dev.off()

}