#' Validation models
#'
#' Runs a set of logistic regression models for the validation step of the pipeline
#'
#' @param data
#' @param group set to "COMBINED" to run combined models
#'
#' @return List with glm objects
#'
#' @export
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
#'
#' Parse over lis of glm objects and return Nagelkerke's R^2 for each
#'
#' @param models A list object containing glm objects
#'
#' @return A vector of R^2 values
#'
#' @importFrom fmsb NagelkerkeR2
#' @export
getNR2 <- function(models){
	unlist(lapply(models, function(x)
		fmsb::NagelkerkeR2(x)))[seq(2, 2 * length(models), by = 2)]
}

#' Get AIC values for model objects in a list
#'
#' Parse over lis of glm objects and return AIC for each
#'
#' @param models A list object containing glm objects
#'
#' @return A vector containing AIC values
#'
#' @importFrom stats AIC
#' @export
getAIC <- function(models){
	unlist(lapply(models, function(x)
		AIC(x)))[1:length(models)]
}

#' Simulate mutation data
#'
#' This function returns simulated mutation data
#'
#' @param data
#' @param EST
#' @param nobs
#' @param chunksize
#'
#' @return data.frame containing simulated mutation data
#' @export
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)
}

#' Sample non-mutated sites
#'
#' Samples a given number of non-mutated sites from a data set
#'
#' @param data
#' @param nsites
#'
#' @return data.frame with a subsample of the input data set
#' @import magrittr
#' @export
buildValidationData <- function(data, nsites){
    set.seed(nsites)
    outdat <- data[sample(nrow(data), nsites),] %>%
        mutate(SIM="ab", SIMOBS=0)

    return(outdat)
}

#' Merge rate estimates with validation data
#'
#' A longer description once you've figured out how this works
#' @import magrittr
#' @export
mergeRates <- function(chrp_c, avrates, ratelist, rm5, test_anc, maskgpdat){
    adj2 <- 3

	rates7 <- ratelist[[4]] %>%
		dplyr::mutate(SEQ7=substr(Motif, 1, 7)) %>%
		dplyr::select(Category=Type, SEQ7, MU_7=ERV_rel_rate)

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

	rates3 <- ratelist[[2]] %>%
		dplyr::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 %>%
		dplyr::mutate(SEQ7=substr(Motif, 1, 7)) %>%
		dplyr::select(Category=Type, SEQ7, MU_7A=eur)

	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(dim(maskgpdat)[1] > 0){
		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 <- 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(input_sites, input_dnms, nsites, ratelist, avrates, r5m, test_anc, maskgpdat, parentdir){
	orderedcats <- c("AT_CG", "AT_GC", "AT_TA", "GC_AT", "GC_CG", "GC_TA", "cpg_GC_AT", "cpg_GC_CG", "cpg_GC_TA")
	orderedcats1 <- c("AT_GC", "GC_AT", "cpg_GC_AT", "AT_CG", "GC_CG", "cpg_GC_CG", "AT_TA", "GC_TA", "cpg_GC_TA")
	orderedcats2 <- c("A>G", "C>T", "CpG>TpG", "A>C", "C>G", "CpG>GpG", "A>T", "C>A", "CpG>ApG")

	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, avrates, ratelist, r5m, test_anc, maskgpdat)

	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 <- lmtest::lrtest(combined_models[[1]], combined_models[[2]])
	test35 <- lmtest::lrtest(combined_models[[2]], combined_models[[3]])
	test57 <- lmtest::lrtest(combined_models[[3]], combined_models[[4]])
	test7L <- lmtest::lrtest(combined_models[[4]], combined_models[[5]])
	fulllist<-list(test13, test35, test57, test7L)

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

	combined_models_summary <- tibble(
			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)) %>%
		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 <- lmtest::lrtest(type_models[[1]], type_models[[2]])
		test75 <- lmtest::lrtest(type_models[[2]], type_models[[3]])
		testL7 <- lmtest::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 <- tibble(category=categ, mod=mods, pvals)
		lrtestdat <- bind_rows(lrtestdat, lrtests)

		summ_tmp <- tibble(group="TYPE",
			category=categ,
			rsq=getNR2(type_models),
			rsq_sim=getNR2(type_models_sim),
			aic=getAIC(type_models),
				aic_sim=getAIC(type_models_sim)) %>%
			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))
	}

get_test_anc <- function(full_data, parentdir){
	cbp <- 5
	i <- 3
	nbp2 <- 7

	sites_c_hc <- full_data$sites %>%
		filter(tolower(ALT) != tolower(AA))

	prop <- nrow(sites_c_hc)/nrow(full_data$sites)

	sites_c_hc <- sites_c_hc %>%
		mutate(SEQA=substr(Motif, cbp-i, cbp+i),
			SEQB=substr(Motif, cbp*3-i, cbp*3+i),
			Motif=paste0(SEQA, "(", SEQB, ")"))

	bindir <- paste0(parentdir, "/motif_counts/", nbp2, "-mers/full")
	p1 <- "motifs_full.txt"
	bins <- get_bins(bindir, p1)
	mct <- get_mct(bins)
	ancaggseq <- get_aggseq(sites_c_hc, mct)

	maskdir <- paste0(parentdir, "/motif_counts/", nbp2, "-mers/mask")
	p1 <- "motifs_mask.txt"
	maskbins <- get_bins(maskdir, p1)
	maskmct <- get_mct(maskbins)

	ancgpdat <- ancaggseq %>%
		mutate(Type=gsub("cpg_", "", Category2)) %>%
		dplyr::select(Type, Motif,
			nERVs_anc=nERVs, nMotifs_anc=nMotifs,
			ERV_rel_rate_anc=rel_prop)

	ancgpdat <- merge(ratelist[[4]], ancgpdat, by=c("Type", "Motif"))

	test_anc <- ancgpdat %>%
		group_by(Type, Motif) %>%
		do(tidy(prop.test(c(.$nERVs, .$nERVs_anc), c(.$nMotifs, .$nMotifs_anc*prop)))) %>%
		dplyr::select(Type, Motif, estimate1, estimate2, statistic, p.value)

	test_anc <- merge(test_anc, ancgpdat, by=c("Type", "Motif"))
	return(test_anc)
}

get_r5m <- function(ratelist, avrates, parentdir, nbp, full_data, cbp, binw, maskfile){
    rates7 <- ratelist[[4]]
    r5m <- merge(rates7, avrates, by=c("Type", "Motif"))

    r5m$Category2 <- ifelse(substr(r5m$Motif,4,5)=="CG", paste0("cpg_",r5m$Type),r5m$Type)

    r5m <- r5m %>%
        mutate(Category2 = plyr::mapvalues(Category2, orderedcats1, orderedcats2))

    r5m$Category2 <- factor(r5m$Category2, levels=orderedcats2)

    r5m$prop_diff <- ( r5m$eur / (mean(r5m$eur)/mean(r5m$ERV_rel_rate)) ) / r5m$ERV_rel_rate
    r5m$prop_diff4 <- r5m$prop_diff
    r5m$prop_diff4[r5m$prop_diff< 0.5] <- 0.5
    r5m$prop_diff4[r5m$prop_diff>2] <- 2

    r5m$v2 <- substr(r5m$Motif,1,3)
    r5m$v2a <- as.character(lapply(as.vector(r5m$v2), reverse_chars))
    r5m$v2a <- factor(r5m$v2a)
    r5m$v3 <- substr(r5m$Motif,3+2,3*2+1)

    ##############################################################################
    # Get BRIDGES MAC10+ rates
    ##############################################################################
    commonfile <- paste0(parentdir, "/summaries/common.full.summary")
    bindir <- paste0(parentdir, "/motif_counts/", nbp, "-mers/full")
    common_data <- getData(summfile=commonfile, bindir=bindir, maskfile = maskfile, binw = binw)
    common_data$aggseq <- get_aggseq(common_data$sites, common_data$mct)

    i <- 3
    gpdat <- common_data$aggseq %>%
        mutate(Type=gsub("cpg_", "", Category2),
            SEQA=substr(Motif, cbp-i, cbp+i),
            SEQB=substr(Motif, cbp*3-i, cbp*3+i),
            Motif=paste0(SEQA, "(", SEQB, ")")) %>%
            dplyr::select(Type, Motif, nERVs) %>%
            group_by(Type, Motif) %>%
            summarise(nMAC10=sum(nERVs))

    r5m <- merge(r5m, gpdat, by=c("Type", "Motif")) %>%
    	mutate(MAC10_rel_rate=nMAC10/nMotifs)

    set.seed(sum(r5m$nMAC10))
    ervs_down <- full_data$sites[sample(nrow(full_data$sites), sum(r5m$nMAC10)),]
    ervs_down_aggseq <- get_aggseq(ervs_down, common_data$mct)

    i <- 3
    gpdat <- ervs_down_aggseq %>%
    mutate(Type=gsub("cpg_", "", Category2),
        SEQA=substr(Motif, cbp-i, cbp+i),
        SEQB=substr(Motif, cbp*3-i, cbp*3+i),
        Motif=paste0(SEQA, "(", SEQB, ")")) %>%
        dplyr::select(Type, Motif, nERVs) %>%
        group_by(Type, Motif) %>%
        summarise(nERVs_down=sum(nERVs))

    r5m <- merge(r5m, gpdat, by=c("Type", "Motif")) %>%
        mutate(ERV_down_rel_rate=nERVs_down/nMotifs)
    return(r5m)
}

get_maskgpdat <- function(parentdir, full_data, ratelist){
	nbp2 <- 7
	data2 <- "mask"

	maskdir <- paste0(parentdir, "/motif_counts/", nbp2, "-mers/mask")
	p1 <- "motifs_mask.txt"
	maskbins <- get_bins(maskdir, p1)

	# maskbins <- read.table(maskbinfile, header=T, stringsAsFactors=F, check.names=F)
	maskmct <- get_mct(maskbins)

	cbp <- 5
	i <- 3
	masktmp <- full_data$sites %>%
		filter(MASK==0) %>%
		mutate(SEQA=substr(Motif, cbp-i, cbp+i),
			SEQB=substr(Motif, cbp*3-i, cbp*3+i),
			Motif=paste0(SEQA, "(", SEQB, ")"))

	maskaggseq <- get_aggseq(masktmp, maskmct)
	rm(masktmp)

	maskgpdat <- maskaggseq %>%
		mutate(Type=gsub("cpg_", "", Category2)) %>%
		dplyr::select(Type, Motif,
			nERVs_mask=nERVs, nMotifs_mask=nMotifs,
			ERV_rel_rate_mask=rel_prop)

	maskgpdat <- merge(ratelist[[4]], maskgpdat, by=c("Type", "Motif"))
	return(maskgpdat)
}


