##############################################################################
# function for running models
##############################################################################
runDNMLogit <- function(data, group){
	models <- list()
	if(group=="COMBINED"){

    # Nested models (1-5)
		models$mod_1mers_n <- glm(OBS~MU_1,
      data=data, family=binomial())
		models$mod_3mers_n <- glm(OBS~MU_1+resid3,
      data=data, family=binomial())
		models$mod_5mers_n <- glm(OBS~MU_1+resid3+resid5,
      data=data, family=binomial())
		models$mod_7mers_n <- glm(OBS~MU_1+resid3+resid5+resid7,
			data=data, family=binomial())
		models$mod_7mers_features_n <- glm(OBS~MU_1+resid3+resid5+resid7+residL,
			data=data, family=binomial())

    # Non-nested models (6-8)
		models$mod_1mers <- glm(OBS~MU_1, data=data, family=binomial())
    models$mod_3mers <- glm(OBS~MU_3, data=data, family=binomial())
		models$mod_5mers <- glm(OBS~MU_5, data=data, family=binomial())

    # Comparison of 7-mer models (9-13)
		models$mod_7mers <- glm(OBS~MU_7, data=data, family=binomial())
    models$mod_7mers_ERVs_down <- glm(OBS~MU_7D, data=data, family=binomial())
    models$mod_7mers_MAC10 <- glm(OBS~MU_7C, data=data, family=binomial())
    models$mod_7mers_AV <- glm(OBS~MU_7A, data=data, family=binomial())
    models$mod_7mers_masked <- glm(OBS~MU_7M, data=data, family=binomial())

    # Non-nested 7-mer+features model (14)
    models$mod_7mers_features <- glm(OBS~MU, data=data, family=binomial())
		models$mod_7mers_adj <- glm(OBS~MU_7adj, data=data, family=binomial())
    models$mod_7mers_anc <- glm(OBS~MU_7AN, data=data, family=binomial())
    # models$mod_7mers_sig <- glm(OBS~MU_7+X1+X2+X3+X4+X5, data=data, family=binomial())
    # models$mod_9mers <- glm(OBS~MU_9, data=data, family=binomial())

		models$mod_int <- glm(OBS~1,
			data=data, family=binomial())

	} else {
    # Nested models (1-4)
		models$mod_3mers_n <- glm(OBS~MU_3,
      data=data, family=binomial())
		models$mod_5mers_n <- glm(OBS~MU_3+resid5,
      data=data, family=binomial())
		models$mod_7mers_n <- glm(OBS~MU_3+resid5+resid7,
			data=data, family=binomial())
		models$mod_7mers_features_n <- glm(OBS~MU_3+resid5+resid7+residL,
			data=data, family=binomial())

    # Non-nested models (5-6)
		models$mod_3mers <- glm(OBS~MU_3, data=data, family=binomial())
		models$mod_5mers <- glm(OBS~MU_5, data=data, family=binomial())

    # Comparison of 7-mer models (7-11)
    models$mod_7mers <- glm(OBS~MU_7, data=data, family=binomial())
    models$mod_7mers_ERVs_down <- glm(OBS~MU_7D, data=data, family=binomial())
    models$mod_7mers_MAC10 <- glm(OBS~MU_7C, data=data, family=binomial())
    models$mod_7mers_AV <- glm(OBS~MU_7A, data=data, family=binomial())
    models$mod_7mers_masked <- glm(OBS~MU_7M, data=data, family=binomial())

    # Non-nested 7-mer+features model (12)
    models$mod_7mers_features <- glm(OBS~MU, data=data, family=binomial())
    models$mod_7mers_anc <- glm(OBS~MU_7AN, data=data, family=binomial())
    # models$mod_7mers_sig <- glm(OBS~MU_7+X1+X2+X3+X4+X5, data=data, family=binomial())
    # models$mod_9mers <- glm(OBS~MU_9, data=data, family=binomial())
	}

  return(models)
}

##############################################################################
# get Nagelkerke's R^2 from model list
##############################################################################
getNR2 <- function(list){
  unlist(lapply(list, function(x)
	  NagelkerkeR2(x)))[seq(2, 2*length(list), by=2)]
}

##############################################################################
# get AIC from model list
##############################################################################
getAIC <- function(list){
  unlist(lapply(list, function(x)
  	AIC(x)))[1:length(list)]
}

##############################################################################
# function for simulating mutation data
##############################################################################
simMu <- function(data, EST, nobs, chunksize=50000, rseed){
  success <- FALSE
  mutated <- data.frame()
  seedit <- 1
	while(!success){
    # set.seed(rseed+seedit)
		rowind <- sample(nrow(data), chunksize)
		batch <- data[rowind,]
		mu <- batch[,c(EST)]

		batch$SIMOBS <- sapply(mu, function(x) rbinom(1,1,x))
    mutated <- rbind(mutated, batch[batch$SIMOBS==1,])

    success <- nrow(mutated) > nobs
    seedit <- seedit+1
	}

  # last batch will go over; sample to desired # of simulated sites
  # set.seed(rseed)
  mutated <- mutated[sample(nrow(mutated), nobs),] %>%
    mutate(OBS=0, SIM="b")
  return(mutated)
}

##############################################################################
# function samples user-defined number of non-mutated sites
##############################################################################
buildValidationData <- function(data, nsites){
  set.seed(nsites)
  outdat <- data[sample(nrow(data), nsites),] %>%
    mutate(SIM="ab", SIMOBS=0) # include in simulation analysis

  return(outdat)
}

##############################################################################
# Function merges rate estimates with validation data
##############################################################################
mergeRates <- function(chrp_c){
  # rates9 <- ratelist[[5]] %>%
  #   dplyr::select(Category=Type, SEQ=Motif, MU_9=ERV_rel_rate)
	adj2 <- 3
  rates7 <- ratelist[[4]] %>%
    mutate(SEQ7=substr(Motif, 1, 7)) %>%
    dplyr::select(Category=Type, SEQ7, MU_7=ERV_rel_rate)

  rates5 <- ratelist[[3]] %>%
    mutate(SEQ5=substr(Motif, 1, 5)) %>%
    dplyr::select(Category=Type, SEQ5, MU_5=ERV_rel_rate)

  rates3 <- ratelist[[2]] %>%
    mutate(SEQ3=substr(Motif, 1, 3)) %>%
    dplyr::select(Category=Type, SEQ3, MU_3=ERV_rel_rate)

  rates1 <- ratelist[[1]] %>%
    dplyr::select(Category=Type, MU_1=ERV_rel_rate)

  rates7A <- avrates %>%
    mutate(SEQ7=substr(Motif, 1, 7)) %>%
    dplyr::select(Category=Type, SEQ7, MU_7A=eur)

  # chrp_c <- merge(chrp_c, rates9, by=c("Category", "SEQ"), all.x=T)
  chrp_c <- merge(chrp_c, rates7A, by=c("Category", "SEQ7"), all.x=T)
  chrp_c <- merge(chrp_c, rates7, by=c("Category", "SEQ7"), all.x=T)
  chrp_c <- merge(chrp_c, rates5, by=c("Category", "SEQ5"), all.x=T)
  chrp_c <- merge(chrp_c, rates3, by=c("Category", "SEQ3"))
  chrp_c <- merge(chrp_c, rates1, by=c("Category"))

  if(exists("maskgpdat")){
    rates_mask <- maskgpdat %>%
      mutate(SEQ7=substr(Motif, 1, 7)) %>%
      dplyr::select(Category=Type, SEQ7, MU_7M=ERV_rel_rate_mask)

      chrp_c <- merge(chrp_c, rates_mask, by=c("Category", "SEQ7"), all.x=T)
  }

  rates_7C <- r5m %>%
    mutate(SEQ7=substr(Motif, 1, 7)) %>%
    dplyr::select(Category=Type, SEQ7, MU_7C=MAC10_rel_rate)

  rates_7D <- r5m %>%
    mutate(SEQ7=substr(Motif, 1, 7)) %>%
    dplyr::select(Category=Type, SEQ7, MU_7D=ERV_down_rel_rate)

  # rates_anc <- ancgpdat %>%
  #   mutate(SEQ7=substr(Motif, 1, 7)) %>%
  #   dplyr::select(Category=Type, SEQ7, MU_7AN=ERV_rel_rate_anc)

	rates_anc <- test_anc %>%
    mutate(SEQ7=substr(Motif, 1, 7)) %>%
    dplyr::select(Category=Type, SEQ7, MU_7AN=estimate2)

  chrp_c <- merge(chrp_c, rates_7C, by=c("Category", "SEQ7"), all.x=T)
  chrp_c <- merge(chrp_c, rates_7D, by=c("Category", "SEQ7"), all.x=T)
  chrp_c <- merge(chrp_c, rates_anc, by=c("Category", "SEQ7"), all.x=T)

	chrp_c <- chrp_c %>%
		mutate(MU_7adj=-lambertW(-MU_7))

  chrp_c <- chrp_c %>%
    mutate(Category=ifelse(substr(SEQ,adj2+1,adj2+2)=="CG",
                  paste0("cpg_",Category), Category)) %>%
    mutate(BIN=ceiling(POS/binw)) %>%
    # mutate(Category =
    #     plyr::mapvalues(Category, orderedcats1, orderedcats2)) %>%
    mutate(resid3=MU_3-MU_1,
      resid5=MU_5-MU_3,
      resid7=MU_7-MU_5,
      residL=MU-MU_7,
      resid5a=MU_5-MU_1,
      resid7a=MU_7-MU_1,
      residLa=MU-MU_1)

  return(chrp_c)
}

##############################################################################
# Pipeline:
# 1. sample non-mutated input sites
# 2. merge with DNMs
# 3. append columns for additional rate estimates
# 4. Simulate DNMs with same data
##############################################################################
validationPipe <- function(nsites){
  cat("Sampling non-mutated sites...\n")
  sampled_sites <- buildValidationData(input_sites, nsites)

  cat("Merging DNMs with sub-sampled background...\n")
  eval_sites <- bind_rows(list(sampled_sites, input_dnms)) %>%
    group_by(Category) %>%
    mutate(prop=cumsum(OBS)/sum(OBS)) %>%
    arrange(MU, prop) %>%
    mutate(SEQ7 = substr(SEQ, 1, 7),
      SEQ5 = substr(SEQ, 2, 6),
      SEQ3 = substr(SEQ, 3, 5))

  cat("Appending additional rate estimates...\n")
  eval_sites <- mergeRates(eval_sites)

  cat("Generating simulated dataset...\n")
  simulated_dnms <- simMu(data=eval_sites, EST="MU", nobs=nrow(input_dnms), rseed=rseed)

  eval_sites_sim <- bind_rows(
      list(eval_sites[eval_sites$OBS==0,], simulated_dnms)) %>%
    group_by(Category) %>%
    mutate(prop=cumsum(OBS)/sum(OBS)) %>%
    arrange(MU, prop) %>%
    mutate(OBS=SIMOBS)

  ##############################################################################
  # run overall models
  ##############################################################################
  cat("Running combined models...\n")
  combined_models_sim <- runDNMLogit(eval_sites_sim, "COMBINED")
  combined_models <- runDNMLogit(eval_sites, "COMBINED")

  # Likelihood ratio test between nested models
  test13 <- lrtest(combined_models[[1]], combined_models[[2]])
  test35 <- lrtest(combined_models[[2]], combined_models[[3]])
  test57 <- lrtest(combined_models[[3]], combined_models[[4]])
  test7L <- lrtest(combined_models[[4]], combined_models[[5]])
  fulllist<-list(test13, test35, test57, test7L)

  pvals <- lapply(fulllist, function(x) x[[5]][2])

  combined_models_summary <- data.frame(group="COMBINED",
    category="ALL",
    nsites=nsites,
    rsq=getNR2(combined_models),
    rsq_sim=getNR2(combined_models_sim),
    aic=getAIC(combined_models),
		aic_sim=getAIC(combined_models_sim), stringsAsFactors=F) %>%
    tibble::rownames_to_column("mod")

  fitfile <- paste0(parentdir, "/output/model_fit_", nsites, ".txt")
  write.table(combined_models_summary, fitfile,
    col.names=T, row.names=F, quote=F, sep="\t")

  ##############################################################################
  # run type-specific models
  ##############################################################################
  cat("Running type-specific models...\n")
  type_models_summary <- data.frame()
  lrtestdat <- data.frame()
  for(i in 1:length(orderedcats)){
    categ <- orderedcats2[i]

    type_dat_s <- eval_sites_sim %>%
      ungroup() %>%
      mutate(Category =
          plyr::mapvalues(Category, orderedcats1, orderedcats2)) %>%
      filter(Category==categ) %>%
      mutate(resid5=MU_5-MU_3, resid7=MU_7-MU_5, residL=MU-MU_7)
    type_models_sim <- runDNMLogit(type_dat_s, "TYPE")

    type_dat <- eval_sites %>%
  		mutate(Category =
  				plyr::mapvalues(Category, orderedcats1, orderedcats2)) %>%
      filter(Category==categ) %>%
      mutate(resid5=MU_5-MU_3, resid7=MU_7-MU_5, residL=MU-MU_7)
    type_models <- runDNMLogit(type_dat, "TYPE")

    test53 <- lrtest(type_models[[1]], type_models[[2]])
    test75 <- lrtest(type_models[[2]], type_models[[3]])
    testL7 <- lrtest(type_models[[3]], type_models[[4]])
    fulllist <- list(test53, test75, testL7)
    pvals <- lapply(fulllist, function(x) x[[5]][2])

    mods <- c("5-mers", "7-mers", "Logit")
    lrtests <- data.frame(category=categ, mod=mods, pvals)
    lrtestdat <- bind_rows(lrtestdat, lrtests)

    summ_tmp <- data.frame(group="TYPE",
      category=categ,
      rsq=getNR2(type_models),
      rsq_sim=getNR2(type_models_sim),
      aic=getAIC(type_models),
			aic_sim=getAIC(type_models_sim),
			stringsAsFactors=F) %>%
      tibble::rownames_to_column("mod")

    type_models_summary <- bind_rows(type_models_summary, summ_tmp)
  }

  typefitfile <- paste0(parentdir, "/output/model_fit_by_type", nsites, ".txt")
  write.table(type_models_summary, typefitfile,
    col.names=T, row.names=F, quote=F, sep="\t")
  return(list(combined_models_summary, type_models_summary))
}

