##############################################################################################
# Example source code for the estimation of ROH-based inbreeding			                              #
##############################################################################################

# By Pattarapol Sumreddee, PhD, May 22, 2021                                 
# contact: pattrapoljk@gmail.com                                             

##############################################################################################
# 1. Create a script file to tell PLINK to identify ROH segments with specific paprameters                                          #
##############################################################################################

# Documentation for ROH identification using PLINK can be found in:

http://zzz.bwh.harvard.edu/plink/ibdibs.shtml#homo


# Parameters: minimum length = 1 Mb 
#             Minimum no.of SNPs per ROH = 15 snps 
#             Maximal gap between two SNPs of 500 kb
#             Minimal density of 500 kb/SNP 
#             Maximum of 2 heterozygous SNPs within the sliding windows

# File name: roh_script.txt
# Contents in the file:
--bfile snp50K_genotype
--autosome-num 29
--no-fid
--no-parents
--no-sex
--no-pheno
--homozyg-kb 1000    
--homozyg-snp 15   
--homozyg-window-het 2
--homozyg-density 500
--homozyg-gap 500
--out roh_1Mb

# Input files 
snp50K_genotype.ped    # genotype files
snp50K_genotype.map    # SNP map file

# Run PLINK to identify ROH segments: 

plink --script roh_script.txt

# Output ROH files:

# roh_1Mb.hom
# roh_1Mb.hom.indiv 
# roh_1Mb.hom.summary 


# Description: roh_1Mb.hom
# The plink.hom file has the following format, one row per identified homozygous region:
#     FID      Family ID
#     IID      Individual ID
#     CHR      Chromosome
#     SNP1     SNP at start of region
#     SNP2     SNP at end of region
#     POS1     Physical position (bp) of SNP1
#     POS2     Physical position (bp) of SNP2
#     KB       Length of region (kb)
#     NSNP     Number of SNPs in run
#     DENSITY  Average SNP density (1 SNP per kb)
#     PHOM     Proportion of sites homozygous
#     PHET     Proportion of sites heterozygous



###########################################################
# 2. Calculation of ROH-based inbreeding coefficients                             #
###########################################################


# R scripts to calculate ROH-based inbreeding coefficients

rm(list=ls())
library(dplyr)
options(stringsAsFactors=FALSE)
options(scipen=999)


# Formulas to calculate ROH-based inbreeding coefficient for each individual

# 1) Genome-wide inbreeding coefficient: FROH  
#    FROH = Sum_LROH/Lauto   (McQuillan et al., 2018)

#    where L_ROH = the total length of all ROH segments
#          L_AUTO = the total length of the autosomal genome covered by SNP (in Mb)

# 2) Long and short ROH-based inbreeding 
# 
#    FROH = Fshort_m + Flong_m 
#    Fshort_m = Sum_LROH_long/Lauto
#    Flong_m = Sum_LROH_short/Lauto

#    where L_ROH_long = the total length of all long ROH segments based on threshold length value m (Mb)
#          L_ROH_short = the total length of all short ROH segments based on threshold length value m (Mb)


#######################
# Upload ROH file              #
#######################

dat=read.table("roh_1Mb.hom",header=TRUE)
dim(dat)
# 78933     8

str(dat)  # Structure of data 
colnames(dat)
#  [1] "FID"     "IID"     "PHE"     "CHR"     "SNP1"    "SNP2"    "POS1"
#  [8] "POS2"    "KB"      "NSNP"    "DENSITY" "PHOM"    "PHET"

# Convert ROH length KB to Mb 

dat$Mb=dat$KB/1000

summary(dat) 

#######################
#  Upload map file              #
#######################

map=read.table('snp50K_genotype.map',header=FALSE)
dim(map)
colnames(map)=c('CHR','snp','pos_cM','pos_bp') # Add column names 
head(map)
#  CHR                             snp pos_cM pos_bp
#1   1          Hapmap43437-BTA-101873      0 135098
#2   1              ARS-BFGL-NGS-16466      0 267940
#3   1 Hapmap34944-BES1_Contig627_1906      0 393248
#4   1              ARS-BFGL-NGS-98142      0 471078


#---------------------------------------------------------------------#
# The total length of autosome covered by SNPs: L_AUTO


# Get the length of Autosome as the lst position in each chr (Same as Sajaad)

mapTL= map %>% group_by(CHR) %>% summarise(n=n(),TL=max(pos_bp))
mapTL = as.data.frame(mapTL) 
mapTL
#   CHR    n        TL
#1    1 2170 161021443
#2    2 1531 136531159
#3    3 1482 125516631
#4    4 1612 120641946
#5    5 1257 124682277
#6    6 1631 119216563
#7    7 1362 112628884
#8    8 1422 116028292
#9    9 1121  96715173
#10  10 1248 104215086
#11  11 1276 107246475
#12  12 1070  91091598
#13  13  998  84147825
#14  14 1101  84505345
#15  15  968  85112130
#16  16  981  81322588
#17  17  890  74998349
#18  18  709  65813358
#19  19  720  63625695
#20  20  972  72197729
#21  21  848  71109676
#22  22  684  61378199
#23  23  589  52285248
#24  24  694  63402996
#25  25  515  42768470
#26  26  626  51680135
#27  27  573  45368987
#28  28  556  46194755
#29  29  614  50742374

# Total autosome length in bp 
Total_length_bp=sum(mapTL$TL) 
# 2512189386

# Total autosome length in Mb 
Total_length_Mb=Total_length_bp/1000000
Total_length_Mb
#2512.189

