columnsort[column_,data_]:=Sort[data,OrderedQ[{#1[[column]],#2[[column]]}]&]

snpinfo=Import["C:\\Users\\Ascia\\Documents\\Mathematica\\HumanCore_48samples_JanFeb2015\\converted_reduced_edited_sorted_merged_position_edited_Carine_HumanCore_48samples_22012015_FinalReport_Matrix_TopStrand_noGC_rs_header.txt", "TSV"]

TableForm[Take[snpinfo,10]]

header = Take[snpinfo,1]

snpinfo2=Drop[snpinfo,1];

TableForm[Take[snpinfo2,10]]

Length[snpinfo2]

Dimensions[snpinfo2]

snpinfo=snpinfo2;

snpinfo[[1]]

(*  map into snp info table from snp number *)

snpchcol=1;
snpposcol=2;

headeroffset=0

(* map from snp number 1...N to index in the snp table *)

snptabi[snpi_]:= snpi + headeroffset

(* get snp number range for each chrom for quick reference *)

(* mao a chrom to its numerical form *)

chrnum[ch_]:=ToExpression[ch];
chrnum["X"]=23;
chrnum["Y"]=24;
chrnum["-"]=25;

chrnum["X"]

thechroms = Select[Sort[Union[#[[snpchcol]]& /@ snpinfo],chrnum[#1]≤chrnum[#2]&],#!="-"&]

(* get indices of chromosome start/stop positions in data tables *)

chrompos[c_] := {Min[#],Max[#]}& @ Select[Range[1,Length[snpinfo]],snpinfo[[#]][[snpchcol]]==c&]

chrompos[23]

cpos = chrompos /@ thechroms

maxind=Max[cpos]

minind=Min[cpos]

(* get genetic map, build 35 version *)

genmap =Import["C:\\Users\\Ascia\\Documents\\Mathematica\\RutgersGenomeMap35.csv"]

TableForm[Take[genmap,-10]]

(* identify columns whith chr, position and cm coordinate *)

mapchcol=8;
mapposcol = 10;
mapcmcol = 11;

(* read in the genotype data for all samples *)

genodat =snpinfo;

TableForm[Take[genodat,10]]

Dimensions[genodat]

samplenames={"PCH2_1","PCH2_2","PCH2_3","ND4_1","ND4_2","ND4_3","ND4_4","NS4-1","NS4-2","NS4-3","NS4-4","NS4-5","NS4-6","NS4-7","FAM1_2","FAM1_3","FAM1_4","FAM1_5","FAM1_6","FAM1_7","FAM1_8","CAD1_1","CAD1_3","CAD1_4","CAD1_5","CAD1_6","CAD1_7","CAD1_9","CAD1_10","CAD1_12","CAD1_13","CAD1_14","CAD1_15","CAD1_17","CAD1_18","CAD1_19","CAD1_20","CAD1_21","CAD1_22","CAD1_23","CAD1_24","HHD1_1","HHD1_2","HHD1_3","HHD1_4","HHD1_5","HHD1_6","HHD1_7"}

genodat2=genodat;

Dimensions[genodat2]

TableForm[Take[genodat2,10]]

(* map a sample index to its column index in the genodat table for genotype and quality *)

genoC=Take[genodat2,All,{3}];

Length[genoC]

infoC=Take[snpinfo,All,{3}];

Length[infoC]

infoC==genoC

Length[samplenames]

genodat3=Drop[genodat2,None,3];

TableForm[Take[genodat3,10]]

Dimensions[genodat3]

genodat=genodat3;

getgenotypecol[samplej_] :=samplej

(*getqualitycol[samplej_] :=2*samplej*)

(* get sample names from columns *)

namekeys=Thread[{Range[1,Length[samplenames]],samplenames}]

(* map all mapped snps to their sex-ave cM postions on the gentic map *)

(* get genetic map index range of each chromosome, for efficient searching *)

genmapchrs = Sort[Union[#[[mapchcol]]& /@ Drop[genmap,1]]]

Do[
mapinds[chri]= {Min[#],Max[#]}& @ Select[Range[1,Length[genmap]],genmap[[#]][[mapchcol]]==chrnum[thechroms[[chri]]]&],
                                            {chri,1,Length[thechroms]}]

mapinds[1]

mapinds[23]

(* here is slow, direct interpolation of bp to cm,
based on direct search to locate flanking snps for interpolation *)

getcM[chr_,pos_] := Module[{imin,imax,i1,i2,di,k,p1,cm1,p2,cm2},
                                                              {imin,imax}=mapinds[chrnum[chr]];
                                                             di = Round[0.05*(imax-imin)];
                                                              (* get indicies of map points to interpolate from *)
                                                             {i1,i2}= Which[
                                                                 pos ≤  genmap[[imin]][[mapposcol]],
                                                                 {imin,imin+di},
                                                                 pos ≥  genmap[[imax]][[mapposcol]],
                                                                  {imax,imax-di},
                                                                 True,   
                                                                     k= imin;
                                                                     While[k<imax && Not[genmap[[k]][[mapposcol]]≤ pos ≤ genmap[[k+1]][[mapposcol]]],k++];
                                                                  {k,k+1}];
                                                                {p1,cm1}=genmap[[i1]][[{mapposcol,mapcmcol}]];
                                                                 {p2,cm2}=genmap[[i2]][[{mapposcol,mapcmcol}]];
                                                                  If[p1==p2, 
                                                                      cm1, 
                                                                      cm1+(pos-p1)*(cm2-cm1)/(p2-p1)]]

Timing[egvales = Table[getcM[1,k],{k,10^6, 10^8, 10^6}];;]

(* here is fast interpolation version, based on bisection to locate flanking snps for interpolation, that reverts to slow if fails...be very careful extrapolating off
the telomeres, the local rates can be very high, for that reason use the sem-local rate
within a few percent of the end *)

getcMfast[chr_,pos_] := Module[{imin,imax,di,i1,i2,k,p1,cm1,p2,cm2},
                                                              {imin,imax}=mapinds[chrnum[chr]];
                                                              di = Round[0.05*(imax-imin)];
                                                              (* get indicies of map points to interpolate from *)
                                                             {i1,i2}= Which[
                                                                 pos ≤  genmap[[imin]][[mapposcol]],
                                                                 {imin,imin+di},
                                                                 pos ≥  genmap[[imax]][[mapposcol]],
                                                                  {imax,imax-di},
                                                                 True,    (* logical bisection *)
                                                                     k1= imin;k2=imax; status=True;
                                                                     While[ k2-k1>1 && status,
                                                                    kmid = Round[(k1+k2)/2];
                                                                    Which[
                                                                         genmap[[k1]][[mapposcol]]≤ pos ≤ genmap[[kmid]][[mapposcol]],
                                                                         k2=kmid,
                                                                          genmap[[kmid]][[mapposcol]]≤ pos ≤ genmap[[k2]][[mapposcol]],
                                                                         k1=kmid,
                                                                         True,
                                                                         status=False;Print["bisection failed at ", {chr,pos,k1,k2,genmap[[{k1,k2}]]}]]];
                                                                       {k1,k2}];
                                                                If[Not[status], getcM[chr,pos],
                                                                {p1,cm1}=genmap[[i1]][[{mapposcol,mapcmcol}]];
                                                                 {p2,cm2}=genmap[[i2]][[{mapposcol,mapcmcol}]];
                                                                  If[p1==p2, 
                                                                      cm1, 
                                                                      cm1+(pos-p1)*(cm2-cm1)/(p2-p1)]
                                                          ]]

(* check speed and agreement *)

Timing[eg1=Table[Table[getcM[chi,k],{k,10^6, 10^8, 10^6}],{chi,1,15}];;]

Timing[eg2=Table[Table[getcMfast[chi,k],{k,10^6, 10^8, 10^6}],{chi,1,15}];;]

eg1==eg2

Do[
thepos = snpinfo[[snptabi[i]]][[snpposcol]];
thech = snpinfo[[snptabi[i]]][[snpchcol]];
cMpos[i]= getcMfast[ thech,thepos],
{i,Min[cpos]-headeroffset,Max[cpos]-headeroffset}]

(* do consistency check on resulting snp positions, and see how many 2 cM gaps exist in
the snp coverage *)

Do[
If[ snpinfo[[snptabi[i-1]]][[snpchcol]]==snpinfo[[snptabi[i]]][[snpchcol]] &&Not[cMpos[i-1] ≤ cMpos[i] ], Print["err at ",i, snpinfo[[snptabi[i]]],snpinfo[[snptabi[i-1]]],cMpos /@ {i-1,i}]];
If[ snpinfo[[snptabi[i-1]]][[snpchcol]]==snpinfo[[snptabi[i]]][[snpchcol]] && cMpos[ i] -cMpos[i-1]> 2, Print[i," ",cMpos[ i] ,"  ",cMpos[i-1],"  ",cMpos[ i] -cMpos[i-1],TableForm@ snpinfo[[{i-1,i,i+1,i+2}]]]],
{i,1+Min[cpos]-headeroffset,Max[cpos]-headeroffset-1,1}]

(* look at call stats for samples.... *)

(* look at call quality scores in a few samples *)

(* here is the logical run length of a block of snps from snp a to snp b... assume indices never dont jump across chromosome ends, and a, b are points of counterevidence (ie DO NOT contribute to run)  *)

logicalw[{a_,b_}]:= b-a-1

(* here is physical length of a run of compatible snps...no credit if do not monitor a SNP in a ~60kb 
interval, eg across centromere, or a gap where no snps, and assume indices do not
jump across chromosome ends  *)

(* choose a gap that will recover ~85% of the total length of a region (based on
distribution of gap sizes, 85% of genome is covered with gaps < 70kb) and is still
reasonable to rep with a single snp 
...and a, b are points of counterevidence (ie DO NOT contribute to run) *)

(* look at gaps *)

posgaps = Select[Table[snpinfo[[i]][[snpposcol]]-snpinfo[[i-1]][[snpposcol]],{i,cpos[[1]][[1]]+1,cpos[[23]][[2]]-1}] ,#>0&];;

Needs["BarCharts`"]

BarChart[BinCounts[posgaps,{1000,0.5*10^6,10000}]]

Plus @@ Select[posgaps, # < 2*10^6&]

Do[
Print[{gapcut, N@ (Plus @@ Select[ posgaps, #<gapcut&])/Plus @@ Select[posgaps, # < 2*10^6&] }],
{gapcut, 0,50000,10000}]

dposgap=50000

physicalw[{a_,b_}] := Module[{w},
                                                 w= 0;
                                            If[b>a+1,
                                             Do[delta=snpinfo[[i]][[snpposcol]]-snpinfo[[i-1]][[snpposcol]];
                                                 If[  dposgap ≥  delta ≥  0,
                                              If[ i == a+1 || i == b -1, delta = Round[delta/2]]; (* expect: count half the boundary deltas *)
                                            w= w + delta],
                                            {i,snptabi[a+1],snptabi[b]}]
                                                 ];
                                               w]

physicalw[{3000,3002}]

(* here is genetic length of a run of compatible snps measured in sex-average cM... assume indices do not
jump across chromosome ends ... do not count regions that are not well resolved by snps...this
is difficult due to hot spots which can concentrate tyically ~0.2 cM in a small region,
but choose a gap that will cover 85% of genome, which is ~ 0.35 cM *)

(* look at gaps *)

cmgaps = Select[Table[cMpos[i]-cMpos[i-1],{i,cpos[[1]][[1]]+1,cpos[[23]][[2]]-1}] ,#>0&];;

BarChart[BinCounts[cmgaps,{0,1,0.01}]]

Plus @@ Select[cmgaps, # < 2&]

Do[
Print[{gapcut, N@ (Plus @@ Select[ cmgaps, #<gapcut&])/(Plus @@ Select[cmgaps, # <2&] )}],
{gapcut, 0,1.0,.05}]

dcMgap=0.25

geneticw[{a_,b_}] := Module[{w},
                                               w= 0;
                                               If[b>a+1,
                                              Do[delta= cMpos[i]-cMpos[i-1];
                                                 If[  dcMgap ≥  delta ≥  0,
                                                       If[ i == a+1 || i == b -1, delta = delta/2]; (* expect: count half the boundary deltas *)  
                                                        w= w + delta],
                                            {i,a+1,b}]];
                                                w]

physicalw[{1000,3000}]

geneticw[{1000,3000}]

RootApproximant[32.08902231957132`]

geneticw[{1000,1002}]

(* record all runs of compatible snps , as {a,b, run length}, where a, b are the counter-evidence points
that define the ends of the run, and
here run is measured using the runmeas[ ] function,  either physical , genetic, or logical length,
and we skip pieces of counterevidence  as possible genotype errors *)

(* also, must detect snps index at end of chrom , and insert mandatory run breaks there,
so that runs do not cross chrom boundaries *)

(* allow a number of errors per 100 snps for a fault-tolerant version, and for
mandatory break points *)

(* define the size of neighborhhod of a snp over which to measure the local counter-evidence rate...
used local 100 snps, on out to 1000 snps, hoping to keep intact large runs in face of
error rate *)

    checkatdists = {100,200,300,400,600,800,1000}

getruns[runmeas_,indicator0_, errmax_, breakinds_] := Module[{ni,errrate,imax ,imin, indicator,checkranges,localrates,ther,theint},
                                                         ni=Length[indicator0]; (* filter out isolated counter evidence points *)
                                                         errrate=errmax/100.;
                                                         indicator= Table[
                                                    Which[indicator0[[i]]==0,0,
                                                 imax = Min[{ni,Select[breakinds,#≥ i&]}];
                                                 imin = Max[{1,Select[breakinds,#≤  i&]}];
                                                  checkranges =  Table[ther =  checkatdists[[di]]/2;
                      {Max[i-ther,imin],Min[i+ther,imax]},{di,1,Length[checkatdists]}];
                                                 (* only use ranges that are big enough, and uniqe *)
                                                    checkranges=Union[ Select[ checkranges, #[[2]]-#[[1]]>0.9*Min[ checkatdists]&]]; 
                                                     localrates =  Table[
                           ( Plus@@Take[indicator0, checkranges[[ri]]])/(checkranges[[ri]][[2]]-checkranges[[ri]][[1]]),
                                                                    {ri,1,Length[checkranges]}];
                                              Min[localrates]≤errrate,0, (* ignore counterevidence if not enough local rate support *)
                                              True, 1],{i,1,ni}];
                                                     theCEpts = Select[Range[0,Length[indicator]],indicator[[ #]]==1
                                       || MemberQ[breakinds,#]&]; (* add in mandatory stop points *)
                                                (* resulting intervals and their lengths *)
                                                 Table[    theint=theCEpts [[{i,i+1}]];{theint,runmeas[theint]}, {i,1,Length[ theCEpts]-1}]
                                  ]

(* here is a graphic depiction of the run, showing the top ntop features *)

rungraphic[{{start_,stop_},size_}] := Rectangle[{start,0},{stop,size}]

getrungraphic[rundist_,nshow_] := Module[{},
                                                                                   Graphics[rungraphic /@ Take[Sort[Select[rundist,#[[2]]>0&],#1[[2]]≤#2[[2]]&],-nshow]]]

(* this version shows all features *)

getrungraphic[rundist_] := Module[{},Graphics[rungraphic /@ Select[rundist,#[[2]]>0&]]]

(* this command produces a simplified representation of the runs, for plotting, by
scanning across chuncks of snps of a given size, and assigning the largest size encountered
to each chunk. Chunk sizes ~ 300 snps give a good, effcient graphical representation of
the run distribtuion. The returned list has the same structure as a run distribution,
but the entries {{i1,i2},size} are the largest size run encountered on {i1,i2}, where this
in turn spans a set of runs from the original run dist that are on the same chrom, and contain
at least chunk snps *)

ifirst

blocklast

Length[rundist[multisamplej]]

getchunkedrundist[rundist_, chunk_:300] := Module[{},
            chunked = {};
            blockfirst=1;
            blocklast=blockfirst;
While[blocklast <=  Length[rundist],
ifirst=rundist[[blockfirst]][[1]][[1]];
ilast=rundist[[blocklast]][[1]][[2]];
nextblock = Min[blocklast+1,Length[rundist]];
          If[ ilast - ifirst ≥ chunk || 
            blocklast == Length[Length[rundist]] ||
            snpinfo[[1+rundist[[nextblock]][[1]][[2]]]][[3]]≠ snpinfo[[1+rundist[[blocklast]][[1]][[1]]]][[3]],
                  next = {{Min[First /@ #],Max[First /@ #]},Max[Last /@ #]}& @ Take[rundist,{blockfirst,blocklast}];
                  AppendTo[chunked,next];
                  blockfirst = blocklast + 1;
                 blocklast = blockfirst,
                 blocklast++]];
      chunked]

(* compute probability of the tail of the background distribution randomly
 producing a peak of a certain size, genome-wide. Note that the block sizes above 0 have 
an exponential distribution...use the intermediate tail of this distribtuion
to define an exponential distribution for the extremes of the tail, and thus
asign probabilities of observing such blocks genomewide.  Assume that the tail
arising from the backgound IBD blocks of size beyond the 90th obeys an exponential distribtuion,
and use the portion of the data between 90th and 99th percentile to estimate this distribution.
                        s90 = 90th percentile block size
                        s99 = 99th percentil block 
                      Exp[-s/S] ds/S = the exponential distribution of sizes,
                      P[size>s] = Exp[-s/S] =>
                      0.1 = Exp[-s90/S]
                     0.01 = Exp[-s99/S] =>
                      10 = Exp[(s99-s90)/S]
                      S = (s99-s90)/Log[10] defines the exponential distribution with 
a tail tat mathces the 90--99%ile portion of the empirical tail
and, with this s, and n = # of blocks > 0, the probability that genomewide there would not
be a block bigger than s, if they are drawn from this distribution, is 
                P[size < s genomewide] = 1 - (1-P[s])^n
*)

(* this first function gets {n,S},  the exponential decay scale S(e-fold reduction for number of blocks)
from the distribution of block sizes, and the total number of blocks n , try'to use 90th and 99the 
percentile as the tail, but use less than 99% if required to have more than 100 blocks in
the tail beyong the peak percentile, for robust estimate not contanminated by non-background large blocks *)

getdistparams[rundist_] :=Module[{Sscale,s9Y,q9Y,s9X,q9X,nblocks,blocks},
                                                                         blocks = Select[Last /@ rundist, #>0&];
                                                                          nblocks = Length[blocks];
                                                                           q9Y = Min[0.90, Max[0.,1-(1000./nblocks)]];(* min qunatile, 90% but at least 1000 blocks*)
                                                                           q9X = Min[0.99, Max[0.1,1-(100./nblocks)]]; (* max quant, 99% but need at least 100 blocks*)
                                                                          s9Y=Quantile[blocks, q9Y];
                                                                          s9X=Quantile[blocks, q9X];
                                                                          Sscale = (s9X-s9Y)/Log[(1-q9Y)/(1-q9X)];
                                                                           {nblocks,Sscale}]

(* and this gets the probability of exceeding a given block size, genomewide *)

getPblock[s_,{n_,S_}] := If[ n*Exp[-s/S]< 10^(-10), n*Exp[-s/S], 1- (1-Exp[-s/S])^n]

(* for a given run from the run distribution, compute its descriptive properties, 
i.e. size, LOD, location...include parameters for computing LOD  *)

snpinfo[[1]]

snpinfo2=Take[snpinfo,All,{1,3}];

snpinfo2[[1]]

snpinfo=snpinfo2;

(* take d digits to right of decimal in x, for pretty printing *)

decdigits[x_,d_] := N[Round[x*10^d]/10^d]

decdigits[250.314159,1]

getrundescription[]={"LOD(GENOME)","L/SNPS","L/Mb","L/cM","CHR","BANDS","UCSC_INPUT","RSID_START","RSID_STOP"}

getrundescription[{{starti_,stopi_},size_}, lodparams_] := Module[{},
      thelogicalsize=logicalw[{starti,stopi}];
      thephysicalsize=physicalw[{starti,stopi}];
     thegeneticsize= geneticw[{starti,stopi}];
     thelod= -Log[10.,getPblock[size,lodparams]];
      {snpchr1,snppos1,snpID1}= snpinfo[[starti+1]];
      {snpchr2,snppos2,snpID2}= snpinfo[[stopi+1]];
{decdigits[thelod,1],
thelogicalsize,
decdigits[thephysicalsize/10^6,1],
 decdigits[thegeneticsize,1],
snpchr1, 
ToString[decdigits[snppos1/10^6,1]]<>"-"<>ToString[decdigits[snppos2/10^6,1]],
"chr"<>ToString[snpchr1]<>":"<>ToString[snppos1]<>"-"<>ToString[snppos2],
snpID1,snpID2}]

TableForm[{getrundescription[],getrundescription[{{1000,1200},4.9},params]}]

(* scan for homo *)

(* here are snp indices of the ends of the chromosomes, 1...N , to use as break points *)

chrombreakinds = Flatten[cpos]-1

(* codes for the genotypes, "AA","AB","BB","NN" or "NoCall" used in the data *)

AAcode="AA";
ABcode="AB";
BBcode="BB";
NNcode="NC";

(* main purpose of this run is to compute stats, not generate all the figs...*)

thesampleinds=First /@ namekeys

(* do "one way" comparison of samples, ie homozygosity scan *)

nway=1;

(* make list of comparison sets to scan *)

usedsamples[nway] = {#}& /@ (First /@ namekeys)

usedsamples[nway] ={{8},{9},{10},{11},{12},{13},{14}}

errsper100=1; (* figure 1--2% error rate, all of time causes counter evidence (homo->het), and a bit of clustering *)

(* make a quality cutoff on acceptable genotype calls *)

(* show any figure where max block is bigger than *)

showcutoff=0

(* scale factor used for plots *)

(* use this for physical length *)

therunmeasfnc = physicalw;
scalesizeby=10^6;
plotmax=5*10^6;
blockunit="Mb";

(* use this for genetic *)

therunmeasfnc = geneticw;
scalesizeby=1;
plotmax=15;
blockunit="cM";

MemoryInUse[]

(*HOMOZYGOSITY MAPPING ALL

t0=AbsoluteTime[];
Do[
multisamplej= usedsamples[nway][[j]];
Print["comparison ", j,": samples ",  samplenames[[multisamplej]], "  ( numbers:  ",multisamplej," )", " at  t = ", (AbsoluteTime[]-t0)/60];
therawpairs = #[[getgenotypecol /@ multisamplej]]& /@ genodat;
thepairs = therawpairs; 
CEind = Table[ If[Length[Intersection[thepairs[[i]],{ABcode}]]==1 ,1,0],{i,Min[cpos],Max[cpos]}];
theindicator = CEind;
cefreq[multisamplej] =N[ Plus@@CEind/Length[CEind]];
Print[" Counter Evidence Frequency ",SetPrecision[ cefreq[multisamplej],2]];
(* special for homozygosity : determine sex fro amout of X homozygosity *)
chXfreq = N[ Plus@@Take[CEind,cpos[[23]]-1]/Length[Take[CEind,cpos[[23]]-1]]];
thesex = If[chXfreq < cefreq[multisamplej] /2, "M","F"];
sexof[multisamplej]=thesex;
Print[" X Chrom Heterozygosity = ",SetPrecision[ chXfreq,2], " inferred  sex = ",thesex];
(* get distribution *)
  rundist[multisamplej]=Select[getruns[therunmeasfnc,theindicator,errsper100,chrombreakinds],#[[2]]>0&];
(* get top runs from distirbution *)
topn = 100;
topdist = Take[ Sort[Select[rundist[multisamplej],#[[2]]>0&],#1[[2]]≤#2[[2]]&],-topn];
 (* get exponential distribution model params *)
params = getdistparams[rundist[multisamplej]];
(* print out info on top three hits, plus any that at unusual at 1 per genome level .. but for males
  skip the chr X results for homozygosity *)
considerforreport =  If[ thesex=="M",Select[topdist,#[[1]][[1]]< Min[cpos[[23]]]-1&],topdist];
reporthits = Union[Take[considerforreport ,-50], Select[considerforreport , getPblock[#[[2]],params]<0.1&]];
Print[TableForm[ Join[{getrundescription[]},getrundescription[#,params]& /@ reporthits]]];
If[ Mod[j,10]==1 || Max[Last /@ considerforreport]> showcutoff, 
figdist = getchunkedrundist[ rundist[multisamplej],300];
maxscalesnpi=If[thesex=="M",cpos[[23]][[1]]-1,cpos[[23]][[2]]]; 
scalefnc = Identity; 
prange=Max[plotmax,1.1*Max[scalefnc/@ (Last /@ Select[figdist,Max[#[[1]]]≤maxscalesnpi&])]];
Print[Show[getrungraphic[{#[[1]],scalefnc[#[[2]]]}& /@ figdist],
PlotRange ->{{cpos[[1]][[1]],cpos[[23]][[2]]},{0,60}},
Frame->True,
Prolog->{GrayLevel[0.501961],Table[Line[{{Max[cpos[[i]]]-1,0},{Max[cpos[[i]]]-1,60}}],{i,1,23}],
GrayLevel[0.501961],Table[Line[{{0,j},{Length[theindicator],j}}],{j,0,60,10}],
RGBColor[0,0,0]},
Frame->True,AspectRatio->1/3,FrameLabel->{"GENOME POSITION","IBD BLOCK SIZE /" <> blockunit} ,
FrameTicks->{ Table[{cpos[[chi]][[1]],ToString[thechroms[[chi]]]},{chi,1,23}],Automatic}]]
];
,{j,1,Length[usedsamples[nway]],1}]

(*1 figure*)
(*All samples share the 'same' homozygous blocks*)

(*usedsamples[nway] ={{39,40,44}} *)
(*usedsamples[nway] ={{39,40,44},{39,40,44,37},{39,40,44,41},{39,40,44,43}}*)

usedsamples[nway] ={{10,13}}

errsper100=1; (* figure 1--2% error rate, all of time causes counter evidence (homo->het), and a bit of clustering *)

(* make a quality cutoff on acceptable genotype calls *)

(* show any figure where max block is bigger than *)

showcutoff=0

(* scale factor used for plots *)

(* use this for physical length *)

therunmeasfnc = physicalw;
scalesizeby=10^6;
plotmax=5*10^6;
blockunit="Mb";

(* use this for genetic *)

therunmeasfnc = geneticw;
scalesizeby=1;
plotmax=15;
blockunit="cM";

MemoryInUse[]

t0=AbsoluteTime[];
Do[
multisamplej= usedsamples[nway][[j]];
Print["comparison ", j,": samples ",  samplenames[[multisamplej]], "  ( numbers:  ",multisamplej," )", " at  t = ", (AbsoluteTime[]-t0)/60];
therawpairs = #[[getgenotypecol /@ multisamplej]]& /@ genodat;
thepairs = therawpairs; 
CEind = Table[ If[Length[Intersection[thepairs[[i]],{ABcode}]]==1 ,1,If[Not[MemberQ[thepairs[[i]],NNcode]]&&  thepairs[[i]][[1]]≠thepairs[[i]][[2]],1,0]],{i,Min[cpos],Max[cpos]}];
theindicator = CEind;
cefreq[multisamplej] =N[ Plus@@CEind/Length[CEind]];
Print[" Counter Evidence Frequency ",SetPrecision[ cefreq[multisamplej],2]];
(* special for homozygosity : determine sex fro amout of X homozygosity *)
chXfreq = N[ Plus@@Take[CEind,cpos[[23]]-1]/Length[Take[CEind,cpos[[23]]-1]]];
thesex = If[chXfreq < cefreq[multisamplej] /2, "M","F"];
sexof[multisamplej]=thesex;
Print[" X Chrom Heterozygosity = ",SetPrecision[ chXfreq,2], " inferred  sex = ",thesex];
(* get distribution *)
  rundist[multisamplej]=Select[getruns[therunmeasfnc,theindicator,errsper100,chrombreakinds],#[[2]]>0&];
(* get top runs from distirbution *)
topn = 100;
topdist = Take[ Sort[Select[rundist[multisamplej],#[[2]]>0&],#1[[2]]≤#2[[2]]&],-topn];
 (* get exponential distribution model params *)
params = getdistparams[rundist[multisamplej]];
(* print out info on top three hits, plus any that at unusual at 1 per genome level .. but for males
  skip the chr X results for homozygosity *)
considerforreport =  If[ thesex=="M",Select[topdist,#[[1]][[1]]< Min[cpos[[23]]]-1&],topdist];
reporthits = Union[Take[considerforreport ,-3], Select[considerforreport , getPblock[#[[2]],params]<0.1&]];
Print[TableForm[ Join[{getrundescription[]},getrundescription[#,params]& /@ reporthits]]];
If[ Mod[j,10]==1 || Max[Last /@ considerforreport]> showcutoff, 
figdist = getchunkedrundist[ rundist[multisamplej],300];
maxscalesnpi=If[thesex=="M",cpos[[23]][[1]]-1,cpos[[23]][[2]]]; 
scalefnc = Identity; 
prange=Max[plotmax,1.1*Max[scalefnc/@ (Last /@ Select[figdist,Max[#[[1]]]≤maxscalesnpi&])]];
Print[Show[getrungraphic[{#[[1]],scalefnc[#[[2]]]}& /@ figdist],
PlotRange ->{{cpos[[1]][[1]],cpos[[23]][[2]]},{0,20}},
Frame->True,
Prolog->{GrayLevel[0.501961],Table[Line[{{Max[cpos[[i]]]-1,0},{Max[cpos[[i]]]-1,40}}],{i,1,23}],
GrayLevel[0.501961],Table[Line[{{0,j},{Length[theindicator],j}}],{j,0,20,5}],
RGBColor[0,0,0]},
Frame->True,AspectRatio->1/3,FrameLabel->{"GENOME POSITION","IBD BLOCK SIZE /" <> blockunit} ,
FrameTicks->{ Table[{cpos[[chi]][[1]],ToString[thechroms[[chi]]]},{chi,1,23}],Automatic}]]
];
,{j,1,Length[usedsamples[nway]],1}]

Show[getrungraphic[{#[[1]],scalefnc[#[[2]]]}& /@ figdist],
PlotRange ->{{cpos[[1]][[1]],cpos[[23]][[2]]},{0,20}},
Frame->True,
Prolog->{GrayLevel[0.501961],Table[Line[{{Max[cpos[[i]]]-1,0},{Max[cpos[[i]]]-1,20}}],{i,1,23}],
GrayLevel[0.501961],Table[Line[{{0,j},{Length[theindicator],j}}],{j,0,20,5}],
RGBColor[0,0,0]},
Frame->True,AspectRatio->1/3,FrameLabel->{"GENOME POSITION","IBD BLOCK SIZE /" <> blockunit} ,LabelStyle-> 30,
FrameTicks->{ Table[{cpos[[chi]][[1]],ToString[thechroms[[chi]]]},{chi,1,23}],Automatic}, FrameTicksStyle -> 20
]

(*************************************************************************************************************************************************************************************************)

(* these tools assume that snpinfo table is defined, as are interval size functions geneticw, etc, as in standard IBD notebook *)

(* these are a set of interval manipulation tools to allow the intersection, union, and subtraction (complement) of various IBD interval sets, as wells as cleanup to remove spurious small intervals...these generall work on
lists of intervals of the form { {{start, stop}, size}, ...} and require an interval size-mesuring function intervalmeasure which is used to calculate new sizes for the manipulated intervals

(* USAGE: in general, given the rundist[...] sets of IBD interval results from various compariosns, we will typically 

(1) use intervalsizeselect[...] to first filter out intervals large enough to be recent IBD
(2) use the intervalcomplement[...],intervalintersection[...],intervalunion[...] to perform inclusion and exlusion disease model operations on the filtered IBD intervals
(3) use the intervalcleanup[ ] untility to remove spurious small few-SNP gaps or intervals that result from (2)

Clear[intize,intervalcomplement,intervalintersection,intervalunion, intervalcleanup, intervalsizeselect, intervalchangeunits]

(* converts a list of indices into interval ranges of indices,  {i1, i2, ...}  -> { {start1, stop1}, {start2, stop2}, ...} ,
this is used internally in the other function to do union, intersection, complement on explicit sets of indices and then convert back to interval form *)

intize[inds0_] := Module[{inds},
inds = Sort[Union[inds0]];
 start = inds[[1]]; stop=inds[[1]]; left = Drop[inds,1]; While[Length[left]>0 && left[[1]]==stop+1, stop++; left = Drop[left,1]]; {{start,stop}}~Join~intize[left]]

intize[{}]={}

intervalcomplement[intsINCLUDE:{{{_Integer,_Integer},_}...},intsEXCLUDE:{{{_Integer,_Integer},_}...},intervalmeasure_:geneticw]:=With[{newints = intize @  Complement[ Union @@ Table[Range @@ int[[1]],{int,intsINCLUDE}], Union @@ Table[Range @@ int[[1]],{int,intsEXCLUDE}]]},
{#, intervalmeasure[#]}& /@ newints]

intervalcomplement[ints0:{{{_Integer,_Integer},_}...},ints:{{{_Integer,_Integer},_}...},otherints__,intervalmeasure_:geneticw]:= intervalcomplement[  intervalcomplement[ints0,ints,intervalmeasure], otherints,intervalmeasure]

(* cleanup intervals to remove spurious small gaps or intervals that might
remain after applying interval manipulation operations: 
fill in any gaps ≤ fillgap (in snps), and 
eliminate any small "speckle" intervals ≤ specksize (in snps) 
which might be noise left from subtractions *)

intervalcleanup[ints:{{{_Integer,_Integer},_}...}, fillgap_:10, specksize_:5, intervalmeasure_:geneticw]:= Module[{}, 
pushout = Ceiling[fillgap/2];
theexpanded = (#[[1]]+{-pushout, pushout})& /@ ints;
thefilled = intize[ Union @@ ( (Range@@#)& /@ theexpanded )];
theshrunk =  Select[ (#+{pushout, -pushout})& /@ thefilled, #[[2]] - #[[1]]+1 > specksize&];
{#,  intervalmeasure[#]}& /@ theshrunk]

(* filter out only intervals above a size threshhold, as measure by the given intervalmeasure *)

intervalsizeselect[ints:{{{_Integer,_Integer},_}...},{minsize_, maxsize_},  intervalmeasure_:geneticw]:=Select[ints, maxsize ≥ intervalmeasure[#[[1]]]≥ minsize&]

(* change the size measure carried along with the intervals to that given by intervalmeasure *)
intervalchangeunits[ints:{{{_Integer,_Integer},_}...},  intervalmeasure_:geneticw]:= {#[[1]],  intervalmeasure[#[[1]]]}& /@ ints

(* Example using SRSP1 family. #6 is affected, rest (1~5 and 7~14) are unaffected*)
(* used only blocks >2cM *)
(* NS4 analysis 2 10,13 affected. 8,9,11,12,14 are unaffected*)

intervalsizeselect[rundist[{10,13}], {5,1000}]

intervalsizeselect[rundist[{8}], {5,1000}]

intervalsizeselect[rundist[{9}], {5,1000}]

intervalsizeselect[rundist[{11}], {5,1000}]

intervalsizeselect[rundist[{12}], {5,1000}]

intervalsizeselect[rundist[{14}], {5,1000}]

(* substract ROHs in #3 from ROHs in #6*)

c1=intervalcomplement[intervalsizeselect[rundist[{10,13}], {5,1000}],intervalsizeselect[rundist[{8}], {5,1000}]]

(* substract ROHs in #4 from c1 interval list*)

c2=intervalcomplement[c1,intervalsizeselect[rundist[{9}], {5,1000}]]

c3=intervalcomplement[c2,intervalsizeselect[rundist[{11}], {5,1000}]]

c4=intervalcomplement[c3,intervalsizeselect[rundist[{12}], {5,1000}]]

c5=intervalcomplement[c4,intervalsizeselect[rundist[{14}], {5,1000}]]

(* Draw the graph of the final interval list, The figure can be saved as a PDF file*)

figdist = getchunkedrundist[ c5];

figdist

Show[getrungraphic[{#[[1]],scalefnc[#[[2]]]}& /@ figdist],
PlotRange ->{{cpos[[1]][[1]],cpos[[23]][[2]]},{0,30}},
Frame->True,
Prolog->{GrayLevel[0.501961],Table[Line[{{Max[cpos[[i]]]-1,0},{Max[cpos[[i]]]-1,50}}],{i,1,23}],
GrayLevel[0.501961],Table[Line[{{0,j},{Length[theindicator],j}}],{j,0,50,10}],
RGBColor[0,0,0]},
Frame->True,AspectRatio->1/3,FrameLabel->{"GENOME POSITION","IBD BLOCK SIZE /" <> blockunit} ,LabelStyle-> 30,
FrameTicks->{ Table[{cpos[[chi]][[1]],ToString[thechroms[[chi]]]},{chi,1,23}],Automatic}, FrameTicksStyle -> 20
]