##############################################################################
# Read and process data
##############################################################################
cat("Reading data...\n")
validation_file <- paste0(parentdir, "/output/predicted/validation_sites.txt")
input_sites <- read.table(validation_file, header=F, stringsAsFactors=F)
names(input_sites) <- c("CHR", "POS", "MU", "OBS", "Category", "SEQ", "ID")

# Remove sites with mu=0
input_sites <- input_sites[input_sites$MU>0,]

# Subset to non-DNMs and DNMs
cat("Splitting by DNM status...\n")

input_dnms <- input_sites[input_sites$ID!="all",] %>%
  mutate(SIM="a", SIMOBS=0)

input_sites <- input_sites[input_sites$ID=="all",]

m500k <- validationPipe(500000)
m1m <- validationPipe(1000000)
m2m <- validationPipe(2000000)
m3m <- validationPipe(3000000)

newmodnames <- c("1-mers", "3-mers", "5-mers", "7-mers", "7-mers+features", "1000G 7-mers")

combined_barplots <- m1m[[1]] %>%
	filter(grepl("_n|AV", mod)) %>%
	mutate(daic=aic-min(aic)) %>%
	# mutate(max=max(aic), aic_col=normalize(aic)+0.1) %>% #data.frame
	# filter(!grepl("down", mod)) %>%
	# filter(!grepl("masked", mod)) %>%
	# filter(!grepl("adj", mod)) %>%
	# mutate(mod=factor(mod, levels=unique(m1m[[1]]$mod)[c(6,7,8,9,14,11,12)])) %>%
	mutate(mod=plyr::mapvalues(mod, unique(m1m[[1]]$mod)[c(1:5,12)], newmodnames)) %>%
	# mutate(mod=factor(mod, levels=unique(m1m[[1]]$mod)[c(1:5)])) %>%
	mutate(mod=factor(mod, levels=newmodnames)) %>%
	mutate(category=paste0(category, "\n")) %>%
	filter(!grepl("features",mod))
	# mutate(data=ifelse(mod %in% unique(m1m[[1]]$mod)[c(11,12)], "poly", "ERV")) %>%

# cbp1 <- ggplot(combined_barplots, aes(x=mod, y=aic_col, group=mod, fill=mod))+
cbp1 <- ggplot(combined_barplots, aes(x=mod, y=daic, group=mod, fill=mod))+
	# geom_point(aes(shape=data), size=4)+
	# geom_point(size=4)+
	geom_col(position="dodge", width=0.8)+
	annotate("rect", xmin=0, xmax=4.5, ymin=0, ymax=Inf, alpha=0.2, fill="grey20")+
	# geom_vline(xintercept=1.5, linetype="dashed")+
	geom_hline(yintercept=10, linetype="dashed")+
	# geom_vline(xintercept=1.5, linetype="dashed")+
	# scale_y_continuous(expand = c(0,0), limits=c(0,1.2))+
	scale_y_continuous(trans = "asinh",
		breaks=c(1,10,100,1000,10000),
		expand = c(0,0))+
	facet_wrap(~category, scales="free")+
	# scale_fill_manual(values=iwhPalette[c(8:9,2:5)])+
	scale_fill_manual(values=c(viridis(4), viridis(25)[24]))+
	# scale_fill_viridis(discrete=TRUE)+
	# scale_colour_viridis(discrete=TRUE)+
	ylab(expression(paste(Delta,AIC)))+
	theme_bw()+
	theme(
		# axis.text.x=element_text(size=14, angle=45, hjust=1, vjust=1),
		axis.text.x=element_blank(),
		panel.grid.minor = element_blank(),
		panel.grid.major.x = element_blank(),
		axis.text.y=element_text(size=14),
		# axis.text.y=element_blank(),
		axis.title.x=element_blank(),
		legend.title=element_blank(),
		axis.title.y=element_text(size=16),
		strip.text.x=element_text(size=16),
		legend.text=element_text(size=14))

cbp1 + theme(legend.position="none")
ggsave("/net/bipolar/jedidiah/mutation/images/testbar.pdf", width=2, height=6)

cbp1a <- cbp1 + theme(legend.position="bottom")
legend <- get_legend(cbp1a)
pdf(paste0(parentdir, "/images/barplot_legend.pdf"),
	height=2, width=6, units="in", res=300)
grid.draw(legend)
dev.off()

newmodnames_facet <- c("1-mers", "3-mers", "5-mers", "7-mers", "7-mers+features", "1000G 7-mers")
#
# dummy <- m1m[[2]] %>%
# 	# dplyr::select(mod, category, aic) %>%
# 	filter(grepl("_n|AV", mod)) %>%
# 	group_by(category) %>%
# 	mutate(mod="dummy", aic=min(aic)-10) %>%
# 	data.frame
oc3 <- c("ALL", gsub(" ", "\n", orderedcats2))
# rbind(dummy, m1m[[2]]) %>%
facet_barplots <- rbind(m1m[[1]][,-4], m1m[[2]]) %>%
	dplyr::select(mod, category, aic, rsq) %>%
	filter(grepl("_n|AV|dummy", mod)) %>%
	group_by(category) %>%
	mutate(daic=aic-min(aic)) %>%
	mutate(drsq=-(rsq-max(rsq))) %>%
	mutate(mod=plyr::mapvalues(mod, unique(m1m[[1]]$mod)[c(1:5,12)], newmodnames_facet)) %>%
	mutate(mod=factor(mod, levels=newmodnames_facet)) %>%
	ungroup() %>%
	mutate(category=gsub(" ", "\n", category)) %>%
	mutate(category=factor(category, levels=oc3)) %>%
	mutate(Data=factor(ifelse(grepl("1000G", mod), "1000G EUR Intergenic SNVs", "BRIDGES ERVs"), levels=c("BRIDGES ERVs", "1000G EUR Intergenic SNVs")))

m500c <- rbind(m500k[[1]][,-4], m500k[[2]])
m500c$nsites <- 500000

m1c <- rbind(m1m[[1]][,-4], m1m[[2]])
m1c$nsites <- 1000000

m2c <- rbind(m2m[[1]][,-4], m2m[[2]])
m2c$nsites <- 2000000

m3c <- rbind(m3m[[1]][,-4], m3m[[2]])
m3c$nsites <- 3000000

facet_barplots2 <- rbind(m500c, m1c, m2c, m3c) %>%
	dplyr::select(mod, category, aic, rsq, nsites) %>%
	filter(grepl("_n|AV|dummy", mod)) %>%
	group_by(category) %>%
	mutate(daic=aic-min(aic)) %>%
	mutate(drsq=-(rsq-max(rsq))) %>%
	mutate(mod=plyr::mapvalues(mod, unique(m1m[[1]]$mod)[c(1:5,12)], newmodnames_facet)) %>%
	mutate(mod=factor(mod, levels=newmodnames_facet)) %>%
	ungroup() %>%
	mutate(category=gsub(" ", "\n", category)) %>%
	mutate(category=factor(category, levels=oc3)) %>%
	mutate(Data=factor(ifelse(grepl("1000G", mod), "1000G EUR Intergenic SNVs", "BRIDGES ERVs"), levels=c("BRIDGES ERVs", "1000G EUR Intergenic SNVs")))

library(scales)
asinh_trans <- function(){
  trans_new(name = 'asinh', transform = function(x) asinh(x),
            inverse = function(x) sinh(x))
}

ratelist[[2]] %>%
	mutate(category=ifelse(substr(Motif,2,3)=="CG",
								paste0("cpg_",Type), Type)) %>%
	group_by(category) %>%
	summarise(nERVs=sum(nERVs), nMotifs=sum(nMotifs)) %>%
	ungroup() %>%
	mutate(prop=nERVs/sum(nERVs))

dnm_type_props <- input_dnms %>%
	mutate(category=ifelse(substr(SEQ,adj2+1,adj2+2)=="CG",
								paste0("cpg_",Category), Category)) %>%
	group_by(category) %>%
	summarise(n=n()) %>%
	ungroup() %>%
	mutate(category =
			plyr::mapvalues(category, orderedcats1, orderedcats2)) %>%
	mutate(category=gsub(" ", "\n", category)) %>%
	mutate(prop=paste0(round(n/sum(n)*100, 1), "%")) %>%
	mutate(propn=paste0(n, "\n(", round(n/sum(n)*100, 1), "%)")) %>%
	rbind(c("ALL", 46813, "100%", "46813\n(100%)")) %>%
	mutate(category=factor(category, levels=oc3)) %>%
	arrange(category)

breakvals <- unique(c(0, rep(10^(c(0,1,2,3)), each=10)*1:10))
breaklabs <- ifelse(grepl("1", breakvals), breakvals, "")
breaklabs[1] <- "0\n(optimal model)"
breaklabs[2] <- ""

pointfig <- ggplot()+
	geom_vline(xintercept=10, linetype="dashed")+
	geom_point(data=facet_barplots, aes(x=daic, y=3), colour="white")+
	annotate("rect", xmin=-0.2, xmax=0.2, ymin=-Inf, ymax=Inf, alpha=0.6, fill="grey30")+
	annotate("rect", xmin=0.2, xmax=10, ymin=-Inf, ymax=Inf, alpha=0.6, fill="grey80")+
	annotate("rect", xmin=30000, xmax=Inf, ymin=-Inf, ymax=Inf, fill="white", colour="black")+
	# geom_point(aes(colour=mod, shape=mod),
	# 	alpha=0.9, size=5)+
	# geom_segment(data=facet_barplots,
	# 	aes(x=0,xend=daic, y=mod, yend=mod, colour=mod))+
	geom_point(data=facet_barplots,
		aes(x=daic, y=3, group=mod, colour=mod, fill=mod, shape=mod),
		alpha=0.9, size=4, stroke=1)+
	geom_text(data=dnm_type_props, aes(x=50000, y=3, label=prop))+
		# shape=21, alpha=0.9, size=2, stroke=3)+
	facet_wrap(~category, ncol=1, scales="free_y", strip.position="left")+
	# scale_y_discrete(position = "right", breaks=dnm_type_props$category, labels=dnm_type_props$prop)+
	scale_x_continuous(trans = "asinh",
		expand=c(0,0),
		breaks=breakvals,
		labels=breaklabs)+
	scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(10:8,3,1,3)])+
	# scale_colour_manual("Model", values=viridis(option="magma", 5, begin=0.1, end=0.8)[c(1:5,4)])+
	# scale_colour_manual("Model", values=c("#af8c3a","#57af6c","#6780d8","#8750a6","#c34f41","#8750a6"))+
	# scale_colour_manual("Model", values=c("#005cbf","#6597d3","#6db840","#ee9800","#ff657c","#ee9800"))+
	# scale_colour_manual("Model", values=c("darkblue", "blue", "green", "orange", "red", "orange"))+
	scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(10:8,3,1)], "black"))+
	scale_shape_manual("Model", values=c(rep(21,5),24))+
	xlab(expression(paste(Delta,AIC)))+
	guides(colour = guide_legend(nrow = 2),
		fill = guide_legend(nrow = 2))+
	coord_cartesian(xlim=c(-0.2, 80000))+
	labs(subtitle="% of total\n de novo mutations")+
	# labs(subtitle="de novo mutations predicted\n(% of total)")+
	# labs(subtitle=expression(paste("% of total\n", italic(de), " ", italic(novo), " mutations")))+
	theme_bw()+
	theme(
		panel.grid.minor = element_blank(),
		panel.grid.major.x = element_blank(),
		plot.subtitle = element_text(hjust=1),
		axis.ticks.y=element_blank(),
		axis.text.x=element_text(size=14),
		axis.text.y=element_blank(),
		axis.title.x=element_text(size=16),
		legend.title=element_blank(),
		axis.title.y=element_blank(),
		strip.background = element_rect(colour = "black", fill = "white"),
		strip.text.y=element_text(size=14, angle=180),
		legend.box.background = element_rect(),
		legend.text=element_text(size=14),
		legend.position="bottom")

pointfig
# cvd_grid(pointfig)
ggsave("/net/bipolar/jedidiah/mutation/images/testpoint_facet.pdf", width=8, height=8)