#--------------------------------#
# Get id of each individual 

idvec=unique(dat$IID)
length(idvec)
#[1] 785
head(idvec)
#[1] 19533159 19533207 19555257 19611340 19733088 19733147

# Calculate summary description of ROH segments, and inbreeding for each individuals 
# e.g., no.of ROH (nseg), no.of long ROH (nseg_long),no.of short ROH (nseg_short) 
#       Total Length of short (long) ROH (TL_short, TL_long),
#       Froh, Fshort_m, Flong_m

# Define m Mb threshold to classify short and long ROH classes
#e.g.,  m = c(3,5,7,9,11,13,15,17)

m=5   # 5 Mb threshold  

#---------------------------------------#
# Create a matrix to store output 

out=matrix(nrow=length(idvec),ncol=9)
colnames(out)=c('id','nseg','nseg_short','nseg_long','TL_short','TL_long','Froh','Fshort','Flong')
head(out)

cnt=0    # index counter
for (i in idvec){   # Loop over individual IDs
                            # Users may make a nested loop over m as well 
				  
cnt=cnt+1   # update index counter 
print(cnt)

#****************************#
# Subsetting individual i 
sub=dat[dat$IID==i,]

nseg=nrow(sub)   # number of ROH segments per individual 
TL=sum(sub$Mb)   # Sum of all ROH lengths in Mb 
Froh=TL/Total_length_Mb   # FROH 
#Total_length_Mb=2512.189 

#**********************************#
# Classification of ROH segments:

Short=sub[sub$Mb< m,]
Long=sub[sub$Mb>= m,]

# No.of ROH segments 
nShort=nrow(Short)
nLong=nrow(Long)

# Total length of long and short classes, Mb 
TL_short=sum(Short$Mb)
TL_long=sum(Long$Mb)

# Inbreeding 
Fshort= sum(Short$Mb)/Total_length_Mb
Flong= sum(Long$Mb)/Total_length_Mb

#*****************#
# Store results
# 'id','nseg','nseg_short','nseg_long','TL_short','TL_long','Froh','Fshort','Flong'
#  1     2          3                   4            5                    6         7           8      9
out[cnt,1]=i 
out[cnt,2]=nseg
out[cnt,3]=nShort
out[cnt,4]=nLong
out[cnt,5]=TL_short
out[cnt,6]=TL_long
out[cnt,7]=Froh    # If want a percent F: Froh*100
out[cnt,8]=Fshort  #                            Fshort*100
out[cnt,9]=Flong   #                            Flong*100

}  # Done for loop 

# Change to a dataframe 

out=as.data.frame(out)

str(out)
#'data.frame':   785 obs. of  9 variables:
# $ id        : num  19533159 19533207 19555257 19611340 19733088 ...
# $ nseg      : num  85 98 84 83 96 9 74 85 78 102 ...
# $ nseg_short: num  39 60 43 42 48 6 32 36 31 46 ...
# $ nseg_long : num  46 38 41 41 48 3 42 49 47 56 ...
# $ TL_short  : num  125 178 138 127 156 ...
# $ TL_long   : num  516 435 406 372 510 ...
# $ Froh      : num  0.255 0.244 0.216 0.199 0.265 ...
# $ Fshort    : num  0.0496 0.0707 0.0547 0.0506 0.062 ...
# $ Flong     : num  0.205 0.173 0.161 0.148 0.203 ...

# Get summary statistics
summary(out[,-1])
#      nseg         nseg_short     nseg_long        TL_short
# Min.   :  7.0   Min.   : 6.0   Min.   : 0.00   Min.   : 19.29
# 1st Qu.: 93.0   1st Qu.:45.0   1st Qu.:45.00   1st Qu.:143.45
# Median :104.0   Median :52.0   Median :51.00   Median :164.93
# Mean   :100.6   Mean   :50.9   Mean   :49.65   Mean   :162.12
# 3rd Qu.:113.0   3rd Qu.:58.0   3rd Qu.:57.00   3rd Qu.:185.45
# Max.   :146.0   Max.   :78.0   Max.   :82.00   Max.   :264.89
#    TL_long           Froh             Fshort             Flong
# Min.   :  0.0   Min.   :0.01031   Min.   :0.007677   Min.   :0.0000
# 1st Qu.:400.2   1st Qu.:0.22271   1st Qu.:0.057102   1st Qu.:0.1593
# Median :459.0   Median :0.25055   Median :0.065651   Median :0.1827
# Mean   :448.4   Mean   :0.24302   Mean   :0.064533   Mean   :0.1785
# 3rd Qu.:515.1   3rd Qu.:0.27430   3rd Qu.:0.073819   3rd Qu.:0.2051
# Max.   :837.0   Max.   :0.40855   Max.   :0.105443   Max.   :0.3332


#---------------------------------------------#
# Write output to file for m = 5 Mb 

output_nameTXT=paste("inbreeding_ROH_m_",m,"Mb.txt",sep="")
output_nameCSV=paste("inbreeding_ROH_m_",m,"Mb.csv",sep="")
output_nameTXT
#[1] "inbreeding_ROH_m_5Mb.txt"
output_nameCSV
#[1] "inbreeding_ROH_m_5Mb.csv"

write.table(out,output_nameTXT,row.names=FALSE,col.names=TRUE)
write.csv(out,output_nameCSV,row.names=FALSE,col.names=TRUE)

###########################################################
# By Pattarapol Sumreddee, PhD, May 22, 2021                                      #
# contact: pattrapoljk@gmail.com                                                             #
###########################################################