# File: qpf.r
# Description:
#    Functions to perfrom QPE from radar data
# Load input/output data
load("input.1316.pc20.RData")
load("output.1316.RData")
rseed = 1234543
# Load library
require(caret)
require(kernlab)
require(parallel)
# Set up multi-core
library(doParallel)
cluster <- makeCluster(detectCores() - 2) # convention to leave 1 core for OS
registerDoParallel(cluster)
# Collect results
results.glm <- data.frame(NULL)
results.svm <- data.frame(NULL)
ys <- NULL
mod.glm <- NULL
mod.svm <- NULL
# Run through each station
nstation <- length(y.1316)
for(i in 1:nstation){
  #
  print(paste("Creating IO data for",names(y.1316)[i]))
  # Combine IO
  iodata <- cbind("y"=c(y.1316[[i]]$t1hr[2:nrow(y.1316[[i]])],NA), input.1316)
  # Clean up NA and move date to row.names
  print("Cleaning up data...")
  row.names(iodata) <- y.1316[[i]]$date
  iodata <- iodata[complete.cases(iodata),]
  #iodata <- iodata[1:1000,]
  print(paste("    Number of valid records:", nrow(iodata)))
  # Setup train-control
  print("Creating folds for cross validation...")
  set.seed(rseed)
  cvOut <- createFolds(iodata$y, k=10)
  cvIn <- cvOut
  for(i in 1:10){
    cvIn[[i]] <- (1:length(iodata$y))[-cvOut[[i]]]
  }
  trctrl <- trainControl("cv", index=cvIn, indexOut=cvOut, allowParallel=T, savePred=F)
  # Fit model
  print("Training and cross validating...")
  # GLM
  fit.glm <- train(log(y+1)~., data=iodata, method="glm", preProcess="scale", trControl=trctrl)
  rec <- fit.glm$results
  yhat.glm <- fit.glm$finalModel$fitted.values
  rec$RMSE.insample <- RMSE(exp(yhat.glm)-1, iodata$y)
  rec$CORR.log <- cor(yhat.glm, log(iodata$y+1))
  rec$CORR.mm <- cor(exp(yhat.glm)-1, iodata$y)
  print("GLM")
  print(rec)
  results.glm <- rbind(results.glm, rec)
  #coef.glm <- c(coef.glm, list(coef(summary(fit.glm))))
  # SVM
  fit.svmr <- train(log(y+1)~., data=iodata, method="svmRadial", preProcess="scale", trControl=trctrl)
  rec <- fit.svmr$results[1,]
  yhat.svm <- fit.svmr$finalModel@fitted
  rec$RMSE.insample <- RMSE(exp(yhat.svm)-1, iodata$y)
  rec$CORR.log <- cor(yhat.svm, log(iodata$y+1))
  rec$CORR.mm <- cor(exp(yhat.svm)-1, iodata$y)
  print("SVR")
  print(rec)
  results.svm <- rbind(results.svm, rec)
  # Collection predictions
  #y <- data.frame(NULL)
  y <- data.frame(iodata$y)
  y$y.glm <- yhat.glm
  y$y.svm <- yhat.svm
  ys <- c(ys, list(y))
  # Save model
  mod.glm <- c(mod.glm, list(fit.glm$finalModel))
  mod.svm <- c(mod.svm, list(fit.svmr$finalModel))
}
#names(coef.glm) <- names(y.1316)
names(ys) <- names(y.1316)
names(mod.glm) <- names(y.1316)
names(mod.svm) <- names(y.1316)
# Clean up
rm(i, iodata, cvOut, cvIn, trctrl, fit.glm, fit.svmr)
# Stop parallel
stopCluster(cluster)
registerDoSEQ()
# Save
save(results.glm, results.svm, ys, file="qpf1hr1316.RData")
save(mod.glm, file="qpf1hr1316.mod.glm.RData")
save(mod.svm, file="qpf1hr1316.mod.svm.RData")


# Run the code below to set up the data
# Add theme_minimal() to the plot.
# Increase the font size of the title.

# Bonus: What else can you change?

library(tidyverse)
# Load and reshape data
unisex_data <- read_csv("data/unisex.csv")
unisex_data <- unisex_data %>%
  select(-prop) %>%
  spread(sex, n, fill=0)
unisex_data

# Add theme_minimal() to the plot.
# Increase the font size of the title.
# See what other theme elements you can change
# Look up the help for theme to see the options
ggplot(unisex_data, aes(x=Male, y=Female, color=name)) +
  geom_point() +
  geom_smooth(method="lm", se=FALSE) +
  labs(title="Unisex Name Popularity",
       x="# of Male Babies per Year",
       y="# of Female Babies per Year",
       color="Name")


library(glue)
library(gtools)
library(ggplot2)
printf <- defmacro(str, expr = {print(glue(str))})

# import data and scale it
data = read.csv("communities.csv")
response = data$ViolentCrimesPerPop
features = as.data.frame(scale(data))
features$ViolentCrimesPerPop = c()


##
## Descriptive stats
##
source("init.r")
#library(ggplot2)
library(tidyverse)
library(wesanderson)

##
## Sample size
##
length(unique(hh.all$Ego.HH))  # no. households
nrow(hh.all)  # no. dyads

# how many households were in a reciprocal relationship?
hh.all %>%
  group_by(Ego.HH) %>%
  summarise(recip = sum(HelpReceived)) %>%
  ungroup() %>%
  mutate(recip = ifelse(recip > 0, 1, 0)) %>%
  select(-Ego.HH) %>%
  table(.)

##
## Village-level descriptives
##
# src: https://stackoverflow.com/a/8189441
Mode <- function(x) {
  ux <- unique(x[x>0])
  ux[which.max(tabulate(match(x, ux)))]
}

village.hh = hh.all %>%
  select(Ego.HH, Ego.VillageID, Ego.Size) %>%
  distinct() %>%
  group_by(Ego.VillageID) %>%
  dplyr::summarise(N = n(),
                   size.mean = mean(Ego.Size),
                   size.sd   = sd(Ego.Size))

village.r = hh.all %>%
  group_by(Ego.VillageID) %>%
  dplyr::summarise(dist.mean = mean(Distance),
                   dist.sd   = sd(Distance),
                   gift.mode = Mode(TotalGifts.ind),
                   help.mode = Mode(HelpInstances))

# save descriptives table
village.hh %>%
  left_join(village.r, by="Ego.VillageID") %>%
  write_csv(file.path(results.dir, "Village descriptives.csv"))

# median gifts and help, for Table 2 caption
hh.all %>%
  filter(TotalGifts.ind > 0) %>%
  group_by(Ego.VillageID) %>%
  summarise(mean = mean(TotalGifts.ind),
            median = median(TotalGifts.ind))

hh.all %>%
  filter(HelpInstances > 0) %>%
  group_by(Ego.VillageID) %>%
  summarise(mean = mean(HelpInstances),
            median = median(HelpInstances))

##
## Relatedness
##
# keep only first instance of each dyad
hh.all.r = hh.all %>%
  dplyr::select(DyadID, Ego.HH, Alter.HH, r, Ego.VillageID) %>%
  group_by(DyadID) %>%
  top_n(1, Alter.HH) %>%
  arrange(Ego.HH, Alter.HH) %>%
  setDT()

# put relatedness into bins
hh.all.r$r.bin = cut(hh.all.r$r, c(0, 0.0039, 0.0078, 0.015, 0.031, 0.063, 0.125, 0.25, 0.5, 1), right=F)
# hh.all.r$r.bin2 = cut(hh.all.r$r, c(0, 0.0039, 0.125, 0.25, 0.5, 1), right=F)

table(hh.all.r$r.bin) %>%
  as.data.frame() %>%
  write_csv(file.path(results.dir, "household relatedness.csv"))

ggplot(hh.all.r, aes(x=r.bin, group=as.factor(Ego.VillageID))) +
  geom_bar(position="dodge", alpha=0.8, aes(fill=as.factor(Ego.VillageID))) +

  coord_cartesian(ylim=c(1, 63000)) +
  scale_y_log10(limits=c(1, 63000)) +

  scale_fill_manual(values = wes_palette("Zissou")) +
  xlab("Relatedness") +
  ylab("Number of households") +

  #facet_grid(. ~ Type) +

  theme_bw() +
  #eliminates baground, gridlines, and chart border
  theme(
    plot.background = element_blank()
    ,panel.grid.major = element_blank()
    ,panel.grid.minor = element_blank()
    ,panel.border = element_blank()
    ,panel.background = element_blank()
  ) + theme(axis.line = element_line(color = 'black')) +
  # hide legend
  theme(legend.position="none") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # show relatedness bins at 45 degree angle

ggsave(filename="fig 1 - relatedness.pdf", width=200, height=100, units="mm")
ggsave(filename="fig 1 - relatedness.png", width=200, height=100, units="mm")

##
## Distributions of relative need
##
needs = unique(subset(hh.all, select=c(Ego.HH, Ego.Need.AFB, Ego.VillageID)))

nrow( subset(needs, Ego.Need.AFB > 1) )  # how many households where kids outnumber adults?

ggplot(needs, aes(Ego.Need.AFB)) +
  geom_histogram(binwidth=0.1) +

  # scale_y_continuous(limits=c(0, max(..count..)+10), expand=c(0,0)) +
  # scale_x_continuous(expand=c(0,0)) +

  xlab("Relative need of household") +
  ylab("Count") +

  theme_bw() +
  #eliminates baground, gridlines, and chart border
  theme(
    plot.background = element_blank()
    ,panel.grid.major = element_blank()
    ,panel.grid.minor = element_blank()
    ,panel.background = element_blank()
    ,axis.text=element_text(size=12)
    ,axis.title=element_text(size=12)
  )

ggsave(filename="fig 2 - relative need.pdf", width=100, height=100, units="mm")
ggsave(filename="fig 2 - relative need.png", width=100, height=100, units="mm")

##
## Are closer kin more likely to reciprocate farm help?
##
# ggplot(hh.all, aes(x=factor(HelpReceived), y=r)) +
#   geom_boxplot()
#
# r_recip_test = broom::tidy( t.test(r ~ HelpReceived, data=hh.all) )
#
# paste0("t(", round(r_recip_test$parameter,3), ")=", round(r_recip_test$estimate,3),
#        " [", round(r_recip_test$conf.low,3), ", ", round(r_recip_test$conf.high,3),
#        "]; P=", round(r_recip_test$p.value,3))

##
## plot correlations between predictors
##
# get upper triangle of the correlation matrix
# (source: http://www.sthda.com/english/wiki/ggplot2-quick-correlation-matrix-heatmap-r-software-and-data-visualization)
get_upper_tri <- function(cormat){
  cormat[lower.tri(cormat)]<- NA
  return(cormat)
}

# calculate, summarise and melt correlation matrix
# cormat = d %>%
#   select(-NumGifts, -ends_with(".z")) %>%
#   cor(.) %>%
#   round(., 2) %>%
#   get_upper_tri(.) %>%
#   reshape2::melt(.)

d = hh.all %>%
  select(HelpObserved, Distance, RelativeWealthRank, Ego.Size, Alter.Size,
  r, AnyWivesInAlter, AnyHusbandsInAlter, ChildrenInAlter,
  HelpReceived, Ego.Need.AFB, Alter.Need.AFB, GiftGiven.ind)

cor_vars = c("Help observed?", "Distance", "Relative wealth", "Ego size", "Alter size",
             "Relatedness", "Any wives in alter?", "Any husbands in alter?", "Any children in alter?",
             "Help received?", "Ego relative need", "Alter relative need", "Gift given?")

# calculate correlations and p-values
cormats = d %>%
  as.matrix(.) %>%
  Hmisc::rcorr(.)

# format p-values
cormat.p = cormats$P %>%
  round(., 2) %>%
  get_upper_tri(.) %>%
  reshape2::melt(.)

# format correlations and merge with p-values
cormat = cormats$r %>%
  round(., 2) %>%
  get_upper_tri(.) %>%
  reshape2::melt(.) %>%
  rename(r = value) %>%
  left_join(cormat.p, by=c("Var1", "Var2")) %>%
  rename(p = value)

# rename variables
cormat$Var1 = factor(cormat$Var1)
levels(cormat$Var1) = cor_vars
cormat$Var2 = factor(cormat$Var2)
levels(cormat$Var2) = cor_vars

# point out where p < 0.01 (rather than show it as p = 0)
cormat$p = as.character(cormat$p)
cormat$p = ifelse(cormat$p == "0", "< 0.01", cormat$p)

ggplot(data = cormat, aes(Var2, Var1, fill = p)) +
  geom_tile(colour = "white") +
  geom_text(aes(label = r), size=3) +

  scale_fill_gradient2(low = "blue", high = "red", mid = "white", na.value="grey75",
                       # midpoint = 0, limit = c(-1,1), space = "Lab",
                       # name="Pearson\nCorrelation") +
                       midpoint = 0.05, limit = c(0, 0.15), space = "Lab",
                       name="P-value") +

  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, vjust = 1,
                                   size = 12, hjust = 1)) +
  coord_fixed() +
  xlab("") +
  ylab("")

ggsave(file.path(plots.dir, "predictors correlations.png"), height=200, width=200, units="mm")
ggsave(file.path(plots.dir, "predictors correlations.pdf"), height=200, width=200, units="mm")


library(xgboost)
library(pROC)
library(doParallel)
library(foreach)
source('setup_crossval.R')
#Parameters
#Tree Depth 5 to 10
#Eta 0.1 to 0.8
#Thread all of them
#Iterations 500-1000

#TODO: Type.measure, parallel