# pointfig2 <- ggplot()+
# 	geom_vline(xintercept=1e-04, linetype="dashed", colour="white")+
# 	geom_point(data=facet_barplots, aes(x=drsq, y=category), colour="white")+
# 	geom_point(data=facet_barplots,
# 		aes(x=drsq, y=category, group=mod, colour=mod, fill=mod, shape=mod),
# 		alpha=0.9, size=4, stroke=1)+
# 	facet_wrap(~category, ncol=1, scales="free_y", strip.position="left")+
# 	scale_x_log10()+
# 	scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(10:8,3,1,3)])+
# 	scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(10:8,3,1)], "black"))+
# 	scale_shape_manual("Model", values=c(rep(21,5),24))+
# 	xlab("decrease in R^2")+
# 	guides(colour = guide_legend(nrow = 2),
# 		fill = guide_legend(nrow = 2))+
# 	theme_bw()+
# 	theme(
# 		panel.grid.minor = element_blank(),
# 		panel.grid.major.x = element_blank(),
# 		plot.subtitle = element_text(hjust=1),
# 		axis.ticks.y=element_blank(),
# 		axis.text.x=element_text(size=14),
# 		axis.text.y=element_blank(),
# 		axis.title.x=element_text(size=16),
# 		legend.title=element_blank(),
# 		axis.title.y=element_blank(),
# 		strip.background = element_rect(colour = "black", fill = "white"),
# 		strip.text.y=element_text(size=14, angle=180),
# 		legend.box.background = element_rect(),
# 		legend.text=element_text(size=14),
# 		legend.position="bottom")
#
# pointfig2
# ggsave("/net/bipolar/jedidiah/mutation/images/testpoint_facet_rsq.pdf", width=8, height=8)
#
#
# ggplot()+
# 	geom_point(data=facet_barplots2,
# 		aes(x=rsq, y=factor(nsites), group=mod, colour=mod, fill=mod, shape=mod),
# 		alpha=0.9, size=4, stroke=1)+
# 	# geom_bar(stat="identity", position="dodge")+
# 	scale_shape_manual("Model", values=c(rep(21,5),24))+
# 	scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(10:8,3,1,3)])+
# 	scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(10:8,3,1)], "black"))+
# 	# facet_grid(category~nsites)+
# 	facet_wrap(~category, ncol=1, strip.position="left")+
# 	theme_bw()+
# 	theme(
# 		panel.grid.minor = element_blank(),
# 		panel.grid.major.x = element_blank(),
# 		plot.subtitle = element_text(hjust=1),
# 		axis.ticks.y=element_blank(),
# 		axis.text.x=element_text(size=14),
# 		# axis.text.y=element_blank(),
# 		axis.title.x=element_text(size=16),
# 		legend.title=element_blank(),
# 		axis.title.y=element_blank(),
# 		strip.background = element_rect(colour = "black", fill = "white"),
# 		strip.text.y=element_text(size=14, angle=180),
# 		legend.box.background = element_rect(),
# 		legend.text=element_text(size=14),
# 		legend.position="bottom")
#
# ggsave("/net/bipolar/jedidiah/mutation/images/model_rsq_nsites_pt.pdf", width=8, height=12)
#
# 	# mutate(data=ifelse(mod %in% unique(m1m[[1]]$mod)[c(11,12)], "poly", "ERV")) %>%
# 	# ggplot(aes(x=mod, y=aic_col, group=category, fill=mod))+
# 	ggplot(facet_barplots, aes(x=mod, y=daic, group=category))+
# 		# geom_rect(aes(xmin=0,xmax=4,ymin=0,ymax=1000,fill="grey20"), colour="black")+
# 		geom_bar(aes(fill=mod), stat="identity", position="dodge", width=0.8)+
# 		# annotate("rect", xmin=0, xmax=3.5, ymin=0, ymax=Inf, alpha=0.2, fill="grey20")+
# 		# geom_vline(xintercept=1.5, linetype="dashed")+
# 		geom_hline(yintercept=0)+
# 		geom_hline(yintercept=10, linetype="dashed")+
# 		geom_hline(yintercept=-10, linetype="dashed")+
# 		# geom_point(size=4, aes(colour=mod))+
# 		scale_y_continuous(trans = "asinh",
# 			breaks=c(-1000,-100,-10,-1,0,1,10,100,1000),
# 			expand = c(0,0))+
# 		# scale_y_continuous(expand = c(0,0), limits=c(0,1.2))+
# 		# scale_y_continuous(expand = c(0,0))+
# 		# scale_y_continuous(breaks=seq(331000,355000,by=2000))+
# 		facet_wrap(~category, ncol=9)+
# 		# facet_wrap(~category, scales="free", dir="v")+
# 		# scale_colour_manual(values=iwhPalette[1:7])+
# 		# scale_fill_viridis(discrete=TRUE)+
# 		# scale_fill_manual(values=c(viridis(4)[2:4], viridis(25)[24]))+
# 		scale_fill_manual(values=viridis(5)[2:5])+
# 		# scale_colour_viridis(discrete=TRUE)+
# 		# scale_colour_manual(values=iwhPalette[c(8,2:5)])+
# 		# scale_fill_manual(values=iwhPalette[c(8,2:5)])+
# 		ylab(expression(paste(Delta,AIC)))+
# 		theme_bw()+
# 		theme(
# 			# axis.text.x=element_text(size=14, angle=45, hjust=1, vjust=1),
# 			panel.grid.minor = element_blank(),
# 			panel.grid.major.x = element_blank(),
# 			axis.text.x=element_blank(),
# 			axis.text.y=element_text(size=14),
# 			# axis.text.y=element_blank(),
# 			axis.title.x=element_blank(),
# 			legend.title=element_blank(),
# 			axis.title.y=element_text(size=16),
# 			strip.text.x=element_text(size=16),
# 			legend.text=element_text(size=14),
# 			legend.position="bottom")
#
# ggsave("/net/bipolar/jedidiah/mutation/images/testbar_facet.pdf", width=14, height=6)
#
# facet_barplots2 <- m1m[[2]] %>%
# 	dplyr::select(mod, category, aic) %>%
# 	filter(grepl("7", mod)) %>%
# 	filter(grepl("_n", mod)) %>%
# 	group_by(category) %>%
# 	spread(mod, aic) %>%
# 	mutate(aicref=mod_7mers_n.R2) %>%
# 	gather(mod, aic, mod_7mers_features_n.R2:mod_7mers_n.R2) %>%
# 	mutate(daic=aicref-aic) %>%
# 	# mutate(daic=ifelse(daic<0,0.01,daic)) %>%
# 	# mutate(max=max(aic), aic_col=normalize(aic)+0.1) %>% #data.frame
# 	# filter(!grepl("down", mod)) %>%
# 	# filter(!grepl("masked", mod)) %>%
# 	# filter(!grepl("adj", mod)) %>%
# 	# mutate(mod=factor(mod, levels=unique(m1m[[1]]$mod)[c(6,7,8,9,14,11,12)])) %>%
# 	# mutate(mod=plyr::mapvalues(mod, unique(m1m[[2]]$mod)[c(10,1:4)], newmodnames_facet)) %>%
# 	mutate(mod=plyr::mapvalues(mod, unique(m1m[[2]]$mod)[c(3:4)], newmodnames_facet[3:4])) %>%
# 	# mutate(mod=factor(mod, levels=unique(m1m[[1]]$mod)[c(1:5)])) %>%
# 	mutate(mod=factor(mod, levels=newmodnames_facet)) %>%
# 	ungroup() %>%
# 	mutate(category=gsub(" ", "\n", category)) %>%
# 	mutate(category=factor(category, levels=oc3)) %>%
# 	filter(grepl("features",mod))
#
# ggplot(facet_barplots2, aes(x=mod, y=daic, group=category))+
# 	# geom_rect(aes(xmin=0,xmax=4,ymin=0,ymax=1000,fill="grey20"), colour="black")+
# 	geom_bar(aes(fill=mod), stat="identity", position="dodge", width=0.8)+
# 	# annotate("rect", xmin=0, xmax=3.5, ymin=0, ymax=Inf, alpha=0.2, fill="grey20")+
# 	# geom_vline(xintercept=1.5, linetype="dashed")+
# 	geom_hline(yintercept=0)+
# 	geom_hline(yintercept=10, linetype="dashed")+
# 	# geom_hline(yintercept=-10, linetype="dashed")+
# 	# geom_point(size=4, aes(colour=mod))+
# 	# scale_y_continuous(trans = "asinh",
# 	scale_y_continuous(#trans = "biexp",
# 		breaks=c(0,1,10,100,1000),
# 		expand = c(0,0))+
# 	# scale_y_continuous(expand = c(0,0), limits=c(0,1.2))+
# 	# scale_y_continuous(expand = c(0,0))+
# 	# scale_y_continuous(breaks=seq(331000,355000,by=2000))+
# 	facet_wrap(~category, ncol=9)+
# 	# facet_wrap(~category, scales="free", dir="v")+
# 	# scale_colour_manual(values=iwhPalette[1:7])+
# 	# scale_fill_viridis(discrete=TRUE)+
# 	# scale_fill_manual(values=c(viridis(4)[2:4], viridis(25)[24]))+
# 	scale_fill_manual(values=viridis(5)[5])+
# 	# scale_colour_viridis(discrete=TRUE)+
# 	# scale_colour_manual(values=iwhPalette[c(8,2:5)])+
# 	# scale_fill_manual(values=iwhPalette[c(8,2:5)])+
# 	ylab(expression(paste(Delta,AIC,"(ERV 7-mer model as reference)")))+
# 	theme_bw()+
# 	theme(
# 		# axis.text.x=element_text(size=14, angle=45, hjust=1, vjust=1),
# 		panel.grid.minor = element_blank(),
# 		panel.grid.major.x = element_blank(),
# 		axis.text.x=element_blank(),
# 		axis.text.y=element_text(size=14),
# 		# axis.text.y=element_blank(),
# 		axis.title.x=element_blank(),
# 		legend.title=element_blank(),
# 		axis.title.y=element_text(size=16),
# 		strip.text.x=element_text(size=16),
# 		legend.text=element_text(size=14),
# 		legend.position="bottom")
#
# ggsave("/net/bipolar/jedidiah/mutation/images/testbar_facet_7vF.pdf", width=14, height=6)
#
#
# m1m[[2]] %>%
# 	filter(grepl("_n|AV|dummy", mod)) %>%
# 	group_by(category) %>%
# 	do(reshape2::melt(outer(.$aic, .$aic, "-"))) %>%
# 	filter(Var2>=Var1) %>%
# 	ggplot(aes(x=Var2, y=Var1, fill=value))+
# 		geom_tile()+
# 		facet_wrap(~category)+
# 		scale_fill_gradientn(colours=brewer.pal(10,"PiYG"),
# 			trans = "asinh",
# 			breaks=c(-1000,-100,-10,-1,0,1,10,100,1000))
#
# ggsave("/net/bipolar/jedidiah/mutation/images/aicheat.pdf")

sampled_sites <- buildValidationData(input_sites, nsites)

cat("Merging DNMs with sub-sampled background...\n")
eval_sites <- bind_rows(list(sampled_sites, input_dnms)) %>%
	group_by(Category) %>%
	mutate(prop=cumsum(OBS)/sum(OBS)) %>%
	arrange(MU, prop) %>%
	mutate(SEQ7 = substr(SEQ, 1, 7),
		SEQ5 = substr(SEQ, 2, 6),
		SEQ3 = substr(SEQ, 3, 5))

cat("Appending additional rate estimates...\n")
eval_sites <- mergeRates(eval_sites)

cat("Generating simulated dataset...\n")
simdnm_list <- list()
MU_types <- names(eval_sites)[grepl("MU", names(eval_sites))]

i <- 1
for(MU in MU_types[1:6]){
 simdnm_list[[MU]] <- simMu(data=eval_sites, EST=MU, nobs=nrow(input_dnms), rseed=runif(1, 0, 10^12))
 # i <- i + 1
}

foreach(i = 1:6,.combine = "cbind") %do% {
 sum(rnorm(N))
}

obs_dnm_counts <- eval_sites %>%
	filter(OBS==1) %>%
	# mutate(SEQ3=Category) %>%
	mutate(num_GC_flank = str_count(paste(substr(SEQ7,1,3), substr(SEQ7,5,7)), "C|G")) %>%
	mutate(GC_gp = ifelse(num_GC_flank<2, "g01",
 		ifelse(num_GC_flank<4, "g23", "g46"))) %>%
	group_by(Category, SEQ3) %>%
	summarise(n=n()) %>%
	ungroup() %>%
	# group_by(Category) %>%
	mutate(prop=n/sum(n)) %>%
	mutate(dnmdat="OBS")

sim_dnm_dat <- data.frame()

for(MU in MU_types[c(1:5)]){
 sim_dnm_counts <- simdnm_list[[MU]] %>%
	 # mutate(SEQ3=Category) %>%
	 mutate(num_GC_flank = str_count(paste(substr(SEQ7,1,3), substr(SEQ7,5,7)), "C|G")) %>%
	 mutate(GC_gp = ifelse(num_GC_flank<2, "g01",
		 ifelse(num_GC_flank<4, "g23", "g46"))) %>%
	 # mutate(Subtype=paste0(Category, "_", SEQ3)) %>%
	 group_by(Category, SEQ3) %>%
	 summarise(n=n()) %>%
	 ungroup() %>%
	 # group_by(Category) %>%
	 mutate(prop=n/sum(n)) %>%
	 mutate(dnmdat=MU)

 sim_dnm_dat <- bind_rows(sim_dnm_dat, sim_dnm_counts)
}

oldmodnames <- c("MU_3", "MU_5", "MU_7", "MU", "MU_7A")

oldmodnames2 <- c("MU_3", "MU_5", "MU_7", "MU", "MU_7A", "OBS")
newmodnames_facet2 <- c("3-mers", "5-mers", "7-mers", "7-mers+features", "1000G 7-mers", "GoNL/ITMI DNMs")

sim_dnm_dat2 <- bind_rows(obs_dnm_counts, sim_dnm_dat) %>%
	ungroup() %>%
	mutate(mod=dnmdat) %>%
	mutate(mod=plyr::mapvalues(mod, oldmodnames2, newmodnames_facet2)) %>%
	mutate(mod=factor(mod, levels=newmodnames_facet2)) %>%
	mutate(Category =
		 plyr::mapvalues(Category, orderedcats1, orderedcats2)) %>%
	mutate(Category=factor(Category, levels=orderedcats2))

