# R script to process Data set 1 with PolyHaplotyper, SATlotyper,
# Happy-inf and ShesisPlus

rm(list=ls()) # clear existing data from memory  

# If the PolyHaplotyper package was not yet installed this must be done first.
# This is straightforward as it is available on CRAN:
install.packages("PolyHaplotyper")

# We assume that the working directory contains file Dataset1_chrysanthemum.RData
load("Dataset1_chrysanthemum.RData")



# PolyHaplotyper ###############################################################
 
library(PolyHaplotyper)

# For this demo we include a small list which contains all haplotype
# combinations that match the SNP dosage combinations that occur in Data set 1.
# This list must first be saved to a file:
save(ahclist, file="ahclist_6x.RData")
# (normally we would use a precalculated list with all haplotype combinations 
# matching all possible SNP dosage combinations, but that would make Data set 1
# much larger) 

# 
# Perform the haplotyping, and time it:
timestr <- format(Sys.time(), format="%Y%m%d-%H%M%S")  
pt <- proc.time()
PHresults <- 
  inferHaplotypes(mrkDosage=dosmat, ploidy=6, 
                  haploblock=hapblocks, 
                  parents=parents, FS=FS,
                  printtimes=TRUE) 
print(proc.time() - pt)

# Generate an overview of the results per haploblock for the four FS families:
PHovwFS <- overviewByFS(haploblock=hapblocks, parents=parents, FS=FS,
                        hapresults=PHresults)

# Determine for each haploblock and individual if the haplotype composition
# is possible, given the haplotype composition(s) of the parent(s),
# and without or with allowing for double reduction:
PHpedchk <- pedigreeHapCheck(ped=ped, mrkDosage=dosmat,
                             haploblock=hapblocks,
                             hapresults=PHresults)

# Make a summary of the pedigree checks and the FS family checks
PHcst <- calcStatistics(pedchk=PHpedchk, ovwFS=PHovwFS)
print(PHcst)
print(colSums(PHcst$pedstats[, -1]))
# check for conflicts between inferred haplotypes and observed marker dosages
cmpdos <- compareHapMrkDosages(mrkDosage=dosmat, hapresults=PHresults)
print(table(cmpdos[,,"match"], useNA="always")) 
#FALSE=conflict, TRUE=match, NA=no marker or haplotyping data

# Save results:
save(PHresults, PHovwFS, PHpedchk, PHcst,
     file=paste0("PHresults_", timestr, ".RData"))



# SATlotyper ###################################################################

# Version used was downloaded on 20 January 2020 from
# http://www.gabipd.org/projects/satlotyper/
# Installation: extract contents of downloaded file SATlotyper_v0.1.5.zip 
# to some directory.
# 
# SATlotyper can be run from R using a function in PolyHaplotyper; 
# for this the path to the SATlotyper.jar file is needed.
# modify SATpath to the directory where SATlotyper.jar resides:
SATpath <- "" 
# e.g. SATpath <- "d:/Data/Haplotyping software/SATlotyper/SATlotyper_v0.1.5" 

# also we assume that PolyHaplotyper is available and 
# Dataset1_chrysanthemum.RData has been loaded
# 
# We convert data to SATlotyper format, run SATlotyper, and convert the
# results to PolyHaplotyper format in three separate steps, to allow
# timing of the SATlotyper execution itself.

# Create SATlotyper input files using a function in PolyHaplotyper:
for (hb in names(hapblocks)) {
  fname <- paste0("SAT_", hb, ".dat")
  SATdat <- 
    make.SATlotyper.input(mrkDosage=dosmat, 
                          markers=hapblocks[[hb]], 
                          ploidy=6, 
                          fname=fname)
}

# Perform the haplotyping (using a function in PolyHaplotyper), and time it:
timestr <- format(Sys.time(), format="%Y%m%d-%H%M%S")  
pt <- proc.time()
SAToutput <- list()
for (hb in names(hapblocks)) {
  infile <- paste0("SAT_", hb, ".dat")
  outfile <- paste0("SAT_", hb, "_", timestr, "_result.xml")
  SAToutput[[hb]] <- run.SATlotyper(path_to_SATlotyper=SATpath,
                                    infile=infile, 
                                    outfile=outfile)
}
print(proc.time() - pt)
# note that the elapsed time is much larger than the user time;
# this is because the SATlotyper processing is done outside R

# Convert the SATlotyper results to PolyHaplotyper format:
# (using a function in PolyHaplotyper)
SATresults <- list()
for (hb in names(hapblocks)) {
  SATresults[[hb]] <- 
    read.SATlotyper.output(fname=paste0("SAT_", hb, "_", timestr, "_result.xml"), 
                           output=SAToutput[[hb]],
                           allelecodes=c("A", "B"), 
                           sep="\t", haploblockname=hb)
}

# Perform the pedigree check as for PolyHaplotyper,
# but not the FS family overview, as SATlotyper does not know about
# FS families:
SATpedchk <- pedigreeHapCheck(ped=ped, mrkDosage=dosmat,
                              haploblock=hapblocks,
                              hapresults=SATresults)

# Make a summary of the pedigree checks
SATcst <- calcStatistics(pedchk=SATpedchk)
print(SATcst)
print(colSums(SATcst$pedstats[, -1]))
# check for conflicts between inferred haplotypes and observed marker dosages
cmpdos <- compareHapMrkDosages(mrkDosage=dosmat, hapresults=SATresults)
print(table(cmpdos[,,"match"], useNA="always")) 
#FALSE=conflict, TRUE=match, NA=no marker or haplotyping data