xgcv <- function(train.data, train.labels, tree.depth, eta, iters, verbose, nfolds = 5) {
  #print(tree.depth)
  #print(eta)
  #print(iters)
  #run internal cross validation to determine the best via a grid search
  #expects a vector for tree.depth, eta, and iters
  if(verbose == TRUE) {
    cat(paste('xgcv: setting up internal cv\n'))
  }

  int.crossval.data <- crossval.list(train.data, train.labels, nfolds)
  # #  folds.lists <- list()
  # folds.lists[[1]] <- train.data.folds
  # folds.lists[[2]] <- test.data.folds
  # folds.lists[[3]] <- train.labels.folds
  # folds.lists[[4]] <- test.labels.folds
  # folds.lists[[5]] <- idx.pos
  # folds.lists[[6]] <- idx.neg
  # folds.lists[[7]] <- positives
  # folds.lists[[8]] <- negatives

  if(verbose == TRUE) {
    cat(paste('xgcv: finished internal cv\n'))
  }

  best.auc <- -Inf
  best.tr <- NA
  best.eta <- NA
  best.iter <- NA

  for(tr in tree.depth) {
    for(et in eta) {
      #for(it in iters) {

          xgb.auc <- vector()

        if(verbose == TRUE) {
          cat(paste('-----------------------\n'))
          cat(paste('xgcv: depth:', tr,'\n'))
          cat(paste('xgcv: eta:', et,'\n'))
          cat(paste('xgcv: iter:', max(iters),'\n'))
        }

        list.models <- list()
        for(f in 1:nfolds) {
          #each fold
          if(verbose == TRUE) {
            cat(paste('xgcv: fold:', f,'\n'))
          }
          train.data.int <- int.crossval.data[[1]][[f]]
          #test.data.int <- crossval.data[[2]][[f]]
          train.labels.int <- int.crossval.data[[3]][[f]]
          #test.labels.int<- crossval.data[[4]][[f]]

          model <- xgboost(data=as.matrix(train.data.int), label=as.numeric(train.labels.int), verbose=0, nrounds=max(iters),
                           eta=et, max.depth=tr, objective='binary:logistic', nthread=64)
          list.models[[f]] <- model

        }

        int.auc <- -Inf
        int.it <- max(iters)
        int.aucs <- vector()
        for(it in iters) {
          aucs <- vector()
          for(f in 1:nfolds) {
            test.data.int <- int.crossval.data[[2]][[f]]
            test.labels.int<- int.crossval.data[[4]][[f]]
            resp <- predict(list.models[[f]], as.matrix(test.data.int), ntreelimit = it)
            roc.model <- roc(as.numeric(test.labels.int), as.numeric(resp))
            aucs[f] <- roc.model$auc
          }

          if(mean(aucs) > int.auc) {
            int.auc <- mean(aucs)
            int.it <- it
            int.aucs <- aucs
          }

        }

        xgb.auc <- int.aucs
        int.iters <- int.it

        #Return highest mean C-stat
          if(verbose == TRUE) {
            cat(paste('xgcv: prev.auc:', best.auc,' this round:', mean(xgb.auc),' iters:', int.iters, '\n'))
            cat(paste('-----------------------\n'))
          }

          if(mean(xgb.auc) >= best.auc) {
            best.auc <- mean(xgb.auc)
	          best.tr <- tr
            best.eta <- et
            best.iter <- int.iters#it
          }

      #}
    }
  }

  #Return parameters in a vector
  list.results <- list()
  list.results[[1]] <- best.eta
  list.results[[2]] <- best.tr
  list.results[[3]] <- best.iter
  return(list.results)

}

xgcv_par <- function(train.data, train.labels, tree.depth, eta, iters, verbose, nfolds = 5, ncores=8, nthread=32, linux=FALSE) {

  list.options <- list()
  i <- 1
  for(dp in tree.depth) {
    for(et in eta) {

        values <- c(dp, et)
        list.options[[i]] <- values
        i <- i+1
    }
  }
  int.crossval.data <- crossval.list(train.data, train.labels, nfolds)

  if(!linux) {
    registerDoParallel(cores=ncores)
  } else {
    c1 <- makePSOCKcluster(ncores)
    registerDoParallel(c1)
  }
  best.auc <- -Inf
  best.tr <- NA
  best.eta <- NA
  best.iter <- NA

  all.results <- foreach(opt=list.options, .combine=rbind) %dopar% {
    library(xgboost)
    library(pROC)

    list.models <- list()
    for(f in 1:nfolds) {
      #each fold
      #if(verbose == TRUE) {
      #  cat(paste('xgcv: fold:', f,'\n'))
      #}
      train.data.int <- int.crossval.data[[1]][[f]]
      #test.data.int <- crossval.data[[2]][[f]]
      train.labels.int <- int.crossval.data[[3]][[f]]
      #test.labels.int<- crossval.data[[4]][[f]]

      model <- xgboost(data=as.matrix(train.data.int), label=as.numeric(train.labels.int), verbose=0, nrounds=max(iters),
                       eta=opt[2], max.depth=opt[1], objective='binary:logistic', nthread=nthread,
                       save_period = NULL, save_name = NULL)
      list.models[[f]] <- model

    }

    int.auc <- -Inf
    int.it <- max(iters)
    int.aucs <- vector()
    for(it in iters) {
      aucs <- vector()
      for(f in 1:nfolds) {
        test.data.int <- int.crossval.data[[2]][[f]]
        test.labels.int<- int.crossval.data[[4]][[f]]
        resp <- predict(list.models[[f]], as.matrix(test.data.int), ntreelimit = it)
        roc.model <- roc(as.numeric(test.labels.int), as.numeric(resp))
        aucs[f] <- roc.model$auc
      }

      if(mean(aucs) > int.auc) {
        int.auc <- mean(aucs)
        int.it <- it
        int.aucs <- aucs
      }

    }

    opt.vals <- vector()
    opt.vals <- c(int.auc, int.it)

  } #End of foreach

  df <- data.frame(all.results)
  idx.sds <- which(df[,1] > max(df[,1]) - sd(df[,1]))
  #val.idx <- which(df[idx.sds,2] == min(df[idx.sds,2]))
  #val <- df[val.idx,1]
  val <- max(df[,1])
  val.idx <- which(val == df[,1])
  final.opts <- list.options[[val.idx]]
  best.eta <- final.opts[2]
  best.tr <- final.opts[1]
  best.it <- df[val.idx,2]#final.opts[3]
  return(c(best.eta, best.tr, best.it))

}


args <- commandArgs(TRUE)

if (length(args) < 4) {
	stop(paste("Rscript XXX.R prefix colnum[1,2,3,4] namestr[a,b,c,d] expr.tab",sep=""))
}

# input max genes number 8000
prefix = args[1]
colnum = args[2]
namestr = args[3]
expr = args[4]

colarr = unlist(strsplit(colnum,"[,]"))
names = unlist(strsplit(namestr,"[,]"))

print("## deal with dataset")
d1 <- read.table(file=expr, header=F)

dat = data.frame()
for (i in 1:length(colarr)) {
	print(i)
	if (i == 1){
		dat = d1[,strtoi(colarr[i])]
	} else
		dat = cbind(dat, d1[,strtoi(colarr[i])])
}
m1 = as.matrix(dat)

#m1<- as.matrix( d1[,2:ncol(d1)])
rownames(m1) = d1$V1
colnames(m1) = names

print("# Sample names")

print(names)

print("# Data summary")
summary(m1[,1])
#m1<- log10(m1)
#summary(m1[,1])
min(m1)
max(m1)

dat_matrix = m1

library("gplots")
hmcols <- rev(redblue(2750));
pdf(paste(prefix,".all.sample.heatmap.pdf",sep=""))
heatmap.2(dat_matrix,trace="none",hclustfun = hclust,dendrogram="both", margins = c(8, 8), keysize = 1.5, symkey=FALSE, density.info="none", Rowv=T,Colv=T, scale="row", col=hmcols)
dev.off()


library(ggplot2)
library(plyr)
library(reshape2)

repos <- llply(dir("cache-repo", full.names = TRUE), readRDS)
names(repos) <- vapply(repos, function(x) x$info$full_name, character(1))

lang <- lapply(repos, function(x) x$lang)
lang_collapse <- function(x) {
  x <- unlist(x)
  data.frame(t(prop.table(x)), total = sum(x), check.names = FALSE)
}

langs <- ldply(lang, lang_collapse)

# Explore total repo size ------------------------------------------------------
qplot(total, data = langs, binwidth = 0.05) + scale_x_log10()

# Only look at repos with at least 5k of code
mean(langs$total > 5e3)
langs$.id[langs$total < 5e3][1:10]
langs <- subset(langs, total > 5e3)

qplot(total, data = langs, binwidth = 0.05) + scale_x_log10()

# Big repos: over a megabyte of R code
big <- subset(langs, langs$total * langs$R > 1e6)
big <- big[(vapply(big, function(x) !all(is.na(x)), logical(1)))]
big$.id

# Look at distribution of other languages --------------------------------------

qplot(R, data = langs, binwidth = 0.01)
mean(langs$R == 1)
# ~70% are only R

langm <- melt(langs, id = c(".id", "total", "R"), na.rm = TRUE)
other_lang <- count(langm, "variable")
pop_lang <- match_df(langm, subset(other_lang, freq >= 20))

qplot(value, data = pop_lang, binwidth = 0.05) + facet_wrap(~ variable)
qplot(value, ..density.., data = pop_lang, binwidth = 0.05, geom = "histogram") +
  facet_wrap(~ variable)


# Author: Jeffrey Grover
# Purpose: Volcano PlotteR is an R script to generate volcano plots
# Created: 2019-04-19
# Usage: Load the results output from DESeq2 as a data frame, the input data
# must have columns for log2FoldChange and padj

library(dplyr)
library(ggplot2)

# Load this function and the above libraries

volcplot <- function(data, padj_threshold, fc, out_prefix, format) {

  # Set the fold-change thresholds

  neg_log2fc <- -log2(fc)
  pos_log2fc <- log2(fc)

  # Make a dataset for plotting, add the status as a new column

  plot_ready_data <- na.omit(data) %>%
    mutate(log2fc_threshold = ifelse((log2FoldChange >= pos_log2fc) & (padj <= padj_threshold), 'up',
                              ifelse((log2FoldChange <= neg_log2fc) & (padj <= padj_threshold), 'down',
                                     'unchanged'
                                     )
                                    )
           )

  # Get the number of up, down, and unchanged genes

  up_genes <- plot_ready_data %>% filter(log2fc_threshold == 'up') %>% nrow()
  down_genes <- plot_ready_data %>% filter(log2fc_threshold == 'down') %>% nrow()
  unchanged_genes <- plot_ready_data %>% filter(log2fc_threshold == 'unchanged') %>% nrow()

  # Make the labels for the legend

  legend_labels <- c(str_c('Down: ', down_genes),
                     str_c('Unchanged: ', unchanged_genes),
                     str_c('Up: ', up_genes)
                    )

  # Set the x axis limits, rounded to the next even number

  x_axis_limits <- RoundTo(
    max(abs(log2FoldChange)), 2, ceiling
  )

  # Set the plot colors

  plot_colors <- c('down' = 'dodgerblue1',
                   'unchanged' = 'gray',
                   'up' = 'firebrick1'
                   )

  # Make the plot, these options are a reasonable strting point

  ggplot(plot_ready_data) +
    geom_point(alpha = 0.4, size = 1.5) +
    aes(x=log2FoldChange, y = -log10(padj), color = log2fc_threshold) +
    geom_vline(xintercept = c(neg_log2fc, pos_log2fc), linetype = 'dotted') +
    geom_hline(yintercept = -log10(padj_threshold), linetype = 'dotted') +
    scale_x_continuous('log2(FC)', limits = c(-x_axis_limits, x_axis_limits)) +
    scale_color_manual(values = plot_colors, labels = legend_labels) +
    labs(color = str_c(fc, '-fold, padj ≤', padj_threshold)) +
    theme(aspect.ratio = 1) +
    ggsave(str_c(out_prefix, '_volcano_fc_', fc, '_padj_', padj_threshold, '.', format))
}


Y <- function(f) {
  (function(x) { (x)(x) })( function(y) { f( (function(a) {y(y)})(a) ) } )
}


## This is a script to filter individuals with high F coefficients > m+-3*s
## het format has the following columns:
# FID	Family ID
# IID	Within-family ID
# O(HOM)	Observed number of homozygotes
# E(HOM)	Expected number of homozygotes
# N(NM)	Number of non-missing autosomal genotypes
# F	Method-of-moments F coefficient estimate

args <- commandArgs(TRUE)

if (length(args)==0) {
  stop("At least one argument must be supplied (input file).n", call.=FALSE)
}