sim_dnm_dat2 %>%
	group_by(Category, mod) %>%
	summarise(n1=sum(n)) %>%
	group_by(mod) %>%
	mutate(prop=n1/sum(n1)) %>%
ggplot(aes(x=mod, y=prop, fill=Category))+
	geom_col(position="stack")+
	coord_flip()+
	scale_fill_manual("Mutation type", values=gp_cols, guide=FALSE)+
	# scale_colour_manual(values=gp_cols)+
	scale_y_continuous(expand = c(0,0))+
	ylab("proportion of mutations")+
	# guides(fill = guide_legend(
	# 	title.position="top",
	# 	title.hjust =0.5, ncol=3)) +
	theme_bw()+
	theme(
		legend.position="bottom",
		# legend.title=element_text(position="top"),
		axis.title.x=element_blank(),
		axis.title.y=element_blank(),
		axis.text.x=element_text(hjust=1))
ggsave(paste0(parentdir, "/images/rates_1_stack.pdf"), width=5, height=1.5)

# terndat <- sim_dnm_dat2 %>%
#  dplyr::select(Category, mod, SEQ7, n) %>%
#  group_by(Category, SEQ7) %>%
#  spread(mod, n)
#
#  #Base Plot
# ternbase <- ggtern(data=terndat,aes(`7-mers+features`, OBS, `1000G 7-mers`, colour=Category))
#
#  #Plot with Points
# ternbase+
#  geom_point(alpha=0.5)+
#  # facet_wrap(~Category)+
#  theme_rgbw()
# ggsave(paste0(parentdir, "/images/ternplot.pdf"), width=12, height=12)

# ggplot(sim_dnm_dat2, aes(x=mod, y=prop, fill=factor(SEQ3)))+
#  geom_col(position = position_fill(reverse = TRUE))+
#  coord_flip()+
#  scale_fill_viridis(discrete=TRUE)+
#  # scale_fill_manual(values=gp_cols)+
#  # scale_colour_manual(values=gp_cols)+
#  facet_wrap(~Category)
# ggsave(paste0(parentdir, "/images/rates_GC_stack.pdf"))

# 1-mers
sim_dnm_radar <- sim_dnm_dat2 %>%
 group_by(Category, mod) %>%
 summarise(n=sum(n)) %>%
 mutate(group=mod) %>%
 dplyr::select(-mod) %>%
 group_by(group) %>%
 mutate(prop=log(n/sum(n))) %>%
 dplyr::select(-n) %>%
 spread(Category, prop)

# 3-mers
sim_dnm_radar <- sim_dnm_dat2 %>%
 mutate(group=mod, subtype=paste0(Category, "_", SEQ3)) %>%
 dplyr::select(group, subtype, n) %>%
 group_by(group) %>%
 mutate(prop=n/sum(n)) %>%
 dplyr::select(-n) %>%
 spread(subtype, prop)

sim_dnm_dat2a <-sim_dnm_dat2 %>%
 mutate(Category =
		plyr::mapvalues(Category, orderedcats2, orderedcatsnc)) %>%
 mutate(Category=factor(Category, levels=orderedcatsnc_short)) %>%
 mutate(subtype=paste0(
	 substr(SEQ3,1,1), "[", Category, "]", substr(SEQ3,3,3))) %>%
 filter(dnmdat %in% c("MU", "OBS", "MU_7A")) %>%
 ungroup() %>%
 arrange(Category, SEQ3)

 sequence_length = length(unique(sim_dnm_dat2a$subtype))
 first_sequence = c(1:(sequence_length%/%2))
 second_sequence = c((sequence_length%/%2+1):sequence_length)
 first_angles = c(90 - 180/length(first_sequence) * first_sequence)
 second_angles = c(-90 - 180/length(second_sequence) * second_sequence)

sdd1<-sim_dnm_dat2a %>%
 filter(dnmdat=="OBS") %>%
 mutate(n=log10(n)) %>%
 arrange(Category)

sdd2<-sim_dnm_dat2a %>%
 filter(dnmdat!="OBS") %>%
 mutate(n=log10(n)) %>%
 arrange(Category)

cat_pal <- data.frame(Category=orderedcatsnc_short, gp_cols=gp_cols[1:6])
sdd1a <- merge(sdd1, cat_pal, by="Category") %>%
 mutate(Category=factor(Category, levels=orderedcatsnc_short)) %>%
 mutate(subtype=paste0(
	 substr(SEQ3,1,1), "[", Category, "]", substr(SEQ3,3,3))) %>%
 arrange(Category)

sdd1$subtype <- factor(sdd1$subtype, levels=sdd1$subtype)
sdd2$subtype <- factor(sdd2$subtype, levels=sdd1$subtype)
sdd1a$subtype <- factor(sdd1a$subtype, levels=sdd1$subtype)

# sdd2$subtype <- factor(sdd2$subtype, levels=orderedcatsnc_short)

# from www.cmap.polytechnique.fr/~lepennec/R/Radar/RadarAndParallelPlots.html
coord_radar <- function (theta = "x", start = 0, direction = 1)
{
	 theta <- match.arg(theta, c("x", "y"))
	 r <- if (theta == "x")
			 "y"
	 else "x"
	 ggproto("CordRadar", CoordPolar, theta = theta, r = r, start = start,
			 direction = sign(direction),
			 is_linear = function(coord) TRUE)
}

plotlabs <- data.frame(y=c(1.7,2,3), ylab=c(NA, 100, 1000), x=45)

ggplot()+
	geom_polygon(data=sdd2,
		aes(x=subtype, y=n, group = mod, colour=mod),
		fill = NA, size = 1, alpha=0.4) +
	geom_point(data=sdd2,
		aes(x=subtype, y=n, colour=mod),
		alpha=0.6, size=1)+
	geom_point(data=sdd1a,
		aes(x=subtype, y=n),
		alpha=0.6, colour="black", size=1)+
	geom_polygon(data=sdd1a,
		aes(x=subtype, y=n, group = mod),
		colour="black", fill = NA, size = 0.75, alpha=0.4) +
	geom_text(data=plotlabs, colour="blue", aes(x=x,y=y,label=ylab, vjust=-0.5))+
	# geom_point(data=sdd1a,
	# 	aes(x=subtype, y=n),
	# 	colour="black", alpha=0.6, size=4)+
	# geom_line(data=sdd1a,
	# 	aes(x=subtype, y=n, group = mod),
	# 	colour="black", linetype="dashed", size = 0.8) +
	# geom_line(data=sdd2,
	# 	aes(x=subtype, y=n, group = mod, colour=mod),
	# 	size = 1.2, alpha=0.8) +
	coord_radar()+
	# scale_y_continuous(limits=c(0,max(log(sdd1$n))))+
	scale_y_continuous(breaks=plotlabs$y)+
	scale_colour_manual(values=c("#547453", "#8051a9"))+
	# scale_colour_manual("Model",
	# 	values=c(brewer.pal(10, "Spectral")[c(1,3)], "black"))+
	theme_minimal()+
	theme(axis.text.x = element_text(
		 angle= c(first_angles,second_angles),
		 vjust=0,
		 colour=as.character(sdd1a$gp_cols)),
	 axis.title.x=element_blank(),
	 axis.title.y=element_blank(),
	 axis.text.y=element_blank(),
	 axis.ticks=element_blank(),
	 panel.grid.major.y=element_line(size = 2, colour = c(rep("grey80", length(plotlabs$y)), NA)),
	 legend.position="bottom")

ggsave(paste0(parentdir, "/images/rates_radar.pdf"), width=8, height=8)

newmodnames_facetb <- c("3-mers", "5-mers", "7-mers", "7-mers+features", "1000G 7-mers")
sim_dnm_plot <- merge(sim_dnm_dat, obs_dnm_counts, by=c("Category", "SEQ3")) %>%
	mutate(err=n.x-n.y) %>%
	# mutate(err=ifelse(dnmdat.x=="MU", -err, err)) %>%
	# mutate(abs_err=(n.x-n.y)/n.y) %>%
	mutate(abs_err=abs(n.x-n.y)) %>%
	# mutate(Category=gsub("cpg_", "", Category)) %>%
	mutate(mod=dnmdat.x) %>%
	mutate(mod=plyr::mapvalues(mod, oldmodnames, newmodnames_facetb)) %>%
	mutate(mod=factor(mod, levels=newmodnames_facetb)) %>%
	mutate(SEQ3=paste0(SEQ3, " (N=", n.y,")")) %>%
	filter(mod %in% newmodnames_facetb[4:5]) %>%
	mutate(Category =
		 plyr::mapvalues(Category, orderedcats1, orderedcats2)) %>%
 mutate(Category =
		plyr::mapvalues(Category, orderedcats2, orderedcatsnc)) %>%
 # mutate(Category=factor(Category, levels=orderedcatsnc_short)) %>%
	mutate(Category=factor(Category, levels=orderedcatsnc_short))
	# filter(dnmdat.x %in% c("MU", "MU_7", "MU_7A"))

sortlevs <- sim_dnm_plot %>%
	filter(mod=="1000G 7-mers") %>%
	group_by(Category) %>%
	arrange(Category, err) %>%
	ungroup() %>%
	dplyr::select(SEQ3)

sim_dnm_plot <- sim_dnm_plot %>%
	mutate(SEQ3=factor(SEQ3, levels=sortlevs$SEQ3))

 sim_cor <- sim_dnm_plot %>%
	 # dplyr::filter()
	 dplyr::filter(n.y>5 & n.x>5) %>%
	 group_by(mod, Category) %>%
	 summarise(cor=cor(prop.x, prop.y, method="spearman"))
	 # summarise(cor=cor(prop.x, prop.y))
# sim_dnm_dat %>% dplyr::filter(n.y>20 & n.x>20) %>% group_by(mod) %>% do(tidy(chisq.test(.$n.x, p=.$n.y, rescale.p=TRUE)))

ggplot()+
	# geom_point(data=sim_dnm_dat, aes(x=abs_err, y=SEQ3, colour=dnmdat.x))+
	geom_col(data=sim_cor,
		aes(x=Category, y=cor, fill=mod, colour=mod),
		position = position_dodge(width=0.9), width=0.8, size=0.2)+
		scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(9:8,3,1,3)])+
		scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(9:8,3,1)], "black"))+
	ylab("correlation")+
	theme_bw()+
	theme(axis.title.y=element_blank(),
		legend.position="bottom")
ggsave(paste0(parentdir, "/images/sim_cor.pdf"), width=8, height=12)

sim_dnm_plot %>% group_by(Category) %>% do(tidy(t.test(abs_err~mod, data=.)))

ggplot()+
	geom_boxplot(data=sim_dnm_plot, aes( x=Category, y=abs_err, colour=mod))+
	scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(1)], "black"))+
	theme_bw()+
	theme(#axis.title.y=element_blank(),
		# axis.text.x=element_text(angle=90),
		legend.position="bottom")
ggsave(paste0(parentdir, "/images/sim_box.pdf"), width=12, height=8)

simdnmdat <- rbind(sim_dnm_dat, obs_dnm_counts) %>%
	# mutate(Category=gsub("cpg_", "", Category)) %>%
	mutate(mod=dnmdat) %>%
	mutate(mod=plyr::mapvalues(mod, oldmodnames2, newmodnames_facet2)) %>%
	mutate(mod=factor(mod, levels=newmodnames_facet2)) %>%
	# mutate(SEQ3=paste0(SEQ3, " (N=", n,")")) %>%
	mutate(Category =
		 plyr::mapvalues(Category, orderedcats1, orderedcats2)) %>%
 mutate(Category =
		plyr::mapvalues(Category, orderedcats2, orderedcatsnc)) %>%
 # mutate(Category=factor(Category, levels=orderedcatsnc_short)) %>%
	mutate(Category=factor(Category, levels=orderedcatsnc_short)) %>%
	mutate(subtype=paste0(
		substr(SEQ3,1,1), "[", Category, "]", substr(SEQ3,3,3))) %>%
	arrange(Category, subtype)

simdnmdat_1mer <- simdnmdat %>%
	group_by(Category, mod) %>%
	summarise(n=sum(n)) %>%
	mutate(prop=n/sum(n))

sim_dnm_dat2 <- simdnmdat %>%
	filter(mod %in% c(newmodnames_facet2[4:6]))

sortlevs <- sim_dnm_dat2 %>%
	filter(mod=="GoNL/ITMI DNMs") %>%
	group_by(Category) %>%
	arrange(Category, n) %>%
	ungroup() %>%
	dplyr::select(subtype)

sim_dnm_dat2 <- sim_dnm_dat2 %>%
	mutate(subtype=factor(subtype, levels=sortlevs$subtype))

ter <- sim_dnm_plot %>%
	group_by(mod, Category) %>%
	summarise(err=sum(abs(err))) %>%
	arrange(Category) %>%
	mutate(label=paste0(mod, ": ", err), y=ifelse(grepl("1000", mod), -450, -350))

ter_title <- sim_dnm_plot %>%
	group_by(mod, Category) %>%
	summarise(err=sum(abs(err))) %>%
	arrange(Category) %>%
	mutate(label="Total absolute error", y=-250)

