PageRenderTime 44ms CodeModel.GetById 20ms RepoModel.GetById 0ms app.codeStats 0ms

/tools/regVariation/multispecies_MicrosatDataGenerator_interrupted_GALAXY.pl

https://bitbucket.org/chapmanb/galaxy-central/
Perl | 5606 lines | 5065 code | 245 blank | 296 comment | 163 complexity | e64ba560e907a6b8d7818123ba23613a MD5 | raw file
    

  1. #!/usr/bin/perl
    2. 

  2. use strict;
    3. 

  3. use warnings;
    4. 

  4. use Term::ANSIColor;
    5. 

  5. use File::Basename;
    6. 

  6. use IO::Handle;
    7. 

  7. use Cwd;
    8. 

  8. use File::Path;
    9. 

  9. use vars qw($distance @thresholds @tags $species_set @allspecies $printer $treeSpeciesNum $focalspec $mergestarts $mergeends $mergemicros $interrtypecord $microscanned $interrcord $interr_poscord $no_of_interruptionscord $infocord $typecord $startcord $strandcord $endcord $microsatcord $motifcord $sequencepos $no_of_species $gapcord $prinkter);
    10. 

  10. use File::Path qw(make_path remove_tree);
    11. 

  11. use File::Temp qw/ tempfile tempdir /;
    12. 

  12. my $tdir = tempdir( CLEANUP => 1 );
    13. 

  13. chdir $tdir;
    14. 

  14. my $dir = getcwd;  
    15. 

  15. #print "dir = $dir\n";
    16. 

  16. 

  17. #$ENV{'PATH'} .= ':' . dirname($0);
    18. 

  18. my $date = `date`;
    19. 

  19. 

  20. my ($mafile, $mafile_sputt, $orthfile, $threshold_array,  $allspeciesin, $tree_definition_all, $separation) = @ARGV;
    21. 

  21. if (!$mafile or !$mafile_sputt or !$orthfile or !$threshold_array or !$separation or !$tree_definition_all or !$allspeciesin) { die "missing arguments\n"; }
    22. 

  22. 

  23. $tree_definition_all =~ s/\s+//g;
    24. 

  24. $threshold_array =~ s/\s+//g;
    25. 

  25. $allspeciesin =~ s/\s+//g;
    26. 

  26. #-------------------------------------------------------------------------------
    27. 

  27. # WHICH SPUTNIK USED?
    28. 

  28. my $sputnikpath = ();
    29. 

  29. $sputnikpath = "sputnik_lowthresh_MATCH_MIN_SCORE3" ;
    30. 

  30. #$sputnikpath = "/Users/ydk/work/rhesus_microsat/codes/./sputnik_Mac-PowerPC";
    31. 

  31. #print "sputnik_Mac-PowerPC non-existant\n" if !-e $sputnikpath;
    32. 

  32. #exit if !-e $sputnikpath;
    33. 

  33. #$sputnikpath = "bx-sputnik" ;
    34. 

  34. #print "ARGV input = @ARGV\n";
    35. 

  35. #print "ARGV input :\n mafile=$mafile\n orthfile=$orthfile\n threshold_array=$threshold_array\n  species_set=$species_set\n tree_definition=$tree_definition\n separation=$separation\n";
    36. 

  36. #-------------------------------------------------------------------------------
    37. 

  37. # RUNFILE
    38. 

  38. #-------------------------------------------------------------------------------
    39. 

  39. $distance = 1; #bp
    40. 

  40. $distance++;
    41. 

  41. my @tree_definitions=MakeTrees($tree_definition_all);
    42. 

  42. my $allspeciesset = $tree_definition_all;
    43. 

  43. $allspeciesset =~ s/[\(\) ]+//g;
    44. 

  44. @allspecies = split(/,/,$allspeciesset);
    45. 

  45. 

  46. my @outputfiles = ();
    47. 

  47. my $round = 0;
    48. 

  48. #my $tdir = tempdir( CLEANUP => 0 );
    49. 

  49. #chdir $tdir;
    50. 

  50. 

  51. foreach my $tree_definition (@tree_definitions){
    52. 

  52. 	my @commas = ($tree_definition =~ /,/g) ;
    53. 

  53. 	#print "commas = @commas\n"; <STDIN>;
    54. 

  54. 	next if scalar(@commas) <= 1;
    55. 

  55. 	#print "species_set = $species_set\n";
    56. 

  56. 	$treeSpeciesNum = scalar(@commas) + 1;
    57. 

  57. 	$species_set = $tree_definition;
    58. 

  58. 	$species_set =~ s/[\)\( ;]+//g;
    59. 

  59. 	#print "species_set = $species_set\n"; <STDIN>;
    60. 

  60. 

  61. 	$round++;
    62. 

  62. 	#-------------------------------------------------------------------------------
    63. 

  63. 	# MICROSATELLITE THRESHOLD SETTINGS (LENGTH, BP)
    64. 

  64. 	$threshold_array=~ s/,/_/g;
    65. 

  65. 	my @thresharr = split("_",$threshold_array);
    66. 

  66. 	@thresholds=@thresharr;
    67. 

  67. 	#my $threshold_array = join("_",($mono_threshold, $di_threshold, $tri_threshold, $tetra_threshold));
    68. 

  68. 	#print "current dit=$dir\n";
    69. 

  69. 	#-------------------------------------------------------------------------------
    70. 

  70. 	# CREATE AXT FILES IN FORWARD AND REVERSE ORDERS IF NECESSARY
    71. 

  71. 	my @chrfiles=();
    72. 

  72. 	
    73. 

  73. 	#my $mafile =  "/Users/ydk/work/rhesus_microsat/results/galay/align.txt"; #$ARGV[0];
    74. 

  74. 	my $chromt=int(rand(10000));
    75. 

  75. 	my $p_chr=$chromt;
    76. 

  76. 	
    77. 

  77. 	
    78. 

  78. 	my @exactspeciesset_unarranged = split(/,/,$species_set);
    79. 

  79. 	$tree_definition=~s/[\)\(, ]/\t/g;
    80. 

  80. 	my @treespecies=split(/\t+/,$tree_definition);
    81. 

  81. 	my @exactspecies=();
    82. 

  82. 	
    83. 

  83. 	foreach my $spec (@treespecies){
    84. 

  84. 		foreach my $espec (@exactspeciesset_unarranged){
    85. 

  85. 			push @exactspecies, $spec if $spec eq $espec;
    86. 

  86. 		}
    87. 

  87. 	}
    88. 

  88. 	#print "exactspecies=@exactspecies\n";
    89. 

  89. 	$focalspec = $exactspecies[0];
    90. 

  90. 	my $arranged_species_set=join(".",@exactspecies);
    91. 

  91. 	my $chr_name = join(".",("chr".$p_chr),$arranged_species_set, "net", "axt");
    92. 

  92. 	my $chr_name_sputt = join(".",("chr".$p_chr),$arranged_species_set, "net", "axt_sputt");
    93. 

  93. 	#print "sending to maftoAxt_multispecies: $mafile, $tree_definition, $chr_name, $species_set .. focalspec=$focalspec \n"; 
    94. 

  94. 	maftoAxt_multispecies($mafile, $tree_definition, $chr_name, $species_set);
    95. 

  95. 	maftoAxt_multispecies($mafile_sputt, $tree_definition, $chr_name_sputt, $species_set);
    96. 

  96. 	#print "done maf to axt conversion\n";
    97. 

  97. 	my $reverse_chr_name = join(".",("chr".$p_chr."r"),$arranged_species_set, "net", "axt");
    98. 

  98. 	artificial_axdata_inverter ($chr_name, $reverse_chr_name);
    99. 

  99. 	#print "reverse_chr_name=$reverse_chr_name\n"; 
    100. 

  100. 	#-------------------------------------------------------------------------------
    101. 

  101. 	# FIND THE CORRESPONDING CHIMP CHROMOSOME FROM FILE ORTp_chrS.TXT
    102. 

  102. 	foreach my $direct ("reverse_direction","forward_direction"){
    103. 

  103. 		$p_chr=$chromt;
    104. 

  104. 		#print "direction = $direct\n";
    105. 

  105. 		$p_chr = $p_chr."r" if $direct eq "reverse_direction";
    106. 

  106. 		$p_chr = $p_chr if $direct eq "forward_direction";
    107. 

  107. 		my $config = $species_set;
    108. 

  108. 		$config=~s/,/./g;
    109. 

  109. 		my @orgs = split(/\./,$arranged_species_set);
    110. 

  110. 		#print "ORGS= @orgs\n";
    111. 

  111. 		my @tag=@orgs;
    112. 

  112. 			
    113. 

  113. 		
    114. 

  114. 		my $tags = join(",", @tag);
    115. 

  115. 		my @tags=@tag;
    116. 

  116. 		chomp $p_chr;
    117. 

  117. 		$tags = join("_", split(/,/, $tags));
    118. 

  118. 		my $pchr = "chr".$p_chr;
    119. 

  119. 		
    120. 

  120. 		my $ptag = $orgs[0]."-".$pchr.".".join(".",@orgs[1 ... scalar(@orgs)-1])."-".$threshold_array;
    121. 

  121. 		my @sp_tags = ();
    122. 

  122. 		
    123. 

  123. #		print "$ptag _ orthfile\n"; <STDIN>;
    124. 

  124. 		#print "orgs=@orgs, pchr=$pchr, hence, ptag = $ptag\n";
    125. 

  125. 		foreach my $sp (@tag){
    126. 

  126. 			push(@sp_tags, ($sp.".".$ptag));
    127. 

  127. 		}
    128. 

  128. 	
    129. 

  129. 		my $preptag = $orgs[0]."-".$pchr.".".join(".",@orgs[1 ... scalar(@orgs)-1]);
    130. 

  130. 		my @presp_tags = ();
    131. 

  131. 		
    132. 

  132. 		foreach my $sp (@tag){
    133. 

  133. 			push(@presp_tags, ($sp.".".$preptag));
    134. 

  134. 		}
    135. 

  135. 	
    136. 

  136. 		my $resultdir = "";
    137. 

  137. 		my $orthdir = "";
    138. 

  138. 		my $filtereddir = "";
    139. 

  139. 		my $pipedir = "";
    140. 

  140. 		
    141. 

  141. 		my @title_queries = ();
    142. 

  142. 		push(@title_queries, "^[0-9]+");
    143. 

  143. 		my $sep="\\s";
    144. 

  144. 		for my $or (0 ... $#orgs){
    145. 

  145. 			my $title =  join($sep, ($orgs[$or],  "[A-Za-z_]+[0-9a-zA-Z]+", "[0-9]+", "[0-9]+", "[\\-\\+]"));
    146. 

  146. 			#$title =~ s/chr\\+\\s+\+/chr/g;
    147. 

  147. 			push(@title_queries, $title);
    148. 

  148. 		}
    149. 

  149. 		my $title_query = join($sep, @title_queries);
    150. 

  150. 		#print "title_queries=@title_queries\n";
    151. 

  151. 		#print "query = >$title_query<\n"; 
    152. 

  152. 		#print "orgs = @orgs\n"; 
    153. 

  153. 		#-------------------------------------------------------------------------------
    154. 

  154. 		# GET AXTNET FILES, EDIT THEM AND SPLIT THEM INTO HUMAN AND CHIMP INPUT FILES
    155. 

  155. 		my $t1input = $pchr.".".$arranged_species_set.".net.axt";
    156. 

  156. 		
    157. 

  157. 		my @t1outputs = ();
    158. 

  158. 		
    159. 

  159. 		foreach my $sp (@presp_tags){
    160. 

  160. 			push(@t1outputs, $sp."_gap_op");
    161. 

  161. 		}
    162. 

  162. 		
    163. 

  163. 		
    164. 

  164. 		
    165. 

  165. 		multi_species_t1($t1input,$tags,(join(",", @t1outputs)), $title_query); 
    166. 

  166. 		#print "t1outputs=@t1outputs\n";
    167. 

  167. 		#print "done t1\n"; <STDIN>;
    168. 

  168. 		#-------------------------------------------------------------------------------
    169. 

  169. 		#START T2.PL
    170. 

  170. 		
    171. 

  171. 		my $stag  = (); my $tag1 = (); my $tag2 = ();  my $schrs = ();
    172. 

  172. 		
    173. 

  173. 		for my $t (0 ... scalar(@tags)-1){
    174. 

  174. 			multi_species_t2($t1outputs[$t], $tag[$t]);		
    175. 

  175. 		}
    176. 

  176. 		#-------------------------------------------------------------------------------
    177. 

  177. 		#START T2.2.PL
    178. 

  178. 		
    179. 

  179. 		my @temp_tags = @tag;
    180. 

  180. 		
    181. 

  181. 		foreach my $sp (@presp_tags){
    182. 

  182. 			my $t2input =  $sp."_nogap_op_unrand";
    183. 

  183. 			multi_species_t2_2($t2input, shift(@temp_tags));
    184. 

  184. 		}
    185. 

  185. 		undef (@temp_tags);
    186. 

  186. 		
    187. 

  187. 		#-------------------------------------------------------------------------------
    188. 

  188. 		#START SPUTNIK
    189. 

  189. 		
    190. 

  190. 		my @jobIDs = ();
    191. 

  191. 		@temp_tags = @tag;
    192. 

  192. 		my @sput_filelist = ();
    193. 

  193. 		
    194. 

  194. 		foreach my $sp (@presp_tags){
    195. 

  195. 			#print "sp = $sp\n";
    196. 

  196. 			my $sputnikoutput = $pipedir.$sp."_sput_op0";
    197. 

  197. 			my $sputnikinput = $pipedir.$sp."_nogap_op_unrand";
    198. 

  198. 			push(@sput_filelist, $sputnikinput);
    199. 

  199. 			my $sputnikcommand = $sputnikpath." ".$sputnikinput." > ".$sputnikoutput;
    200. 

  200. 		#	print "$sputnikcommand\n";
    201. 

  201. 			my @sputnikcommand_system = $sputnikcommand;
    202. 

  202. 			system(@sputnikcommand_system);
    203. 

  203. 		}
    204. 

  204. 	
    205. 

  205. 		#-------------------------------------------------------------------------------
    206. 

  206. 		#START SPUTNIK OUTPUT CORRECTOR
    207. 

  207. 		
    208. 

  208. 		foreach my $sp (@presp_tags){
    209. 

  209. 			my $corroutput = $pipedir.$sp."_sput_op1";
    210. 

  210. 			my $corrinput = $pipedir.$sp."_sput_op0";
    211. 

  211. 			sputnikoutput_corrector($corrinput,$corroutput);
    212. 

  212. 			
    213. 

  213. 			my $t4output = $pipedir.$sp."_sput_op2";
    214. 

  214. 			multi_species_t4($corroutput,$t4output);
    215. 

  215. 		
    216. 

  216. 			my $t5output = $pipedir.$sp."_sput_op3";
    217. 

  217. 			multi_species_t5($t4output,$t5output);
    218. 

  218. 			#print "done t5.pl for $sp\n";
    219. 

  219. 		
    220. 

  220. 			my $t6output = $pipedir.$sp."_sput_op4";
    221. 

  221. 			multi_species_t6($t5output,$t6output,scalar(@orgs));
    222. 

  222. 		}
    223. 

  223. 		#-------------------------------------------------------------------------------
    224. 

  224. 		#START T9.PL FOR T10.PL AND FOR INTERRUPTED HUNTING
    225. 

  225. 		
    226. 

  226. 		foreach my $sp (@presp_tags){
    227. 

  227. 			my $t9output = $pipedir.$sp."_gap_op_unrand_match";
    228. 

  228. 			my $t9sequence = $pipedir.$sp."_gap_op_unrand2";
    229. 

  229. 			my $t9micro = $pipedir.$sp."_sput_op4";
    230. 

  230. 			t9($t9micro,$t9sequence,$t9output);
    231. 

  231. 			
    232. 

  232. 			my $t9output2 = $pipedir.$sp."_nogap_op_unrand2_match";
    233. 

  233. 			my $t9sequence2 = $pipedir.$sp."_nogap_op_unrand2";
    234. 

  234. 			t9($t9micro,$t9sequence2,$t9output2);
    235. 

  235. 		}
    236. 

  236. 		#print "done both t9.pl for all orgs\n";
    237. 

  237. 	
    238. 

  238. 		#-------------------------------------------------------------------------------
    239. 

  239. 		# FIND COMPOUND MICROSATELLITES
    240. 

  240. 		
    241. 

  241. 		@jobIDs = ();
    242. 

  242. 		my $species_counter = 0;
    243. 

  243. 		
    244. 

  244. 		foreach my $sp (@presp_tags){
    245. 

  245. 			my $simple_microsats=$pipedir.$sp."_sput_op4_simple";
    246. 

  246. 			my $compound_microsats=$pipedir.$sp."_sput_op4_compound";
    247. 

  247. 			my $input_micro = $pipedir.$sp."_sput_op4";
    248. 

  248. 			my $input_seq = $pipedir.$sp."_nogap_op_unrand2_match";
    249. 

  249. 			multiSpecies_compound_microsat_hunter3($input_micro,$input_seq,$simple_microsats,$compound_microsats,$orgs[$species_counter], scalar(@sp_tags), $threshold_array );
    250. 

  250. 			$species_counter++;
    251. 

  251. 		}
    252. 

  252. 		
    253. 

  253. 		#-------------------------------------------------------------------------------
    254. 

  254. 		# READING  AND FILTERING SIMPLE MICROSATELLITES
    255. 

  255. 		my $spcounter2=0;
    256. 

  256. 		foreach my $sp (@sp_tags){
    257. 

  257. 			my $presp = $presp_tags[$spcounter2];
    258. 

  258. 			$spcounter2++;
    259. 

  259. 			my $simple_microsats=$pipedir.$presp."_sput_op4_simple";
    260. 

  260. 			my $simple_filterout = $pipedir.$sp."_sput_op4_simple_filtered";
    261. 

  261. 			my $simple_residue = $pipedir.$sp."_sput_op4_simple_residue";
    262. 

  262. 			multiSpecies_filtering_interrupted_microsats($simple_microsats, $simple_filterout, $simple_residue,$threshold_array,$threshold_array,scalar(@sp_tags));
    263. 

  263. 		}
    264. 

  264. 		
    265. 

  265. 		#-------------------------------------------------------------------------------
    266. 

  266. 		# ANALYZE  COMPOUND MICROSATELLITES FOR BEING INTERRUPTED MICROSATS
    267. 

  267. 		
    268. 

  268. 		$species_counter = 0;
    269. 

  269. 		foreach my $sp (@sp_tags){
    270. 

  270. 			my $presp = $presp_tags[$species_counter];
    271. 

  271. 			my $compound_microsats = $pipedir.$presp."_sput_op4_compound";
    272. 

  272. 			my $analyzed_simple_microsats=$pipedir.$presp."_sput_op4_compound_interrupted";
    273. 

  273. 			my $analyzed_compound_microsats=$pipedir.$presp."_sput_op4_compound_pure";
    274. 

  274. 			my $seq_file = $pipedir.$presp."_nogap_op_unrand2_match";
    275. 

  275. 			multiSpecies_compound_microsat_analyzer($compound_microsats,$seq_file,$analyzed_simple_microsats,$analyzed_compound_microsats,$orgs[$species_counter], scalar(@sp_tags));
    276. 

  276. 			$species_counter++;
    277. 

  277. 		}
    278. 

  278. 		#-------------------------------------------------------------------------------
    279. 

  279. 		# REANALYZE COMPOUND MICROSATELLITES FOR PRESENCE OF SIMPLE ONES WITHIN THEM.. 
    280. 

  280. 		$species_counter = 0;
    281. 

  281. 		
    282. 

  282. 		foreach my $sp (@sp_tags){
    283. 

  283. 			my $presp = $presp_tags[$species_counter];
    284. 

  284. 			my $compound_microsats = $pipedir.$presp."_sput_op4_compound_pure";
    285. 

  285. 			my $compound_interrupted = $pipedir.$presp."_sput_op4_compound_clarifiedInterrupted";
    286. 

  286. 			my $compound_compound = $pipedir.$presp."_sput_op4_compound_compound";
    287. 

  287. 			my $seq_file = $pipedir.$presp."_nogap_op_unrand2_match";
    288. 

  288. 			multiSpecies_compoundClarifyer($compound_microsats,$seq_file,$compound_interrupted,$compound_compound,$orgs[$species_counter], scalar(@sp_tags), "2_4_6_8", "3_4_6_8", "2_4_6_8");
    289. 

  289. 			$species_counter++;
    290. 

  290. 		}
    291. 

  291. 		#-------------------------------------------------------------------------------
    292. 

  292. 		# READING  AND FILTERING SIMPLE AND COMPOUND MICROSATELLITES
    293. 

  293. 		$species_counter = 0;
    294. 

  294. 		
    295. 

  295. 		foreach my $sp (@sp_tags){
    296. 

  296. 			my $presp = $presp_tags[$species_counter];
    297. 

  297. 		
    298. 

  298. 			my $simple_microsats=$pipedir.$presp."_sput_op4_compound_clarifiedInterrupted";
    299. 

  299. 			my $simple_filterout = $pipedir.$sp."_sput_op4_compound_clarifiedInterrupted_filtered";
    300. 

  300. 			my $simple_residue = $pipedir.$sp."_sput_op4_compound_clarifiedInterrupted_residue";
    301. 

  301. 			multiSpecies_filtering_interrupted_microsats($simple_microsats, $simple_filterout, $simple_residue,$threshold_array,$threshold_array,scalar(@sp_tags));
    302. 

  302. 		
    303. 

  303. 			my $simple_microsats2 = $pipedir.$presp."_sput_op4_compound_interrupted";
    304. 

  304. 			my $simple_filterout2 = $pipedir.$sp."_sput_op4_compound_interrupted_filtered";
    305. 

  305. 			my $simple_residue2 = $pipedir.$sp."_sput_op4_compound_interrupted_residue";
    306. 

  306. 			multiSpecies_filtering_interrupted_microsats($simple_microsats2, $simple_filterout2, $simple_residue2,$threshold_array,$threshold_array,scalar(@sp_tags));
    307. 

  307. 		
    308. 

  308. 			my $compound_microsats=$pipedir.$presp."_sput_op4_compound_compound";
    309. 

  309. 			my $compound_filterout = $pipedir.$sp."_sput_op4_compound_compound_filtered";
    310. 

  310. 			my $compound_residue = $pipedir.$sp."_sput_op4_compound_compound_residue";
    311. 

  311. 			multispecies_filtering_compound_microsats($compound_microsats, $compound_filterout, $compound_residue,$threshold_array,$threshold_array,scalar(@sp_tags));
    312. 

  312. 			$species_counter++;
    313. 

  313. 		}
    314. 

  314. 		#print "done filtering both simple and compound microsatellites \n";
    315. 

  315. 		
    316. 

  316. 		#-------------------------------------------------------------------------------
    317. 

  317. 		
    318. 

  318. 		my @combinedarray = ();
    319. 

  319. 		my @combinedarray_indicators = ("mononucleotide", "dinucleotide", "trinucleotide", "tetranucleotide");
    320. 

  320. 		my @combinedarray_tags = ("mono", "di", "tri", "tetra");
    321. 

  321. 		$species_counter = 0;
    322. 

  322. 		
    323. 

  323. 		foreach my $sp (@sp_tags){
    324. 

  324. 			my $simple_interrupted = $pipedir.$sp."_simple_analyzed_simple";
    325. 

  325. 			push @{$combinedarray[$species_counter]}, $pipedir.$sp."_simple_analyzed_simple_mono", $pipedir.$sp."_simple_analyzed_simple_di", $pipedir.$sp."_simple_analyzed_simple_tri", $pipedir.$sp."_simple_analyzed_simple_tetra";
    326. 

  326. 			$species_counter++;
    327. 

  327. 		}
    328. 

  328. 		
    329. 

  329. 		#-------------------------------------------------------------------------------
    330. 

  330. 		# PUT TOGETHER THE INTERRUPTED AND SIMPLE MICROSATELLITES BASED ON THEIR MOTIF SIZE FOR FURTHER EXTENTION	
    331. 

  331. 		my $sp_counter = 0;
    332. 

  332. 		foreach my $sp (@sp_tags){	
    333. 

  333. 			my $analyzed_simple = $pipedir.$sp."_sput_op4_compound_interrupted_filtered";
    334. 

  334. 			my $clarifyed_simple = $pipedir.$sp."_sput_op4_compound_clarifiedInterrupted_filtered";
    335. 

  335. 			my $simple = $pipedir.$sp."_sput_op4_simple_filtered";
    336. 

  336. 			my $simple_analyzed_simple = $pipedir.$sp."_simple_analyzed_simple";
    337. 

  337. 			`cat $analyzed_simple $clarifyed_simple $simple > $simple_analyzed_simple`;
    338. 

  338. 			for my $i (0 ... 3){
    339. 

  339. 				`grep "$combinedarray_indicators[$i]" $simple_analyzed_simple > $combinedarray[$sp_counter][$i]`;	
    340. 

  340. 			}
    341. 

  341. 			$sp_counter++;		
    342. 

  342. 		}
    343. 

  343. 		#print "\ndone grouping interrupted & simple microsats based on their motif size for further extention\n";
    344. 

  344. 		
    345. 

  345. 		#-------------------------------------------------------------------------------
    346. 

  346. 		# BREAK CHROMOSOME INTO PARTS OF CERTAIN NO. CONTIGS EACH, FOR FUTURE SEARCHING OF INTERRUPTED MICROSATELLITES
    347. 

  347. 		# ESPECIALLY DI, TRI AND TETRANUCLEOTIDE MICROSATELLITES
    348. 

  348. 		@temp_tags = @sp_tags;
    349. 

  349. 		my $increment = 1000000;
    350. 

  350. 		my @splist = ();
    351. 

  351. 		my $targetdir = $pipedir;
    352. 

  352. 		$species_counter=0;
    353. 

  353. 		
    354. 

  354. 		foreach my $sp (@sp_tags){
    355. 

  355. 			my $presp = $presp_tags[$species_counter];
    356. 

  356. 			$species_counter++;
    357. 

  357. 			my $localtag = shift @temp_tags;
    358. 

  358. 			my $locallist = $targetdir.$localtag."_".$p_chr."_list";
    359. 

  359. 			push(@splist, $locallist);
    360. 

  360. 			my $input = $pipedir.$presp."_nogap_op_unrand2_match";
    361. 

  361. 			chromosome_unrand_breaker($input,$targetdir,$locallist,$increment, $localtag, $pchr);
    362. 

  362. 		}
    363. 

  363. 		
    364. 

  364. 	
    365. 

  365. 		my @unionarray = ();
    366. 

  366. 		#print "splist=@splist\n";
    367. 

  367. 		#-------------------------------------------------------------------------------
    368. 

  368. 		# FIND INTERRUPTED MICROSATELLITES
    369. 

  369. 		
    370. 

  370. 		$species_counter = 0;		
    371. 

  371. 		
    372. 

  372. 		for my $i (0 .. $#combinedarray){
    373. 

  373. 			
    374. 

  374. 			@jobIDs = ();
    375. 

  375. 			open (JLIST1, "$splist[$i]") or die "Cannot open file $splist[$i]: $!";
    376. 

  376. 			
    377. 

  377. 			while (my $sp1  = <JLIST1>){
    378. 

  378. 				#print "$splist[$i]: sp1=$sp1\n";
    379. 

  379. 				chomp $sp1;
    380. 

  380. 				
    381. 

  381. 				for my $j (0 ... $#combinedarray_tags){
    382. 

  382. 					my $interr  = $sp1."_interr_".$combinedarray_tags[$j];
    383. 

  383. 					my $simple  = $sp1."_simple_".$combinedarray_tags[$j];
    384. 

  384. 					push @{$unionarray[$i]}, $interr, $simple;	
    385. 

  385. 					multiSpecies_interruptedMicrosatHunter($combinedarray[$i][$j],$sp1,$interr ,$simple, $orgs[$species_counter], scalar(@sp_tags), "3_4_6_8"); 
    386. 

  386. 				}		
    387. 

  387. 			}
    388. 

  388. 			$species_counter++;
    389. 

  389. 		}
    390. 

  390. 		close JLIST1;	
    391. 

  391. 		#-------------------------------------------------------------------------------
    392. 

  392. 		#	REUNION AND ZIPPING BEFORE T10.PL
    393. 

  393. 		
    394. 

  394. 		my @allarray = ();
    395. 

  395. 		
    396. 

  396. 		for my $i (0 ... $#sp_tags){	
    397. 

  397. 			my $localfile = $pipedir.$sp_tags[$i]."_allmicrosats";
    398. 

  398. 			unlink $localfile if -e $localfile;
    399. 

  399. 			push(@allarray, $localfile);
    400. 

  400. 		
    401. 

  401. 			my $unfiltered_localfile= $localfile."_unfiltered";
    402. 

  402. 			my $residue_localfile= $localfile."_residue";
    403. 

  403. 			
    404. 

  404. 			unlink $unfiltered_localfile;
    405. 

  405. 			#unlink $unfiltered_localfile;
    406. 

  406. 			for my $j (0 ... $#{$unionarray[$i]}){
    407. 

  407. 				#print "listing files for species $i  and list number $j= \n$unionarray[$i][$j] \n";
    408. 

  408. 				`cat $unionarray[$i][$j] >> $unfiltered_localfile`;
    409. 

  409. 				unlink $unionarray[$i][$j];
    410. 

  410. 			}
    411. 

  411. 	
    412. 

  412. 			multiSpecies_filtering_interrupted_microsats($unfiltered_localfile, $localfile, $residue_localfile,$threshold_array,$threshold_array,scalar(@sp_tags) );
    413. 

  413. 			my $analyzed_compound = $pipedir.$sp_tags[$i]."_sput_op4_compound_compound_filtered";
    414. 

  414. 			my $simple_residue = $pipedir.$sp_tags[$i]."_sput_op4_simple_residue";
    415. 

  415. 			my $compound_residue = $pipedir.$sp_tags[$i]."_sput_op4_compound_residue";
    416. 

  416. 			
    417. 

  417. 			`cat $analyzed_compound >> $localfile`;
    418. 

  418. 		}
    419. 

  419. 		#-------------------------------------------------------------------------------
    420. 

  420. 		# MERGING MICROSATELLITES THAT ARE VERY CLOSE TO EACH OTHER, INCLUDING THOSE FOUND BY SEARCHING IN 2 OPPOSIT DIRECTIONS
    421. 

  421. 		
    422. 

  422. 		my $toescape=0;
    423. 

  423. 		
    424. 

  424. 		
    425. 

  425. 		for my $i (0 ... $#sp_tags){	
    426. 

  426. 			my $localfile = $pipedir.$sp_tags[$i]."_allmicrosats";
    427. 

  427. 			$localfile =~ /$focalspec\-(chr[0-9a-zA-Z]+)\./;
    428. 

  428. 			my $direction = $1;
    429. 

  429. 			#print "localfile = $localfile , direction = $direction\n"; 
    430. 

  430. 	#		`gzip $reverse_chr_name` if $direction =~ /chr[0-9a-zA-Z]+r/ && $switchboard{"deleting_processFiles"} != 1;
    431. 

  431. 			$toescape =1 if $direction =~ /chr[0-9a-zA-Z]+r/;
    432. 

  432. 			last if $direction =~ /chr[0-9a-zA-Z]+r/;
    433. 

  433. 			my $nogap_sequence = $pipedir.$presp_tags[$i]."_nogap_op_unrand2_match";
    434. 

  434. 			my $gap_sequence = $pipedir.$presp_tags[$i]."_gap_op_unrand_match";
    435. 

  435. 			my $reverselocal = $localfile;
    436. 

  436. 			$reverselocal =~ s/\-chr([0-9a-zA-Z]+)\./-chr$1r./g;
    437. 

  437. 			merge_interruptedMicrosats($nogap_sequence,$localfile, $reverselocal ,scalar(@sp_tags)); 
    438. 

  438. 			#-------------------------------------------------------------------------------
    439. 

  439. 			my $forward_separate = $localfile."_separate";
    440. 

  440. 			my $reverse_separate = $reverselocal."_separate";
    441. 

  441. 			my $diff = $forward_separate."_diff";
    442. 

  442. 			my $miss = $forward_separate."_miss";
    443. 

  443. 			my $common = $forward_separate."_common";
    444. 

  444. 			forward_reverse_sputoutput_comparer($nogap_sequence,$forward_separate, $reverse_separate, $diff, $miss, $common ,scalar(@sp_tags)); 
    445. 

  445. 			#-------------------------------------------------------------------------------
    446. 

  446. 			my $symmetrical_file = $localfile."_symmetrical";
    447. 

  447. 			my $merged_file = $localfile."_merged";
    448. 

  448. 			#print "cating: $merged_file $common  into -> $symmetrical_file \n"; 
    449. 

  449. 			`cat $merged_file $common > $symmetrical_file`;
    450. 

  450. 			#-------------------------------------------------------------------------------
    451. 

  451. 			my $t10output = $symmetrical_file."_fin_hit_all_2";
    452. 

  452. 			new_multispecies_t10($gap_sequence, $symmetrical_file, $t10output, join(".", @orgs));
    453. 

  453. 			#-------------------------------------------------------------------------------		
    454. 

  454. 		}
    455. 

  455. 		next if $toescape == 1;
    456. 

  456. 		#------------------------------------------------------------------------------------------------
    457. 

  457. 		# BRINGING IT ALL TOGETHER: FINDING ORTHOLOGOUS MICROSATELLITES AMONG THE SPECIES
    458. 

  458. 		
    459. 

  459. 		
    460. 

  460. 		my @micros_array = ();
    461. 

  461. 		my $sampletag = ();
    462. 

  462. 		for my $i (0 ... $#sp_tags){
    463. 

  463. 			my $finhitFile = $pipedir.$sp_tags[$i]."_allmicrosats_symmetrical_fin_hit_all_2";
    464. 

  464. 			push(@micros_array, $finhitFile);
    465. 

  465. 			$sampletag = $sp_tags[$i];
    466. 

  466. 		}
    467. 

  467. 		#$sampletag =~ s/^([A-Z]+\.)/ORTH_/;
    468. 

  468. 		#$sampletag = $sampletag."_monoThresh-".$mono_threshold."bp";
    469. 

  469. 		my $orthfiletemp = $ptag."_orthfile";
    470. 

  470. 		my $orthanswer = multiSpecies_orthFinder4($t1input, join(":",@micros_array), $orthfiletemp, join(":", @orgs), $separation);
    471. 

  471. 

  472. 		my $maskedorthfiletemp = $ptag."_orthfile_masked";
    473. 

  473. 		qualityFilter ($orthfiletemp, $chr_name_sputt, $maskedorthfiletemp);
    474. 

  474. 

  475. 		push @outputfiles , $maskedorthfiletemp;
    476. 

  476. 	}
    477. 

  477. 	$date = `date`;
    478. 

  478. }
    479. 

  479. 

  480. `cat @outputfiles > $orthfile`;
    481. 

  481. 

  482. my $rootdir = $dir;
    483. 

  483. $rootdir =~ s/\/[A-Za-z0-9\-_]+$//;
    484. 

  484. chdir $rootdir;
    485. 

  485. remove_tree($dir);
    486. 

  486. 

  487. #print "date = $date\n";
    488. 

  488. #remove_tree($tdir);
    489. 

  489. #------------------------------------------------------------------------------------------------
    490. 

  490. #------------------------------------------------------------------------------------------------
    491. 

  491. #------------------------------------------------------------------------------------------------
    492. 

  492. #------------------------------------------------------------------------------------------------
    493. 

  493. 

  494. #xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx 
    495. 

  495. 

  496. sub maftoAxt_multispecies {
    497. 

  497. 	#print "in maftoAxt_multispecies : got @_\n";
    498. 

  498. 	my $fname=$_[0];
    499. 

  499. 	open(IN,"<$_[0]") or die "Cannot open $_[0]: $! \n";
    500. 

  500. 	my $treedefinition = $_[1];
    501. 

  501. 	open(OUT,">$_[2]") or die "Cannot open $_[2]: $! \n";
    502. 

  502. 	my $counter = 0;
    503. 

  503. 	my $exactspeciesset = $_[3];
    504. 

  504. 	my @exactspeciesset_unarranged = split(/,/,$exactspeciesset);
    505. 

  505. 	
    506. 

  506. 	$treedefinition=~s/[\)\(, ]/\t/g;
    507. 

  507. 	my @species=split(/\t+/,$treedefinition);
    508. 

  508. 	my @exactspecies=();
    509. 

  509. 	
    510. 

  510. 	foreach my $spec (@species){
    511. 

  511. 		foreach my $espec (@exactspeciesset_unarranged){
    512. 

  512. 			push @exactspecies, $spec if $spec eq $espec;
    513. 

  513. 		}
    514. 

  514. 	}
    515. 

  515. 	#print "exactspecies=@exactspecies\n";
    516. 

  516. 	
    517. 

  517. 	###########
    518. 

  518. 	my $select = 2;  
    519. 

  519. 	#select = 1 if all species need sequences to be present for each block otherwise, it is 0
    520. 

  520. 	#select = 2 only the allowed set make up the alignment. use the removeset
    521. 

  521. 	# information to detect alignmenets that have other important genomes aligned.
    522. 

  522. 	###########
    523. 

  523. 	my @allowedset = ();
    524. 

  524. 	@allowedset = split(/;/,allowedSetOfSpecies(join("_",@species))) if $select == 0;
    525. 

  525. 	@allowedset = join("_",0,@species) if $select == 1;
    526. 

  526. 	#print "species = @species , allowedset =",join("\n", @allowedset) ," \n"; 
    527. 

  527. 	@allowedset = join("_",0,@exactspecies) if $select == 2;
    528. 

  528. 	#print "allowedset = @allowedset and exactspecies = @exactspecies\n";
    529. 

  529. 	
    530. 

  530. 	my $start = 0;
    531. 

  531. 	my @sequences = ();
    532. 

  532. 	my @titles = ();
    533. 

  533. 	my $species_counter = "0";
    534. 

  534. 	my $countermatch = 0;
    535. 

  535. 	my $outsideSpecies=0;
    536. 

  536. 	
    537. 

  537. 	while(my $line = <IN>){
    538. 

  538. #		print $line;
    539. 

  539. 		next if $line =~ /^#/;
    540. 

  540. 		next if $line =~ /^i/;
    541. 

  541. 		chomp $line;
    542. 

  542. 		my @fields = split(/\s+/,$line);
    543. 

  543. 		chomp $line;
    544. 

  544. 		if ($line =~ /^a /){
    545. 

  545. 			$start = 1;
    546. 

  546. 		}
    547. 

  547. 		
    548. 

  548. 		if ($line =~ /^s /){
    549. 

  549. 		
    550. 

  550. 			foreach my $sp (@allspecies){
    551. 

  551. #				print "checking species $sp\n";
    552. 

  552. 				if ($fields[1] =~ /$sp/){
    553. 

  553. 					$species_counter = $species_counter."_".$sp;
    554. 

  554. 					push(@sequences, $fields[6]);
    555. 

  555. 					my @sp_info = split(/\./,$fields[1]);
    556. 

  556. 					my $title = join(" ",@sp_info, $fields[2], ($fields[2]+$fields[3]), $fields[4]);
    557. 

  557. 					push(@titles, $title);				
    558. 

  558. #					print "species_counter = $species_counter\n";
    559. 

  559. 				}
    560. 

  560. 			}
    561. 

  561. 		}
    562. 

  562. 		
    563. 

  563. 		if (($line !~ /^a/) && ($line !~ /^s/) && ($line !~ /^#/) && ($line !~ /^i/) && ($start = 1)){
    564. 

  564. #			print "species_counter = $species_counter\n"; 
    565. 

  565. 			my $arranged = reorderSpecies($species_counter, @allspecies);
    566. 

  566. 			my $stopper = 1;
    567. 

  567. 			my $arrno = 0;
    568. 

  568. 			
    569. 

  569. #			print "checking if ", scalar(@sequences), " match @exactspecies allowedset=@allowedset\n";
    570. 

  570. 			if (scalar(@sequences) == scalar(@exactspecies)){
    571. 

  571. 				foreach my $set (@allowedset){
    572. 

  572. #					print "testing $arranged against $set\n";
    573. 

  573. 					if ($arranged eq $set){
    574. 

  574. 						$stopper = 0; last;
    575. 

  575. 					}
    576. 

  576. 					$arrno++;
    577. 

  577. 				}
    578. 

  578. 			}
    579. 

  579. 			else{
    580. 

  580. 				$stopper = 1;
    581. 

  581. 			}
    582. 

  582. 			
    583. 

  583. 			
    584. 

  584. 			if ($stopper == 0) {
    585. 

  585. 				@titles = split ";", orderInfo(join(";", @titles), $species_counter, $arranged) if $species_counter ne $arranged;				
    586. 

  586. 				@sequences = split ";", orderInfo(join(";", @sequences), $species_counter, $arranged) if $species_counter ne $arranged;				
    587. 

  587. 				my $filteredseq = filter_gaps(@sequences);
    588. 

  588. 				
    589. 

  589. 				if ($filteredseq ne "SHORT"){
    590. 

  590. 					#print "printing"; <STDIN>;
    591. 

  591. 					$counter++;
    592. 

  592. 					print OUT join (" ",$counter, @titles), "\n";
    593. 

  593. 					print OUT $filteredseq, "\n";
    594. 

  594. 					print OUT "\n"; 
    595. 

  595. 					$countermatch++;
    596. 

  596. 				}
    597. 

  597. 			}
    598. 

  598. 			else{ #print "nexting\n";<STDIN>;
    599. 

  599. 			}
    600. 

  600. 	
    601. 

  601. 			@sequences = (); @titles = (); $start = 0;$species_counter = "0";
    602. 

  602. 			next;		
    603. 

  603. 			
    604. 

  604. 		}
    605. 

  605. 	}
    606. 

  606. #	print "countermatch = $countermatch\n";
    607. 

  607. }
    608. 

  608. 

  609. sub reorderSpecies{
    610. 

  610. 	my @inarr=@_;
    611. 

  611. 	my $currSpecies = shift (@inarr);
    612. 

  612. 	my $ordered_species = 0;
    613. 

  613. 	my @species=@inarr;
    614. 

  614. 	#print "species = @species\n";
    615. 

  615. 	foreach my $order (@species){
    616. 

  616. 		$ordered_species = $ordered_species."_".$order	if	$currSpecies=~ /$order/;
    617. 

  617. 	}
    618. 

  618. 	return $ordered_species;
    619. 

  619. 

  620. }
    621. 

  621. 

  622. sub filter_gaps{
    623. 

  623. 	my @sequences = @_;
    624. 

  624. #	print "sequences sent are @sequences\n";
    625. 

  625. 	my $seq_length = length($sequences[0]);
    626. 

  626. 	my $seq_no = scalar(@sequences);
    627. 

  627. 	my $allgaps = ();
    628. 

  628. 	for (1 ... $seq_no){
    629. 

  629. 		$allgaps = $allgaps."-";
    630. 

  630. 	}
    631. 

  631. 	
    632. 

  632. 	my @seq_array = ();
    633. 

  633. 	my $seq_counter = 0;
    634. 

  634. 	foreach my $seq (@sequences){
    635. 

  635. #		my @sequence = split(/\s*/,$seq);
    636. 

  636. 		$seq_array[$seq_counter] = [split(/\s*/,$seq)];
    637. 

  637. #		push @seq_array, [@sequence];
    638. 

  638. 		$seq_counter++;
    639. 

  639. 	}
    640. 

  640. 	my $g = 0;
    641. 

  641. 	while ( $g < $seq_length){
    642. 

  642. 		last if (!exists $seq_array[0][$g]);
    643. 

  643. 		my $bases = ();
    644. 

  644. 		for my $u (0 ... $#seq_array){
    645. 

  645. 			$bases = $bases.$seq_array[$u][$g];
    646. 

  646. 		}	
    647. 

  647. #		print $bases, "\n";
    648. 

  648. 		if ($bases eq $allgaps){
    649. 

  649. #			print "bases are $bases, position is $g \n";
    650. 

  650. 			for my $seq (@seq_array){
    651. 

  651. 				splice(@$seq , $g, 1);
    652. 

  652. 			}
    653. 

  653. 		}
    654. 

  654. 		else {
    655. 

  655. 			$g++;
    656. 

  656. 		}
    657. 

  657. 	}
    658. 

  658. 	
    659. 

  659. 	my @outs = ();
    660. 

  660. 	
    661. 

  661. 	foreach my $seq (@seq_array){
    662. 

  662. 		push(@outs, join("",@$seq));
    663. 

  663. 	}
    664. 

  664. 	return "SHORT" if length($outs[0]) <=100;
    665. 

  665. 	return (join("\n", @outs));	
    666. 

  666. }
    667. 

  667. 

  668. 

  669. sub allowedSetOfSpecies{
    670. 

  670. 	my @allowed_species = split(/_/,$_[0]);
    671. 

  671. 	unshift @allowed_species, 0;
    672. 

  672. #	print "allowed set = @allowed_species \n";
    673. 

  673. 	my @output = ();
    674. 

  674. 	for (0 ... scalar(@allowed_species) - 4){
    675. 

  675. 		push(@output, join("_",@allowed_species));
    676. 

  676. 		pop @allowed_species;
    677. 

  677. 	}
    678. 

  678. 	return join(";",reverse(@output));
    679. 

  679. 

  680. }
    681. 

  681. 

  682. 

  683. sub orderInfo{
    684. 

  684. 	my @info = split(/;/,$_[0]);
    685. 

  685. #	print "info = @info";
    686. 

  686. 	my @old = split(/_/,$_[1]);
    687. 

  687. 	my @new = split(/_/,$_[2]);
    688. 

  688. 	shift @old; shift @new;
    689. 

  689. 	my @outinfo = ();
    690. 

  690. 	foreach my $spe (@new){
    691. 

  691. 		for my $no (0 ... $#old){
    692. 

  692. 			if ($spe eq $old[$no]){
    693. 

  693. 				push(@outinfo, $info[$no]);
    694. 

  694. 			}
    695. 

  695. 		}
    696. 

  696. 	}
    697. 

  697. #	print "outinfo = @outinfo \n"; 
    698. 

  698. 	return join(";", @outinfo);
    699. 

  699. }
    700. 

  700. 

  701. #xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx 
    702. 

  702. 

  703. #xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx 
    704. 

  704. sub artificial_axdata_inverter{
    705. 

  705. 	open(IN,"<$_[0]") or die "Cannot open file $_[0]: $!";
    706. 

  706. 	open(OUT,">$_[1]") or die "Cannot open file $_[1]: $!";
    707. 

  707. 	my $linecounter=0;
    708. 

  708. 	while (my $line = <IN>){
    709. 

  709. 		$linecounter++;
    710. 

  710. 		#print "$linecounter\n";
    711. 

  711. 		chomp $line;	
    712. 

  712. 		my $final_line = $line;	
    713. 

  713. 		my $trycounter = 0;
    714. 

  714. 		if ($line =~ /^[a-zA-Z\-]/){
    715. 

  715. 		#	while ($final_line eq $line){
    716. 

  716. 				my @fields = split(/\s*/,$line);
    717. 

  717. 				
    718. 

  718. 				$final_line = join("",reverse(@fields));
    719. 

  719. 		#		print colored ['red'], "$line\n$final_line\n" if $final_line eq $line && $line !~ /chr/ && $line =~ /[a-zA-Z]/;
    720. 

  720. 		#		$trycounter++;
    721. 

  721. 		#		print "trying again....$trycounter : $final_line\n" if $final_line eq $line;
    722. 

  722. 		#	}
    723. 

  723. 		}
    724. 

  724. 		
    725. 

  725. 	#	print colored ['yellow'], "$line\n$final_line\n" if $final_line eq $line && $line !~ /chr/ && $line =~ /[a-zA-Z]/;
    726. 

  726. 		if ($line =~ /^[0-9]/){
    727. 

  727. 			$line =~ s/chr([A-Z0-9a-b]+)/chr$1r/g;
    728. 

  728. 			$final_line = $line;
    729. 

  729. 		}
    730. 

  730. 		print OUT $final_line,"\n";
    731. 

  731. 		#print "$line\n$final_line\n" if $final_line eq $line && $line !~ /chr/ && $line =~ /[a-zA-Z]/;
    732. 

  732. 	}
    733. 

  733. 	close OUT;
    734. 

  734. }
    735. 

  735. #xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx 
    736. 

  736. 

  737. 

  738. #xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx 
    739. 

  739. 

  740. sub multi_species_t1 {
    741. 

  741. 

  742. 	my $input1 = $_[0];
    743. 

  743. 	#print "@_\n"; <STDIN>;
    744. 

  744. 	my @tags = split(/_/, $_[1]);
    745. 

  745. 	my @outputs = split(/,/, $_[2]);
    746. 

  746. 	my $title_query = $_[3];
    747. 

  747. 	my @handles = ();
    748. 

  748. 	
    749. 

  749. 	open(FILEB,"<$input1")or die "Cannot open file: $input1 $!";
    750. 

  750. 	my $i = 0;
    751. 

  751. 	foreach my $path (@outputs){
    752. 

  752. 		$handles[$i] = IO::Handle->new();
    753. 

  753. 		open ($handles[$i], ">$path") or die "Can't open $path : $!";
    754. 

  754. 		$i++;
    755. 

  755. 	}
    756. 

  756. 	
    757. 

  757. 	my $curdef;
    758. 

  758. 	my $start = 0;
    759. 

  759. 	
    760. 

  760. 	while (my $line = <FILEB> ) {
    761. 

  761. 		if ($line =~ /^\d/){
    762. 

  762. 			$line =~ s/ +/\t/g;
    763. 

  763. 			my @fields = split(/\s+/, $line);
    764. 

  764. 			if (($line =~ /$title_query/)){
    765. 

  765. 				my $title = $line;
    766. 

  766. 				my $counter = 0;
    767. 

  767. 				foreach my $tag (@tags){
    768. 

  768. 					$line = <FILEB>;
    769. 

  769. 					print {$handles[$counter]} ">",$tag,"\t",$title, " ",$line;  	
    770. 

  770. 					$counter++;
    771. 

  771. 				}
    772. 

  772. 			}
    773. 

  773. 			else{
    774. 

  774. 					foreach my $tag (@tags){
    775. 

  775. 					my $tine = <FILEB>;
    776. 

  776. 				}		
    777. 

  777. 			}
    778. 

  778. 		
    779. 

  779. 		}
    780. 

  780. 	}
    781. 

  781. 	
    782. 

  782. 	foreach my $hand (@handles){
    783. 

  783. 		$hand->close(); 
    784. 

  784. 	}
    785. 

  785. 	
    786. 

  786. 	close FILEB;
    787. 

  787. }
    788. 

  788. 

  789. #xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx 
    790. 

  790. 

  791. #xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx 
    792. 

  792. 

  793. sub multi_species_t2{
    794. 

  794. 	
    795. 

  795. 	my $input = $_[0];
    796. 

  796. 	my $species = $_[1];
    797. 

  797. 	my $output1 = $input."_unr";
    798. 

  798. 	
    799. 

  799. 	#------------------------------------------------------------------------------------------
    800. 

  800. 	open (FILEF1, "<$input") or die "Cannot open file $input :$!";
    801. 

  801. 	open (FILEF2, ">$output1") or die "Cannot open file $output1 :$!";
    802. 

  802. 	
    803. 

  803. 	my $line1 = <FILEF1>;
    804. 

  804. 	
    805. 

  805. 	while($line1){
    806. 

  806. 	{
    807. 

  807. 	#    chomp($line);
    808. 

  808. 		if ($line1 =~ (m/^\>$species/)){
    809. 

  809. 		chomp($line1);
    810. 

  810. 		print FILEF2 $line1;
    811. 

  811. 		$line1 = <FILEF1>;
    812. 

  812. 		chomp($line1);
    813. 

  813. 		print FILEF2 "\t", $line1,"\n";
    814. 

  814. 	   }   
    815. 

  815. 	}
    816. 

  816. 	$line1 = <FILEF1>;
    817. 

  817. 	}
    818. 

  818. 	
    819. 

  819. 	close FILEF1;
    820. 

  820. 	close FILEF2;
    821. 

  821. 	#------------------------------------------------------------------------------------------
    822. 

  822. 	
    823. 

  823. 	my $output2 = $output1."and";
    824. 

  824. 	my $output3 = $output1."and2";
    825. 

  825. 	open(IN,"<$output1");
    826. 

  826. 	open (FILEF3, ">$output2");
    827. 

  827. 	open (FILEF4, ">$output3");
    828. 

  828. 	
    829. 

  829. 	
    830. 

  830. 	while (<IN>){
    831. 

  831. 		my $line = $_;
    832. 

  832. 		chomp($line);
    833. 

  833. 		my @fields=split (/\t/, $line);
    834. 

  834. 	  #  print $line,"\n"; <STDIN>;
    835. 

  835. 		if($line !~ /random/){
    836. 

  836. 			print FILEF3 join ("\t",@fields[0 ... scalar(@fields)-2]), "\n", $fields[scalar(@fields)-1], "\n";
    837. 

  837. 			print FILEF4 join ("\t",@fields[0 ... scalar(@fields)-2]), "\t", $fields[scalar(@fields)-1], "\n";	
    838. 

  838. 		}
    839. 

  839. 	}
    840. 

  840. 	
    841. 

  841. 	
    842. 

  842. 	close IN;
    843. 

  843. 	close FILEF3;
    844. 

  844. 	close FILEF4;
    845. 

  845. 	unlink $output1;
    846. 

  846. 	
    847. 

  847. 	#------------------------------------------------------------------------------------------
    848. 

  848. 	# OLD T3.PL RUDIMENT
    849. 

  849. 	
    850. 

  850. 	my $t3output = $output2;
    851. 

  851. 	$t3output =~ s/gap_op_unrand/nogap_op_unrand/g;
    852. 

  852. 	
    853. 

  853. 	open(IN,"<$output2");
    854. 

  854. 	open(OUTA,">$t3output");
    855. 

  855. 	
    856. 

  856. 	
    857. 

  857. 	while (<IN>){
    858. 

  858. 		s/-//g unless /^>/;
    859. 

  859. 		print OUTA;
    860. 

  860. 	}
    861. 

  861. 	
    862. 

  862. 	close IN;
    863. 

  863. 	close OUTA;
    864. 

  864. 	#------------------------------------------------------------------------------------------
    865. 

  865. }
    866. 

  866. #xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx 
    867. 

  867. 

  868. 

  869. #xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxxmulti_species_t2_2 xxxxxxx 
    870. 

  870. sub multi_species_t2_2{
    871. 

  871. 	#print "IN multi_species_t2_2 : @_\n";
    872. 

  872. 	my $input = $_[0];
    873. 

  873. 	my $species = $_[1];
    874. 

  874. 	my $output1 = $input."2";
    875. 

  875. 	
    876. 

  876. 	
    877. 

  877. 	open (FILEF1, "<$input");
    878. 

  878. 	open (FILEF2, ">$output1");
    879. 

  879. 	
    880. 

  880. 	my $line1 = <FILEF1>;
    881. 

  881. 	
    882. 

  882. 	while($line1){
    883. 

  883. 	{
    884. 

  884. 	#    chomp($line);
    885. 

  885. 		if ($line1 =~ (m/^\>$species/)){
    886. 

  886. 		chomp($line1);
    887. 

  887. 		print FILEF2 $line1;
    888. 

  888. 		$line1 = <FILEF1>;
    889. 

  889. 		chomp($line1);
    890. 

  890. 		print FILEF2 "\t", $line1,"\n";
    891. 

  891. 	   }   
    892. 

  892. 	}
    893. 

  893. 	$line1 = <FILEF1>;
    894. 

  894. 	}
    895. 

  895. 	
    896. 

  896. 	close FILEF1;
    897. 

  897. 	close FILEF2;
    898. 

  898. }
    899. 

  899. 

  900. #xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxx multi_species_t2_2 xxxxxxx 
    901. 

  901. 

  902. 

  903. #xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx 
    904. 

  904. sub sputnikoutput_corrector{
    905. 

  905. 	my $input = $_[0];
    906. 

  906. 	my $output = $_[1];
    907. 

  907. 	open(IN,"<$input") or die "Cannot open file $input :$!";
    908. 

  908. 	open(OUT,">$output") or die "Cannot open file $output :$!";
    909. 

  909. 	my $tine;
    910. 

  910. 	while (my $line=<IN>){
    911. 

  911. 		if($line =~/length /){
    912. 

  912. 			$tine = $line;
    913. 

  913. 			$tine =~ s/\s+/\t/g;
    914. 

  914. 			my @fields = split(/\t/,$tine);	
    915. 

  915. 			if ($fields[6] > 60){
    916. 

  916. 				print OUT $line;
    917. 

  917. 				$line = <IN>;
    918. 

  918. 			
    919. 

  919. 				while (($line !~ /nucleotide/) && ($line !~ /^>/)){
    920. 

  920. 					chomp $line;
    921. 

  921. 					print OUT $line;
    922. 

  922. 					$line = <IN>;
    923. 

  923. 				}
    924. 

  924. 				print OUT "\n";
    925. 

  925. 				print OUT $line;
    926. 

  926. 			}
    927. 

  927. 			else{
    928. 

  928. 				print OUT $line;
    929. 

  929. 			}
    930. 

  930. 		}
    931. 

  931. 		else{
    932. 

  932. 			print OUT $line;
    933. 

  933. 		}
    934. 

  934. 	}
    935. 

  935. 	close IN;
    936. 

  936. 	close OUT;
    937. 

  937. }
    938. 

  938. #xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx 
    939. 

  939. 

  940. 

  941. #xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx 
    942. 

  942. sub multi_species_t4{
    943. 

  943. #	print "multi_species_t4 : @_\n";
    944. 

  944. 	my $input = $_[0];
    945. 

  945. 	my $output = $_[1];
    946. 

  946. 	open (FILEA, "<$input");
    947. 

  947. 	open (FILEB, ">$output");
    948. 

  948. 	
    949. 

  949. 	my $line = <FILEA>;
    950. 

  950. 	
    951. 

  951. 	while ($line) {
    952. 

  952. 	   # chomp $line;
    953. 

  953. 		if ($line =~ />/) {
    954. 

  954. 			chomp $line;
    955. 

  955. 			print FILEB $line, "\n"; 
    956. 

  956. 		}
    957. 

  957. 	
    958. 

  958. 		
    959. 

  959. 		if ($line =~ /^m/ | $line =~ /^d/ | $line =~ /^t/ | $line =~ /^p/){
    960. 

  960. 		chomp $line;
    961. 

  961. 		print FILEB $line, " " ;
    962. 

  962. 		$line = <FILEA>;
    963. 

  963. 		chomp $line;
    964. 

  964. 		print FILEB $line,"\n";
    965. 

  965. 		}
    966. 

  966. 	
    967. 

  967. 		$line = <FILEA>;
    968. 

  968. 	}
    969. 

  969. 	
    970. 

  970. 	
    971. 

  971. 	close FILEA;
    972. 

  972. 	close FILEB;
    973. 

  973. 

  974. }
    975. 

  975. 

  976. #xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx 
    977. 

  977. 

  978. 

  979. #xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx 
    980. 

  980. sub multi_species_t5{
    981. 

  981. 	
    982. 

  982. 	my $input = $_[0];
    983. 

  983. 	my $output = $_[1];
    984. 

  984. 	
    985. 

  985. 	open(FILEB,"<$input");
    986. 

  986. 	open(FILEC,">$output");
    987. 

  987. 	
    988. 

  988. 	my $curdef;
    989. 

  989. 	
    990. 

  990. 	while (my $line = <FILEB> ) {
    991. 

  991. 	
    992. 

  992. 		if ($line =~ /^>/){
    993. 

  993. 		chomp $line;
    994. 

  994. 		$curdef = $line;
    995. 

  995. 		next;
    996. 

  996. 	}
    997. 

  997. 	
    998. 

  998. 	if ($line =~ /^m/ | $line =~ /^d/ | $line =~ /^t/ | $line =~ /^p/){
    999. 

  999. 		print  FILEC $curdef," ",$line;
    1000. 

  1000. 	}
    1001. 

  1001. 	
    1002. 

  1002. 	}
    1003. 

  1003. 	
    1004. 

  1004. 	
    1005. 

  1005. 	close FILEB;
    1006. 

  1006. 	close FILEC;
    1007. 

  1007. 

  1008. }
    1009. 

  1009. #xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx 
    1010. 

  1010. 

  1011. 

  1012. #xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx 
    1013. 

  1013. sub multi_species_t6{
    1014. 

  1014. 	my $input = $_[0];
    1015. 

  1015. 	my $output = $_[1];	
    1016. 

  1016. 	my $focalstrand=$_[3];
    1017. 

  1017. #	print "inpput = @_\n"; 
    1018. 

  1018. 	open (FILE, "<$input");
    1019. 

  1019. 	open (FILE_MICRO, ">$output");
    1020. 

  1020. 	my $linecounter=0;	
    1021. 

  1021. 	while (my $line = <FILE>){
    1022. 

  1022. 		$linecounter++;
    1023. 

  1023. 		chomp $line;
    1024. 

  1024. 		#print "line = $line\n";
    1025. 

  1025. 		#MONO#
    1026. 

  1026. 		$line =~ /$focalspec\s[a-zA-Z]+[0-9a-zA-Z]+\s[0-9]+\s[0-9]+\s([+\-])/;
    1027. 

  1027. 		my $strand=$1;
    1028. 

  1028. 		my $no_of_species = ($line =~ s/\s+[+\-]\s+/ /g);
    1029. 

  1029. 		#print "line = $line\n";
    1030. 

  1030. 		my $specfieldsend = 2 + ($no_of_species*4) - 1;
    1031. 

  1031. 		my @fields = split(/\s+/, $line);
    1032. 

  1032. 		my @speciesdata = @fields[0 ... $specfieldsend];
    1033. 

  1033. 		$line =~ /([a-z]+nucleotide)\s([0-9]+)\s:\s([0-9]+)/;
    1034. 

  1034. 		my ($tide, $start, $end) = ($1, $2, $3);
    1035. 

  1035. 		#print "no_of_species=$no_of_species.. speciesdata = @speciesdata and ($tide, $start, $end)\n";
    1036. 

  1036. 		if($line  =~ /mononucleotide/){
    1037. 

  1037. 			print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields],  mono($fields[$#fields]),),"\n";
    1038. 

  1038. 		}
    1039. 

  1039. 		#DI#	
    1040. 

  1040. 		elsif($line =~ /dinucleotide/){
    1041. 

  1041. 			print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields],  di($fields[$#fields]),),"\n";
    1042. 

  1042. 		}
    1043. 

  1043. 		#TRI#	
    1044. 

  1044. 		elsif($line =~ /trinucleotide/ ){
    1045. 

  1045. 			print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields],  tri($fields[$#fields]),),"\n";
    1046. 

  1046. 		}
    1047. 

  1047. 		#TETRA#
    1048. 

  1048. 		elsif($line =~ /tetranucleotide/){
    1049. 

  1049. 			print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields],  tetra($fields[$#fields]),),"\n";
    1050. 

  1050. 		}
    1051. 

  1051. 		#PENTA#
    1052. 

  1052. 		elsif($line =~ /pentanucleotide/){
    1053. 

  1053. 			#print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields],  penta($fields[$#fields]),),"\n";
    1054. 

  1054. 		}
    1055. 

  1055. 		else{
    1056. 

  1056. 		#	print "not: @fields\n";
    1057. 

  1057. 		}
    1058. 

  1058. 	}
    1059. 

  1059. #	print "linecounter=$linecounter\n"; 
    1060. 

  1060. 	close FILE;
    1061. 

  1061. 	close FILE_MICRO;
    1062. 

  1062. }
    1063. 

  1063. 

  1064. sub mono {
    1065. 

  1065. 	my $st = $_[0];
    1066. 

  1066. 	my $tp = unpack "A1"x(length($st)/1),$st;
    1067. 

  1067. 	my $var1 = substr($tp, 0, 1);
    1068. 

  1068. 	return join ("\t", $var1);
    1069. 

  1069. }
    1070. 

  1070. sub di {
    1071. 

  1071. 	my $st = $_[0];
    1072. 

  1072. 	my $tp = unpack "A2"x(length($st)/2),$st;
    1073. 

  1073. 	my $var1 = substr($tp, 0, 2);
    1074. 

  1074. 	return join ("\t", $var1);
    1075. 

  1075. }
    1076. 

  1076. sub tri {
    1077. 

  1077. 	my $st = $_[0];
    1078. 

  1078. 	my $tp = unpack "A3"x(length($st)/3),$st;
    1079. 

  1079. 	my $var1 = substr($tp, 0, 3);
    1080. 

  1080. 	return join ("\t", $var1);
    1081. 

  1081. }
    1082. 

  1082. sub tetra {
    1083. 

  1083. 	my $st = $_[0];
    1084. 

  1084. 	my $tp = unpack "A4"x(length($st)/4),$st;
    1085. 

  1085. 	my $var1 = substr($tp, 0, 4);
    1086. 

  1086. 	return join ("\t", $var1);
    1087. 

  1087. }
    1088. 

  1088. sub penta {
    1089. 

  1089. 	my $st = $_[0];
    1090. 

  1090. 	my $tp = unpack "A5"x(length($st)/5),$st;
    1091. 

  1091. 	my $var1 = substr($tp, 0, 5);
    1092. 

  1092. 	return join ("\t", $var1);
    1093. 

  1093. }
    1094. 

  1094. 

  1095. #xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx 
    1096. 

  1096. 

  1097. 

  1098. #xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx 
    1099. 

  1099. sub t9{
    1100. 

  1100. 	my $input1 = $_[0];
    1101. 

  1101. 	my $input2 = $_[1];
    1102. 

  1102. 	my $output = $_[2];
    1103. 

  1103. 	
    1104. 

  1104. 	
    1105. 

  1105. 	open(IN1,"<$input1") if -e $input1; 
    1106. 

  1106. 	open(IN2,"<$input2") or die "cannot open file $_[1] : $!";
    1107. 

  1107. 	open(OUT,">$output") or die "cannot open file $_[2] : $!"; 
    1108. 

  1108. 	
    1109. 

  1109. 	
    1110. 

  1110. 	my %seen = ();
    1111. 

  1111. 	my $prevkey = 0;
    1112. 

  1112. 	
    1113. 

  1113. 	if (-e $input1){
    1114. 

  1114. 		while (my $line = <IN1>){
    1115. 

  1115. 			chomp($line);
    1116. 

  1116. 			my @fields = split(/\t/,$line);
    1117. 

  1117. 			my $key1 = join ("_K10K1_",@fields[0,1,3,4,5]);
    1118. 

  1118. 		#	print "key in t9 = $key1\n";
    1119. 

  1119. 			$seen{$key1}++	if ($prevkey ne $key1) ;
    1120. 

  1120. 			$prevkey = $key1;
    1121. 

  1121. 		}
    1122. 

  1122. #		print "done first hash\n";
    1123. 

  1123. 		close IN1;
    1124. 

  1124. 	}
    1125. 

  1125. 	
    1126. 

  1126. 	while (my $line = <IN2>){
    1127. 

  1127. 	#	print $line, "**\n";
    1128. 

  1128. 		if (-e $input1){
    1129. 

  1129. 			chomp($line);
    1130. 

  1130. 			my @fields = split(/\t/,$line);
    1131. 

  1131. 			my $key2 = join ("_K10K1_",@fields[0,1,3,4,5]);
    1132. 

  1132. 			if (exists $seen{$key2}){
    1133. 

  1133. 				print OUT "$line\n"	;
    1134. 

  1134. 				delete $seen{$key2};
    1135. 

  1135. 			}
    1136. 

  1136. 		}
    1137. 

  1137. 		else {
    1138. 

  1138. 			print OUT "$line\n"	;		
    1139. 

  1139. #			print  "$line\n"	;		
    1140. 

  1140. 		}
    1141. 

  1141. 	}
    1142. 

  1142. 	
    1143. 

  1143. 	close IN2;
    1144. 

  1144. 	close OUT;
    1145. 

  1145. }
    1146. 

  1146. #xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx 
    1147. 

  1147. 

  1148. 

  1149. #xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx  multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx  multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx 
    1150. 

  1150. 

  1151. 

  1152. sub multiSpecies_compound_microsat_hunter3{	
    1153. 

  1153. 	
    1154. 

  1154. 	my $input1 = $_[0];  ###### the *_sput_op4_ii file
    1155. 

  1155. 	my $input2 = $_[1];  ###### looks like this: my $t8humanoutput = $pipedir.$ptag."_nogap_op_unrand2"
    1156. 

  1156. 	my $output1 = $_[2]; ###### plain microsatellite file
    1157. 

  1157. 	my $output2 = $_[3]; ###### compound microsatellite file
    1158. 

  1158. 	my $org = $_[4]; ###### 1 or 2
    1159. 

  1159. 	$no_of_species = $_[5];
    1160. 

  1160. 	#print "IN multiSpecies_compound_microsat_hunter3: @_\n"; 
    1161. 

  1161. 	#my @tags = split(/\t/,$info);
    1162. 

  1162. 	sub compoundify;
    1163. 

  1163. 	open(IN,"<$input1") or die "Cannot open file $input1 $!";
    1164. 

  1164. 	open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
    1165. 

  1165. 	open(OUT,">$output1") or die "Cannot open file $output1 $!";
    1166. 

  1166. 	open(OUT2,">$output2") or die "Cannot open file $output2 $!";
    1167. 

  1167. 	$infocord = 2 + (4*$no_of_species) - 1;
    1168. 

  1168. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    1169. 

  1169. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    1170. 

  1170. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    1171. 

  1171. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    1172. 

  1172. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    1173. 

  1173. 	my $sequencepos = 2 + (5*$no_of_species) + 1 -1 ; 
    1174. 

  1174. 	
    1175. 

  1175. 	my @thresholds = ("0");
    1176. 

  1176. 	push(@thresholds, split(/_/,$_[6]));
    1177. 

  1177. 	sub thresholdCheck;
    1178. 

  1178. 	my %micros = ();
    1179. 

  1179. 	while (my $line = <IN>){
    1180. 

  1180. 	#	print "$org\t(chr[0-9]+)\t([0-9]+)\t([0-9])+\t \n";
    1181. 

  1181. 		next if $line =~ /\t\t/;
    1182. 

  1182. 		if ($line =~ /^>[A-Za-z0-9_]+\s+([0-9]+)\s+([a-zA-Z0-9]+)\s([a-zA-Z]+[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    1183. 

  1183. 			my $key = join("\t",$1, $2, $3, $4, $5);
    1184. 

  1184. 		#	print $key, "#-#-#-#-#-#-#-#\n";
    1185. 

  1185. 			push (@{$micros{$key}},$line);		
    1186. 

  1186. 		}
    1187. 

  1187. 		else{
    1188. 

  1188. 		}
    1189. 

  1189. 	}
    1190. 

  1190. 	close IN;
    1191. 

  1191. 	my @deletedlines = ();
    1192. 

  1192. 	
    1193. 

  1193. 	my $linecount = 0;
    1194. 

  1194. 	
    1195. 

  1195. 	while(my $sine = <SEQ>){
    1196. 

  1196. 		my %microstart=();
    1197. 

  1197. 		my %microend=();
    1198. 

  1198. 	
    1199. 

  1199. 		my @sields = split(/\t/,$sine);
    1200. 

  1200. 	
    1201. 

  1201. 		my $key = ();
    1202. 

  1202. 	
    1203. 

  1203. 		if ($sine =~ /^>[A-Za-z0-9]+\s+([0-9]+)\s+([a-zA-Z0-9]+)\s([a-zA-Z]+[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    1204. 

  1204. 			$key = join("\t",$1, $2, $3, $4, $5);
    1205. 

  1205. 		#	print $key, "<-<-<-<-<-<-<-<\n";		
    1206. 

  1206. 		}
    1207. 

  1207. 		else{
    1208. 

  1208. 		}
    1209. 

  1209. 	
    1210. 

  1210. 		if (exists $micros{$key}){
    1211. 

  1211. 			$linecount++;	
    1212. 

  1212. 			my @microstring = @{$micros{$key}};
    1213. 

  1213. 			my @tempmicrostring = @{$micros{$key}};
    1214. 

  1214. 			
    1215. 

  1215. 			foreach my $line (@tempmicrostring){
    1216. 

  1216. 				my @fields = split(/\t/,$line);
    1217. 

  1217. 				my $start = $fields[$startcord];
    1218. 

  1218. 				my $end = $fields[$endcord];
    1219. 

  1219. 				push (@{$microstart{$start}},$line);
    1220. 

  1220. 				push (@{$microend{$end}},$line);	
    1221. 

  1221. 			}
    1222. 

  1222. 			my $firstflag = 'down';
    1223. 

  1223. 			while( my $line =shift(@microstring)){
    1224. 

  1224. 	#			print "-----------\nline = $line ";
    1225. 

  1225. 				chomp $line;
    1226. 

  1226. 				my @fields = split(/\t/,$line);
    1227. 

  1227. 				my $start = $fields[$startcord];
    1228. 

  1228. 				my $end = $fields[$endcord];
    1229. 

  1229. 				my $startmicro = $line;
    1230. 

  1230. 				my $endmicro = $line;
    1231. 

  1231. 	
    1232. 

  1232. 			#	print "fields=@fields, start = $start end=$end, startcord=$startcord, endcord=$endcord\n";
    1233. 

  1233. 	
    1234. 

  1234. 				delete ($microstart{$start});
    1235. 

  1235. 				delete ($microend{$end});
    1236. 

  1236. 				my $flag = 'down';	
    1237. 

  1237. 				my $startflag = 'down';
    1238. 

  1238. 				my $endflag = 'down';
    1239. 

  1239. 				my $prestart = $start - $distance;
    1240. 

  1240. 				my $postend = $end + $distance;
    1241. 

  1241. 				my @compoundlines = ();
    1242. 

  1242. 				my %compoundhash = ();
    1243. 

  1243. 				push (@compoundlines, $line);
    1244. 

  1244. 				push (@{$compoundhash{$line}},$line);
    1245. 

  1245. 				my $startrank = 1;
    1246. 

  1246. 				my $endrank = 1;
    1247. 

  1247. 				
    1248. 

  1248. 				while( ($startflag eq "down") || ($endflag eq "down") ){
    1249. 

  1249. 				if ((($prestart < 0) && $firstflag eq "up") || (($postend > length($sields[$sequencepos])) && $firstflag eq "up") ) {
    1250. 

  1250. #					print "coming to the end of sequence,prestart = $prestart &  post end = $postend and sequence length =", length($sields[$sequencepos])," so exiting\n";
    1251. 

  1251. 					last;
    1252. 

  1252. 				}
    1253. 

  1253. 					
    1254. 

  1254. 				$firstflag = "up";
    1255. 

  1255. 				if ($startflag eq "down"){		
    1256. 

  1256. 					for my $i ($prestart ... $start){
    1257. 

  1257. 					
    1258. 

  1258. 						if(exists $microend{$i}){	
    1259. 

  1259. 							chomp $microend{$i}[0];
    1260. 

  1260. 							if(exists $compoundhash{$microend{$i}[0]}) {next;}
    1261. 

  1261. 	#						print "sending from microend $startmicro, $microend{$i}[0] |||\n";
    1262. 

  1262. 							if (identityMatch_thresholdCheck($startmicro, $microend{$i}[0], $startrank) eq "proceed"){
    1263. 

  1263. 								push(@compoundlines, $microend{$i}[0]);
    1264. 

  1264. 	#							print "accepted\n";
    1265. 

  1265. 								my @tields = split(/\t/,$microend{$i}[0]);
    1266. 

  1266. 								$startmicro = $microend{$i}[0];
    1267. 

  1267. 								chomp $startmicro;
    1268. 

  1268. 								$start = $tields[$startcord];
    1269. 

  1269. 								$flag = 'down';
    1270. 

  1270. 								$startrank++;
    1271. 

  1271. 	#							print "startcompund = $microend{$i}[0]\n";
    1272. 

  1272. 								delete $microend{$i};
    1273. 

  1273. 								delete $microstart{$start};
    1274. 

  1274. 								$startflag = 'down';
    1275. 

  1275. 								$prestart = $start - $distance;
    1276. 

  1276. 								last;
    1277. 

  1277. 							}	
    1278. 

  1278. 							else{
    1279. 

  1279. 								$flag = 'up';
    1280. 

  1280. 								$startflag = 'up';							
    1281. 

  1281. 							}
    1282. 

  1282. 						}
    1283. 

  1283. 						else{
    1284. 

  1284. 							$flag = 'up';
    1285. 

  1285. 							$startflag = 'up';
    1286. 

  1286. 						}
    1287. 

  1287. 					}
    1288. 

  1288. 				}
    1289. 

  1289. 					
    1290. 

  1290. 				$endrank = $startrank;
    1291. 

  1291. 				
    1292. 

  1292. 				if ($endflag eq "down"){				
    1293. 

  1293. 					for my $i ($end ... $postend){
    1294. 

  1294. 					
    1295. 

  1295. 						if(exists $microstart{$i} ){
    1296. 

  1296. 							chomp $microstart{$i}[0];
    1297. 

  1297. 							if(exists $compoundhash{$microstart{$i}[0]}) {next;}	
    1298. 

  1298. 	#						print "sending from microstart $endmicro, $microstart{$i}[0] |||\n";
    1299. 

  1299. 	
    1300. 

  1300. 							if(identityMatch_thresholdCheck($endmicro,$microstart{$i}[0], $endrank) eq "proceed"){
    1301. 

  1301. 								push(@compoundlines, $microstart{$i}[0]);
    1302. 

  1302. 	#								print "accepted\n";
    1303. 

  1303. 								my @tields = split(/\t/,$microstart{$i}[0]);
    1304. 

  1304. 								$end = $tields[$endcord]-0;
    1305. 

  1305. 								$endmicro = $microstart{$i}[0];
    1306. 

  1306. 								$endrank++;
    1307. 

  1307. 								chomp $endmicro;
    1308. 

  1308. 								$flag = 'down';
    1309. 

  1309. 	#							print "endcompund = $microstart{$i}[0]\n";
    1310. 

  1310. 								delete $microstart{$i};
    1311. 

  1311. 								delete $microend{$end};
    1312. 

  1312. 								shift @microstring;
    1313. 

  1313. 								$postend = $end + $distance;
    1314. 

  1314. 								$endflag = 'down';
    1315. 

  1315. 								last;								
    1316. 

  1316. 							}
    1317. 

  1317. 							else{
    1318. 

  1318. 								$flag = 'up';
    1319. 

  1319. 								$endflag = 'up';							
    1320. 

  1320. 							}
    1321. 

  1321. 						}
    1322. 

  1322. 						else{
    1323. 

  1323. 							$flag = 'up';
    1324. 

  1324. 							$endflag = 'up';
    1325. 

  1325. 						}
    1326. 

  1326. 					}
    1327. 

  1327. 				}
    1328. 

  1328. 	#			print "for next turn, flag status: startflag = $startflag and endflag = $endflag \n";
    1329. 

  1329. 			} 														#end while( $flag eq "down")
    1330. 

  1330. 	#			print "compoundlines = @compoundlines \n";
    1331. 

  1331. 			if (scalar (@compoundlines) == 1){
    1332. 

  1332. 				print OUT $line,"\n";			
    1333. 

  1333. 			}
    1334. 

  1334. 			if (scalar (@compoundlines) > 1){
    1335. 

  1335. 				my $compoundline = compoundify(\@compoundlines, $sields[$sequencepos]);
    1336. 

  1336. 	#				print $compoundline,"\n";
    1337. 

  1337. 				print OUT2 $compoundline,"\n";
    1338. 

  1338. 			}
    1339. 

  1339. 			} #end foreach my $line (@microstring){
    1340. 

  1340. 		}	#if (exists $micros{$key}){
    1341. 

  1341. 	
    1342. 

  1342. 	
    1343. 

  1343. 	}
    1344. 

  1344. 	
    1345. 

  1345. 	close OUT;
    1346. 

  1346. 	close OUT2;
    1347. 

  1347. }
    1348. 

  1348. 

  1349. 

  1350. #------------------------------------------------------------------------------------------------
    1351. 

  1351. sub compoundify{
    1352. 

  1352. 	my ($compoundlines, $sequence)  = @_;
    1353. 

  1353. #	print "\nfound to compound : @$compoundlines and$sequence \n";
    1354. 

  1354. 	my $noOfComps = @$compoundlines;
    1355. 

  1355. #	print "Number of elements in hash is $noOfComps\n";
    1356. 

  1356. 	my @starts;
    1357. 

  1357. 	my @ends;
    1358. 

  1358. 	foreach my $line (@$compoundlines){
    1359. 

  1359. #		print "compoundify.. line = $line \n";
    1360. 

  1360. 		chomp $line;
    1361. 

  1361. 		my @fields = split(/\t/,$line);
    1362. 

  1362. 		my $start = $fields[$startcord];
    1363. 

  1363. 		my $end = $fields[$endcord];
    1364. 

  1364. 	#	print "start = $start, end = $end \n";
    1365. 

  1365. 		push(@starts, $start);
    1366. 

  1366. 		push(@ends,$end);		
    1367. 

  1367. 	}
    1368. 

  1368. 	my @temp = @$compoundlines;
    1369. 

  1369. 	my $startline=$temp[0];
    1370. 

  1370. 	my @mields  = split(/\t/,$startline);
    1371. 

  1371. 	my $startcoord = $mields[$startcord];
    1372. 

  1372. 	my $startgapsign=$mields[$endcord];
    1373. 

  1373. 	my @startsorted = sort { $a <=> $b } @starts;
    1374. 

  1374. 	my @endsorted = sort { $a <=> $b } @ends;
    1375. 

  1375. 	my @intervals;
    1376. 

  1376. 	for my $end (0 ... (scalar(@endsorted)-2)){
    1377. 

  1377. 		my $interval = substr($sequence,($endsorted[$end]+1),(($startsorted[$end+1])-($endsorted[$end])-1));
    1378. 

  1378. 		push(@intervals,$interval);
    1379. 

  1379. 	#	print "interval = $interval =\n";
    1380. 

  1380. 	#	print "substr(sequence,($endsorted[$end]+1),(($startsorted[$end+1])-($endsorted[$end])-1))\n";
    1381. 

  1381. 	}
    1382. 

  1382. 	push(@intervals,"");
    1383. 

  1383. 	my $compoundmicrosat=();
    1384. 

  1384. 	my $multiunit="";
    1385. 

  1385. 	foreach my $line (@$compoundlines){
    1386. 

  1386. 		my @fields = split(/\t/,$line);
    1387. 

  1387. 		my $component="[".$fields[$microsatcord]."]".shift(@intervals);
    1388. 

  1388. 		$compoundmicrosat=$compoundmicrosat.$component;
    1389. 

  1389. 		$multiunit=$multiunit."[".$fields[$motifcord]."]";
    1390. 

  1390. #		print "multiunit = $multiunit\n";
    1391. 

  1391. 	}
    1392. 

  1392. 	my $compoundcopy = $compoundmicrosat;
    1393. 

  1393. 	$compoundcopy =~ s/\[|\]//g;
    1394. 

  1394. 	my $compoundlength = $mields[$startcord] + length($compoundcopy) - 1;
    1395. 

  1395. 	
    1396. 

  1396. 	
    1397. 

  1397. 	my $compoundline = join("\t",(@mields[0 ... $infocord], "compound",@mields[$startcord ... $startcord+1],$compoundlength,$compoundmicrosat, $multiunit));
    1398. 

  1398. 	return $compoundline;
    1399. 

  1399. }	
    1400. 

  1400. 

  1401. #------------------------------------------------------------------------------------------------
    1402. 

  1402. 

  1403. sub identityMatch_thresholdCheck{
    1404. 

  1404. 	my $line1 = $_[0];
    1405. 

  1405. 	my $line2 = $_[1];
    1406. 

  1406. 	my $rank = $_[2];
    1407. 

  1407. 	my @lields1 = split(/\t/,$line1);
    1408. 

  1408. 	my @lields2 = split(/\t/,$line2);
    1409. 

  1409. #	print "recieved $line1 && $line2\n motif comparison: ", length($lields1[$motifcord])," : ",length($lields2[$motifcord]),"\n";
    1410. 

  1410. 	
    1411. 

  1411. 	if (length($lields1[$motifcord]) == length($lields2[$motifcord])){
    1412. 

  1412. 		my $probe = $lields1[$motifcord].$lields1[$motifcord];
    1413. 

  1413. 			#print "$probe :: $lields2[$motifcord]\n";
    1414. 

  1414. 		return "proceed" if $probe =~ /$lields2[$motifcord]/;
    1415. 

  1415. 			#print "line recieved\n";
    1416. 

  1416. 		if ($rank ==1){
    1417. 

  1417. 			return "proceed" if thresholdCheck($line1) eq "proceed" && thresholdCheck($line2) eq "proceed";
    1418. 

  1418. 		}
    1419. 

  1419. 		else {
    1420. 

  1420. 			return "proceed" if thresholdCheck($line2) eq "proceed";
    1421. 

  1421. 			return "stop";
    1422. 

  1422. 		}
    1423. 

  1423. 	}
    1424. 

  1424. 	else{
    1425. 

  1425. 		if ($rank ==1){
    1426. 

  1426. 			return "proceed" if thresholdCheck($line1) eq "proceed" && thresholdCheck($line2) eq "proceed";
    1427. 

  1427. 		}
    1428. 

  1428. 		else {
    1429. 

  1429. 			return "proceed" if thresholdCheck($line2) eq "proceed";
    1430. 

  1430. 			return "stop";
    1431. 

  1431. 		}
    1432. 

  1432. 	}
    1433. 

  1433. 	return "stop";
    1434. 

  1434. }
    1435. 

  1435. #------------------------------------------------------------------------------------------------
    1436. 

  1436. 

  1437. sub thresholdCheck{
    1438. 

  1438. 	my @checkthresholds=(0,@thresholds);
    1439. 

  1439. 	#print "IN thresholdCheck: @_\n";
    1440. 

  1440. 	my $line = $_[0];
    1441. 

  1441. 	my @lields = split(/\t/,$line);
    1442. 

  1442. 	return "proceed" if length($lields[$microsatcord]) >= $checkthresholds[length($lields[$motifcord])];
    1443. 

  1443. 	return "stop";
    1444. 

  1444. }
    1445. 

  1445. #xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx  multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx  multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx 
    1446. 

  1446. 

  1447. 

  1448. #xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx  multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx  multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx 
    1449. 

  1449. 

  1450. sub multiSpecies_filtering_interrupted_microsats{
    1451. 

  1451. #	print "IN multiSpecies_filtering_interrupted_microsats: @_\n";
    1452. 

  1452. 	my $unfiltered = $_[0];
    1453. 

  1453. 	my $filtered = $_[1];
    1454. 

  1454. 	my $residue = $_[2];
    1455. 

  1455. 	my $no_of_species = $_[5];
    1456. 

  1456. 	open(UNF,"<$unfiltered") or die "Cannot open file $unfiltered: $!";
    1457. 

  1457. 	open(FIL,">$filtered") or die "Cannot open file $filtered: $!";
    1458. 

  1458. 	open(RES,">$residue") or die "Cannot open file $residue: $!";
    1459. 

  1459. 		
    1460. 

  1460. 	$infocord = 2 + (4*$no_of_species) - 1;
    1461. 

  1461. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    1462. 

  1462. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    1463. 

  1463. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    1464. 

  1464. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    1465. 

  1465. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    1466. 

  1466. 	
    1467. 

  1467. 	
    1468. 

  1468. 	my @sub_thresholds = (0);
    1469. 

  1469. 	
    1470. 

  1470. 	push(@sub_thresholds, split(/_/,$_[3]));
    1471. 

  1471. 	my @thresholds = (0);
    1472. 

  1472. 	
    1473. 

  1473. 	push(@thresholds, split(/_/,$_[4]));
    1474. 

  1474. 	
    1475. 

  1475. 	while (my $line = <UNF>) {
    1476. 

  1476. 		next if $line !~ /[a-z]/;
    1477. 

  1477. 		#print $line;
    1478. 

  1478. 		chomp $line;
    1479. 

  1479. 		my @fields = split(/\t/,$line);
    1480. 

  1480. 		my $motif = $fields[$motifcord];
    1481. 

  1481. 		my $realmotif = $motif;
    1482. 

  1482. 		#print "motif = $motif\n";
    1483. 

  1483. 		if ($motif =~ /^\[/){
    1484. 

  1484. 			$motif =~ s/^\[//g;
    1485. 

  1485. 			my @motifs = split(/\]/,$motif);
    1486. 

  1486. 			$realmotif = $motifs[0];
    1487. 

  1487. 		}
    1488. 

  1488. #		print "realmotif = $realmotif";
    1489. 

  1489. 		my $motif_size = length($realmotif);
    1490. 

  1490. 		
    1491. 

  1491. 		my $microsat = $fields[$microsatcord];
    1492. 

  1492. #		print "microsat = $microsat\n";
    1493. 

  1493. 		$microsat =~ s/^\[|\]$//sg;
    1494. 

  1494. 		my @microsats = split(/\][a-zA-Z|-]*\[/,$microsat);
    1495. 

  1495. 		
    1496. 

  1496. 		$microsat = join("",@microsats);
    1497. 

  1497. 		if (length($microsat) < $thresholds[$motif_size]) {
    1498. 

  1498. 		#	print length($microsat)," < ",$thresholds[$motif_size],"\n"; 
    1499. 

  1499. 			print RES $line,"\n"; next;
    1500. 

  1500. 		}
    1501. 

  1501. 		my @lengths = ();
    1502. 

  1502. 		foreach my $mic (@microsats){
    1503. 

  1503. 			push(@lengths, length($mic));
    1504. 

  1504. 		}
    1505. 

  1505. 		if (largest_microsat(@lengths) < $sub_thresholds[$motif_size]) {
    1506. 

  1506. 	#		print largest_microsat(@lengths)," < ",$sub_thresholds[$motif_size],"\n"; 
    1507. 

  1507. 			print RES $line,"\n"; next;}
    1508. 

  1508. 			else {print FIL $line,"\n"; next;
    1509. 

  1509. 		}
    1510. 

  1510. 	}
    1511. 

  1511. 	close FIL;
    1512. 

  1512. 	close RES;
    1513. 

  1513. 

  1514. }
    1515. 

  1515. 

  1516. sub largest_microsat{
    1517. 

  1517. 	my $counter = 0;
    1518. 

  1518. 	my($max) = shift(@_);
    1519. 

  1519.     foreach my $temp (@_) {
    1520. 

  1520.     	#print "finding largest array: $maxcounter \n";
    1521. 

  1521.     	if($temp > $max){
    1522. 

  1522.         	$max = $temp;
    1523. 

  1523.         }
    1524. 

  1524.     }
    1525. 

  1525.     return($max);
    1526. 

  1526. }
    1527. 

  1527. 

  1528. #xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx  multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx  multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx 
    1529. 

  1529. 

  1530. 

  1531. #xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx  multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx  multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx 
    1532. 

  1532. sub multiSpecies_compound_microsat_analyzer{
    1533. 

  1533. 	####### PARAMETER ########
    1534. 

  1534. 	##########################
    1535. 

  1535. 	
    1536. 

  1536. 	my $input1 = $_[0];  ###### the *_sput_op4_ii file
    1537. 

  1537. 	my $input2 = $_[1];  ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
    1538. 

  1538. 	my $output1 = $_[2]; ###### interrupted microsatellite file, in new .interrupted format
    1539. 

  1539. 	my $output2 = $_[3]; ###### the pure compound microsatellites
    1540. 

  1540. 	my $org = $_[4];
    1541. 

  1541. 	my $no_of_species = $_[5];
    1542. 

  1542. #	print "IN multiSpecies_compound_microsat_analyzer: $input1\n $input2\n $output1\n $output2\n $org\n $no_of_species\n";
    1543. 

  1543. 	$infocord = 2 + (4*$no_of_species) - 1;
    1544. 

  1544. 	$typecord = 2 + (4*$no_of_species) + 1 - 1;
    1545. 

  1545. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    1546. 

  1546. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    1547. 

  1547. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    1548. 

  1548. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    1549. 

  1549. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    1550. 

  1550. 	
    1551. 

  1551. 	open(IN,"<$input1") or die "Cannot open file $input1 $!";
    1552. 

  1552. 	open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
    1553. 

  1553. 	
    1554. 

  1554. 	open(OUT,">$output1") or die "Cannot open file $output1 $!";
    1555. 

  1555. 	open(OUT2,">$output2") or die "Cannot open file $output2 $!";
    1556. 

  1556. 	
    1557. 

  1557. 	
    1558. 

  1558. #	print "opened files \n";
    1559. 

  1559. 	my %micros = ();
    1560. 

  1560. 	my $keycounter=0;
    1561. 

  1561. 	my $linecounter=0;
    1562. 

  1562. 	while (my $line = <IN>){
    1563. 

  1563. 		$linecounter++;
    1564. 

  1564. 		if ($line =~ /([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    1565. 

  1565. 			my $key = join("\t",$1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
    1566. 

  1566. 			push (@{$micros{$key}},$line);		
    1567. 

  1567. 			$keycounter++;
    1568. 

  1568. 		}
    1569. 

  1569. 		else{
    1570. 

  1570. 	#		print "no key\n";
    1571. 

  1571. 		}
    1572. 

  1572. 	}
    1573. 

  1573. 	close IN;
    1574. 

  1574. 	my @deletedlines = ();
    1575. 

  1575. #	print "done hash . linecounter=$linecounter, keycounter=$keycounter\n";
    1576. 

  1576. 	#---------------------------------------------------------------------------------------------------
    1577. 

  1577. 	# NOW READING THE SEQUENCE FILE
    1578. 

  1578. 	my $keyfound=0;
    1579. 

  1579. 	my $keyexists=0;
    1580. 

  1580. 	my $inter=0;
    1581. 

  1581. 	my $pure=0;
    1582. 

  1582. 	
    1583. 

  1583. 	while(my $sine = <SEQ>){
    1584. 

  1584. 		my %microstart=();
    1585. 

  1585. 		my %microend=();
    1586. 

  1586. 		my @sields = split(/\t/,$sine);
    1587. 

  1587. 		my $key = 0;
    1588. 

  1588. 		if ($sine =~ /([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s[\+|\-]\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s[\+|\-]\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    1589. 

  1589. 			$key = join("\t",$1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
    1590. 

  1590. 		#	print $sine;
    1591. 

  1591. 		#	print $key;
    1592. 

  1592. 			$keyfound++;
    1593. 

  1593. 		}
    1594. 

  1594. 		else{
    1595. 

  1595. 		
    1596. 

  1596. 		}
    1597. 

  1597. 		#<STDIN> if !defined $key;
    1598. 

  1598. 

  1599. 		if (exists $micros{$key}){
    1600. 

  1600. 			$keyexists++;
    1601. 

  1601. 			my @microstring = @{$micros{$key}};
    1602. 

  1602. 	
    1603. 

  1603. 			my @filteredmicrostring;
    1604. 

  1604. 			
    1605. 

  1605. 			foreach my $line (@microstring){
    1606. 

  1606. 				chomp $line;
    1607. 

  1607. 				my $copy_line = $line;
    1608. 

  1608. 				my @fields = split(/\t/,$line);
    1609. 

  1609. 				my $start = $fields[$startcord];
    1610. 

  1610. 				my $end = $fields[$endcord];				
    1611. 

  1611. 				# FOR COMPOUND MICROSATELLITES	
    1612. 

  1612. 				if ($fields[$typecord] eq "compound"){					
    1613. 

  1613. 					$line = compound_microsat_analyser($line);	
    1614. 

  1614. 					if ($line eq "NULL") {
    1615. 

  1615. 						print OUT2 "$copy_line\n";
    1616. 

  1616. 						$pure++;
    1617. 

  1617. 						next;
    1618. 

  1618. 					}
    1619. 

  1619. 					else{
    1620. 

  1620. 						print OUT "$line\n";
    1621. 

  1621. 						$inter++;
    1622. 

  1622. 						next;
    1623. 

  1623. 					}
    1624. 

  1624. 				}
    1625. 

  1625. 			}
    1626. 

  1626. 			
    1627. 

  1627. 		}	#if (exists $micros{$key}){
    1628. 

  1628. 	}
    1629. 

  1629. 	close OUT;
    1630. 

  1630. 	close OUT2;
    1631. 

  1631. #	print "keyfound=$keyfound, keyexists=$keyexists, pure=$pure, inter=$inter\n";
    1632. 

  1632. }
    1633. 

  1633. 	
    1634. 

  1634. sub compound_microsat_analyser{
    1635. 

  1635. 	my $line = $_[0];
    1636. 

  1636. 	my @fields = split(/\t/,$line);
    1637. 

  1637. 	my $motifline = $fields[$motifcord];
    1638. 

  1638. 	my $microsat = $fields[$microsatcord];
    1639. 

  1639. 	$motifline =~ s/^\[|\]$//g;
    1640. 

  1640. 	$microsat =~ s/^\[|\]$//g;
    1641. 

  1641. 	$microsat =~ s/-//g;
    1642. 

  1642. 	my @interruptions = ();
    1643. 

  1643. 	my @motields = split(/\]\[/,$motifline);
    1644. 

  1644. 	my @microields = split(/\][a-zA-Z|-]*\[/,$microsat);
    1645. 

  1645. 	my @inields = split(/[.*]/,$microsat);
    1646. 

  1646. 	shift @inields;
    1647. 

  1647. 	my @motifcount = scalar(@motields);
    1648. 

  1648. 	my $prevmotif = $motields[0];
    1649. 

  1649. 	my $prevmicro = $microields[0];
    1650. 

  1650. 	my $prevphase = substr($microields[0],-(length($motields[0])),length($motields[0]));
    1651. 

  1651. 	my $localflag = 'down';
    1652. 

  1652. 	my @infoarray = ();
    1653. 

  1653. 	
    1654. 

  1654. 	for my $l (1 ... (scalar(@motields)-1)){
    1655. 

  1655. 		my $probe = $prevmotif.$prevmotif;
    1656. 

  1656. 		if (length $prevmotif != length $motields[$l]) {$localflag = "up"; last;}
    1657. 

  1657. 		
    1658. 

  1658. 		if ($probe =~ /$motields[$l]/i){ 
    1659. 

  1659. 			my $curr_endphase = substr($microields[$l],-length($motields[$l]),length($motields[$l]));
    1660. 

  1660. 			my $curr_startphase = substr($microields[$l],0,length($motields[$l]));
    1661. 

  1661. 			if ($curr_startphase =~ /$prevphase/i) {
    1662. 

  1662. 				$infoarray[$l-1] = "insertion";
    1663. 

  1663. 			}
    1664. 

  1664. 			else {
    1665. 

  1665. 				$infoarray[$l-1] = "indel/substitution";
    1666. 

  1666. 			}
    1667. 

  1667. 		
    1668. 

  1668. 			$prevmotif = $motields[$l]; $prevmicro = $microields[$l]; $prevphase = $curr_endphase;
    1669. 

  1669. 			next;
    1670. 

  1670. 		}
    1671. 

  1671. 		else {$localflag = "up"; last;}
    1672. 

  1672. 	}
    1673. 

  1673. 	if ($localflag eq 'up') {return "NULL";}
    1674. 

  1674. 	
    1675. 

  1675. 	if (length($prevmotif) == 1) {$fields[$typecord] = "mononucleotide";}
    1676. 

  1676. 	if (length($prevmotif) == 2) {$fields[$typecord] = "dinucleotide";}
    1677. 

  1677. 	if (length($prevmotif) == 3) {$fields[$typecord] = "trinucleotide";}
    1678. 

  1678. 	if (length($prevmotif) == 4) {$fields[$typecord] = "tetranucleotide";}
    1679. 

  1679. 	if (length($prevmotif) == 5) {$fields[$typecord] = "pentanucleotide";}
    1680. 

  1680. 

  1681. 	@microields = split(/[\[|\]]/,$microsat);
    1682. 

  1682. 	my @microsats = ();
    1683. 

  1683. 	my @positions = ();
    1684. 

  1684. 	my $lengthtracker = 0;
    1685. 

  1685. 

  1686. 	for my $i (0 ... (scalar(@microields ) - 1)){
    1687. 

  1687. 		if ($i%2 == 0){
    1688. 

  1688. 			push(@microsats,$microields[$i]);
    1689. 

  1689. 			$lengthtracker = $lengthtracker + length($microields[$i]);
    1690. 

  1690. 

  1691. 		}
    1692. 

  1692. 		else{			
    1693. 

  1693. 			push(@interruptions,$microields[$i]);
    1694. 

  1694. 			push(@positions, $lengthtracker+1);
    1695. 

  1695. 			$lengthtracker = $lengthtracker + length($microields[$i]);	
    1696. 

  1696. 		}				
    1697. 

  1697. 		
    1698. 

  1698. 	}
    1699. 

  1699. 	my $returnline = join("\t",(join("\t",@fields),join(",",(@infoarray)),join(",",(@interruptions)),join(",",(@positions)),scalar(@interruptions)));
    1700. 

  1700. 	return($returnline);
    1701. 

  1701. }
    1702. 

  1702. 

  1703. #xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx  multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx  multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx 
    1704. 

  1704. 

  1705. 

  1706. #xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx  multiSpecies_compoundClarifyer xxxxxxxxxxxxxx  multiSpecies_compoundClarifyer xxxxxxxxxxxxxx 
    1707. 

  1707. 

  1708. sub multiSpecies_compoundClarifyer{	
    1709. 

  1709. #	print "IN multiSpecies_compoundClarifyer: @_\n";
    1710. 

  1710. 	my $input1 = $_[0];  ###### the *_sput_compound
    1711. 

  1711. 	my $input2 = $_[1];  ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
    1712. 

  1712. 	my $output1 = $_[2]; ###### interrupted microsatellite file, in new .interrupted format
    1713. 

  1713. 	my $output2 = $_[3]; ###### compound file
    1714. 

  1714. 	my $org = $_[4];
    1715. 

  1715. 	my $no_of_species = $_[5];
    1716. 

  1716. 	@thresholds = "0";
    1717. 

  1717. 	push(@thresholds, split(/_/,$_[6]));
    1718. 

  1718. 	
    1719. 

  1719. 	
    1720. 

  1720. 	$infocord = 2 + (4*$no_of_species) - 1;
    1721. 

  1721. 	$typecord = 2 + (4*$no_of_species) + 1 - 1;
    1722. 

  1722. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    1723. 

  1723. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    1724. 

  1724. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    1725. 

  1725. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    1726. 

  1726. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    1727. 

  1727. 	$sequencepos = 2 + (5*$no_of_species) + 1 -1 ; 
    1728. 

  1728. 	
    1729. 

  1729. 	$interr_poscord = $motifcord + 3;
    1730. 

  1730. 	$no_of_interruptionscord = $motifcord + 4;
    1731. 

  1731. 	$interrcord = $motifcord + 2;
    1732. 

  1732. 	$interrtypecord = $motifcord + 1;
    1733. 

  1733. 	
    1734. 

  1734. 	
    1735. 

  1735. 	open(IN,"<$input1") or die "Cannot open file $input1 $!";
    1736. 

  1736. 	open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
    1737. 

  1737. 	
    1738. 

  1738. 	open(INT,">$output1") or die "Cannot open file $output2 $!";
    1739. 

  1739. 	open(COMP,">$output2") or die "Cannot open file $output2 $!";
    1740. 

  1740. 	#open(CH,">changed") or die "Cannot open file changed $!";
    1741. 

  1741. 		
    1742. 

  1742. #	print "opened files \n";
    1743. 

  1743. 	my $linecounter = 0;
    1744. 

  1744. 	my $microcounter = 0;
    1745. 

  1745. 	
    1746. 

  1746. 	my %micros = ();
    1747. 

  1747. 	while (my $line = <IN>){
    1748. 

  1748. 	#	print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
    1749. 

  1749. 		$linecounter++;
    1750. 

  1750. 		if ($line =~ /($focalspec)\s+([0-9a-zA-Z_\-]+)\s+([0-9]+)\s+([0-9]+)/ ) {
    1751. 

  1751. 			my $key = join("\t",$1, $2, $3, $4);
    1752. 

  1752. 	#		print $key, "#-#-#-#-#-#-#-#\n";
    1753. 

  1753. 	#		print "key = $key\n";
    1754. 

  1754. 			push (@{$micros{$key}},$line);	
    1755. 

  1755. 			$microcounter++;
    1756. 

  1756. 		}
    1757. 

  1757. 		else {#print $line," key not made\n"; <STDIN>;
    1758. 

  1758. 			}
    1759. 

  1759. 	}
    1760. 

  1760. #	print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
    1761. 

  1761. 	close IN;
    1762. 

  1762. 	my @deletedlines = ();
    1763. 

  1763. #	print "done hash \n";
    1764. 

  1764. 	$linecounter = 0;
    1765. 

  1765. 	#---------------------------------------------------------------------------------------------------
    1766. 

  1766. 	# NOW READING THE SEQUENCE FILE
    1767. 

  1767. 	my @microsat_types = qw(_ mononucleotide dinucleotide trinucleotide tetranucleotide);
    1768. 

  1768. 	 $printer = 0;
    1769. 

  1769. 	
    1770. 

  1770. 	while(my $sine = <SEQ>){
    1771. 

  1771. 		my %microstart=();
    1772. 

  1772. 		my %microend=();
    1773. 

  1773. 		my @sields = split(/\t/,$sine);
    1774. 

  1774. 		my $key = ();
    1775. 

  1775. 		
    1776. 

  1776. #		print "sine = $sine. focalspec = $focalspec \n"; #<STDIN>;
    1777. 

  1777. 		
    1778. 

  1778. 		if ($sine =~ /($focalspec)\s+([0-9a-zA-Z_\-]+)\s+([0-9]+)\s+([0-9]+)/ ) {
    1779. 

  1779. 			
    1780. 

  1780. #			if ($sine =~ /([a-z0-9A-Z]+)\s+([0-9a-zA-Z_]+)\s+([0-9]+)\s+([0-9]+)\s+[\+|\-]\s+([a-z0-9A-Z]+)\s+([0-9a-zA-Z_]+)\s+([0-9]+)\s+([0-9]+)\s+[\+|\-]\s+([a-z0-9A-Z]+)\s+([0-9a-zA-Z_]+)\s+([0-9]+)\s+([0-9]+)\s/ ) {
    1781. 

  1781. 			$key = join("\t",$1, $2, $3, $4);
    1782. 

  1782. #			print "key = $key\n";
    1783. 

  1783. 		}
    1784. 

  1784. 		else{
    1785. 

  1785. #			print "no key in $sine\nfor pattern ([a-z0-9A-Z]+) (chr[0-9a-zA-Z]+) ([0-9]+) ([0-9]+) [\+|\-] (a-z0-9A-Z) (chr[0-9a-zA-Z]+) ([0-9]+) ([0-9]+) [\+|\-] (a-z0-9A-Z) (chr[0-9a-zA-Z]+) ([0-9]+) ([0-9]+)   / \n"; 
    1786. 

  1786. 		}
    1787. 

  1787. 	
    1788. 

  1788. 		if (exists $micros{$key}){
    1789. 

  1789. 			my @microstring = @{$micros{$key}};
    1790. 

  1790. 			delete $micros{$key};
    1791. 

  1791. 			
    1792. 

  1792. 			foreach my $line (@microstring){
    1793. 

  1793. #				print "#---------#---------#---------#---------#---------#---------#---------#---------\n" if $printer == 1; 
    1794. 

  1794. #				print "microsat = $line" if $printer == 1; 
    1795. 

  1795. 				$linecounter++; 
    1796. 

  1796. 				my $copy_line = $line;
    1797. 

  1797. 				my @mields = split(/\t/,$line);
    1798. 

  1798. 				my @fields = @mields;
    1799. 

  1799. 				my $start = $fields[$startcord];
    1800. 

  1800. 				my $end = $fields[$endcord];
    1801. 

  1801. 				my $microsat = $fields[$microsatcord];
    1802. 

  1802. 				my $motifline = $fields[$motifcord];
    1803. 

  1803. 				my $microsatcopy = $microsat;
    1804. 

  1804. 				my $positioner = $microsat;
    1805. 

  1805. 				$positioner =~ s/[a-zA-Z|-]/_/g;
    1806. 

  1806. 				$microsatcopy =~ s/^\[|\]$//gs;
    1807. 

  1807. 				chomp $microsatcopy;
    1808. 

  1808. 				my @microields = split(/\][a-zA-Z|-]*\[/,$microsatcopy);
    1809. 

  1809. 				my @inields = split(/\[[a-zA-Z|-]*\]/,$microsat);
    1810. 

  1810. 				my $absolutstart = 1; my $absolutend = $absolutstart + ($end-$start);
    1811. 

  1811. #				print "absolut: start = $absolutstart, end = $absolutend\n" if $printer == 1;
    1812. 

  1812. 				shift @inields;
    1813. 

  1813. 				#print "inields =@inields<\n";
    1814. 

  1814. 				$motifline =~ s/^\[|\]$//gs;
    1815. 

  1815. 				chomp $motifline;
    1816. 

  1816. 				#print "microsat = $microsat, its copy = $microsatcopy motifline = $motifline<\n";
    1817. 

  1817. 				my @motields = split(/\]\[/,$motifline);
    1818. 

  1818. 				my $seq = $microsatcopy;
    1819. 

  1819. 				$seq =~ s/\[|\]//g;
    1820. 

  1820. 				my $seqlen = length($seq);
    1821. 

  1821. 				$seq = " ".$seq;
    1822. 

  1822. 	
    1823. 

  1823. 				my $longestmotif_no = longest_array_element(@motields);
    1824. 

  1824. 				my $shortestmotif_no = shortest_array_element(@motields);
    1825. 

  1825. 				#print "shortest motif = $motields[$shortestmotif_no], longest motif = $motields[$longestmotif_no] \n";
    1826. 

  1826. 			
    1827. 

  1827. 				my $search = $motields[$longestmotif_no].$motields[$longestmotif_no];
    1828. 

  1828. 				if ((length($motields[$longestmotif_no]) == length($motields[$shortestmotif_no])) && ($search !~ /$motields[$shortestmotif_no]/) ){
    1829. 

  1829. 					print COMP $line;
    1830. 

  1830. 					next;
    1831. 

  1831. 				}
    1832. 

  1832. 			
    1833. 

  1833. 				my @shortestmotif_nos = ();
    1834. 

  1834. 				for my $m (0 ... $#motields){
    1835. 

  1835. 					push(@shortestmotif_nos, $m) if (length($motields[$m]) == length($motields[$shortestmotif_no]) );
    1836. 

  1836. 				}
    1837. 

  1837. 				## LOOKING AT LEFT OF THE SHORTEST MOTIF------------------------------------------------
    1838. 

  1838. 				my $newleft =();
    1839. 

  1839. 				my $leftstopper = 0; my $rightstopper = 0;
    1840. 

  1840. 				foreach my $shortmotif_no (@shortestmotif_nos){
    1841. 

  1841. 					next if $shortmotif_no == 0;
    1842. 

  1842. 					my $last_left =  $shortmotif_no; #$#motields;
    1843. 

  1843. 					my $last_hitter = 0;
    1844. 

  1844. 					for (my $i =($shortmotif_no-1); $i>=0; $i--){	
    1845. 

  1845. 						my $search  = $motields[$shortmotif_no];
    1846. 

  1846. 						if (length($motields[$shortmotif_no]) == 1){ $search = $motields[$shortmotif_no].$motields[$shortmotif_no] ;}
    1847. 

  1847. 						if( (length($motields[$i]) > length($motields[$shortmotif_no])) && length($microields[$i]) > (2.5 * length($motields[$i])) ){
    1848. 

  1848. 							$last_hitter = 1;
    1849. 

  1849. 							$last_left = $i+1; last;				
    1850. 

  1850. 						}
    1851. 

  1851. 						my $probe = $motields[$i];
    1852. 

  1852. 						if (length($motields[$shortmotif_no]) == length($motields[$i])) {$probe = $motields[$i].$motields[$i];}
    1853. 

  1853. 	
    1854. 

  1854. 						if ($probe !~ /$search/){
    1855. 

  1855. 							$last_hitter = 1;
    1856. 

  1856. 							$last_left = $i+1; 
    1857. 

  1857. 	#						print "hit the last match: before $microields[$i]..last left = $last_left.. exiting.\n";
    1858. 

  1858. 							last;
    1859. 

  1859. 						}
    1860. 

  1860. 						$last_left--;$last_hitter = 1;
    1861. 

  1861. 	#					print "passed tests, last left = $last_left\n";
    1862. 

  1862. 					}
    1863. 

  1863. 	#				print "comparing whether $last_left < $shortmotif_no, lasthit = $last_hitter\n";
    1864. 

  1864. 					if (($last_left) < $shortmotif_no && $last_hitter == 1) {$leftstopper=0; last;}
    1865. 

  1865. 					else {$leftstopper = 1;
    1866. 

  1866. 	#					print "leftstopper = 1\n";
    1867. 

  1867. 					}
    1868. 

  1868. 				}
    1869. 

  1869. 				
    1870. 

  1870. 				## LOOKING AT LEFT OF THE SHORTEST MOTIF------------------------------------------------
    1871. 

  1871. 				my $newright =();
    1872. 

  1872. 				foreach my $shortmotif_no (@shortestmotif_nos){
    1873. 

  1873. 					next if $shortmotif_no == $#motields;
    1874. 

  1874. 					my $last_right =  $shortmotif_no;# -1;
    1875. 

  1875. 					for my $i ($shortmotif_no+1 ... $#motields){
    1876. 

  1876. 						my $search  = $motields[$shortmotif_no];
    1877. 

  1877. 						if (length($motields[$shortmotif_no]) == 1 ){ $search = $motields[$shortmotif_no].$motields[$shortmotif_no] ;}
    1878. 

  1878. 						if ( (length($motields[$i]) > length($motields[$shortmotif_no])) && length($microields[$i]) > (2.5 * length($motields[$i])) ){
    1879. 

  1879. 							$last_right = $i-1; last;			
    1880. 

  1880. 						}
    1881. 

  1881. 						my $probe = $motields[$i];
    1882. 

  1882. 						if (length($motields[$shortmotif_no]) == length($motields[$i])) {$probe = $motields[$i].$motields[$i];}
    1883. 

  1883. 						if (  $probe !~ /$search/){
    1884. 

  1884. 							$last_right = $i-1; last;
    1885. 

  1885. 						}
    1886. 

  1886. 						$last_right++; 
    1887. 

  1887. 					}
    1888. 

  1888. 					if (($last_right) > $shortmotif_no) {$rightstopper=0; last;# print "rightstopper = 0\n";
    1889. 

  1889. 					}
    1890. 

  1890. 					else {$rightstopper = 1;
    1891. 

  1891. 					}
    1892. 

  1892. 				}
    1893. 

  1893. 				
    1894. 

  1894. 				
    1895. 

  1895. 				if ($rightstopper == 1 && $leftstopper == 1){
    1896. 

  1896. 					print COMP $line; 
    1897. 

  1897. #					print "rightstopper == 1 && leftstopper == 1\n" if $printer == 1; 
    1898. 

  1898. 					next;
    1899. 

  1899. 				}
    1900. 

  1900. 	
    1901. 

  1901. #				print "pased initial testing phase \n" if $printer == 1; 
    1902. 

  1902. 				my @outputs = ();
    1903. 

  1903. 				my @orig_starts = ();
    1904. 

  1904. 				my @orig_ends = ();
    1905. 

  1905. 				for my $mic (0 ... $#microields){
    1906. 

  1906. 					my $miclen = length($microields[$mic]);
    1907. 

  1907. 					my $microleftlen = 0;
    1908. 

  1908. 					#print "\nmic = $mic\n";
    1909. 

  1909. 					if($mic > 0){
    1910. 

  1910. 						for my $submin (0 ... $mic-1){
    1911. 

  1911. 							my $interval = ();
    1912. 

  1912. 							if (!exists $inields[$submin]) {$interval = "";}
    1913. 

  1913. 							else {$interval = $inields[$submin];}
    1914. 

  1914. 							#print "inield =$interval< and microield =$microields[$submin]<\n  ";
    1915. 

  1915. 							$microleftlen = $microleftlen + length($microields[$submin]) + length($interval);
    1916. 

  1916. 						}
    1917. 

  1917. 					}
    1918. 

  1918. 					push(@orig_starts,($microleftlen+1));
    1919. 

  1919. 					push(@orig_ends, ($microleftlen+1 + $miclen -1));
    1920. 

  1920. 				}				
    1921. 

  1921. 	
    1922. 

  1922. 	#############  F I N A L L Y   S T U D Y I N G   S E Q U E N C E S  #########@@@@#########@@@@#########@@@@#########@@@@#########@@@@
    1923. 

  1923. 	
    1924. 

  1924. 	
    1925. 

  1925. 				for my $mic (0 ... $#microields){
    1926. 

  1926. 					my $miclen = length($microields[$mic]);
    1927. 

  1927. 					my $microleftlen = 0;
    1928. 

  1928. 					if($mic > 0){
    1929. 

  1929. 						for my $submin (0 ... $mic-1){
    1930. 

  1930. 						#	if(!exists $inields[$submin]) {$inields[$submin] = "";}
    1931. 

  1931. 							my $interval = ();
    1932. 

  1932. 							if (!exists $inields[$submin]) {$interval = "";}
    1933. 

  1933. 							else {$interval = $inields[$submin];}
    1934. 

  1934. 							#print "inield =$interval< and microield =$microields[$submin]<\n  ";
    1935. 

  1935. 							$microleftlen = $microleftlen + length($microields[$submin]) + length($interval);
    1936. 

  1936. 						}
    1937. 

  1937. 					}
    1938. 

  1938. 					$fields[$startcord] = $microleftlen+1;
    1939. 

  1939. 					$fields[$endcord] = $fields[$startcord] + $miclen -1;
    1940. 

  1940. 					$fields[$typecord] = $microsat_types[length($motields[$mic])];
    1941. 

  1941. 					$fields[$microsatcord] = $microields[$mic];
    1942. 

  1942. 					$fields[$motifcord] = $motields[$mic];		
    1943. 

  1943. 					my $templine = join("\t", (@fields[0 .. $motifcord]) );
    1944. 

  1944. 					my $orig_templine = join("\t", (@fields[0 .. $motifcord]) );
    1945. 

  1945. 					my $newline;
    1946. 

  1946. 					my $lefter = 1; my $righter = 1;
    1947. 

  1947. 					if ( $fields[$startcord] < 2){$lefter = 0;}
    1948. 

  1948. 					if ($fields[$endcord] == $seqlen){$righter = 0;}
    1949. 

  1949. 	
    1950. 

  1950. 					while($lefter == 1){
    1951. 

  1951. 						$newline = left_extender($templine, $seq,$org);
    1952. 

  1952. #						print "returned line from left extender= $newline \n" if $printer == 1; 
    1953. 

  1953. 						if ($newline eq $templine){$templine = $newline; last;}
    1954. 

  1954. 						else {$templine = $newline;}
    1955. 

  1955. 						
    1956. 

  1956. 						if (left_extention_permission_giver($templine) eq "no") {last;}
    1957. 

  1957. 					}
    1958. 

  1958. 					while($righter == 1){
    1959. 

  1959. 						$newline = right_extender($templine, $seq,$org);
    1960. 

  1960. #						print "returned line from right extender= $newline \n" if $printer == 1; 
    1961. 

  1961. 						if ($newline eq $templine){$templine = $newline; last;}
    1962. 

  1962. 						else {$templine = $newline;}
    1963. 

  1963. 						if (right_extention_permission_giver($templine) eq "no") {last;}
    1964. 

  1964. 					}
    1965. 

  1965. 					my @tempfields = split(/\t/,$templine);
    1966. 

  1966. 					$tempfields[$microsatcord] =~ s/\]|\[//g;
    1967. 

  1967. 					$tempfields[$motifcord] =~ s/^\[|\]$//gs;
    1968. 

  1968. 					my @tempmotields = split(/\]\[/,$tempfields[$motifcord]);			
    1969. 

  1969. 					
    1970. 

  1970. 					if (scalar(@tempmotields) == 1 && $templine eq $orig_templine) { 
    1971. 

  1971. #						print "scalar ( tempmotields) = 1\n" if $printer == 1; 
    1972. 

  1972. 						next;
    1973. 

  1973. 					} 
    1974. 

  1974. 					my $prevmotif = shift(@tempmotields);
    1975. 

  1975. 					my $stopper = 0;
    1976. 

  1976. 					
    1977. 

  1977. 					foreach my $tempmot (@tempmotields){
    1978. 

  1978. 						if (length($tempmot) != length($prevmotif)) {$stopper = 1; last;}
    1979. 

  1979. 						my $search = $prevmotif.$prevmotif;
    1980. 

  1980. 						if ($search !~ /$tempmot/) {$stopper = 1; last;}
    1981. 

  1981. 						$prevmotif = $tempmot;
    1982. 

  1982. 					}
    1983. 

  1983. 					if ( $stopper == 1) { 
    1984. 

  1984. #						print "length tempmot  != length prevmotif\n" if $printer == 1; 
    1985. 

  1985. 						next; 
    1986. 

  1986. 					} 
    1987. 

  1987. 					my $lastend  = 0;
    1988. 

  1988. 					#----------------------------------------------------------
    1989. 

  1989. 					my $left_captured = (); my $right_captured = ();
    1990. 

  1990. 					my $left_bp = (); my $right_bp = ();
    1991. 

  1991. 	#				print "new startcord = $tempfields[$startcord] , new endcord  = $tempfields[$endcord].. orig strts = @orig_starts and orig ends = @orig_ends\n";
    1992. 

  1992. 					for my $o (0 ... $#orig_starts){
    1993. 

  1993. #						print "we are talking abut tempstart:$tempfields[$startcord] >= origstart:$lastend && tempstart:$tempfields[$startcord] <= origend: $orig_ends[$o] \n" if $printer == 1; 
    1994. 

  1994. #						print "we are talking abut tempend:$tempfields[$endcord] >= origstart:$lastend && tempstart:$tempfields[$endcord] >= origend: $orig_ends[$o] \n" if $printer == 1; 
    1995. 

  1995. 	
    1996. 

  1996. 						if (($tempfields[$startcord] > $lastend)  && ($tempfields[$startcord] <= $orig_ends[$o])){ # && ($tempfields[$startcord] != $fields[$startcord])
    1997. 

  1997. #							print "motif captured on left is $microields[$o] from $microsat\n" if $printer == 1; 
    1998. 

  1998. 							$left_captured  = $o;
    1999. 

  1999. 							$left_bp =  $orig_ends[$o] - $tempfields[$startcord] + 1;
    2000. 

  2000. 						}
    2001. 

  2001. 						elsif ($tempfields[$endcord] > $lastend  && $tempfields[$endcord] <= $orig_ends[$o]){ #&& $tempfields[$endcord] != $fields[$endcord])
    2002. 

  2002. #							print "motif captured on right is $microields[$o] from $microsat\n" if $printer == 1; 
    2003. 

  2003. 							$right_captured  = $o;
    2004. 

  2004. 							$right_bp = $tempfields[$endcord]  - $orig_starts[$o] + 1;
    2005. 

  2005. 						}
    2006. 

  2006. 						$lastend = $orig_ends[$o]
    2007. 

  2007. 					}
    2008. 

  2008. #					print "leftcaptured = $left_captured, right = $right_captured\n" if $printer==1;
    2009. 

  2009. 					my $leftmotif = (); my $left_trashed = ();
    2010. 

  2010. 					if ($tempfields[$startcord] != $fields[$startcord]) {
    2011. 

  2011. 						$leftmotif = $motields[$left_captured]; 
    2012. 

  2012. #						print "$left_captured in @microields: $motields[$left_captured]\n" if $printer == 1; 
    2013. 

  2013. 						if ( $left_captured !~ /[0-9]+/) {#print $line,"\n", $templine,"\n"; 
    2014. 

  2014. 						}
    2015. 

  2015. 						 $left_trashed = length($microields[$left_captured]) - $left_bp;
    2016. 

  2016. 					}
    2017. 

  2017. 					my $rightmotif = (); my $right_trashed = ();
    2018. 

  2018. 					if ($tempfields[$endcord] != $fields[$endcord]) {
    2019. 

  2019. #						print "$right_captured in @microields: $motields[$right_captured]\n" if $printer == 1; 
    2020. 

  2020. 						$rightmotif = $motields[$right_captured];
    2021. 

  2021. 						$right_trashed = length($microields[$right_captured]) - $right_bp;
    2022. 

  2022. 					} 
    2023. 

  2023. 					
    2024. 

  2024. 					########## P A R A M S #####################@@@@#########@@@@#########@@@@#########@@@@#########@@@@#########@@@@#########@@@@
    2025. 

  2025. 					$stopper = 0;
    2026. 

  2026. 					my $deletioner = 0;
    2027. 

  2027. 					#if($tempfields[$startcord] != $fields[$startcord]){
    2028. 

  2028. #						print "enter left: tempfields,startcord  : $tempfields[$startcord] != $absolutstart && left_captured: $left_captured != 0 \n" if $printer==1;
    2029. 

  2029. 						if ($left_captured != 0){ 
    2030. 

  2030. #							print "at line 370, going: 0 ... $left_captured-1 \n" if $printer == 1;
    2031. 

  2031. 							for my $e (0 ... $left_captured-1){
    2032. 

  2032. 								if( length($motields[$e]) > 2 && length($microields[$e]) > (3* length($motields[$e]) )){
    2033. 

  2033. #									print "motif on left not included too big to be ignored : $microields[$e] \n" if $printer == 1;  
    2034. 

  2034. 									$deletioner++; last;
    2035. 

  2035. 								}
    2036. 

  2036. 								if( length($motields[$e]) == 2 && length($microields[$e]) > (3* length($motields[$e]) )){
    2037. 

  2037. #									print "motif on left not included too big to be ignored : $microields[$e] \n" if $printer == 1;  
    2038. 

  2038. 									$deletioner++; last;
    2039. 

  2039. 								}
    2040. 

  2040. 								if( length($motields[$e]) == 1 && length($microields[$e]) > (4* length($motields[$e]) )){
    2041. 

  2041. #									print "motif on left not included too big to be ignored : $microields[$e] \n" if $printer == 1; 
    2042. 

  2042. 									$deletioner++; last;
    2043. 

  2043. 								}
    2044. 

  2044. 							}				
    2045. 

  2045. 						}
    2046. 

  2046. 					#}
    2047. 

  2047. #					print "after left search, deletioner = $deletioner\n" if $printer == 1;
    2048. 

  2048. 					if ($deletioner >= 1) {  
    2049. 

  2049. #						print "deletioner = $deletioner\n" if $printer == 1;
    2050. 

  2050. 						next; 
    2051. 

  2051. 					} 
    2052. 

  2052. 					
    2053. 

  2053. 					$deletioner = 0;
    2054. 

  2054. 	
    2055. 

  2055. 					#if($tempfields[$endcord] != $fields[$endcord]){				
    2056. 

  2056. #						print "if tempfields endcord: $tempfields[$endcord] != absolutend: $absolutend\n and $right_captured != $#microields\n" if $printer==1;
    2057. 

  2057. 						if ($right_captured != $#microields){ 
    2058. 

  2058. #							print "at line 394, going: $right_captured+1 ... $#microields \n" if $printer == 1;
    2059. 

  2059. 							for my $e ($right_captured+1 ... $#microields){
    2060. 

  2060. 								if( length($motields[$e]) > 2 &&  length($microields[$e]) > (3* length($motields[$e])) ){
    2061. 

  2061. #									print "motif on right not included too big to be ignored : $microields[$e] \n" if $printer == 1; 
    2062. 

  2062. 									$deletioner++; last;
    2063. 

  2063. 								}
    2064. 

  2064. 								if( length($motields[$e]) == 2 && length($microields[$e]) > (3* length($motields[$e]) )){
    2065. 

  2065. #									print "motif on right not included too big to be ignored : $microields[$e] \n" if $printer == 1;
    2066. 

  2066. 									$deletioner++; last;
    2067. 

  2067. 								}
    2068. 

  2068. 								if( length($motields[$e]) == 1 && length($microields[$e]) > (4* length($motields[$e]) )){
    2069. 

  2069. #									print "motif on right not included too big to be ignored : $microields[$e] \n" if $printer == 1;
    2070. 

  2070. 									$deletioner++; last;
    2071. 

  2071. 								}
    2072. 

  2072. 							}				
    2073. 

  2073. 						}
    2074. 

  2074. 					#}
    2075. 

  2075. #					print "deletioner = $deletioner\n" if $printer == 1;
    2076. 

  2076. 					if ($deletioner >= 1) {  
    2077. 

  2077. 						next; 
    2078. 

  2078. 					} 
    2079. 

  2079. 					my $leftMotifs_notCaptured = ();
    2080. 

  2080. 					my $rightMotifs_notCaptured = ();
    2081. 

  2081. 									
    2082. 

  2082. 					if ($tempfields[$startcord] != $fields[$startcord] ){
    2083. 

  2083. 						#print "in left params: (length($leftmotif) == 1 && $tempfields[$startcord] != $fields[$startcord]) ... and .... $left_trashed > (1.5* length($leftmotif]) && ($tempfields[$startcord] != $fields[$startcord])\n";
    2084. 

  2084. 						if (length($leftmotif) == 1 && $left_trashed > 3){
    2085. 

  2085. #							print "invaded left motif is long mononucleotide" if $printer == 1;
    2086. 

  2086. 							 next;
    2087. 

  2087. 	
    2088. 

  2088. 						}
    2089. 

  2089. 						elsif ((length($leftmotif) != 1 && $left_trashed > ( thrashallow($leftmotif)) && ($tempfields[$startcord] != $fields[$startcord]) ) ){
    2090. 

  2090. #							print "invaded left motif too long" if $printer == 1; 						
    2091. 

  2091. 							 next; 
    2092. 

  2092. 						}
    2093. 

  2093. 					}
    2094. 

  2094. 					if ($tempfields[$endcord] != $fields[$endcord] ){
    2095. 

  2095. 						#print "in right params: after $tempfields[$endcord] != $fields[$endcord]  .....   (length($rightmotif)==1 && $tempfields[$endcord] != $fields[$endcord]) ... and ... $right_trashed > (1.5* length($rightmotif))\n";
    2096. 

  2096. 						if (length($rightmotif)==1 && $right_trashed){
    2097. 

  2097. #							print "invaded right motif is long mononucleotide" if $printer == 1; 
    2098. 

  2098. 							 next; 
    2099. 

  2099. 	
    2100. 

  2100. 						}
    2101. 

  2101. 						elsif (length($rightmotif) !=1 && ($right_trashed > ( thrashallow($rightmotif))  && $tempfields[$endcord] != $fields[$endcord])){
    2102. 

  2102. #							print "invaded right motif too long" if $printer == 1;
    2103. 

  2103. 							 next; 
    2104. 

  2104. 	
    2105. 

  2105. 						}
    2106. 

  2106. 					}
    2107. 

  2107. 					push @outputs, $templine;
    2108. 

  2108. 				}
    2109. 

  2109. 				if (scalar(@outputs) == 0){ print COMP $line; next;}
    2110. 

  2110. 	#			print "outputs are:", join("\n",@outputs),"\n";
    2111. 

  2111. 				if (scalar(@outputs) == 1){ 
    2112. 

  2112. 					my @oields = split(/\t/,$outputs[0]);
    2113. 

  2113. 					my $start = $oields[$startcord]+$mields[$startcord]-1;
    2114. 

  2114. 					my $end = $start+($oields[$endcord]-$oields[$startcord]);
    2115. 

  2115. 					$oields[$startcord] = $start; $oields[$endcord] = $end;
    2116. 

  2116. 					print INT join("\t",@oields), "\n"; 
    2117. 

  2117. 				#	print CH $line,;
    2118. 

  2118. 				}
    2119. 

  2119. 				if (scalar(@outputs) > 1){ 
    2120. 

  2120. 					my $motif_min = 10;
    2121. 

  2121. 					my $chosen_one = $outputs[0];
    2122. 

  2122. 					foreach my $micro (@outputs){
    2123. 

  2123. 						my @oields = split(/\t/,$micro);
    2124. 

  2124. 						my $tempmotif = $oields[$motifcord];
    2125. 

  2125. 						$tempmotif =~ s/^\[|\]$//gs;
    2126. 

  2126. 						my @omots = split(/\]\[/, $tempmotif);
    2127. 

  2127. 			#			print "motif_min  = $motif_min, current motif  = $tempmotif\n";
    2128. 

  2128. 						my $start = $oields[$startcord]+$mields[$startcord]-1;
    2129. 

  2129. 						my $end = $start+($oields[$endcord]-$oields[$startcord]);
    2130. 

  2130. 						$oields[$startcord] = $start; $oields[$endcord] = $end;
    2131. 

  2131. 						if(length($omots[0]) < $motif_min) {
    2132. 

  2132. 							$chosen_one = join("\t",@oields); 
    2133. 

  2133. 							$motif_min = length($omots[0]);
    2134. 

  2134. 						}
    2135. 

  2135. 					}
    2136. 

  2136. 					print INT $chosen_one, "\n";
    2137. 

  2137. 				#	print "chosen one is ".$chosen_one, "\n";
    2138. 

  2138. 				#	print CH $line;
    2139. 

  2139. 				
    2140. 

  2140. 				
    2141. 

  2141. 				}
    2142. 

  2142. 				
    2143. 

  2143. 			}
    2144. 

  2144. 			
    2145. 

  2145. 		}	#if (exists $micros{$key}){
    2146. 

  2146. 		else{
    2147. 

  2147. 		}
    2148. 

  2148. 	}
    2149. 

  2149. 	close INT;
    2150. 

  2150. 	close COMP;
    2151. 

  2151. }
    2152. 

  2152. sub left_extender{
    2153. 

  2153. 	#print "left extender\n";
    2154. 

  2154. 	my ($line, $seq, $org) = @_;	
    2155. 

  2155. #	print "in left extender... line passed = $line and sequence is $seq\n";
    2156. 

  2156. 	chomp $line;
    2157. 

  2157. 	my @fields = split(/\t/,$line);
    2158. 

  2158. 	my $rstart = $fields[$startcord];
    2159. 

  2159. 	my $microsat = $fields[$microsatcord];
    2160. 

  2160. 	$microsat =~ s/\[|\]//g;
    2161. 

  2161. 	my $rend = $rstart + length($microsat)-1;
    2162. 

  2162. 	$microsat =~ s/-//g;
    2163. 

  2163. 	my $motif = $fields[$motifcord];
    2164. 

  2164. 	my $firstmotif = ();
    2165. 

  2165. 

  2166. 	if ($motif =~ /^\[/){
    2167. 

  2167. 		$motif =~ s/^\[//g;
    2168. 

  2168. 		$motif =~ /([a-zA-Z]+)\].*/;
    2169. 

  2169. 		$firstmotif = $1;
    2170. 

  2170. 	}
    2171. 

  2171. 	else {$firstmotif = $motif;}
    2172. 

  2172. 	
    2173. 

  2173. 	#print "hacked microsat = $microsat, motif = $motif, firstmotif = $firstmotif\n";
    2174. 

  2174. 	my $leftphase = substr($microsat, 0,length($firstmotif));
    2175. 

  2175. 	my $phaser = $leftphase.$leftphase;
    2176. 

  2176. 	my @phase = split(/\s*/,$leftphase);
    2177. 

  2177. 	my @phases;
    2178. 

  2178. 	my @copy_phases = @phases;
    2179. 

  2179. 	my $crawler=0;
    2180. 

  2180. 	for (0 ... (length($leftphase)-1)){
    2181. 

  2181. 		push(@phases, substr($phaser, $crawler, length($leftphase)));
    2182. 

  2182. 		$crawler++;
    2183. 

  2183. 	}
    2184. 

  2184. 

  2185. 	my $start = $rstart;
    2186. 

  2186. 	my $end = $rend;
    2187. 

  2187. 	
    2188. 

  2188. 	my $leftseq = substr($seq, 0, $start);
    2189. 

  2189. #	print "left phases are @phases , start = $start left sequence = ",substr($leftseq, -10),"\n";	
    2190. 

  2190. 	my @extentions = ();
    2191. 

  2191. 	my @trappeds = ();
    2192. 

  2192. 	my @intervalposs = ();
    2193. 

  2193. 	my @trappedposs = ();
    2194. 

  2194. 	my @trappedphases = ();
    2195. 

  2195. 	my @intervals = ();
    2196. 

  2196. 	my $firstmotif_length = length($firstmotif);
    2197. 

  2197. 	foreach my $phase (@phases){
    2198. 

  2198. #		print "left phase\t",substr($leftseq, -10),"\t$phase\n";
    2199. 

  2199. #		print "search patter = (($phase)+([a-zA-Z|-]{0,$firstmotif_length})) \n";
    2200. 

  2200. 		if ($leftseq =~ /(($phase)+([a-zA-Z|-]{0,$firstmotif_length}))$/i){
    2201. 

  2201. #			print "in left pattern\n";
    2202. 

  2202. 			my $trapped = $1;
    2203. 

  2203. 			my $trappedpos = length($leftseq)-length($trapped);
    2204. 

  2204. 			my $interval = $3;
    2205. 

  2205. 			my $intervalpos = index($trapped, $interval) + 1;
    2206. 

  2206. #			print "left trapped = $trapped, interval = $interval, intervalpos = $intervalpos\n";
    2207. 

  2207. 

  2208. 			my $extention = substr($trapped, 0, length($trapped)-length($interval));
    2209. 

  2209. 			my $leftpeep = substr($seq, 0, ($start-length($trapped)));
    2210. 

  2210. 			my @passed_overhangs;
    2211. 

  2211. 			
    2212. 

  2212. 			for my $i (1 ... length($phase)-1){
    2213. 

  2213. 				my $overhang = substr($phase, -length($phase)+$i);
    2214. 

  2214. #				print "current overhang = $overhang, leftpeep = ",substr($leftpeep,-10)," whole sequence = ",substr($seq, ($end - ($end-$start) - 20), (($end-$start)+20)),"\n";
    2215. 

  2215. 				#TEMPORARY... BETTER METHOD NEEDED
    2216. 

  2216. 				$leftpeep =~ s/-//g;
    2217. 

  2217. 				if ($leftpeep =~ /$overhang$/i){
    2218. 

  2218. 					push(@passed_overhangs,$overhang);
    2219. 

  2219. #					print "l overhang\n";
    2220. 

  2220. 				}
    2221. 

  2221. 			}
    2222. 

  2222. 			
    2223. 

  2223. 			if(scalar(@passed_overhangs)>0){
    2224. 

  2224. 				my $overhang = $passed_overhangs[longest_array_element(@passed_overhangs)];
    2225. 

  2225. 				$extention = $overhang.$extention;
    2226. 

  2226. 				$trapped = $overhang.$trapped;
    2227. 

  2227. 				#print "trapped extended to $trapped \n";
    2228. 

  2228. 				$trappedpos = length($leftseq)-length($trapped);
    2229. 

  2229. 			}
    2230. 

  2230. 			
    2231. 

  2231. 			push(@extentions,$extention);
    2232. 

  2232. #			print "extentions = @extentions \n";
    2233. 

  2233. 

  2234. 			push(@trappeds,$trapped );
    2235. 

  2235. 			push(@intervalposs,length($extention)+1);
    2236. 

  2236. 			push(@trappedposs, $trappedpos);
    2237. 

  2237. #			print "trappeds = @trappeds\n";
    2238. 

  2238. 			push(@trappedphases, substr($extention,0,length($phase)));
    2239. 

  2239. 			push(@intervals, $interval);
    2240. 

  2240. 		}
    2241. 

  2241. 	}
    2242. 

  2242. 	if (scalar(@trappeds == 0)) {return $line;}
    2243. 

  2243. 	
    2244. 

  2244. 	my $nikaal = shortest_array_element(@intervals);
    2245. 

  2245. 	
    2246. 

  2246. 	if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
    2247. 

  2247. 	$fields[$motifcord] = "[".$trappedphases[$nikaal]."]".$fields[$motifcord];
    2248. 

  2248. 	##print "new fields 9 = $fields[9]\n";
    2249. 

  2249. 	$fields[$startcord] = $fields[$startcord]-length($trappeds[$nikaal]);
    2250. 

  2250. 

  2251. 	if($fields[$microsatcord] !~ /^\[/i){
    2252. 

  2252. 		$fields[$microsatcord] = "[".$fields[$microsatcord]."]";
    2253. 

  2253. 	}
    2254. 

  2254. 	
    2255. 

  2255. 	$fields[$microsatcord] = "[".$extentions[$nikaal]."]".$intervals[$nikaal].$fields[$microsatcord];
    2256. 

  2256. 	
    2257. 

  2257. 	if (exists ($fields[$motifcord+1])){
    2258. 

  2258. 		$fields[$motifcord+1] = "indel/deletion,".$fields[$motifcord+1];
    2259. 

  2259. 	}
    2260. 

  2260. 	else{$fields[$motifcord+1] = "indel/deletion";}
    2261. 

  2261. 	##print "new fields 14 = $fields[14]\n";
    2262. 

  2262. 	
    2263. 

  2263. 	if (exists ($fields[$motifcord+2])){		
    2264. 

  2264. 		$fields[$motifcord+2] = $intervals[$nikaal].",".$fields[$motifcord+2];
    2265. 

  2265. 	}
    2266. 

  2266. 	else{$fields[$motifcord+2] =  $intervals[$nikaal];}	
    2267. 

  2267. 	my @seventeen=();	
    2268. 

  2268. 	if (exists ($fields[$motifcord+3])){			
    2269. 

  2269. 		@seventeen = split(/,/,$fields[$motifcord+3]);	
    2270. 

  2270. 	#	#print "scalarseventeen =@seventeen<-\n";
    2271. 

  2271. 		for (0 ... scalar(@seventeen)-1) {$seventeen[$_] = $seventeen[$_]+length($trappeds[$nikaal]);}
    2272. 

  2272. 		$fields[$motifcord+3] = ($intervalposs[$nikaal]).",".join(",",@seventeen);
    2273. 

  2273. 		$fields[$motifcord+4] = $fields[$motifcord+4]+1;
    2274. 

  2274. 	}
    2275. 

  2275. 	
    2276. 

  2276. 	else {$fields[$motifcord+3] = $intervalposs[$nikaal]; $fields[$motifcord+4]=1}
    2277. 

  2277. 	
    2278. 

  2278. 	##print "new fields 16 = $fields[16]\n";
    2279. 

  2279. 	##print "new fields 17 = $fields[17]\n";
    2280. 

  2280. 	
    2281. 

  2281. 	
    2282. 

  2282. 	my $returnline =  join("\t",@fields);
    2283. 

  2283. 	my $pastline  = $returnline;
    2284. 

  2284. 	if ($fields[$microsatcord] =~ /\[/){
    2285. 

  2285. 		$returnline = multiSpecies_compoundClarifyer_merge($returnline);
    2286. 

  2286. 	}
    2287. 

  2287. 	return $returnline;
    2288. 

  2288. }
    2289. 

  2289. sub right_extender{
    2290. 

  2290. 	my ($line, $seq, $org) = @_;	
    2291. 

  2291. 	chomp $line;
    2292. 

  2292. 	my @fields = split(/\t/,$line);
    2293. 

  2293. 	my $rstart = $fields[$startcord];
    2294. 

  2294. 	my $microsat = $fields[$microsatcord];
    2295. 

  2295. 	$microsat =~ s/\[|\]//g;
    2296. 

  2296. 	my $rend = $rstart + length($microsat)-1;
    2297. 

  2297. 	$microsat =~ s/-//g;
    2298. 

  2298. 	my $motif = $fields[$motifcord];
    2299. 

  2299. 	my $temp_lastmotif = ();
    2300. 

  2300. 

  2301. 	if ($motif =~ /\]$/s){
    2302. 

  2302. 		$motif =~ s/\]$//sg;
    2303. 

  2303. 		$motif =~ /.*\[([a-zA-Z]+)/;
    2304. 

  2304. 		$temp_lastmotif = $1;
    2305. 

  2305. 	}
    2306. 

  2306. 	else {$temp_lastmotif = $motif;}
    2307. 

  2307. 	my $lastmotif = substr($microsat,-length($temp_lastmotif));
    2308. 

  2308. 	##print "hacked microsat = $microsat, motif = $motif, lastmotif = $lastmotif\n";
    2309. 

  2309. 	my $rightphase = substr($microsat, -length($lastmotif));
    2310. 

  2310. 	my $phaser = $rightphase.$rightphase;
    2311. 

  2311. 	my @phase = split(/\s*/,$rightphase);
    2312. 

  2312. 	my @phases;
    2313. 

  2313. 	my @copy_phases = @phases;
    2314. 

  2314. 	my $crawler=0;
    2315. 

  2315. 	for (0 ... (length($rightphase)-1)){
    2316. 

  2316. 		push(@phases, substr($phaser, $crawler, length($rightphase)));
    2317. 

  2317. 		$crawler++;
    2318. 

  2318. 	}
    2319. 

  2319. 

  2320. 	my $start = $rstart;
    2321. 

  2321. 	my $end = $rend;
    2322. 

  2322. 	
    2323. 

  2323. 	my $rightseq = substr($seq, $end+1);
    2324. 

  2324. 	my @extentions = ();
    2325. 

  2325. 	my @trappeds = ();
    2326. 

  2326. 	my @intervalposs = ();
    2327. 

  2327. 	my @trappedposs = ();
    2328. 

  2328. 	my @trappedphases = ();
    2329. 

  2329. 	my @intervals = ();
    2330. 

  2330. 	my $lastmotif_length = length($lastmotif);
    2331. 

  2331. 	foreach my $phase (@phases){
    2332. 

  2332. 		if ($rightseq =~ /^(([a-zA-Z|-]{0,$lastmotif_length}?)($phase)+)/i){
    2333. 

  2333. 			my $trapped = $1;
    2334. 

  2334. 			my $trappedpos = $end+1;
    2335. 

  2335. 			my $interval = $2;
    2336. 

  2336. 			my $intervalpos = index($trapped, $interval) + 1;
    2337. 

  2337. 

  2338. 			my $extention = substr($trapped, length($interval));
    2339. 

  2339. 			my $rightpeep = substr($seq, ($end+length($trapped))+1);
    2340. 

  2340. 			my @passed_overhangs = "";
    2341. 

  2341. 			
    2342. 

  2342. 			#TEMPORARY... BETTER METHOD NEEDED
    2343. 

  2343. 			$rightpeep =~ s/-//g;
    2344. 

  2344. 

  2345. 			for my $i (1 ... length($phase)-1){
    2346. 

  2346. 				my $overhang = substr($phase,0, $i);
    2347. 

  2347. #				#print "current extention = $extention, overhang = $overhang, rightpeep = ",substr($rightpeep,0,10),"\n";
    2348. 

  2348. 				if ($rightpeep =~ /^$overhang/i){
    2349. 

  2349. 					push(@passed_overhangs, $overhang);
    2350. 

  2350. #					#print "r overhang\n";
    2351. 

  2351. 				}
    2352. 

  2352. 			}
    2353. 

  2353. 			if (scalar(@passed_overhangs) > 0){			
    2354. 

  2354. 				my $overhang = @passed_overhangs[longest_array_element(@passed_overhangs)];
    2355. 

  2355. 				$extention = $extention.$overhang;
    2356. 

  2356. 				$trapped = $trapped.$overhang;
    2357. 

  2357. #				#print "trapped extended to $trapped \n";
    2358. 

  2358. 			}
    2359. 

  2359. 		
    2360. 

  2360. 			push(@extentions,$extention);
    2361. 

  2361. 			##print "extentions = @extentions \n";
    2362. 

  2362. 

  2363. 			push(@trappeds,$trapped );
    2364. 

  2364. 			push(@intervalposs,$intervalpos);
    2365. 

  2365. 			push(@trappedposs, $trappedpos);
    2366. 

  2366. #			#print "trappeds = @trappeds\n";
    2367. 

  2367. 			push(@trappedphases, substr($extention,0,length($phase)));
    2368. 

  2368. 			push(@intervals, $interval);
    2369. 

  2369. 		}
    2370. 

  2370. 	}
    2371. 

  2371. 	if (scalar(@trappeds == 0)) {return $line;}
    2372. 

  2372. 	
    2373. 

  2373. #	my $nikaal = longest_array_element(@trappeds);
    2374. 

  2374. 	my $nikaal = shortest_array_element(@intervals);
    2375. 

  2375. 	
    2376. 

  2376. #	#print "longest element found = $nikaal \n";
    2377. 

  2377. 	
    2378. 

  2378. 	if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
    2379. 

  2379. 	$fields[$motifcord] = $fields[$motifcord]."[".$trappedphases[$nikaal]."]";
    2380. 

  2380. 	##print "new fields 9 = $fields[9]";
    2381. 

  2381. 	$fields[$endcord] = $fields[$endcord] + length($trappeds[$nikaal]);
    2382. 

  2382. 

  2383. 	##print "new fields 11 = $fields[11]\n";
    2384. 

  2384. 

  2385. 	if($fields[$microsatcord] !~ /^\[/i){
    2386. 

  2386. 		$fields[$microsatcord] = "[".$fields[$microsatcord]."]";
    2387. 

  2387. 	}
    2388. 

  2388. 	
    2389. 

  2389. 	$fields[$microsatcord] = $fields[$microsatcord].$intervals[$nikaal]."[".$extentions[$nikaal]."]";
    2390. 

  2390. 	##print "new fields 12 = $fields[12]\n";
    2391. 

  2391. 	
    2392. 

  2392. 	##print "scalar of fields = ",scalar(@fields),"\n";
    2393. 

  2393. 	if (exists ($fields[$motifcord+1])){
    2394. 

  2394. #		print " print fields = @fields.. scalar=", scalar(@fields),".. motifcord+1 = $motifcord + 1 \n " if !exists $fields[$motifcord+1];
    2395. 

  2395. #		<STDIN> if !exists $fields[$motifcord+1];
    2396. 

  2396. 		$fields[$motifcord+1] = $fields[$motifcord+1].",indel/deletion";
    2397. 

  2397. 	}
    2398. 

  2398. 	else{$fields[$motifcord+1] = "indel/deletion";}
    2399. 

  2399. 	##print "new fields 14 = $fields[14]\n";
    2400. 

  2400. 	
    2401. 

  2401. 	if (exists ($fields[$motifcord+2])){
    2402. 

  2402. 		$fields[$motifcord+2] = $fields[$motifcord+2].",".$intervals[$nikaal];
    2403. 

  2403. 	}
    2404. 

  2404. 	else{$fields[$motifcord+2] =  $intervals[$nikaal];}	
    2405. 

  2405. 	##print "new fields 15 = $fields[15]\n";
    2406. 

  2406. 

  2407. 	my @seventeen=();
    2408. 

  2408. 	if (exists ($fields[$motifcord+3])){
    2409. 

  2409. 		##print "at 608 we are doing this:length($microsat)+$intervalposs[$nikaal]\n";
    2410. 

  2410. #		print " print fields = @fields\n " if !exists $fields[$motifcord+3];
    2411. 

  2411. 		<STDIN> if !exists $fields[$motifcord+3];
    2412. 

  2412. 		my $currpos = length($microsat)+$intervalposs[$nikaal];
    2413. 

  2413. 		$fields[$motifcord+3] = $fields[$motifcord+3].",".$currpos;
    2414. 

  2414. 		$fields[$motifcord+4] = $fields[$motifcord+4]+1;
    2415. 

  2415. 

  2416. 	}
    2417. 

  2417. 	
    2418. 

  2418. 	else {$fields[$motifcord+3] = length($microsat)+$intervalposs[$nikaal]; $fields[$motifcord+4]=1}
    2419. 

  2419. 	
    2420. 

  2420. 	##print "new fields 16 = $fields[16]\n";
    2421. 

  2421. 	
    2422. 

  2422. 	##print "new fields 17 = $fields[17]\n";
    2423. 

  2423. 	my $returnline = join("\t",@fields);
    2424. 

  2424. 	my $pastline  = $returnline;
    2425. 

  2425. 	if ($fields[$microsatcord] =~ /\[/){
    2426. 

  2426. 		$returnline = multiSpecies_compoundClarifyer_merge($returnline);
    2427. 

  2427. 	}
    2428. 

  2428. 	#print "finally right-extended line = ",$returnline,"\n";
    2429. 

  2429. 	return $returnline;
    2430. 

  2430. }
    2431. 

  2431. sub longest_array_element{
    2432. 

  2432. 	my $counter = 0;
    2433. 

  2433. 	my($max) = shift(@_);
    2434. 

  2434. 	my $maxcounter = 0;
    2435. 

  2435.     foreach my $temp (@_) {
    2436. 

  2436.     	$counter++;
    2437. 

  2437.     	#print "finding largest array: $maxcounter \n" if $prinkter == 1;
    2438. 

  2438.     	if(length($temp) > length($max)){
    2439. 

  2439.         	$max = $temp;
    2440. 

  2440.         	$maxcounter = $counter;
    2441. 

  2441.         }
    2442. 

  2442.     }
    2443. 

  2443.     return($maxcounter);
    2444. 

  2444. }
    2445. 

  2445. sub shortest_array_element{
    2446. 

  2446. 	my $counter = 0;
    2447. 

  2447. 	my($min) = shift(@_);
    2448. 

  2448. 	my $mincounter = 0;
    2449. 

  2449.     foreach my $temp (@_) {
    2450. 

  2450.     	$counter++;
    2451. 

  2451.     	#print "finding largest array: $mincounter \n" if $prinkter == 1;
    2452. 

  2452.     	if(length($temp) < length($min)){
    2453. 

  2453.         	$min = $temp;
    2454. 

  2454.         	$mincounter = $counter;
    2455. 

  2455.         }
    2456. 

  2456.     }
    2457. 

  2457.     return($mincounter);
    2458. 

  2458. }
    2459. 

  2459. 

  2460. 

  2461. sub left_extention_permission_giver{
    2462. 

  2462. 	my @fields = split(/\t/,$_[0]);
    2463. 

  2463. 	my $microsat = $fields[$microsatcord];
    2464. 

  2464. 	$microsat =~ s/(^\[)|-//g;
    2465. 

  2465. 	my $motif = $fields[$motifcord];
    2466. 

  2466. 	my $firstmotif = ();
    2467. 

  2467. 	my $firststretch = ();
    2468. 

  2468. 	my @stretches=();
    2469. 

  2469. 	if ($motif =~ /^\[/){
    2470. 

  2470. 		$motif =~ s/^\[//g;
    2471. 

  2471. 		$motif =~ /([a-zA-Z]+)\].*/;
    2472. 

  2472. 		$firstmotif = $1;
    2473. 

  2473. 		@stretches = split(/\]/,$microsat);
    2474. 

  2474. 		$firststretch = $stretches[0];
    2475. 

  2475. 		##print "firststretch = $firststretch\n";
    2476. 

  2476. 	}
    2477. 

  2477. 	else {$firstmotif = $motif;$firststretch = $microsat;}
    2478. 

  2478. 	
    2479. 

  2479. 	if (length($firststretch) < $thresholds[length($firstmotif)]){
    2480. 

  2480. 		return "no";
    2481. 

  2481. 	}
    2482. 

  2482. 	else {return "yes";}
    2483. 

  2483. 

  2484. }
    2485. 

  2485. sub right_extention_permission_giver{
    2486. 

  2486. 	my @fields = split(/\t/,$_[0]);
    2487. 

  2487. 	my $microsat = $fields[$microsatcord];
    2488. 

  2488. 	$microsat =~ s/-|(\]$)//sg;
    2489. 

  2489. 	my $motif = $fields[$motifcord];
    2490. 

  2490. 	my $temp_lastmotif = ();
    2491. 

  2491. 	my $laststretch = ();
    2492. 

  2492. 	my @stretches=();
    2493. 

  2493. 

  2494. 

  2495. 	if ($motif =~ /\]/){
    2496. 

  2496. 		$motif =~ s/\]$//gs;
    2497. 

  2497. 		$motif =~ /.*\[([a-zA-Z]+)$/;
    2498. 

  2498. 		$temp_lastmotif = $1;
    2499. 

  2499. 		@stretches = split(/\[/,$microsat);
    2500. 

  2500. 		$laststretch = pop(@stretches);
    2501. 

  2501. 		##print "last stretch = $laststretch\n";
    2502. 

  2502. 	}
    2503. 

  2503. 	else {$temp_lastmotif = $motif; $laststretch = $microsat;}
    2504. 

  2504. 

  2505. 	if (length($laststretch) < $thresholds[length($temp_lastmotif)]){
    2506. 

  2506. 		return "no";
    2507. 

  2507. 	}
    2508. 

  2508. 	else { return "yes";}
    2509. 

  2509. 

  2510. 

  2511. }
    2512. 

  2512. sub multiSpecies_compoundClarifyer_merge{
    2513. 

  2513. 	my $line = $_[0];
    2514. 

  2514. 	#print "sent for mering: $line \n";
    2515. 

  2515. 	my @mields = split(/\t/,$line);
    2516. 

  2516. 	my @fields = @mields;
    2517. 

  2517. 	my $microsat = $fields[$microsatcord];
    2518. 

  2518. 	my $motifline = $fields[$motifcord];
    2519. 

  2519. 	my $microsatcopy = $microsat;
    2520. 

  2520. 	$microsatcopy =~ s/^\[|\]$//sg;
    2521. 

  2521. 	my @microields = split(/\][a-zA-Z|-]*\[/,$microsatcopy);
    2522. 

  2522. 	my @inields = split(/\[[a-zA-Z|-]*\]/,$microsat);
    2523. 

  2523. 	shift @inields;
    2524. 

  2524. 	#print "inields =@inields<\n";
    2525. 

  2525. 	$motifline =~ s/^\[|\]$//sg;
    2526. 

  2526. 	my @motields = split(/\]\[/,$motifline);
    2527. 

  2527. 	my @firstmotifs = ();
    2528. 

  2528. 	my @lastmotifs = ();
    2529. 

  2529. 	for my $i  (0 ... $#microields){
    2530. 

  2530. 		$firstmotifs[$i] =  substr($microields[$i],0,length($motields[$i]));
    2531. 

  2531. 		$lastmotifs[$i] = substr($microields[$i],-length($motields[$i]));
    2532. 

  2532. 	}
    2533. 

  2533. 	#print "firstmotif = @firstmotifs... lastmotif = @lastmotifs\n";
    2534. 

  2534. 	my @mergelist = ();
    2535. 

  2535. 	my @inter_poses = split(/,/,$fields[$interr_poscord]);
    2536. 

  2536. 	my $no_of_interruptions = $fields[$no_of_interruptionscord];
    2537. 

  2537. 	my @interruptions = split(/,/,$fields[$interrcord]);
    2538. 

  2538. 	my @interrtypes = split(/,/,$fields[$interrtypecord]);
    2539. 

  2539. 	my $stopper = 0;
    2540. 

  2540. 	for my $i (0 ... $#motields-1){
    2541. 

  2541. 		#print "studying connection of $motields[$i] and $motields[$i+1], i = $i in $microsat\n";
    2542. 

  2542. 		if (($lastmotifs[$i] eq $firstmotifs[$i+1]) && !exists $inields[$i]){
    2543. 

  2543. 			$stopper = 1;
    2544. 

  2544. 			push(@mergelist, ($i)."_".($i+1));
    2545. 

  2545. 		}
    2546. 

  2546. 	}
    2547. 

  2547. 	
    2548. 

  2548. 	return $line if scalar(@mergelist) == 0;
    2549. 

  2549. 	
    2550. 

  2550. 	foreach my $merging (@mergelist){
    2551. 

  2551. 		my @sets = split(/_/, $merging);
    2552. 

  2552. 		my @tempmicro = ();
    2553. 

  2553. 		my @tempmot = ();
    2554. 

  2554. 		for my $i (0 ... $sets[0]-1){
    2555. 

  2555. 			push(@tempmicro, "[".$microields[$i]."]");
    2556. 

  2556. 			push(@tempmicro, $inields[$i]);
    2557. 

  2557. 			push(@tempmot, "[".$motields[$i]."]");
    2558. 

  2558. 			#print "adding pre-motifs number $i\n";
    2559. 

  2559. 		}
    2560. 

  2560. 		my $pusher = "[".$microields[$sets[0]].$microields[$sets[1]]."]";
    2561. 

  2561. 		push (@tempmicro, $pusher);
    2562. 

  2562. 		push(@tempmot, "[".$motields[$sets[0]]."]");
    2563. 

  2563. 		my $outcoming = -2;
    2564. 

  2564. 		for my $i ($sets[1]+1 ... $#microields-1){
    2565. 

  2565. 			push(@tempmicro, "[".$microields[$i]."]");
    2566. 

  2566. 			push(@tempmicro, $inields[$i]);	
    2567. 

  2567. 			push(@tempmot, "[".$motields[$i]."]");
    2568. 

  2568. 			#print "adding post-motifs number $i\n";
    2569. 

  2569. 			$outcoming  = $i;
    2570. 

  2570. 		}
    2571. 

  2571. 		if ($outcoming != -2){
    2572. 

  2572. 			#print "outcoming = $outcoming \n";
    2573. 

  2573. 			push(@tempmicro, "[".$microields[$outcoming+1 ]."]");
    2574. 

  2574. 			push(@tempmot,"[". $motields[$outcoming+1]."]");
    2575. 

  2575. 		}
    2576. 

  2576. 		$fields[$microsatcord] = join("",@tempmicro);
    2577. 

  2577. 		$fields[$motifcord] = join("",@tempmot);
    2578. 

  2578. 		
    2579. 

  2579. 		splice(@interrtypes, $sets[0], 1);
    2580. 

  2580. 		$fields[$interrtypecord] = join(",",@interrtypes);
    2581. 

  2581. 		splice(@interruptions, $sets[0], 1);
    2582. 

  2582. 		$fields[$interrcord] = join(",",@interruptions);
    2583. 

  2583. 		splice(@inter_poses, $sets[0], 1);
    2584. 

  2584. 		$fields[$interr_poscord] = join(",",@inter_poses);
    2585. 

  2585. 		$no_of_interruptions = $no_of_interruptions - 1;
    2586. 

  2586. 	}	
    2587. 

  2587. 

  2588. 	if ($no_of_interruptions == 0){
    2589. 

  2589. 		$fields[$microsatcord] =~ s/^\[|\]$//sg;
    2590. 

  2590. 		$fields[$motifcord] =~ s/^\[|\]$//sg;
    2591. 

  2591. 		$line = join("\t", @fields[0 ... $motifcord]);		
    2592. 

  2592. 	}
    2593. 

  2593. 	else{
    2594. 

  2594. 		$line = join("\t", @fields);
    2595. 

  2595. 	}
    2596. 

  2596. 	return $line;
    2597. 

  2597. }
    2598. 

  2598. 

  2599. sub thrashallow{
    2600. 

  2600. 	my $motif = $_[0];
    2601. 

  2601. 	return 4 if length($motif) == 2;
    2602. 

  2602. 	return 6 if length($motif) == 3;
    2603. 

  2603. 	return 8 if length($motif) == 4;
    2604. 

  2604. 	
    2605. 

  2605. }
    2606. 

  2606. 

  2607. #xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx  multiSpecies_compoundClarifyer xxxxxxxxxxxxxx  multiSpecies_compoundClarifyer xxxxxxxxxxxxxx 
    2608. 

  2608. 

  2609. 

  2610. #xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx  multispecies_filtering_compound_microsats xxxxxxxxxxxxxx  multispecies_filtering_compound_microsats xxxxxxxxxxxxxx 
    2611. 

  2611. sub multispecies_filtering_compound_microsats{
    2612. 

  2612. 	my $unfiltered = $_[0];
    2613. 

  2613. 	my $filtered = $_[1];
    2614. 

  2614. 	my $residue = $_[2];
    2615. 

  2615. 	my $no_of_species = $_[5];
    2616. 

  2616. 	open(UNF,"<$unfiltered") or die "Cannot open file $unfiltered: $!";
    2617. 

  2617. 	open(FIL,">$filtered") or die "Cannot open file $filtered: $!";
    2618. 

  2618. 	open(RES,">$residue") or die "Cannot open file $residue: $!";
    2619. 

  2619. 	
    2620. 

  2620. 	$infocord = 2 + (4*$no_of_species) - 1;
    2621. 

  2621. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    2622. 

  2622. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    2623. 

  2623. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    2624. 

  2624. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    2625. 

  2625. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    2626. 

  2626. 	
    2627. 

  2627. 	my @sub_thresholds = ("0");
    2628. 

  2628. 	push(@sub_thresholds, split(/_/,$_[3]));
    2629. 

  2629. 	my @thresholds = ("0");
    2630. 

  2630. 	push(@thresholds, split(/_/,$_[4]));
    2631. 

  2631. 	
    2632. 

  2632. 	while (my $line = <UNF>) {
    2633. 

  2633. 		if ($line !~ /compound/){
    2634. 

  2634. 			print FIL $line,"\n"; next;
    2635. 

  2635. 		}
    2636. 

  2636. 		chomp $line;
    2637. 

  2637. 		my @fields = split(/\t/,$line);
    2638. 

  2638. 		my $motifline = $fields[$motifcord];
    2639. 

  2639. 		$motifline =~ s/^\[|\]$//g;
    2640. 

  2640. 		my @motifs = split(/\]\[/,$motifline);
    2641. 

  2641. 		my $microsat = $fields[$microsatcord];
    2642. 

  2642. 		$microsat =~ s/^\[|\]$|-//g;
    2643. 

  2643. 		my @microsats = split(/\][a-zA-Z|-]*\[/,$microsat);		
    2644. 

  2644. 		
    2645. 

  2645. 		my $stopper = 0;
    2646. 

  2646. 		for my $i (0 ... $#motifs){
    2647. 

  2647. 			my @common = ();
    2648. 

  2648. 			my $probe = $motifs[$i].$motifs[$i];
    2649. 

  2649. 			my $motif_size = length($motifs[$i]);
    2650. 

  2650. 		
    2651. 

  2651. 			for my $j (0 ... $#motifs){	
    2652. 

  2652. 				next if length($motifs[$i]) != length($motifs[$j]);
    2653. 

  2653. 				push(@common, length($microsats[$j])) if $probe =~ /$motifs[$j]/i;
    2654. 

  2654. 			}
    2655. 

  2655. 			
    2656. 

  2656. 			if (largest_microsat(@common) < $sub_thresholds[$motif_size]) {$stopper = 1; last;}
    2657. 

  2657. 			else {next;}
    2658. 

  2658. 		}
    2659. 

  2659. 		
    2660. 

  2660. 		if ($stopper  == 1){
    2661. 

  2661. 			print RES $line,"\n";
    2662. 

  2662. 		}
    2663. 

  2663. 		else { print FIL $line,"\n"; }
    2664. 

  2664. 	}
    2665. 

  2665. 	close FIL;
    2666. 

  2666. 	close RES;
    2667. 

  2667. }
    2668. 

  2668. 

  2669. #xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx  multispecies_filtering_compound_microsats xxxxxxxxxxxxxx  multispecies_filtering_compound_microsats xxxxxxxxxxxxxx 
    2670. 

  2670. 

  2671. 

  2672. #xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx  chromosome_unrand_breaker xxxxxxxxxxxxxx  chromosome_unrand_breaker xxxxxxxxxxxxxx 
    2673. 

  2673. 

  2674. sub chromosome_unrand_breaker{
    2675. 

  2675. #	print "IN chromosome_unrand_breaker: @_\n ";
    2676. 

  2676. 	my $input1 = $_[0];  ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
    2677. 

  2677. 	my $dir = $_[1]; ###### directory where subsets are put
    2678. 

  2678. 	my $output2 = $_[2]; ###### list of subset files
    2679. 

  2679. 	my $increment = $_[3];
    2680. 

  2680. 	my $info = $_[4];
    2681. 

  2681. 	my $chr = $_[5];
    2682. 

  2682. 	open(SEQ,"<$input1") or die "Cannot open file $input1 $!";
    2683. 

  2683. 	
    2684. 

  2684. 	open(OUT,">$output2") or die "Cannot open file $output2 $!";
    2685. 

  2685. 	
    2686. 

  2686. 	#---------------------------------------------------------------------------------------------------
    2687. 

  2687. 	# NOW READING THE SEQUENCE FILE
    2688. 

  2688. 	
    2689. 

  2689. 	my $seed = 0;
    2690. 

  2690. 	my $subset = $dir.$info."_".$chr."_".$seed."_".($seed+$increment);
    2691. 

  2691. 	print OUT $subset,"\n";
    2692. 

  2692. 	open(SUB,">$subset");
    2693. 

  2693. 	
    2694. 

  2694. 	while(my $sine = <SEQ>){
    2695. 

  2695. 		$seed++;
    2696. 

  2696. 		print SUB $sine;
    2697. 

  2697. 		
    2698. 

  2698. 		if ($seed%$increment == 0 ){
    2699. 

  2699. 			close SUB;
    2700. 

  2700. 			$subset = $dir.$info."_".$chr."_".$seed."_".($seed+$increment);
    2701. 

  2701. 			open(SUB,">$subset");
    2702. 

  2702. 			print SUB $sine;
    2703. 

  2703. 			print OUT $subset,"\n";
    2704. 

  2704. 	#		print $subset,"\n";
    2705. 

  2705. 		}
    2706. 

  2706. 	}
    2707. 

  2707. 	close OUT;
    2708. 

  2708. 	close SUB;
    2709. 

  2709. }
    2710. 

  2710. #xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx  chromosome_unrand_breaker xxxxxxxxxxxxxx  chromosome_unrand_breaker xxxxxxxxxxxxxx 
    2711. 

  2711. 

  2712. 

  2713. #xxxxxxxxxxxxxx multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx  multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx  multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx 
    2714. 

  2714. sub multiSpecies_interruptedMicrosatHunter{
    2715. 

  2715. #	print "IN multiSpecies_interruptedMicrosatHunter: @_\n";
    2716. 

  2716. 	my $input1 = $_[0];  ###### the *_sput_op4_ii file
    2717. 

  2717. 	my $input2 = $_[1];  ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
    2718. 

  2718. 	my $output1 = $_[2]; ###### interrupted microsatellite file, in new .interrupted format
    2719. 

  2719. 	my $output2 = $_[3]; ###### uninterrupted microsatellite file
    2720. 

  2720. 	my $org = $_[4];
    2721. 

  2721. 	my $no_of_species = $_[5];
    2722. 

  2722. 	
    2723. 

  2723. 	my @thresholds = "0";
    2724. 

  2724. 	push(@thresholds, split(/_/,$_[6]));
    2725. 

  2725. 	
    2726. 

  2726. #	print "thresholds = @thresholds \n";
    2727. 

  2727. 	$infocord = 2 + (4*$no_of_species) - 1;
    2728. 

  2728. 	$typecord = 2 + (4*$no_of_species) + 1 - 1;
    2729. 

  2729. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    2730. 

  2730. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    2731. 

  2731. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    2732. 

  2732. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    2733. 

  2733. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    2734. 

  2734. 	$sequencepos = 2 + (5*$no_of_species) + 1 -1 ; 
    2735. 

  2735. 	
    2736. 

  2736. 	$interr_poscord = $motifcord + 3;
    2737. 

  2737. 	$no_of_interruptionscord = $motifcord + 4;
    2738. 

  2738. 	$interrcord = $motifcord + 2;
    2739. 

  2739. 	$interrtypecord = $motifcord + 1;
    2740. 

  2740. 	
    2741. 

  2741. 	
    2742. 

  2742. 	$prinkter = 0;
    2743. 

  2743. #	print "prionkytet = $prinkter\n";
    2744. 

  2744. 	
    2745. 

  2745. 	open(IN,"<$input1") or die "Cannot open file $input1 $!";
    2746. 

  2746. 	open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
    2747. 

  2747. 	
    2748. 

  2748. 	open(INT,">$output1") or die "Cannot open file $output2 $!";
    2749. 

  2749. 	open(UNINT,">$output2") or die "Cannot open file $output2 $!";
    2750. 

  2750. 	
    2751. 

  2751. #	print "opened files !!\n";
    2752. 

  2752. 	my $linecounter = 0;
    2753. 

  2753. 	my $microcounter = 0;
    2754. 

  2754. 	
    2755. 

  2755. 	my %micros = ();
    2756. 

  2756. 	while (my $line = <IN>){
    2757. 

  2757. 	#	print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
    2758. 

  2758. 		$linecounter++;
    2759. 

  2759. 		if ($line =~ /^>[A-Za-z0-9]+\s+([0-9]+)\s+([0-9a-zA-Z]+)\s+([0-9a-zA-Z_]+)\s([0-9]+)\s+([0-9]+)\s/ ) {
    2760. 

  2760. 			my $key = join("\t",$1, $2, $3, $4, $5);
    2761. 

  2761. 		#	print $key, "#-#-#-#-#-#-#-#\n" if $prinkter == 1;
    2762. 

  2762. 			push (@{$micros{$key}},$line);	
    2763. 

  2763. 			$microcounter++;
    2764. 

  2764. 		}
    2765. 

  2765. 		else {#print $line if $prinkter == 1;
    2766. 

  2766. 		}
    2767. 

  2767. 	}
    2768. 

  2768. #	print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
    2769. 

  2769. 	close IN;
    2770. 

  2770. 	my @deletedlines = ();
    2771. 

  2771. #	print "done hash \n";
    2772. 

  2772. 	$linecounter = 0;
    2773. 

  2773. 	#---------------------------------------------------------------------------------------------------
    2774. 

  2774. 	# NOW READING THE SEQUENCE FILE
    2775. 

  2775. 	while(my $sine = <SEQ>){
    2776. 

  2776. 		#print $linecounter,"\n" if $linecounter % 1000 == 0;
    2777. 

  2777. 		my %microstart=();
    2778. 

  2778. 		my %microend=();
    2779. 

  2779. 		my @sields = split(/\t/,$sine);
    2780. 

  2780. 		my $key = ();
    2781. 

  2781. 		if ($sine =~ /^>[A-Za-z0-9]+\s+([0-9]+)\s+([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    2782. 

  2782. 			$key = join("\t",$1, $2, $3, $4, $5);
    2783. 

  2783. 	#		print $key, "<-<-<-<-<-<-<-<\n";		
    2784. 

  2784. 		}
    2785. 

  2785. 	
    2786. 

  2786. 	#	$prinkter = 1 if $sine =~ /^>H\t499\t/;
    2787. 

  2787. 	
    2788. 

  2788. 		if (exists $micros{$key}){
    2789. 

  2789. 			my @microstring = @{$micros{$key}};
    2790. 

  2790. 			delete $micros{$key};
    2791. 

  2791. 			my @filteredmicrostring;
    2792. 

  2792. #			print "sequence = $sields[$sequencepos]" if $prinkter == 1;
    2793. 

  2793. 			foreach my $line (@microstring){
    2794. 

  2794. 				$linecounter++;
    2795. 

  2795. 				my $copy_line = $line;
    2796. 

  2796. 				my @fields = split(/\t/,$line);
    2797. 

  2797. 				my $start = $fields[$startcord];
    2798. 

  2798. 				my $end = $fields[$endcord];
    2799. 

  2799. 				
    2800. 

  2800. #				print $line if $prinkter == 1;
    2801. 

  2801. 				#LOOKING FOR LEFTWARD EXTENTION OF MICROSATELLITE 
    2802. 

  2802. 				my $newline;
    2803. 

  2803. 				while(1){
    2804. 

  2804. 				#	print "\n before left sequence = $sields[$sequencepos]\n" if $prinkter == 1;
    2805. 

  2805. 					if (multiSpecies_interruptedMicrosatHunter_left_extention_permission_giver($line) eq "no") {last;}
    2806. 

  2806. 	
    2807. 

  2807. 					$newline = multiSpecies_interruptedMicrosatHunter_left_extender($line, $sields[$sequencepos],$org);
    2808. 

  2808. 					if ($newline eq $line){$line = $newline; last;}
    2809. 

  2809. 					else {$line = $newline;}
    2810. 

  2810. 					
    2811. 

  2811. 					if (multiSpecies_interruptedMicrosatHunter_left_extention_permission_giver($line) eq "no") {last;}
    2812. 

  2812. #					print "returned line from left extender= $line \n" if $prinkter == 1;
    2813. 

  2813. 				}
    2814. 

  2814. 				while(1){
    2815. 

  2815. 				#	print "sequence = $sields[$sequencepos]\n" if $prinkter == 1;
    2816. 

  2816. 					if (multiSpecies_interruptedMicrosatHunter_right_extention_permission_giver($line) eq "no") {last;}
    2817. 

  2817. 					
    2818. 

  2818. 					$newline = multiSpecies_interruptedMicrosatHunter_right_extender($line, $sields[$sequencepos],$org);
    2819. 

  2819. 					if ($newline eq $line){$line = $newline; last;}
    2820. 

  2820. 					else {$line = $newline;}
    2821. 

  2821. 					
    2822. 

  2822. 					if (multiSpecies_interruptedMicrosatHunter_right_extention_permission_giver($line) eq "no") {last;}
    2823. 

  2823. #					print "returned line from right extender= $line \n" if $prinkter == 1;
    2824. 

  2824. 				}
    2825. 

  2825. #				print "\n>>>>>>>>>>>>>>>>\n In the end, the line is: \n$line\n<<<<<<<<<<<<<<<<\n" if $prinkter == 1;
    2826. 

  2826. 	
    2827. 

  2827. 				my @tempfields = split(/\t/,$line);
    2828. 

  2828. 				if ($tempfields[$microsatcord] =~ /\[/){
    2829. 

  2829. 					print INT $line,"\n";
    2830. 

  2830. 				}
    2831. 

  2831. 				else{
    2832. 

  2832. 					print UNINT $line,"\n";
    2833. 

  2833. 				}
    2834. 

  2834. 				
    2835. 

  2835. 				if ($line =~ /NULL/){ next; }
    2836. 

  2836. 				push(@filteredmicrostring, $line);
    2837. 

  2837. 				push (@{$microstart{$start}},$line);
    2838. 

  2838. 				push (@{$microend{$end}},$line);
    2839. 

  2839. 			}
    2840. 

  2840. 			
    2841. 

  2841. 			my $firstflag = 'down';
    2842. 

  2842. 	
    2843. 

  2843. 		}	#if (exists $micros{$key}){
    2844. 

  2844. 	}
    2845. 

  2845. 	close INT;
    2846. 

  2846. 	close UNINT;
    2847. 

  2847. #	print "final number of lines = $linecounter\n";
    2848. 

  2848. }
    2849. 

  2849. 

  2850. sub multiSpecies_interruptedMicrosatHunter_left_extender{
    2851. 

  2851. 	my ($line, $seq, $org) = @_;	
    2852. 

  2852. #	print "left extender, like passed = $line\n" if $prinkter == 1;
    2853. 

  2853. #	print "in left extender... line passed = $line and sequence is $seq\n" if $prinkter == 1;
    2854. 

  2854. 	chomp $line;
    2855. 

  2855. 	my @fields = split(/\t/,$line);
    2856. 

  2856. 	my $rstart = $fields[$startcord];
    2857. 

  2857. 	my $microsat = $fields[$microsatcord];
    2858. 

  2858. 	$microsat =~ s/\[|\]//g;
    2859. 

  2859. 	my $rend = $rstart + length($microsat)-1;
    2860. 

  2860. 	$microsat =~ s/-//g;
    2861. 

  2861. 	my $motif = $fields[$motifcord];
    2862. 

  2862. 	my $firstmotif = ();
    2863. 

  2863. 

  2864. 	if ($motif =~ /^\[/){
    2865. 

  2865. 		$motif =~ s/^\[//g;
    2866. 

  2866. 		$motif =~ /([a-zA-Z]+)\].*/;
    2867. 

  2867. 		$firstmotif = $1;
    2868. 

  2868. 	}
    2869. 

  2869. 	else {$firstmotif = $motif;}
    2870. 

  2870. 	
    2871. 

  2871. #	print "hacked microsat = $microsat, motif = $motif, firstmotif = $firstmotif\n" if $prinkter == 1;
    2872. 

  2872. 	my $leftphase = substr($microsat, 0,length($firstmotif));
    2873. 

  2873. 	my $phaser = $leftphase.$leftphase;
    2874. 

  2874. 	my @phase = split(/\s*/,$leftphase);
    2875. 

  2875. 	my @phases;
    2876. 

  2876. 	my @copy_phases = @phases;
    2877. 

  2877. 	my $crawler=0;
    2878. 

  2878. 	for (0 ... (length($leftphase)-1)){
    2879. 

  2879. 		push(@phases, substr($phaser, $crawler, length($leftphase)));
    2880. 

  2880. 		$crawler++;
    2881. 

  2881. 	}
    2882. 

  2882. 

  2883. 	my $start = $rstart;
    2884. 

  2884. 	my $end = $rend;
    2885. 

  2885. 	
    2886. 

  2886. 	my $leftseq = substr($seq, 0, $start);
    2887. 

  2887. #	print "left phases are @phases , start = $start left sequence = ",substr($leftseq, -10),"\n" if $prinkter == 1;	
    2888. 

  2888. 	my @extentions = ();
    2889. 

  2889. 	my @trappeds = ();
    2890. 

  2890. 	my @intervalposs = ();
    2891. 

  2891. 	my @trappedposs = ();
    2892. 

  2892. 	my @trappedphases = ();
    2893. 

  2893. 	my @intervals = ();
    2894. 

  2894. 	my $firstmotif_length = length($firstmotif);
    2895. 

  2895. 	foreach my $phase (@phases){
    2896. 

  2896. #		print "left phase\t",substr($leftseq, -10),"\t$phase\n" if $prinkter == 1;
    2897. 

  2897. #		print "search patter = (($phase)+([a-zA-Z|-]{0,$firstmotif_length})) \n" if $prinkter == 1;
    2898. 

  2898. 		if ($leftseq =~ /(($phase)+([a-zA-Z|-]{0,$firstmotif_length}))$/i){
    2899. 

  2899. #			print "in left pattern\n" if $prinkter == 1;
    2900. 

  2900. 			my $trapped = $1;
    2901. 

  2901. 			my $trappedpos = length($leftseq)-length($trapped);
    2902. 

  2902. 			my $interval = $3;
    2903. 

  2903. 			my $intervalpos = index($trapped, $interval) + 1;
    2904. 

  2904. #			print "left trapped = $trapped, interval = $interval, intervalpos = $intervalpos\n" if $prinkter == 1;
    2905. 

  2905. 

  2906. 			my $extention = substr($trapped, 0, length($trapped)-length($interval));
    2907. 

  2907. 			my $leftpeep = substr($seq, 0, ($start-length($trapped)));
    2908. 

  2908. 			my @passed_overhangs;
    2909. 

  2909. 			
    2910. 

  2910. 			for my $i (1 ... length($phase)-1){
    2911. 

  2911. 				my $overhang = substr($phase, -length($phase)+$i);
    2912. 

  2912. #				print "current overhang = $overhang, leftpeep = ",substr($leftpeep,-10)," whole sequence = ",substr($seq, ($end - ($end-$start) - 20), (($end-$start)+20)),"\n" if $prinkter == 1;
    2913. 

  2913. 				#TEMPORARY... BETTER METHOD NEEDED
    2914. 

  2914. 				$leftpeep =~ s/-//g;
    2915. 

  2915. 				if ($leftpeep =~ /$overhang$/i){
    2916. 

  2916. 					push(@passed_overhangs,$overhang);
    2917. 

  2917. #					print "l overhang\n" if $prinkter == 1;
    2918. 

  2918. 				}
    2919. 

  2919. 			}
    2920. 

  2920. 			
    2921. 

  2921. 			if(scalar(@passed_overhangs)>0){
    2922. 

  2922. 				my $overhang = $passed_overhangs[longest_array_element(@passed_overhangs)];
    2923. 

  2923. 				$extention = $overhang.$extention;
    2924. 

  2924. 				$trapped = $overhang.$trapped;
    2925. 

  2925. #				print "trapped extended to $trapped \n" if $prinkter == 1;
    2926. 

  2926. 				$trappedpos = length($leftseq)-length($trapped);
    2927. 

  2927. 			}
    2928. 

  2928. 			
    2929. 

  2929. 			push(@extentions,$extention);
    2930. 

  2930. #			print "extentions = @extentions \n" if $prinkter == 1;
    2931. 

  2931. 

  2932. 			push(@trappeds,$trapped );
    2933. 

  2933. 			push(@intervalposs,length($extention)+1);
    2934. 

  2934. 			push(@trappedposs, $trappedpos);
    2935. 

  2935. #			print "trappeds = @trappeds\n" if $prinkter == 1;
    2936. 

  2936. 			push(@trappedphases, substr($extention,0,length($phase)));
    2937. 

  2937. 			push(@intervals, $interval);
    2938. 

  2938. 		}
    2939. 

  2939. 	}
    2940. 

  2940. 	if (scalar(@trappeds == 0)) {return $line;}
    2941. 

  2941. 	
    2942. 

  2942. ############################	my $nikaal = longest_array_element(@trappeds);
    2943. 

  2943. 	my $nikaal = shortest_array_element(@intervals);
    2944. 

  2944. 	
    2945. 

  2945. #	print "longest element found = $nikaal \n" if $prinkter == 1;
    2946. 

  2946. 	
    2947. 

  2947. 	if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
    2948. 

  2948. 	$fields[$motifcord] = "[".$trappedphases[$nikaal]."]".$fields[$motifcord];
    2949. 

  2949. 	#print "new fields 9 = $fields[9]\n" if $prinkter == 1;
    2950. 

  2950. 	$fields[$startcord] = $fields[$startcord]-length($trappeds[$nikaal]);
    2951. 

  2951. 

  2952. 	#print "new fields 9 = $fields[9]\n" if $prinkter == 1;
    2953. 

  2953. 

  2954. 	if($fields[$microsatcord] !~ /^\[/i){
    2955. 

  2955. 		$fields[$microsatcord] = "[".$fields[$microsatcord]."]";
    2956. 

  2956. 	}
    2957. 

  2957. 	
    2958. 

  2958. 	$fields[$microsatcord] = "[".$extentions[$nikaal]."]".$intervals[$nikaal].$fields[$microsatcord];
    2959. 

  2959. 	#print "new fields 14 = $fields[12]\n" if $prinkter == 1;
    2960. 

  2960. 	
    2961. 

  2961. 	#print "scalar of fields = ",scalar(@fields),"\n" if $prinkter == 1;
    2962. 

  2962. 

  2963. 	
    2964. 

  2964. 	if (scalar(@fields) > $motifcord+1){
    2965. 

  2965. 		$fields[$motifcord+1] = "indel/deletion,".$fields[$motifcord+1];
    2966. 

  2966. 	}
    2967. 

  2967. 	else{$fields[$motifcord+1] = "indel/deletion";}
    2968. 

  2968. 	#print "new fields 14 = $fields[14]\n" if $prinkter == 1;
    2969. 

  2969. 	
    2970. 

  2970. 	if (scalar(@fields)>$motifcord+2){		
    2971. 

  2971. 		$fields[$motifcord+2] = $intervals[$nikaal].",".$fields[$motifcord+2];
    2972. 

  2972. 	}
    2973. 

  2973. 	else{$fields[$motifcord+2] =  $intervals[$nikaal];}	
    2974. 

  2974. 	#print "new fields 15 = $fields[15]\n" if $prinkter == 1;
    2975. 

  2975. 

  2976. 	my @seventeen=();
    2977. 

  2977. 	
    2978. 

  2978. 	if (scalar(@fields)>$motifcord+3){			
    2979. 

  2979. 		@seventeen = split(/,/,$fields[$motifcord+3]);	
    2980. 

  2980. 	#	print "scalarseventeen =@seventeen<-\n" if $prinkter == 1;
    2981. 

  2981. 		for (0 ... scalar(@seventeen)-1) {$seventeen[$_] = $seventeen[$_]+length($trappeds[$nikaal]);}
    2982. 

  2982. 		$fields[$motifcord+3] = ($intervalposs[$nikaal]).",".join(",",@seventeen);
    2983. 

  2983. 		$fields[$motifcord+4] = $fields[$motifcord+4]+1;
    2984. 

  2984. 	}
    2985. 

  2985. 	
    2986. 

  2986. 	else {$fields[$motifcord+3] = $intervalposs[$nikaal]; $fields[$motifcord+4]=1}
    2987. 

  2987. 	
    2988. 

  2988. 	#print "new fields 16 = $fields[16]\n" if $prinkter == 1;
    2989. 

  2989. 	#print "new fields 17 = $fields[17]\n" if $prinkter == 1;
    2990. 

  2990. 	
    2991. 

  2991. #	return join("\t",@fields);	
    2992. 

  2992. 	my $returnline = join("\t",@fields);
    2993. 

  2993. 	my $pastline  = $returnline;
    2994. 

  2994. 	if ($fields[$microsatcord] =~ /\[/){
    2995. 

  2995. 		$returnline = multiSpecies_interruptedMicrosatHunter_merge($returnline);
    2996. 

  2996. 	}
    2997. 

  2997. #	print "finally left-extended line = ",$returnline,"\n" if $prinkter == 1;
    2998. 

  2998. 	return $returnline;
    2999. 

  2999. }
    3000. 

  3000. 

  3001. sub multiSpecies_interruptedMicrosatHunter_right_extender{
    3002. 

  3002. #	print "right extender\n" if $prinkter == 1;
    3003. 

  3003. 	my ($line, $seq, $org) = @_;	
    3004. 

  3004. #	print "in right extender... line passed = $line\n" if $prinkter == 1;
    3005. 

  3005. #	print "line = $line, sequence = ",$seq, "\n" if $prinkter == 1;
    3006. 

  3006. 	chomp $line;
    3007. 

  3007. 	my @fields = split(/\t/,$line);
    3008. 

  3008. 	my $rstart = $fields[$startcord];
    3009. 

  3009. 	my $microsat = $fields[$microsatcord];
    3010. 

  3010. 	$microsat =~ s/\[|\]//g;
    3011. 

  3011. 	my $rend = $rstart + length($microsat)-1;
    3012. 

  3012. 	$microsat =~ s/-//g;
    3013. 

  3013. 	my $motif = $fields[$motifcord];
    3014. 

  3014. 	my $temp_lastmotif = ();
    3015. 

  3015. 

  3016. 	if ($motif =~ /\]$/){
    3017. 

  3017. 		$motif =~ s/\]$//g;
    3018. 

  3018. 		$motif =~ /.*\[([a-zA-Z]+)/;
    3019. 

  3019. 		$temp_lastmotif = $1;
    3020. 

  3020. 	}
    3021. 

  3021. 	else {$temp_lastmotif = $motif;}
    3022. 

  3022. 	my $lastmotif = substr($microsat,-length($temp_lastmotif));
    3023. 

  3023. #	print "hacked microsat = $microsat, motif = $motif, lastmotif = $lastmotif\n" if $prinkter == 1;
    3024. 

  3024. 	my $rightphase = substr($microsat, -length($lastmotif));
    3025. 

  3025. 	my $phaser = $rightphase.$rightphase;
    3026. 

  3026. 	my @phase = split(/\s*/,$rightphase);
    3027. 

  3027. 	my @phases;
    3028. 

  3028. 	my @copy_phases = @phases;
    3029. 

  3029. 	my $crawler=0;
    3030. 

  3030. 	for (0 ... (length($rightphase)-1)){
    3031. 

  3031. 		push(@phases, substr($phaser, $crawler, length($rightphase)));
    3032. 

  3032. 		$crawler++;
    3033. 

  3033. 	}
    3034. 

  3034. 

  3035. 	my $start = $rstart;
    3036. 

  3036. 	my $end = $rend;
    3037. 

  3037. 	
    3038. 

  3038. 	my $rightseq = substr($seq, $end+1);
    3039. 

  3039. #	print "length of sequence  = " ,length($seq), "the coordinate to start from = ", $end+1, "\n" if $prinkter == 1;
    3040. 

  3040. #	print "right phases are @phases , end = $end right sequence = ",substr($rightseq,0,10),"\n" if $prinkter == 1;	
    3041. 

  3041. 	my @extentions = ();
    3042. 

  3042. 	my @trappeds = ();
    3043. 

  3043. 	my @intervalposs = ();
    3044. 

  3044. 	my @trappedposs = ();
    3045. 

  3045. 	my @trappedphases = ();
    3046. 

  3046. 	my @intervals = ();
    3047. 

  3047. 	my $lastmotif_length = length($lastmotif);
    3048. 

  3048. 	foreach my $phase (@phases){
    3049. 

  3049. #		print "right phase\t$phase\t",substr($rightseq,0,10),"\n" if $prinkter == 1;
    3050. 

  3050. #		print "search patter = (([a-zA-Z|-]{0,$lastmotif_length})($phase)+) \n" if $prinkter == 1;
    3051. 

  3051. 		if ($rightseq =~ /^(([a-zA-Z|-]{0,$lastmotif_length}?)($phase)+)/i){
    3052. 

  3052. #			print "in right pattern\n" if $prinkter == 1;
    3053. 

  3053. 			my $trapped = $1;
    3054. 

  3054. 			my $trappedpos = $end+1;
    3055. 

  3055. 			my $interval = $2;
    3056. 

  3056. 			my $intervalpos = index($trapped, $interval) + 1;
    3057. 

  3057. #			print "trapped = $trapped, interval = $interval\n" if $prinkter == 1;
    3058. 

  3058. 

  3059. 			my $extention = substr($trapped, length($interval));
    3060. 

  3060. 			my $rightpeep = substr($seq, ($end+length($trapped))+1);
    3061. 

  3061. 			my @passed_overhangs = "";
    3062. 

  3062. 			
    3063. 

  3063. 			#TEMPORARY... BETTER METHOD NEEDED
    3064. 

  3064. 			$rightpeep =~ s/-//g;
    3065. 

  3065. 

  3066. 			for my $i (1 ... length($phase)-1){
    3067. 

  3067. 				my $overhang = substr($phase,0, $i);
    3068. 

  3068. #				print "current extention = $extention, overhang = $overhang, rightpeep = ",substr($rightpeep,0,10),"\n" if $prinkter == 1;
    3069. 

  3069. 				if ($rightpeep =~ /^$overhang/i){
    3070. 

  3070. 					push(@passed_overhangs, $overhang);
    3071. 

  3071. #					print "r overhang\n" if $prinkter == 1;
    3072. 

  3072. 				}
    3073. 

  3073. 			}
    3074. 

  3074. 			if (scalar(@passed_overhangs) > 0){			
    3075. 

  3075. 				my $overhang = @passed_overhangs[longest_array_element(@passed_overhangs)];
    3076. 

  3076. 				$extention = $extention.$overhang;
    3077. 

  3077. 				$trapped = $trapped.$overhang;
    3078. 

  3078. #				print "trapped extended to $trapped \n" if $prinkter == 1;
    3079. 

  3079. 			}
    3080. 

  3080. 		
    3081. 

  3081. 			push(@extentions,$extention);
    3082. 

  3082. 			#print "extentions = @extentions \n" if $prinkter == 1;
    3083. 

  3083. 

  3084. 			push(@trappeds,$trapped );
    3085. 

  3085. 			push(@intervalposs,$intervalpos);
    3086. 

  3086. 			push(@trappedposs, $trappedpos);
    3087. 

  3087. #			print "trappeds = @trappeds\n" if $prinkter == 1;
    3088. 

  3088. 			push(@trappedphases, substr($extention,0,length($phase)));
    3089. 

  3089. 			push(@intervals, $interval);
    3090. 

  3090. 		}
    3091. 

  3091. 	}
    3092. 

  3092. 	if (scalar(@trappeds == 0)) {return $line;}
    3093. 

  3093. 	
    3094. 

  3094. ###################################	my $nikaal = longest_array_element(@trappeds);
    3095. 

  3095. 	my $nikaal = shortest_array_element(@intervals);
    3096. 

  3096. 	
    3097. 

  3097. #	print "longest element found = $nikaal \n" if $prinkter == 1;
    3098. 

  3098. 	
    3099. 

  3099. 	if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
    3100. 

  3100. 	$fields[$motifcord] = $fields[$motifcord]."[".$trappedphases[$nikaal]."]";
    3101. 

  3101. 	$fields[$endcord] = $fields[$endcord] + length($trappeds[$nikaal]);
    3102. 

  3102. 

  3103. 

  3104. 	if($fields[$microsatcord] !~ /^\[/i){
    3105. 

  3105. 		$fields[$microsatcord] = "[".$fields[$microsatcord]."]";
    3106. 

  3106. 	}
    3107. 

  3107. 	
    3108. 

  3108. 	$fields[$microsatcord] = $fields[$microsatcord].$intervals[$nikaal]."[".$extentions[$nikaal]."]";
    3109. 

  3109. 	
    3110. 

  3110. 	
    3111. 

  3111. 	if (scalar(@fields) > $motifcord+1){
    3112. 

  3112. 		$fields[$motifcord+1] = $fields[$motifcord+1].",indel/deletion";
    3113. 

  3113. 	}
    3114. 

  3114. 	else{$fields[$motifcord+1] = "indel/deletion";}
    3115. 

  3115. 	
    3116. 

  3116. 	if (scalar(@fields)>$motifcord+2){		
    3117. 

  3117. 		$fields[$motifcord+2] = $fields[$motifcord+2].",".$intervals[$nikaal];
    3118. 

  3118. 	}
    3119. 

  3119. 	else{$fields[$motifcord+2] =  $intervals[$nikaal];}	
    3120. 

  3120. 

  3121. 	my @seventeen=();
    3122. 

  3122. 	if (scalar(@fields)>$motifcord+3){
    3123. 

  3123. 		#print "at 608 we are doing this:length($microsat)+$intervalposs[$nikaal]\n" if $prinkter == 1;
    3124. 

  3124. 		my $currpos = length($microsat)+$intervalposs[$nikaal];
    3125. 

  3125. 		$fields[$motifcord+3] = $fields[$motifcord+3].",".$currpos;
    3126. 

  3126. 		$fields[$motifcord+4] = $fields[$motifcord+4]+1;
    3127. 

  3127. 

  3128. 	}
    3129. 

  3129. 	
    3130. 

  3130. 	else {$fields[$motifcord+3] = length($microsat)+$intervalposs[$nikaal]; $fields[$motifcord+4]=1}
    3131. 

  3131. 	
    3132. 

  3132. #	print "finally right-extended line = ",join("\t",@fields),"\n" if $prinkter == 1;
    3133. 

  3133. #	return join("\t",@fields);
    3134. 

  3134. 

  3135. 	my $returnline = join("\t",@fields);
    3136. 

  3136. 	my $pastline  = $returnline;
    3137. 

  3137. 	if ($fields[$microsatcord] =~ /\[/){
    3138. 

  3138. 		$returnline = multiSpecies_interruptedMicrosatHunter_merge($returnline);
    3139. 

  3139. 	}
    3140. 

  3140. #	print "finally right-extended line = ",$returnline,"\n" if $prinkter == 1;
    3141. 

  3141. 	return $returnline;
    3142. 

  3142. 

  3143. }
    3144. 

  3144. 

  3145. sub multiSpecies_interruptedMicrosatHunter_left_extention_permission_giver{
    3146. 

  3146. 	my @fields = split(/\t/,$_[0]);
    3147. 

  3147. 	my $microsat = $fields[$microsatcord];
    3148. 

  3148. 	$microsat =~ s/(^\[)|-//sg;
    3149. 

  3149. 	my $motif = $fields[$motifcord];
    3150. 

  3150. 	chomp $motif;
    3151. 

  3151. #	print $motif, "\n" if $motif !~ /^\[/;
    3152. 

  3152. 	my $firstmotif = ();
    3153. 

  3153. 	my $firststretch = ();
    3154. 

  3154. 	my @stretches=();
    3155. 

  3155. 	
    3156. 

  3156. #	print "motif = $motif, microsat = $microsat\n" if $prinkter == 1;
    3157. 

  3157. 	if ($motif =~ /^\[/){
    3158. 

  3158. 		$motif =~ s/^\[//sg;
    3159. 

  3159. 		$motif =~ /([a-zA-Z]+)\].*/;
    3160. 

  3160. 		$firstmotif = $1;
    3161. 

  3161. 		@stretches = split(/\]/,$microsat);
    3162. 

  3162. 		$firststretch = $stretches[0];
    3163. 

  3163. 		#print "firststretch = $firststretch\n" if $prinkter == 1;
    3164. 

  3164. 	}
    3165. 

  3165. 	else {$firstmotif = $motif;$firststretch = $microsat;}
    3166. 

  3166. #	print "if length:firststretch - length($firststretch) < threshes length :firstmotif ($firstmotif) - $thresholds[length($firstmotif)]\n" if $prinkter == 1; 
    3167. 

  3167. 	if (length($firststretch) < $thresholds[length($firstmotif)]){
    3168. 

  3168. 		return "no";
    3169. 

  3169. 	}
    3170. 

  3170. 	else {return "yes";}
    3171. 

  3171. 

  3172. }
    3173. 

  3173. sub multiSpecies_interruptedMicrosatHunter_right_extention_permission_giver{
    3174. 

  3174. 	my @fields = split(/\t/,$_[0]);
    3175. 

  3175. 	my $microsat = $fields[$microsatcord];
    3176. 

  3176. 	$microsat =~ s/-|(\]$)//sg;
    3177. 

  3177. 	my $motif = $fields[$motifcord];
    3178. 

  3178. 	chomp $motif;
    3179. 

  3179. 	my $temp_lastmotif = ();
    3180. 

  3180. 	my $laststretch = ();
    3181. 

  3181. 	my @stretches=();
    3182. 

  3182. 

  3183. 

  3184. 	if ($motif =~ /\]/){
    3185. 

  3185. 		$motif =~ s/\]$//sg;
    3186. 

  3186. 		$motif =~ /.*\[([a-zA-Z]+)$/;
    3187. 

  3187. 		$temp_lastmotif = $1;
    3188. 

  3188. 		@stretches = split(/\[/,$microsat);
    3189. 

  3189. 		$laststretch = pop(@stretches);
    3190. 

  3190. 		#print "last stretch = $laststretch\n" if $prinkter == 1;
    3191. 

  3191. 	}
    3192. 

  3192. 	else {$temp_lastmotif = $motif; $laststretch = $microsat;}
    3193. 

  3193. 

  3194. 	if (length($laststretch) < $thresholds[length($temp_lastmotif)]){
    3195. 

  3195. 		return "no";
    3196. 

  3196. 	}
    3197. 

  3197. 	else { return "yes";}
    3198. 

  3198. 

  3199. 

  3200. }
    3201. 

  3201. sub checking_substitutions{
    3202. 

  3202. 	
    3203. 

  3203. 	my ($line, $seq, $startprobes, $endprobes) = @_;
    3204. 

  3204. 	#print "sequence = $seq \n" if $prinkter == 1;
    3205. 

  3205. 	#print "COMMAND  = \n $line, \n $seq, \n $startprobes \n, $endprobes\n";
    3206. 

  3206. 		#		<STDIN>;
    3207. 

  3207. 	my @seqarray = split(/\s*/,$seq);
    3208. 

  3208. 	my @startsubst_probes = split(/\|/,$startprobes); 
    3209. 

  3209. 	my @endsubst_probes = split(/\|/,$endprobes);
    3210. 

  3210. 	chomp $line;
    3211. 

  3211. 	my @fields = split(/\t/,$line);
    3212. 

  3212. 	my $start = $fields[11] - $fields[10];
    3213. 

  3213. 	my $end = $fields[13] - $fields[10];
    3214. 

  3214. 	my $motif = $fields[9]; #IN FUTURE, USE THIS AS A PROBE, LIKE MOTIF = $FIELDS[9].$FIELDS[9]
    3215. 

  3215. 	$motif =~ s/\[|\]//g;
    3216. 

  3216. 	my $microsat = $fields[14];
    3217. 

  3217. 	$microsat =~ s/\[|\]//g;
    3218. 

  3218. 	#------------------------------------------------------------------------
    3219. 

  3219. 	# GETTING START AND END PHASES
    3220. 

  3220. 	my $startphase = substr($microsat,0, length($motif));
    3221. 

  3221. 	my $endphase = substr($microsat,-length($motif), length($motif));
    3222. 

  3222. 	#print "start and end phases are  - $startphase and $endphase\n";
    3223. 

  3223. 	my $startflag = 'down';
    3224. 

  3224. 	my $endflag = 'down';
    3225. 

  3225. 	my $substitution_distance = length($motif);
    3226. 

  3226. 	my $prestart = $start - $substitution_distance;
    3227. 

  3227. 	my $postend = $end + $substitution_distance;
    3228. 

  3228. 	my @endadds = ();
    3229. 

  3229. 	my @startadds = ();
    3230. 

  3230. 		if (($prestart < 0) || ($postend > scalar(@seqarray))) {
    3231. 

  3231. 			last;
    3232. 

  3232. 		}
    3233. 

  3233. 	#------------------------------------------------------------------------#------------------------------------------------------------------------
    3234. 

  3234. 	# CHECKING FOR SUBSTITUTION PROBES NOW			
    3235. 

  3235. 		
    3236. 

  3236. 	if ($fields[8] ne "mononucleotide"){				
    3237. 

  3237. 		while ($startflag eq "down"){		
    3238. 

  3238. 			my $search = join("",@seqarray[$prestart...($start-1)]);
    3239. 

  3239. 			#print "search is from $prestart...($start-1) = $search\n";
    3240. 

  3240. 			foreach my $probe (@startsubst_probes){
    3241. 

  3241. 				#print "\t\tprobe = $probe\n";				
    3242. 

  3242. 				if ($search =~ /^$probe/){
    3243. 

  3243. 					#print "\tfound addition to the left - $search \n";
    3244. 

  3244. 					my $copyprobe = $probe;
    3245. 

  3245. 					my $type;
    3246. 

  3246. 					my $subspos = 0;
    3247. 

  3247. 					my $interruption = "";
    3248. 

  3248. 					if ($search eq $startphase) { $type = "NONE";}
    3249. 

  3249. 					else{
    3250. 

  3250. 						$copyprobe =~ s/\[a-zA-Z\]/^/g;
    3251. 

  3251. 						$subspos = index($copyprobe,"^") + 1;
    3252. 

  3252. 						$type = "substitution";
    3253. 

  3253. 						$interruption  = substr($search, $subspos,1);
    3254. 

  3254. 					}
    3255. 

  3255. 					my $addinfo = join("\t",$prestart, $start, $search, $type, $interruption, $subspos);
    3256. 

  3256. 					#print "adding information: $addinfo \n";
    3257. 

  3257. 					push(@startadds, $addinfo);
    3258. 

  3258. 					$prestart = $prestart - $substitution_distance;
    3259. 

  3259. 					$start = $start-$substitution_distance;
    3260. 

  3260. 					$startflag = 'down';
    3261. 

  3261. 					
    3262. 

  3262. 					last;
    3263. 

  3263. 				}
    3264. 

  3264. 				else{
    3265. 

  3265. 					$startflag = 'up';
    3266. 

  3266. 				}
    3267. 

  3267. 			}
    3268. 

  3268. 		}
    3269. 

  3269. 		#<STDIN>;		
    3270. 

  3270. 		while ($endflag eq "down"){									
    3271. 

  3271. 			my $search = join("",@seqarray[($end+1)...$postend]);
    3272. 

  3272. 			#print "search is from ($end+1)...$postend] = $search\n";
    3273. 

  3273. 

  3274. 			foreach my $probe (@endsubst_probes){
    3275. 

  3275. 				#print "\t\tprobe = $probe\n";
    3276. 

  3276. 				if ($search =~ /$probe$/){
    3277. 

  3277. 					my $copyprobe = $probe;
    3278. 

  3278. 					my $type;
    3279. 

  3279. 					my $subspos = 0;
    3280. 

  3280. 					my $interruption = "";
    3281. 

  3281. 					if ($search eq $endphase) { $type = "NONE";}
    3282. 

  3282. 					else{
    3283. 

  3283. 						$copyprobe =~ s/\[a-zA-Z\]/^/g;
    3284. 

  3284. 						$subspos = index($copyprobe,"^") + 1;
    3285. 

  3285. 						$type = "substitution";
    3286. 

  3286. 						$interruption  = substr($search, $subspos,1);
    3287. 

  3287. 					}
    3288. 

  3288. 					my $addinfo = join("\t",$end, $postend, $search, $type, $interruption, $subspos);
    3289. 

  3289. 					#print "adding information: $addinfo \n";
    3290. 

  3290. 					push(@endadds, $addinfo);
    3291. 

  3291. 					$postend = $postend + $substitution_distance;
    3292. 

  3292. 					$end = $end+$substitution_distance;
    3293. 

  3293. 					push(@endadds, $search);
    3294. 

  3294. 					$endflag = 'down';
    3295. 

  3295. 					last;
    3296. 

  3296. 				}
    3297. 

  3297. 				else{
    3298. 

  3298. 					$endflag = 'up';
    3299. 

  3299. 				}
    3300. 

  3300. 			}
    3301. 

  3301. 		}
    3302. 

  3302. 		#print "startadds = @startadds, endadds  = @endadds \n";
    3303. 

  3303. 	
    3304. 

  3304. 	}
    3305. 

  3305. }
    3306. 

  3306. sub microsat_packer{
    3307. 

  3307. 	my $microsat = $_[0];
    3308. 

  3308. 	my $addition = $_[1];
    3309. 

  3309. 

  3310. 

  3311. 

  3312. }
    3313. 

  3313. sub multiSpecies_interruptedMicrosatHunter_merge{
    3314. 

  3314. 		$prinkter = 0;
    3315. 

  3315. #	print "~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~\n";
    3316. 

  3316. 	my $line = $_[0];
    3317. 

  3317. #	print "sent for mering: $line \n" if $prinkter ==1;
    3318. 

  3318. 	my @mields = split(/\t/,$line);
    3319. 

  3319. 	my @fields = @mields;
    3320. 

  3320. 	my $microsat = allCaps($fields[$microsatcord]);
    3321. 

  3321. 	my $motifline = allCaps($fields[$motifcord]);
    3322. 

  3322. 	my $microsatcopy = $microsat;
    3323. 

  3323. #	print "microsat = $microsat|\n" if $prinkter ==1;
    3324. 

  3324. 	$microsatcopy =~ s/^\[|\]$//sg;
    3325. 

  3325. 	chomp $microsatcopy;
    3326. 

  3326. 	my @microields = split(/\][a-zA-Z|-]*\[/,$microsatcopy);
    3327. 

  3327. 	my @inields = split(/\[[a-zA-Z|-]*\]/,$microsat);
    3328. 

  3328. 	shift @inields;
    3329. 

  3329. #	print "inields =",join("|",@inields)," microields = ",join("|",@microields)," and count of microields = ", $#microields,"\n" if $prinkter ==1;
    3330. 

  3330. 	$motifline =~ s/^\[|\]$//sg;
    3331. 

  3331. 	my @motields = split(/\]\[/,$motifline);
    3332. 

  3332. 	my @firstmotifs = ();
    3333. 

  3333. 	my @lastmotifs = ();
    3334. 

  3334. 	for my $i  (0 ... $#microields){
    3335. 

  3335. 		$firstmotifs[$i] =  substr($microields[$i],0,length($motields[$i]));
    3336. 

  3336. 		$lastmotifs[$i] = substr($microields[$i],-length($motields[$i]));
    3337. 

  3337. 	}
    3338. 

  3338. #	print "firstmotif = @firstmotifs... lastmotif = @lastmotifs\n" if $prinkter ==1;
    3339. 

  3339. 	my @mergelist = ();
    3340. 

  3340. 	my @inter_poses = split(/,/,$fields[$interr_poscord]);
    3341. 

  3341. 	my $no_of_interruptions = $fields[$no_of_interruptionscord];
    3342. 

  3342. 	my @interruptions = split(/,/,$fields[$interrcord]);
    3343. 

  3343. 	my @interrtypes = split(/,/,$fields[$interrtypecord]);
    3344. 

  3344. 	my $stopper = 0;
    3345. 

  3345. 	for my $i (0 ... $#motields-1){
    3346. 

  3346. #		print "studying connection of $motields[$i] and $motields[$i+1], i = $i in $microsat\n:$lastmotifs[$i] eq $firstmotifs[$i+1]?\n" if $prinkter ==1;
    3347. 

  3347. 		if ((allCaps($lastmotifs[$i]) eq allCaps($firstmotifs[$i+1])) && (!exists $inields[$i] || $inields[$i] !~ /[a-zA-Z]/)){
    3348. 

  3348. 			$stopper = 1;
    3349. 

  3349. 			push(@mergelist, ($i)."_".($i+1)); #<STDIN> if $prinkter ==1;
    3350. 

  3350. 		}
    3351. 

  3351. 	}
    3352. 

  3352. 	
    3353. 

  3353. #	print "mergelist = @mergelist\n" if $prinkter ==1;
    3354. 

  3354. 	return $line if scalar(@mergelist) == 0;
    3355. 

  3355. #	print "merging @mergelist\n" if $prinkter ==1;
    3356. 

  3356. #	<STDIN> if $prinkter ==1;
    3357. 

  3357. 	
    3358. 

  3358. 	foreach my $merging (@mergelist){
    3359. 

  3359. 		my @sets = split(/_/, $merging);
    3360. 

  3360. #		print "sets = @sets\n" if $prinkter ==1;
    3361. 

  3361. 		my @tempmicro = ();
    3362. 

  3362. 		my @tempmot = ();
    3363. 

  3363. #		print "for loop going from 0 ... ", $sets[0]-1, "\n" if $prinkter ==1;
    3364. 

  3364. 		for my $i (0 ... $sets[0]-1){
    3365. 

  3365. #			print " adding pre- i = $i adding: microields= $microields[$i]. motields = $motields[$i], inields = |$inields[$i]|\n" if $prinkter ==1;
    3366. 

  3366. 			push(@tempmicro, "[".$microields[$i]."]");
    3367. 

  3367. 			push(@tempmicro, $inields[$i]);
    3368. 

  3368. 			push(@tempmot, "[".$motields[$i]."]");
    3369. 

  3369. #			print "adding pre-motifs number $i\n" if $prinkter ==1;
    3370. 

  3370. #			print "tempmot = @tempmot, tempmicro = @tempmicro \n" if $prinkter ==1;
    3371. 

  3371. 		}
    3372. 

  3372. #		print "tempmot = @tempmot, tempmicro = @tempmicro \n" if $prinkter ==1;
    3373. 

  3373. #		print "now pushing ", "[",$microields[$sets[0]]," and ",$microields[$sets[1]],"]\n" if $prinkter ==1;
    3374. 

  3374. 		my $pusher = "[".$microields[$sets[0]].$microields[$sets[1]]."]";
    3375. 

  3375. #		print "middle is, from @motields -   @sets, number 0 which is  is\n";
    3376. 

  3376. #		print ": $motields[$sets[0]]\n";
    3377. 

  3377. 		push (@tempmicro, $pusher);
    3378. 

  3378. 		push(@tempmot, "[".$motields[$sets[0]]."]");
    3379. 

  3379. 		push (@tempmicro, $inields[$sets[1]]) if $sets[1] != $#microields && exists $sets[1] && exists $inields[$sets[1]];
    3380. 

  3380. 		my $outcoming = -2;
    3381. 

  3381. #		print "tempmot = @tempmot, tempmicro = @tempmicro \n" if $prinkter ==1;
    3382. 

  3382. #		print "for loop going from ",$sets[1]+1, " ... ", $#microields, "\n" if $prinkter ==1;
    3383. 

  3383. 		for my $i ($sets[1]+1 ... $#microields){
    3384. 

  3384. #			print " adding post- i = $i adding: microields= $microields[$i]. motields = $motields[$i]\n" if $prinkter ==1;
    3385. 

  3385. 			push(@tempmicro, "[".$microields[$i]."]") if exists $microields[$i];
    3386. 

  3386. 			push(@tempmicro, $inields[$i]) unless $i == $#microields || !exists $inields[$i];
    3387. 

  3387. 			push(@tempmot, "[".$motields[$i]."]");
    3388. 

  3388. #			print "adding post-motifs number $i\n" if $prinkter ==1;
    3389. 

  3389. 			$outcoming  = $i;
    3390. 

  3390. 		}
    3391. 

  3391. #		print "____________________________________________________________________________\n";
    3392. 

  3392. 		$prinkter = 0;
    3393. 

  3393. 		$fields[$microsatcord] = join("",@tempmicro);
    3394. 

  3394. 		$fields[$motifcord] = join("",@tempmot);
    3395. 

  3395. #		print "tempmot = @tempmot, tempmicro = @tempmicro . microsat = $fields[$microsatcord] and motif = $fields[$motifcord] \n" if $prinkter ==1;
    3396. 

  3396. 		
    3397. 

  3397. 		splice(@interrtypes, $sets[0], 1);
    3398. 

  3398. 		$fields[$interrtypecord] = join(",",@interrtypes);
    3399. 

  3399. 		splice(@interruptions, $sets[0], 1);
    3400. 

  3400. 		$fields[$interrcord] = join(",",@interruptions);
    3401. 

  3401. 		splice(@inter_poses, $sets[0], 1);
    3402. 

  3402. 		$fields[$interr_poscord] = join(",",@inter_poses);
    3403. 

  3403. 		$no_of_interruptions = $no_of_interruptions - 1;
    3404. 

  3404. 	}	
    3405. 

  3405. 

  3406. 	if ($no_of_interruptions == 0 && $line !~ /compound/){
    3407. 

  3407. 		$fields[$microsatcord] =~ s/^\[|\]$//sg;
    3408. 

  3408. 		$fields[$motifcord] =~ s/^\[|\]$//sg;
    3409. 

  3409. 		$line = join("\t", @fields[0 ... $motifcord]);		
    3410. 

  3410. 	}
    3411. 

  3411. 	else{
    3412. 

  3412. 		$line = join("\t", @fields);
    3413. 

  3413. 	}
    3414. 

  3414. #	print "post merging, the line is $line\n" if $prinkter ==1;
    3415. 

  3415. 	#<STDIN> if $stopper ==1;
    3416. 

  3416. 	return $line;
    3417. 

  3417. }
    3418. 

  3418. sub interval_asseser{
    3419. 

  3419. 	my $pre_phase = $_[0]; my $post_phase = $_[1]; my $inter = $_[3];
    3420. 

  3420. }
    3421. 

  3421. #---------------------------------------------------------------------------------------------------
    3422. 

  3422. sub allCaps{
    3423. 

  3423. 	my $motif = $_[0];
    3424. 

  3424. 	$motif =~ s/a/A/g;
    3425. 

  3425. 	$motif =~ s/c/C/g;
    3426. 

  3426. 	$motif =~ s/t/T/g;
    3427. 

  3427. 	$motif =~ s/g/G/g;
    3428. 

  3428. 	return $motif;
    3429. 

  3429. }
    3430. 

  3430. 

  3431. 

  3432. #xxxxxxxxxxxxxx multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx  chromosome_unrand_breamultiSpecies_interruptedMicrosatHunterker xxxxxxxxxxxxxx  multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx 
    3433. 

  3433. 

  3434. 

  3435. #xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx  merge_interruptedMicrosats xxxxxxxxxxxxxx  merge_interruptedMicrosats xxxxxxxxxxxxxx 
    3436. 

  3436. sub merge_interruptedMicrosats{
    3437. 

  3437. #	print "IN merge_interruptedMicrosats: @_\n";
    3438. 

  3438. 	my $input0 = $_[0];  ######looks like this: my $t8humanoutput = $pipedir.$ptag."_nogap_op_unrand2"
    3439. 

  3439. 	my $input1 = $_[1];  ###### the *_sput_op4_ii file
    3440. 

  3440. 	my $input2 = $_[2];  ###### the *_sput_op4_ii file
    3441. 

  3441. 	$no_of_species = $_[3];
    3442. 

  3442. 	
    3443. 

  3443. 	my $output1 = $_[1]."_separate";    #$_[3]; ###### plain microsatellite file forward
    3444. 

  3444. 	my $output2 = $_[2]."_separate";    ##$_[4]; ###### plain microsatellite file reverse
    3445. 

  3445. 	my $output3 = $_[1]."_merged";    ##$_[5]; ###### plain microsatellite file forward
    3446. 

  3446. 	#my $output4 = $_[2]."_merged";    ##$_[6]; ###### plain microsatellite file reverse
    3447. 

  3447. 	#my $info = $_[4];
    3448. 

  3448. 	#my @tags = split(/\t/,$info);
    3449. 

  3449. 	
    3450. 

  3450. 	open(SEQ,"<$input0") or die "Cannot open file $input0 $!";
    3451. 

  3451. 	open(INF,"<$input1") or die "Cannot open file $input1 $!";
    3452. 

  3452. 	open(INR,"<$input2") or die "Cannot open file $input2 $!";
    3453. 

  3453. 	open(OUTF,">$output1") or die "Cannot open file $output1 $!";
    3454. 

  3454. 	open(OUTR,">$output2") or die "Cannot open file $output2 $!";
    3455. 

  3455. 	open(MER,">$output3") or die "Cannot open file $output3 $!";
    3456. 

  3456. 	#open(MERR,">$output4") or die "Cannot open file $output4 $!";
    3457. 

  3457. 		
    3458. 

  3458. 	
    3459. 

  3459. 		
    3460. 

  3460. 	 $printer = 0;
    3461. 

  3461. 	
    3462. 

  3462. #	print "files opened \n";
    3463. 

  3463. 	$infocord = 2 + (4*$no_of_species) - 1;
    3464. 

  3464. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    3465. 

  3465. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    3466. 

  3466. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    3467. 

  3467. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    3468. 

  3468. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    3469. 

  3469. 	$typecord = $infocord + 1;
    3470. 

  3470. 	my $sequencepos = 2 + (5*$no_of_species) + 1 -1 ; 
    3471. 

  3471. 	
    3472. 

  3472. 	$interrtypecord = $motifcord + 1;
    3473. 

  3473. 	$interrcord = $motifcord + 2;
    3474. 

  3474. 	$interr_poscord = $motifcord + 3;
    3475. 

  3475. 	$no_of_interruptionscord = $motifcord + 4;
    3476. 

  3476. 	$mergestarts  = $no_of_interruptionscord+ 1;
    3477. 

  3477. 	$mergeends = $no_of_interruptionscord+ 2;
    3478. 

  3478. 	$mergemicros = $no_of_interruptionscord+ 3;
    3479. 

  3479. 	
    3480. 

  3480. 	# NOW ADDING FORWARD MICROSATELLITES TO HASH
    3481. 

  3481. 	my %fmicros = ();
    3482. 

  3482. 	my $microcounter=0;
    3483. 

  3483. 	my $linecounter = 0;
    3484. 

  3484. 	while (my $line = <INF>){
    3485. 

  3485. 	#	print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
    3486. 

  3486. 		$linecounter++;
    3487. 

  3487. 		if ($line =~ /^>[A-Za-z0-9]+\s+([0-9]+)\s+([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    3488. 

  3488. 			my $key = join("\t",$1, $2, $4, $5);
    3489. 

  3489. 		#	print $key, "#-#-#-#-#-#-#-#\n";
    3490. 

  3490. 			push (@{$fmicros{$key}},$line);	
    3491. 

  3491. 			$microcounter++;
    3492. 

  3492. 		}
    3493. 

  3493. 		else {
    3494. 

  3494. 			#print $line;
    3495. 

  3495. 		}
    3496. 

  3496. 	}
    3497. 

  3497. #	print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
    3498. 

  3498. 	close INF;
    3499. 

  3499. 	my @deletedlines = ();
    3500. 

  3500. #	print "done forward hash \n";
    3501. 

  3501. 	$linecounter = 0;
    3502. 

  3502. 	#---------------------------------------------------------------------------------------------------
    3503. 

  3503. 	# NOW ADDING REVERSE MICROSATELLITES TO HASH
    3504. 

  3504. 	my %rmicros = ();
    3505. 

  3505. 	$microcounter=0;
    3506. 

  3506. 	while (my $line = <INR>){
    3507. 

  3507. 	#	print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
    3508. 

  3508. 		$linecounter++;
    3509. 

  3509. 		if ($line =~ /^>[A-Za-z0-9]+\s+([0-9]+)\s+([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    3510. 

  3510. 			my $key = join("\t",$1, $2, $4, $5);
    3511. 

  3511. 	#		print $key, "#-#-#-#-#-#-#-#\n";
    3512. 

  3512. 			push (@{$rmicros{$key}},$line);	
    3513. 

  3513. 			$microcounter++;
    3514. 

  3514. 		}
    3515. 

  3515. 		else {
    3516. 

  3516. 			#print "cant make key\n";
    3517. 

  3517. 		}
    3518. 

  3518. 	}
    3519. 

  3519. #	print "number of reverse microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
    3520. 

  3520. 	close INR;
    3521. 

  3521. #	print "done reverse hash \n";
    3522. 

  3522. 	$linecounter = 0;
    3523. 

  3523. 	
    3524. 

  3524. 	#------------------------------------------------------------------------------------------------
    3525. 

  3525. 	
    3526. 

  3526. 	while(my $sine = <SEQ>){
    3527. 

  3527. 		#<STDIN> if $sine =~ /16349128/;
    3528. 

  3528. 		next if $sine !~ /[a-zA-Z0-9]/;
    3529. 

  3529. #		print "-" x 150, "\n"  if $printer == 1;
    3530. 

  3530. 		my @sields = split(/\t/,$sine);
    3531. 

  3531. 		my @merged = ();
    3532. 

  3532. 	
    3533. 

  3533. 		my $key = ();
    3534. 

  3534. 	
    3535. 

  3535. 		if ($sine =~ /^>[A-Za-z0-9]+\s+([0-9]+)\s+([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    3536. 

  3536. 			$key = join("\t",$1, $2, $4, $5);
    3537. 

  3537. 		#	print $key, "<-<-<-<-<-<-<-<\n";		
    3538. 

  3538. 		}
    3539. 

  3539. 	#	print "key = $key\n";
    3540. 

  3540. 		
    3541. 

  3541. 		my @sets1;
    3542. 

  3542. 		my @sets2;
    3543. 

  3543. 		chomp $sields[$sequencepos];
    3544. 

  3544. 		my $rev_sequence = reverse($sields[$sequencepos]); 
    3545. 

  3545. 		$rev_sequence =~ s/ //g;
    3546. 

  3546. 		$rev_sequence = " ".$rev_sequence;
    3547. 

  3547. 		next if (!exists $fmicros{$key} && !exists $rmicros{$key});
    3548. 

  3548. 		
    3549. 

  3549. 		if (exists $fmicros{$key}){
    3550. 

  3550. 		#	print "line no : $linecount\n";
    3551. 

  3551. 			my @raw_microstring = @{$fmicros{$key}};
    3552. 

  3552. 			my %starts = (); my %ends = ();
    3553. 

  3553. #			print colored ['yellow'],"unsorted, unfiltered microats = \n" if $printer == 1; foreach (@raw_microstring) {print colored ['blue'],$_,"\n" if $printer == 1;}
    3554. 

  3554. 			my @microstring=();
    3555. 

  3555. 			for my $u (0 ... $#raw_microstring){
    3556. 

  3556. 				my @tields = split(/\t/,$raw_microstring[$u]);
    3557. 

  3557. 				next if exists $starts{$tields[$startcord]} && exists $ends{$tields[$endcord]};
    3558. 

  3558. 				push(@microstring, $raw_microstring[$u]);
    3559. 

  3559. 				$starts{$tields[$startcord]} = $tields[$startcord];
    3560. 

  3560. 				$ends{$tields[$endcord]} = $tields[$endcord];
    3561. 

  3561. 			}
    3562. 

  3562. 			
    3563. 

  3563. 	#		print "founf microstring in forward\n: @microstring\n"; 
    3564. 

  3564. 			chomp @microstring;
    3565. 

  3565. 			my $clusterresult = (find_clusters(@microstring, $sields[$sequencepos])); 	
    3566. 

  3566. 			@sets1 = split("\=", $clusterresult);
    3567. 

  3567. 			my @temp = split(/_X0X_/,$sets1[0]) ; $microscanned+= scalar(@temp);
    3568. 

  3568. 		#	print "sets = ", join("<all\nmerged>", @sets1), "\n<<-sets1\n"; <STDIN>;
    3569. 

  3569. 		}	#if (exists $micros{$key}){
    3570. 

  3570. 	
    3571. 

  3571. 		if (exists $rmicros{$key}){
    3572. 

  3572. 		#	print "line no : $linecount\n";
    3573. 

  3573. 			my @raw_microstring = @{$rmicros{$key}};
    3574. 

  3574. 			my %starts = (); my %ends = ();
    3575. 

  3575. #			print colored ['yellow'],"unsorted, unfiltered microats = \n" if $printer == 1; foreach (@raw_microstring) {print colored ['blue'],$_,"\n" if $printer == 1;}
    3576. 

  3576. 			my @microstring=();
    3577. 

  3577. 			for my $u (0 ... $#raw_microstring){
    3578. 

  3578. 				my @tields = split(/\t/,$raw_microstring[$u]);
    3579. 

  3579. 				next if exists $starts{$tields[$startcord]} && exists $ends{$tields[$endcord]};
    3580. 

  3580. 				push(@microstring, $raw_microstring[$u]);
    3581. 

  3581. 				$starts{$tields[$startcord]} = $tields[$startcord];
    3582. 

  3582. 				$ends{$tields[$endcord]} = $tields[$endcord];
    3583. 

  3583. 			}
    3584. 

  3584. 	#		print "founf microstring in reverse\n: @microstring\n"; <STDIN>;
    3585. 

  3585. 			chomp @microstring;
    3586. 

  3586. 	#		print "sending reversed sequence\n";
    3587. 

  3587. 			my $clusterresult = (find_clusters(@microstring, $rev_sequence ) ); 	
    3588. 

  3588. 			@sets2 = split("\=", $clusterresult);
    3589. 

  3589. 			my @temp = split(/_X0X_/,$sets2[0]) ; $microscanned+= scalar(@temp);
    3590. 

  3590. 		}	#if (exists $micros{$key}){
    3591. 

  3591. 	
    3592. 

  3592. 		my @popout1 = ();
    3593. 

  3593. 		my @popout2 = ();
    3594. 

  3594. 		my @forwardset = ();
    3595. 

  3595. 		if (exists $sets2[1] ){
    3596. 

  3596. 			if(exists $sets1[0]) {
    3597. 

  3597. 				push (@popout1, $sets1[0],$sets2[1]);
    3598. 

  3598. 				my @forwardset = split("=", popOuter(@popout1, $rev_sequence ));#		
    3599. 

  3599. 				print OUTF join("\n",split("_X0X_", $forwardset[0])), "\n";
    3600. 

  3600. 				my @localmerged = split("_X0X_", $forwardset[1]);
    3601. 

  3601. 				my $sequence = $sields[$sequencepos];
    3602. 

  3602. 				$sequence =~ s/ //g;
    3603. 

  3603. #				print "\nforwardset = @forwardset\n";
    3604. 

  3604. 				for my $j (0 ... $#localmerged){
    3605. 

  3605. 					$localmerged[$j] = 	invert_justCoordinates ($localmerged[$j], length($sequence));
    3606. 

  3606. 				}
    3607. 

  3607. 				
    3608. 

  3608. 				push (@merged, @localmerged);
    3609. 

  3609. 				
    3610. 

  3610. 			}
    3611. 

  3611. 			else{
    3612. 

  3612. 				my @localmerged = split("_X0X_", $sets2[1]);
    3613. 

  3613. 				my $sequence = $sields[$sequencepos];
    3614. 

  3614. 				$sequence =~ s/ //g;
    3615. 

  3615. 				for my $j (0 ... $#localmerged){
    3616. 

  3616. #					print "\nlocalmerged = @localmerged\n";
    3617. 

  3617. 					$localmerged[$j] = 	invert_justCoordinates ($localmerged[$j], length($sequence));
    3618. 

  3618. 				}
    3619. 

  3619. 				
    3620. 

  3620. 				push (@merged, @localmerged);
    3621. 

  3621. 			}
    3622. 

  3622. 		}
    3623. 

  3623. 		elsif (exists $sets1[0]){
    3624. 

  3624. 			print OUTF join("\n",split("_X0X_", $sets1[0])), "\n";
    3625. 

  3625. 		}
    3626. 

  3626. 		
    3627. 

  3627. 		my @reverseset= ();
    3628. 

  3628. 		if (exists $sets1[1]){
    3629. 

  3629. 			if (exists $sets2[0]){
    3630. 

  3630. 				push (@popout2, $sets2[0],$sets1[1]);
    3631. 

  3631. 			#	print "popout2 = @popout2\n";
    3632. 

  3632. 				my @reverseset = split("=", popOuter(@popout2, $sields[$sequencepos]));
    3633. 

  3633. 				#print "reverseset = $reverseset[1] < --- reverseset1\n"; 
    3634. 

  3634. 				print OUTR join("\n",split("_X0X_", $reverseset[0])), "\n";
    3635. 

  3635. 				push(@merged,  (split("_X0X_", $reverseset[1])));
    3636. 

  3636. 			}
    3637. 

  3637. 			else{
    3638. 

  3638. 				push(@merged,  (split("_X0X_", $sets1[1])));
    3639. 

  3639. 			}
    3640. 

  3640. 		}
    3641. 

  3641. 		elsif (exists $sets2[0]){
    3642. 

  3642. 			print OUTR join("\n",split("_X0X_", $sets2[0])), "\n";
    3643. 

  3643. 		
    3644. 

  3644. 		}
    3645. 

  3645. 		
    3646. 

  3646. 		if (scalar @merged > 0){
    3647. 

  3647. 			my @filtered_merged = split("__",(filterDuplicates_merged(@merged)));
    3648. 

  3648. 			print MER join("\n", @filtered_merged),"\n"; 
    3649. 

  3649. 		}	
    3650. 

  3650. 	#		<STDIN> if $sine =~ /16349128/;
    3651. 

  3651. 	
    3652. 

  3652. 	}
    3653. 

  3653. 	close(SEQ);
    3654. 

  3654. 	close(INF);
    3655. 

  3655. 	close(INR);
    3656. 

  3656. 	close(OUTF);
    3657. 

  3657. 	close(OUTR);
    3658. 

  3658. 	close(MER);
    3659. 

  3659. 

  3660. }
    3661. 

  3661. sub find_clusters{
    3662. 

  3662. 	my @input = @_;
    3663. 

  3663. 	my $sequence = pop(@input);
    3664. 

  3664. 	$sequence =~ s/ //g;
    3665. 

  3665. 	my @microstring0 = @input;
    3666. 

  3666. #	print "IN: find_clusters:\n";
    3667. 

  3667. 	my %microstart=();
    3668. 

  3668. 	my %microend=();
    3669. 

  3669. 	my @nonmerged = ();
    3670. 

  3670. 	my @mergedSet = ();
    3671. 

  3671. #		print "set of microsats = @microstring \n";
    3672. 

  3672. 	my @microstring = map { $_->[0] } sort custom map { [$_, split /\t/ ] } @microstring0; 
    3673. 

  3673. #	print "microstring = ", join("\n",@microstring0) ," \n---->\n", join("\n", @microstring),"\n ,,+." if $printer == 1; 
    3674. 

  3674. 	#<STDIN> if $printer == 1; 
    3675. 

  3675. 	my @tempmicrostring = @microstring;
    3676. 

  3676. 	foreach my $line (@tempmicrostring){
    3677. 

  3677. 		my @fields = split(/\t/,$line);
    3678. 

  3678. 		my $start = $fields[$startcord];
    3679. 

  3679. 		my $end = $fields[$endcord];
    3680. 

  3680. 		next if $start !~ /[0-9]+/ || $end !~ /[0-9]+/;
    3681. 

  3681. 	#		print " starts >>> start: $start = $fields[11] - $fields[10] || $end = $fields[13] - $fields[10]\n";
    3682. 

  3682. 		push (@{$microstart{$start}},$line);
    3683. 

  3683. 		push (@{$microend{$end}},$line);	
    3684. 

  3684. 	}
    3685. 

  3685. 	my $firstflag = 'down';
    3686. 

  3686. 	while( my $line =shift(@microstring)){
    3687. 

  3687. #		print "-----------\nline = $line \n" if $printer == 1;
    3688. 

  3688. 		chomp $line;
    3689. 

  3689. 		my @fields = split(/\t/,$line);
    3690. 

  3690. 		my $start = $fields[$startcord];
    3691. 

  3691. 		my $end = $fields[$endcord];
    3692. 

  3692. 		next if $start !~ /[0-9]+/ || $end !~ /[0-9]+/ || $distance !~ /[0-9]+/ ;
    3693. 

  3693. 		my $startmicro = $line;
    3694. 

  3694. 		my $endmicro = $line;
    3695. 

  3695. #		print "start: $start = $fields[11] - $fields[10] || $end = $fields[13] - $fields[10]\n";
    3696. 

  3696. 

  3697. 		delete ($microstart{$start});
    3698. 

  3698. 		delete ($microend{$end});
    3699. 

  3699. 		my $flag = 'down';	
    3700. 

  3700. 		my $startflag = 'down';
    3701. 

  3701. 		my $endflag = 'down';
    3702. 

  3702. 		my $prestart = $start - $distance;
    3703. 

  3703. 		my $postend = $end + $distance;
    3704. 

  3704. 		my @compoundlines = ();
    3705. 

  3705. 		my %compoundhash = ();
    3706. 

  3706. 		push (@compoundlines, $line);
    3707. 

  3707. 		push (@{$compoundhash{$line}},$line);
    3708. 

  3708. 		my $startrank = 1;
    3709. 

  3709. 		my $endrank = 1;
    3710. 

  3710. 

  3711. 		while( ($startflag eq "down") || ($endflag eq "down") ){
    3712. 

  3712. #			print "prestart=$prestart, post end =$postend.. seqlen =", length($sequence)," firstflag = $firstflag \n" if $printer == 1;
    3713. 

  3713. 			if ( (($prestart < 0) && $firstflag eq "up") || (($postend > length($sequence) && $firstflag eq "up")) ){
    3714. 

  3714. #				print "coming to the end of sequence,post end = $postend and sequence length =", length($sequence)," so exiting\n" if $printer == 1;
    3715. 

  3715. 				last;
    3716. 

  3716. 			}
    3717. 

  3717. 			
    3718. 

  3718. 			$firstflag = "up";
    3719. 

  3719. 			if ($startflag eq "down"){		
    3720. 

  3720. 				for my $i ($prestart ... $end){
    3721. 

  3721. 					if(exists $microend{$i}){	
    3722. 

  3722. 						chomp $microend{$i}[0];
    3723. 

  3723. 						if(exists $compoundhash{$microend{$i}[0]}) {next;}
    3724. 

  3724. 							chomp $microend{$i}[0];
    3725. 

  3725. 							push(@compoundlines, $microend{$i}[0]);
    3726. 

  3726. 							my @tields = split(/\t/,$microend{$i}[0]);
    3727. 

  3727. 							$startmicro = $microend{$i}[0];
    3728. 

  3728. 							chomp $startmicro;
    3729. 

  3729. 							$flag = 'down';
    3730. 

  3730. 							$startrank++;
    3731. 

  3731. #							print "deleting $microend{$i}[0] and $microstart{$tields[$startcord]}[0]\n" if $printer == 1;
    3732. 

  3732. 							delete $microend{$i};
    3733. 

  3733. 							delete $microstart{$tields[$startcord]};
    3734. 

  3734. 							$end = $tields[$endcord];
    3735. 

  3735. 							$startflag = 'down';
    3736. 

  3736. 							$prestart = $tields[$startcord] - $distance;
    3737. 

  3737. 							last;
    3738. 

  3738. 					}
    3739. 

  3739. 					else{
    3740. 

  3740. 						$flag = 'up';
    3741. 

  3741. 						$startflag = 'up';
    3742. 

  3742. 					}
    3743. 

  3743. 				}
    3744. 

  3744. 			}
    3745. 

  3745. 	
    3746. 

  3746. 			if ($endflag eq "down"){	
    3747. 

  3747. 

  3748. 				for my $i ($start ... $postend){
    3749. 

  3749. #					print "$start ----> $i -----> $postend\n" if $printer == 1;
    3750. 

  3750. 					if(exists $microstart{$i} ){
    3751. 

  3751. 						chomp $microstart{$i}[0];
    3752. 

  3752. 						if(exists $compoundhash{$microstart{$i}[0]}) {next;}	
    3753. 

  3753. 							chomp $microstart{$i}[0];
    3754. 

  3754. 							push(@compoundlines, $microstart{$i}[0]);
    3755. 

  3755. 							my @tields = split(/\t/,$microstart{$i}[0]);
    3756. 

  3756. 							$endmicro = $microstart{$i}[0];
    3757. 

  3757. 							$endrank++;
    3758. 

  3758. 							chomp $endmicro;
    3759. 

  3759. 							$flag = 'down';
    3760. 

  3760. #							print "deleting $microend{$tields[$endcord]}[0]\n" if $printer == 1;
    3761. 

  3761. 							
    3762. 

  3762. 							delete $microstart{$i} if exists $microstart{$i} ;
    3763. 

  3763. 							delete $microend{$tields[$endcord]} if exists $microend{$tields[$endcord]};
    3764. 

  3764. #							print "done\n" if $printer == 1;
    3765. 

  3765. 							
    3766. 

  3766. 							shift @microstring;
    3767. 

  3767. 							$end = $tields[$endcord];
    3768. 

  3768. 							$postend = $tields[$endcord] + $distance;
    3769. 

  3769. 							$endflag = 'down';
    3770. 

  3770. 							last;								
    3771. 

  3771. 					}
    3772. 

  3772. 					else{
    3773. 

  3773. 						$flag = 'up';
    3774. 

  3774. 						$endflag = 'up';
    3775. 

  3775. 					}
    3776. 

  3776. #					print "out of the if\n" if $printer == 1;
    3777. 

  3777. 				}
    3778. 

  3778. #				print "out of the for\n" if $printer == 1;
    3779. 

  3779. 

  3780. 			}
    3781. 

  3781. #			print "for next turn, flag status: startflag = $startflag and endflag = $endflag \n";
    3782. 

  3782. 		} 														#end while( $flag eq "down")
    3783. 

  3783. #			print "compoundlines = @compoundlines \n" if $printer == 1;
    3784. 

  3784. 

  3785. 		if (scalar (@compoundlines) == 1){
    3786. 

  3786. 			push(@nonmerged, $line);		
    3787. 

  3787. 

  3788. 		}
    3789. 

  3789. 		if (scalar (@compoundlines) > 1){
    3790. 

  3790. #			print "FROM CLUSTERER\n"  if $printer == 1;
    3791. 

  3791. 			push(@mergedSet,merge_microsats(@compoundlines, $sequence) );
    3792. 

  3792. 		}
    3793. 

  3793. 	} #end foreach my $line (@microstring){
    3794. 

  3794. #	print join("\n",@mergedSet),"<-----mergedSet\n"  if $printer == 1;
    3795. 

  3795. #<STDIN> if scalar(@mergedSet) > 0;
    3796. 

  3796. #	print "EXIT: find_clusters\n";
    3797. 

  3797. return (join("_X0X_",@nonmerged). "=".join("_X0X_",@mergedSet));
    3798. 

  3798. }
    3799. 

  3799. 

  3800. sub custom {
    3801. 

  3801. 	$a->[$startcord+1] <=> $b->[$startcord+1];
    3802. 

  3802. }
    3803. 

  3803. 

  3804. sub popOuter {
    3805. 

  3805. #	print "\nIN: popOuter @_\n"; <STDIN>;
    3806. 

  3806. 	my @all = split ("_X0X_",$_[0]);
    3807. 

  3807. #	<STDIN> if !defined $_[0];
    3808. 

  3808. 	my @merged = split ("_X0X_",$_[1]);
    3809. 

  3809. 	my $sequence = $_[2];
    3810. 

  3810. 	my $seqlen = length($sequence);
    3811. 

  3811. 	my %microstart=();
    3812. 

  3812. 	my %microend=();
    3813. 

  3813. 	my @mergedSet = ();
    3814. 

  3814. 	my @nonmerged = ();
    3815. 

  3815. 	
    3816. 

  3816. 	foreach my $line (@all){
    3817. 

  3817. 		my @fields = split(/\t/,$line);
    3818. 

  3818. 		my $start = $seqlen - $fields[$startcord]+ 1;
    3819. 

  3819. 		my $end = $seqlen - $fields[$endcord] + 1;
    3820. 

  3820. 		push (@{$microstart{$start}},$line);
    3821. 

  3821. 		push (@{$microend{$end}},$line);	
    3822. 

  3822. 	}
    3823. 

  3823. 	my $firstflag = 'down';
    3824. 

  3824. 	my %forPopouting = ();
    3825. 

  3825. 

  3826. 	while( my $line =shift(@merged)){
    3827. 

  3827. 	#	print "\n MErgedline: $line .. startcord = $startcord  ... endcord = $endcord\n" ;
    3828. 

  3828. 		chomp $line;
    3829. 

  3829. 		my @fields = split(/\t/,$line);
    3830. 

  3830. 		my $start = $fields[$startcord];
    3831. 

  3831. 		my $end = $fields[$endcord];
    3832. 

  3832. 		my $startmicro = $line;
    3833. 

  3833. 		my $endmicro = $line;
    3834. 

  3834. 		
    3835. 

  3835. 		
    3836. 

  3836. 		delete ($microstart{$start});
    3837. 

  3837. 		delete ($microend{$end});
    3838. 

  3838. 		my $flag = 'down';	
    3839. 

  3839. 		my $startflag = 'down';
    3840. 

  3840. 		my $endflag = 'down';
    3841. 

  3841. 		my $prestart = $start - $distance;
    3842. 

  3842. 		my $postend = $end + $distance;
    3843. 

  3843. 		my @compoundlines = ();
    3844. 

  3844. 		my %compoundhash = ();
    3845. 

  3845. 		push (@compoundlines, $line);
    3846. 

  3846. 		my $startrank = 1;
    3847. 

  3847. 		my $endrank = 1;
    3848. 

  3848. 		
    3849. 

  3849. 	#	print "\nstart = $start, end = $end\n";
    3850. 

  3850. 	#	<STDIN>;
    3851. 

  3851. 		for my $i ($start ... $end){
    3852. 

  3852. 			if(exists $microend{$i}){	
    3853. 

  3853. 		#		print "\nmicrosat exists: $microend{$i}[0] microsat exists\n"; 
    3854. 

  3854. 				chomp $microend{$i}[0];
    3855. 

  3855. 				my @fields = split(/\t/,$microend{$i}[0]);
    3856. 

  3856. 				delete $microstart{$seqlen - $fields[$startcord] + 1};
    3857. 

  3857. 				my $invertseq = $sequence;
    3858. 

  3858. 				$invertseq =~ s/ //g;
    3859. 

  3859. 				push(@compoundlines, invert_microsat($microend{$i}[0] , $invertseq ));
    3860. 

  3860. 				delete $microend{$i};
    3861. 

  3861. 				
    3862. 

  3862. 			}
    3863. 

  3863. 

  3864. 			if(exists $microstart{$i} ){
    3865. 

  3865. 		#		print "\nmicrosat exists: $microstart{$i}[0] microsat exists\n"; 
    3866. 

  3866. 

  3867. 				chomp $microstart{$i}[0];
    3868. 

  3868. 				my @fields = split(/\t/,$microstart{$i}[0]);
    3869. 

  3869. 				delete $microend{$seqlen - $fields[$endcord] + 1};
    3870. 

  3870. 				my $invertseq = $sequence;
    3871. 

  3871. 				$invertseq =~ s/ //g;
    3872. 

  3872. 				push(@compoundlines, invert_microsat($microstart{$i}[0], $invertseq) );						
    3873. 

  3873. 				delete $microstart{$i};
    3874. 

  3874. 			}
    3875. 

  3875. 		}			
    3876. 

  3876. 	
    3877. 

  3877. 		if (scalar (@compoundlines) == 1){
    3878. 

  3878. 			push(@mergedSet,join("\t",@compoundlines) );
    3879. 

  3879. 		}
    3880. 

  3880. 		else {
    3881. 

  3881. #			print "FROM POPOUTER\n" if $printer == 1;
    3882. 

  3882. 			push(@mergedSet, merge_microsats(@compoundlines, $sequence) );
    3883. 

  3883. 		}
    3884. 

  3884. 	} 
    3885. 

  3885. 	
    3886. 

  3886. 	foreach my $key (sort keys %microstart) {
    3887. 

  3887.     	push(@nonmerged,$microstart{$key}[0]);
    3888. 

  3888. 	}
    3889. 

  3889. 	
    3890. 

  3890. 	return (join("_X0X_",@nonmerged). "=".join("_X0X_",@mergedSet) );
    3891. 

  3891. }
    3892. 

  3892. 

  3893. 

  3894. 

  3895. sub invert_justCoordinates{
    3896. 

  3896. 	my $microsat = $_[0];
    3897. 

  3897. #	print "IN invert_justCoordinates ... @_\n" ; <STDIN>;
    3898. 

  3898. 	chomp $microsat;
    3899. 

  3899. 	my $seqLength = $_[1];
    3900. 

  3900. 	my @fields = split(/\t/,$microsat);
    3901. 

  3901. 	my $start = $seqLength - $fields[$endcord] + 1;
    3902. 

  3902. 	my $end = $seqLength - $fields[$startcord] + 1;
    3903. 

  3903. 	$fields[$startcord] = $start;
    3904. 

  3904. 	$fields[$endcord] = $end;
    3905. 

  3905. 	$fields[$microsatcord] = reverse_micro($fields[$microsatcord]);
    3906. 

  3906. #	print "RETURNIG: ", join("\t",@fields), "\n" if $printer == 1;
    3907. 

  3907. 	return join("\t",@fields); 	
    3908. 

  3908. }
    3909. 

  3909. 

  3910. sub largest_number{
    3911. 

  3911. 	my $counter = 0;
    3912. 

  3912. 	my($max) = shift(@_);
    3913. 

  3913.     foreach my $temp (@_) {
    3914. 

  3914.     	#print "finding largest array: $maxcounter \n";
    3915. 

  3915.     	if($temp > $max){
    3916. 

  3916.         	$max = $temp;
    3917. 

  3917.         }
    3918. 

  3918.     }
    3919. 

  3919.     return($max);
    3920. 

  3920. }
    3921. 

  3921. sub smallest_number{
    3922. 

  3922. 	my $counter = 0;
    3923. 

  3923. 	my($min) = shift(@_);
    3924. 

  3924.     foreach my $temp (@_) {
    3925. 

  3925.     	#print "finding largest array: $maxcounter \n";
    3926. 

  3926.     	if($temp < $min){
    3927. 

  3927.         	$min = $temp;
    3928. 

  3928.         }
    3929. 

  3929.     }
    3930. 

  3930.     return($min);
    3931. 

  3931. }
    3932. 

  3932. 

  3933. 

  3934. sub filterDuplicates_merged{
    3935. 

  3935. 	my @merged = @_;
    3936. 

  3936. 	my %revmerged = ();
    3937. 

  3937. 	my @fmerged = ();
    3938. 

  3938. 	foreach my $micro (@merged) {
    3939. 

  3939. 		my @fields = split(/\t/,$micro);
    3940. 

  3940. 		if ($fields[3] =~ /chr[A-Z0-9a-z]+r/){
    3941. 

  3941. 			my $key = join("_K0K_",$fields[1], $fields[$startcord], $fields[$endcord]);
    3942. 

  3942. 	#		print "adding  ... \n$key\n$micro\n";
    3943. 

  3943. 			push(@{$revmerged{$key}}, $micro);
    3944. 

  3944. 		}
    3945. 

  3945. 		else{
    3946. 

  3946. 		#	print "pushing.. $micro\n";
    3947. 

  3947. 			push(@fmerged, $micro);
    3948. 

  3948. 		}
    3949. 

  3949. 	}
    3950. 

  3950. #	print "\n";
    3951. 

  3951. 	foreach my $micro (@fmerged) {
    3952. 

  3952. 			my @fields = split(/\t/,$micro);
    3953. 

  3953. 			my $key = join("_K0K_",$fields[1], $fields[$startcord], $fields[$endcord]);
    3954. 

  3954. 	#		print "searching for key $key\n";
    3955. 

  3955. 			if (exists $revmerged{$key}){
    3956. 

  3956. 		#		print "deleting $revmerged{$key}[0]\n";
    3957. 

  3957. 				delete $revmerged{$key};
    3958. 

  3958. 			}
    3959. 

  3959. 	}
    3960. 

  3960. 	foreach my $key (sort keys %revmerged) {
    3961. 

  3961.     	push(@fmerged,$revmerged{$key}[0]);
    3962. 

  3962. 	}
    3963. 

  3963. #	print "returning ", join("\n", @fmerged),"\n" ;
    3964. 

  3964. 	return join("__", @fmerged);
    3965. 

  3965. }
    3966. 

  3966. 

  3967. sub invert_microsat{
    3968. 

  3968. 	my $micro = $_[0];
    3969. 

  3969. 	chomp $micro;
    3970. 

  3970. 	if ($micro =~ /chr[A-Z0-9a-z]+r/) { $micro =~  s/chr([0-9a-b]+)r/chr$1/g ;}
    3971. 

  3971. 	else {  $micro =~  s/chr([0-9a-b]+)/chr$1r/g ; }
    3972. 

  3972. 	my $sequence = $_[1];
    3973. 

  3973. 	$sequence =~ s/ //g;
    3974. 

  3974. 	my $seqlen = length($sequence);
    3975. 

  3975. 	my @fields = split(/\t/,$micro);
    3976. 

  3976. 	my $start = $seqlen - $fields[$endcord] +1;
    3977. 

  3977. 	my $end = $seqlen - $fields[$startcord] +1;
    3978. 

  3978. 	$fields[$startcord]  = $start;
    3979. 

  3979. 	$fields[$endcord] = $end;
    3980. 

  3980. 	$fields[$motifcord] = reverse_micro($fields[$motifcord]);
    3981. 

  3981. 	$fields[$microsatcord] = reverse_micro($fields[$microsatcord]);
    3982. 

  3982. 	if ($fields[$typecord] ne "compound" && exists $fields[$no_of_interruptionscord] ){
    3983. 

  3983. 		my @intertypes = split(/,/,$fields[$interrtypecord]);
    3984. 

  3984. 		my @inters = split(/,/,$fields[$interrcord]);
    3985. 

  3985. 		my @interposes = split(/,/,$fields[$interr_poscord]);
    3986. 

  3986. 		$fields[$interrtypecord] = join(",",reverse(@intertypes));
    3987. 

  3987. 		$fields[$no_of_interruptionscord] = scalar(@interposes);
    3988. 

  3988. 		for my $i (0 ... $fields[$no_of_interruptionscord]-1){
    3989. 

  3989. 			if (exists $inters[$i] && $inters[$i] =~ /[a-zA-Z]/){
    3990. 

  3990. 				$inters[$i] = reverse($inters[$i]);
    3991. 

  3991. 				$interposes[$i] = $interposes[$i] + length($inters[$i]) - 1;
    3992. 

  3992. 			}	
    3993. 

  3993. 			else{
    3994. 

  3994. 				$inters[$i] = "";
    3995. 

  3995. 				$interposes[$i] = $interposes[$i] - 1;
    3996. 

  3996. 			}
    3997. 

  3997. 			$interposes[$i] = ($end - $start + 1) - $interposes[$i] + 1;
    3998. 

  3998. 		}
    3999. 

  3999. 		
    4000. 

  4000. 		$fields[$interrcord] = join(",",reverse(@inters));
    4001. 

  4001. 		$fields[$interr_poscord] = join(",",reverse(@interposes));
    4002. 

  4002. 	}
    4003. 

  4003. 	
    4004. 

  4004. 	my $finalmicrosat = join("\t", @fields);
    4005. 

  4005. 	return $finalmicrosat;			
    4006. 

  4006. 

  4007. }
    4008. 

  4008. sub reverse_micro{
    4009. 

  4009. 	my $micro = reverse($_[0]);
    4010. 

  4010. 	my @strand = split(/\s*/,$micro);
    4011. 

  4011. 	for my $i (0 ... $#strand){
    4012. 

  4012. 		if ($strand[$i] =~ /\[/i) {$strand[$i] = "]";next;}
    4013. 

  4013. 		if ($strand[$i] =~ /\]/i) {$strand[$i] = "[";next;}
    4014. 

  4014. 	}
    4015. 

  4015. 	return join("",@strand);
    4016. 

  4016. }
    4017. 

  4017. 

  4018. #xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx  merge_interruptedMicrosats xxxxxxxxxxxxxx  merge_interruptedMicrosats xxxxxxxxxxxxxx 
    4019. 

  4019. 

  4020. 

  4021. #xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx  forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx  forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx 
    4022. 

  4022. 

  4023. sub forward_reverse_sputoutput_comparer	{
    4024. 

  4024. #	print "IN forward_reverse_sputoutput_comparer: @_\n";
    4025. 

  4025. 	my $input0 = $_[0];  ###### the *nogap_unrand_match file
    4026. 

  4026. 	my $input1 = $_[1];  ###### the real file, *sput* data
    4027. 

  4027. 	my $input2 = $_[2];  ###### the reverse file, *sput* data
    4028. 

  4028. 	my $output1 = $_[3]; ###### microsats different in real file
    4029. 

  4029. 	my $output2 = $_[4]; ###### microsats missing in real file
    4030. 

  4030. 	my $output3 = $_[5]; ###### microsats common among real and reverse file
    4031. 

  4031. 	my $no_of_species = $_[6];
    4032. 

  4032. 	
    4033. 

  4033. 	$infocord = 2 + (4*$no_of_species) - 1;
    4034. 

  4034. 	$typecord = 2 + (4*$no_of_species) + 1 - 1;
    4035. 

  4035. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    4036. 

  4036. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    4037. 

  4037. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    4038. 

  4038. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    4039. 

  4039. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    4040. 

  4040. 	$sequencepos = 2 + (5*$no_of_species) + 1 -1 ; 
    4041. 

  4041. 	$interrtypecord = $motifcord + 1;
    4042. 

  4042. 	$interrcord = $motifcord + 2;
    4043. 

  4043. 	$interr_poscord = $motifcord + 3;
    4044. 

  4044. 	$no_of_interruptionscord = $motifcord + 4;
    4045. 

  4045. 	$mergestarts  = $no_of_interruptionscord+ 1;
    4046. 

  4046. 	$mergeends = $no_of_interruptionscord+ 2;
    4047. 

  4047. 	$mergemicros = $no_of_interruptionscord+ 3;
    4048. 

  4048. 	
    4049. 

  4049. 	
    4050. 

  4050. 	open(SEQ,"<$input0") or die "Cannot open file $input0 $!";
    4051. 

  4051. 	open(INF,"<$input1") or die "Cannot open file $input1 $!";
    4052. 

  4052. 	open(INR,"<$input2") or die "Cannot open file $input2 $!";
    4053. 

  4053. 	
    4054. 

  4054. 	open(DIFF,">$output1") or die "Cannot open file $output1 $!";
    4055. 

  4055. 	#open(MISS,">$output2") or die "Cannot open file $output2 $!";
    4056. 

  4056. 	open(SAME,">$output3") or die "Cannot open file $output3 $!";
    4057. 

  4057. 		
    4058. 

  4058. 		
    4059. 

  4059. #	print "opened files \n";
    4060. 

  4060. 	my $linecounter = 0;
    4061. 

  4061. 	my $fcounter = 0;
    4062. 

  4062. 	my $rcounter = 0;
    4063. 

  4063. 	
    4064. 

  4064. 	$printer = 0;
    4065. 

  4065. 	#---------------------------------------------------------------------------------------------------
    4066. 

  4066. 	# NOW ADDING FORWARD MICROSATELLITES TO HASH
    4067. 

  4067. 	my %fmicros = ();
    4068. 

  4068. 	my $microcounter=0;
    4069. 

  4069. 	while (my $line = <INF>){
    4070. 

  4070. 		$linecounter++;
    4071. 

  4071. 		if ($line =~ /([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    4072. 

  4072. 			my $key = join("\t",$1, $3, $4, $5, $7, $8, $9, $11, $12);
    4073. 

  4073. 		#	print $key, "#-#-#-#-#-#-#-#\n";
    4074. 

  4074. 			push (@{$fmicros{$key}},$line);	
    4075. 

  4075. 			$microcounter++;
    4076. 

  4076. 		}
    4077. 

  4077. 		else {
    4078. 

  4078. 		#print $line;
    4079. 

  4079. 		}
    4080. 

  4080. 	}
    4081. 

  4081. #	print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
    4082. 

  4082. 	close INF;
    4083. 

  4083. 	my @deletedlines = ();
    4084. 

  4084. #	print "done forward hash \n";
    4085. 

  4085. 	$linecounter = 0;
    4086. 

  4086. 	#---------------------------------------------------------------------------------------------------
    4087. 

  4087. 	# NOW ADDING REVERSE MICROSATELLITES TO HASH
    4088. 

  4088. 	my %rmicros = ();
    4089. 

  4089. 	$microcounter=0;
    4090. 

  4090. 	while (my $line = <INR>){
    4091. 

  4091. 		$linecounter++;
    4092. 

  4092. 		if ($line =~ /([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    4093. 

  4093. 			my $key = join("\t",$1, $3, $4, $5, $7, $8, $9, $11, $12);
    4094. 

  4094. 		#	print $key, "#-#-#-#-#-#-#-#\n";
    4095. 

  4095. 			push (@{$rmicros{$key}},$line);	
    4096. 

  4096. 			$microcounter++;
    4097. 

  4097. 		}
    4098. 

  4098. 		else {}
    4099. 

  4099. 	}
    4100. 

  4100. #	print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
    4101. 

  4101. 	close INR;
    4102. 

  4102. #	print "done reverse hash \n";
    4103. 

  4103. 	$linecounter = 0;
    4104. 

  4104. 	#---------------------------------------------------------------------------------------------------
    4105. 

  4105. 	#---------------------------------------------------------------------------------------------------
    4106. 

  4106. 	# NOW READING THE SEQUENCE FILE
    4107. 

  4107. 	while(my $sine = <SEQ>){
    4108. 

  4108. 		my %microstart=();
    4109. 

  4109. 		my %microend=();
    4110. 

  4110. 		my @sields = split(/\t/,$sine);
    4111. 

  4111. 		my $key = ();
    4112. 

  4112. 		if ($sine =~ /([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s[\+|\-]\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s[\+|\-]\s([0-9a-zA-Z]+)\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    4113. 

  4113. 			$key = join("\t",$1, $3, $4, $5, $7, $8, $9, $11, $12);
    4114. 

  4114. 		}
    4115. 

  4115. 		else {
    4116. 

  4116. 			next;
    4117. 

  4117. 		}
    4118. 

  4118. 		$printer = 0;
    4119. 

  4119. 		my $sequence = $sields[$sequencepos];
    4120. 

  4120. 		chomp $sequence;
    4121. 

  4121. 		$sequence =~ s/ //g;
    4122. 

  4122. 		my @localfs = ();
    4123. 

  4123. 		my @localrs = ();
    4124. 

  4124. 		
    4125. 

  4125. 		if (exists $fmicros{$key}){
    4126. 

  4126. 			@localfs = @{$fmicros{$key}};
    4127. 

  4127. 			delete $fmicros{$key};		
    4128. 

  4128. 		}
    4129. 

  4129. 	
    4130. 

  4130. 		my %forwardstarts = ();
    4131. 

  4131. 		my %forwardends = ();
    4132. 

  4132. 	
    4133. 

  4133. 		foreach my $f (@localfs){
    4134. 

  4134. 			my @fields = split(/\t/,$f);
    4135. 

  4135. 			push (@{$forwardstarts{$fields[$startcord]}},$f);
    4136. 

  4136. 			push (@{$forwardends{$fields[$endcord]}},$fields[$startcord]);
    4137. 

  4137. 		}
    4138. 

  4138. 	
    4139. 

  4139. 		if (exists $rmicros{$key}){
    4140. 

  4140. 			@localrs = @{$rmicros{$key}};
    4141. 

  4141. 			delete $rmicros{$key};		
    4142. 

  4142. 		}
    4143. 

  4143. 		else{
    4144. 

  4144. 		}
    4145. 

  4145. 	
    4146. 

  4146. 		foreach my $r (@localrs){
    4147. 

  4147. 			chomp $r;
    4148. 

  4148. 			my @rields = split(/\t/,$r);
    4149. 

  4149. #			print "rields = @rields\n" if $printer == 1;
    4150. 

  4150. 			my $reciprocalstart = length($sequence) - $rields[$endcord] + 1;
    4151. 

  4151. 			my $reciprocalend = length($sequence) - $rields[$startcord] + 1;
    4152. 

  4152. #			print "reciprocal start = $reciprocalstart = ",length($sequence)," - $rields[$endcord] + 1\n" if $printer == 1;
    4153. 

  4153. 			my $microsat = reverse_micro(all_caps($rields[$microsatcord]));
    4154. 

  4154. 			my @localcollection=();
    4155. 

  4155. 			for my $i ($reciprocalstart+1 ... $reciprocalend-1){
    4156. 

  4156. 				if (exists $forwardstarts{$i}){
    4157. 

  4157. 					push(@localcollection, $forwardstarts{$i}[0] );
    4158. 

  4158. 					delete $forwardstarts{$i}; 
    4159. 

  4159. 				}
    4160. 

  4160. 				if (exists $forwardends{$i}){
    4161. 

  4161. 					next if !exists $forwardstarts{$forwardends{$i}[0]};
    4162. 

  4162. 					push(@localcollection, $forwardstarts{$forwardends{$i}[0]}[0] );
    4163. 

  4163. 				}
    4164. 

  4164. 			}
    4165. 

  4165. 			if (exists $forwardstarts{$reciprocalstart} && exists $forwardends{$reciprocalend}) {push(@localcollection,$forwardstarts{$reciprocalstart}[0]);}
    4166. 

  4166. 			
    4167. 

  4167. 			if (scalar(@localcollection) == 0){
    4168. 

  4168. 				print SAME invert_microsat($r,($sequence) ), "\n";
    4169. 

  4169. 			}
    4170. 

  4170. 	
    4171. 

  4171. 			elsif (scalar(@localcollection) == 1){
    4172. 

  4172. #				print "f microsat = $localcollection[0]\n"  if $printer == 1;
    4173. 

  4173. 				my @lields = split(/\t/,$localcollection[0]);
    4174. 

  4174. 				$lields[$microsatcord]=all_caps($lields[$microsatcord]);
    4175. 

  4175. #				print "comparing: $microsat and $lields[$microsatcord]\n" if $printer == 1;
    4176. 

  4176. #				print "coordinates are: $lields[$startcord]-$lields[$endcord] and $reciprocalstart-$reciprocalend\n" if $printer == 1;
    4177. 

  4177. 				if ($microsat eq $lields[$microsatcord]){
    4178. 

  4178. 					chomp $localcollection[0];
    4179. 

  4179. 					print SAME $localcollection[0], "\n";
    4180. 

  4180. 				}
    4181. 

  4181. 				if ($microsat ne $lields[$microsatcord]){
    4182. 

  4182. 					chomp $localcollection[0];
    4183. 

  4183. 					my $newmicro = microsatChooser(join("\t",@lields), join("\t",@rields), $sequence);
    4184. 

  4184. #					print "newmicro = $newmicro\n"  if $printer == 1;
    4185. 

  4185. 					if ($newmicro =~ /[a-zA-Z]/){
    4186. 

  4186. 						print SAME $newmicro,"\n";
    4187. 

  4187. 					}
    4188. 

  4188. 					else{
    4189. 

  4189. 					print DIFF join("\t",$localcollection[0],"-->",$rields[$typecord],$reciprocalstart,$reciprocalend, $rields[$microsatcord], reverse_micro($rields[$motifcord]), @rields[$motifcord+1 ... $#rields] ),"\n";
    4190. 

  4190. #					print join("\t",$localcollection[0],"-->",$rields[$typecord],$reciprocalstart,$reciprocalend, $rields[$microsatcord], reverse_micro($rields[$motifcord]), @rields[$motifcord+1 ... $#rields] ),"\n" if $printer == 1;
    4191. 

  4191. #					print "@rields\n@lields\n" if $printer == 1;
    4192. 

  4192. 					}
    4193. 

  4193. 				}			
    4194. 

  4194. 			}
    4195. 

  4195. 			else{
    4196. 

  4196. #				print "multiple found for $r --> ", join("\t",@localcollection),"\n" if $printer == 1;
    4197. 

  4197. 			}
    4198. 

  4198. 		}
    4199. 

  4199. 	}	
    4200. 

  4200. 		
    4201. 

  4201. 	close(SEQ);
    4202. 

  4202. 	close(INF);
    4203. 

  4203. 	close(INR);
    4204. 

  4204. 	close(DIFF);
    4205. 

  4205. 	close(SAME);
    4206. 

  4206. 	
    4207. 

  4207. }
    4208. 

  4208. sub all_caps{
    4209. 

  4209. 	my @strand = split(/\s*/,$_[0]);
    4210. 

  4210. 	for my $i (0 ... $#strand){
    4211. 

  4211. 		if ($strand[$i] =~ /c/) {$strand[$i] = "C";next;}
    4212. 

  4212. 		if ($strand[$i] =~ /a/) {$strand[$i] = "A";next;}
    4213. 

  4213. 		if ($strand[$i] =~ /t/) { $strand[$i] = "T";next;}
    4214. 

  4214. 		if ($strand[$i] =~ /g/) {$strand[$i] = "G";next;}
    4215. 

  4215. 	}
    4216. 

  4216. 	return join("",@strand);
    4217. 

  4217. }
    4218. 

  4218. sub microsatChooser{
    4219. 

  4219. 	my $forward = $_[0];
    4220. 

  4220. 	my $reverse = $_[1];
    4221. 

  4221. 	my $sequence = $_[2];
    4222. 

  4222. 	my $seqLength = length($sequence);
    4223. 

  4223. 	$sequence =~ s/ //g;
    4224. 

  4224. 	my @fields = split(/\t/,$forward);
    4225. 

  4225. 	my @rields = split(/\t/,$reverse);	
    4226. 

  4226. 	my $r_start = $seqLength - $rields[$endcord] + 1;
    4227. 

  4227. 	my $r_end = $seqLength - $rields[$startcord] + 1;
    4228. 

  4228. 	
    4229. 

  4229. 	
    4230. 

  4230. 	my $f_microsat = $fields[$microsatcord];
    4231. 

  4231. 	my $r_microsat = $rields[$microsatcord];
    4232. 

  4232. 	
    4233. 

  4233. 	if ($fields[$typecord] =~ /\./ && $rields[$typecord] =~ /\./) {
    4234. 

  4234. 		return $forward if length($f_microsat) >= length($r_microsat);
    4235. 

  4235. 		return invert_microsat($reverse, $sequence) if length($f_microsat) < length($r_microsat);
    4236. 

  4236. 	}
    4237. 

  4237. 	return $forward if all_caps($fields[$motifcord]) eq all_caps($rields[$motifcord]) && $fields[$startcord] == $rields[$startcord] && $fields[$endcord] == $rields[$endcord];	
    4238. 

  4238. 

  4239. 	my $f_microsat_copy = $f_microsat;
    4240. 

  4240. 	my $r_microsat_copy = $r_microsat;
    4241. 

  4241. 	$f_microsat_copy =~ s/^\[|\]$//g;
    4242. 

  4242. 	$r_microsat_copy =~ s/^\[|\]$//g;
    4243. 

  4243. 

  4244. 	my @f_microields = split(/\][a-zA-Z]*\[/,$f_microsat_copy);
    4245. 

  4245. 	my @r_microields = split(/\][a-zA-Z]*\[/,$r_microsat_copy);
    4246. 

  4246. 	my @f_intields = split(/\][a-zA-Z]*\[/,$f_microsat_copy);
    4247. 

  4247. 	my @r_intields = split(/\][a-zA-Z]*\[/,$r_microsat_copy);
    4248. 

  4248. 	
    4249. 

  4249. 	my $f_motif = $fields[$motifcord];
    4250. 

  4250. 	my $r_motif = $rields[$motifcord];
    4251. 

  4251. 	my $f_motif_copy = $f_motif;
    4252. 

  4252. 	my $r_motif_copy = $r_motif;
    4253. 

  4253. 	$f_motif_copy =~ s/^\[|\]$//g;
    4254. 

  4254. 	$r_motif_copy =~ s/^\[|\]$//g;
    4255. 

  4255. 

  4256. 	my @f_motields = split(/\]\[/,$f_motif_copy);
    4257. 

  4257. 	my @r_motields = split(/\]\[/,$r_motif_copy);
    4258. 

  4258. 

  4259. 	my $f_purestretch = join("",@f_microields);
    4260. 

  4260. 	my $r_purestretch = join("",@r_microields);
    4261. 

  4261. 

  4262. 	if ($fields[$typecord]=~/nucleotide/ && $rields[$typecord]=~/nucleotide/){
    4263. 

  4263. #		print "now.. studying $forward\n$reverse\n" if $printer == 1;
    4264. 

  4264. 		if ($fields[$typecord] eq $rields[$typecord]){
    4265. 

  4265. #			print "comparing motifs::", all_caps($fields[$motifcord]) ," and ", all_caps(reverse_micro($rields[$motifcord])), "\n" if $printer == 1;
    4266. 

  4266. 

  4267. 			if(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 1){
    4268. 

  4268. 				my $subset_answer = isSubset($forward, $reverse, $seqLength);
    4269. 

  4269. #				print "subset answer = $subset_answer\n" if $printer == 1;
    4270. 

  4270. 				return $forward if $subset_answer == 1; 
    4271. 

  4271. 				return invert_microsat($reverse, $sequence) if $subset_answer == 2; 
    4272. 

  4272. 				return $forward if $subset_answer == 0 && length($f_purestretch) >= length($r_purestretch);
    4273. 

  4273. 				return invert_microsat($reverse, $sequence) if $subset_answer == 0 && length($f_purestretch) < length($r_purestretch);
    4274. 

  4274. 				return $forward if $subset_answer == 3 && slided_microsat($forward, $reverse, $seqLength) == 0 && length($f_purestretch) >= length($r_purestretch);
    4275. 

  4275. 				return invert_microsat($reverse, $sequence) if $subset_answer == 3 && slided_microsat($forward, $reverse, $seqLength) == 0 && length($f_purestretch) < length($r_purestretch);
    4276. 

  4276. 				return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence) if $subset_answer == 3 ;			
    4277. 

  4277. 			}
    4278. 

  4278. 			elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 0){
    4279. 

  4279. 				return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4280. 

  4280. 			}
    4281. 

  4281. 			elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 2){
    4282. 

  4282. 				return $forward;
    4283. 

  4283. 			}
    4284. 

  4284. 			elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 3){
    4285. 

  4285. 				return invert_microsat($reverse, $sequence);
    4286. 

  4286. 			}
    4287. 

  4287. 		}
    4288. 

  4288. 		else{
    4289. 

  4289. 			my $fmotlen = ();
    4290. 

  4290. 			my $rmotlen = ();
    4291. 

  4291. 	 		$fmotlen =1 if $fields[$typecord] eq "mononucleotide";
    4292. 

  4292. 	 		$fmotlen =2 if $fields[$typecord] eq "dinucleotide";
    4293. 

  4293. 	 		$fmotlen =3 if $fields[$typecord] eq "trinucleotide";
    4294. 

  4294. 	 		$fmotlen =4 if $fields[$typecord] eq "tetranucleotide";
    4295. 

  4295. 	 		$rmotlen =1 if $rields[$typecord] eq "mononucleotide";
    4296. 

  4296. 	 		$rmotlen =2 if $rields[$typecord] eq "dinucleotide";
    4297. 

  4297. 	 		$rmotlen =3 if $rields[$typecord] eq "trinucleotide";
    4298. 

  4298. 	 		$rmotlen =4 if $rields[$typecord] eq "tetranucleotide";
    4299. 

  4299. 			
    4300. 

  4300. 			if ($fmotlen < $rmotlen){
    4301. 

  4301. 				if (abs($fields[$startcord] -  $r_start) <= $fmotlen || abs($fields[$endcord] -  $r_end) <= $fmotlen ){
    4302. 

  4302. 					return $forward;
    4303. 

  4303. 				}
    4304. 

  4304. 				else{
    4305. 

  4305. 					return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4306. 

  4306. 				}
    4307. 

  4307. 			}
    4308. 

  4308. 			if ($fmotlen > $rmotlen){
    4309. 

  4309. 				if (abs($fields[$startcord] -  $r_start) <= $rmotlen || abs($fields[$endcord] -  $r_end) <= $rmotlen){
    4310. 

  4310. 					return invert_microsat($reverse, $sequence);
    4311. 

  4311. 				}
    4312. 

  4312. 				else{
    4313. 

  4313. 					return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4314. 

  4314. 				}
    4315. 

  4315. 			}
    4316. 

  4316. 		}
    4317. 

  4317. 	}
    4318. 

  4318. 	if ($fields[$typecord] eq "compound" && $rields[$typecord] eq "compound"){
    4319. 

  4319. #			print "comparing compound motifs::", all_caps($fields[$motifcord]) ," and ", all_caps(reverse_micro($rields[$motifcord])), "\n" if $printer == 1;
    4320. 

  4320. 			if(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 1){
    4321. 

  4321. 				my $subset_answer = isSubset($forward, $reverse, $seqLength);
    4322. 

  4322. #				print "subset answer = $subset_answer\n" if $printer == 1;
    4323. 

  4323. 				return $forward if $subset_answer == 1; 
    4324. 

  4324. 				return invert_microsat($reverse, $sequence) if $subset_answer == 2; 
    4325. 

  4325. #				print length($f_purestretch) ,">", length($r_purestretch)," \n" if $printer == 1;
    4326. 

  4326. 				return $forward if $subset_answer == 0 && length($f_purestretch) >= length($r_purestretch);
    4327. 

  4327. 				return invert_microsat($reverse, $sequence) if $subset_answer == 0 && length($f_purestretch) < length($r_purestretch);
    4328. 

  4328. 				if ($subset_answer == 3){
    4329. 

  4329. 					if ($fields[$startcord] < $r_start || $fields[$endcord] > $r_end){
    4330. 

  4330. 						if (abs($fields[$startcord] -  $r_start) < length($f_motields[0]) || abs($fields[$endcord] -  $r_end)  < length($f_motields[$#f_motields]) ){
    4331. 

  4331. 							return $forward;
    4332. 

  4332. 						}
    4333. 

  4333. 						else{
    4334. 

  4334. 							return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4335. 

  4335. 						}
    4336. 

  4336. 					}
    4337. 

  4337. 					if ($fields[$startcord] > $r_start || $fields[$endcord] < $r_end){
    4338. 

  4338. 						if (abs($fields[$startcord] -  $r_start) < length($r_motields[0]) || abs($fields[$endcord] -  $r_end) < length($r_motields[$#r_motields]) ){
    4339. 

  4339. 							return invert_microsat($reverse, $sequence);
    4340. 

  4340. 						}
    4341. 

  4341. 						else{
    4342. 

  4342. 							return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4343. 

  4343. 						}
    4344. 

  4344. 					}
    4345. 

  4345. 				}
    4346. 

  4346. 			}
    4347. 

  4347. 			elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 0){
    4348. 

  4348. 				return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4349. 

  4349. 			}
    4350. 

  4350. 			elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 2){
    4351. 

  4351. 				return $forward;
    4352. 

  4352. 			}
    4353. 

  4353. 			elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 3){
    4354. 

  4354. 				return invert_microsat($reverse, $sequence);
    4355. 

  4355. 			}
    4356. 

  4356. 		
    4357. 

  4357. 	}
    4358. 

  4358. 	
    4359. 

  4359. 	if ($fields[$typecord] eq "compound" && $rields[$typecord] =~ /nucleotide/){
    4360. 

  4360. #		print "one compound, one nucleotide\n" if $printer == 1; 
    4361. 

  4361. 		return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4362. 

  4362. 	}
    4363. 

  4363. 	if ($fields[$typecord] =~ /nucleotide/ && $rields[$typecord]eq "compound"){
    4364. 

  4364. #		print "one compound, one nucleotide\n" if $printer == 1; 
    4365. 

  4365. 		return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
    4366. 

  4366. 	}
    4367. 

  4367. }
    4368. 

  4368. 

  4369. sub isSubset{
    4370. 

  4370. 	my $forward = $_[0]; 	my @fields = split(/\t/,$forward);
    4371. 

  4371. 	my $reverse = $_[1];	my @rields = split(/\t/,$reverse);
    4372. 

  4372. 	my $seqLength = $_[2];
    4373. 

  4373. 	my $r_start = $seqLength - $rields[$endcord] + 1;
    4374. 

  4374. 	my $r_end = $seqLength - $rields[$startcord] + 1;
    4375. 

  4375. #	print "we have $fields[$startcord] -> $fields[$endcord] && $r_start -> $r_end\n" if $printer == 1;
    4376. 

  4376. 	return "0" if $fields[$startcord] == $r_start && $fields[$endcord] == $r_end;
    4377. 

  4377. 	return "1" if $fields[$startcord] <= $r_start && $fields[$endcord] >= $r_end;
    4378. 

  4378. 	return "2" if $r_start <= $fields[$startcord] && $r_end >= $fields[$endcord];
    4379. 

  4379. 	return "3";
    4380. 

  4380. }
    4381. 

  4381. 

  4382. sub motifBYmotif_match{
    4383. 

  4383. 	my $forward = $_[0];
    4384. 

  4384. 	my $reverse = $_[1];
    4385. 

  4385. 	$forward =~ s/^\[|\]$//g;
    4386. 

  4386. 	$reverse =~ s/^\[|\]$//g;
    4387. 

  4387. 	my @f_motields=split(/\]\[/, $forward);
    4388. 

  4388. 	my @r_motields=split(/\]\[/, $reverse);
    4389. 

  4389. 	my $finalresult = 0;
    4390. 

  4390. 

  4391. 	if (scalar(@f_motields) != scalar(@r_motields)){
    4392. 

  4392. 		my $subresult = 0;
    4393. 

  4393. 		my @mega = (); my @sub = ();
    4394. 

  4394. 		@mega = @f_motields if scalar(@f_motields) > scalar(@r_motields);
    4395. 

  4395. 		@sub = @f_motields if scalar(@f_motields) > scalar(@r_motields);
    4396. 

  4396. 		@mega = @r_motields if scalar(@f_motields) < scalar(@r_motields);
    4397. 

  4397. 		@sub = @r_motields if scalar(@f_motields) < scalar(@r_motields);
    4398. 

  4398. 		
    4399. 

  4399. 		for my $i (0 ... $#sub){
    4400. 

  4400. 			my $probe = $sub[$i].$sub[$i];
    4401. 

  4401. #			print "probing $probe and $mega[$i]\n" if $printer == 1;
    4402. 

  4402. 			if ($probe =~ /$mega[$i]/) {$subresult = 1; }
    4403. 

  4403. 			else {$subresult = 0; last; }
    4404. 

  4404. 		}
    4405. 

  4405. 		
    4406. 

  4406. 		return 0 if $subresult == 0;
    4407. 

  4407. 		return 2 if $subresult == 1 && scalar(@f_motields) > scalar(@r_motields); # r is subset of f
    4408. 

  4408. 		return 3 if $subresult == 1 && scalar(@f_motields) < scalar(@r_motields);  # ^reverse
    4409. 

  4409. 		
    4410. 

  4410. 	}
    4411. 

  4411. 	else{
    4412. 

  4412. 		for my $i (0 ... $#f_motields){
    4413. 

  4413. 			my $probe = $f_motields[$i].$f_motields[$i];
    4414. 

  4414. 			if ($probe =~ /$r_motields[$i]/) {$finalresult = 1 ;}
    4415. 

  4415. 			else {$finalresult = 0 ;last;}
    4416. 

  4416. 		}
    4417. 

  4417. 	}
    4418. 

  4418. #	print "finalresult = $finalresult\n" if $printer == 1;
    4419. 

  4419. 	return $finalresult;
    4420. 

  4420. }
    4421. 

  4421. 

  4422. sub merge_microsats{
    4423. 

  4423. 	my @input = @_;
    4424. 

  4424. 	my $sequence = pop(@input);
    4425. 

  4425. 	$sequence =~ s/ //g;
    4426. 

  4426. 	my @seq_string = @input;
    4427. 

  4427. #	print "IN: merge_microsats\n";
    4428. 

  4428. #	print "recieved for merging: ", join("\n", @seq_string), "\nsequence = $sequence\n"; 
    4429. 

  4429. 	my $start;
    4430. 

  4430. 	my $end;
    4431. 

  4431. 	my @micros = map { $_->[0] } sort custom map { [$_, split /\t/ ] } @seq_string; 
    4432. 

  4432. #	print "\nrearranged into @micros \n";
    4433. 

  4433. 	my (@motifs, @microsats, @interruptiontypes, @interruptions, @interrposes, @no_of_interruptions, @types, @starts, @ends, @mergestart, @mergeend, @mergemicro) = ();
    4434. 

  4434. 	my @fields = ();
    4435. 

  4435. 	for my $i (0 ... $#micros){
    4436. 

  4436. 		chomp $micros[$i];
    4437. 

  4437. 		@fields = split(/\t/,$micros[$i]);
    4438. 

  4438. 		push(@types, $fields[$typecord]);
    4439. 

  4439. 		push(@motifs, $fields[$motifcord]);		
    4440. 

  4440. 

  4441. 		if (exists $fields[$interrtypecord]){ push(@interruptiontypes, $fields[$interrtypecord]);}
    4442. 

  4442. 			else { push(@interruptiontypes, "NA"); }
    4443. 

  4443. 		if (exists $fields[$interrcord]) {push(@interruptions, $fields[$interrcord]);}
    4444. 

  4444. 			else { push(@interruptions, "NA"); }
    4445. 

  4445. 		if (exists $fields[$interr_poscord]) { push(@interrposes, $fields[$interr_poscord]);}	
    4446. 

  4446. 			else { push(@interrposes, "NA"); }
    4447. 

  4447. 		if (exists $fields[$no_of_interruptionscord]) {push(@no_of_interruptions, $fields[$no_of_interruptionscord]);}
    4448. 

  4448. 			else { push(@no_of_interruptions, "NA"); }
    4449. 

  4449. 		if(exists $fields[$mergestarts]) { @mergestart = (@mergestart, split(/\./,$fields[$mergestarts]));}
    4450. 

  4450. 			else { push(@mergestart, $fields[$startcord]); }
    4451. 

  4451. 		if(exists $fields[$mergeends]) { @mergeend = (@mergeend, split(/\./,$fields[$mergeends]));}
    4452. 

  4452. 			else { push(@mergeend, $fields[$endcord]); }
    4453. 

  4453. 		if(exists $fields[$mergemicros]) { push(@mergemicro, $fields[$mergemicros]);}
    4454. 

  4454. 			else { push(@mergemicro, $fields[$microsatcord]); }
    4455. 

  4455. 			
    4456. 

  4456. 

  4457. 	}
    4458. 

  4458. 	$start = smallest_number(@mergestart);
    4459. 

  4459. 	$end = largest_number(@mergeend);
    4460. 

  4460. 	my $microsat_entry = "[".substr( $sequence, $start-1, ($end - $start + 1) )."]";
    4461. 

  4461. 	my $microsat = join("\t", @fields[0 ... $infocord], join(".", @types), $start, $fields[$strandcord], $end, $microsat_entry , join(".", @motifs), join(".", @interruptiontypes),join(".", @interruptions),join(".", @interrposes),join(".", @no_of_interruptions), join(".", @mergestart), join(".", @mergeend) , join(".", @mergemicro));
    4462. 

  4462. 	return $microsat;
    4463. 

  4463. }
    4464. 

  4464. 

  4465. sub slided_microsat{
    4466. 

  4466. 	my $forward = $_[0]; 	my @fields = split(/\t/,$forward);
    4467. 

  4467. 	my $reverse = $_[1];	my @rields = split(/\t/,$reverse);
    4468. 

  4468. 	my $seqLength = $_[2];
    4469. 

  4469. 	my $r_start = $seqLength - $rields[$endcord] + 1;
    4470. 

  4470. 	my $r_end = $seqLength - $rields[$startcord] + 1;
    4471. 

  4471. 	my $motlen =();
    4472. 

  4472. 	 $motlen =1 if $fields[$typecord] eq "mononucleotide";
    4473. 

  4473. 	 $motlen =2 if $fields[$typecord] eq "dinucleotide";
    4474. 

  4474. 	 $motlen =3 if $fields[$typecord] eq "trinucleotide";
    4475. 

  4475. 	 $motlen =4 if $fields[$typecord] eq "tetranucleotide";
    4476. 

  4476. 	
    4477. 

  4477. 	if (abs($fields[$startcord] - $r_start) < $motlen || abs($fields[$endcord] - $r_end) < $motlen ) {
    4478. 

  4478. 		return 0;
    4479. 

  4479. 	}
    4480. 

  4480. 	else{
    4481. 

  4481. 		return 1;
    4482. 

  4482. 	}
    4483. 

  4483. 	
    4484. 

  4484. }
    4485. 

  4485. 

  4486. #xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx  forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx  forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx 
    4487. 

  4487. 

  4488. 

  4489. 

  4490. #xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx  new_multispecies_t10 xxxxxxxxxxxxxx  new_multispecies_t10 xxxxxxxxxxxxxx 
    4491. 

  4491. sub new_multispecies_t10{
    4492. 

  4492. 	my $input1 = $_[0];  #gap_op_unrand_match
    4493. 

  4493. 	my $input2 = $_[1];  #sput
    4494. 

  4494. 	my $output = $_[2];  #output
    4495. 

  4495. 	my $bin = $output."_bin";
    4496. 

  4496. 	my $orgs = join("|",split(/\./,$_[3]));
    4497. 

  4497. 	my @organisms = split(/\./,$_[3]);
    4498. 

  4498. 	my $no_of_species = scalar(@organisms); #3
    4499. 

  4499. 	my $t10info = $output."_info";
    4500. 

  4500. 	$prinkter = 0;
    4501. 

  4501. 	
    4502. 

  4502. 	open (MATCH, "<$input1");
    4503. 

  4503. 	open (SPUT, "<$input2");
    4504. 

  4504. 	open (OUT, ">$output");
    4505. 

  4505. 	open (INFO, ">$t10info");
    4506. 

  4506. 

  4507. 

  4508. 	sub microsat_bracketer;
    4509. 

  4509. 	sub custom;
    4510. 

  4510. 	my %seen = ();
    4511. 

  4511. 	$infocord = 2 + (4*$no_of_species) - 1;
    4512. 

  4512. 	$typecord = 2 + (4*$no_of_species) + 1 - 1;
    4513. 

  4513. 	$startcord = 2 + (4*$no_of_species) + 2 - 1;
    4514. 

  4514. 	$strandcord = 2 + (4*$no_of_species) + 3 - 1;
    4515. 

  4515. 	$endcord = 2 + (4*$no_of_species) + 4 - 1;
    4516. 

  4516. 	$microsatcord = 2 + (4*$no_of_species) + 5 - 1;
    4517. 

  4517. 	$motifcord = 2 + (4*$no_of_species) + 6 - 1;
    4518. 

  4518. 	$sequencepos = 2 + (5*$no_of_species) + 1 -1 ; 
    4519. 

  4519. 	#---------------------------------------------------------------------------------------------------------------#
    4520. 

  4520. 	#	MAKING A HASH FROM SPUT, WITH HASH KEYS GENERATED BELOW AND SEQUENCES STORED AS VALUES	#
    4521. 

  4521. 	#---------------------------------------------------------------------------------------------------------------#
    4522. 

  4522. 	my $linecounter = 0;
    4523. 

  4523. 	my $microcounter = 0;
    4524. 

  4524. 	while (my $line = <SPUT>){
    4525. 

  4525. 		chomp $line;
    4526. 

  4526. 	#	print "$org\t(chr[0-9]+)\t([0-9]+)\t([0-9])+\t \n";
    4527. 

  4527. 		next if $line !~ /[0-9a-z]+/;
    4528. 

  4528. 		$linecounter++;
    4529. 

  4529. 	#		my $key = join("\t",$1 , $2, $4, $5, $6, $8, $9, $10, $12, $13);
    4530. 

  4530. 	#		print $key, "#-#-#-#-#-#-#-#\n";
    4531. 

  4531. 		if ($line =~ /([0-9]+)\s+([0-9a-zA-Z]+)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    4532. 

  4532. 			my $key = join("\t",$1, $2, $3, $4, $5);
    4533. 

  4533. #			print "key = $key\n" if $prinkter == 1;
    4534. 

  4534. 			push (@{$seen{$key}},$line);	
    4535. 

  4535. 			$microcounter++;
    4536. 

  4536. 		}
    4537. 

  4537. 		else {		
    4538. 

  4538. 			#print "could not make ker in SPUT : \n$line \n"; 
    4539. 

  4539. 		}
    4540. 

  4540. 	}
    4541. 

  4541. #	print "done hash.. linecounter = $linecounter, microcounter = $microcounter and total keys entered = ",scalar(keys %seen),"\n";
    4542. 

  4542. #	print INFO  "done hash.. linecounter = $linecounter, microcounter = $microcounter and total keys entered = ",scalar(keys %seen),"\n";
    4543. 

  4543. 	close SPUT;
    4544. 

  4544. 	
    4545. 

  4545. 	#----------------------------------------------------------------------------------------------------------------
    4546. 

  4546. 	
    4547. 

  4547. 	#-------------------------------------------------------------------------------------------------------#
    4548. 

  4548. 	#	THE ENTIRE CODE BELOW IS DEVOTED TO GENERATING HASH KEYS FROM MATCH FOLLOWED BY			#
    4549. 

  4549. 	#	USING THESE HASH KEYS TO CORRESPOND EACH SEQUENCE IN FIRST FILE TO ITS MICROSAT REPEATS IN			#
    4550. 

  4550. 	#   SECOND FILE FOLLOWED BY																				#
    4551. 

  4551. 	#	FINDING THE EXACT LOCATION OF EACH MICROSAT REPEAT WITHIN EACH SEQUENCE USING THE 'index' FUNCTION	#
    4552. 

  4552. 	#-------------------------------------------------------------------------------------------------------#		
    4553. 

  4553. 	my $ref = 0;
    4554. 

  4554. 	my $ref2 = 0;
    4555. 

  4555. 	my $ref3 = 0;
    4556. 

  4556. 	my $ref4 = 0;
    4557. 

  4557. 	my $deletes= 0;
    4558. 

  4558. 	my $duplicates = 0;
    4559. 

  4559. 	my $neighbors = 0;
    4560. 

  4560. 	my $tooshort = 0;
    4561. 

  4561. 	my $prevmicrol=();
    4562. 

  4562. 	my $startnotfound = 0;
    4563. 

  4563. 	my $matchkeysformed = 0;
    4564. 

  4564. 	my $keysused = 0;
    4565. 

  4565. 	
    4566. 

  4566. 	while (my $line = <MATCH>)	{
    4567. 

  4567. #		print    colored ['magenta'], $line  if $prinkter == 1;
    4568. 

  4568. 		next if $line !~ /[a-zA-Z0-9]/;
    4569. 

  4569. 		chomp $line;	
    4570. 

  4570. 		my @fields2 = split(/\t/,$line);
    4571. 

  4571. 		my $key2 = ();
    4572. 

  4572. 	#		$key2 = join("\t",$1 , $2, $4, $5, $6, $8, $9, $10, $12, $13);
    4573. 

  4573. 		if ($line =~ /([0-9]+)\s+([0-9a-zA-Z]+)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)\s/ ) {
    4574. 

  4574. 			$matchkeysformed++;
    4575. 

  4575. 			$key2 = join("\t",$1, $2, $3, $4, $5);
    4576. 

  4576. #			print "key = $key2 \n" if $prinkter == 1; 
    4577. 

  4577. 		}
    4578. 

  4578. 		else{
    4579. 

  4579. #			print "could not make ker in SEQ : $line\n";
    4580. 

  4580. 			next;
    4581. 

  4581. 		}
    4582. 

  4582. 		my $sequence = $fields2[$sequencepos];
    4583. 

  4583. 		$sequence =~ s/\*/-/g;
    4584. 

  4584. 		my $count = 0;
    4585. 

  4585. 		if (exists $seen{$key2}){
    4586. 

  4586. 			$keysused++;
    4587. 

  4587. 			my @unsorted_raw = @{$seen{$key2}};
    4588. 

  4588. 			delete $seen{$key2};
    4589. 

  4589. 			my @sequencearr = split(/\s*/, $sequence);
    4590. 

  4590. 			
    4591. 

  4591. #			print "sequencearr = @sequencearr\n" if $prinkter == 1;
    4592. 

  4592. 			
    4593. 

  4593. 			my $counter;
    4594. 

  4594. 	
    4595. 

  4595. 			my %start_database = ();
    4596. 

  4596. 			my %end_database = ();
    4597. 

  4597. 			foreach my $uns (@unsorted_raw){
    4598. 

  4598. 				my @uields = split(/\t/,$uns);
    4599. 

  4599. 				$start_database{$uields[$startcord]} = $uns;
    4600. 

  4600. 				$end_database{$uields[$endcord]} = $uns;
    4601. 

  4601. 			}
    4602. 

  4602. 			
    4603. 

  4603. 			my @unsorted = ();
    4604. 

  4604. 			my %starts = (); my %ends = ();
    4605. 

  4605. #			print colored ['yellow'],"unsorted, unfiltered microats = \n" if $prinkter == 1; foreach (@unsorted_raw) {print colored ['blue'],$_,"\n" if $prinkter == 1;}
    4606. 

  4606. 			for my $u (0 ... $#unsorted_raw){
    4607. 

  4607. 				my @tields = split(/\t/,$unsorted_raw[$u]);
    4608. 

  4608. 				next if exists $starts{$tields[$startcord]} && exists $ends{$tields[$endcord]};
    4609. 

  4609. 				push(@unsorted, $unsorted_raw[$u]);
    4610. 

  4610. 				$starts{$tields[$startcord]} = $unsorted_raw[$u];
    4611. 

  4611. #				print "in starts : $tields[$startcord] -> $unsorted_raw[$u]\n" if $prinkter == 1;
    4612. 

  4612. 			}
    4613. 

  4613. 			
    4614. 

  4614. 			my $basecounter= 0;
    4615. 

  4615. 			my $gapcounter = 0;
    4616. 

  4616. 			my $poscounter = 0;
    4617. 

  4617. 			
    4618. 

  4618. 			for my $s (@sequencearr){
    4619. 

  4619. 				
    4620. 

  4620. 				$poscounter++;
    4621. 

  4621. 				if ($s eq "-"){
    4622. 

  4622. 					$gapcounter++; next;
    4623. 

  4623. 				}
    4624. 

  4624. 				else{
    4625. 

  4625. 					$basecounter++;
    4626. 

  4626. 				}
    4627. 

  4627. 				
    4628. 

  4628. 				
    4629. 

  4629. 				#print "s = $s, poscounter = $poscounter, basecounter = $basecounter, gapcpunter = $gapcounter\n" if $prinkter == 1;
    4630. 

  4630. 				#print "s = $s, basecounter = $basecounter, gapcpunter = $gapcounter\n" if $prinkter == 1;
    4631. 

  4631. 				#print "s = $s, gapcpunter = $gapcounter\n" if $prinkter == 1;
    4632. 

  4632. 				
    4633. 

  4633. 				if (exists $starts{$basecounter}){
    4634. 

  4634. 					my $locus = $starts{$basecounter};
    4635. 

  4635. #					print "locus identified = $locus\n" if $prinkter == 1;
    4636. 

  4636. 					my @fields3 = split(/\t/,$locus);
    4637. 

  4637. 					my $start = $fields3[$startcord];
    4638. 

  4638. 					my $end = $fields3[$endcord];
    4639. 

  4639. 					my $motif = $fields3[$motifcord];
    4640. 

  4640. 					my $microsat = $fields3[$microsatcord];				
    4641. 

  4641. 					my @leftbracketpos = ();			
    4642. 

  4642. 					my @rightbracketpos = (); 
    4643. 

  4643. 					my $bracket_picker = 'no';
    4644. 

  4644. 					my $leftbrackets=();
    4645. 

  4645. 					my $rightbrackets = ();
    4646. 

  4646. 					my $micro_cpy = $microsat;
    4647. 

  4647. #					print "microsat = $microsat\n" if $prinkter == 1;
    4648. 

  4648. 					while($microsat =~ m/\[/g) {push(@leftbracketpos, (pos($microsat)));  $leftbrackets = join("__",@leftbracketpos);$bracket_picker='yes';}
    4649. 

  4649. 					while($microsat =~ m/\]/g) {push(@rightbracketpos, (pos($microsat))); $rightbrackets = join("__",@rightbracketpos);}
    4650. 

  4650. 					$microsat =~ s/[\[\]\-\*]//g;
    4651. 

  4651. #					print "microsat = $microsat\n" if $prinkter == 1;
    4652. 

  4652. 					my $human_search = join '-*', split //, $microsat;
    4653. 

  4653. 					my $temp = substr($sequence, $poscounter-1);
    4654. 

  4654. #					print "with poscounter = $poscounter\n" if $prinkter == 1;
    4655. 

  4655. 					my $search_result = ();
    4656. 

  4656. 					my $posnow  = ();
    4657. 

  4657. 					
    4658. 

  4658. #					print "for $line, temp $temp or human_search $human_search not defined\n" if !defined $temp || !defined $human_search;
    4659. 

  4659. #					<STDIN> if !defined $temp || !defined $human_search;
    4660. 

  4660. 					
    4661. 

  4661. 					while ($temp =~ /($human_search)/gi){
    4662. 

  4662. 						$search_result = $1;
    4663. 

  4663. 					#	$posnow  = pos($temp);
    4664. 

  4664. 						last;
    4665. 

  4665. 					}
    4666. 

  4666. 					
    4667. 

  4667. 					my @gapspos = ();
    4668. 

  4668. 					next if !defined $search_result;
    4669. 

  4669. 					
    4670. 

  4670. 					while($search_result =~ m/-/g) {push(@gapspos, (pos($search_result))); }
    4671. 

  4671. 					my $gaps  = join("__",@gapspos);
    4672. 

  4672. 	
    4673. 

  4673. 					my $final_microsat = $search_result;
    4674. 

  4674. 					if ($bracket_picker eq "yes"){
    4675. 

  4675. 						$final_microsat = microsat_bracketer($search_result, $gaps,$leftbrackets,$rightbrackets);
    4676. 

  4676. 					}
    4677. 

  4677. 					
    4678. 

  4678. 					my $outsentence = join("\t",join ("\t",@fields3[0 ... $infocord]),$fields3[$typecord],$fields3[$motifcord],$gapcounter,$poscounter,$fields3[$strandcord],$poscounter + length($search_result) -1 ,$final_microsat);
    4679. 

  4679. 					
    4680. 

  4680. 					if ($bracket_picker eq "yes") {
    4681. 

  4681. 						$outsentence = $outsentence."\t".join("\t",@fields3[($motifcord+1) ... $#fields3]);
    4682. 

  4682. 					}
    4683. 

  4683. 					print OUT $outsentence,"\n";	
    4684. 

  4684. 				}			
    4685. 

  4685. 			}
    4686. 

  4686. 		}
    4687. 

  4687. 	}
    4688. 

  4688. 	my $unusedkeys = scalar(keys %seen);
    4689. 

  4689. #	print INFO "in hash = $ref, looped = $ref4, captured = $ref3\n REMOVED: \nmicrosats with too long gaps = $deletes\n";
    4690. 

  4690. #	print INFO "exact duplicated removed = $duplicates \nmicrosats removed due to multiple microsats defined  in +-10 bp neighboring region: $neighbors \n";
    4691. 

  4691. #	print INFO "microsatellites too short = $tooshort\n";
    4692. 

  4692. #	print INFO "keysused = $keysused...starts not found = $startnotfound ... matchkeysformed=$matchkeysformed ... unusedkeys=$unusedkeys\n";
    4693. 

  4693. 	
    4694. 

  4694. 	#print  "in hash = $ref, looped = $ref4, captured = $ref3\n REMOVED: \nmicrosats with too long gaps = $deletes\n";
    4695. 

  4695. 	#print  "exact duplicated removed = $duplicates \nmicrosats removed due to multiple microsats defined  in +-10 bp neighboring region: $neighbors \n";
    4696. 

  4696. 	#print  "microsatellites too short = $tooshort\n";
    4697. 

  4697. 	#print  "keysused = $keysused...starts not found = $startnotfound ... matchkeysformed=$matchkeysformed ... unusedkeys=$unusedkeys\n";
    4698. 

  4698. 	#print "unused keys = \n",join("\n", (keys %seen)),"\n";
    4699. 

  4699. 	close (MATCH);
    4700. 

  4700. 	close (SPUT);
    4701. 

  4701. 	close (OUT);
    4702. 

  4702. 	close (INFO);
    4703. 

  4703. }	
    4704. 

  4704. 

  4705. sub microsat_bracketer{
    4706. 

  4706. #	print "in bracketer: @_\n";
    4707. 

  4707. 	my ($microsat, $gapspos, $leftbracketpos, $rightbracketpos) = @_;
    4708. 

  4708. 	my @gaps = split(/__/,$gapspos);
    4709. 

  4709. 	my @lefts = split(/__/,$leftbracketpos);
    4710. 

  4710. 	my @rights = split(/__/,$rightbracketpos);
    4711. 

  4711. 	my @new=();
    4712. 

  4712. 	my $pure = $microsat;
    4713. 

  4713. 	$pure =~ s/-//g;
    4714. 

  4714. 	my $off = 0;
    4715. 

  4715. 	my $finallength  = length($microsat) + scalar(@lefts)+scalar(@rights);
    4716. 

  4716. 	push(@gaps, 0);
    4717. 

  4717. 	push(@lefts,0);
    4718. 

  4718. 	push(@rights,0);
    4719. 

  4719. 	
    4720. 

  4720. 	for my $i (1 ... $finallength){
    4721. 

  4721. #		print "1 current i = >$i<>, right = >$rights[0]<  gap = $gaps[0] left = >$lefts[0]< and $rights[0] == $i\n";
    4722. 

  4722. 		if($rights[0] == $i){
    4723. 

  4723. 	#		print "pushed a ]\n";
    4724. 

  4724. 			push(@new, "]");
    4725. 

  4725. 			shift(@rights);
    4726. 

  4726. 			push(@rights,0);
    4727. 

  4727. 			for my $j (0 ... scalar(@gaps)-1) {$gaps[$j]++;}	
    4728. 

  4728. 			next;
    4729. 

  4729. 		}
    4730. 

  4730. 		if($gaps[0] == $i){
    4731. 

  4731. 	#		print "pushed a -\n";
    4732. 

  4732. 			push(@new, "-");
    4733. 

  4733. 			shift(@gaps);
    4734. 

  4734. 			push(@gaps, 0);
    4735. 

  4735. 			for my $j (0 ... scalar(@rights)-1) {$rights[$j]++;}	
    4736. 

  4736. 			for my $j (0 ... scalar(@lefts)-1) {$lefts[$j]++;}	
    4737. 

  4737. 

  4738. 			next;
    4739. 

  4739. 		}
    4740. 

  4740. 		if($lefts[0] == $i){
    4741. 

  4741. #			print "pushed a [\n";
    4742. 

  4742. 			push(@new, "[");
    4743. 

  4743. 			shift(@lefts);
    4744. 

  4744. 			push(@lefts,0);
    4745. 

  4745. 			for my $j (0 ... scalar(@gaps)-1) {$gaps[$j]++;}	
    4746. 

  4746. 			next;
    4747. 

  4747. 		}
    4748. 

  4748. 		else{
    4749. 

  4749. 			my $pushed = substr($pure,$off,1);
    4750. 

  4750. 			$off++;
    4751. 

  4751. 			push(@new,$pushed );
    4752. 

  4752. #			print "pushed an alphabet, now new = @new, pushed = $pushed\n";
    4753. 

  4753. 			next;
    4754. 

  4754. 		}
    4755. 

  4755. 	}
    4756. 

  4756. 	my $returnmicrosat = join("",@new);
    4757. 

  4757. #	print "final microsat = $returnmicrosat \n";
    4758. 

  4758. 	return($returnmicrosat);
    4759. 

  4759. }
    4760. 

  4760. 

  4761. #xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx  new_multispecies_t10 xxxxxxxxxxxxxx  new_multispecies_t10 xxxxxxxxxxxxxx 
    4762. 

  4762. 

  4763. 

  4764. #xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx  multiSpecies_orthFinder4 xxxxxxxxxxxxxx  multiSpecies_orthFinder4 xxxxxxxxxxxxxx 
    4765. 

  4765. sub multiSpecies_orthFinder4{
    4766. 

  4766. 	#print "IN multiSpecies_orthFinder4: @_\n";
    4767. 

  4767. 	my @handles = ();
    4768. 

  4768. 	#1 SEPT 30TH 2008
    4769. 

  4769. 	#2 THIS CODE (multiSpecies_orthFinder4.pl)  IS BEING MADE SO THAT IN THE REMOVAL OF MICROSATELLITES THAT ARE CLOSER TO EACH OTHER
    4770. 

  4770. 	#3 THAN 50 BP (HE 50BP RADIUS OF EXCLUSION), WE ARE LOOKING ACCROSS ALIGNMENT BLOCKS.. AND NOT JUST LOOKING WITHIN THE ALIGNMENT BLOCKS. THIS WILL
    4771. 

  4771. 	#4 POTENTIALLY REMOVE EVEN MORE MICROSATELLITES THAN BEFORE, BUT THIS WILL RESCUE THOSE MICROSATELLITES THAT WERE LOST
    4772. 

  4772. 	#5 DUE TO OUR PREVIOUS REQUIREMENT FROM VERSION 3, THAT MICROSATELLITES THAT ARE CLOSER TO THE BOUNDARY THAN 25 BP NEED TO BE REMOVED
    4773. 

  4773. 	#6 SUCH A REQUIREMENT WAS A CRUDE WAY TO IMPOSE THE ABOVE 50 BP RADIUS OF EXCLUSION ACCROSS THE ALIGNMENT BLOCKS WITHOUT ACTUALLY
    4774. 

  4774. 	#7 CHECKING COORDINATES OF THE EXCLUDED MICROSATELLITES.
    4775. 

  4775. 	#8 IN ORDER TO TAKE CARE OF THE CASES WHERE MICROSATELLITES ARE PRELIOUSLY CLOSE TO ENDS OF THE ALIGNMENT BLOCKS, WE IMPOSE HERE
    4776. 

  4776. 	#9 A NEW REQUIREMENT THAT FOR A MICROSATELLITE TO BE CONSIDERED, ALL THE SPECIES NEED TO HAVE AT LEAST 10 BP OF NON-MICROSATELLITE SEQUENCE
    4777. 

  4777. 	#10 ON EITHER SIDE OF IT.. GAPLESS. THIS INFORMATION IS STORED IN THE VARIABLE: $FLANK_SUPPORT. THIS PART, INSTEAD OF BEING INCLUDED IN
    4778. 

  4778. 	#11 THIS CODE, WILL BE INCLUDED IN A NEW CODE THAT WE WILL BE WRITING AS PART OF THE PIPELINE: multiSpecies_microsatSetSelector.pl
    4779. 

  4779. 	
    4780. 

  4780. 	#1 trial run:
    4781. 

  4781. 	#2 perl ../../../codes/multiSpecies_orthFinder4.pl /gpfs/home/ydk104/work/rhesus_microsat/axtNet/hg18.panTro2.ponAbe2.rheMac2.calJac1/chr22.hg18.panTro2.ponAbe2.rheMac2.calJac1.net.axt H.hg18-chr22.panTro2.ponAbe2.rheMac2.calJac1_allmicrosats_symmetrical_fin_hit_all_2:C.hg18-chr22.panTro2.ponAbe2.rheMac2.calJac1_allmicrosats_symmetrical_fin_hit_all_2:O.hg18-chr22.panTro2.ponAbe2.rheMac2.calJac1_allmicrosats_symmetrical_fin_hit_all_2:R.hg18-chr22.panTro2.ponAbe2.rheMac2.calJac1_allmicrosats_symmetrical_fin_hit_all_2:M.hg18-chr22.panTro2.ponAbe2.rheMac2.calJac1_allmicrosats_symmetrical_fin_hit_all_2 orth22 hg18:panTro2:ponAbe2:rheMac2:calJac1 50
    4782. 

  4782. 	
    4783. 

  4783. 	$prinkter=0;
    4784. 

  4784. 	
    4785. 

  4785. 	#############
    4786. 

  4786. 	my $CLUSTER_DIST = $_[4];
    4787. 

  4787. 	#############
    4788. 

  4788. 	
    4789. 

  4789. 	
    4790. 

  4790. 	my $aligns = $_[0];
    4791. 

  4791. 	my @micros = split(/:/, $_[1]);
    4792. 

  4792. 	my $orth = $_[2];
    4793. 

  4793. 	#my $not_orth = "notorth";
    4794. 

  4794. 	@tags = split(/:/, $_[3]);
    4795. 

  4795. 	
    4796. 

  4796. 	$no_of_species=scalar(@tags);
    4797. 

  4797. 	my $junkfile = $orth."_junk";
    4798. 

  4798. 	#open(JUNK,">$junkfile");
    4799. 

  4799. 	
    4800. 

  4800. 	#my $info = $output1."_info";
    4801. 

  4801. 	#print "inputs are : \n"; foreach(@micros){print $_,"\n";} 
    4802. 

  4802. 	#print "info = @_\n";
    4803. 

  4803. 	
    4804. 

  4804. 	
    4805. 

  4805. 	open (BO, "<$aligns") or die "Cannot open alignment file: $aligns: $!";
    4806. 

  4806. 	open (ORTH, ">$orth");
    4807. 

  4807. 	my $output=$orth."_out";
    4808. 

  4808. 	open (OUTP, ">$output");
    4809. 

  4809. 	
    4810. 

  4810. 	
    4811. 

  4811. 	#open (NORTH, ">$not_orth");
    4812. 

  4812. 	#open (INF, ">$info");
    4813. 

  4813. 	my $i = 0;
    4814. 

  4814. 	foreach my $path (@micros){
    4815. 

  4815. 		$handles[$i] = IO::Handle->new();
    4816. 

  4816. 		open ($handles[$i], "<$path") or die "Can't open microsat file $path : $!";
    4817. 

  4817. 		$i++;
    4818. 

  4818. 	}
    4819. 

  4819. 	
    4820. 

  4820. 	#print "Opened files\n";
    4821. 

  4821. 	
    4822. 

  4822. 	
    4823. 

  4823. 	$infocord = 2 + (4*$no_of_species) - 1;
    4824. 

  4824. 	$typecord = 2 + (4*$no_of_species) + 1 - 1;
    4825. 

  4825. 	$motifcord = $typecord + 1;
    4826. 

  4826. 	$gapcord = $motifcord+1;
    4827. 

  4827. 	$startcord = $gapcord + 1;
    4828. 

  4828. 	$strandcord = $startcord + 1;
    4829. 

  4829. 	$endcord = $strandcord + 1;
    4830. 

  4830. 	$microsatcord = $endcord + 1;
    4831. 

  4831. 	$sequencepos = 2 + (4*$no_of_species) + 1 -1 ; 
    4832. 

  4832. 	#$sequencepos = 17;
    4833. 

  4833. 	#	GENERATING HASHES CONTAINING CHIMP AND HUMAN DATA FROM ABOVE FILES
    4834. 

  4834. 	#----------------------------------------------------------------------------------------------------------------
    4835. 

  4835. 	my @hasharr = ();
    4836. 

  4836. 	foreach my $path (@micros){
    4837. 

  4837. 		open(READ, "<$path") or die "Cannot open file $path :$!";
    4838. 

  4838. 		my %single_hash = ();
    4839. 

  4839. 		my $key = ();
    4840. 

  4840. 		my $counter = 0;
    4841. 

  4841. 		while (my $line = <READ>){
    4842. 

  4842. 			$counter++;
    4843. 

  4843. 		#	print $line;
    4844. 

  4844. 			chomp $line;
    4845. 

  4845. 			my @fields1 = split(/\t/,$line);
    4846. 

  4846. 			if ($line =~ /([0-9]+)\s+($focalspec)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)/ ) {
    4847. 

  4847. 				$key = join("\t",$1, $2,  $4, $5);
    4848. 

  4848. 	
    4849. 

  4849. #					print "key =  : $key\n" if $prinkter == 1;
    4850. 

  4850. 				
    4851. 

  4851. #				print $line if $prinkter == 1;
    4852. 

  4852. 				push (@{$single_hash{$key}},$line);
    4853. 

  4853. 			}
    4854. 

  4854. 			else{
    4855. 

  4855. 			#	print "microsat line incompatible\n";
    4856. 

  4856. 			}
    4857. 

  4857. 		}
    4858. 

  4858. 		push @hasharr, {%single_hash};
    4859. 

  4859. 	#	print "@{$single_hash{$key}} \n";
    4860. 

  4860. #		print "done $path: counter = $counter\n" if $prinkter == 1;
    4861. 

  4861. 		close READ;
    4862. 

  4862. 	}	
    4863. 

  4863. #	print "Done hashes\n";
    4864. 

  4864. 	#----------------------------------------------------------------------------------------------------------------
    4865. 

  4865. 	my $question=();
    4866. 

  4866. 	#----------------------------------------------------------------------------------------------------------------
    4867. 

  4867. 	my @contigstarts = ();
    4868. 

  4868. 	my @contigends = ();
    4869. 

  4869. 	
    4870. 

  4870. 	my %contigclusters = ();
    4871. 

  4871. 	my %contigclustersFirstStartOnly=();
    4872. 

  4872. 	my %contigclustersLastEndOnly=();
    4873. 

  4873. 	my %contigclustersLastEndLengthOnly=();
    4874. 

  4874. 	my %contigclustersFirstStartLengthOnly=();
    4875. 

  4875. 	my %contigpath=();
    4876. 

  4876. 	my $dotcounter = 0;
    4877. 

  4877. 	while (my $line = <BO>){
    4878. 

  4878. #		print "x" x 60, "\n" if $prinkter == 1;
    4879. 

  4879. 		$dotcounter++;
    4880. 

  4880. #		print "." if $dotcounter % 100 ==0;
    4881. 

  4881. #		print "\n" if $dotcounter % 5000 ==0;
    4882. 

  4882. 		next if $line !~ /^[0-9]+/;
    4883. 

  4883. #		print $line if $prinkter == 1;
    4884. 

  4884. 		chomp $line;	
    4885. 

  4885. 		my @fields2 = split(/\t/,$line);
    4886. 

  4886. 		my $key2 = ();
    4887. 

  4887. 		if ($line =~ /([0-9]+)\s+($focalspec)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)/ ) {
    4888. 

  4888. 			$key2 = join("\t",$1, $2,  $4, $5);
    4889. 

  4889. 		}
    4890. 

  4890. 		else {
    4891. 

  4891. #			print "seq line $line incompatible\n" if $prinkter == 1; 
    4892. 

  4892. 			next;}
    4893. 

  4893. 		
    4894. 

  4894. 		
    4895. 

  4895. 		
    4896. 

  4896. 		
    4897. 

  4897. 		
    4898. 

  4898. 		
    4899. 

  4899. 		my @sequences = ();
    4900. 

  4900. 		for (0 ... $#tags){
    4901. 

  4901. 			my $seq = <BO>;
    4902. 

  4902. 	#		print $seq;
    4903. 

  4903. 			chomp $seq;
    4904. 

  4904. 			push(@sequences , " ".$seq);
    4905. 

  4905. 		}
    4906. 

  4906. 		my @origsequences = @sequences;
    4907. 

  4907. 		my $seqcopy = $sequences[0];
    4908. 

  4908. 		my @strings = ();
    4909. 

  4909. 		$seqcopy =~ s/[a-zA-Z]|-/x/g;
    4910. 

  4910. 		my @string = split(/\s*/,$seqcopy);
    4911. 

  4911. 	
    4912. 

  4912. 		for my $s (0 ... $#tags){
    4913. 

  4913. 			$sequences[$s] =~ s/-//g;
    4914. 

  4914. 			$sequences[$s] =~ s/[a-zA-Z]/x/g;		
    4915. 

  4915. 	#		print "length  of sequence = ",length($sequences[$s]),"\n";
    4916. 

  4916. 			my @tempstring = split(/\s*/,$sequences[$s]);
    4917. 

  4917. 			push(@strings, [@tempstring])
    4918. 

  4918. 			
    4919. 

  4919. 		}
    4920. 

  4920. 	
    4921. 

  4921. 		my @species_list = ();
    4922. 

  4922. 		my @micro_count = 0;
    4923. 

  4923. 		my @starthash = ();
    4924. 

  4924. 		my $stopper = 1;
    4925. 

  4925. 		my @endhash = ();
    4926. 

  4926. 		
    4927. 

  4927. 		my @currentcontigstarts=();
    4928. 

  4928. 		my @currentcontigends=();
    4929. 

  4929. 		my @currentcontigchrs=();
    4930. 

  4930. 		
    4931. 

  4931. 		for my $i (0 ... $#tags){
    4932. 

  4932. #			print "searching for : if exists  hasharr: $i : $tags[$i] : $key2 \n" if $prinkter == 1;
    4933. 

  4933. 			my @temparr = (); 
    4934. 

  4934. 	
    4935. 

  4935. 			if (exists $hasharr[$i]{$key2}){
    4936. 

  4936. 				@temparr =  @{$hasharr[$i]{$key2}};
    4937. 

  4937. 				
    4938. 

  4938. 				$line =~ /$tags[$i]\s([a-zA-Z0-9_]+)\s([0-9]+)\s([0-9]+)/;
    4939. 

  4939. ##				print "in line $line, trying to hunt for: $tags[$i]\\s([a-zA-Z0-9_])+\\s([0-9]+)\\s([0-9]+) \n" if $prinkter == 1;
    4940. 

  4940. #				print "org = $tags[$i], and chr = $1, start = $2, end =$3 \n" if $prinkter == 1; 
    4941. 

  4941. 				my $startkey = $1."_SK0SK_".$2; #print "adding start key for this alignmebt block: $startkey to species $tags[$i]\n" if $prinkter == 1;
    4942. 

  4942. 				my $endkey = $1."_EK0EK_".$3; #print "adding end key for this alignmebt block: $endkey to species $tags[$i]\n" if $prinkter == 1;
    4943. 

  4943. 				$contigstarts[$i]{$startkey}= $key2;
    4944. 

  4944. 				$contigends[$i]{$endkey}= $key2;
    4945. 

  4945. #				print "confirming existance: \n" if $prinkter == 1;
    4946. 

  4946. #				print "present \n" if exists $contigends[$i]{$endkey} && $prinkter == 1;
    4947. 

  4947. #				print "absent \n" if !exists $contigends[$i]{$endkey} && $prinkter == 1;			
    4948. 

  4948. 				$currentcontigchrs[$i]=$1;
    4949. 

  4949. 				$currentcontigstarts[$i]=$2;
    4950. 

  4950. 				$currentcontigends[$i]=$3;
    4951. 

  4951. 				
    4952. 

  4952. 			} # print "exists: @{$hasharr[$i]{$key2}}[0]\n"}
    4953. 

  4953. 			else {
    4954. 

  4954. 				push (@starthash, {0 => "0"});
    4955. 

  4955. 				push (@endhash, {0 => "0"});
    4956. 

  4956. 				$currentcontigchrs[$i] = 0;
    4957. 

  4957. 				next;
    4958. 

  4958. 			}
    4959. 

  4959. 			$stopper = 0;
    4960. 

  4960. 	#		print "exists: @temparr\n" if $prinkter == 1;
    4961. 

  4961. 			push(@micro_count, scalar(@temparr));
    4962. 

  4962. 			push(@species_list, [@temparr]);	
    4963. 

  4963. 			my @tempstart = (); my @tempend = ();
    4964. 

  4964. 			my %localends = ();
    4965. 

  4965. 			my %localhash = ();
    4966. 

  4966. 	#		print "---------------------------\n";
    4967. 

  4967. 	
    4968. 

  4968. 			foreach my $templine (@temparr){
    4969. 

  4969. #				print "templine = $templine\n" if $prinkter == 1;
    4970. 

  4970. 				my @tields = split(/\t/,$templine);
    4971. 

  4971. 				my $start = $tields[$startcord]; # - $tields[$gapcord];
    4972. 

  4972. 				my $end = $tields[$endcord]; #- $tields[$gapcord];
    4973. 

  4973. 				my $realstart = $tields[$startcord]- $tields[$gapcord];
    4974. 

  4974. 				my $gapsinmicrosat = ($tields[$microsatcord] =~ s/-/-/g);
    4975. 

  4975. 				$gapsinmicrosat = 0 if $gapsinmicrosat !~ /[0-9]+/;
    4976. 

  4976. 	#			print "infocord = $infocord  typecord = $typecord  motifcord = $motifcord  gapcord = $gapcord  startcord = $startcord strandcord = $strandcord endcord = $endcord   microsatcord = $microsatcord  sequencepos = $sequencepos\n";
    4977. 

  4977. 				my $realend = $tields[$endcord]- $tields[$gapcord]- $gapsinmicrosat;
    4978. 

  4978. 		#		print "real start = $realstart, realend = $realend \n";
    4979. 

  4979. 				for my $pos ($realstart ... $realend){  $strings[$i][$pos] = $strings[$i][$pos].",".$i.":".$start."-".$end;}
    4980. 

  4980. 				push(@tempstart, $start);
    4981. 

  4981. 				push(@tempend, $end);
    4982. 

  4982. 				$localhash{$start."-".$end} = $templine;
    4983. 

  4983. 				}
    4984. 

  4984. 			push @starthash, {%localhash};
    4985. 

  4985. 			my $foundclusters  =findClusters(join("!",@{$strings[$i]}), $CLUSTER_DIST);
    4986. 

  4986. 	
    4987. 

  4987. #			print "foundclusters = $foundclusters\n";
    4988. 

  4988. 	
    4989. 

  4989. 			my @clusters = split(/_/,$foundclusters);
    4990. 

  4990. 			
    4991. 

  4991. 			my $clustno = 0;
    4992. 

  4992. 			
    4993. 

  4993. 			foreach my $cluster (@clusters) {
    4994. 

  4994. 				my @constituenst = split(/,/,$cluster);
    4995. 

  4995. #				print "clusters returned: @constituenst\n" if $prinkter == 1;
    4996. 

  4996. 			}
    4997. 

  4997. 	
    4998. 

  4998. 			@string = split("_S0S_",stringPainter(join("_C0C_",@string),$foundclusters));
    4999. 

  4999. 			
    5000. 

  5000. 			
    5001. 

  5001. 		}
    5002. 

  5002. 		next if $stopper == 1;
    5003. 

  5003. 	
    5004. 

  5004. #		print colored ['blue'],"FINAL:\n" if $prinkter == 1;
    5005. 

  5005. 		my $finalclusters  =findClusters(join("!",@string), 1);
    5006. 

  5006. #		print "finalclusters = $finalclusters\n";
    5007. 

  5007. #		print colored ['blue'],"----------------------\n" if $prinkter == 1;
    5008. 

  5008. 		my @clusters = split(/,/,$finalclusters);
    5009. 

  5009. #			print "@string\n" if $prinkter == 1;
    5010. 

  5010. #			print "@clusters\n" if $prinkter == 1;
    5011. 

  5011. #			print "------------------------------------------------------------------\n" if $prinkter == 1;
    5012. 

  5012. 		
    5013. 

  5013. 		my $clustno = 0;
    5014. 

  5014. 		
    5015. 

  5015. 	#	foreach my $cluster (@clusters) {
    5016. 

  5016. 	#		my @constituenst = split(/,/,$cluster);
    5017. 

  5017. 	#		print "clusters returned: @constituenst\n";
    5018. 

  5018. 	#	}
    5019. 

  5019. 	
    5020. 

  5020. 		next if (scalar @clusters == 0);
    5021. 

  5021. 	
    5022. 

  5022. 		my @contigcluster=();
    5023. 

  5023. 		my $clusterno=0;
    5024. 

  5024. 		my @contigClusterstarts=();
    5025. 

  5025. 		my @contigClusterends = ();
    5026. 

  5026. 		
    5027. 

  5027. 		foreach my $clust (@clusters){
    5028. 

  5028. 	 #		print "cluster: $clust\n";   		
    5029. 

  5029. 			$clusterno++;
    5030. 

  5030. 			my @localclust = split(/\./, $clust);
    5031. 

  5031. 			my @result = ();
    5032. 

  5032. 			my @starts = ();
    5033. 

  5033. 			my @ends = ();
    5034. 

  5034. 	 
    5035. 

  5035. 			for my $i (0 ... $#localclust){
    5036. 

  5036. 	 #			print "localclust[$i]: $localclust[$i]\n";   		
    5037. 

  5037. 				my @pattern = split(/:/, $localclust[$i]);
    5038. 

  5038. 				my @cords = split(/-/, $pattern[1]);
    5039. 

  5039. 				push (@starts, $cords[0]);
    5040. 

  5040. 				push (@ends, $cords[1]);
    5041. 

  5041. 			}
    5042. 

  5042. 	
    5043. 

  5043. 			my $extremestart = smallest_number(@starts);
    5044. 

  5044. 			my $extremeend = largest_number(@ends);
    5045. 

  5045. 			push(@contigClusterstarts, $extremestart);
    5046. 

  5046. 			push(@contigClusterends, $extremeend);
    5047. 

  5047. #			print "cluster starts from $extremestart and ends at $extremeend \n" if $prinkter == 1 ;
    5048. 

  5048. 					
    5049. 

  5049. 			foreach my $clustparts (@localclust){
    5050. 

  5050. 				my @pattern = split(/:/, $clustparts);
    5051. 

  5051. 	# 			print "printing from pattern: $pattern[1]: $starthash[$pattern[0]]{$pattern[1]}\n";
    5052. 

  5052. 				push (@result, $starthash[$pattern[0]]{$pattern[1]});
    5053. 

  5053. 			}
    5054. 

  5054. 			push(@contigcluster, join("\t", @result));
    5055. 

  5055. #			print join("\t", @result),"<-result \n" if $prinkter == 1 ;
    5056. 

  5056. 		}	
    5057. 

  5057. 		
    5058. 

  5058. 	
    5059. 

  5059. 		my $firstclusterstart = smallest_number(@contigClusterstarts);
    5060. 

  5060. 		my $lastclusterend = largest_number(@contigClusterends);
    5061. 

  5061. 		
    5062. 

  5062. 		
    5063. 

  5063. 		$contigclustersFirstStartOnly{$key2}=$firstclusterstart;	
    5064. 

  5064. 		$contigclustersLastEndOnly{$key2} = $lastclusterend;
    5065. 

  5065. 		$contigclusters{$key2}=[ @contigcluster ];
    5066. 

  5066. #		print "currentcontigchr are @currentcontigchrs , firstclusterstart = $firstclusterstart, lastclusterend = $lastclusterend\n " if $prinkter == 1;
    5067. 

  5067. 		for my $i (0 ... $#tags){
    5068. 

  5068. 			#1 check if there exists adjacent alignment block wrt coordinates of this species.
    5069. 

  5069. 			next if $currentcontigchrs[$i] eq "0"; #1 this means that there are no microsats in this species in this alignment block.. 
    5070. 

  5070. 												 #2	no need to worry about proximity of anything in adjacent block!
    5071. 

  5071. 			
    5072. 

  5072. 			#1 BELOW, the following is really to calclate the distance between the end coordinate of the 
    5073. 

  5073. 			#2 cluster and the end of the gap-free sequence of each species. this is so that if an
    5074. 

  5074. 			#3 adjacent alignment block is found lateron, the exact distance between the potentially
    5075. 

  5075. 			#4 adjacent microsat clusters can be found here. the exact start coordinate will be used
    5076. 

  5076. 			#5 immediately below.
    5077. 

  5077. 	#		print "full sequence = $origsequences[$i] and its length = ",length($origsequences[$i])," \n" if $prinkter == 1;		
    5078. 

  5078. 			
    5079. 

  5079. 			my $species_startsubstring = substr($origsequences[$i], 0, $firstclusterstart);
    5080. 

  5080. 			my $species_endsubstring = ();
    5081. 

  5081. 			
    5082. 

  5082. 			if (length ($origsequences[$i]) <= $lastclusterend+1){ $species_endsubstring = "";}
    5083. 

  5083. 			else{  $species_endsubstring = substr($origsequences[$i], $lastclusterend+1);}
    5084. 

  5084. 			
    5085. 

  5085. #			print "\nnot defined species_endsubstring...\n"  if !defined $species_endsubstring && $prinkter == 1;
    5086. 

  5086. #			print "for species: $tags[$i]: \n" if $prinkter == 1;
    5087. 

  5087. 			
    5088. 

  5088. 			$species_startsubstring =~ s/-| //g;
    5089. 

  5089. 			$species_endsubstring =~ s/-| //g;
    5090. 

  5090. 			$contigclustersLastEndLengthOnly{$key2}[$i]=length($species_endsubstring);
    5091. 

  5091. 			$contigclustersFirstStartLengthOnly{$key2}[$i]=length($species_startsubstring);
    5092. 

  5092. 	
    5093. 

  5093. 	
    5094. 

  5094. 	
    5095. 

  5095. #			print "species_startsubstring = $species_startsubstring, and its length =",length($species_startsubstring)," \n" if $prinkter == 1;
    5096. 

  5096. #			print "species_endsubstring = $species_endsubstring, and its length =",length($species_endsubstring)," \n" if $prinkter == 1;
    5097. 

  5097. #			print "attaching to contigclustersLastEndOnly: $key2: $i\n" if $prinkter == 1;	
    5098. 

  5098. 			
    5099. 

  5099. #			print "just confirming: $contigclustersLastEndLengthOnly{$key2}[$i] \n" if $prinkter == 1;
    5100. 

  5100. 	
    5101. 

  5101. 		}
    5102. 

  5102. 	
    5103. 

  5103. 	
    5104. 

  5104. 	}
    5105. 

  5105. #	print "\ndone the job of filling... \n";
    5106. 

  5106. 	#///////////////////////////////////////////////////////////////////////////////////////
    5107. 

  5107. 	#///////////////////////////////////////////////////////////////////////////////////////
    5108. 

  5108. 	#///////////////////////////////////////////////////////////////////////////////////////
    5109. 

  5109. 	#///////////////////////////////////////////////////////////////////////////////////////
    5110. 

  5110. 	$prinkter=0;
    5111. 

  5111. 	open (BO, "<$aligns") or die "Cannot open alignment file: $aligns: $!";
    5112. 

  5112. 	
    5113. 

  5113. 	my %clusteringpaths=();
    5114. 

  5114. 	my %clustersholder=();
    5115. 

  5115. 	my %foundkeys=();
    5116. 

  5116. 	my %clusteringpathsRev=();
    5117. 

  5117. 	
    5118. 

  5118. 	
    5119. 

  5119. 	my $totalcount=();
    5120. 

  5120. 	my $founkeys_enteredcount=();
    5121. 

  5121. 	my $transfered=0;
    5122. 

  5122. 	my $complete_transfered=0;
    5123. 

  5123. 	my $plain_transfered=0;
    5124. 

  5124. 	my $existing_removed=0;
    5125. 

  5125. 	
    5126. 

  5126. 	while (my $line = <BO>){
    5127. 

  5127. #		print "x" x 60, "\n" if $prinkter == 1;
    5128. 

  5128. 		next if $line !~ /^[0-9]+/;
    5129. 

  5129. 		#print $line;
    5130. 

  5130. 		chomp $line;	
    5131. 

  5131. 		my @fields2 = split(/\t/,$line);
    5132. 

  5132. 		my $key2 = ();
    5133. 

  5133. 		if ($line =~ /([0-9]+)\s+($focalspec)\s(chr[0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)/ ) {
    5134. 

  5134. 			$key2 = join("\t",$1, $2,  $4, $5);
    5135. 

  5135. 		}
    5136. 

  5136. 		
    5137. 

  5137. 		else {
    5138. 

  5138. 		#	print "seq line $line incompatible\n";
    5139. 

  5139. 			next;
    5140. 

  5140. 		}
    5141. 

  5141. #		print "KEY =  : $key2\n" if $prinkter == 1;
    5142. 

  5142. 	
    5143. 

  5143. 	
    5144. 

  5144. 		my @currentcontigstarts=();
    5145. 

  5145. 		my @currentcontigends=();
    5146. 

  5146. 		my @currentcontigchrs=();
    5147. 

  5147. 		my @clusters = ();
    5148. 

  5148. 		my @clusterscopy=();
    5149. 

  5149. 		if (exists $contigclusters{$key2}){
    5150. 

  5150. 			@clusters =  @{$contigclusters{$key2}};
    5151. 

  5151. 			@clusterscopy=@clusters;
    5152. 

  5152. 			for my $i (0 ... $#tags){
    5153. 

  5153. 	#			print "in line $line, trying to hunt for: $tags[$i]\\s([a-zA-Z0-9])+\\s([0-9]+)\\s([0-9]+) \n" if $prinkter == 1;
    5154. 

  5154. 				if ($line =~ /$tags[$i]\s([a-zA-Z0-9_]+)\s([0-9]+)\s([0-9]+)/){
    5155. 

  5155. 	#				print "org = $tags[$i], and chr = $1, start = $2, end =$3 \n" if $prinkter == 1; 
    5156. 

  5156. 					my $startkey = $1."_S0E_".$2; #print "adding start key for this alignmebt block: $startkey to species $tags[$i]\n" if $prinkter == 1;
    5157. 

  5157. 					my $endkey = $1."_S0E_".$3; #print "adding end key for this alignmebt block: $endkey to species $tags[$i]\n" if $prinkter == 1;
    5158. 

  5158. 					$currentcontigchrs[$i]=$1;
    5159. 

  5159. 					$currentcontigstarts[$i]=$2;
    5160. 

  5160. 					$currentcontigends[$i]=$3;			
    5161. 

  5161. 				}
    5162. 

  5162. 				else {
    5163. 

  5163. 					$currentcontigchrs[$i] = 0;
    5164. 

  5164. 	#				print "no microsat clusters for $key2\n" if $prinkter == 1; next;	
    5165. 

  5165. 				}
    5166. 

  5166. 			}
    5167. 

  5167. 		} # print "exists: @{$hasharr[$i]{$key2}}[0]\n"}
    5168. 

  5168. 		
    5169. 

  5169. 		my @sequences = ();
    5170. 

  5170. 		for (0 ... $#tags){
    5171. 

  5171. 			my $seq = <BO>;
    5172. 

  5172. 	#		print $seq;
    5173. 

  5173. 			chomp $seq;
    5174. 

  5174. 			push(@sequences , " ".$seq);
    5175. 

  5175. 		}
    5176. 

  5176. 		
    5177. 

  5177. 		next if scalar @currentcontigchrs == 0;
    5178. 

  5178. 		
    5179. 

  5179. 	#	print "contigchrs= @currentcontigchrs \n" if $prinkter == 1;
    5180. 

  5180. 		my %visitedcontigs=();
    5181. 

  5181. 	
    5182. 

  5182. 		for my $i (0 ... $#tags){
    5183. 

  5183. 			#1 check if there exists adjacent alignment block wrt coordinates of this species.
    5184. 

  5184. 			next if $currentcontigchrs[$i] eq "0"; #1 this means that there are no microsats in this species in this alignment block.. 
    5185. 

  5185. 													#2	no need to worry about proximity of anything in adjacent block!
    5186. 

  5186. 			@clusters=@clusterscopy;
    5187. 

  5187. 			#1 BELOW, the following is really to calclate the distance between the end coordinate of the 
    5188. 

  5188. 			#2 cluster and the end of the gap-free sequence of each species. this is so that if an
    5189. 

  5189. 			#3 adjacent alignment block is found lateron, the exact distance between the potentially
    5190. 

  5190. 			#4 adjacent microsat clusters can be found here. the exact start coordinate will be used
    5191. 

  5191. 			#5 immediately below.
    5192. 

  5192. 			my $firstclusterstart = $contigclustersFirstStartOnly{$key2};
    5193. 

  5193. 			my $lastclusterend = $contigclustersLastEndOnly{$key2};
    5194. 

  5194. 					
    5195. 

  5195. 			my $key3 = $currentcontigchrs[$i]."_S0E_".($currentcontigstarts[$i]);
    5196. 

  5196. #			print  "check if exists $key3 in  contigends for $i\n" if $prinkter == 1; 
    5197. 

  5197. 			
    5198. 

  5198. 			if (exists($contigends[$i]{$key3}) && !exists $visitedcontigs{$contigends[$i]{$key3}}){
    5199. 

  5199. 				$visitedcontigs{$contigends[$i]{$key3}} = $contigends[$i]{$key3}; #1 this array keeps track of adjacent contigs that we have already visited, thus saving computational time and potential redundancies#
    5200. 

  5200. 	#			print "just checking the hash visitedcontigs: ",$visitedcontigs{$contigends[$i]{$key3}} ,"\n" if $prinkter == 1;
    5201. 

  5201. 	
    5202. 

  5202. 				#1 extract coordinates of the last cluster of this found alignment block
    5203. 

  5203. #				print "key of the found alignment block = ", $contigends[$i]{$key3},"\n" if $prinkter == 1;
    5204. 

  5204. 	#			print "we are trying to mine: contigclustersAllLastEndLengthOnly_raw: $contigends[$i]{$key3}: $i \n" if $prinkter == 1;
    5205. 

  5205. 	#			print "EXISTS\n" if exists $contigclusters{$contigends[$i]{$key3}} && $prinkter == 1;
    5206. 

  5206. 	#			print "does NOT EXIST\n" if !exists $contigclusters{$contigends[$i]{$key3}} && $prinkter == 1;
    5207. 

  5207. 				my @contigclustersAllFirstStartLengthOnly_raw=@{$contigclustersFirstStartLengthOnly{$key2}};
    5208. 

  5208. 				my @contigclustersAllLastEndLengthOnly_raw=@{$contigclustersLastEndLengthOnly{$contigends[$i]{$key3}}};
    5209. 

  5209. 				my @contigclustersAllFirstStartLengthOnly=(); my @contigclustersAllLastEndLengthOnly=();
    5210. 

  5210. 				
    5211. 

  5211. 				for my $val (0 ... $#contigclustersAllFirstStartLengthOnly_raw){
    5212. 

  5212. 	#				print "val = $val\n" if $prinkter == 1;
    5213. 

  5213. 					if (defined $contigclustersAllFirstStartLengthOnly_raw[$val]){
    5214. 

  5214. 						push(@contigclustersAllFirstStartLengthOnly, $contigclustersAllFirstStartLengthOnly_raw[$val]) if $contigclustersAllFirstStartLengthOnly_raw[$val] =~ /[0-9]+/;
    5215. 

  5215. 					}
    5216. 

  5216. 				}
    5217. 

  5217. 	#			print "-----\n" if $prinkter == 1;
    5218. 

  5218. 				for my $val (0 ... $#contigclustersAllLastEndLengthOnly_raw){
    5219. 

  5219. 	#				print "val = $val\n" if $prinkter == 1;
    5220. 

  5220. 					if (defined $contigclustersAllLastEndLengthOnly_raw[$val]){
    5221. 

  5221. 						push(@contigclustersAllLastEndLengthOnly, $contigclustersAllLastEndLengthOnly_raw[$val]) if  $contigclustersAllLastEndLengthOnly_raw[$val] =~ /[0-9]+/;
    5222. 

  5222. 					}
    5223. 

  5223. 				}
    5224. 

  5224. 				
    5225. 

  5225. 				
    5226. 

  5226. 	#			print "our two arrays are: starts = <@contigclustersAllFirstStartLengthOnly> ......... and ends = <@contigclustersAllLastEndLengthOnly>\n" if $prinkter == 1;
    5227. 

  5227. 	#			print "the last cluster's end in that one is: ",smallest_number(@contigclustersAllFirstStartLengthOnly) + smallest_number(@contigclustersAllLastEndLengthOnly)," = ", smallest_number(@contigclustersAllFirstStartLengthOnly)," + ",smallest_number(@contigclustersAllLastEndLengthOnly),"\n" if $prinkter == 1; 
    5228. 

  5228. 				
    5229. 

  5229. 	#			if ($contigclustersFirstStartLengthOnly{$key2}[$i] + $contigclustersLastEndLengthOnly{$contigends[$i]{$key3}}[$i] < 50){
    5230. 

  5230. 				if (smallest_number(@contigclustersAllFirstStartLengthOnly) + smallest_number(@contigclustersAllLastEndLengthOnly) < $CLUSTER_DIST){
    5231. 

  5231. 					my @regurgitate = @{$contigclusters{$contigends[$i]{$key3}}}; 
    5232. 

  5232. 					$regurgitate[$#regurgitate]=~s/\n//g;
    5233. 

  5233. 					$regurgitate[$#regurgitate] = $regurgitate[$#regurgitate]."\t".shift(@clusters);
    5234. 

  5234. 					delete $contigclusters{$contigends[$i]{$key3}};
    5235. 

  5235. 					$contigclusters{$contigends[$i]{$key3}}=[ @regurgitate ];
    5236. 

  5236. 					delete $contigclusters{$key2};
    5237. 

  5237. 					$contigclusters{$key2}= [ @clusters ] if scalar(@clusters) >0;
    5238. 

  5238. 					$contigclusters{$key2}= [ "" ] if scalar(@clusters) ==0;
    5239. 

  5239. 					
    5240. 

  5240. 					if (scalar(@clusters) < 1){
    5241. 

  5241. 				#		print "$key2-> $clusteringpaths{$key2} in the loners\n" if exists $foundkeys{$key2};
    5242. 

  5242. 						$clusteringpaths{$key2}=$contigends[$i]{$key3};	
    5243. 

  5243. 						$clusteringpathsRev{$contigends[$i]{$key3}}=$key2;				
    5244. 

  5244. 						print OUTP "$contigends[$i]{$key3} -> $clusteringpathsRev{$contigends[$i]{$key3}}\n";
    5245. 

  5245. 	#					print " clusteringpaths $key2 -> $contigends[$i]{$key3}\n";
    5246. 

  5246. 						$founkeys_enteredcount-- if exists $foundkeys{$key2};
    5247. 

  5247. 						$existing_removed++  if exists $foundkeys{$key2};
    5248. 

  5248. #						print "$key2->",@{$contigclusters{$key2}},"->>$foundkeys{$key2}\n" if exists $foundkeys{$key2} && $prinkter == 1;
    5249. 

  5249. 						delete $foundkeys{$key2} if exists $foundkeys{$key2};
    5250. 

  5250. 						$complete_transfered++;
    5251. 

  5251. 					}
    5252. 

  5252. 					else{
    5253. 

  5253. 						print OUTP "$key2-> 0 not so lonely\n"  if !exists $clusteringpathsRev{$key2};
    5254. 

  5254. 						$clusteringpaths{$key2}=$key2  if !exists $clusteringpaths{$key2};
    5255. 

  5255. 						$clusteringpathsRev{$key2}=0 if !exists $clusteringpathsRev{$key2};
    5256. 

  5256. 						
    5257. 

  5257. 						$founkeys_enteredcount++ if !exists $foundkeys{$key2};
    5258. 

  5258. 						$foundkeys{$key2} = $key2 if !exists $foundkeys{$key2};
    5259. 

  5259. 	#					print "adding foundkeys entry $foundkeys{$key2}\n";
    5260. 

  5260. 						$transfered++;				
    5261. 

  5261. 					}
    5262. 

  5262. 					#$contigclusters{$key2}=[ @contigcluster ];
    5263. 

  5263. 				}
    5264. 

  5264. 			}
    5265. 

  5265. 			else{
    5266. 

  5266. 	#					print "adjacent block with species $tags[$i] does not exist\n" if $prinkter == 1; 
    5267. 

  5267. 						$plain_transfered++;
    5268. 

  5268. 						print OUTP "$key2-> 0 , going straight\n"  if exists $contigclusters{$key2} && !exists $clusteringpathsRev{$key2};
    5269. 

  5269. 						$clusteringpaths{$key2}=$key2 if exists $contigclusters{$key2} && !exists $clusteringpaths{$key2};
    5270. 

  5270. 						$clusteringpathsRev{$key2}=0  if exists $contigclusters{$key2} && !exists $clusteringpathsRev{$key2};
    5271. 

  5271. 						$founkeys_enteredcount++ if !exists $foundkeys{$key2} && exists $contigclusters{$key2};
    5272. 

  5272. 						$foundkeys{$key2} = $key2 if !exists $foundkeys{$key2} && exists $contigclusters{$key2};
    5273. 

  5273. 	#					print "adding foundkeys entry $foundkeys{$key2}\n";
    5274. 

  5274. 				
    5275. 

  5275. 			}
    5276. 

  5276. 			$totalcount++;
    5277. 

  5277. 	
    5278. 

  5278. 		}
    5279. 

  5279. 		
    5280. 

  5280. 		
    5281. 

  5281. 	}
    5282. 

  5282. 	close BO;
    5283. 

  5283. 	#close (NORTH);
    5284. 

  5284. 	#///////////////////////////////////////////////////////////////////////////////////////
    5285. 

  5285. 	#///////////////////////////////////////////////////////////////////////////////////////
    5286. 

  5286. 	#///////////////////////////////////////////////////////////////////////////////////////
    5287. 

  5287. 	#///////////////////////////////////////////////////////////////////////////////////////
    5288. 

  5288. 	
    5289. 

  5289. 	my $founkeys_count=();
    5290. 

  5290. 	my $nopath_count=();
    5291. 

  5291. 	my $pathed_count=0; 
    5292. 

  5292. 	foreach my $key2 (keys %foundkeys){
    5293. 

  5293. 		#print "x" x 60, "\n";
    5294. 

  5294. #		print "x" if $dotcounter % 100 ==0;
    5295. 

  5295. #		print "\n" if $dotcounter % 5000 ==0;
    5296. 

  5296. 		$founkeys_count++;
    5297. 

  5297. 		my $key = $key2;
    5298. 

  5298. #		print "$key2 -> $clusteringpaths{$key2}\n" if $prinkter == 1;
    5299. 

  5299. 		if ($clusteringpaths{$key} eq $key){
    5300. 

  5300. #			print "printing hit the alignment block immediately... no path needed\n" if $prinkter == 1;
    5301. 

  5301. 			$nopath_count++;
    5302. 

  5302. 			delete $foundkeys{$key2};
    5303. 

  5303. 			print ORTH join ("\n",@{$contigclusters{$key2}}),"\n";
    5304. 

  5304. 		}
    5305. 

  5305. 		else{
    5306. 

  5306. 			my @pool=();
    5307. 

  5307. 			my $key3=();
    5308. 

  5308. 			$pathed_count++;
    5309. 

  5309. #			print "going reverse... clusteringpathsRev, $key = $clusteringpathsRev{$key}\n" if exists $clusteringpathsRev{$key} && $prinkter == 1;
    5310. 

  5310. #			print "going reverse... clusteringpathsRev  $key does not exist\n" if !exists $clusteringpathsRev{$key} && $prinkter == 1;
    5311. 

  5311. 			if ($clusteringpathsRev{$key} eq "0") {
    5312. 

  5312.  				next;
    5313. 

  5313. 			}
    5314. 

  5314. 			else{
    5315. 

  5315. 				my $yek3 = $clusteringpathsRev{$key};
    5316. 

  5316. 				my $yek = $key;
    5317. 

  5317. #				print "caught in the middle of a path, now goin down from $yek to $yek3, which is $clusteringpathsRev{$key} \n" if $prinkter == 1;
    5318. 

  5318. 				while ($yek3 ne "0"){
    5319. 

  5319. #					print "$yek->$yek3," if $prinkter == 1;
    5320. 

  5320. 					$yek = $yek3;
    5321. 

  5321. 					$yek3 = $clusteringpathsRev{$yek};
    5322. 

  5322. 				}
    5323. 

  5323. #				print "\nfinally reached the end of path: $yek3, and the next in line is $yek, and its up-route is  $clusteringpaths{$yek}\n" if $prinkter == 1; 
    5324. 

  5324. 				$key3 = $clusteringpaths{$yek};
    5325. 

  5325. 				$key = $yek;
    5326. 

  5326. 			}
    5327. 

  5327. 		
    5328. 

  5328. #			print "now that we are at bottom of the path, lets start climbing up again\n" if $prinkter == 1;
    5329. 

  5329. 			
    5330. 

  5330. 			while($key ne $key3){
    5331. 

  5331. #				print "KEEY $key->$key3\n" if $prinkter == 1;
    5332. 

  5332. #				print "our contigcluster = @{$contigclusters{$key}}\n----------\n" if $prinkter == 1;
    5333. 

  5333. 				
    5334. 

  5334. 				if (scalar(@{$contigclusters{$key}}) > 0) {push @pool, @{$contigclusters{$key}}; 
    5335. 

  5335. 				#	print "now pool = @pool\n" if $prinkter == 1;
    5336. 

  5336. 				}
    5337. 

  5337. 				delete $foundkeys{$key3};
    5338. 

  5338. 				$key=$key3;
    5339. 

  5339. 				$key3=$clusteringpaths{$key};
    5340. 

  5340. 			}
    5341. 

  5341. #			print "\nfinally, adding the first element of path: @{$contigclusters{$key}}\n AND printing the contents:\n" if $prinkter == 1;
    5342. 

  5342. 			my @firstcontig= @{$contigclusters{$key}};
    5343. 

  5343. 			delete $foundkeys{$key2} if exists $foundkeys{$key2} ;
    5344. 

  5344. 			delete $foundkeys{$key} if exists $foundkeys{$key};
    5345. 

  5345. 	
    5346. 

  5346. 			unshift @pool, pop @firstcontig;
    5347. 

  5347. #			print join("\t",@pool),"\n" if $prinkter == 1;
    5348. 

  5348. 			print ORTH join ("\n",@firstcontig),"\n" if scalar(@firstcontig) > 0;
    5349. 

  5349. 			print ORTH join ("\t",@pool),"\n";		
    5350. 

  5350. 		#	join();
    5351. 

  5351. 		}
    5352. 

  5352. 	
    5353. 

  5353. 	}
    5354. 

  5354. 	#close (NORTH);
    5355. 

  5355. #	print "founkeys_entered =$founkeys_enteredcount, plain_transfered=$plain_transfered,existing_removed=$existing_removed,founkeys_count =$founkeys_count, nopath_count =$nopath_count, transfered = $transfered, complete_transfered = $complete_transfered, totalcount = $totalcount, pathed=$pathed_count\n" if $prinkter == 1;
    5356. 

  5356. 	close (BO);
    5357. 

  5357. 	close (ORTH);
    5358. 

  5358. 	close (OUTP);
    5359. 

  5359. 	return 1;
    5360. 

  5360. 	
    5361. 

  5361. }
    5362. 

  5362. sub stringPainter{
    5363. 

  5363. 	my @string  = split(/_C0C_/,$_[0]);
    5364. 

  5364. #	print $_[0], " <- in stringPainter\n";
    5365. 

  5365. #	print $_[1], " <- in clusters\n";
    5366. 

  5366. 	
    5367. 

  5367. 	my @clusters = split(/,/, $_[1]);
    5368. 

  5368. 	for my $i (0 ... $#clusters){
    5369. 

  5369. 		my $cluster = $clusters[$i];
    5370. 

  5370. #		print "cluster = $cluster\n";
    5371. 

  5371. 		my @parts = split(/\./,$cluster);
    5372. 

  5372. 		my @cord = split(/:|-/,shift(@parts));
    5373. 

  5373. 		my $minstart = $cord[1];
    5374. 

  5374. 		my $maxend = $cord[2];
    5375. 

  5375. #		print "minstart = $minstart , maxend = $maxend\n";
    5376. 

  5376. 		
    5377. 

  5377. 		for my $j (0 ... $#parts){
    5378. 

  5378. #			print "oing thri $parts[$j]\n";
    5379. 

  5379. 			my @cord = split(/:|-/,$parts[$j]);
    5380. 

  5380. 			$minstart = $cord[1] if $cord[1] < $minstart;
    5381. 

  5381. 			$maxend = $cord[2] if $cord[2] > $maxend;
    5382. 

  5382. 		}
    5383. 

  5383. #		print "minstart = $minstart , maxend = $maxend\n";
    5384. 

  5384. 		for my $pos ($minstart ... $maxend){ $string[$pos] = $string[$pos].",".$cluster;}
    5385. 

  5385. 				
    5386. 

  5386. 		
    5387. 

  5387. 	}
    5388. 

  5388. #	print "@string <-done from function stringPainter\n";
    5389. 

  5389. 	return join("_S0S_",@string);
    5390. 

  5390. }
    5391. 

  5391. 

  5392. sub findClusters{
    5393. 

  5393. 	my $continue = 0;
    5394. 

  5394. 	my @mapped_clusters = ();	
    5395. 

  5395. 	my $clusterdist = $_[1];
    5396. 

  5396. 	my $previous = 'x';
    5397. 

  5397. 	my @localcluster = ();
    5398. 

  5398. 	my $cluster_starts = ();
    5399. 

  5399. 	my $cluster_ends = ();
    5400. 

  5400. 	my $localcluster_start = ();
    5401. 

  5401. 	my $localcluster_end = ();
    5402. 

  5402. 	my @record_cluster = ();
    5403. 

  5403. 	my @string = split(/\!/, $_[0]);
    5404. 

  5404. 	my $zerolength=0;
    5405. 

  5405. 	
    5406. 

  5406. 	for my $pos_pos (1 ... $#string){
    5407. 

  5407. 			my $pos = $string[$pos_pos];
    5408. 

  5408. #			print $pos, "\n";
    5409. 

  5409. 			if ($continue == 0 && $pos eq "x") {next;}
    5410. 

  5410. 			
    5411. 

  5411. 			if ($continue == 1 && $pos eq "x" && $zerolength <= $clusterdist){ 
    5412. 

  5412. 				if ($zerolength == 0) {$localcluster_end = $pos_pos-1};
    5413. 

  5413. 				$zerolength++; 
    5414. 

  5414. 				$continue = 1; 
    5415. 

  5415. 			}
    5416. 

  5416. 

  5417. 			if ($continue == 1 && $pos eq "x" && $zerolength > $clusterdist) { 
    5418. 

  5418. 				$zerolength = 0; 
    5419. 

  5419. 				$continue = 0; 
    5420. 

  5420. 				my %seen;
    5421. 

  5421. 				my @uniqed = grep !$seen{$_}++, @localcluster;
    5422. 

  5422. #				print "caught cluster : @uniqed \n";
    5423. 

  5423. 				push(@mapped_clusters, [@uniqed]);
    5424. 

  5424. #				print "clustered:\n@uniqed\n";
    5425. 

  5425. 				@localcluster = ();
    5426. 

  5426. 				@record_cluster = ();
    5427. 

  5427. 				
    5428. 

  5428. 			}
    5429. 

  5429. 			
    5430. 

  5430. 			if ($pos ne "x"){
    5431. 

  5431. 				$zerolength = 0;
    5432. 

  5432. 				$continue = 1;
    5433. 

  5433. 				$pos =~ s/x,//g;
    5434. 

  5434. 				my @entries = split(/,/,$pos);
    5435. 

  5435. 				$localcluster_end = 0;
    5436. 

  5436. 				$localcluster_start = 0;
    5437. 

  5437. 				push(@record_cluster,$pos);
    5438. 

  5438. 			
    5439. 

  5439. 				if ($continue == 0){
    5440. 

  5440. 					@localcluster = ();
    5441. 

  5441. 					@localcluster = (@localcluster, @entries);
    5442. 

  5442. 					$localcluster_start = $pos_pos;
    5443. 

  5443. 				}
    5444. 

  5444. 			
    5445. 

  5445. 				if ($continue == 1 ) {
    5446. 

  5446. 					@localcluster = (@localcluster, @entries);
    5447. 

  5447. 				}
    5448. 

  5448. 			}
    5449. 

  5449. 	}
    5450. 

  5450. 	
    5451. 

  5451. 	if (scalar(@localcluster) > 0){
    5452. 

  5452. 		my %seen;
    5453. 

  5453. 		my @uniqed = grep !$seen{$_}++, @localcluster;
    5454. 

  5454. 	#	print "caught cluster : @uniqed \n";
    5455. 

  5455. 		push(@mapped_clusters, [@uniqed]);
    5456. 

  5456. 	#	print "clustered:\n@uniqed\n";
    5457. 

  5457. 		@localcluster = ();
    5458. 

  5458. 		@record_cluster = ();
    5459. 

  5459. 	}
    5460. 

  5460. 

  5461. 	my @returner = ();
    5462. 

  5462. 	
    5463. 

  5463. 	foreach my $clust (@mapped_clusters){
    5464. 

  5464. 		my @localclust = @$clust;
    5465. 

  5465. 		my @result = ();
    5466. 

  5466. 		foreach my $clustparts (@localclust){
    5467. 

  5467. 			push(@result,$clustparts);
    5468. 

  5468. 		}
    5469. 

  5469. 		push(@returner , join(".",@result));
    5470. 

  5470. 	}	
    5471. 

  5471. #	print "returnig: ", join(",",@returner), "\n";
    5472. 

  5472. 	return join(",",@returner);
    5473. 

  5473. }
    5474. 

  5474. #xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx  multiSpecies_orthFinder4 xxxxxxxxxxxxxx  multiSpecies_orthFinder4 xxxxxxxxxxxxxx 
    5475. 

  5475. 

  5476. #xxxxxxxxxxxxxx MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx  MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx  MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx 
    5477. 

  5477. 

  5478. sub MakeTrees{
    5479. 

  5479. 	my $tree = $_[0];
    5480. 

  5480. 	my @parts=($tree);
    5481. 

  5481. #	my @parts=();
    5482. 

  5482. 	
    5483. 

  5483. 	while (1){
    5484. 

  5484. 		$tree =~ s/^\(//g;
    5485. 

  5485. 		$tree =~ s/\)$//g;
    5486. 

  5486. 		my @arr = ();
    5487. 

  5487. 	
    5488. 

  5488. 		if ($tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)\)$/){
    5489. 

  5489. 			@arr = $tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)$/;
    5490. 

  5490. 			$tree = $2;
    5491. 

  5491. 			push @parts, $tree;
    5492. 

  5492. 		}
    5493. 

  5493. 		elsif ($tree =~ /^\(([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/){
    5494. 

  5494. 			@arr = $tree =~ /^([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/;
    5495. 

  5495. 			$tree = $1;
    5496. 

  5496. 			push @parts, $tree;
    5497. 

  5497. 		}
    5498. 

  5498. 		elsif ($tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_]+)$/){
    5499. 

  5499. 			last;
    5500. 

  5500. 		}
    5501. 

  5501. 	}	
    5502. 

  5502. 	return @parts;
    5503. 

  5503. }
    5504. 

  5504. 

  5505. #xxxxxxxxxxxxxx qualityFilter xxxxxxxxxxxxxxxxxxxxxxxxxxxx  qualityFilter xxxxxxxxxxxxxxxxxxxxxxxxxxxx  qualityFilter xxxxxxxxxxxxxxxxxxxxxxxxxxxx 
    5506. 

  5506. 

  5507. sub qualityFilter{
    5508. 

  5508. 	my $unmaskedorthfile = $_[0];
    5509. 

  5509. 	my $seqfile = $_[1];
    5510. 

  5510. 	my $maskedorthfile = $_[2];
    5511. 

  5511. 	my $filteredout = $maskedorthfile."_residue";
    5512. 

  5512. 	open (PMORTH, "<$unmaskedorthfile") or die "Cannot open unmaskedorthfile file: $unmaskedorthfile: $!";
    5513. 

  5513. 

  5514. 	my %keyhash = ();
    5515. 

  5515. 	
    5516. 

  5516. 	while (my $line = <PMORTH>){
    5517. 

  5517. 		my $key = join("\t", $1,$2,$3,$4) if $line =~ /($focalspec)\s+([a-zA-Z0-9\-_]+)\s+([0-9]+)\s+([0-9]+)/;
    5518. 

  5518. 		push @{$keyhash{$key}}, $line;
    5519. 

  5519. 	}
    5520. 

  5520. 	
    5521. 

  5521. 	open (SEQ, "<$seqfile") or die "Cannot open seqfile file: $seqfile: $!";
    5522. 

  5522. 	open (MORTH, ">$maskedorthfile") or die "Cannot open maskedorthfile file: $maskedorthfile: $!";
    5523. 

  5523.         open (RES, ">$filteredout") or die "Cannot open filteredout file: $filteredout: $!";
    5524. 

  5524. 

  5525. 

  5526. 	
    5527. 

  5527. 	while (my $line = <SEQ>){
    5528. 

  5528. 		chomp $line;
    5529. 

  5529. 		if ($line =~ /($focalspec)\s+([a-zA-Z0-9\-_]+)\s+([0-9]+)\s+([0-9]+)/){
    5530. 

  5530. 			my $key = join("\t", $1,$2,$3,$4);
    5531. 

  5531. 			next if !exists $keyhash{$key};
    5532. 

  5532. 			my @orths = @{$keyhash{$key}} if exists $keyhash{$key};
    5533. 

  5533. 			delete $keyhash{$key};
    5534. 

  5534. 			
    5535. 

  5535. 			my $sine = <SEQ>;
    5536. 

  5536. 			
    5537. 

  5537. 			foreach my $orth (@orths){
    5538. 

  5538. 				#print "-----------------------------------------------------------------\n";
    5539. 

  5539. 				#print $orth;
    5540. 

  5540. 				my $orthcopy = $orth;
    5541. 

  5541. 				$orth =~ s/^>//;
    5542. 

  5542. 				my @parts = split(/>/,$orth);
    5543. 

  5543. 				
    5544. 

  5544. 				my @starts = ();
    5545. 

  5545. 				my @ends = ();
    5546. 

  5546. 				
    5547. 

  5547. 				foreach my $part (@parts){
    5548. 

  5548. 					my $no_of_species = adjustCoordinates($part);
    5549. 

  5549. 					my @pields = split(/\t/,$part);
    5550. 

  5550. 					
    5551. 

  5551. 				#	print "pields = @pields .. no_of_species = $no_of_species .. startcord = $pields[$startcord]\n";
    5552. 

  5552. 					
    5553. 

  5553. 					push @starts, $pields[$startcord];
    5554. 

  5554. 					push @ends, $pields[$endcord];
    5555. 

  5555. 				}
    5556. 

  5556. 				
    5557. 

  5557. 				#print "starts = @starts ... ends = @ends\n";
    5558. 

  5558. 				
    5559. 

  5559. 				my $leftend = smallest_number(@starts)-10;
    5560. 

  5560. 				my $rightend = largest_number(@ends)+10;
    5561. 

  5561. 

  5562. 				my $maskarea = substr($sine, $leftend, $rightend-$leftend+1);
    5563. 

  5563. 				print RES $orth if $maskarea =~ /#/;		
    5564. 

  5564. 				
    5565. 

  5565. 				
    5566. 

  5566. 				next if $maskarea =~ /#/;
    5567. 

  5567. 				
    5568. 

  5568. 				print MORTH $orthcopy;
    5569. 

  5569. 			}
    5570. 

  5570. 		}
    5571. 

  5571. 		else{
    5572. 

  5572. 			next;
    5573. 

  5573. 		}
    5574. 

  5574. 		
    5575. 

  5575. 		
    5576. 

  5576. 	}
    5577. 

  5577. 	
    5578. 

  5578. #	print "UNDONE: ", scalar(keys %keyhash),"\n";
    5579. 

  5579. #	print MORTH "UNDONE: ", scalar(keys %keyhash),"\n";
    5580. 

  5580. 	
    5581. 

  5581. }
    5582. 

  5582. 

  5583. sub adjustCoordinates{
    5584. 

  5584. 	my $line = $_[0];
    5585. 

  5585. 	my $no_of_species = $line =~ s/(chr[0-9a-zA-Z]+)|(Contig[0-9a-zA-Z\._\-]+)|(scaffold[0-9a-zA-Z\._\-]+)|(supercontig[0-9a-zA-Z\._\-]+)/x/ig;
    5586. 

  5586. 	my @got = ($line =~ s/(chr[0-9a-zA-Z]+)|(Contig[0-9a-zA-Z\._\-]+)/x/g);
    5587. 

  5587. # print "line = $line\n";
    5588. 

  5588. 	$infocord = 2 + (4*$no_of_species) - 1;
    5589. 

  5589. 	$typecord = 2 + (4*$no_of_species) + 1 - 1;
    5590. 

  5590. 	$motifcord = 2 + (4*$no_of_species) + 2 - 1;
    5591. 

  5591. 	$gapcord = $motifcord+1;
    5592. 

  5592. 	$startcord = $gapcord+1;
    5593. 

  5593. 	$strandcord = $startcord+1;
    5594. 

  5594. 	$endcord = $strandcord + 1;
    5595. 

  5595. 	$microsatcord = $endcord + 1;
    5596. 

  5596. 	$sequencepos = 2 + (5*$no_of_species) + 1 -1 ; 
    5597. 

  5597. 	$interr_poscord = $microsatcord + 3;
    5598. 

  5598. 	$no_of_interruptionscord = $microsatcord + 4;
    5599. 

  5599. 	$interrcord = $microsatcord + 2;
    5600. 

  5600. #	print "$line\n startcord = $startcord, and endcord = $endcord and no_of_species = $no_of_species\n" if $line !~ /calJac/i;
    5601. 

  5601. 	return $no_of_species;
    5602. 

  5602. }
    5603. 

  5603. 

  5604. 

  5605. 

  5606. 

  5607.