dat <- read.table(args[1], header=F)	# Read in the EUR.het file
m <- mean(dat$V6)				# Calculate the mean
s <- sd(dat$V6)					# Calculate the SD
valid <- subset(dat, V6 <= m+3*s & V6 >= m-3*s)	# Get any samples with F coefficient within 3 SD of the population mean
write.table(valid[,c(1,2)], args[2], quote=F, row.names=F)	# print FID and IID for valid samples
q()


Reduce(function(a,b){c(a,0,b)},  c(2,3,4,5))
2 0 3 0 4 0 5


#ESTRUTURA DE VERIFICACAO / CONDICIONAIS
x = 2
y = 4
#Verificar igualdade
if(x == y) {
    print(TRUE) #TRUE sempre maiusculo
} else {
    print(FALSE) #FALSE sempre maiusculo
}

#Forma resumida
ifelse(x == y, TRUE, FALSE) #Se x == y, mostra TRUE caso o contrario, mostra FALSE

#Verificar PAR
if(8 %% 2 == 0) {
    print("O numero {8} e PAR ")
} else {
    print("O numero {8} e IMPAR ")
}

#Forma resumida
ifelse(8 %% 2 == 0, "O numero {8} e PAR ", "O numero {8} e IMPAR")


# Run the code below to set up the data
# Make a scatter plot for casey data with x=Male, y=Female
# Color by year
# Then color by factor(decade): color=factor(decade)
# What's the difference?

# Bonus: Try setting other aesthetics besides color

library(tidyverse)
# Load and reshape data
unisex_data <- read_csv("data/unisex.csv")
casey <- unisex_data %>%
  select(-prop) %>%
  filter(name=="Casey") %>%
  spread(sex, n, fill=0) %>%
  mutate(decade=year-year%%10)
casey

# make the scatterplots


library(ggplot2)
library(reshape2)
library(ggpubr)
library(effsize)
# Note: These plots are generated from 5kb bins files, and intersections of
# bigWig files with bed files provided as supplementary data: IAPEz_consensus,
# ChromHMM17, RepMasker_lt200bp_all and TSS_hi.

# These tables can be downloaded from the extra data folder.

tabledir <- './tables'
figdir <- './figures'

# Figure 6C - Boxplot H3.3 ChIP-seq, H3K9me3 ChIP-seq Smarcad1KD vs WT
# at IAP ERVs and TSS highly expressed.

bin.id <- c('seqnames', 'start', 'end')
df <- read.csv(paste(tabledir,
                     'fig06c_and_ext12b_atac_and_chip_at_iap.csv', sep='/'))

columns <- c('Navarro2020_WT_Input',
             'Navarro2020_WT_H33',
             'Navarro2020_WT_H3K9me3',
             'Navarro2020_Smarcad1KD_Input',
             'Navarro2020_Smarcad1KD_H33',
             'Navarro2020_Smarcad1KD_H3K9me3')

df <- df[, c(bin.id, columns)]
df <- df[df$Navarro2020_WT_Input > 0 & df$Navarro2020_Smarcad1KD_Input > 0, ]

df$WT_H33_norm <- df$Navarro2020_WT_H33/df$Navarro2020_WT_Input
df$Smarcad1KD_H33_norm <- df$Navarro2020_Smarcad1KD_H33/df$Navarro2020_Smarcad1KD_Input
df$WT_H3K9me3_norm <- df$Navarro2020_WT_H3K9me3/df$Navarro2020_WT_Input
df$Smarcad1KD_H3K9me3_norm <- df$Navarro2020_Smarcad1KD_H3K9me3/df$Navarro2020_Smarcad1KD_Input

fig.df <- melt(df[, c(bin.id, 'WT_H33_norm', 'Smarcad1KD_H33_norm', 'WT_H3K9me3_norm', 'Smarcad1KD_H3K9me3_norm')], id.vars=bin.id)

ggplot(fig.df, aes(x=variable, y=value, color=variable)) +
  geom_boxplot(color="black",outlier.alpha = 0,notch = T) +
  geom_jitter(aes(x=variable, y=value, color=variable), alpha=0.15, size=0.5) +
  ylim(0,25) +
  xlab('') +
  ylab('ChIP RPGC / Input') +
  ggtitle('IAP ERVs') +
  theme(legend.position='none', axis.text.x=element_text(angle=45, hjust=1))

ggsave(paste(figdir, 'fig06c_1_chip_at_IAP.png', sep='/'))

compare_means(value ~ variable, data=fig.df,
              method='t.test', paired=T)

cohen.d(df$Smarcad1KD_H33_norm, df$WT_H33_norm)
cohen.d(df$Smarcad1KD_H3K9me3_norm, df$WT_H3K9me3_norm)

## Same at TSS_hi
bin.id <- c('seqnames', 'start', 'end')
df <- read.csv(paste(tabledir,
                     'fig06c_chip_at_tss.csv', sep='/'))

columns <- c('Navarro2020_WT_Input',
             'Navarro2020_WT_H33',
             'Navarro2020_WT_H3K9me3',
             'Navarro2020_Smarcad1KD_Input',
             'Navarro2020_Smarcad1KD_H33',
             'Navarro2020_Smarcad1KD_H3K9me3')

df <- df[, c(bin.id, columns)]
df <- df[df$Navarro2020_WT_Input > 0 & df$Navarro2020_Smarcad1KD_Input > 0, ]

df$WT_H33_norm <- df$Navarro2020_WT_H33/df$Navarro2020_WT_Input
df$Smarcad1KD_H33_norm <- df$Navarro2020_Smarcad1KD_H33/df$Navarro2020_Smarcad1KD_Input
df$WT_H3K9me3_norm <- df$Navarro2020_WT_H3K9me3/df$Navarro2020_WT_Input
df$Smarcad1KD_H3K9me3_norm <- df$Navarro2020_Smarcad1KD_H3K9me3/df$Navarro2020_Smarcad1KD_Input

fig.df <- melt(df[, c(bin.id, 'WT_H33_norm', 'Smarcad1KD_H33_norm', 'WT_H3K9me3_norm', 'Smarcad1KD_H3K9me3_norm')], id.vars=bin.id)

ggplot(fig.df, aes(x=variable, y=value, color=variable)) +
  geom_boxplot(color="black",outlier.alpha = 0,notch = T) +
  geom_jitter(aes(x=variable, y=value, color=variable), alpha=0.15, size=0.5) +
  ylim(0,10) +
  xlab('') +
  ylab('ChIP RPGC / Input') +
  ggtitle('TSS highly expressed') +
  theme(legend.position='none', axis.text.x=element_text(angle=45, hjust=1))

ggsave(paste(figdir, 'fig06c_2_chip_at_TSS.png', sep='/'))

compare_means(value ~ variable, data=fig.df,
              method='t.test', paired=T)

cohen.d(df$Smarcad1KD_H33_norm, df$WT_H33_norm)
cohen.d(df$Smarcad1KD_H3K9me3_norm, df$WT_H3K9me3_norm)


.b = import('../base')

#' Cluster the rows and columns, order factor levels to respect that
#'
#' @param df       The data.frame containing the associations
#' @param formula  A formula of the kind value ~ axis[, axis2] FIXME: doesn't work
#' @param cols     Boolean flag indicating whether to cluster columns
#' @param rows     Boolean flag indicating whether to cluster rows
#' @param size     A size c(rows,cols) to limit the result clustering to
#' @param fill     Fill array if data.frame does not have all values
cluster = function(df, formula, cols=TRUE, rows=TRUE, size=NULL, fill=NA) {
    mat = narray::construct(data=df, formula=formula)
    indep_vars = all.vars(formula[[3]])
    rname = indep_vars[1] #FIXME: ar$construct should order by std. axis ordering
    cname = indep_vars[2] # order: 1,2 && remove t()

    if (!is.null(size))
        mat = mat[.b$top_mask(rowSums(mat), size[1]),
                  .b$top_mask(colSums(mat), size[2])]

    ord_rows = rownames(mat)
    ord_cols = colnames(mat)
    if (rows)
        ord_rows = rownames(mat)[hclust(dist(mat))$order]
    if (cols)
        ord_cols = colnames(mat)[hclust(dist(t(mat)))$order]

    df = df[df[[rname]] %in% ord_rows,]
    df = df[df[[cname]] %in% ord_cols,]
    df[[rname]] = factor(df[[rname]], ord_rows)
    df[[cname]] = factor(df[[cname]], ord_cols)
    df
}

#' Draws a matrix plot using ggplot::geom_tile or circle
#'
#' @param df       A data.frame containing the data
#' @param formula  Formula of sort value ~ row + col
#' @param color    Name of colour filed in df
#' @param label    Name of label field in df
#' @param palette  ggplot palette that should be used; default: RdYlGn
#' @param geom     ggplot geom that should be used, 'tile' or 'circle'
#' @param limits
matrix = function(df, formula, color="color", label=NULL, palette="RdYlGn", text_size=7,
                  geom="tile", limits=NULL, na_value="#f5f5f5",
                  reverse_colors=FALSE, symmetric=FALSE) {
    value = all.vars(formula[[2]])
    rows = all.vars(formula[[3]])[1]
    cols = all.vars(formula[[3]])[2]

    if ('label' %in% colnames(df))
        label = 'label'

    if (symmetric)
        limits = rep(max(abs(df[[value]]), na.rm=TRUE), 2) * c(-1, 1)

    po.nopanel = list(theme(
        panel.background = element_blank(),
        panel.grid.minor = element_blank(),
        panel.grid.major = element_blank(),
        axis.text.x = element_text(angle=45, hjust=1, size=text_size),
        axis.text.y = element_text(size=text_size))
    )

    p = ggplot(df, aes_string(x=cols, y=rows, fill=value))

    colors = RColorBrewer::brewer.pal(7, palette)
    if (reverse_colors)
        colors = rev(colors)

    if (geom == "tile")
        p = p + scale_fill_gradientn(colours=colors, na.value=na_value, limits=limits) +
                geom_tile(colour="white") #TODO: scale size here as well
#    else if (geom == "circle")
#        p = p + scale_colour_brewer(palette) + #,
##                                       na.value=na_value, limits=limits) +
#            scale_size_area(max_size = 20)+
##            scale_size_area(max_size = max_size,
##                            labels = levels(M$value)[table(M$value) > 0]) +
#            geom_point(aes(size = 15, colour = "white"))
    else
        stop("geom needs to be either 'tile' or 'circle'")

    p = p + po.nopanel
    if (is.null(label))
        p
    else
        p + geom_text(data=df, aes(label=label), size=text_size)
}


precno.preverjanje = function(podatki, razbitje, formula, algoritem, razvrscanje) {

  # pripravimo vektor za napovedi
  if (razvrscanje) {
    pp.napovedi = factor(rep(1, nrow(podatki)), levels = c(-1,1))
  } else {
    pp.napovedi = rep(0, nrow(podatki))
  }

  # gremo čez vse podmnožice Si razbitja S
  for (i in 1:length(razbitje)) {
    # naučimo se modela na množici S \ Si
    model = podatki[ -razbitje[[i]], ] %>% ucenje(formula, algoritem)

    # naučen model uporabimo za napovedi na Si
    pp.napovedi[ razbitje[[i]] ] = podatki[ razbitje[[i]], ] %>% napovedi(model, algoritem)
  }

  if (razvrscanje) {
    mean(pp.napovedi != podatki$yd)
  } else {
    mean((pp.napovedi - podatki$yn) ^ 2)
  }
}

# Razreži vektor x na k enako velikih kosov
razbitje = function(x, k) {

  # Razreži indekse vektorja na k intervalov
  razrez = cut(seq_along(x), k, labels = FALSE)

  # Razbij vektor na k seznamov
  # na osnovi razreza intervalov
  split(x, razrez)
}

pp.razbitje = function(n, k = 10, stratifikacija = NULL, seme = NULL) {

  # najprej nastavimo seme za naključna števila, če je podano
  if (!is.null(seme)) {
    set.seed(seme)
  }

  # če ne opravljamo stratifikacije, potem vrnemo navadno razbitje
  # funkcijo sample uporabimo zato, da naključno premešamo primere
  if (is.null(stratifikacija)) {
    return(razbitje(sample(1:length(n)), k))
  }

  # če pa opravljamo stratifikacijo, razbitje izvedemo za vsako
  # vrednost spremenljive stratifikacija posebej in nato
  # podmnožice združimo v skupno razbitje
  r = NULL
  for (v in levels(stratifikacija)) {

    # Če smo pri prvi vrednosti vzpostavimo razbitje
    if (is.null(r)) {
      # opravimo razbitje samo za primere z vrednostjo v
      r = razbitje(sample(which(stratifikacija == v)), k)
    } else {
      # opravimo razbitje za vrednost v
      # in podmnožice združimo s trenutnim razbitjem
      r.v = razbitje(sample(which(stratifikacija == v)), k)
      for (i in 1:k) {
        r[[i]] = c(r[[i]], r.v[[i]])
      }
    }
  }
  r
}