ggplot()+
	# geom_point(data=sim_dnm_dat2, aes(x=subtype, y=n, colour=mod))+
	geom_col(data=sim_dnm_plot,
		aes(y=err, x=SEQ3, fill=mod),
		position = position_dodge(width=0.9), width=0.8, size=0.2)+
	geom_text(data=ter, aes(x=1.5, y=y, colour=mod, label=label),
						hjust=0, vjust=1, size=7.5)+
	geom_text(data=ter_title, aes(x=1.5, y=y, label=label),
						hjust=0, vjust=1, size=8)+
	# geom_line(data=sim_dnm_dat2, aes(x=subtype, y=n, colour=mod, group=mod))+
	# scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(9:8,3,1,3)])+
	# scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(9:8,3,1)], "black"))+
	# scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(1,3)])+
	scale_fill_manual(NA, values=c("#547453", "#8051a9", "black"))+
	scale_colour_manual(NA, values=c("#547453", "#8051a9"))+
	# scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(1)], "black"))+
	# scale_y_log10()+
	# scale_y_continuous(limits=c(-40,200))+
	# geom_hline(data=obs_dnm_counts, aes(yintercept=n))+
	facet_wrap(~Category, scales="free_x", nrow=2)+
	# coord_flip()+
	ylab("Difference with observed count")+
	xlab("Subtype (#observed DNMs)")+
	theme_bw()+
	theme(#axis.title.y=element_blank(),
		axis.text.x=element_text(angle=-90, size=14, vjust=0),
		axis.text.y=element_text(size=20),
		axis.title=element_text(size=20),
		legend.text=element_text(size=18),
		strip.text=element_text(size=16),
		legend.title=element_blank(),
		legend.position="bottom")
ggsave(paste0(parentdir, "/images/sim_pt.pdf"), width=14, height=12)

ggplot()+
	# geom_point(data=sim_dnm_dat, aes(x=abs_err, y=SEQ3, colour=dnmdat.x))+
	geom_col(data=sim_dnm_plot,
		aes(y=abs_err*100, x=SEQ3, fill=mod, colour=mod),
		position = position_dodge(width=0.9), width=0.8, size=0.2)+
	# scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(9:8,3,1,3)])+
	# scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(9:8,3,1)], "black"))+
	scale_fill_manual("Model", values=brewer.pal(10, "Spectral")[c(1,3)])+
	scale_colour_manual("Model", values=c(brewer.pal(10, "Spectral")[c(1)], "black"))+
	# scale_y_continuous(limits=c(-40,200))+
	# geom_hline(data=obs_dnm_counts, aes(yintercept=n))+
	facet_wrap(~Category, scales="free")+
	coord_flip()+
	ylab("% error")+
	theme_bw()+
	theme(axis.title.y=element_blank(),
		legend.position="bottom")
ggsave(paste0(parentdir, "/images/sim_pt.pdf"), width=8, height=12)


## load packages
#Load package
suppressMessages(library(mclust))

args <- commandArgs(trailingOnly = TRUE)
try(if(length(args) != 3) stop("Incorrect number of arguments, usage> Rscript seGMM.R featrue cutoff output"))
input = args[1]
threshould = as.numeric(args[2])
Output = args[3]

## read features
feature <- read.table(input, head = T, stringsAsFactors = F, row.names=1, sep="\t")
#feature_scale <- feature
feature_scale <- as.data.frame(scale(feature))
#--------- MM model  ---------------------------------------------------------
em <- Mclust(feature_scale, G = 2)
#summary(em, parameters = T)

cbPalette <- c("#000000", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2",
"#D55E00", "#CC79A7", "#999999")
bicPlotColors <- mclust.options("bicPlotColors")
bicPlotColors[1:14] <- c(cbPalette, cbPalette[1:5])
mclust.options("bicPlotColors" = bicPlotColors)
mclust.options("classPlotColors" = cbPalette[-1])

#pdf(paste(Output,"/GMM.density.pdf",sep=""),height=5,width=5)
#drmod <- MclustDR(em)
#plot(drmod, what = "density", dimens = 2)
#dev.off()

#pdf(paste(Output,"/GMM.classification.pdf",sep=""),height=5,width=5)
#plot(drmod, what = "scatterplot")
#dev.off()

outliers <- em$uncertainty>=threshould

print(paste("There are ",sum(outliers)," outliers samples based on prediction uncertainty", sep="")); print(rownames(feature)[outliers]); print(table(outliers))

feature$class<-em$classification
feature$Predict="NA"
feature$karyotypes="NA"

features_name = c("SRY","Xmap","Ymap","XH","XYratio")

for(i in features_name){
    if(i  %in% colnames(feature)){
        if(i=="SRY" || i=="Ymap"){
            if(mean(feature[feature$class=="1",i])>mean(feature[feature$class=="2",i])){
                feature[feature$class=="1",]$Predict = "Male"
                feature[feature$class=="2",]$Predict = "Female"
                feature[feature$class=="1",]$karyotypes = "XY"
                feature[feature$class=="2",]$karyotypes = "XX"
                break
            }
            else{
                feature[feature$class=="1",]$Predict = "Female"
                feature[feature$class=="2",]$Predict = "Male"
                feature[feature$class=="1",]$karyotypes = "XX"
                feature[feature$class=="2",]$karyotypes = "XY"
                break
            }
        }
        else{
            if(mean(feature[feature$class=="1",i])>mean(feature[feature$class=="2",i])){
                feature[feature$class=="1",]$Predict = "Female"
                feature[feature$class=="2",]$Predict = "Male"
                feature[feature$class=="1",]$karyotypes = "XX"
                feature[feature$class=="2",]$karyotypes = "XY"
                break
            }
            else{
                feature[feature$class=="1",]$Predict = "Male"
                feature[feature$class=="2",]$Predict = "Female"
                feature[feature$class=="1",]$karyotypes = "XY"
                feature[feature$class=="2",]$karyotypes = "XX"
                break
            }
        }
    }
    else{next}
}

if("Xmap" %in% colnames(feature) & "Ymap" %in% colnames(feature)){
    mean_f_xmap<-mean(feature[feature$karyotypes=="XX","Xmap"])
    mean_f_ymap<-mean(feature[feature$karyotypes=="XX","Ymap"])
    sd_f_xmap<-sd(feature[feature$karyotypes=="XX","Xmap"])
    sd_f_ymap<-sd(feature[feature$karyotypes=="XX","Ymap"])
    mean_m_xmap<-mean(feature[feature$karyotypes=="XY","Xmap"])
    mean_m_ymap<-mean(feature[feature$karyotypes=="XY","Ymap"])
    sd_m_xmap<-sd(feature[feature$karyotypes=="XY","Xmap"])
    sd_m_ymap<-sd(feature[feature$karyotypes=="XY","Ymap"])
    for(i in 1:nrow(feature)){
        if(feature[i,"Xmap"]>(mean_m_xmap-3*sd_m_xmap) & feature[i,"Xmap"]<(mean_m_xmap+3*sd_m_xmap) & feature[i,"Ymap"]>(mean_m_ymap-3*sd_m_ymap) & feature[i,"Ymap"]<(mean_m_ymap+3*sd_m_ymap)){
            feature$karyotypes[i] = "XY"
        } else if (feature[i,"Xmap"]>(mean_m_xmap-3*sd_m_xmap) & feature[i,"Xmap"]<(mean_m_xmap+3*sd_m_xmap) & feature[i,"Ymap"]>(2*mean_m_ymap)){
            feature$karyotypes[i] = "XYY"
        } else if (feature[i,"Xmap"]>(mean_f_xmap-3*sd_f_xmap) & feature[i,"Xmap"]<(mean_f_xmap+3*sd_f_xmap) & feature[i,"Ymap"]>(mean_f_ymap-3*sd_f_ymap) & feature[i,"Ymap"]<(mean_f_ymap+3*sd_f_ymap)){
            feature$karyotypes[i] = "XX"
        } else if (feature[i,"Xmap"]>(2*mean_f_xmap) & feature[i,"Ymap"]>(mean_m_ymap-3*sd_m_ymap) & feature[i,"Ymap"]<(mean_m_ymap+3*sd_m_ymap)){
            feature$karyotypes[i] = "XXY"
        } else if (feature[i,"Xmap"]>(3*mean_f_xmap) & feature[i,"Ymap"]>(mean_f_ymap-3*sd_f_ymap) & feature[i,"Ymap"]<(mean_f_ymap+3*sd_f_ymap)){
            feature$karyotypes[i] = "XXX"
        } else if (feature[i,"Xmap"]<(0.5*mean_f_xmap) & feature[i,"Ymap"]>(mean_f_ymap-3*sd_f_ymap) & feature[i,"Ymap"]<(mean_f_ymap+3*sd_f_ymap)){
            feature$karyotypes[i] = "X"
        }
        else{
            feature$karyotypes[i] = feature$karyotypes[i]
        }
    }
}

for(i in 1:nrow(feature)){
    if(em$uncertainty[i]>=threshould){
        feature$Predict[i] = "NA"
        feature$karyotypes[i] = "NA"
    }
}

write.table(feature[,-(ncol(feature)-2)], paste(Output,"/seGMM_result.txt",sep=""), sep="\t", row.name=TRUE, col.names=TRUE, quote=FALSE)


data<-read.csv("data.csv", sep = ",")
vocab<-colnames(data[-ncol(data)])
nomClasses<-c("accueil", "blog", "commerce", "FAQ", "home", "liste", "recherche")
library(tm)
merge<-function(t){
  PlainTextDocument(paste(t,collapse=""))
}

#Suppression des script s(<script .... </script>)
removeScript<-function(t){
  #découpage de la chaine en utilisant "<split"
  sp<-strsplit(as.character(t), "<script"),]
  #pour chaque partie du split, le début (jusqu'a </script>) est supprimé
  vec<-sapply(1:length(sp),function(i) gsub(sp[i], pattern=".*</script>", replace=" "))
  #les élements du split nettoyés sont concaténés
  PlainTextDocument(paste(vec,collapse=""))
}

#Suppression de toutes les balises
removeBalises<-function(t){
  t1<-gsub("<[^>]*>", " ", t)
  #suppression des occurrences multiples d'espaces (ou de tabulations)
  PlainTextDocument(gsub("[ \t]+"," ",t1))
}

#Fonction de nettoyage permettant de récupérer uniquement le contenu textuel d'une page HTML
nettoyage<-function(corpus){
  corpus<-tm_map(corpus,merge)
  corpus<-tm_map(corpus,content_transformer(tolower))
  #on utilise content_tranformer pour forcer le traitement via tolower à renvoyer un PlainTextDocument
  corpus<-tm_map(corpus,removeScript)
  corpus<-tm_map(corpus,removeBalises)
  corpus<-tm_map(corpus, removeWords, words=stopwords('en'))
  corpus<-tm_map(corpus, removePunctuation)
  corpus<-tm_map(corpus, stemDocument, language='en')
  corpus<-tm_map(corpus, removeNumbers)
}

distance<-function(x,y){
  return(sqrt(sum((x-y)^2)))
}

dist_voisins<-function(vecteur,data){
  return(apply(data[,-ncol(data)],1,distance,x=vecteur))
}

kppv<-function(vecteur, k, data){
  v<-dist_voisins(vecteur,data)
  return(order(v)[1:k])
}

classerKPPV<-function(vecteur, k, data) {
  vec<-kppv(vecteur, k, data)
  classes<-data[vec,ncol(data)]
  occ<-table(classes)
  return (names(occ)[which.max(occ)])
}

erreurKPPV<-function(k, data) {
  res<-sapply(1:nrow(data), function(i)classerKPPV(data[i,-ncol(data)],k,data[-i,]))
  return (1-sum((res==(data[,ncol(data)]))/nrow(data)))
}

classer<-function(fic) {
  corpus<-VCorpus(URISource(fic))
  corpusN<-nettoyage(corpus)
  tmp<-DocumentTermMatrix(corpusN, list(dictionary=vocab))
  mat<-as.matrix(tmp)
  numClasse<-classerKPPV(mat, 4, data)
  return (nomClasses[as.numeric(numClasse)])
}


convert_pacific_centric_2_regular <- function(dat, tempWrite = FALSE) {
    if (xmax(dat) < 180) return(dat)
	if (nlayers(dat) == 1) dat = dat[[1]]
    index = 1:length(values(dat[[1]]))

    xyz = cbind(xyFromCell(dat,index), values(dat))
    x = xyz[, 1]
    test = x > 180

    x[test] = x[test] - 360

    xyz[,1] = x
    dat = rasterFromXYZ(xyz, crs = projection(dat))
    if (tempWrite) dat = writeRaster(dat, file = memSafeFile())
    return(dat)
}

convert_regular_2_pacific_centric <- function(dat, tempWrite = FALSE) {
    if (xmax(dat) > 300) return(dat)
    dat_names = names(dat)
    index = 1:length(values(dat[[1]]))

    xyz = cbind(xyFromCell(dat,index), values(dat))
    x = xyz[, 1]

    test = x < 0

    x[test] = x[test] + 360

    xyz[,1] = x
    dat = rasterFromXYZ(xyz, crs = projection(dat))

    names(dat) = dat_names

    if (tempWrite) dat = writeRaster(dat, file = memSafeFile())
    return(dat)
}


library(ggplot2)
library(dplyr)

source('data_preparation.r')

plt <- ggplot(eq2_pop_df, aes(x = num_trait_configurations, y = ..density..)) + geom_density(aes(fill=model_class_label, position="stack"))
plt

plt <- ggplot(eq2_pop_df, aes(x = configuration_slatkin, y = ..density..)) + geom_density(aes(fill=model_class_label, position="stack"))
plt

neutral_df <- filter(eq2_pop_df, model_class_label == 'allneutral')
plt <- ggplot(neutral_df, aes(x = configuration_slatkin, y = ..density..)) + geom_density(aes(fill=model_class_label, position="stack"))
plt

plt <- ggplot(eq2_pop_df, aes(x = richness_locus_min)) + geom_density(fill="red") + facet_grid(. ~ model_class_label)
plt