# Save results:
save(SAToutput, SATresults, SATpedchk, SATcst,
     file=paste0("SATresults_", timestr, ".RData"))



# Happy-inf ####################################################################

# Create Happy-inf input files using a function in PolyHaplotyper:
make.Happyinf.input(mrkDosage=dosmat, haploblock=hapblocks, ploidy=6,
                    fname="Happyinf.dat")

# Happy-inf Version V1 was downloaded on 14 September 2020 from
# https://git.wageningenur.nl/wille094/Happy-haplotype-inference/-/tree/master/V1
# copy happy-inf.py to some directory
# Installation (under Windows10) according to Readme.md, using python 2.7: 
# - Open an Anaconda Powershell Prompt window and enter the following commands: 
# > conda create -n happy-inf python=2.7.* 
# > conda activate happy-inf
# > pip install scipy numpy 
#
# Run Happy-inf; in the following,
# - replace <wd> by the working directory where you just created Happyinf.dat
# - replace <HAPpath> by the path to the directory where haplotyper.py resides
# - the "double quotes" are needed if the paths contain spaces
# > cd "<wd>"
# > conda activate happy-inf
# > python "<HAPpath>/happy-inf.py" -i Happyinf.dat -ploidy 6 -join -o HappyOut -joining_steps 100
# 
# Happy-inf prints its own timing data

# Rename the Happy-inf files with a unique name,
# so new runs won't overwrite them:
timestr <- format(Sys.time(), format="%Y%m%d-%H%M%S")  
file.rename(from=paste0("HappyOut.", c("blk", "freq", "haplotypes", "stat"), ".dat"),
            to=paste0("HappyOut_", timestr, ".", 
                      c("blk", "freq", "haplotypes", "stat"), ".dat"))
# Convert the Happy-inf results to PolyHaplotyper format:
# (using a function in PolyHaplotyper)
HAPresults <- read.Happyinf.output(file_prefix=paste0("HappyOut_", timestr))

# Perform the pedigree check as for PolyHaplotyper
# but not the FS family overview, as Happy-inf does not know about
# FS families:
HAPpedchk <- pedigreeHapCheck(ped=ped, mrkDosage=dosmat,
                              haploblock=hapblocks,
                              hapresults=HAPresults)

# Make a summary of the pedigree checks
HAPcst <- calcStatistics(HAPpedchk, haploblocks=hapblocks)
print(HAPcst)
print(colSums(HAPcst$pedstats[, -1]))
# check for conflicts between inferred haplotypes and observed marker dosages
cmpdos <- compareHapMrkDosages(mrkDosage=dosmat, hapresults=HAPresults)
print(table(cmpdos[,,"match"], useNA="always")) 
#FALSE=conflict, TRUE=match, NA=no marker or haplotyping data

# Save results:
save(HAPresults, HAPpedchk, HAPcst,
     file=paste0("HAPresults_", timestr, ".RData"))



# ShesisPlus ###################################################################

# ShesisPlus is available through a web interface: 
# http://shesisplus.bio-x.cn/SHEsis.html
# On this website the data for a single haploblock are entered, and the results
# are returned.
# We accessed this website on 1 and 4 May 2020.

# create a list to store the ShesisPlus results:
SSPresults <- list()

# Create ShesisPlus input data for a single haploblock,
# using a function in PolyHaplotyper:
hb <- "contig_05692" # one haploblock from hapblocks
SSPdat <- 
  make.ShesisPlus.input(mrkDosage=dosmat, 
                        phenotype=round(abs(runif(ncol(dosmat))),3), #set of random phenotypes
                        markers=hapblocks[[hb]], 
                        ploidy=6, 
                        fname=paste0("SPP_", hb,".dat"))

# Run ShesisPlus:
# Visit http://shesisplus.bio-x.cn/SHEsis.html
# Choose analysis: check "Haplotype Analysis"
# Enter Ploidy: 6
# Phenotype: "Quantitative Trait"
# Input data: copy here the contents of the plain text file created above
# (including the final newline)
# Leave all other items unchanged
# Click "Calculate" at the bottom
# Wait for the page with the results (can take some time)
# Copy the results and save as a text file: we assume here this is
# paste0("SSP_", hb, "_results.txt")

# Convert the ShesisPlus results to a more structured format:
# (using a function in PolyHaplotyper)
if (!(hb %in% names(SSPresults))) SSPresults[[hb]] <- list()
timestr <- format(Sys.time(), format="%Y%m%d-%H%M%S")  
SSPresults[[hb]][[timestr]] <- 
  read.ShesisPlus.output(fname=paste0("SSP_", hb, "_results.txt"))

# Repeat this for other haploblocks, or with the same haploblock
# (ShesisPlus is not deterministic, results obtained with the same input data 
# may differ considerably from each other)
# 
# ShesisPlus does not return inferred haplotype combinations for all 
# individuals; it only returns frequencies of haplotypes over the
# population (and other data that do not concern the haplotyping).

timestr <- format(Sys.time(), format="%Y%m%d-%H%M%S")  
save(SSPresults, file=paste0("SSPresults_", timestr, ".Rdata"))