##edgeR_example.r
##2014-12-09 dmontaner@cipf.es
##We use edgeR to perform a differential gene expression analysis

##' clean the working space
rm (list = ls ())

##' load the library
library (edgeR)

##' prepare some variables
myfiles <- c ("g041_case.count", "g042_case.count", "g043_case.count", "g044_cont.count", "g045_cont.count", "g046_cont.count")
myclass <- c ("case", "case", "case", "cont", "cont", "cont")
mylabel <- c ("case1", "case2", "case3", "cont1", "cont2", "cont3")

cbind (myfiles, myclass, mylabel)

datos <- readDGE (files = myfiles, group = myclass, labels = mylabel)
class (datos)
datos
dim (datos)

##' Check that the counts are read properly:
##' from the shell:
##'    grep ENSG00000141959 g04*
system ("grep ENSG00000141959 g04*")

##' You can access to the full data matrix doing
datos$counts

##'As you can see their are some undesirable rows at the end.
tail (datos$counts)

##' We can exclude them
malos <- grepl ("_", rownames (datos$counts), )
table (malos)
datos[malos,]

datos <- datos[!malos,]
dim (datos)

##' now the last rows have been removed
tail (datos$counts)

##' We can compute counts per million
cpms <- cpm (datos)
summary (cpms)

##' cpms are very small in this example dataset.
##' We will not do it but generally,
##' features with less than 1 read per million are excluded form the analysis.

##' When gene lengths are available RPKMs can be computed using the function "rpkm"

##' Now we can start computing differential expression.
##' Fists we create a "DGEList" object:
dgeL <- DGEList (counts = datos, group = datos$samples$group)
dgeL
class (dgeL)

##' and compute normalization factors
dgeN <-  calcNormFactors (dgeL)
dgeN

##' We can explore the "relationship" between the samples
##' in a PCA wise plot
plotMDS (dgeN)

##' Now we will estimate dispersion
dgeD <- estimateCommonDisp (object = dgeN)
dgeD
dgeD <- estimateTagwiseDisp (object = dgeN)
dgeD

##' And finally we perform the statistical test
res <- exactTest (dgeD)
class (res)
res

##' You can find the most significant genes
topTags (res)

##'Find out all significant genes
padj <- p.adjust (res$table$PValue, "BH")
touse <- padj < 0.05
table (touse)
res[touse,]$table

## What does it mean the sign of the logFC?