# should use histogram, takes integer values
plt <- ggplot(eq2_pop_df, aes(x = kandler_locus_min)) + geom_histogram() + facet_grid(. ~ model_class_label)
plt

# should use histogram, takes integer values
plt <- ggplot(eq2_pop_df, aes(x = num_trait_configurations)) + geom_histogram() + facet_grid(. ~ model_class_label)
plt


#========================
#  strain dominance
# require(cgam)

require(Iso)
require(lubridate)

rm( list=ls() )
set.seed(523)

###########################
#  set-up parallel computations
#  uses forking
library(parallel)
MaxCores <- detectCores() -  1

########################################################################################

# source functions
source("myfunctions_v3.r")

# get data

all.files <- list.files()
data.files <- all.files[ grep( ".csv", all.files ) ]
dat.tmp <- read.table(data.files[1], header=T, sep=",", as.is = T)
dat.tmp[,2] <- as.Date(dat.tmp[,2])
dat.cnt     <- split( dat.tmp, dat.tmp[,1] )

#===============================================================================

#  number of bootstrap samples
N.perm <- 1000

#======================================================================================
# B.1.1.7

first.day.b117 <- as.Date("2020-09-20")
country.b117 <- match(c("Netherlands","United Kingdom"), names(dat.cnt) )

dat <- dat.cnt[country.b117]

lastday.b117 <- vector("list",length(dat))
pval.b117 <- lastday.b117
for ( k in 1:length(dat) ) {
  nl <- dim(dat[[k]])[1]
  sl <- sum(dat[[k]][,2] < first.day.b117 )
  lastday.b117[[k]] <- dat[[k]][(sl+7):nl,2]
  pval.b117[[k]] <- rep(-1,length(lastday.b117[[k]]))
}

for ( k in 1:length(dat) ){

  dd <- dat[[k]][,c(2,3,4)]
  dd[,2] <- dd[,2]-dd[,3]
  dd[,1] <- as.Date(dd[,1])

  for ( kk in 1:length(lastday.b117[[k]] ) ){
    print(paste(kk,k,names(dat)[k],sep="   "))
    # time range

    idx.window <- ( dd[,1] >= first.day.b117 ) & ( dd[,1] <= lastday.b117[[k]][kk])
    da <- dd[idx.window,]
    if ( sum(da[,3]) < 10 ) next

    # baseline
    ffit.constant <- glm( as.matrix(da[,c(3,2)]) ~ 1, family = binomial ) # null model (constant)
    ffit.iso      <- IsoLog(da[,c(3,2)], decreasing = F )

    # calculate probabilities
    p2 <- da[,3]/(da[,2]+da[,3])         # full model
    p1 <- exp(ffit.iso)/(1+exp(ffit.iso))  # isotonic model
    p0 <- sum(da[,3])/sum(da[,2]+da[,3])            # null model

    # calculate loglikelihood ratio
    dloglik <- sum( da[,3]*log(p1/p0) + da[,2]*log((1-p1)/(1-p0)) )  # loglikelihood ratio

    #  expand for bootstrap
    ddl <- as.data.frame( t( da[,2:3] ) )
    DD <- cbind( rep( as.character(da[,1]), da[,2]+da[,3]),
                 unlist( lapply( ddl, FUN=function(x) rep(c("W","M"),x) ) )  )

    #  do the bootstrap
    zz <- vector("list", length=N.perm)
    LL <- unlist( mclapply(zz,
                           FUN=Boot.Pval,
                           DD[,2],
                           DD[,1],
                           p0,
                           Decreasing=F,
                           Labels=c("M","W"),
                           mc.cores = MaxCores) )

    # calculate the p-value
    pval.b117[[k]][kk] <- ( sum( dloglik <= LL ) +1) /( N.perm + 2 )
  }

}

#======================================================================================
# B.1.351

first.day.b1351 <- as.Date("2020-10-01")
country.b1351 <- match(c("Netherlands"), names(dat.cnt) )

dat <- dat.cnt[country.b1351]

lastday.b1351 <- vector("list",length(dat))
pval.b1351 <- lastday.b1351
for ( k in 1:length(dat) ) {
  nl <- dim(dat[[k]])[1]
  sl <- sum(dat[[k]][,2] < first.day.b1351 )
  lastday.b1351[[k]] <- dat[[k]][(sl+7):nl,2]
  pval.b1351[[k]] <- rep(-1,length(lastday.b1351[[k]]))
}

for ( k in 1:length(dat) ){

  dd <- dat[[k]][,c(2,3,5)]
  dd[,2] <- dd[,2]-dd[,3]
  dd[,1] <- as.Date(dd[,1])

  for ( kk in 1:length(lastday.b1351[[k]] ) ){
    print(paste(kk,k,names(dat)[k],sep="   "))
    # time range

    idx.window <- ( dd[,1] >= first.day.b1351 ) & ( dd[,1] <= lastday.b1351[[k]][kk])
    da <- dd[idx.window,]
    if ( sum(da[,3]) < 10 ) next

    # baseline
    ffit.constant <- glm( as.matrix(da[,c(3,2)]) ~ 1, family = binomial ) # null model (constant)
    ffit.iso      <- IsoLog(da[,c(3,2)], decreasing = F )

    # calculate probabilities
    p2 <- da[,3]/(da[,2]+da[,3])         # full model
    p1 <- exp(ffit.iso)/(1+exp(ffit.iso))  # isotonic model
    p0 <- sum(da[,3])/sum(da[,2]+da[,3])            # null model

    # calculate loglikelihood ratio
    dloglik <- sum( da[,3]*log(p1/p0) + da[,2]*log((1-p1)/(1-p0)) )  # loglikelihood ratio

    #  expand for bootstrap
    ddl <- as.data.frame( t( da[,2:3] ) )
    DD <- cbind( rep( as.character(da[,1]), da[,2]+da[,3]),
                 unlist( lapply( ddl, FUN=function(x) rep(c("W","M"),x) ) )  )

    #  do the bootstrap
    zz <- vector("list", length=N.perm)
    LL <- unlist( mclapply(zz,
                           FUN=Boot.Pval,
                           DD[,2],
                           DD[,1],
                           p0,
                           Decreasing=F,
                           Labels=c("M","W"),
                           mc.cores = MaxCores) )

    # calculate the p-value
    pval.b1351[[k]][kk] <- ( sum( dloglik <= LL ) +1) /( N.perm + 2 )
  }

}

#======================================================================================
# B.1.1.7

first.day.b117 <- as.Date("2020-09-20")
country.b117 <- match(c("Netherlands","United Kingdom"), names(dat.cnt) )

dat <- dat.cnt[country.b117]

lastday.b117 <- vector("list",length(dat))
pval.b117 <- lastday.b117
for ( k in 1:length(dat) ) {
  nl <- dim(dat[[k]])[1]
  sl <- sum(dat[[k]][,2] < first.day.b117 )
  lastday.b117[[k]] <- dat[[k]][(sl+7):nl,2]
  pval.b117[[k]] <- rep(-1,length(lastday.b117[[k]]))
}

for ( k in 1:length(dat) ){

  dd <- dat[[k]][,c(2,3,4)]
  dd[,2] <- dd[,2]-dd[,3]
  dd[,1] <- as.Date(dd[,1])

  for ( kk in 1:length(lastday.b117[[k]] ) ){
    print(paste(kk,k,names(dat)[k],sep="   "))
    # time range

    idx.window <- ( dd[,1] >= first.day.b117 ) & ( dd[,1] <= lastday.b117[[k]][kk])
    da <- dd[idx.window,]
    if ( sum(da[,3]) < 10 ) next

    # baseline
    ffit.constant <- glm( as.matrix(da[,c(3,2)]) ~ 1, family = binomial ) # null model (constant)
    ffit.iso      <- IsoLog(da[,c(3,2)], decreasing = F )

    # calculate probabilities
    p2 <- da[,3]/(da[,2]+da[,3])         # full model
    p1 <- exp(ffit.iso)/(1+exp(ffit.iso))  # isotonic model
    p0 <- sum(da[,3])/sum(da[,2]+da[,3])            # null model

    # calculate loglikelihood ratio
    dloglik <- sum( da[,3]*log(p1/p0) + da[,2]*log((1-p1)/(1-p0)) )  # loglikelihood ratio

    #  expand for bootstrap
    ddl <- as.data.frame( t( da[,2:3] ) )
    DD <- cbind( rep( as.character(da[,1]), da[,2]+da[,3]),
                 unlist( lapply( ddl, FUN=function(x) rep(c("W","M"),x) ) )  )

    #  do the bootstrap
    zz <- vector("list", length=N.perm)
    LL <- unlist( mclapply(zz,
                           FUN=Boot.Pval,
                           DD[,2],
                           DD[,1],
                           p0,
                           Decreasing=F,
                           Labels=c("M","W"),
                           mc.cores = MaxCores) )

    # calculate the p-value
    pval.b117[[k]][kk] <- ( sum( dloglik <= LL ) +1) /( N.perm + 2 )
  }

}

#======================================================================================
# R.1

first.day.r1 <- as.Date("2020-10-24")
last.day.r1 <- as.Date(c("2021-02-15",
            "2021-02-28",
            "2021-03-15",
            "2021-03-25",
            "2021-04-10" ) )

dat <- dat.cnt
pval.r1 <- matrix(0,length(dat),length(last.day.r1))
rownames(pval.r1) <- names(dat)
colnames(pval.r1) <- as.character( last.day.r1 )

for ( kk in 1:length(last.day.r1) ){
  for ( k in 1:length(dat) ){

   # select country and strain
    print(paste(kk,k,names(dat)[k],sep="   "))
    dd <- dat[[k]][,c(2,3,6)]
    dd[,2] <- dd[,2]-dd[,3]

    # time range
    idx.window <- ( dd[,1] >= first.day.r1 ) & ( dd[,1] <= last.day.r1[[kk]])
    print( paste(names(dat)[k],sum(idx.window),sep="    " ) )
    pval.r1[k,kk] <- -2
    if ( sum(idx.window ) <=3 ) next
    dd <- dd[idx.window,]

    # exclusion filter
    ss1 <- sum(dd[,3])
    ss2 <- sum(dd[,2])
    pval.r1[k,kk] <- -1
    print( paste( names(dat)[k], ss1, ss2, sep="    ") )
    if (( ss1 < 20 )||(ss2 < 20 )) next

    # baseline
    ffit.constant <- glm( as.matrix(dd[,c(3,2)]) ~ 1, family = binomial ) # null model (constant)
    ffit.iso      <- IsoLog(dd[,c(3,2)], decreasing = F )

    # calculate probabilities
    p2 <- dd[,3]/(dd[,2]+dd[,3])                    # full model
    p1 <- exp(ffit.iso)/(1+exp(ffit.iso))           # isotonic model
    p0 <- sum(dd[,3])/sum(dd[,2]+dd[,3])            # null model

    # calculate loglikelihood ratio
    dloglik <- sum( dd[,3]*log(p1/p0) + dd[,2]*log((1-p1)/(1-p0)) )  # loglikelihood ratio

    #  expand for bootstrap
    ddl <- as.data.frame( t( dd[,2:3] ) )
    DD <- cbind( rep( as.character(dd[,1]), dd[,2]+dd[,3]),
                unlist( lapply( ddl, FUN=function(x) rep(c("W","M"),x) ) )  )

    #  do the bootstrap
    zz <- vector("list", length=N.perm)
    LL <- unlist( mclapply(zz,
                           FUN=Boot.Pval,
                           DD[,2],
                           DD[,1],
                           p0,
                           Decreasing=F,
                           Labels=c("M","W"),
                           mc.cores = MaxCores) )

    # calculate the p-value
    pval.r1[k,kk] <- ( sum( dloglik <= LL ) +1) /( N.perm + 2 )

  }
}

idx <- apply(pval.r1 < -0.5,1,sum ) < length(last.day.r1)
Pval.r1 <- pval.r1[idx,]

#=============================================================================================
#
dat.tmp <- read.table(data.files[2],sep=",",header = T, as.is = T)

dat.cnt     <- split( dat.tmp[,1:4], dat.tmp[,1] )

FF.include  <- function(x){
  c1 <- dim(x)[1]  > 9             # at least 10 days
  s1 <- sum( x[,4] )
  s2 <- sum( x[,3] )
  c2 <- (s2 - s1) > 19             # at least 20 cases of other
  c3 <- s1 > 19                    # at least 20 cases of variant
  return( c1 & c2 & c3 )
}

idx.d614g   <- sapply( dat.cnt, FF.include )
dat.cnt.d614g <- dat.cnt[ idx.d614g ]

#======================================================================================
# D614G

dat <- dat.cnt.d614g
pval.d614g <- rep(0,length(dat))
names(pval.d614g) <- names(dat)

for ( k in 1:length(dat) ){
  print(paste(k,names(dat)[k],sep="   "))
  dd     <- dat[[k]][,c(2,3,4)]
  iidx   <- dd[,2] > 0
  dd     <- dd[ iidx, ]
  dd[,2] <- dd[,2]-dd[,3]

  # baseline
  ffit.constant <- glm( as.matrix(dd[,c(3,2)]) ~ 1, family = binomial ) # null model (constant)
  ffit.iso      <- IsoLog( as.matrix(dd[,c(3,2)]), decreasing = F )

  # calculate probabilities
  p2 <- dd[,3]/(dd[,2]+dd[,3])                    # full model
  p1 <- exp(ffit.iso)/(1+exp(ffit.iso))           # isotonic model
  p0 <- sum(dd[,3])/sum(dd[,2]+dd[,3])            # null model

  # calculate loglikelihood ratio
  dloglik <- sum( dd[,3]*log(p1/p0) + dd[,2]*log((1-p1)/(1-p0)) )  # loglikelihood ratio

  #  expand for bootstrap
  ddl <- as.data.frame( t( dd[,2:3] ) )
  DD <- cbind( rep( as.character(dd[,1]), dd[,2]+dd[,3]),
               unlist( lapply( ddl, FUN=function(x) rep(c("W","M"),x) ) )  )

  #  do the bootstrap
  zz <- vector("list", length=N.perm)
  LL <- unlist( mclapply(zz,
                         FUN=Boot.Pval,
                         DD[,2],
                         DD[,1],
                         p0,
                         Decreasing=F,
                         Labels=c("M","W"),
                         mc.cores = MaxCores) )

  # calculate the p-value
  pval.d614g[k] <- ( sum( dloglik <= LL ) +1) /( N.perm + 2 )

}


