#+++++++++++++++++++++++++++++++++++++++++++++++++++++++#	
	 		#														#
			#	Association testing between haplotypes and			#
			#	recessive disorders using information from			#
			#	affected individuals, their parents and				#
			#	unaffected controls									#
			#														#
			#	Hubert Pausch (hubert.pausch@usys.ethz.ch)			#  
			#	22.09.2016											#
			#														#
			#														#
			#  This R script requires following files:				#
			#    - phenotype file in plink format					#
			#    - haplotype file in MaCH/Minimac format			#
			#    - map-file in plink format							#
			#    - eigenvector file in GCTA format					#
			#														#
			#  original article (pre-print):						#
		    #  http://biorxiv.org/content/early/2016/07/09/062968	# 
			#														#	
			#+++++++++++++++++++++++++++++++++++++++++++++++++++++++#



#*************************************************
#*************************************************

chr <- 22				#chromosome to be analysed

sliding_window <- 5		#number of SNPs
haplo_length <- 20		#width of the sliding window [in number of SNPs]
min_haplo_freq <- 0.05	#minimum haplotype frequency considered for association testing

pheno <- read.table('pheno_epiderm_bullosa.txt', colClasses=c(rep('character', 2), 'numeric'))
haplo_file <- read.table(paste('phased_BTA', chr, '.txt', sep=''), colClasses='character')
map_file <- read.table(paste('BTA', chr, '.map.txt', sep=''), colClasses=c('numeric','character', rep('numeric', 2)))
evec_file <- read.table('vwd.eigenvec.txt', colClasses=c(rep('character', 2), rep('numeric', 10)))

#*************************************************
#*************************************************



names(pheno)[2] <- names(haplo_file)[1] <- names(evec_file)[2] <- 'ID'
pheno <- pheno[!is.na(pheno[,3]),]

haplo_file[,1] <- unlist(strsplit(haplo_file[ ,1], '->'))[seq(from=2, by=2, to=nrow(haplo_file)*2)]
haplo_file <- merge(haplo_file, pheno, by='ID')
haplo_file <- merge(haplo_file, evec_file[ ,c(2:ncol(evec_file))], by='ID')
evecs <- haplo_file[seq(from=1, by=2, to=nrow(haplo_file)), c(6:ncol(haplo_file))]
haplo_file <- haplo_file[ ,c(1:5)]
phenotype <- haplo_file[seq(from=1, by=2, to=nrow(haplo_file)), 5]
table(phenotype)

min_haplos <- round(min_haplo_freq * nrow(haplo_file), 0)

ht1 <- seq(from=1, by=2, to=nrow(haplo_file))
ht2 <- seq(from=2, by=2, to=nrow(haplo_file))

n_snps <- nchar(haplo_file[1, 3])
window_starts <- sort(unique(c(seq(from=1, by=sliding_window, to=(n_snps-haplo_length+sliding_window)), n_snps-haplo_length)))

collect_results <- numeric(0)
for (i in 1:length(window_starts[window_starts+haplo_length <= n_snps])){
	hts <- substr(haplo_file[,3], window_starts[i], window_starts[i]+haplo_length)
 	if (length(which(table(hts)>=min_haplos)) >= 1){
 		for (j in 1:length(names(which(table(hts) >= min_haplos)))){
 			test_ht <- names(which(table(hts) >= min_haplos))[j]
            fq <- length(hts[hts==test_ht])/length(hts)
            count <- rep(0, length(ht1))
            count[hts[ht1]==test_ht] <- 1
            count[hts[ht2]==test_ht] <- count[hts[ht2]==test_ht]+1
			model <- summary(lm(phenotype~count+as.matrix(evecs)))
			stats_ht <- c(i,j, test_ht, fq, length(count[count==0]),length(count[count==1]),length(count[count==2]), model$coefficients[2,1], model$coefficients[2,2], model$coefficients[2,4])
			collect_results <- rbind(collect_results, stats_ht)
		}
	}
}

outfile <- as.data.frame(cbind(rep(chr,nrow(collect_results)), window_starts[as.numeric(collect_results[,1])], window_starts[as.numeric(collect_results[,1])]+haplo_length, map_file[window_starts[as.numeric(collect_results[,1])],4], map_file[window_starts[as.numeric(collect_results[,1])]+haplo_length,4], collect_results[,3], collect_results[,4] , collect_results[,5], collect_results[,6], collect_results[,7], collect_results[,8], collect_results[,9], collect_results[,10]), row.names=c(1:nrow(collect_results)), stringsAsFactors=FALSE)
colnames(outfile) <- c('CHR', 'startSNP', 'stopSNP', 'startPosition', 'stopPosition', 'Haplotype', 'fq', 'AA', 'AB', 'BB', 'beta', 'se_beta', 'pval')

#get 10 most significantly associated haplotypes:
head(outfile[order(as.numeric(outfile$pval)), ], 10)

plot((as.numeric(outfile$startPosition)+as.numeric(outfile$stopPosition))/2/1000000, as.numeric(-log10(as.numeric(outfile$pval))), xlab='Position (Mb)', ylab='-log10(P)', main=paste('Chromosome ', chr, sep=''))