LBList <- read.csv("./Desktop/Git/disruptionN-1/test/LBList.csv")
png(file = "./Desktop/Git/disruptionN-1/test/LBList.png", width= 10,height=6,units = 'in',res = 300);
par(mar = c(5,5,2,2));
plot(LBList$LB96,type = "l",ylim=range(c(0,40000)),xlab = "Iterations",ylab = "Obj Value",
     main = "Lower Bound", col = "#377EB8", lwd = 3, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(LBList$LB72, col = "#E41A1C", lwd = 3)
lines(LBList$LB48, col = "#4DAF4A", lwd = 3)
lines(LBList$LB24, col = "#984EA3", lwd = 3)
lines(LBList$LB12, col = "#FF7F00", lwd = 3)
legend("topleft",c("T = 96","T = 72","T = 48","T = 24","T = 12"), col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#FF7F00"),pch = 20,cex = 1.5)
dev.off();

tauList <- read.csv("./Desktop/Git/disruptionN-1/test/tauList.csv")
png(file = "./Desktop/Git/disruptionN-1/test/tauList.png", width= 10,height=6,units = 'in',res = 300);
par(mar = c(5,5,2,2));
plot(tauList$tau,tauList$LB,type = "l",ylim=range(c(1580,2800)),xlab = "Recovery Length",ylab = "Obj Value",
     main = "Cost vs. Recovery Length", col = "#377EB8", lwd = 5, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(tauList$tau, tauList$X1000_UB, col = "#E41A1C", lwd = 5)
legend("topleft",c("Lower bound","Simulated Estimation"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5)

dev.off();

#=============================================================================================
# plot 1: GenAll vs. DOnly
dOnlylb1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_lb_1.csv", header = FALSE)
dOnlylb2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_lb_2.csv", header = FALSE)
dOnlylb3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_lb_3.csv", header = FALSE)

dOnlyt1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_time_1.csv", header = FALSE)
dOnlyt2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_time_2.csv", header = FALSE)
dOnlyt3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_time_3.csv", header = FALSE)

outString = "./Desktop/Git/disruptionN-1/test/csvOut/GenAll.png"
png(file = outString, width= 13, height = 8, units = 'in',res = 300);
par(mfrow=c(2,3));
par(mar = c(5,5,2.5,2.5));
plot(1:20, dOnlylb1$V1[1:20], type = "l", xlim = range(c(1,100)), ylim=range(c(0,30000)), xlab = "Iteration", ylab = "LB", main = "Case 13",
      col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, dOnlylb1$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
legend("bottomright",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(1:20, dOnlylb2$V1[1:20], type = "l", xlim = range(c(1,100)), ylim=range(c(0,38000)), xlab = "Iteration", ylab = "LB", main = "Case 33",
      col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, dOnlylb2$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
legend("bottomright",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(1:20, dOnlylb3$V1[1:20], type = "l", xlim = range(c(1,100)), ylim=range(c(0,50000)), xlab = "Iteration", ylab = "LB", main = "Case 123",
      col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, dOnlylb3$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
legend("bottomright",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);

par(mar = c(5,5,1.5,2.5));
plot(1:19, dOnlyt1$V1[1:19], type = "l", xlim = range(c(1,100)), ylim=range(c(0,10000)), xlab = "Iteration", ylab = "Time (sec.)",
      col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, dOnlyt1$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
legend("topleft",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(1:20, dOnlyt2$V1[1:20], type = "l", xlim = range(c(1,100)), ylim=range(c(0,28000)), xlab = "Iteration", ylab = "Time (sec.)",
      col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, dOnlyt2$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
legend("topleft",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(1:19, dOnlyt3$V1[1:19], type = "l", xlim = range(c(1,100)), ylim=range(c(0,63000)), xlab = "Iteration", ylab = "Time (sec.)",
      col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, dOnlyt3$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
legend("topleft",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
dev.off();

# plot 2: preGen
outString = "./Desktop/Git/disruptionN-1/test/csvOut/pgFig.png"
png(file = outString, width= 13, height = 8, units = 'in',res = 300);
par(mfrow=c(2,3));
par(mar = c(5,5,2.5,2.5));
plot(1:100, dOnlylb1$V3[1:100], type = "l", ylim=range(c(0,30000)), xlab = "Iteration", ylab = "LB", main = "Case 13",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(1:100, dOnlylb1$V2[1:100], col = "#E41A1C", lwd = 2);
legend("bottomright",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(1:100, dOnlylb2$V3[1:100], type = "l", ylim=range(c(0,38000)), xlab = "Iteration", ylab = "LB", main = "Case 33",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(1:100, dOnlylb2$V2[1:100], col = "#E41A1C", lwd = 2);
legend("bottomright",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(1:100, dOnlylb3$V3[1:100], type = "l", ylim=range(c(0,50000)), xlab = "Iteration", ylab = "LB", main = "Case 123",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(1:100, dOnlylb3$V2[1:100], col = "#E41A1C", lwd = 2);
legend("bottomright",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);

par(mar = c(5,5,1.5,2.5));
plot(dOnlyt1$V3[1:100], type = "l", ylim=range(c(0,2500)), xlab = "Iteration", ylab = "Time (sec.)",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(dOnlyt1$V2[1:100], col = "#E41A1C", lwd = 2);
legend("topleft",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(dOnlyt2$V3[1:100], type = "l", ylim=range(c(0,5500)), xlab = "Iteration", ylab = "Time (sec.)",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(dOnlyt2$V2[1:100], col = "#E41A1C", lwd = 2);
legend("topleft",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(dOnlyt3$V3[1:100], type = "l", ylim=range(c(0,20000)), xlab = "Iteration", ylab = "Time (sec.)",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(dOnlyt3$V2[1:100], col = "#E41A1C", lwd = 2);
legend("topleft",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
dev.off();

# plot 3: NTest
Nlb1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_1.csv", header = FALSE)
Nlb2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_2.csv", header = FALSE)
Nlb3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_3.csv", header = FALSE)
Nlb4 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_4.csv", header = FALSE)
Nlb5 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_5.csv", header = FALSE)
#Nlb6 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_6.csv", header = FALSE)
#Nlb7 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_7.csv", header = FALSE)

Nt1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_1.csv", header = FALSE)
Nt2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_2.csv", header = FALSE)
Nt3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_3.csv", header = FALSE)
Nt4 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_4.csv", header = FALSE)
Nt5 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_5.csv", header = FALSE)
#Nt6 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_6.csv", header = FALSE)
#Nt7 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_7.csv", header = FALSE)

outString = "./Desktop/Git/disruptionN-1/test/csvOut/NFig.png"
png(file = outString, width= 13, height = 8, units = 'in',res = 300);
par(mfrow=c(2,3));
par(mar = c(5,5,2.5,2.5));
plot(1:500, Nlb1$V1[1:500], type = "l", ylim=range(c(0,30000)), xlab = "Iteration", ylab = "LB", main = "Case 13",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, Nlb2$V1[1:100], col = "#E41A1C", lwd = 2, log="x");
lines(1:50, Nlb3$V1[1:50], col = "#4DAF4A", lwd = 2, log="x");
lines(1:33, Nlb4$V1[1:33], col = "#984EA3", lwd = 2, log="x");
lines(1:25, Nlb5$V1[1:25], col = "#3CAEA3", lwd = 2, log="x");
legend("bottomright",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(1:500, Nlb1$V2[1:500], type = "l", ylim=range(c(0,38000)), xlab = "Iteration", ylab = "LB", main = "Case 33",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, Nlb2$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
lines(1:50, Nlb3$V2[1:50], col = "#4DAF4A", lwd = 2, log="x");
lines(1:33, Nlb4$V2[1:33], col = "#984EA3", lwd = 2, log="x");
lines(1:25, Nlb5$V2[1:25], col = "#3CAEA3", lwd = 2, log="x");
legend("bottomright",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(1:500, Nlb1$V3[1:500], type = "l", ylim=range(c(0,50000)), xlab = "Iteration", ylab = "LB", main = "Case 123",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(1:100, Nlb2$V3[1:100], col = "#E41A1C", lwd = 2, log="x");
lines(1:50, Nlb3$V3[1:50], col = "#4DAF4A", lwd = 2, log="x");
lines(1:33, Nlb4$V3[1:33], col = "#984EA3", lwd = 2, log="x");
lines(1:25, Nlb5$V3[1:25], col = "#3CAEA3", lwd = 2, log="x");
legend("bottomright",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(0:500, Nt1$V1[1:501], type = "l", ylim=range(c(0,6000)), xlab = "Iteration", ylab = "Time (sec.)",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(0:100, Nt2$V1[1:101], col = "#E41A1C", lwd = 2, log="x");
lines(0:50, Nt3$V1[1:51], col = "#4DAF4A", lwd = 2, log="x");
lines(0:33, Nt4$V1[1:34], col = "#984EA3", lwd = 2, log="x");
lines(0:25, Nt5$V1[1:26], col = "#3CAEA3", lwd = 2, log="x");
legend("topleft",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(0:500, Nt1$V2[1:501], type = "l", ylim=range(c(0,12000)), xlab = "Iteration", ylab = "Time (sec.)",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(0:100, Nt2$V2[1:101], col = "#E41A1C", lwd = 2, log="x");
lines(0:50, Nt3$V2[1:51], col = "#4DAF4A", lwd = 2, log="x");
lines(0:33, Nt4$V2[1:34], col = "#984EA3", lwd = 2, log="x");
lines(0:25, Nt5$V2[1:26], col = "#3CAEA3", lwd = 2, log="x");
legend("topleft",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(0:500, Nt1$V3[1:501], type = "l", ylim=range(c(0,28000)), xlab = "Iteration", ylab = "Time (sec.)",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(0:100, Nt2$V3[1:101], col = "#E41A1C", lwd = 2, log="x");
lines(0:50, Nt3$V3[1:51], col = "#4DAF4A", lwd = 2, log="x");
lines(0:33, Nt4$V3[1:34], col = "#984EA3", lwd = 2, log="x");
lines(0:25, Nt5$V3[1:26], col = "#3CAEA3", lwd = 2, log="x");
legend("topleft",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);
dev.off()

#=============================================================================================
# plot: GenAll vs. DOnly, LB against time
dOnlylb1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_lb_1.csv", header = FALSE)
dOnlylb2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_lb_2.csv", header = FALSE)
dOnlylb3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_lb_3.csv", header = FALSE)

dOnlyt1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_time_1.csv", header = FALSE)
dOnlyt2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_time_2.csv", header = FALSE)
dOnlyt3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/dOnly_time_3.csv", header = FALSE)

outString = "./Desktop/Git/disruptionN-1/test/csvOut/GenAll_LB.png"

png(file = outString, width= 13, height = 4.5, units = 'in',res = 300);
par(mfrow=c(1,3));
par(mar = c(5,5,2,2.5));
plot(dOnlyt1$V1[1:20],dOnlylb1$V1[1:20], type = "l", xlim = range(c(80,10000)), ylim=range(c(0,30000)), xlab = "Time (sec.)", ylab = "LB", main = "Case 13",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log = "x");
lines(dOnlyt1$V2[1:100],dOnlylb1$V2[1:100], col = "#E41A1C", lwd = 2, log = "x");
legend("bottomright",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(dOnlyt2$V1[1:20],dOnlylb2$V1[1:20], type = "l", xlim = range(c(30,28000)), ylim=range(c(0,38000)), xlab = "Time (sec.)", ylab = "LB", main = "Case 33",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(dOnlyt2$V2[1:100],dOnlylb2$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
legend("bottomright",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(dOnlyt3$V1[1:20],dOnlylb3$V1[1:20], type = "l", xlim = range(c(50,63000)), ylim=range(c(0,50000)), xlab = "Time (sec.)", ylab = "LB", main = "Case 123",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(dOnlyt3$V2[1:99],dOnlylb3$V2[1:99], col = "#E41A1C", lwd = 2, log="x");
legend("bottomright",c("GenAll","DOnly"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
dev.off();

# plot 2: preGen
outString = "./Desktop/Git/disruptionN-1/test/csvOut/pgFig_LB.png"
png(file = outString, width= 13, height = 4, units = 'in',res = 300);
par(mfrow=c(1,3));

par(mar = c(5,5,2,2.5));
plot(dOnlyt1$V3[1:100], dOnlylb1$V3[1:100], type = "l", xlim=range(c(0,2500)), xlab = "Time (sec.)", ylab = "LB", main = "Case 13",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(dOnlyt1$V2[1:100], dOnlylb1$V2[1:100], col = "#E41A1C", lwd = 2);
legend("bottomright",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(dOnlyt2$V3[1:100], dOnlylb2$V3[1:100], type = "l", xlim=range(c(0,5500)), xlab = "Time (sec.)", ylab = "LB", main = "Case 33",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(dOnlyt2$V2[1:100], dOnlylb2$V2[1:100], col = "#E41A1C", lwd = 2);
legend("bottomright",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
plot(dOnlyt3$V3[1:100], dOnlylb3$V3[1:100], type = "l", xlim=range(c(0,20000)), xlab = "Time (sec.)", ylab = "LB", main = "Case 123",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
lines(dOnlyt3$V2[1:100], dOnlylb3$V2[1:100], col = "#E41A1C", lwd = 2);
legend("bottomright",c("Pre-generated cuts","No pre-generated cuts"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
dev.off();

# plot 3: NTest
Nlb1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_1.csv", header = FALSE)
Nlb2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_2.csv", header = FALSE)
Nlb3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_3.csv", header = FALSE)
Nlb4 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_4.csv", header = FALSE)
Nlb5 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_5.csv", header = FALSE)
#Nlb6 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_6.csv", header = FALSE)
#Nlb7 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_lb_7.csv", header = FALSE)

Nt1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_1.csv", header = FALSE)
Nt2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_2.csv", header = FALSE)
Nt3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_3.csv", header = FALSE)
Nt4 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_4.csv", header = FALSE)
Nt5 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_5.csv", header = FALSE)
#Nt6 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_6.csv", header = FALSE)
#Nt7 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/N_time_7.csv", header = FALSE)

outString = "./Desktop/Git/disruptionN-1/test/csvOut/NFig_LB.png"
png(file = outString, width= 13, height = 8, units = 'in',res = 300);
par(mfrow=c(2,3));
par(mar = c(5,5,2.5,2.5));
plot(0:500, Nt1$V1[1:501], type = "l", ylim=range(c(0,6000)), xlab = "Iteration", ylab = "Time (sec.)", main = "Case 13",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(0:100, Nt2$V1[1:101], col = "#E41A1C", lwd = 2, log="x");
lines(0:50, Nt3$V1[1:51], col = "#4DAF4A", lwd = 2, log="x");
lines(0:33, Nt4$V1[1:34], col = "#984EA3", lwd = 2, log="x");
lines(0:25, Nt5$V1[1:26], col = "#3CAEA3", lwd = 2, log="x");
legend("topleft",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(0:500, Nt1$V2[1:501], type = "l", ylim=range(c(0,12000)), xlab = "Iteration", ylab = "Time (sec.)", main = "Case 33",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(0:100, Nt2$V2[1:101], col = "#E41A1C", lwd = 2, log="x");
lines(0:50, Nt3$V2[1:51], col = "#4DAF4A", lwd = 2, log="x");
lines(0:33, Nt4$V2[1:34], col = "#984EA3", lwd = 2, log="x");
lines(0:25, Nt5$V2[1:26], col = "#3CAEA3", lwd = 2, log="x");
legend("topleft",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(0:500, Nt1$V3[1:501], type = "l", ylim=range(c(0,28000)), xlab = "Iteration", ylab = "Time (sec.)", main = "Case 123",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(0:100, Nt2$V3[1:101], col = "#E41A1C", lwd = 2, log="x");
lines(0:50, Nt3$V3[1:51], col = "#4DAF4A", lwd = 2, log="x");
lines(0:33, Nt4$V3[1:34], col = "#984EA3", lwd = 2, log="x");
lines(0:25, Nt5$V3[1:26], col = "#3CAEA3", lwd = 2, log="x");
legend("topleft",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(Nt1$V1[1:500], Nlb1$V1[1:500], type = "l", ylim=range(c(0,30000)), xlab = "Time (sec.)", ylab = "LB",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(Nt2$V1[1:100], Nlb2$V1[1:100], col = "#E41A1C", lwd = 2, log="x");
lines(Nt3$V1[1:50], Nlb3$V1[1:50], col = "#4DAF4A", lwd = 2, log="x");
lines(Nt4$V1[1:33], Nlb4$V1[1:33], col = "#984EA3", lwd = 2, log="x");
lines(Nt5$V1[1:25], Nlb5$V1[1:25], col = "#3CAEA3", lwd = 2, log="x");
legend("bottomright",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(Nt1$V2[1:500], Nlb1$V2[1:500], type = "l", ylim=range(c(0,38000)), xlab = "Time (sec.)", ylab = "LB",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(Nt2$V2[1:100], Nlb2$V2[1:100], col = "#E41A1C", lwd = 2, log="x");
lines(Nt3$V2[1:50], Nlb3$V2[1:50], col = "#4DAF4A", lwd = 2, log="x");
lines(Nt4$V2[1:33], Nlb4$V2[1:33], col = "#984EA3", lwd = 2, log="x");
lines(Nt5$V2[1:25], Nlb5$V2[1:25], col = "#3CAEA3", lwd = 2, log="x");
legend("bottomright",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);

plot(Nt1$V3[1:500], Nlb1$V3[1:500], type = "l", ylim=range(c(0,50000)), xlab = "Time (sec.)", ylab = "LB",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2, log="x");
lines(Nt2$V3[1:100], Nlb2$V3[1:100], col = "#E41A1C", lwd = 2, log="x");
lines(Nt3$V3[1:50], Nlb3$V3[1:50], col = "#4DAF4A", lwd = 2, log="x");
lines(Nt4$V3[1:33], Nlb4$V3[1:33], col = "#984EA3", lwd = 2, log="x");
lines(Nt5$V3[1:25], Nlb5$V3[1:25], col = "#3CAEA3", lwd = 2, log="x");
legend("bottomright",c(expression(~N^p~" = 1",~N^p~" = 5",~N^p~" = 10",~N^p~" = 15",~N^p~" = 20")), , col = c("#377EB8","#E41A1C","#4DAF4A","#984EA3","#3CAEA3"),pch = 20,cex = 1.5);
dev.off()

# plot 4: UB plot
dOnlyub1 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/ub_1.csv", header = FALSE)
dOnlyub2 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/ub_2.csv", header = FALSE)
dOnlyub3 <- read.csv("./Desktop/Git/disruptionN-1/test/csvOut/ub_3.csv", header = FALSE)
redRGB <- col2rgb("#E41A1C");
red_1 <- rgb(redRGB[1]/255, redRGB[2]/255, redRGB[3]/255, alpha=0.7)

outString = "./Desktop/Git/disruptionN-1/test/csvOut/LBUB.png"
png(file = outString, width= 13, height = 4.5, units = 'in',res = 300);
par(mfrow=c(1,3));
par(mar = c(5,5,2,2.5));

plot(1:100,dOnlyub1$V1[1:100], type = "l", xlim = range(c(0,100)), ylim=range(c(0,50000)), xlab = "Iterations", ylab = "Bounds", main = "Case 13",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
points(1:100,dOnlyub1$V2[1:100], col = "#E41A1C", lwd = 2, pch = 16);
legend("bottomright",c("Lower Bound","StatisticalUpper Bound"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);

plot(1:100,dOnlyub2$V1[1:100], type = "l", xlim = range(c(0,100)), ylim=range(c(0,60000)), xlab = "Iterations", ylab = "Bounds", main = "Case 33",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
points(1:100,dOnlyub2$V2[1:100], col = "#E41A1C", lwd = 2, pch = 16);
legend("bottomright",c("Lower Bound","StatisticalUpper Bound"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);

plot(1:100,dOnlyub3$V1[1:100], type = "l", xlim = range(c(0,100)), ylim=range(c(0,60000)), xlab = "Iterations", ylab = "Bounds", main = "Case 123",
     col = "#377EB8", lwd = 2, cex.main = 2, cex.lab = 2, cex.axis = 2);
points(1:100,dOnlyub3$V2[1:100], col = "#E41A1C", lwd = 2, pch = 16);
legend("bottomright",c("Lower Bound","Statistical Upper Bound"), col = c("#377EB8","#E41A1C"),pch = 20,cex = 1.5);
dev.off()

#polygon(c(1:100,rev(1:100)), c(dOnlyub1$V3[1:100], rev(dOnlyub1$V4[1:100])), col = red_1, border = NA)


##############################
#
# Required Packages
#
require("ggplot2")
require("RSNNS")
require("scales")
require(grid)
require(graphics)

##############################
# Loading data
##############################

intel <- read.table("data/intel.csv", sep = ",", dec = ".", header = TRUE)
amd   <- read.table("data/amd.csv",   sep = ",", dec = ".", header = TRUE)

intel <- cbind(intel[ncol(intel)], data.frame(arch = "A1"))
amd   <- cbind(amd[ncol(amd)], data.frame(arch = "A2"))

both  <- rbind(intel, amd)
both$arch <- "Mix"

##############################
#
# Power Consumption Histogram
#
all <- rbind(intel, amd, both)

graph <- ggplot(all, aes(x = POWER_CONSUMPTION, fill = arch, color = arch)) +
  geom_histogram(aes(y = ..count../1000), binwidth = 2.5, alpha = .6, size = 0) +
  scale_fill_hue("Architecture") +
  scale_colour_hue("Architecture") +
  xlab("Power Consumption (W)") +
  ylab(expression("Frequency ("*E10^{-3}*")")) +
  facet_grid(. ~ arch) +
  theme(
    legend.position = "none",
    axis.text       = element_text(size = 6),
    text            = element_text(size = 8),
    axis.title.x    = element_text(vjust = -.5))

ggsave("../images/POWER_HISTOGRAM.pdf", graph, width = 8.25, height = 6, units = "cm")


#load data, fit a bunch of hierarchical models
rm(list=ls())
library(nlme)
library(MuMIn)
library(data.table)
library(boot)
library(betareg)

#output path.
output.path <- '/fs/data3/caverill/NEFI_microbial/model_fits/ted_frequentist.rds'

#load data
d <- data.table(readRDS('/fs/data3/caverill/NEFI_microbial/prior_data/ted_all_prior_data.rds'))

start.position <- grep("Ectomycorrhizal", colnames(d))

#function to transform [0,1] to (0,1) a la Cribari-Neto & Zeileis 2010
crib.fun <- function(x){(x * (length(x) - 1) + 0.5) / length(x)}
d[,start.position:ncol(d)] <- lapply(d[,start.position:ncol(d)],crib.fun)
#then logit transform.
d[,start.position:ncol(d)] <- lapply(d[,start.position:ncol(d)],logit)

#fit models of relative abundance
model.out.list <- list()
#specify columns to model- all relative abundances
to_model <- (d[,start.position:ncol(d)])
#specify fixed and random effects data.
fixed.effects <- d[,.(doy,MAT,MAP,MAT_CV,MAP_CV,pH,cn,latitude)]
random.effects <- d[,.(Site)]

#Run a model loop.
for(i in 1:ncol(to_model)){
  y <- to_model[,to_model[,..i]] #grab dependent variable
  data <- cbind(y,fixed.effects,random.effects) #build dataframe for analysis
  #specify model formula
  formula <- as.formula(paste(paste(colnames(y)),'~', paste(colnames(fixed.effects), collapse="+")))
  #run model
  mod <-  lm(formula, data = data)
  sum <- data.frame(summary(mod)[[4]])
  sum <- sum[-1,]
  #perform stepAIC on model, subset fixed effects to only include these predictors.
  s.AIC <- data.frame(summary(stepAIC(mod))[[4]])[-1,]
  fixed.effects.AIC <- fixed.effects[,rownames(s.AIC), with = F]
  #specify a new formula of fixed effects, if any predictors are significant
  if(length(fixed.effects.AIC) > 0){
    formula <- as.formula(paste(paste(colnames(y)),'~', paste(colnames(fixed.effects.AIC), collapse="+")))
    mod <- lm(formula, data = data)
  }
  #get model summary, R2 values, and a complete dataset with fitted values.
  out.data <- data.frame(y,fixed.effects.AIC,random.effects)
  out.data <- out.data[complete.cases(out.data),]
  out.data$fitted <- fitted(mod)
  #r.sq <- r.squaredGLMM(mod)
  r.sq <- summary(mod)$r.squared
  report.list <- list(mod,r.sq,out.data)
  names(report.list) <- c('model','r.sq','data')
  model.out.list[[i]] <- report.list
  names(model.out.list)[[i]] <- colnames(y)
}

#sort by r2 values because you are awful.
z <- data.frame(names(model.out.list))
out.r2m <- list()
out.r2c <- list()
out.preds <- list()
for(k in 1:length(model.out.list)){
  r2m <- model.out.list[[k]]$r.sq[1]
  r2c <- model.out.list[[k]]$r.sq[2]
  preds <- rownames(summary(model.out.list[[k]]$model)$tTable)
  out.r2c[[k]] <- r2c
  out.r2m[[k]] <- r2m
  out.preds[[k]] <- preds
}
z$r2m <- do.call('rbind',out.r2m)
z$r2c <- do.call('rbind',out.r2c)
z[order(-z$r2m),]

d <- model.out.list$Oidiodendron$data
plot(Oidiodendron ~ fitted, data = d, cex = 0.5, pch = 16)

saveRDS(model.out.list,output.path)

testing_development/tedersoo_fits/fishing hierarchical model fits to Tedersoo data set.r


### Import and Join Labels (W) with Predictors (X) and Outcomes (Y)
df_W = read.csv('_data/FIPS_ZCTA.csv', stringsAsFactors = FALSE) # Import dataset from _data folder
df_X = dbGetQuery(con_1, 'SELECT * FROM CDC_PLACES_2019_ZCTA') # Select first 6 lines from table with PostgreSQL query
df_WX = merge(df_W, df_X, by = 'ZCTA', how = 'inner') # Merge data frame into data slot in SpatialDataFrame
df_WX$population[!is.finite(df_WX$population)] <- 0
df_WX$mhlth_crudeprev <- df_WX$D1_23
df_WX$mhlth_percent <- df_WX$mhlth_crudeprev
df_WX$mhlth_count =  df_WX$mhlth_percent * df_WX$population / 100 # Calculate countd counts from rates
df_WX$total_pop <- df_WX$population
df_WX$mhlth_count[!is.finite(df_WX$mhlth_count)] <- 0
df_WX$mhlth_count = round(df_WX$mhlth_count, 0)
df_WX = df_WX[c('mhlth_count', 'mhlth_percent', 'total_pop', 'ZCTA')]
head(df_WX)
write.csv(df_WX, paste('_data/CDC_PLACES_2020_mhlth.csv', sep = ''), row.names = FALSE) # Clean in excel and select variable


library(ggplot2)
library(randomForest)

set.seed(1)
train <- read.csv("../input/train.csv", stringsAsFactors=FALSE)
test  <- read.csv("../input/test.csv",  stringsAsFactors=FALSE)

featuresExtraction <- function(data) {
  featuresSelection <- c("Sex",
                       "Age",
                       "SibSp",
                       "Parch",
                       "Fare")
  features <- data[,featuresSelection]
  features$Sex      <- as.factor(features$Sex)
  features$Age[is.na(features$Age)] <- -1
  features$Fare[is.na(features$Fare)] <- median(features$Fare, na.rm=TRUE)

  return(features)
}

rf <- randomForest(featuresExtraction(train), as.factor(train$Survived), ntree=100, importance=TRUE)

submission <- data.frame(PassengerId = test$PassengerId)
submission$Survived <- predict(rf, featuresExtraction(test))
write.csv(submission, file = " RandomForest_Data.csv", row.names=FALSE)

imp <- importance(rf, type=1)
featureImportance <- data.frame(Feature=row.names(imp), Importance=imp[,1])

boxplot <- qplot(x=Features, y=Importance, geom=”boxplot”)

ggsave("boxplot_rf.png", boxplot)


#' PPD
#'
#' Predicted Percentage of Dissatisfied (PPD) predicts the percentage of occupants that will be dissatisfied with the thermal conditions.
#'
#' @param PMV numeric Predicted Mean Vote.
#' @return Predicted Percentage of Dissatisfied
#'
#'
#' @author Istituto per la Bioeconomia CNR Firenze Italy  Alfonso Crisci \email{alfonso.crisci@@ibe.cnr.it}
#' @keywords  PPD
#' @references UNI EN ISO 7730.
#' @export
#'
#'
#'
#'

PPD=function(PMV) {
                         ct$assign("PMV", as.array(PMV))
                         ct$eval("var res=[]; for(var i=0, len=PMV.length; i < len; i++){ res[i]=PPD(PMV[i])};")
                         res=ct$get("res")
                         return(ifelse(res==9999,NA,res))
}


# Copyright Syncfusion Inc. 2001 - 2016. All rights reserved.
# Use of this code is subject to the terms of our license.
# A copy of the current license can be obtained at any time by e-mailing
# licensing@syncfusion.com. Any infringement will be prosecuted under
# applicable laws.

# If you are not familiar with R you can obtain a quick introduction by downloading
# R Succinctly for free from Syncfusion - http://www.syncfusion.com/resources/techportal/ebooks/rsuccinctly
# R Succinctly is also included with this installation and is available here
# Installed Drive :\Program Files (x86)\Syncfusion\Essential Studio\XX.X.X.XX\Infrastructure\EBooks\R_Succintly.pdf OF R Succinctly
# Uncomment below lines to install necessary packages if not installed already
#install.packages("gbm")
#install.packages("devtools")
#install.packages("rJava")
#install.packages("TH.data")
#install.packages("githubinstall")
#Use 'r2pmml' package version v0.3.0 or below since, the function 'huberized' has been deprecated in later versions.
#library(githubinstall)
#gh_install_packages("jpmml/r2pmml", ref="0.3.0")

# Load below packages
library(devtools)
library(gbm)
library(rJava)
library(r2pmml)
library(TH.data)# This package is specifically loaded for GBSG2 dataset shipped within it.

# Here we directly load the breastCancer dataset installed with the "TH.data" package.
data(GBSG2)

# rename column names in GBSG2 dataset from TH.data package
breastCancerOriginal <- setNames(GBSG2, c("Hormonal_Therapy", "Age", "Menopausal_Status", "Tumor_Size", "Tumor_Grade", "Positive_Nodes", "Progesterone", "Estrogen_Receptor",
"Survival_Time", "Indicator"))

# Omit rows with missing values
breastCancerOriginal = na.omit(breastCancerOriginal)

# Code below demonstrates loading the same dataset from a CSV file shipped with our installer.
# Please check installed samples (Data) location to set actual working directory
# Uncomment below lines and comment out the code to read data from CSV file.
# setwd("C:/actual_data_location")
# breastCancer= read.csv("BreastCancer.csv")

# Divide dataset for training and test
trainData<-breastCancerOriginal[1:549,]
testData<-breastCancerOriginal[550:686,]

# Applying the GBM - huberized function to predict cens
breastCancer_GBM = gbm(Indicator~., data=trainData,distribution="huberized")

# Display the predicted results
# Predict "cens" column probability for test data set
breastCancerTestProbabilities = predict.gbm(breastCancer_GBM, newdata=testData, n.trees=100,type="response")
# Display predicted probabilities
breastCancerTestProbabilities

# PMML generated will be of version v4.2 since, older version(v0.3.0) 'r2pmml' has been loaded.
r2pmml(breastCancer_GBM ,"BreastCancer.pmml")

# The code below is used for evaluation purpose.
# The model is applied for original breastCancer data set and predicted results are saved in "ROutput.csv"
# "ROutput.csv" file used for comparing the R results with PMML Evaluation engine results

# Applying GBM to entire dataset and save the results in a CSV file
breastCancerEntireProbabilities = predict.gbm(breastCancer_GBM,breastCancerOriginal, n.trees=100,type="response")

# Save predicted value in a data frame
result = data.frame(breastCancerEntireProbabilities)
names(result) = c("Predicted_censored")

# Write the results in a CSV file
write.csv(result,"ROutput.csv",quote=F)


suppressPackageStartupMessages(library(singscore))
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggplot2))

seed <- 1234
num_permutations <- 1000

set.seed(seed)

sig_cols <- readr::cols(
  feature = readr::col_character(),
  estimate = readr::col_double(),
  adj.p.value = readr::col_double()
)

sig_file <- file.path("results", "cloneAE_signature_tukey.tsv")
psmb_signature_scores <- readr::read_tsv(sig_file, col_types=sig_cols)

head(psmb_signature_scores, 2)

# Extract features that are up and down in the signature
up_features <- psmb_signature_scores %>% dplyr::filter(estimate > 0) %>% dplyr::pull(feature)
down_features <- psmb_signature_scores %>% dplyr::filter(estimate < 0) %>% dplyr::pull(feature)

col_types <- readr::cols(
    .default = readr::col_double(),
    Metadata_Plate = readr::col_character(),
    Metadata_Well = readr::col_character(),
    Metadata_plate_map_name = readr::col_character(),
    Metadata_clone_number = readr::col_character(),
    Metadata_clone_type = readr::col_character(),
    Metadata_plate_ID = readr::col_character(),
    Metadata_plate_filename = readr::col_character(),
    Metadata_treatment = readr::col_character(),
    Metadata_batch = readr::col_character()
)

# Do not load the feature selected data
profile_dir <- file.path("..", "2.describe-data", "data", "merged")
profile_file <- file.path(profile_dir, "combined_four_clone_dataset.csv")

fourclone_data_df <- readr::read_csv(profile_file, col_types = col_types)

print(dim(fourclone_data_df))
head(fourclone_data_df, 2)

# Generate unique sample names (for downstream merging of results)
sample_names <- paste(
    fourclone_data_df$Metadata_clone_number,
    fourclone_data_df$Metadata_Plate,
    fourclone_data_df$Metadata_Well,
    fourclone_data_df$Metadata_batch,
    sep = "_"
)

fourclone_data_df <- fourclone_data_df %>%
    dplyr::mutate(Metadata_unique_sample_name = sample_names)

# Convert the four clone dataset into a feature x sample matrix without metadata
features_only_df <- t(fourclone_data_df %>% dplyr::select(!starts_with("Metadata_")))

# Apply the `rankGenes()` method to get feature rankings per feature for each sample
rankData <- rankGenes(features_only_df)
colnames(rankData) <- fourclone_data_df$Metadata_unique_sample_name

print(dim(rankData))
head(rankData, 3)

# Using the rank dataframe, up, and down features, get the sample scores
scoredf <- simpleScore(rankData, upSet = up_features, downSet = down_features)

# Merge scores with metadata features
full_result_df <- dplyr::bind_cols(
    fourclone_data_df %>% dplyr::select(starts_with("Metadata_")),
    scoredf
    )

print(dim(full_result_df))
head(full_result_df, 2)

# Generate a null distribution of scores by randomly shuffling ranks
permuteResult <- generateNull(
    upSet = up_features,
    downSet = down_features,
    rankData = rankData,
    centerScore = TRUE,
    knownDirection = TRUE,
    B = num_permutations,
    seed = seed,
    useBPPARAM = NULL
)

# Calculate p values and add to list
pvals <- getPvals(permuteResult, scoredf)
pval_tidy <- broom::tidy(pvals)
colnames(pval_tidy) <- c("names", "Metadata_permuted_p_value")

full_result_df <- full_result_df %>%
    dplyr::left_join(
        pval_tidy,
        by = c("Metadata_unique_sample_name" = "names")
    )

# Are there differences in quantiles across batch?
batch_info <- gsub("^.*_", "", rownames(t(permuteResult)))
batch_permute <- t(permuteResult) %>%
    dplyr::as_tibble() %>%
    dplyr::mutate(batch = batch_info)

permute_bounds <- list()
for (batch_id in unique(batch_permute$batch)) {
    subset_permute <- batch_permute %>% dplyr::filter(batch == !!batch_id) %>% dplyr::select(!batch)
    min_val <- quantile(as.vector(as.matrix(subset_permute)), 0.005)
    max_val <- quantile(as.vector(as.matrix(subset_permute)), 0.995)
    permute_bounds[[batch_id]] <- c(batch_id, min_val, max_val)
}

do.call(rbind, permute_bounds)

min_val <- quantile(as.vector(as.matrix(permuteResult)), 0.05)
max_val <- quantile(as.vector(as.matrix(permuteResult)), 0.95)

apply_psmb_signature_gg <- ggplot(full_result_df,
       aes(y = TotalScore,
           x = Metadata_clone_number)) +
    geom_boxplot(aes(fill = Metadata_treatment), outlier.alpha = 0) +
    geom_point(
        aes(fill = Metadata_treatment, group = Metadata_treatment),
        position = position_dodge(width=0.75),
        size = 0.9,
        alpha = 0.7,
        shape = 21) +
    scale_fill_manual(name = "Treatment",
                      labels = c("bortezomib" = "Bortezomib", "DMSO" = "DMSO"),
                      values = c("bortezomib" = "#9e0ba3", "DMSO" = "#fcba03")) +
    theme_bw() +
    annotate("rect", ymin = min_val,
              ymax = max_val,
              xmin = 0,
              xmax = length(unique(full_result_df$Metadata_clone_number)) + 1,
              alpha = 0.2,
              color = "red",
              linetype = "dashed",
              fill = "grey") +
    xlab("") +
    ylab("PSMB5 Signature Score") +
    theme(axis.text.x = element_text(angle=90)) +
    facet_wrap("Metadata_batch~Metadata_plate_ID", nrow=3) +
    theme(strip.text = element_text(size = 8, color = "black"),
          strip.background = element_rect(colour = "black", fill = "#fdfff4"))

output_fig <- file.path("figures", "signature", "psmb5_signature_apply_fourclone.png")
ggsave(output_fig, dpi = 500, height = 5, width = 10)
apply_psmb_signature_gg

summarized_mean_result_df <- full_result_df %>%
    dplyr::group_by(
        Metadata_batch, Metadata_plate_map_name, Metadata_clone_number, Metadata_treatment, Metadata_clone_type
    ) %>%
    dplyr::mutate(mean_score = mean(TotalScore)) %>%
    dplyr::select(
        Metadata_batch, Metadata_plate_map_name, Metadata_clone_number, Metadata_clone_type, Metadata_treatment, mean_score
    ) %>%
    dplyr::distinct() %>%
    tidyr::spread(key = "Metadata_treatment", value = "mean_score") %>%
    dplyr::mutate(treatment_score_diff = DMSO - bortezomib)

head(summarized_mean_result_df)

apply_psmb_signature_diff_gg <- ggplot(summarized_mean_result_df,
       aes(y = treatment_score_diff,
           x = Metadata_clone_number,
           fill = Metadata_clone_type)) +
    geom_boxplot(outlier.alpha = 0) +
    geom_jitter(
        width = 0.2,
        size = 2,
        alpha = 0.7,
        shape = 21) +

    scale_fill_manual(name = "Clone Type",
                      labels = c("resistant" = "Resistant", "wildtype" = "Wildtype"),
                      values = c("resistant" = "#9e0ba3", "wildtype" = "#fcba03")) +
    theme_bw() +
    xlab("") +
    ylab("Difference PSMB5 Signature Score\nDMSO - Bortezomib") +
    theme(axis.text.x = element_text(angle=90)) +
    theme(strip.text = element_text(size = 8, color = "black"),
          strip.background = element_rect(colour = "black", fill = "#fdfff4"))

output_fig <- file.path("figures", "signature", "psmb5_signature_apply_fourclone_difference.png")
ggsave(output_fig, dpi = 500, height = 4.5, width = 6)

apply_psmb_signature_diff_gg

sig_file <- file.path("results", "fourclone_signature_tukey.tsv")
resistance_signature_scores <- readr::read_tsv(sig_file, col_types=sig_cols)

head(resistance_signature_scores, 2)

# Extract features that are up and down in the signature
up_resistance_features <- resistance_signature_scores %>%
    dplyr::filter(estimate > 0) %>%
    dplyr::pull(feature)

down_resistance_features <- resistance_signature_scores %>%
    dplyr::filter(estimate < 0) %>%
    dplyr::pull(feature)

# Do not load the feature selected data
profile_file <- file.path(profile_dir, "combined_cloneAcloneE_dataset.csv")

cloneae_cols <- readr::cols(
  .default = readr::col_double(),
  Metadata_CellLine = readr::col_character(),
  Metadata_Plate = readr::col_character(),
  Metadata_Well = readr::col_character(),
  Metadata_batch = readr::col_character(),
  Metadata_plate_map_name = readr::col_character(),
  Metadata_clone_type = readr::col_character()
)

cloneAE_data_df <- readr::read_csv(profile_file, col_types = cloneae_cols)

print(dim(cloneAE_data_df))
head(cloneAE_data_df, 2)

# Generate unique sample names (for downstream merging of results)
cloneae_sample_names <- paste(
    cloneAE_data_df$Metadata_CellLine,
    cloneAE_data_df$Metadata_Plate,
    cloneAE_data_df$Metadata_Well,
    cloneAE_data_df$Metadata_batch,
    sep = "_"
)

cloneAE_data_df <- cloneAE_data_df %>%
    dplyr::mutate(Metadata_unique_sample_name = cloneae_sample_names)

# Convert the four clone dataset into a feature x sample matrix without metadata
features_only_res_df <- t(cloneAE_data_df %>% dplyr::select(!starts_with("Metadata_")))

# Apply the `rankGenes()` method to get feature rankings per feature for each sample
rankData_res <- rankGenes(features_only_res_df)
colnames(rankData_res) <- cloneAE_data_df$Metadata_unique_sample_name

print(dim(rankData_res))
head(rankData_res, 3)

# Using the rank dataframe, up, and down features, get the sample scores
scoredf_res <- simpleScore(rankData_res,
                           upSet = up_resistance_features,
                           downSet = down_resistance_features)

# Merge scores with metadata features
full_res_result_df <- dplyr::bind_cols(
    cloneAE_data_df %>% dplyr::select(starts_with("Metadata_")),
    scoredf_res
    )

print(dim(full_res_result_df))
head(full_res_result_df, 2)

# Generate a null distribution of scores by randomly shuffling ranks
permuteResult_res <- generateNull(
    upSet = up_resistance_features,
    downSet = down_resistance_features,
    rankData = rankData_res,
    centerScore = TRUE,
    knownDirection = TRUE,
    B = num_permutations,
    seed = seed,
    useBPPARAM = NULL
)

# Calculate p values and add to list
pvals_res <- getPvals(permuteResult_res, scoredf_res)
pval_res_tidy <- broom::tidy(pvals)
colnames(pval_res_tidy) <- c("names", "Metadata_permuted_p_value")

full_res_result_df <- full_res_result_df %>%
    dplyr::left_join(
        pval_res_tidy,
        by = c("Metadata_unique_sample_name" = "names")
    )

min_val <- quantile(as.vector(as.matrix(permuteResult_res)), 0.05)
max_val <- quantile(as.vector(as.matrix(permuteResult_res)), 0.95)

append_dose <- function(string) paste0("Dose: ", string, "nM")

apply_res_signature_gg <- ggplot(full_res_result_df,
       aes(y = TotalScore,
           x = Metadata_CellLine)) +
    geom_boxplot(aes(fill = Metadata_clone_type), outlier.alpha = 0) +
    geom_point(
        aes(fill = Metadata_clone_type, group = Metadata_clone_type),
        position = position_dodge(width=0.75),
        size = 0.9,
        alpha = 0.7,
        shape = 21) +
    scale_fill_manual(name = "Clone Type",
                      labels = c("resistant" = "Resistant", "wildtype" = "WildType"),
                      values = c("resistant" = "#f5b222", "wildtype" = "#4287f5")) +
    theme_bw() +
    annotate("rect", ymin = min_val,
                  ymax = max_val,
                  xmin = 0,
                  xmax = length(unique(full_res_result_df$Metadata_CellLine)) + 1,
                  alpha = 0.2,
                  color = "red",
                  linetype = "dashed",
                  fill = "grey") +
    xlab("") +
    ylab("Generic Resistance Signature Score") +
    theme(axis.text.x = element_text(angle=90)) +
    facet_grid("Metadata_Dosage~Metadata_batch",
               labeller = labeller(Metadata_Dosage = as_labeller(append_dose))) +
    theme(strip.text = element_text(size = 8, color = "black"),
          strip.background = element_rect(colour = "black", fill = "#fdfff4"))

output_fig <- file.path("figures", "signature", "generic_resistance_signature_apply_cloneAE.png")
ggsave(output_fig, dpi = 500, height = 5, width = 5)
apply_res_signature_gg

full_res_result_df$Metadata_Dosage <- factor(
    full_res_result_df$Metadata_Dosage, levels = unique(sort(full_res_result_df$Metadata_Dosage))
)
full_res_result_df <- full_res_result_df %>%
    dplyr::mutate(Metadata_group = paste0(Metadata_batch, Metadata_CellLine))

ggplot(full_res_result_df, aes(x = Metadata_Dosage, y = TotalScore, color = Metadata_CellLine, group = Metadata_group)) +
    geom_point(size = 1) +
    geom_smooth(aes(fill = Metadata_clone_type), method = "loess", lwd = 0.5) +
    facet_wrap("~Metadata_batch", nrow = 2) +
    theme_bw() +
    scale_fill_manual(name = "Clone Type",
                          labels = c("resistant" = "Resistant", "wildtype" = "WildType"),
                          values = c("resistant" = "#f5b222", "wildtype" = "#4287f5")) +
    ylab("Generic Resistance Signature Score") +
    annotate("rect", ymin = min_val,
                      ymax = max_val,
                      xmin = 0,
                      xmax = length(unique(full_res_result_df$Metadata_CellLine)) + 2,
                      alpha = 0.2,
                      color = "red",
                      linetype = "dashed",
                      fill = "grey") +
    theme(strip.text = element_text(size = 8, color = "black"),
          strip.background = element_rect(colour = "black", fill = "#fdfff4"))

output_fig <- file.path("figures", "signature", "generic_resistance_signature_apply_cloneAE_xaxis_dosage.png")
ggsave(output_fig, dpi = 500, height = 5, width = 5)