context("Test telfer")

# Create data
set.seed(seed = 128)
SS <- 1000 # number of observations
taxa <- sample(letters, SS, replace = TRUE)
site <- sample(paste('A', 1:20, sep = ''), SS, replace = TRUE)
time_period <- sample(1:3, SS, replace = TRUE)

df <- unique(data.frame(taxa, site, time_period))

# This is what the results should look like
results <- structure(list(taxa = c("a", "b", "c", "d", "e", "f", "g", "h",
                                   "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u",
                                   "v", "w", "x", "y", "z"),
                          Nsite_1.x = c(7, 5, 11, 6, 8, 12, 13,
                                        10, 11, 7, 9, 10, 10, 8, 6, 10, 10, 9,
                                        7, 9, 7, 12, 7, 6, 11, 6),
                          Nsite_2.x = c(8, 8, 10, 11, 14, 12, 8, 8, 8, 10, 10, 10,
                                        9, 11, 7, 13, 9, 10, 12, 9, 14, 11, 5, 11, 13, 8),
                          Telfer_1_2 = c(-0.737325194162432, -0.771337920914978,
                                         -0.0978316993182738, 0.705665061130678,
                                         1.84449355838129, 0.793204324994675,
                                         -1.39542120066517, -0.889663497755277,
                                         -0.988718249517388, 0.145264509176636,
                                         0.0208475603716532, -0.0362700616533217,
                                         -0.459036841151605, 0.49957587189965, -1.23170170347477,
                                         1.26438350620118, -0.459036841151605, 0.0208475603716532,
                                         1.0278542125157, -0.395395287450087, 1.98143673331934,
                                         0.306052052307134, -2.22583487465281, 0.705665061130678,
                                         1.25996497575673, -0.728918435468554),
                          Nsite_1.y = c(7, 5, 11, 6, 8, 12, 13, 10, 11, 7, 9, 10, 10,
                                        8, 6, 10, 10, 9, 7, 9, 7, 12, 7, 6, 11, 6),
                          Nsite_3.x = c(10, 8, 11, 11, 7, 11, 12, 9, 7, 11, 10, 9,
                                        9, 7, 11, 5, 10, 12, 9, 8, 7, 10, 10, 11, 12, 8),
                          Telfer_1_3 = c(0.428256932967209, -0.949087297190003, 0.65790219617248, 1.22829202628365,
                                         -1.28886094429482, 0.613532330883972, 1.07474465397477, -0.262484704574745,
                                         -1.29949214495499, 1.00528677409354, 0.277980477724887, -0.262484704574745,
                                         -0.262484704574745, -1.28886094429482, 1.22829202628365,
                                         -2.41810658165437, 0.224882116972965, 1.29327001776924, -0.148772908159123,
                                         -0.737309062319468, -1.3469911660205, 0.133164595928159,
                                         0.42825693296721, 1.22829202628365, 1.14699133920679, -0.781680952309443),
                          Nsite_2.y = c(8, 8, 10, 11, 14, 12, 8, 8, 8, 10, 10, 10,
                                        9, 11, 7, 13, 9, 10, 12, 9, 14, 11, 5, 11, 13, 8),
                          Nsite_3.y = c(10, 8, 11, 11, 7, 11, 12, 9, 7, 11, 10, 9, 9, 7, 11,
                                        5, 10, 12, 9, 8, 7, 10, 10, 11, 12, 8),
                          Telfer_2_3 = c(0.241879867181403, -1.1282200653054, 0.905222087260817, 0.882140380723752,
                                         -0.835189914093116, 0.855157996286309, 1.61197979966821, -0.436860689687682,
                                         -1.84628403251525, 0.905222087260817, 0.325816517346919,
                                         -0.253589052566972, -0.340138161126636, -1.27848889281263,
                                         0.896127341439063, -2.00286651006585, 0.290092552577541,
                                         1.49539968751045, -0.112055476633155, -0.982085821852136,
                                         -0.835189914093116, 0.352123266172587, 0.00652263716418258,
                                         0.882140380723752, 1.27518370742708, -1.12822006530541)),
                     row.names = c(NA, -26L),
                     class = "data.frame")

######################
test_that("Test errors and warnings", {

  expect_error(temp <- telfer(taxa = 'tom', site = df$site, time_period = df$time_period),
               'The following arguements are not of equal length: taxa, site, time_period')
  expect_error(temp <- telfer(taxa = df$taxa, site = head(df$site,-1), time_period = df$time_period),
               'The following arguements are not of equal length: taxa, site, time_period')
  expect_error(temp <- telfer(taxa = df$taxa, site = df$site, time_period = tail(df$time_period, -1)),
               'The following arguements are not of equal length: taxa, site, time_period')
  expect_error(temp <- telfer(taxa = df$taxa, site = df$site, time_period = df$time_period, minSite = 100),
               'No taxa satisfy the minSite criteria when comparing time period 1 and 2')
  expect_error(temp <- telfer(taxa = df$taxa, site = df$site, time_period = df$time_period, minSite = TRUE),
               'minSite must be numeric or integer')
  expect_warning(temp <- telfer(taxa, site, time_period),
                 '269 out of 1000 observations will be removed as duplicates')

})
test_that("The function works", {

  TelferResult <- telfer(df$taxa, df$site, df$time_period)
  expect_true(all.equal(TelferResult, results, tolerance = .0000001))
  expect_is(TelferResult, class = 'data.frame')
  TelferResult <- telfer(df$taxa, df$site, df$time_period, useIterations = FALSE)
  expect_is(TelferResult, class = 'data.frame')

})


#module load r/intel/4.0.4
#R
install.packages("nlme")
#78
install.packages("tidyverse")
install.packages("ggplot2")
install.packages("compositions")
install.packages("readr")

#setwd('C:/Gresham/Project_Gravimondo/Project_Impact_2/PeerJ_Submission/ANCOM-master/ANCOM-master')
setwd('/scratch/ps163/Dr_Carolina/Project_Impact/ANCOM/')
library(nlme)

library(tidyverse)
library(ggplot2)
library(compositions)
source("scripts/ancom_v2.1.R")

library(readr)

otu_data = read_tsv("Impact/feature-table.biom.txt")
otu_id = otu_data$`#OTU_ID`
otu_data = data.frame(otu_data[, -1], check.names = FALSE)
rownames(otu_data) = otu_id

meta_data = read_tsv("Impact/MappingFile_Impact.csv")
meta_data = meta_data %>% rename(Sample.ID = 'sample-id')

source("scripts/ancom_v2.1.R")

# Step 1: Data preprocessing

feature_table = otu_data; sample_var = "Sample.ID"; group_var = NULL
out_cut = 0.25; zero_cut = 0.90; lib_cut = 100; neg_lb = FALSE
prepro = feature_table_pre_process(feature_table, meta_data, sample_var, group_var,
                                   out_cut, zero_cut, lib_cut, neg_lb)
feature_table = prepro$feature_table # Preprocessed feature table
meta_data = prepro$meta_data # Preprocessed metadata
struc_zero = prepro$structure_zeros # Structural zero info

# Step 2: ANCOM

main_var = "Site"; p_adj_method = "BH"; alpha = 0.05
adj_formula = NULL; rand_formula = NULL
t_start = Sys.time()
res = ANCOM(feature_table, meta_data, struc_zero, main_var, p_adj_method,
            alpha, adj_formula, rand_formula)
t_end = Sys.time()
t_run = t_end - t_start # around 30s

write_csv(res$out, "outputs/res_impact_3.csv")

# Step 3: Volcano Plot

# Number of taxa except structural zeros
n_taxa = ifelse(is.null(struc_zero), nrow(feature_table), sum(apply(struc_zero, 1, sum) == 0))
# Cutoff values for declaring differentially abundant taxa
cut_off = c(0.9 * (n_taxa -1), 0.8 * (n_taxa -1), 0.7 * (n_taxa -1), 0.6 * (n_taxa -1))
names(cut_off) = c("detected_0.9", "detected_0.8", "detected_0.7", "detected_0.6")

# Annotation data
dat_ann = data.frame(x = min(res$fig$data$x), y = cut_off["detected_0.7"], label = "W[0.7]")

fig = res$fig +
  geom_hline(yintercept = cut_off["detected_0.7"], linetype = "dashed") +
  geom_text(data = dat_ann, aes(x = x, y = y, label = label),
            size = 4, vjust = -0.5, hjust = 0, color = "orange", parse = TRUE)
fig


#HISTOGRAMI STAROSTNIH STRUKTUR SKOZI LETA
procenti_poLetih <- vsote %>% mutate(procent_014 = 100 * prva/total, procent_1564 = 100 * druga/total,
                                     procent_65 = 100 * tretja/total) %>%
  select(-"total", -"prva", -"druga", -"tretja") %>%
  gather(group, procent, "procent_014":"procent_65", -year) %>% arrange(year) %>%
  mutate(percentage = procent,Age_group = parse_number(group) %>%
           factor(levels=c(14,1564,65), labels = c("0-14","15-64","65+"), ordered=TRUE)) %>% select(-procent, -group)

procenti_poLetih <- procenti_poLetih[c(1,3,2)]

procenti_poLetih_graf <- ggplot(procenti_poLetih, aes(x=year,y=percentage, fill=Age_group)) +
  geom_col(position=position_dodge2(preserve = "total")) +
  labs(y = "Procent", color = "Skupina", x = "")
poLetih <- ggplotly(procenti_poLetih_graf, tooltip = 'percentage')

#BDP(ppp) IN STAROSTNE STRUKTURE GRAFI narejeno v shinyju

bdp_starostneStrutkure <- inner_join(bdpji, StarostneStruktureProcent, by=c("year", "country")) %>%
  left_join(hdi, by = c("country", "year")) %>% left_join(populacija, by = c("year", "country")) %>%
  mutate(gdp_ppp = gdp_ppp/1000000)

bdp_starostneStrutkure_graf <- ggplot(bdp_starostneStrutkure %>% filter(Age_group=="0-14"),
                                      aes(x=country, y = percentage, color = factor(year))) + geom_point() +
  theme(axis.text.x = element_blank(), axis.text.y = element_blank())

bdp_starostne <- ggplotly(bdp_starostneStrutkure_graf)

#RELIGIJE IN STAROSTNE STRUKTURE
religije_procenti <- religije_procenti %>% rename('muslimani' = muslims ,'kristjani' = christians, 'tradicionalna verovanja' = folkReligions,
                                                  'hindujci' = hindus, 'judje' = jews, 'neverujoči' = unaffiliated, 'ostalo' = other, 'budisti' = buddhists)

religion_tidy <- religije_procenti %>%
  gather(religion, percentage, "muslimani":"kristjani",-country, na.rm = TRUE) %>%
  mutate(religion = religion %>% factor(ordered = TRUE)) %>% arrange(country, desc(percentage))

religion_unique <- religion_tidy %>% distinct(country, .keep_all = TRUE)

relig_starostne <- inner_join(religion_unique, StarostneStruktureProcent, by = "country") %>%
  rename(percentageReligion = percentage.x, percentage = percentage.y)

povprecjaVere <-relig_starostne %>% group_by(Age_group, religion, year) %>%
  summarise(povp = mean(percentage))

povpReligije_graf <- ggplot(povprecjaVere, aes(x = year, y = povp, color = religion)) + geom_line() +
  facet_wrap(Age_group~.) + ggtitle("Graf starostnih skupin in religij skozi leta") +
  labs(x = "Leto", y = "Povprečen delež populacije", color = "Religija") +
  theme(axis.title.y = element_text(hjust = 1))
povpReligije <- ggplotly(povpReligije_graf)
print(povpReligije)

#ZEMLJEVIDI

zemljevid_median <- tm_shape(merge(svet, median_age2018, by.x = "NAME", by.y = "country")) +
  tm_fill(col = "median", contrast = 1, palette = "YlOrRd", title = "Medianska starost", textNA = "Manjkajoči podatki") +
  tm_layout(legend.outside = TRUE)
#print(zemljevid_median)

#MEDIANSKA STAROST IN BDP

median_bdp <- bdpji_median %>% filter(year == 2018) %>% inner_join(median_age2018, by="country") %>%
  inner_join(religion_unique, by="country") %>%
  inner_join(populacija2018, by="country") %>% mutate(country = country %>% factor(ordered = TRUE), gdp_pc = gdp/population) %>%
  select(-percentage)

median_bdp_graf1 <- ggplot(median_bdp, aes(x = gdp_pc, y=median, color = religion, text = paste0("country: ", country))) +
  geom_point() + scale_x_log10(labels = comma) +
  labs(x="BDP per capita", y="Medianska starost", color = "Religija") +
  ggtitle("Graf BDP p.c. in medianske starosti")

#print(median_bdp_graf1)

median_bdp_graf <- ggplotly(median_bdp_graf1)
#print(median_bdp_graf)


###########################################################################
#CoxRegression
#This will load our input files into variables so we can run the cox regression.
###########################################################################

CoxRegression.loader <- function(
  input.filename,
  output.file						="CoxRegression_result",
  time								="TIME",
  status							="CENSOR",
  variable.continuous				="CATEGORY",
  variable.category					="NA",
  variable.interaction.terms		="NA",
  strata							="NA",
  input.subgroup					="NA",
  variable.selection				="none"
  )
 {
  	print("-------------------")
	print("CoxRegressionLoader.r")
	print("DOING COX REGRESSION")

	######################################################
	#Load packages for doing the regression.
	library(survival)
	######################################################

	######################################################
	#Read the survival data.
	surv.data<-read.delim(input.filename,header=T)

	#If we have a group column, make sure it's regarded as a factor.
	if("GROUP" %in% colnames(surv.data))
	{
		surv.data$GROUP <- as.factor(surv.data$GROUP)
		lapply(split(surv.data, surv.data$GROUP), CoxRegression.loader.individual,output.file,variable.selection)
	}
	else
	{
		CoxRegression.loader.individual(surv.data,output.file,variable.selection)
	}
	######################################################
	print("-------------------")
}

CoxRegression.loader.individual <- function(dataChunk,output.file,variable.selection)
{
	#Modify output file name if there is a group column.
	if("GROUP" %in% colnames(dataChunk))
	{
		currentGroup <- unique(dataChunk$GROUP)
		currentGroup <- gsub("^\\s+|\\s+$", "",currentGroup)

		#Change the output file name to have the group in it.
		output.file <- paste(output.file,'_',currentGroup,sep='')
	}

	######################################################
	#Hardcode some variables.
	tie.data.handling="efron"
	robust.variance="F"
	######################################################

	######################################################
	#Clean up the variables, Removing leading/trailing spaces and replacing other spaces with an underscore.
	classList <- as.vector(gsub("\\s","_",gsub("^\\s+|\\s+$", "",(dataChunk$'CATEGORY'))))
	######################################################

	######################################################
	#Running the actual Cox analysis.

	#Only include Tilde if we had multiple groups.
	if(length(unique(classList)) < 2)
	{
		return()
		#coxph.fit<-coxph(Surv(TIME,CENSOR)~1,data=surv.data,method="efron",robust="F")
	}
	else
	{
		coxph.fit<-coxph(Surv(TIME,CENSOR)~classList,data=dataChunk,method="efron",robust="F")
	}

	fit.vector<-unlist(coxph.fit)
	######################################################

	######################################################
	#If we need to further analyze the data based on variable selection, do it here.
	if (variable.selection!="none")
	{
		if (robust.variance=="T")
		{
			stop("### Robust variance cannot be used in variable selection! ###")
		}

		coxph.fit<-stepAIC(coxph.fit,direction=variable.selection,trace=0)
		fit.vector<-unlist(coxph.fit)

		# null model?
		if (names(fit.vector[1])=="loglik")
		{
			stop("### Null model! No variable is selected! ###")
		}  # end null model?
	}
	######################################################

	######################################################
	#Number of plots
	num.plot<-0

	for (n in 1:length(fit.vector))
	{
		if (regexpr("^coefficients.",names(fit.vector[n]))!=-1)
		{
			num.plot<-num.plot+1
		}
	}

	if (num.plot==1)
	{
		num.row.col.plot<-1
	}else{
		num.row.col.plot<-as.integer(sqrt(num.plot)+1)
	}
	######################################################

	######################################################
	# Text output

	#Set the output file name.
	output.file <- paste(output.file,".txt",sep="")
	options(width=10000)
	#Determine how we display the tie method.
	if (tie.data.handling=="efron"){method<-"tie data handling:  Efron approximation"}
	if (tie.data.handling=="breslow"){method<-"tie data handling:  Breslow approximation"}
	if (tie.data.handling=="exact"){method<-"tie data handling:  Exact method"}

	#Determine how to display the selection.
	if (variable.selection=="none"){selection<-"variable selection:  none"}
	if (variable.selection=="both"){selection<-"variable selection:  Stepwise selection"}
	if (variable.selection=="forward"){selection<-"variable selection:  Forward selection"}
	if (variable.selection=="backward"){selection<-"variable selection:  Backward selection"}

	#Write the tables with the analysis data.
	write.table("# Cox regression results",output.file,quote=F,sep="\t",row.names=F,col.names=F)
	write.table("",output.file,quote=F,sep="\t",row.names=F,col.names=F,append=T)
	write.table(method,output.file,quote=F,sep="\t",row.names=F,col.names=F,append=T)
	write.table(selection,output.file,quote=F,sep="\t",row.names=F,col.names=F,append=T)
	write.table("",output.file,quote=F,sep="\t",row.names=F,col.names=F,append=T)

	write.table(capture.output(summary(coxph.fit)),output.file,quote=F,sep="\t",row.names=F,col.names=F,append=T)
	options(width=80)
	######################################################
}


# install.packages("R6")
# install.packages("tidyverse")

require(R6)
require("tidyverse")

source("graphwrapper.r")
source("pdfcreator.r")
source("renderer.r")
source("colorwrapper.r")

main <- function(){
  # pdf <- PDFCreator$new(my_name = "sample")
  # pdf$open()
  renderer <- Renderer$new()

  # Scatter plot sample.
  file_name <- "sample.csv"
  sample_data <- read.csv(file_name)
  sample_data <- to_long_format(data = sample_data,
                                cols = c("y_axis_values"),
                                names_to = "y_axis_cases",
                                values_to = "new_y_axis_values")
  aes <- aes(x = sample_data$x_axis_values,
             y = sample_data$new_y_axis_values,
             color = sample_data$y_axis_cases,
             size = sample_data$y_axis_cases)
  g <- make_a_scatter_plot(data = sample_data,
                           aes = aes,
                           title = "TODO: Write title.")

  ## Add a curve to scatter plot.
  power_function <- function(x, a, b, c) {
    a * (x - b) ** c
  }

  a <- 2
  b <- 2
  c <- 2.625
  arg_list <- list(a = a, b = b, c = c)
  x_axis_range <- c(1.0, 5.5)

  g <- g + add_curve(
    aes = aes,
    function_shape = power_function,
    function_args = arg_list,
    x_axis_range = x_axis_range)

  renderer$add_graph_object(g)

  # Line graph sample.
  # dummy line data.
  # https://mrunadon.github.io/%E6%A6%82%E8%A6%81%E3%82%92%E3%81%8A%E3%81%95%E3%81%88%E3%81%A6ggplot2%E3%82%92%E4%BD%BF%E3%81%84%E3%81%93%E3%81%AA%E3%81%99%E3%83%81%E3%83%A5%E3%83%BC%E3%83%88%E3%83%AA%E3%82%A2%E3%83%AB%E3%81%A8%E3%82%B3%E3%83%BC%E3%83%89%E9%9B%86/
  df_temperature <- data.frame(Temperature = rgamma(365, 15, 2)) %>%
    dplyr::mutate(Lower = Temperature - 10,
                  Upper = Temperature + 15,
                  Date = as.POSIXct(seq(as.Date("2019-01-01"),
                                        as.Date("2019-12-31"),
                                        by = "days")))
  aes <- aes(x = Date,
             y = Temperature)
  g <- make_a_line_graph(data = df_temperature,
                         aes = aes,
                         title = "TODO: Write title.")

  renderer$add_graph_object(g)

  # Bar graph sample.
  aes <- aes(x = Date,
             y = Temperature,
             fill = "")

  g <- make_a_bar_graph(data = df_temperature,
                        aes = aes,
                        title = "TODO: Write title.")

  renderer$add_graph_object(g)

  # Histgram sample.
  aes <- aes(x = Temperature,
             fill = "")

  g <- make_a_histgram(data = df_temperature,
                       aes = aes,
                       title = "TODO: Write title.")

  renderer$add_graph_object(g)

  renderer$render_graph_objects()

  # pdf$close()
}

# See:
# https://rdrr.io/github/tidyverse/tidyr/f/NEWS.md
# https://speakerdeck.com/yutannihilation/tidyr-pivot
# https://heavywatal.github.io/rstats/tidyr.html
# data: Original data.
# cols: Columns you want to summarize.
#   examples:
#     cols = col1
#     cols = c(col1, col2, col3)
#     cols = col1:col3 # range
#     cols = -col2 # excluding col(s)
#     cols = c("col1", "col2", "col3")
#     cols = starts_with("col") # use helper function
#     cols = c(col1, "col2", last_col()) # combinations
# names_to: a new column label after grouping column names.
# values_to: a new column label after grouping values.
to_long_format <- function(data, cols, names_to, values_to) {
  long_format_data <- data %>%
    pivot_longer(cols = cols,
                 names_to = names_to,
                 values_to = values_to)

  return (long_format_data)
}

make_a_scatter_plot <- function(data, aes, title) {
  scatter_plot <- ScatterPlotWrapper$new(data, aes)
  g <- scatter_plot$get_graph_object()

  canvas <- scatter_plot$add_canvas()
  g <- g + canvas$initialize_background()
  g <- g + canvas$add_title(title)
  g <- g + canvas$add_margin()

  axis <- scatter_plot$add_axis()
  g <- g + axis$add_labels(x_axis_name = "TODO: Write x axis label name.",
                           y_axis_name = "TODO: Write y axis label name.")
  g <- g + axis$set_labels_font()
  g <- g + axis$modify_x_axis(lower_and_upper = c(1.0, 7.0),
                              ticks = seq(1.0, 7.0, 0.5))
  g <- g + axis$modify_y_axis(lower_and_upper = c(0, 80),
                              ticks = seq(0, 80, 10))
  g <- g + axis$set_axis_font()
  g <- g + axis$rotate_x_axis()

  g <- g + scale_color_manual(name = "fizz",
                              values = c(boston_univ_red, "blue"),
                              labels = c("hoge", "foo"))
  # See:
  # http://www.sthda.com/english/wiki/ggplot2-legend-easy-steps-to-change-the-position-and-the-appearance-of-a-graph-legend-in-r-software
  g <- g + scale_size_manual(values = c(3, 3),
                             guide = FALSE)

  legend <- scatter_plot$add_legend()
  g <- g + legend$set_position(c(0.25, 0.9))
  g <- g + legend$set_font()
  g <- g + legend$set_edge()

  grid <- scatter_plot$add_grid()
  g <- g + grid$set_default()
  g <- g + grid$add_major_line("gray")
  g <- g + grid$add_minor_line("white")

  return (g)
}

make_a_line_graph <- function(data, aes, title) {
  require(scales)

  line_graph <- LineGraphWrapper$new(data, aes)
  g <- line_graph$get_graph_object()

  canvas <- line_graph$add_canvas()
  g <- g + canvas$initialize_background()
  g <- g + canvas$add_title(title)
  g <- g + canvas$add_margin()

  axis <- line_graph$add_axis()
  g <- g + axis$add_labels(x_axis_name = "TODO: Write x axis label name.",
                           y_axis_name = "TODO: Write y axis label name.")
  g <- g + axis$set_labels_font()
  g <- g + axis$modify_x_axis(ticks = date_breaks("90 days"))
  g <- g + axis$modify_y_axis(lower_and_upper = c(0, 20),
                              ticks = seq(0, 20, 2))
  g <- g + axis$set_axis_font()

  return (g)
}

make_a_bar_graph <- function(data, aes, title) {
  bar_graph <- BarGraphWrapper$new(data, aes)
  g <- bar_graph$get_graph_object()

  canvas <- bar_graph$add_canvas()
  g <- g + canvas$initialize_background()
  g <- g + canvas$add_title(title)
  g <- g + canvas$add_margin()

  axis <- bar_graph$add_axis()
  g <- g + axis$add_labels(x_axis_name = "TODO: Write x axis label name.",
                           y_axis_name = "TODO: Write y axis label name.")
  g <- g + axis$set_labels_font()
  g <- g + axis$modify_x_axis(ticks = date_breaks("90 days"))
  g <- g + axis$modify_y_axis(lower_and_upper = c(0, 20),
                              ticks = seq(0, 20, 2))
  g <- g + axis$set_axis_font()

  g <- g + scale_fill_manual(name = "",
                             values = c("darkblue"),
                             labels = c("TODO: Write label name"))
  legend <- bar_graph$add_legend()
  g <- g + legend$set_position(c(0.25, 0.9))
  g <- g + legend$set_font()
  g <- g + legend$set_edge()

  return (g)
}

make_a_histgram <- function(data, aes, title) {
  histgram <- HistgramWrapper$new(data, aes)
  g <- histgram$get_graph_object()

  canvas <- histgram$add_canvas()
  g <- g + canvas$initialize_background()
  g <- g + canvas$add_title(title)
  g <- g + canvas$add_margin()

  axis <- histgram$add_axis()
  g <- g + axis$add_labels(x_axis_name = "TODO: Write x axis label name.",
                           y_axis_name = "TODO: Write y axis label name.")
  g <- g + axis$set_labels_font()
  g <- g + axis$modify_x_axis(lower_and_upper = c(0.0, 20.0),
                              ticks = seq(0.0, 20.0, 2))
  g <- g + axis$modify_y_axis(lower_and_upper = c(0, 50),
                              ticks = seq(0, 50, 5))
  g <- g + axis$set_axis_font()

  g <- g + scale_fill_manual(name = "",
                             values = c("green"),
                             labels = c("TODO: Write label name"))
  legend <- histgram$add_legend()
  g <- g + legend$set_position(c(0.25, 0.9))
  g <- g + legend$set_font()
  g <- g + legend$set_edge()

  return (g)
}

main()