diff --git a/lib/tool_shed/galaxy_install/migrate/versions/0008_tools.py b/lib/tool_shed/galaxy_install/migrate/versions/0008_tools.py
new file mode 100644
index 00000000000..e028d455afa
--- /dev/null
+++ b/lib/tool_shed/galaxy_install/migrate/versions/0008_tools.py
@@ -0,0 +1,106 @@
+"""
+The following tools have been eliminated from the distribution:
+
+1: BAM-to-SAM converts BAM format to SAM format
+2: Categorize Elements satisfying criteria
+3: Compute Motif Frequencies For All Motifs motif by motif
+4: Compute Motif Frequencies in indel flanking regions
+5: CTD analysis of chemicals, diseases, or genes
+6: Delete Overlapping Indels from a chromosome indels file
+7: Separate pgSnp alleles into columns
+8: Draw Stacked Bar Plots for different categories and different criteria
+9: Length Distribution chart
+10: FASTA Width formatter
+11: RNA/DNA converter
+12: Draw quality score boxplot
+13: Quality format converter (ASCII-Numeric)
+14: Filter by quality
+15: FASTQ to FASTA converter
+16: Remove sequencing artifacts
+17: Barcode Splitter
+18: Clip adapter sequences
+19: Collapse sequences
+20: Draw nucleotides distribution chart
+21: Compute quality statistics
+22: Rename sequences
+23: Reverse- Complement
+24: Trim sequences
+25: FunDO human genes associated with disease terms
+26: HVIS visualization of genomic data with the Hilbert curve
+27: Fetch Indels from 3-way alignments
+28: Identify microsatellite births and deaths
+29: Extract orthologous microsatellites for multiple (>2) species alignments
+30: Mutate Codons with SNPs
+31: Pileup-to-Interval condenses pileup format into ranges of bases
+32: Filter pileup on coverage and SNPs
+33: Filter SAM on bitwise flag values
+34: Merge BAM Files merges BAM files together
+35: Generate pileup from BAM dataset
+36: SAM-to-BAM converts SAM format to BAM format
+37: Convert SAM to interval
+38: flagstat provides simple stats on BAM files
+39: MPileup SNP and indel caller
+40: rmdup remove PCR duplicates
+41: Slice BAM by provided regions
+42: Split paired end reads
+43: T Test for Two Samples
+44: Plotting tool for multiple series and graph types.
+
+The tools are now available in the repositories respectively:
+
+1: bam_to_sam
+2: categorize_elements_satisfying_criteria
+3: compute_motif_frequencies_for_all_motifs
+4: compute_motifs_frequency
+5: ctd_batch
+6: delete_overlapping_indels
+7: divide_pg_snp
+8: draw_stacked_barplots
+9: fasta_clipping_histogram
+10: fasta_formatter
+11: fasta_nucleotide_changer
+12: fastq_quality_boxplot
+13: fastq_quality_converter
+14: fastq_quality_filter
+15: fastq_to_fasta
+16: fastx_artifacts_filter
+17: fastx_barcode_splitter
+18: fastx_clipper
+19: fastx_collapser
+20: fastx_nucleotides_distribution
+21: fastx_quality_statistics
+22: fastx_renamer
+23: fastx_reverse_complement
+24: fastx_trimmer
+25: hgv_fundo
+26: hgv_hilbertvis
+27: indels_3way
+28: microsatellite_birthdeath
+29: multispecies_orthologous_microsats
+30: mutate_snp_codon
+31: pileup_interval
+32: pileup_parser
+33: sam_bitwise_flag_filter
+34: sam_merge
+35: sam_pileup
+36: sam_to_bam
+37: sam2interval
+38: samtools_flagstat
+39: samtools_mpileup
+40: samtools_rmdup
+41: samtools_slice_bam
+42: split_paired_reads
+43: t_test_two_samples
+44: xy_plot
+
+from the main Galaxy tool shed at http://toolshed.g2.bx.psu.edu
+and will be installed into your local Galaxy instance at the
+location discussed above by running the following command.
+
+"""
+
+def upgrade( migrate_engine ):
+ print __doc__
+
+def downgrade( migrate_engine ):
+ pass
diff --git a/scripts/migrate_tools/0008_tools.sh b/scripts/migrate_tools/0008_tools.sh
new file mode 100644
index 00000000000..50cafd19936
--- /dev/null
+++ b/scripts/migrate_tools/0008_tools.sh
@@ -0,0 +1,4 @@
+#!/bin/sh
+
+cd `dirname $0`/../..
+python ./scripts/migrate_tools/migrate_tools.py 0008_tools.xml $@
diff --git a/scripts/migrate_tools/0008_tools.xml b/scripts/migrate_tools/0008_tools.xml
new file mode 100644
index 00000000000..339f1b3efbf
--- /dev/null
+++ b/scripts/migrate_tools/0008_tools.xml
@@ -0,0 +1,135 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/test-data/1.bam b/test-data/1.bam
deleted file mode 100644
index 95c65de8572..00000000000
Binary files a/test-data/1.bam and /dev/null differ
diff --git a/test-data/3unsorted.bam b/test-data/3unsorted.bam
deleted file mode 100644
index e86c83a4aa2..00000000000
Binary files a/test-data/3unsorted.bam and /dev/null differ
diff --git a/test-data/pileup_parser.6col.pileup b/test-data/pileup_parser.6col.pileup
deleted file mode 100644
index df6fdf75c72..00000000000
--- a/test-data/pileup_parser.6col.pileup
+++ /dev/null
@@ -1,1000 +0,0 @@
-chrM 42 C 1 ^:. I
-chrM 43 C 2 .^:. II
-chrM 44 T 2 .. II
-chrM 45 A 3 ..^:. III
-chrM 46 G 4 ...^:. IIII
-chrM 47 A 5 ....^:, IIIII
-chrM 48 T 5 ...., IIIII
-chrM 49 G 5 ...., IIIII
-chrM 50 A 5 ...., IIIII
-chrM 51 G 5 ...., IIIII
-chrM 52 T 5 ...., IIIII
-chrM 53 A 5 ...., IIIII
-chrM 54 T 5 ...., IIIII
-chrM 55 T 5 ...., IIIII
-chrM 56 C 5 ...., IIIII
-chrM 57 T 5 ...., IIIII
-chrM 58 T 5 ...., IIIII
-chrM 59 A 5 ...., IIIII
-chrM 60 C 5 ...., IIIII
-chrM 61 T 5 ...., IIIII
-chrM 62 C 5 ...., IIIII
-chrM 63 C 5 ...., IIIII
-chrM 64 A 5 ...., IIIII
-chrM 65 T 5 ...., IIIII
-chrM 66 A 5 ...., IIIII
-chrM 67 A 5 ...., IIIII
-chrM 68 A 5 ...., IIICI
-chrM 69 C 5 ...., IIIII
-chrM 70 A 5 ...., IIIII
-chrM 71 C 5 ...., IIIII
-chrM 72 A 5 ...., IAIII
-chrM 73 T 5 ...., IIIII
-chrM 74 A 5 ...., IIIII
-chrM 75 G 5 ...., %IIII
-chrM 76 G 5 T..., *IIII
-chrM 77 C 5 .$..., GIIII
-chrM 78 T 4 .$.., IIII
-chrM 79 T 3 .., III
-chrM 80 G 3 .$., I1I
-chrM 81 G 2 .$, II
-chrM 82 T 1 ,$ I
-chrM 83 C 2 ^:.^:. II
-chrM 84 C 2 .. II
-chrM 85 T 2 .. II
-chrM 86 A 2 .. II
-chrM 87 G 2 .. II
-chrM 88 C 2 .. II
-chrM 89 C 2 .. II
-chrM 90 T 2 .. II
-chrM 91 T 2 .. II
-chrM 92 T 2 .. II
-chrM 93 T 2 .. II
-chrM 94 T 2 .. II
-chrM 95 A 2 .. II
-chrM 96 T 2 .. II
-chrM 97 T 2 .. II
-chrM 98 A 2 .. II
-chrM 99 G 2 .. II
-chrM 100 T 2 .. II
-chrM 101 T 2 .. II
-chrM 102 A 2 .. II
-chrM 103 T 2 .. II
-chrM 104 T 2 .. II
-chrM 105 A 2 .. IE
-chrM 106 A 2 .. II
-chrM 107 T 2 .. II
-chrM 108 A 2 .. II
-chrM 109 G 2 .. II
-chrM 110 A 2 .. II
-chrM 111 A 2 .. I2
-chrM 112 T 2 .. II
-chrM 113 T 2 .. II
-chrM 114 A 2 .. H7
-chrM 115 C 2 .. II
-chrM 116 A 2 .. II
-chrM 117 C 2 .. II
-chrM 118 A 2 .$.$ F8
-chrM 156 T 1 ^:, &
-chrM 157 C 1 , I
-chrM 158 A 2 g^:g I>
-chrM 159 C 2 ,, /F
-chrM 160 G 2 ,, II
-chrM 161 T 2 ,, I>
-chrM 162 C 2 ,, .-
-chrM 163 T 2 ,, I8
-chrM 164 C 2 ,, 4F
-chrM 165 T 2 ,, II
-chrM 166 A 2 ,, II
-chrM 167 C 2 ,, ;6
-chrM 168 G 2 ,, II
-chrM 169 A 2 ,, II
-chrM 170 T 2 ,, II
-chrM 171 T 2 ,, IB
-chrM 172 A 2 ,, II
-chrM 173 A 2 ,, II
-chrM 174 A 2 ,, II
-chrM 175 A 2 ,, II
-chrM 176 G 2 ,, II
-chrM 177 G 2 ,, II
-chrM 178 A 2 ,, II
-chrM 179 G 2 ,, II
-chrM 180 C 2 ,, II
-chrM 181 A 3 ,,^:, III
-chrM 182 G 3 ,,, III
-chrM 183 G 3 ,,, III
-chrM 184 T 3 ,,, III
-chrM 185 A 3 ,,, III
-chrM 186 T 3 ,,, III
-chrM 187 C 3 ,,, III
-chrM 188 A 3 ,,, III
-chrM 189 A 3 ,,, III
-chrM 190 G 3 ,,, III
-chrM 191 C 3 ,$,, III
-chrM 192 A 2 ,, II
-chrM 193 C 2 ,$, II
-chrM 194 A 1 , I
-chrM 195 C 1 , I
-chrM 196 T 1 , F
-chrM 197 A 1 , I
-chrM 198 G 1 , I
-chrM 199 A 1 , I
-chrM 200 A 1 , I
-chrM 201 A 2 ,^:. I-
-chrM 202 G 2 ,. II
-chrM 203 T 2 ,. II
-chrM 204 A 2 ,. II
-chrM 205 G 2 ,. I6
-chrM 206 C 2 ,. II
-chrM 207 T 2 ,. I,
-chrM 208 C 2 ,. II
-chrM 209 A 2 ,. II
-chrM 210 T 2 ,. II
-chrM 211 A 2 ,. II
-chrM 212 A 2 ,. IE
-chrM 213 C 2 ,. IC
-chrM 214 A 2 ,. I;
-chrM 215 C 2 ,. II
-chrM 216 C 2 ,$. II
-chrM 217 T 1 . I
-chrM 218 T 1 . I
-chrM 219 G 1 T I
-chrM 220 C 1 . I
-chrM 221 T 1 . I
-chrM 222 C 1 . E
-chrM 223 A 1 . 4
-chrM 224 G 1 T 9
-chrM 225 C 1 . :
-chrM 226 C 1 . ?
-chrM 227 A 1 . .
-chrM 228 C 1 . C
-chrM 229 A 3 .^:,^:, %II
-chrM 230 C 3 .,, 8II
-chrM 231 C 3 .,, 9II
-chrM 232 C 3 .,, III
-chrM 233 C 3 .,, AI'
-chrM 234 C 3 .,, DI+
-chrM 235 A 3 .,, &I@
-chrM 236 C 3 .$,a +I$
-chrM 237 G 2 ,, II
-chrM 238 G 2 ,, II
-chrM 239 G 2 ,, II
-chrM 240 A 2 ,, II
-chrM 241 C 2 ,, I+
-chrM 242 A 2 ,, II
-chrM 243 C 2 ,, II
-chrM 244 A 3 ,,^:, II;
-chrM 245 G 3 ,,, II*
-chrM 246 C 3 ,,n II"
-chrM 247 A 3 ,,, III
-chrM 248 G 4 ,,,^:. IIII
-chrM 249 T 4 ,,,. II)I
-chrM 250 G 4 ,,,. II2I
-chrM 251 A 4 ,,,. II(I
-chrM 252 T 4 ,,,. II*I
-chrM 253 A 4 ,,,. II7I
-chrM 254 A 4 ,,,. II1I
-chrM 255 A 4 ,,,. II?I
-chrM 256 A 4 ,,,. II9I
-chrM 257 A 4 ,,,. II?I
-chrM 258 T 4 ,,,. II$I
-chrM 259 T 5 ,,,.^:. II&II
-chrM 260 A 5 ,,,.. II,II
-chrM 261 A 5 ,,,.. II/II
-chrM 262 G 5 ,,,.. II5II
-chrM 263 C 5 ,,a.. II%II
-chrM 264 T 5 ,$,$,.. II%II
-chrM 265 A 3 ,.. )II
-chrM 266 T 3 ,.. +II
-chrM 267 G 4 ,..^:. *III
-chrM 268 A 4 ,... EIII
-chrM 269 A 4 ,... =III
-chrM 270 C 4 a... ;III
-chrM 271 G 4 ,... ;III
-chrM 272 A 4 ,... 8@II
-chrM 273 A 4 ,... 1III
-chrM 274 A 4 ,... ICII
-chrM 275 G 4 ,... IIII
-chrM 276 T 4 ,... IIII
-chrM 277 T 4 ,... IIII
-chrM 278 C 4 ,... IIII
-chrM 279 G 4 ,$... IIII
-chrM 280 A 3 ... III
-chrM 281 C 3 ... GII
-chrM 282 T 3 ... III
-chrM 283 A 3 .$.. IFI
-chrM 284 A 3 ..^:, IAI
-chrM 285 G 3 .., ;II
-chrM 286 T 4 ..,^:. IIII
-chrM 287 C 4 ..,. II4I
-chrM 288 A 4 ..,. @III
-chrM 289 T 4 ..,. IIII
-chrM 290 A 4 ..,. @:II
-chrM 291 T 4 ..,. IIAI
-chrM 292 T 4 ..,. IIII
-chrM 293 A 4 ..,. 8;II
-chrM 294 A 4 .$.,. III
-chrM 392 A 3 ... III
-chrM 393 T 3 ... III
-chrM 394 A 3 ... III
-chrM 395 A 3 .$.. III
-chrM 396 A 2 .. II
-chrM 397 G 2 .. II
-chrM 398 T 2 .. EI
-chrM 399 T 2 .. II
-chrM 400 A 3 ..^:. III
-chrM 401 A 3 ... III
-chrM 402 A 3 ... III
-chrM 403 A 3 ... III
-chrM 404 C 3 ... III
-chrM 405 C 3 ... III
-chrM 406 C 3 ... EII
-chrM 407 A 3 ... III
-chrM 408 G 3 ... III
-chrM 409 T 3 ... 0II
-chrM 410 T 3 ... III
-chrM 411 A 4 ...^:, IIII
-chrM 412 A 4 ..., FIII
-chrM 413 G 4 ..., IIIH
-chrM 414 C 4 ...a III2
-chrM 415 C 4 TTTt III7
-chrM 416 G 5 ...,^:, II?7:
-chrM 417 T 5 ...,, ;IIE@
-chrM 418 A 5 ...,, IIIII
-chrM 419 A 5 ...,, IIIII
-chrM 420 A 5 ...,, FIIII
-chrM 421 A 5 ...,, IIIII
-chrM 422 A 5 ...,, >IIII
-chrM 423 G 6 ...,,^:, HII/I,
-chrM 424 C 6 .$..a,, ;II-I:
-chrM 425 T 5 .$.,,, IIIIF
-chrM 426 A 5 .,,,^:, III@I
-chrM 427 C 5 .,,,, III$I
-chrM 428 A 5 .,,,, IIIII
-chrM 429 A 5 .,,,, IIII.
-chrM 430 C 5 .,,,a I%I5'
-chrM 431 C 5 .,,,, I(I5<
-chrM 432 A 5 .,,,, IIIII
-chrM 433 A 5 .,,,, 0IIII
-chrM 434 A 5 .,,,, =IIII
-chrM 435 G 5 .$,,,, EIIII
-chrM 436 T 4 ,,,, III5
-chrM 437 A 4 ,,,, IIII
-chrM 438 A 4 ,,,, IIII
-chrM 439 A 4 ,,,, IIII
-chrM 440 A 4 ,,,, IIIF
-chrM 441 T 6 ,,,,^:.^:. III;II
-chrM 442 A 6 ,,,,.. IIIIII
-chrM 443 G 6 ,,,,.. IIIIII
-chrM 444 A 6 ,,,,.. IIIIII
-chrM 445 C 6 ,,,,.. IIIIII
-chrM 446 T 6 ,$,,,.. IIIIII
-chrM 447 A 5 ,,,.. IIIII
-chrM 448 C 5 ,,,.. IIIII
-chrM 449 G 6 ,,,..^:, IIIII6
-chrM 450 A 6 ,,,.., IIIIII
-chrM 451 A 6 ,$,,.., IIIIII
-chrM 452 A 5 ,,.., IIIII
-chrM 453 G 5 ,,.., IIIII
-chrM 454 T 6 ,,..,^:, IIIIII
-chrM 455 G 6 ,,..,, IIIIII
-chrM 456 A 6 ,,..,, IIIIII
-chrM 457 C 6 ,,..,, IIIII=
-chrM 458 T 6 ,$,..,, IIIIII
-chrM 459 T 5 ,..,, IIIII
-chrM 460 T 5 ,..,, IIIII
-chrM 461 A 5 ,$..,, IIIII
-chrM 462 A 4 ..,, IIII
-chrM 463 T 4 ..,, IIIC
-chrM 464 A 4 ..,, IIII
-chrM 465 C 4 ..,, IIII
-chrM 466 C 4 ..,, IIII
-chrM 467 T 4 ..,, II>?
-chrM 468 C 4 ..,, IIII
-chrM 469 T 4 ..,, IIIG
-chrM 470 G 4 ..,, %III
-chrM 471 A 4 ..,, 4;II
-chrM 472 C 4 ..,, II3I
-chrM 473 T 4 ..,, IIII
-chrM 474 A 4 ..,, ;III
-chrM 475 C 4 ..,, IIII
-chrM 476 A 4 .$.$,, 32II
-chrM 477 C 2 ,, II
-chrM 478 G 2 ,, II
-chrM 479 A 2 ,, II
-chrM 480 T 3 ,,^:. III
-chrM 481 A 3 ,,. III
-chrM 482 G 3 ,,. III
-chrM 483 C 4 ,,.^:, IIIE
-chrM 484 T 4 ,$,., III9
-chrM 485 A 3 ,., III
-chrM 486 A 3 ,., III
-chrM 487 G 3 ,., III
-chrM 488 A 3 ,., III
-chrM 489 C 3 ,$., III
-chrM 490 C 2 ., II
-chrM 491 C 2 ., II
-chrM 492 A 2 ., II
-chrM 493 A 2 ., II
-chrM 494 A 2 ., II
-chrM 495 C 2 ., II
-chrM 496 T 2 ., I2
-chrM 497 G 2 ., II
-chrM 498 G 2 ., II
-chrM 499 G 2 ., II
-chrM 500 A 2 ., II
-chrM 501 T 2 ., II
-chrM 502 T 2 ., II
-chrM 503 A 2 ., II
-chrM 504 G 2 ., II
-chrM 505 A 2 ., GI
-chrM 506 T 2 ., II
-chrM 507 A 2 ., II
-chrM 508 C 2 ., II
-chrM 509 C 2 ., II
-chrM 510 C 3 .,^:. III
-chrM 511 C 3 .,. III
-chrM 512 A 3 .,. 6II
-chrM 513 C 3 .,. III
-chrM 514 T 3 .,. III
-chrM 515 A 3 .$,. III
-chrM 516 T 2 ,. II
-chrM 517 G 2 ,. II
-chrM 518 C 3 ,$.^:. III
-chrM 519 T 2 .. II
-chrM 520 T 3 ..^:, III
-chrM 521 A 3 .., III
-chrM 522 G 3 .., II,
-chrM 523 C 3 .., III
-chrM 524 C 3 .., II7
-chrM 525 C 3 .., III
-chrM 526 T 3 .., II?
-chrM 527 A 3 .., III
-chrM 528 A 3 .., III
-chrM 529 A 3 .., FII
-chrM 530 C 3 .., II+
-chrM 531 T 3 .., III
-chrM 532 A 3 .., :II
-chrM 533 A 3 .., DGI
-chrM 534 A 3 .., III
-chrM 535 A 3 .., ?CI
-chrM 536 T 3 .., III
-chrM 537 A 3 .., 9II
-chrM 538 G 3 .., III
-chrM 539 C 3 .., III
-chrM 540 T 3 .., III
-chrM 541 T 3 .., III
-chrM 542 A 4 ..,^:. IIII
-chrM 543 C 4 ..,. IIII
-chrM 544 C 4 ..,. IIII
-chrM 545 A 4 N$.,. "III
-chrM 546 C 3 .,. III
-chrM 547 A 3 .,. DII
-chrM 548 A 3 .,. EII
-chrM 549 C 3 .,. III
-chrM 550 A 3 .,. III
-chrM 551 A 3 .,. 6II
-chrM 552 A 3 .,. GII
-chrM 553 G 3 .$,. ?II
-chrM 554 C 2 ,. I<
-chrM 555 T 2 ,$. II
-chrM 556 A 2 .^:. II
-chrM 557 T 2 .. II
-chrM 558 T 2 .. II
-chrM 559 C 2 .. II
-chrM 560 G 2 .. II
-chrM 561 C 2 .. II
-chrM 562 C 2 .. II
-chrM 563 A 2 .. CI
-chrM 564 G 2 .. II
-chrM 565 A 2 .. GI
-chrM 566 G 2 .. II
-chrM 567 T 2 .. /I
-chrM 568 A 2 .. DI
-chrM 569 C 2 .. II
-chrM 570 T 2 .. II
-chrM 571 A 2 .. II
-chrM 572 C 2 .. FI
-chrM 573 T 2 .. 9I
-chrM 574 A 2 .. II
-chrM 575 G 2 .. II
-chrM 576 C 2 .. II
-chrM 577 A 3 .$.^:. III
-chrM 578 A 2 .. II
-chrM 579 C 2 .. II
-chrM 580 A 3 ..^:, III
-chrM 581 G 3 .., III
-chrM 582 C 3 .., II?
-chrM 583 C 3 ..a II-
-chrM 584 T 3 .., IIH
-chrM 585 A 3 .., III
-chrM 586 A 3 .., III
-chrM 587 A 4 ..,^:, IIII
-chrM 588 A 4 ..,, IIII
-chrM 589 C 4 ..,, IIII
-chrM 590 T 4 ..,, II.5
-chrM 591 C 4 .$.,, II
-chrM 769 A 3 ,,^:, III
-chrM 770 G 3 ,,, III
-chrM 771 C 3 ,,, IHI
-chrM 772 C 3 ,a, I)/
-chrM 773 C 3 ,,, I7I
-chrM 774 A 4 ,,,^:. II:I
-chrM 775 T 4 ,,,. IH.I
-chrM 776 G 4 ,,,. IIII
-chrM 777 G 4 ,,,. IIII
-chrM 778 G 4 ,,,. IIII
-chrM 779 A 4 ,,,. IIAI
-chrM 780 T 4 ,,,. IIGI
-chrM 781 G 4 ,,,. IIII
-chrM 782 G 4 ,,,. IIII
-chrM 783 A 4 ,,,. IIII
-chrM 784 G 4 ,,,. IIII
-chrM 785 A 4 ,,,. IIII
-chrM 786 G 4 ,,,. IIII
-chrM 787 A 4 ,,,. IIII
-chrM 788 A 4 ,,,. IIII
-chrM 789 A 4 ,,,. IIII
-chrM 790 T 5 ,,,.^:. IIIII
-chrM 791 G 5 ,$,,.. IIIII
-chrM 792 G 4 ,,.. IIII
-chrM 793 G 4 ,,.. IIII
-chrM 794 C 4 ,,.. IIII
-chrM 795 T 4 ,,.. IIII
-chrM 796 A 4 ,,.. IIII
-chrM 797 C 4 ,,.. IIII
-chrM 798 A 4 ,,.. IIII
-chrM 799 T 4 ,,.. IIII
-chrM 800 T 4 ,,.. IIII
-chrM 801 T 4 ,,.. IIII
-chrM 802 T 4 ,$,.. IIII
-chrM 803 C 3 ,.. III
-chrM 804 T 3 ,$.. III
-chrM 805 A 2 .. II
-chrM 806 C 3 ..^:. III
-chrM 807 C 3 ... III
-chrM 808 C 3 ... III
-chrM 809 T 3 .$.. III
-chrM 810 A 3 ..^:, III
-chrM 811 A 3 .., III
-chrM 812 G 3 .., II7
-chrM 813 A 3 .., III
-chrM 814 A 3 .., III
-chrM 815 C 3 .., III
-chrM 816 A 3 .., III
-chrM 817 A 3 .., III
-chrM 818 G 3 .., III
-chrM 819 A 3 .., III
-chrM 820 A 3 .., &II
-chrM 821 C 3 .., III
-chrM 822 T 3 .., III
-chrM 823 T 3 ..n II"
-chrM 824 T 3 .., III
-chrM 825 A 3 .$., III
-chrM 826 A 3 .,^:. III
-chrM 827 C 3 .,. III
-chrM 828 C 3 .,. III
-chrM 829 C 4 .,.^:, IIII
-chrM 830 G 4 .,., IIII
-chrM 831 G 4 .,., IIII
-chrM 832 A 4 .,., IIII
-chrM 833 C 4 .,., IIII
-chrM 834 G 4 .,., IIII
-chrM 835 A 4 .,., IIII
-chrM 836 A 4 .,., 8III
-chrM 837 A 4 .,., IIII
-chrM 838 G 4 .,., IIII
-chrM 839 T 5 .,.,^:, 4:IIG
-chrM 840 C 5 .,.,, IIIII
-chrM 841 T 5 .$,.,, IIIII
-chrM 842 C 4 ,.,, IIII
-chrM 843 C 4 ,.,, IIII
-chrM 844 A 4 ,.,, IIII
-chrM 845 T 4 ,$.,, IIII
-chrM 846 G 3 .,, @II
-chrM 847 A 3 .,, III
-chrM 848 A 3 .,, III
-chrM 849 A 3 .,, III
-chrM 850 C 3 .,, III
-chrM 851 T 3 .,, III
-chrM 852 G 3 .,, III
-chrM 853 G 3 .,, III
-chrM 854 A 3 .,, EII
-chrM 855 G 3 .,, DII
-chrM 856 A 3 .,, III
-chrM 857 C 3 .,, III
-chrM 858 T 4 .,,^:, IIIA
-chrM 859 A 4 .,,, @III
-chrM 860 A 4 .,,, IIII
-chrM 861 A 4 .$,,, EIII
-chrM 862 G 3 ,,, III
-chrM 863 G 3 ,,, III
-chrM 864 A 3 ,$,, III
-chrM 865 G 2 ,, II
-chrM 866 G 2 ,, II
-chrM 867 A 2 ,, II
-chrM 868 T 2 ,, II
-chrM 869 T 2 ,, II
-chrM 870 T 2 ,, II
-chrM 871 A 2 ,, II
-chrM 872 G 2 ,, II
-chrM 873 C 2 ,, II
-chrM 874 A 2 ,$, II
-chrM 875 G 1 , I
-chrM 876 T 1 , I
-chrM 877 A 1 , I
-chrM 878 A 1 , I
-chrM 879 A 1 , I
-chrM 880 T 1 , I
-chrM 881 T 1 , I
-chrM 882 A 1 , I
-chrM 883 A 1 , I
-chrM 884 G 1 , I
-chrM 885 A 1 , I
-chrM 886 A 1 , I
-chrM 887 T 1 , (
-chrM 888 A 1 , I
-chrM 889 G 1 , I
-chrM 890 A 1 , I
-chrM 891 G 1 , I
-chrM 892 A 1 , I
-chrM 893 G 1 ,$ I
-chrM 898 A 1 ^:, I
-chrM 899 T 2 ,^:. /I
-chrM 900 T 2 ,. 7I
-chrM 901 G 2 ,. CI
-chrM 902 A 2 ,. II
-chrM 903 A 2 ,. II
-chrM 904 T 2 ,. II
-chrM 905 C 3 ,.^:, III
-chrM 906 A 3 ,., III
-chrM 907 G 3 ,., III
-chrM 908 G 3 ,., III
-chrM 909 C 3 ,., III
-chrM 910 C 3 ,., III
-chrM 911 A 4 ,.,^:, IIII
-chrM 912 T 4 ,.,, IIEG
-chrM 913 G 4 ,.,, III:
-chrM 914 A 4 ,.,, IIII
-chrM 915 A 4 ,.,, IIII
-chrM 916 G 4 ,.,, III5
-chrM 917 C 4 ,.,, III5
-chrM 918 G 4 ,.,, IIII
-chrM 919 C 4 ,.,, III<
-chrM 920 G 4 ,.,, IIII
-chrM 921 C 4 ,.,, IIII
-chrM 922 A 4 ,.,, IIII
-chrM 923 C 4 ,.,, III8
-chrM 924 A 4 ,.,, IFII
-chrM 925 C 4 ,.,, IIII
-chrM 926 A 4 ,.,, IIII
-chrM 927 C 4 ,.,, IIII
-chrM 928 C 5 ,.,,^:, IIII:
-chrM 929 G 5 ,.,,, IIIE:
-chrM 930 C 5 ,.,,, IIIII
-chrM 931 C 5 ,.,,, IIIIF
-chrM 932 C 5 ,.,,, IIIIC
-chrM 933 G 5 ,$.,,, I?II:
-chrM 934 T 4 .$,,, 4II>
-chrM 935 C 3 ,,, III
-chrM 936 A 3 ,,, III
-chrM 937 C 3 ,,, II1
-chrM 938 C 3 ,,, III
-chrM 939 C 3 ,,, III
-chrM 940 T 3 ,$,, III
-chrM 941 C 2 ,, II
-chrM 942 C 2 ,, I'
-chrM 943 T 2 ,, II
-chrM 944 T 2 ,, II
-chrM 945 A 2 ,, II
-chrM 946 A 2 ,$, II
-chrM 947 A 1 , I
-chrM 948 T 1 , I
-chrM 949 A 1 , I
-chrM 950 T 1 , I
-chrM 951 C 1 , I
-chrM 952 A 1 , I
-chrM 953 C 1 , I
-chrM 954 A 1 , I
-chrM 955 A 2 ,^:. II
-chrM 956 A 2 ,. II
-chrM 957 T 2 ,. II
-chrM 958 C 3 ,.^:. III
-chrM 959 A 3 ,.. III
-chrM 960 T 3 ,.. III
-chrM 961 A 3 ,.. III
-chrM 962 A 3 ,.. III
-chrM 963 C 4 ,$..^:. IIII
-chrM 964 A 3 ... I(;
-chrM 965 T 3 ... III
-chrM 966 A 4 ...^:. IIII
-chrM 967 A 4 .... IIII
-chrM 968 C 4 .... IEII
-chrM 969 A 4 .... IIII
-chrM 970 T 4 .... IIII
-chrM 971 A 4 .... IIII
-chrM 972 A 4 .... IIII
-chrM 973 A 4 .... II0I
-chrM 974 A 5 ....^:. IIIII
-chrM 975 C 5 ..... IIIII
-chrM 976 C 5 ..... IIIII
-chrM 977 G 5 ..... IIIII
-chrM 978 T 5 ..... IIIII
-chrM 979 G 5 ..... I0III
-chrM 980 A 5 ..... IIII4
-chrM 981 C 5 ..... IIIII
-chrM 982 C 5 ..... IIIII
-chrM 983 C 5 ..... IIIII
-chrM 984 A 5 ..... -IGII
-chrM 985 A 5 ..... 4GIII
-chrM 986 A 5 ..... BDGII
-chrM 987 C 5 ..... IDIII
-chrM 988 A 5 ..... @
+
-
-
+
+
-
+
@@ -32,19 +32,19 @@
-
+
-
+
-
+
-
+
@@ -65,25 +65,25 @@
-
+
-
+
-
+
-
-
+
+
-
+
@@ -95,39 +95,38 @@
-
-
+
-
+
-
+
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
+
-
+
@@ -141,21 +140,19 @@
-
+
-
-
-
+
-
+
-
+
-
@@ -177,57 +173,48 @@
-
+
-
-
-
-
- s
-
-
-
-
+
-
+
-
+
-
-
-
-
+
+
+
-
+
-
+
@@ -235,38 +222,35 @@
-
+
-
-
-
-
+
-
+
-
+
-
+
-
+
-
+
@@ -274,25 +258,10 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
+
-
+
-
+
-
-
+
-
+
@@ -337,90 +305,74 @@
-->
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
+
-
-
-
+
-
+
\ No newline at end of file
diff --git a/tools/evolution/mutate_snp_codon.py b/tools/evolution/mutate_snp_codon.py
deleted file mode 100644
index c62a043034d..00000000000
--- a/tools/evolution/mutate_snp_codon.py
+++ /dev/null
@@ -1,112 +0,0 @@
-#!/usr/bin/env python
-"""
-Script to mutate SNP codons.
-Dan Blankenberg
-"""
-
-import sys, string
-
-def strandify( fields, column ):
- strand = '+'
- if column >= 0 and column < len( fields ):
- strand = fields[ column ]
- if strand not in [ '+', '-' ]:
- strand = '+'
- return strand
-
-def main():
- # parse command line
- input_file = sys.argv[1]
- out = open( sys.argv[2], 'wb+' )
- codon_chrom_col = int( sys.argv[3] ) - 1
- codon_start_col = int( sys.argv[4] ) - 1
- codon_end_col = int( sys.argv[5] ) - 1
- codon_strand_col = int( sys.argv[6] ) - 1
- codon_seq_col = int( sys.argv[7] ) - 1
-
- snp_chrom_col = int( sys.argv[8] ) - 1
- snp_start_col = int( sys.argv[9] ) - 1
- snp_end_col = int( sys.argv[10] ) - 1
- snp_strand_col = int( sys.argv[11] ) - 1
- snp_observed_col = int( sys.argv[12] ) - 1
-
- max_field_index = max( codon_chrom_col, codon_start_col, codon_end_col, codon_strand_col, codon_seq_col, snp_chrom_col, snp_start_col, snp_end_col, snp_strand_col, snp_observed_col )
-
- DNA_COMP = string.maketrans( "ACGTacgt", "TGCAtgca" )
- skipped_lines = 0
- errors = {}
- for name, message in [ ('max_field_index','not enough fields'), ( 'codon_len', 'codon length must be 3' ), ( 'codon_seq', 'codon sequence must have length 3' ), ( 'snp_len', 'SNP length must be 3' ), ( 'snp_observed', 'SNP observed values must have length 3' ), ( 'empty_comment', 'empty or comment'), ( 'no_overlap', 'codon and SNP do not overlap' ) ]:
- errors[ name ] = { 'count':0, 'message':message }
- line_count = 0
- for line_count, line in enumerate( open( input_file ) ):
- line = line.rstrip( '\n\r' )
- if line and not line.startswith( '#' ):
- fields = line.split( '\t' )
- if max_field_index >= len( fields ):
- skipped_lines += 1
- errors[ 'max_field_index' ]['count'] += 1
- continue
-
- #read codon info
- codon_chrom = fields[codon_chrom_col]
- codon_start = int( fields[codon_start_col] )
- codon_end = int( fields[codon_end_col] )
- if codon_end - codon_start != 3:
- #codons must be length 3
- skipped_lines += 1
- errors[ 'codon_len' ]['count'] += 1
- continue
- codon_strand = strandify( fields, codon_strand_col )
- codon_seq = fields[codon_seq_col].upper()
- if len( codon_seq ) != 3:
- #codon sequence must have length 3
- skipped_lines += 1
- errors[ 'codon_seq' ]['count'] += 1
- continue
-
- #read snp info
- snp_chrom = fields[snp_chrom_col]
- snp_start = int( fields[snp_start_col] )
- snp_end = int( fields[snp_end_col] )
- if snp_end - snp_start != 1:
- #snps must be length 1
- skipped_lines += 1
- errors[ 'snp_len' ]['count'] += 1
- continue
- snp_strand = strandify( fields, snp_strand_col )
- snp_observed = fields[snp_observed_col].split( '/' )
- snp_observed = [ observed for observed in snp_observed if len( observed ) == 1 ]
- if not snp_observed:
- #sequence replacements must be length 1
- skipped_lines += 1
- errors[ 'snp_observed' ]['count'] += 1
- continue
-
- #Determine index of replacement for observed values into codon
- offset = snp_start - codon_start
- #Extract DNA on neg strand codons will have positions reversed relative to interval positions; i.e. position 0 == position 2
- if codon_strand == '-':
- offset = 2 - offset
- if offset < 0 or offset > 2: #assert offset >= 0 and offset <= 2, ValueError( 'Impossible offset determined: %s' % offset )
- #codon and snp do not overlap
- skipped_lines += 1
- errors[ 'no_overlap' ]['count'] += 1
- continue
-
- for observed in snp_observed:
- if codon_strand != snp_strand:
- #if our SNP is on a different strand than our codon, take complement of provided observed SNP base
- observed = observed.translate( DNA_COMP )
- snp_codon = [ char for char in codon_seq ]
- snp_codon[offset] = observed.upper()
- snp_codon = ''.join( snp_codon )
-
- if codon_seq != snp_codon: #only output when we actually have a different codon
- out.write( "%s\t%s\n" % ( line, snp_codon ) )
- else:
- skipped_lines += 1
- errors[ 'empty_comment' ]['count'] += 1
- if skipped_lines:
- print "Skipped %i (%4.2f%%) of %i lines; reasons: %s" % ( skipped_lines, ( float( skipped_lines )/float( line_count ) ) * 100, line_count, ', '.join( [ "%s (%i)" % ( error['message'], error['count'] ) for error in errors.itervalues() if error['count'] ] ) )
-
-if __name__ == "__main__": main()
diff --git a/tools/evolution/mutate_snp_codon.xml b/tools/evolution/mutate_snp_codon.xml
deleted file mode 100644
index 4df847bf519..00000000000
--- a/tools/evolution/mutate_snp_codon.xml
+++ /dev/null
@@ -1,67 +0,0 @@
-
- with SNPs
- mutate_snp_codon.py $input1 $output1 ${input1.metadata.chromCol} ${input1.metadata.startCol} ${input1.metadata.endCol} ${input1.metadata.strandCol} $codon_seq_col $snp_chrom_col $snp_start_col $snp_end_col $snp_strand_col $snp_observed_col
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-This tool takes an interval file as input. This input should contain a set of codon locations and corresponding DNA sequence (such as from the *Extract Genomic DNA* tool) joined to SNP locations with observed values (such as *all fields from selected table* from the snp130 table of hg18 at the UCSC Table browser). This interval file should have the metadata (chromosome, start, end, strand) set for the columns containing the locations of the codons. The user needs to specify the columns containing the sequence for the codon as well as the genomic positions and observed values (values should be split by '/') for the SNP data as tool input; SNPs positions and sequence substitutes must have a length of exactly 1. Only genomic intervals which yield a different sequence string are output. All sequence characters are converted to uppercase during processing.
-
- For example, using these settings:
-
- * **metadata** **chromosome**, **start**, **end** and **strand** set to **1**, **2**, **3** and **6**, respectively
- * **Codon Sequence column** set to **c8**
- * **SNP chromosome column** set to **c17**
- * **SNP start column** set to **c18**
- * **SNP end column** set to **c19**
- * **SNP strand column** set to **c22**
- * **SNP observed column** set to **c25**
-
- with the following input::
-
- chr1 58995 58998 NM_001005484 0 + GAA GAA Glu GAA 1177632 28.96 0 2787607 0.422452662804 585 chr1 58996 58997 rs1638318 0 + A A A/G genomic single by-submitter 0 0 unknown exact 3
- chr1 59289 59292 NM_001005484 0 + TTT TTT Phe TTT 714298 17.57 0 1538990 0.464134269878 585 chr1 59290 59291 rs71245814 0 + T T G/T genomic single unknown 0 0 unknown exact 3
- chr1 59313 59316 NM_001005484 0 + AAG AAG Lys AAG 1295568 31.86 0 2289189 0.565950648898 585 chr1 59315 59316 rs2854682 0 - G G C/T genomic single by-submitter 0 0 unknown exact 3
- chr1 59373 59376 NM_001005484 0 + ACA ACA Thr ACA 614523 15.11 0 2162384 0.284187729839 585 chr1 59373 59374 rs2691305 0 - A A C/T genomic single unknown 0 0 unknown exact 3
- chr1 59412 59415 NM_001005484 0 + GCG GCG Ala GCG 299495 7.37 0 2820741 0.106176001271 585 chr1 59414 59415 rs2531266 0 + G G C/G genomic single by-submitter 0 0 unknown exact 3
- chr1 59412 59415 NM_001005484 0 + GCG GCG Ala GCG 299495 7.37 0 2820741 0.106176001271 585 chr1 59414 59415 rs55874132 0 + G G C/G genomic single unknown 0 0 coding-synon exact 1
-
-
- will produce::
-
- chr1 58995 58998 NM_001005484 0 + GAA GAA Glu GAA 1177632 28.96 0 2787607 0.422452662804 585 chr1 58996 58997 rs1638318 0 + A A A/G genomic single by-submitter 0 0 unknown exact 3 GGA
- chr1 59289 59292 NM_001005484 0 + TTT TTT Phe TTT 714298 17.57 0 1538990 0.464134269878 585 chr1 59290 59291 rs71245814 0 + T T G/T genomic single unknown 0 0 unknown exact 3 TGT
- chr1 59313 59316 NM_001005484 0 + AAG AAG Lys AAG 1295568 31.86 0 2289189 0.565950648898 585 chr1 59315 59316 rs2854682 0 - G G C/T genomic single by-submitter 0 0 unknown exact 3 AAA
- chr1 59373 59376 NM_001005484 0 + ACA ACA Thr ACA 614523 15.11 0 2162384 0.284187729839 585 chr1 59373 59374 rs2691305 0 - A A C/T genomic single unknown 0 0 unknown exact 3 GCA
- chr1 59412 59415 NM_001005484 0 + GCG GCG Ala GCG 299495 7.37 0 2820741 0.106176001271 585 chr1 59414 59415 rs2531266 0 + G G C/G genomic single by-submitter 0 0 unknown exact 3 GCC
- chr1 59412 59415 NM_001005484 0 + GCG GCG Ala GCG 299495 7.37 0 2820741 0.106176001271 585 chr1 59414 59415 rs55874132 0 + G G C/G genomic single unknown 0 0 coding-synon exact 1 GCC
-
-------
-
-**Citation**
-
-If you use this tool, please cite `Blankenberg D, Taylor J, Nekrutenko A; The Galaxy Team. Making whole genome multiple alignments usable for biologists. Bioinformatics. 2011 Sep 1;27(17):2426-2428. <http://www.ncbi.nlm.nih.gov/pubmed/21775304>`_
-
-
-
diff --git a/tools/fastx_toolkit/fasta_clipping_histogram.xml b/tools/fastx_toolkit/fasta_clipping_histogram.xml
deleted file mode 100644
index 859cc6317b5..00000000000
--- a/tools/fastx_toolkit/fasta_clipping_histogram.xml
+++ /dev/null
@@ -1,110 +0,0 @@
-
- chart
- fastx_toolkit
- fasta_clipping_histogram.pl $input $outfile
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool creates a histogram image of sequence lengths distribution in a given fasta dataset file.
-
-**TIP:** Use this tool after clipping your library (with **FASTX Clipper tool**), to visualize the clipping results.
-
------
-
-**Output Examples**
-
-In the following library, most sequences are 24-mers to 27-mers.
-This could indicate an abundance of endo-siRNAs (depending of course of what you've tried to sequence in the first place).
-
-.. image:: ${static_path}/fastx_icons/fasta_clipping_histogram_1.png
-
-
-In the following library, most sequences are 19,22 or 23-mers.
-This could indicate an abundance of miRNAs (depending of course of what you've tried to sequence in the first place).
-
-.. image:: ${static_path}/fastx_icons/fasta_clipping_histogram_2.png
-
-
------
-
-
-**Input Formats**
-
-This tool accepts short-reads FASTA files. The reads don't have to be short, but they do have to be on a single line, like so::
-
- >sequence1
- AGTAGTAGGTGATGTAGAGAGAGAGAGAGTAG
- >sequence2
- GTGTGTGTGGGAAGTTGACACAGTA
- >sequence3
- CCTTGAGATTAACGCTAATCAAGTAAAC
-
-
-If the sequences span over multiple lines::
-
- >sequence1
- CAGCATCTACATAATATGATCGCTATTAAACTTAAATCTCCTTGACGGAG
- TCTTCGGTCATAACACAAACCCAGACCTACGTATATGACAAAGCTAATAG
- aactggtctttacctTTAAGTTG
-
-Use the **FASTA Width Formatter** tool to re-format the FASTA into a single-lined sequences::
-
- >sequence1
- CAGCATCTACATAATATGATCGCTATTAAACTTAAATCTCCTTGACGGAGTCTTCGGTCATAACACAAACCCAGACCTACGTATATGACAAAGCTAATAGaactggtctttacctTTAAGTTG
-
-
------
-
-
-
-**Multiplicity counts (a.k.a reads-count)**
-
-If the sequence identifier (the text after the '>') contains a dash and a number, it is treated as a multiplicity count value (i.e. how many times that individual sequence repeated in the original FASTA file, before collapsing).
-
-Example 1 - The following FASTA file *does not* have multiplicity counts::
-
- >seq1
- GGATCC
- >seq2
- GGTCATGGGTTTAAA
- >seq3
- GGGATATATCCCCACACACACACAC
-
-Each sequence is counts as one, to produce the following chart:
-
-.. image:: ${static_path}/fastx_icons/fasta_clipping_histogram_3.png
-
-
-Example 2 - The following FASTA file have multiplicity counts::
-
- >seq1-2
- GGATCC
- >seq2-10
- GGTCATGGGTTTAAA
- >seq3-3
- GGGATATATCCCCACACACACACAC
-
-The first sequence counts as 2, the second as 10, the third as 3, to produce the following chart:
-
-.. image:: ${static_path}/fastx_icons/fasta_clipping_histogram_4.png
-
-Use the **FASTA Collapser** tool to create FASTA files with multiplicity counts.
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
-
diff --git a/tools/fastx_toolkit/fasta_formatter.xml b/tools/fastx_toolkit/fasta_formatter.xml
deleted file mode 100644
index d068be7238d..00000000000
--- a/tools/fastx_toolkit/fasta_formatter.xml
+++ /dev/null
@@ -1,87 +0,0 @@
-
- formatter
- fastx_toolkit
-
- zcat -f '$input' | fasta_formatter -w $width -o $output
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool re-formats a FASTA file, changing the width of the nucleotides lines.
-
-**TIP:** Outputting a single line (with **width = 0**) can be useful for scripting (with **grep**, **awk**, and **perl**). Every odd line is a sequence identifier, and every even line is a nucleotides line.
-
---------
-
-**Example**
-
-Input FASTA file (each nucleotides line is 50 characters long)::
-
- >Scaffold3648
- AGGAATGATGACTACAATGATCAACTTAACCTATCTATTTAATTTAGTTC
- CCTAATGTCAGGGACCTACCTGTTTTTGTTATGTTTGGGTTTTGTTGTTG
- TTGTTTTTTTAATCTGAAGGTATTGTGCATTATATGACCTGTAATACACA
- ATTAAAGTCAATTTTAATGAACATGTAGTAAAAACT
- >Scaffold9299
- CAGCATCTACATAATATGATCGCTATTAAACTTAAATCTCCTTGACGGAG
- TCTTCGGTCATAACACAAACCCAGACCTACGTATATGACAAAGCTAATAG
- aactggtctttacctTTAAGTTG
-
-
-Output FASTA file (with width=80)::
-
- >Scaffold3648
- AGGAATGATGACTACAATGATCAACTTAACCTATCTATTTAATTTAGTTCCCTAATGTCAGGGACCTACCTGTTTTTGTT
- ATGTTTGGGTTTTGTTGTTGTTGTTTTTTTAATCTGAAGGTATTGTGCATTATATGACCTGTAATACACAATTAAAGTCA
- ATTTTAATGAACATGTAGTAAAAACT
- >Scaffold9299
- CAGCATCTACATAATATGATCGCTATTAAACTTAAATCTCCTTGACGGAGTCTTCGGTCATAACACAAACCCAGACCTAC
- GTATATGACAAAGCTAATAGaactggtctttacctTTAAGTTG
-
-Output FASTA file (with width=0 => single line)::
-
- >Scaffold3648
- AGGAATGATGACTACAATGATCAACTTAACCTATCTATTTAATTTAGTTCCCTAATGTCAGGGACCTACCTGTTTTTGTTATGTTTGGGTTTTGTTGTTGTTGTTTTTTTAATCTGAAGGTATTGTGCATTATATGACCTGTAATACACAATTAAAGTCAATTTTAATGAACATGTAGTAAAAACT
- >Scaffold9299
- CAGCATCTACATAATATGATCGCTATTAAACTTAAATCTCCTTGACGGAGTCTTCGGTCATAACACAAACCCAGACCTACGTATATGACAAAGCTAATAGaactggtctttacctTTAAGTTG
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fasta_nucleotide_changer.xml b/tools/fastx_toolkit/fasta_nucleotide_changer.xml
deleted file mode 100644
index cd202fa11e7..00000000000
--- a/tools/fastx_toolkit/fasta_nucleotide_changer.xml
+++ /dev/null
@@ -1,73 +0,0 @@
-
- converter
- fastx_toolkit
- zcat -f '$input' | fasta_nucleotide_changer $mode -v -o $output
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool converts RNA FASTA files to DNA (and vice-versa).
-
-In **RNA-to-DNA** mode, U's are changed into T's.
-
-In **DNA-to-RNA** mode, T's are changed into U's.
-
---------
-
-**Example**
-
-Input RNA FASTA file ( from Sanger's mirBase )::
-
- >cel-let-7 MIMAT0000001 Caenorhabditis elegans let-7
- UGAGGUAGUAGGUUGUAUAGUU
- >cel-lin-4 MIMAT0000002 Caenorhabditis elegans lin-4
- UCCCUGAGACCUCAAGUGUGA
- >cel-miR-1 MIMAT0000003 Caenorhabditis elegans miR-1
- UGGAAUGUAAAGAAGUAUGUA
-
-Output DNA FASTA file (with RNA-to-DNA mode)::
-
- >cel-let-7 MIMAT0000001 Caenorhabditis elegans let-7
- TGAGGTAGTAGGTTGTATAGTT
- >cel-lin-4 MIMAT0000002 Caenorhabditis elegans lin-4
- TCCCTGAGACCTCAAGTGTGA
- >cel-miR-1 MIMAT0000003 Caenorhabditis elegans miR-1
- TGGAATGTAAAGAAGTATGTA
-
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastq_quality_boxplot.xml b/tools/fastx_toolkit/fastq_quality_boxplot.xml
deleted file mode 100644
index 77e9d0896ac..00000000000
--- a/tools/fastx_toolkit/fastq_quality_boxplot.xml
+++ /dev/null
@@ -1,56 +0,0 @@
-
-
- fastx_toolkit
-
- fastq_quality_boxplot_graph.sh -t '$input.name' -i $input -o $output
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-Creates a boxplot graph for the quality scores in the library.
-
-.. class:: infomark
-
-**TIP:** Use the **FASTQ Statistics** tool to generate the report file needed for this tool.
-
------
-
-**Output Examples**
-
-* Black horizontal lines are medians
-* Rectangular red boxes show the Inter-quartile Range (IQR) (top value is Q3, bottom value is Q1)
-* Whiskers show outlier at max. 1.5*IQR
-
-
-An excellent quality library (median quality is 40 for almost all 36 cycles):
-
-.. image:: ${static_path}/fastx_icons/fastq_quality_boxplot_1.png
-
-
-A relatively good quality library (median quality degrades towards later cycles):
-
-.. image:: ${static_path}/fastx_icons/fastq_quality_boxplot_2.png
-
-A low quality library (median drops quickly):
-
-.. image:: ${static_path}/fastx_icons/fastq_quality_boxplot_3.png
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
-
-
-
diff --git a/tools/fastx_toolkit/fastq_quality_converter.xml b/tools/fastx_toolkit/fastq_quality_converter.xml
deleted file mode 100644
index 7e0b264d8e9..00000000000
--- a/tools/fastx_toolkit/fastq_quality_converter.xml
+++ /dev/null
@@ -1,97 +0,0 @@
-
- (ASCII-Numeric)
- fastx_toolkit
- zcat -f $input | fastq_quality_converter $QUAL_FORMAT -o $output -Q $offset
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-Converts a Solexa FASTQ file to/from numeric or ASCII quality format.
-
-.. class:: warningmark
-
-Re-scaling is **not** performed. (e.g. conversion from Phred scale to Solexa scale).
-
-
------
-
-FASTQ with Numeric quality scores::
-
- @CSHL__2_FC042AGWWWXX:8:1:120:202
- ACGATAGATCGGAAGAGCTAGTATGCCGTTTTCTGC
- +CSHL__2_FC042AGWWWXX:8:1:120:202
- 40 40 40 40 20 40 40 40 40 6 40 40 28 40 40 25 40 20 40 -1 30 40 14 27 40 8 1 3 7 -1 11 10 -1 21 10 8
- @CSHL__2_FC042AGWWWXX:8:1:103:1185
- ATCACGATAGATCGGCAGAGCTCGTTTACCGTCTTC
- +CSHL__2_FC042AGWWWXX:8:1:103:1185
- 40 40 40 40 40 35 33 31 40 40 40 32 30 22 40 -0 9 22 17 14 8 36 15 34 22 12 23 3 10 -0 8 2 4 25 30 2
-
-
-FASTQ with ASCII quality scores::
-
- @CSHL__2_FC042AGWWWXX:8:1:120:202
- ACGATAGATCGGAAGAGCTAGTATGCCGTTTTCTGC
- +CSHL__2_FC042AGWWWXX:8:1:120:202
- hhhhThhhhFhh\hhYhTh?^hN[hHACG?KJ?UJH
- @CSHL__2_FC042AGWWWXX:8:1:103:1185
- ATCACGATAGATCGGCAGAGCTCGTTTACCGTCTTC
- +CSHL__2_FC042AGWWWXX:8:1:103:1185
- hhhhhca_hhh`^Vh@IVQNHdObVLWCJ@HBDY^B
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
-
diff --git a/tools/fastx_toolkit/fastq_quality_filter.xml b/tools/fastx_toolkit/fastq_quality_filter.xml
deleted file mode 100644
index f60fe110b5f..00000000000
--- a/tools/fastx_toolkit/fastq_quality_filter.xml
+++ /dev/null
@@ -1,82 +0,0 @@
-
-
- fastx_toolkit
-
- zcat -f '$input' | fastq_quality_filter -q $quality -p $percent -v -o $output
-#if $input.ext == "fastqsanger":
--Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool filters reads based on quality scores.
-
-.. class:: infomark
-
-Using **percent = 100** requires all cycles of all reads to be at least the quality cut-off value.
-
-.. class:: infomark
-
-Using **percent = 50** requires the median quality of the cycles (in each read) to be at least the quality cut-off value.
-
---------
-
-Quality score distribution (of all cycles) is calculated for each read. If it is lower than the quality cut-off value - the read is discarded.
-
-
-**Example**::
-
- @CSHL_4_FC042AGOOII:1:2:214:584
- GACAATAAAC
- +CSHL_4_FC042AGOOII:1:2:214:584
- 30 30 30 30 30 30 30 30 20 10
-
-Using **percent = 50** and **cut-off = 30** - This read will not be discarded (the median quality is higher than 30).
-
-Using **percent = 90** and **cut-off = 30** - This read will be discarded (90% of the cycles do no have quality equal to / higher than 30).
-
-Using **percent = 100** and **cut-off = 20** - This read will be discarded (not all cycles have quality equal to / higher than 20).
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastq_to_fasta.xml b/tools/fastx_toolkit/fastq_to_fasta.xml
deleted file mode 100644
index b391d0a5580..00000000000
--- a/tools/fastx_toolkit/fastq_to_fasta.xml
+++ /dev/null
@@ -1,80 +0,0 @@
-
- converter
- fastx_toolkit
- gunzip -cf $input | fastq_to_fasta $SKIPN $RENAMESEQ -o $output -v
-#if $input.ext == "fastqsanger":
--Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool converts data from Solexa format to FASTA format (scroll down for format description).
-
---------
-
-**Example**
-
-The following data in Solexa-FASTQ format::
-
- @CSHL_4_FC042GAMMII_2_1_517_596
- GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
- +CSHL_4_FC042GAMMII_2_1_517_596
- 40 40 40 40 40 40 40 40 40 40 38 40 40 40 40 40 14 40 40 40 40 40 36 40 13 14 24 24 9 24 9 40 10 10 15 40
-
-Will be converted to FASTA (with 'rename sequence names' = NO)::
-
- >CSHL_4_FC042GAMMII_2_1_517_596
- GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
-
-Will be converted to FASTA (with 'rename sequence names' = YES)::
-
- >1
- GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastx_artifacts_filter.xml b/tools/fastx_toolkit/fastx_artifacts_filter.xml
deleted file mode 100644
index 0defc79f17c..00000000000
--- a/tools/fastx_toolkit/fastx_artifacts_filter.xml
+++ /dev/null
@@ -1,90 +0,0 @@
-
-
- fastx_toolkit
- zcat -f '$input' | fastx_artifacts_filter -v -o "$output"
-#if $input.ext == "fastqsanger":
--Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool filters sequencing artifacts (reads with all but 3 identical bases).
-
---------
-
-**The following is an example of sequences which will be filtered out**::
-
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAACACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAACACAAAAAAAAAAAAAAAAAAAAAAAAAAAAACACAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- AAAAACACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAACACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAACACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAA
- AAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAA
- AAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAA
- AAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAAAAAA
- AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACAAAAAAAAAAAA
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastx_barcode_splitter.xml b/tools/fastx_toolkit/fastx_barcode_splitter.xml
deleted file mode 100644
index e9251d7425e..00000000000
--- a/tools/fastx_toolkit/fastx_barcode_splitter.xml
+++ /dev/null
@@ -1,76 +0,0 @@
-
-
- fastx_toolkit
- fastx_barcode_splitter_galaxy_wrapper.sh $BARCODE $input "$input.name" "$output.files_path" --mismatches $mismatches --partial $partial $EOL > $output
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool splits a Solexa library (FASTQ file) or a regular FASTA file into several files, using barcodes as the split criteria.
-
---------
-
-**Barcode file Format**
-
-Barcode files are simple text files.
-Each line should contain an identifier (descriptive name for the barcode), and the barcode itself (A/C/G/T), separated by a TAB character.
-Example::
-
- #This line is a comment (starts with a 'number' sign)
- BC1 GATCT
- BC2 ATCGT
- BC3 GTGAT
- BC4 TGTCT
-
-For each barcode, a new FASTQ file will be created (with the barcode's identifier as part of the file name).
-Sequences matching the barcode will be stored in the appropriate file.
-
-One additional FASTQ file will be created (the 'unmatched' file), where sequences not matching any barcode will be stored.
-
-The output of this tool is an HTML file, displaying the split counts and the file locations.
-
-**Output Example**
-
-.. image:: ${static_path}/fastx_icons/barcode_splitter_output_example.png
-
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
-
diff --git a/tools/fastx_toolkit/fastx_barcode_splitter_galaxy_wrapper.sh b/tools/fastx_toolkit/fastx_barcode_splitter_galaxy_wrapper.sh
deleted file mode 100755
index 712bdd5307c..00000000000
--- a/tools/fastx_toolkit/fastx_barcode_splitter_galaxy_wrapper.sh
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/bin/bash
-
-# FASTX-toolkit - FASTA/FASTQ preprocessing tools.
-# Copyright (C) 2009 A. Gordon (gordon@cshl.edu)
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU Affero General Public License as
-# published by the Free Software Foundation, either version 3 of the
-# License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU Affero General Public License for more details.
-#
-# You should have received a copy of the GNU Affero General Public License
-# along with this program. If not, see .
-
-#
-#This is a shell script wrapper for 'fastx_barcode_splitter.pl'
-#
-# 1. Output files are saved at the dataset's files_path directory.
-#
-# 2. 'fastx_barcode_splitter.pl' outputs a textual table.
-# This script turns it into pretty HTML with working URL
-# (so lazy users can just click on the URLs and get their files)
-
-BARCODE_FILE="$1"
-FASTQ_FILE="$2"
-LIBNAME="$3"
-OUTPUT_PATH="$4"
-shift 4
-# The rest of the parameters are passed to the split program
-
-if [ "$OUTPUT_PATH" == "" ]; then
- echo "Usage: $0 [BARCODE FILE] [FASTQ FILE] [LIBRARY_NAME] [OUTPUT_PATH]" >&2
- exit 1
-fi
-
-#Sanitize library name, make sure we can create a file with this name
-LIBNAME=${LIBNAME//\.gz/}
-LIBNAME=${LIBNAME//\.txt/}
-LIBNAME=${LIBNAME//[^[:alnum:]]/_}
-
-if [ ! -r "$FASTQ_FILE" ]; then
- echo "Error: Input file ($FASTQ_FILE) not found!" >&2
- exit 1
-fi
-if [ ! -r "$BARCODE_FILE" ]; then
- echo "Error: barcode file ($BARCODE_FILE) not found!" >&2
- exit 1
-fi
-mkdir -p "$OUTPUT_PATH"
-if [ ! -d "$OUTPUT_PATH" ]; then
- echo "Error: failed to create output path '$OUTPUT_PATH'" >&2
- exit 1
-fi
-
-PUBLICURL=""
-BASEPATH="$OUTPUT_PATH/"
-#PREFIX="$BASEPATH"`date "+%Y-%m-%d_%H%M__"`"${LIBNAME}__"
-PREFIX="$BASEPATH""${LIBNAME}__"
-SUFFIX=".txt"
-
-RESULTS=`zcat -f "$FASTQ_FILE" | fastx_barcode_splitter.pl --bcfile "$BARCODE_FILE" --prefix "$PREFIX" --suffix "$SUFFIX" "$@"`
-if [ $? != 0 ]; then
- echo "error"
-fi
-
-#
-# Convert the textual tab-separated table into simple HTML table,
-# with the local path replaces with a valid URL
-echo "
"
-echo "$RESULTS" | sed -r "s|$BASEPATH(.*)|\\1|" | sed '
-i
-s|\t|
|g
-a<\/td><\/tr>
-'
-echo "
"
-echo "
"
diff --git a/tools/fastx_toolkit/fastx_clipper.xml b/tools/fastx_toolkit/fastx_clipper.xml
deleted file mode 100644
index 98a7a661735..00000000000
--- a/tools/fastx_toolkit/fastx_clipper.xml
+++ /dev/null
@@ -1,115 +0,0 @@
-
- adapter sequences
- fastx_toolkit
-
- zcat -f $input | fastx_clipper -l $minlength -a $clip_source.clip_sequence -d $keepdelta -o $output -v $KEEP_N $DISCARD_OPTIONS
-#if $input.ext == "fastqsanger":
- -Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- use this for hairpin barcoding. keep at 0 unless you know what you're doing.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool clips adapters from the 3'-end of the sequences in a FASTA/FASTQ file.
-
---------
-
-
-**Clipping Illustration:**
-
-.. image:: ${static_path}/fastx_icons/fastx_clipper_illustration.png
-
-
-
-
-
-
-
-
-**Clipping Example:**
-
-.. image:: ${static_path}/fastx_icons/fastx_clipper_example.png
-
-
-
-**In the above example:**
-
-* Sequence no. 1 was discarded since it wasn't clipped (i.e. didn't contain the adapter sequence). (**Output** parameter).
-* Sequence no. 5 was discarded --- it's length (after clipping) was shorter than 15 nt (**Minimum Sequence Length** parameter).
-
-
-
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastx_collapser.xml b/tools/fastx_toolkit/fastx_collapser.xml
deleted file mode 100644
index 28a6907774f..00000000000
--- a/tools/fastx_toolkit/fastx_collapser.xml
+++ /dev/null
@@ -1,88 +0,0 @@
-
- sequences
- fastx_toolkit
- zcat -f '$input' | fastx_collapser -v -o '$output'
-#if $input.ext == "fastqsanger":
--Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool collapses identical sequences in a FASTA file into a single sequence.
-
---------
-
-**Example**
-
-Example Input File (Sequence "ATAT" appears multiple times)::
-
- >CSHL_2_FC0042AGLLOO_1_1_605_414
- TGCG
- >CSHL_2_FC0042AGLLOO_1_1_537_759
- ATAT
- >CSHL_2_FC0042AGLLOO_1_1_774_520
- TGGC
- >CSHL_2_FC0042AGLLOO_1_1_742_502
- ATAT
- >CSHL_2_FC0042AGLLOO_1_1_781_514
- TGAG
- >CSHL_2_FC0042AGLLOO_1_1_757_487
- TTCA
- >CSHL_2_FC0042AGLLOO_1_1_903_769
- ATAT
- >CSHL_2_FC0042AGLLOO_1_1_724_499
- ATAT
-
-Example Output file::
-
- >1-1
- TGCG
- >2-4
- ATAT
- >3-1
- TGGC
- >4-1
- TGAG
- >5-1
- TTCA
-
-.. class:: infomark
-
-Original Sequence Names / Lane descriptions (e.g. "CSHL_2_FC0042AGLLOO_1_1_742_502") are discarded.
-
-The output sequence name is composed of two numbers: the first is the sequence's number, the second is the multiplicity value.
-
-The following output::
-
- >2-4
- ATAT
-
-means that the sequence "ATAT" is the second sequence in the file, and it appeared 4 times in the input FASTA file.
-
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastx_nucleotides_distribution.xml b/tools/fastx_toolkit/fastx_nucleotides_distribution.xml
deleted file mode 100644
index 7ed2f93c61f..00000000000
--- a/tools/fastx_toolkit/fastx_nucleotides_distribution.xml
+++ /dev/null
@@ -1,51 +0,0 @@
-
-
- fastx_toolkit
- fastx_nucleotide_distribution_graph.sh -t '$input.name' -i $input -o $output
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-Creates a stacked-histogram graph for the nucleotide distribution in the Solexa library.
-
-.. class:: infomark
-
-**TIP:** Use the **FASTQ Statistics** tool to generate the report file needed for this tool.
-
------
-
-**Output Examples**
-
-The following chart clearly shows the barcode used at the 5'-end of the library: **GATCT**
-
-.. image:: ${static_path}/fastx_icons/fastq_nucleotides_distribution_1.png
-
-In the following chart, one can almost 'read' the most abundant sequence by looking at the dominant values: **TGATA TCGTA TTGAT GACTG AA...**
-
-.. image:: ${static_path}/fastx_icons/fastq_nucleotides_distribution_2.png
-
-The following chart shows a growing number of unknown (N) nucleotides towards later cycles (which might indicate a sequencing problem):
-
-.. image:: ${static_path}/fastx_icons/fastq_nucleotides_distribution_3.png
-
-But most of the time, the chart will look rather random:
-
-.. image:: ${static_path}/fastx_icons/fastq_nucleotides_distribution_4.png
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
-
diff --git a/tools/fastx_toolkit/fastx_quality_statistics.xml b/tools/fastx_toolkit/fastx_quality_statistics.xml
deleted file mode 100644
index 4126a9727a9..00000000000
--- a/tools/fastx_toolkit/fastx_quality_statistics.xml
+++ /dev/null
@@ -1,70 +0,0 @@
-
-
- fastx_toolkit
- zcat -f $input | fastx_quality_stats -o $output -Q 33
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-Creates quality statistics report for the given Solexa/FASTQ library.
-
-.. class:: infomark
-
-**TIP:** This statistics report can be used as input for **Quality Score** and **Nucleotides Distribution** tools.
-
------
-
-**The output file will contain the following fields:**
-
-* column = column number (1 to 36 for a 36-cycles read Solexa file)
-* count = number of bases found in this column.
-* min = Lowest quality score value found in this column.
-* max = Highest quality score value found in this column.
-* sum = Sum of quality score values for this column.
-* mean = Mean quality score value for this column.
-* Q1 = 1st quartile quality score.
-* med = Median quality score.
-* Q3 = 3rd quartile quality score.
-* IQR = Inter-Quartile range (Q3-Q1).
-* lW = 'Left-Whisker' value (for boxplotting).
-* rW = 'Right-Whisker' value (for boxplotting).
-* A_Count = Count of 'A' nucleotides found in this column.
-* C_Count = Count of 'C' nucleotides found in this column.
-* G_Count = Count of 'G' nucleotides found in this column.
-* T_Count = Count of 'T' nucleotides found in this column.
-* N_Count = Count of 'N' nucleotides found in this column.
-
-
-For example::
-
- 1 6362991 -4 40 250734117 39.41 40 40 40 0 40 40 1396976 1329101 678730 2958184 0
- 2 6362991 -5 40 250531036 39.37 40 40 40 0 40 40 1786786 1055766 1738025 1782414 0
- 3 6362991 -5 40 248722469 39.09 40 40 40 0 40 40 2296384 984875 1443989 1637743 0
- 4 6362991 -4 40 248214827 39.01 40 40 40 0 40 40 2536861 1167423 1248968 1409739 0
- 36 6362991 -5 40 117158566 18.41 7 15 30 23 -5 40 4074444 1402980 63287 822035 245
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
-
diff --git a/tools/fastx_toolkit/fastx_renamer.xml b/tools/fastx_toolkit/fastx_renamer.xml
deleted file mode 100644
index db6bfd212c9..00000000000
--- a/tools/fastx_toolkit/fastx_renamer.xml
+++ /dev/null
@@ -1,65 +0,0 @@
-
-
- fastx_toolkit
- zcat -f $input | fastx_renamer -n $TYPE -o $output -v
-#if $input.ext == "fastqsanger":
--Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool renames the sequence identifiers in a FASTQ/A file.
-
-.. class:: infomark
-
-Use this tool at the beginning of your workflow, as a way to keep the original sequence (before trimming, clipping, barcode-removal, etc).
-
---------
-
-**Example**
-
-The following Solexa-FASTQ file::
-
- @CSHL_4_FC042GAMMII_2_1_517_596
- GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
- +CSHL_4_FC042GAMMII_2_1_517_596
- 40 40 40 40 40 40 40 40 40 40 38 40 40 40 40 40 14 40 40 40 40 40 36 40 13 14 24 24 9 24 9 40 10 10 15 40
-
-Renamed to **nucleotides sequence**::
-
- @GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
- GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
- +GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
- 40 40 40 40 40 40 40 40 40 40 38 40 40 40 40 40 14 40 40 40 40 40 36 40 13 14 24 24 9 24 9 40 10 10 15 40
-
-Renamed to **numeric counter**::
-
- @1
- GGTCAATGATGAGTTGGCACTGTAGGCACCATCAAT
- +1
- 40 40 40 40 40 40 40 40 40 40 38 40 40 40 40 40 14 40 40 40 40 40 36 40 13 14 24 24 9 24 9 40 10 10 15 40
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastx_reverse_complement.xml b/tools/fastx_toolkit/fastx_reverse_complement.xml
deleted file mode 100644
index 06e188ed575..00000000000
--- a/tools/fastx_toolkit/fastx_reverse_complement.xml
+++ /dev/null
@@ -1,63 +0,0 @@
-
-
- fastx_toolkit
- zcat -f '$input' | fastx_reverse_complement -v -o $output
-#if $input.ext == "fastqsanger":
--Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool reverse-complements each sequence in a library.
-If the library is a FASTQ, the quality-scores are also reversed.
-
---------
-
-**Example**
-
-Input FASTQ file::
-
- @CSHL_1_FC42AGWWWXX:8:1:3:740
- TGTCTGTAGCCTCNTCCTTGTAATTCAAAGNNGGTA
- +CSHL_1_FC42AGWWWXX:8:1:3:740
- 33 33 33 34 33 33 33 33 33 33 33 33 27 5 27 33 33 33 33 33 33 27 21 27 33 32 31 29 26 24 5 5 15 17 27 26
-
-
-Output FASTQ file::
-
- @CSHL_1_FC42AGWWWXX:8:1:3:740
- TACCNNCTTTGAATTACAAGGANGAGGCTACAGACA
- +CSHL_1_FC42AGWWWXX:8:1:3:740
- 26 27 17 15 5 5 24 26 29 31 32 33 27 21 27 33 33 33 33 33 33 27 5 27 33 33 33 33 33 33 33 33 34 33 33 33
-
-------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
diff --git a/tools/fastx_toolkit/fastx_trimmer.xml b/tools/fastx_toolkit/fastx_trimmer.xml
deleted file mode 100644
index 3baa934571a..00000000000
--- a/tools/fastx_toolkit/fastx_trimmer.xml
+++ /dev/null
@@ -1,81 +0,0 @@
-
-
- fastx_toolkit
- zcat -f '$input' | fastx_trimmer -v -f $first -l $last -o $output
-#if $input.ext == "fastqsanger":
--Q 33
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool trims (cut bases from) sequences in a FASTA/Q file.
-
---------
-
-**Example**
-
-Input Fasta file (with 36 bases in each sequences)::
-
- >1-1
- TATGGTCAGAAACCATATGCAGAGCCTGTAGGCACC
- >2-1
- CAGCGAGGCTTTAATGCCATTTGGCTGTAGGCACCA
-
-
-Trimming with First=1 and Last=21, we get a FASTA file with 21 bases in each sequences (starting from the first base)::
-
- >1-1
- TATGGTCAGAAACCATATGCA
- >2-1
- CAGCGAGGCTTTAATGCCATT
-
-Trimming with First=6 and Last=10, will generate a FASTA file with 5 bases (bases 6,7,8,9,10) in each sequences::
-
- >1-1
- TCAGA
- >2-1
- AGGCT
-
- ------
-
-This tool is based on `FASTX-toolkit`__ by Assaf Gordon.
-
- .. __: http://hannonlab.cshl.edu/fastx_toolkit/
-
-
-
-
diff --git a/tools/phenotype_association/ctd.pl b/tools/phenotype_association/ctd.pl
deleted file mode 100755
index 644e0789870..00000000000
--- a/tools/phenotype_association/ctd.pl
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/usr/bin/perl -w
-use strict;
-use LWP::UserAgent;
-require HTTP::Cookies;
-
-#######################################################
-# ctd.pl
-# Submit a batch query to CTD and fetch results into galaxy history
-# usage: ctd.pl inFile idCol inputType resultType actionType outFile
-#######################################################
-
-if (!@ARGV or scalar @ARGV != 6) {
- print "usage: ctd.pl inFile idCol inputType resultType actionType outFile\n";
- exit;
-}
-
-my $in = shift @ARGV;
-my $col = shift @ARGV;
-if ($col < 1) {
- print "The column number is with a 1 start\n";
- exit 1;
-}
-my $type = shift @ARGV;
-my $resType = shift @ARGV;
-my $actType = shift @ARGV;
-my $out = shift @ARGV;
-
-my @data;
-open(FH, $in) or die "Couldn't open $in, $!\n";
-while () {
- chomp;
- my @f = split(/\t/);
- if (scalar @f < $col) {
- print "ERROR the requested column is not in the file $col\n";
- exit 1;
- }
- push(@data, $f[$col-1]);
-}
-close FH or die "Couldn't close $in, $!\n";
-
-my $url = 'http://ctdbase.org/tools/batchQuery.go';
-#my $url = 'http://ctd.mdibl.org/tools/batchQuery.go';
-my $d = join("\n", @data);
-#list maintains order, where hash doesn't
-#order matters at ctd
-#to use input file (gives error can't find file)
-#my @form = ('inputType', $type, 'inputTerms', '', 'report', $resType,
- #'queryFile', [$in, ''], 'queryFileColumn', $col, 'format', 'tsv', 'action', 'Submit');
-my @form = ('inputType', $type, 'inputTerms', $d, 'report', $resType,
- 'queryFile', '', 'format', 'tsv', 'action', 'Submit');
-if ($resType eq 'cgixns') { #only add if this type
- push(@form, 'actionTypes', $actType);
-}
-if ($resType eq 'go' or $resType eq 'go_enriched') {
- push(@form, 'ontology', 'go_bp', 'ontology', 'go_mf', 'ontology', 'go_cc');
-}
-my $ua = LWP::UserAgent->new;
-$ua->cookie_jar(HTTP::Cookies->new( () ));
-$ua->agent('Mozilla/5.0');
-my $page = $ua->post($url, \@form, 'Content_Type'=>'form-data');
-if ($page->is_success) {
- open(FH, ">", $out) or die "Couldn't open $out, $!\n";
- print FH "#";
- print FH $page->content, "\n";
- close FH or die "Couldn't close $out, $!\n";
-}else {
- print "ERROR failed to get page from CTD, ", $page->status_line, "\n";
- print $page->content, "\n";
- my $req = $page->request();
- print "Requested \n";
- foreach my $k(keys %$req) {
- if ($k eq '_headers') {
- my $t = $req->{$k};
- foreach my $k2 (keys %$t) { print "$k2 => $t->{$k2}\n"; }
- }else { print "$k => $req->{$k}\n"; }
- }
- exit 1;
-}
-exit;
-
diff --git a/tools/phenotype_association/ctd.xml b/tools/phenotype_association/ctd.xml
deleted file mode 100644
index b769758b96c..00000000000
--- a/tools/phenotype_association/ctd.xml
+++ /dev/null
@@ -1,289 +0,0 @@
-
- analysis of chemicals, diseases, or genes
- #if $inType.inputType=="disease" #ctd.pl $input $numerical_column $inType.inputType $inType.report ANY $out_file1
-#else if $inType.reportType.report=="cgixns" #ctd.pl $input $numerical_column $inType.inputType $inType.reportType.report "$inType.reportType.actType" $out_file1
-#else #ctd.pl $input $numerical_column $inType.inputType $inType.reportType.report ANY $out_file1
-#end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**Dataset formats**
-
-The input and output datasets are tabular_.
-
------
-
-**What it does**
-
-This tool extracts data related to the provided list of identifiers
-from the Comparative Toxicogenomics Database (CTD). The fields
-extracted vary with the type of data requested; the first row
-of the output identifies the columns.
-
-For the curated chemical-gene interactions, you can also choose the
-interaction type from the search-and-select box. The choices that
-start with '-' are a subset of a choice above them; you can chose
-either the general interaction type or a more specific one.
-
-Home page: http://ctdbase.org
-
-.. _tabular: ${static_path}/formatHelp.html#tab
-
------
-
-**Examples**
-
-- input data file:
- HBB
-
-- select column c1, Identifier type = Genes, and Data to extract = All disease relationships
-
-- output file::
-
- #Input GeneSymbol GeneName GeneID DiseaseName DiseaseID GeneDiseaseRelation OmimIDs PubMedIDs
- hbb HBB hemoglobin, beta 3043 Abnormalities, Drug-Induced MESH:D000014 inferred via Ethanol 17676605|18926900
- hbb HBB hemoglobin, beta 3043 Abnormalities, Drug-Induced MESH:D000014 inferred via Valproic Acid 8875741
- etc.
-
-Another example:
-
-- same input file:
- HBB
-
-- select column c1, Identifier type = Genes, Data to extract = Curated chemical-gene interactions, and Interaction type = ANY
-
-- output file::
-
- #Input GeneSymbol GeneName GeneID ChemicalName ChemicalID CasRN Organism OrganismID Interaction InteractionTypes PubMedIDs
- hbb HBB hemoglobin, beta 3043 1-nitronaphthalene C016614 86-57-7 Macaca mulatta 9544 1-nitronaphthalene metabolite binds to HBB protein binding 16453347
- hbb HBB hemoglobin, beta 3043 2,6-diisocyanatotoluene C026942 91-08-7 Cavia porcellus 10141 2,6-diisocyanatotoluene binds to HBB protein binding 8728499
- etc.
-
------
-
-**Reference**
-
-Davis AP, Murphy CG, Saraceni-Richards CA, Rosenstein MC, Wiegers TC, Mattingly CJ. Comparative Toxicogenomics Database: a knowledgebase and discovery tool for chemical.gene.disease networks. Nucleic Acids Res. 2009 Jan;37(Database issue):D786-92.
-
-
-
-
diff --git a/tools/phenotype_association/disease_ontology_gene_fuzzy_selector.pl b/tools/phenotype_association/disease_ontology_gene_fuzzy_selector.pl
deleted file mode 100755
index 0dd3c498b23..00000000000
--- a/tools/phenotype_association/disease_ontology_gene_fuzzy_selector.pl
+++ /dev/null
@@ -1,64 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-##################################################################
-# Select genes that are associated with the diseases listed in the
-# disease ontology.
-# ontology: http://do-wiki.nubic.northwestern.edu/index.php/Main_Page
-# gene associations by FunDO: http://projects.bioinformatics.northwestern.edu/do_rif/
-# Sept 2010, switch to doLite
-# input: build outfile sourceFileLoc.loc term or partial term
-##################################################################
-
-if (!@ARGV or @ARGV < 3) {
- print "usage: disease_ontology_gene_selector.pl build outfile.txt sourceFile.loc [list of terms]\n";
- exit;
-}
-
-my $build = shift @ARGV;
-my $out = shift @ARGV;
-my $in = shift @ARGV;
-my $term = shift @ARGV;
-$term =~ s/^'//; #remove quotes protecting from shell
-$term =~ s/'$//;
-my $data;
-open(LOC, $in) or die "Couldn't open $in, $!\n";
-while () {
- chomp;
- if (/^\s*#/) { next; }
- my @f = split(/\t/);
- if ($f[0] eq $build) {
- if ($f[1] eq 'disease associated genes') {
- $data = $f[2];
- }
- }
-}
-close LOC or die "Couldn't close $in, $!\n";
-if (!$data) {
- print "Error $build not found in $in\n";
- exit;
-}
-if (!defined $term) {
- print "No disease term entered\n";
- exit;
-}
-
-#start with just fuzzy term matches
-open(OUT, ">", $out) or die "Couldn't open $out, $!\n";
-open(FH, $data) or die "Couldn't open data file $data, $!\n";
-$term =~ s/\s+/|/g; #use OR between words
-while () {
- chomp;
- my @f = split(/\t/); #chrom start end strand geneName geneID disease
- if ($f[6] =~ /($term)/i) {
- print OUT join("\t", @f), "\n";
- }elsif ($term eq 'disease') { #print all with disease
- print OUT join("\t", @f), "\n";
- }
-}
-close FH or die "Couldn't close data file $data, $!\n";
-close OUT or die "Couldn't close $out, $!\n";
-
-exit;
diff --git a/tools/phenotype_association/dividePgSnpAlleles.pl b/tools/phenotype_association/dividePgSnpAlleles.pl
deleted file mode 100755
index 167847d10cc..00000000000
--- a/tools/phenotype_association/dividePgSnpAlleles.pl
+++ /dev/null
@@ -1,41 +0,0 @@
-#!/usr/bin/perl -w
-use strict;
-
-#divide the alleles and their information into separate columns for pgSnp-like
-#files. Keep any additional columns beyond the pgSnp ones.
-#reads from stdin, writes to stdout
-my $ref;
-my $in;
-if (@ARGV && $ARGV[0] =~ /-ref=(\d+)/) {
- $ref = $1 -1;
- if ($ref == -1) { undef $ref; }
- shift @ARGV;
-}
-if (@ARGV) {
- $in = shift @ARGV;
-}
-
-open(FH, $in) or die "Couldn't open $in, $!\n";
-while () {
- chomp;
- my @f = split(/\t/);
- my @a = split(/\//, $f[3]);
- my @fr = split(/,/, $f[5]);
- my @sc = split(/,/, $f[6]);
- if ($f[4] == 1) { #homozygous add N, 0, 0
- if ($ref) { push(@a, $f[$ref]); }
- else { push(@a, "N"); }
- push(@fr, 0);
- push(@sc, 0);
- }
- if ($f[4] > 2) { next; } #skip those with more than 2 alleles
- print "$f[0]\t$f[1]\t$f[2]\t$a[0]\t$fr[0]\t$sc[0]\t$a[1]\t$fr[1]\t$sc[1]";
- if (scalar @f > 7) {
- splice(@f, 0, 7); #remove first 7
- print "\t", join("\t", @f), "\n";
- }else { print "\n"; }
-}
-close FH;
-
-exit;
-
diff --git a/tools/phenotype_association/dividePgSnpAlleles.xml b/tools/phenotype_association/dividePgSnpAlleles.xml
deleted file mode 100644
index 874d47521ae..00000000000
--- a/tools/phenotype_association/dividePgSnpAlleles.xml
+++ /dev/null
@@ -1,76 +0,0 @@
-
- into columns
-
- #if $refcol.ref == "yes" #dividePgSnpAlleles.pl -ref=$refcol.ref_column $input1 > $out_file1
- #else #dividePgSnpAlleles.pl $input1 > $out_file1
- #end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**Dataset formats**
-
-The input dataset is of Galaxy datatype interval_ with the columns specified
-for pgSnp_.
-Any additional columns beyond the pgSnp defined columns will be appended to
-the output.
-The output dataset is in interval_ format. (`Dataset missing?`_)
-
-.. _interval: ./static/formatHelp.html#interval
-.. _Dataset missing?: ./static/formatHelp.html
-.. _pgSnp: ./static/formatHelp.html#pgSnp
-
-**What it does**
-
-This separates the alleles from a pgSnp dataset into separate columns,
-as well as the frequencies and scores that go with the alleles. It will skip
-any positions with more than 2 alleles. If only a single allele is given then "N"
-will be used for the second, with a frequency and score of zero. Or, if a
-column with reference alleles is provided,
-the value in that column will be used in place of the "N" for single alleles.
-
------
-
-**Examples**
-
-- input pgSnp file::
-
- chr1 256 257 A/C 2 3,4 10,20
- chr1 56100 56101 A 1 5 30
- chr1 77052 77053 A/G 2 6,7 40,50
- chr1 110904 110905 A 1 8 60
- etc.
-
-- output::
-
- chr1 256 257 A 3 10 C 4 20
- chr1 56100 56101 A 5 30 N 0 0
- chr1 77052 77053 A 6 40 G 7 50
- chr1 110904 110905 A 8 60 N 0 0
- etc.
-
-
-
diff --git a/tools/phenotype_association/funDo.xml b/tools/phenotype_association/funDo.xml
deleted file mode 100644
index 113355ea046..00000000000
--- a/tools/phenotype_association/funDo.xml
+++ /dev/null
@@ -1,101 +0,0 @@
-
- human genes associated with disease terms
-
-
- disease_ontology_gene_fuzzy_selector.pl $build $out_file1 ${GALAXY_DATA_INDEX_DIR}/funDo.loc '$term'
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**Dataset formats**
-
-There is no input dataset. The output is in interval_ format.
-
-.. _interval: ${static_path}/formatHelp.html#interval
-
------
-
-**What it does**
-
-This tool searches the disease-term field of the DOLite mappings
-used by the FunDO project and returns a set of genes that
-are associated with terms matching the specified pattern. (This is the
-reverse of what FunDO's own server does.)
-
-The search is case insensitive, and selects terms that contain any of
-the given words, either exactly or within a longer word (e.g. "nemia"
-selects not only "anemia", but also "hyperglycinemia", "tyrosinemias",
-and many other things). Multiple words should be separated by spaces,
-not commas. As a special case, entering the word "disease" returns all
-genes associated with any disease, even if that word does not actually
-appear in the term field.
-
-Website: http://django.nubic.northwestern.edu/fundo/
-
------
-
-**Example**
-
-Typing::
-
- carcinoma
-
-results in::
-
- 1. 2. 3. 4. 5. 6. 7.
- chr11 89507465 89565427 + NAALAD2 10003 Adenocarcinoma
- chr15 50189113 50192264 - BCL2L10 10017 Carcinoma
- chr7 150535855 150555250 - ABCF2 10061 Clear cell carcinoma
- chr7 150540508 150555250 - ABCF2 10061 Clear cell carcinoma
- chr10 134925911 134940397 - ADAM8 101 Adenocarcinoma
- chr10 134925911 134940397 - ADAM8 101 Adenocarcinoma
- etc.
-
-where the column contents are as follows::
-
- 1. chromosome name
- 2. start position of the gene
- 3. end position of the gene
- 4. strand
- 4. gene name
- 6. Entrez Gene ID
- 7. disease term
-
------
-
-**References**
-
-Du P, Feng G, Flatow J, Song J, Holko M, Kibbe WA, Lin SM. (2009)
-From disease ontology to disease-ontology lite: statistical methods to adapt a general-purpose
-ontology for the test of gene-ontology associations.
-Bioinformatics. 25(12):i63-8.
-
-Osborne JD, Flatow J, Holko M, Lin SM, Kibbe WA, Zhu LJ, Danila MI, Feng G, Chisholm RL. (2009)
-Annotating the human genome with Disease Ontology.
-BMC Genomics. 10 Suppl 1:S6.
-
-
-
diff --git a/tools/phenotype_association/hilbertvis.sh b/tools/phenotype_association/hilbertvis.sh
deleted file mode 100755
index eeb6a88a60e..00000000000
--- a/tools/phenotype_association/hilbertvis.sh
+++ /dev/null
@@ -1,109 +0,0 @@
-#!/usr/bin/env bash
-
-input_file="$1"
-output_file="$2"
-chromInfo_file="$3"
-chrom="$4"
-score_col="$5"
-hilbert_curve_level="$6"
-summarization_mode="$7"
-chrom_col="$8"
-start_col="$9"
-end_col="${10}"
-strand_col="${11}"
-
-## use first sequence if chrom filed is empty
-if [ -z "$chrom" ]; then
- chrom=$( head -n 1 "$input_file" | cut -f$chrom_col )
-fi
-
-## get sequence length
-if [ ! -r "$chromInfo_file" ]; then
- echo "Unable to read chromInfo_file $chromInfo_file" 1>&2
- exit 1
-fi
-
-chrom_len=$( awk '$1 == chrom {print $2}' chrom=$chrom $chromInfo_file )
-
-## error if we can't find the chrom_len
-if [ -z "$chrom_len" ]; then
- echo "Can't find length for sequence \"$chrom\" in chromInfo_file $chromInfo_file" 1>&2
- exit 1
-fi
-
-## make sure chrom_len is positive
-if [ $chrom_len -le 0 ]; then
- echo "sequence \"$chrom\" length $chrom_len <= 0" 1>&2
- exit 1
-fi
-
-## modify R script depending on the inclusion of a score column, strand information
-input_cols="\$${start_col}, \$${end_col}"
-col_types='beg=0, end=0, strand=""'
-
-# if strand_col == 0 (strandCol metadata is not set), assume everything's on the plus strand
-if [ $strand_col -ne 0 ]; then
- input_cols="${input_cols}, \$${strand_col}"
-else
- input_cols="${input_cols}, \\\"+\\\""
-fi
-
-# set plot value (either from data or use a constant value)
-if [ $score_col -eq -1 ]; then
- value=1
-else
- input_cols="${input_cols}, \$${score_col}"
- col_types="${col_types}, score=0"
- value='chunk$score[i]'
-fi
-
-R --vanilla &> /dev/null <
- visualization of genomic data with the Hilbert curve
-
-
- hilbertvis.sh $input $output $chromInfo "$chrom" $plot_value.score_col $level $mode
- #if isinstance( $input.datatype, $__app__.datatypes_registry.get_datatype_by_extension('gff').__class__)
- 1 4 5 7
- #else
- ${input.metadata.chromCol} ${input.metadata.startCol} ${input.metadata.endCol} ${input.metadata.strandCol}
- #end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**Dataset formats**
-
-The input format is interval_, and the output is an image in PDF format.
-(`Dataset missing?`_)
-
-.. _interval: ${static_path}/formatHelp.html#interval
-.. _Dataset missing?: ${static_path}/formatHelp.html
-
------
-
-**What it does**
-
-HilbertVis uses the Hilbert space-filling curve to visualize the structure of
-position-dependent data. It maps the traditional one-dimensional line
-visualization onto a two-dimensional square. For example, here is a diagram
-showing the path of a level-2 Hilbert curve.
-
-.. image:: ${static_path}/images/hilbertvisDiagram.png
-
-The shade of each pixel represents the value for the corresponding bin of
-consecutive genomic positions, calculated according to the specified
-summarization mode. The pixels are arranged so that bins that are close
-to each other on the data vector are represented by pixels that are close
-to each other in the plot. In particular, adjacent bins are mapped to
-adjacent pixels. Hence, dark spots in a figure represent a peak; the area
-of the spot in the two-dimensional plot is proportional to the width of the
-peak in the one-dimensional data, and the darkness of the spot corresponds to
-the height of the peak.
-
-The input file is in interval format, and typically contains a column with
-scores or other numbers, such as conservation scores, SNP density, the
-coverage of aligned reads from ChIP-Seq data, etc.
-
-Website: http://www.ebi.ac.uk/huber-srv/hilbert/
-
------
-
-**Examples**
-
-Here are some examples from the HilbertVis homepage, using ChIP-Seq data.
-
-.. image:: ${static_path}/images/hilbertvis1.png
-
------
-
-.. image:: ${static_path}/images/hilbertvis2.png
-
------
-
-**Reference**
-
-Anders S. (2009)
-Visualization of genomic data with the Hilbert curve.
-Bioinformatics. 25(10):1231-5. Epub 2009 Mar 17.
-
-
-
diff --git a/tools/plotting/r_wrapper.sh b/tools/plotting/r_wrapper.sh
deleted file mode 100755
index ac978d8b029..00000000000
--- a/tools/plotting/r_wrapper.sh
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/bin/sh
-
-### Run R providing the R script in $1 as standard input and passing
-### the remaining arguments on the command line
-
-# Function that writes a message to stderr and exits
-function fail
-{
- echo "$@" >&2
- exit 1
-}
-
-# Ensure R executable is found
-which R > /dev/null || fail "'R' is required by this tool but was not found on path"
-
-# Extract first argument
-infile=$1; shift
-
-# Ensure the file exists
-test -f $infile || fail "R input file '$infile' does not exist"
-
-# Invoke R passing file named by first argument to stdin
-R --vanilla --slave $* < $infile
diff --git a/tools/plotting/xy_plot.xml b/tools/plotting/xy_plot.xml
deleted file mode 100644
index 00acdef726c..00000000000
--- a/tools/plotting/xy_plot.xml
+++ /dev/null
@@ -1,148 +0,0 @@
-
- for multiple series and graph types
- r_wrapper.sh $script_file
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- ## Setup R error handling to go to stderr
- options( show.error.messages=F,
- error = function () { cat( geterrmessage(), file=stderr() ); q( "no", 1, F ) } )
- ## Determine range of all series in the plot
- xrange = c( NULL, NULL )
- yrange = c( NULL, NULL )
- #for $i, $s in enumerate( $series )
- s${i} = read.table( "${s.input.file_name}" )
- x${i} = s${i}[,${s.xcol}]
- y${i} = s${i}[,${s.ycol}]
- xrange = range( x${i}, xrange )
- yrange = range( y${i}, yrange )
- #end for
- ## Open output PDF file
- pdf( "${out_file1}" )
- ## Dummy plot for axis / labels
- plot( NULL, type="n", xlim=xrange, ylim=yrange, main="${main}", xlab="${xlab}", ylab="${ylab}" )
- ## Plot each series
- #for $i, $s in enumerate( $series )
- #if $s.series_type['type'] == "line"
- lines( x${i}, y${i}, lty=${s.series_type.lty}, lwd=${s.series_type.lwd}, col=${s.series_type.col} )
- #elif $s.series_type.type == "points"
- points( x${i}, y${i}, pch=${s.series_type.pch}, cex=${s.series_type.cex}, col=${s.series_type.col} )
- #end if
- #end for
- ## Close the PDF file
- devname = dev.off()
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-This tool allows you to plot values contained in columns of a dataset against each other and also allows you to have different series corresponding to the same or different datasets in one plot.
-
------
-
-.. class:: warningmark
-
-This tool throws an error if the columns selected for plotting are absent or are not numeric and also if the lengths of these columns differ.
-
------
-
-**Example**
-
-Input file::
-
- 1 68 4.1
- 2 71 4.6
- 3 62 3.8
- 4 75 4.4
- 5 58 3.2
- 6 60 3.1
- 7 67 3.8
- 8 68 4.1
- 9 71 4.3
- 10 69 3.7
-
-Create a two series XY plot on the above data:
-
-- Series 1: Red Dashed-Line plot between columns 1 and 2
-- Series 2: Blue Circular-Point plot between columns 3 and 2
-
-.. image:: ${static_path}/images/xy_example.jpg
-
-
diff --git a/tools/regVariation/categorize_elements_satisfying_criteria.pl b/tools/regVariation/categorize_elements_satisfying_criteria.pl
deleted file mode 100644
index 81a4b474221..00000000000
--- a/tools/regVariation/categorize_elements_satisfying_criteria.pl
+++ /dev/null
@@ -1,172 +0,0 @@
-#!/usr/bin/perl -w
-
-# The program takes as input a set of categories, such that each category contains many elements.
-# It also takes a table relating elements with criteria, such that each element is assigned a number
-# representing the number of times the element satisfies a certain criterion.
-# The first input is a TABULAR format file, such that the left column represents the name of categories and,
-# all other columns represent the names of elements.
-# The second input is a TABULAR format file relating elements with criteria, such that the first line
-# represents the names of criteria and the left column represents the names of elements.
-# The output is a TABULAR format file relating catergories with criteria, such that each categoy is
-# assigned a number representing the total number of times its elements satisfies a certain criterion.
-# Each category is assigned as many numbers as criteria.
-
-use strict;
-use warnings;
-
-#variables to handle information of the categories input file
-my @categoryElementsArray = ();
-my @categoriesArray = ();
-my $categoryMemberNames;
-my $categoryName;
-my %categoryMembersHash = ();
-my $memberNumber = 0;
-my $totalMembersNumber = 0;
-my $totalCategoriesNumber = 0;
-my @categoryCountersTwoDimArray = ();
-my $lineCounter1 = 0;
-
-#variables to handle information of the criteria and elements data input file
-my $elementLine;
-my @elementDataArray = ();
-my $elementName;
-my @criteriaArray = ();
-my $criteriaNumber = 0;
-my $totalCriteriaNumber = 0;
-my $lineCounter2 = 0;
-
-#variable representing the row and column indices used to store results into a two-dimensional array
-my $row = 0;
-my $column = 0;
-
-# check to make sure having correct files
-my $usage = "usage: categorize_motifs_significance.pl [TABULAR.in] [TABULAR.in] [TABULAR.out] \n";
-die $usage unless @ARGV == 3;
-
-#get the categories input file
-my $categories_inputFile = $ARGV[0];
-
-#get the criteria and data input file
-my $elements_data_inputFile = $ARGV[1];
-
-#get the output file
-my $categorized_data_outputFile = $ARGV[2];
-
-#open the input and output files
-open (INPUT1, "<", $categories_inputFile) || die("Could not open file $categories_inputFile \n");
-open (INPUT2, "<", $elements_data_inputFile ) || die("Could not open file $elements_data_inputFile \n");
-open (OUTPUT, ">", $categorized_data_outputFile) || die("Could not open file $categorized_data_outputFile \n");
-
-#store the first input file into an array
-my @categoriesData = ;
-
-#reset the value of $lineCounter1 to 0
-$lineCounter1 = 0;
-
-#iterate through the first input file to get the names of categories and their corresponding elements
-foreach $categoryMemberNames (@categoriesData){
- chomp ($categoryMemberNames);
-
- @categoryElementsArray = split(/\t/, $categoryMemberNames);
-
- #store the name of the current category into an array
- $categoriesArray [$lineCounter1] = $categoryElementsArray[0];
-
- #store the name of the current category into a two-dimensional array
- $categoryCountersTwoDimArray [$lineCounter1] [0] = $categoryElementsArray[0];
-
- #get the total number of elements in the current category
- $totalMembersNumber = @categoryElementsArray;
-
- #store the names of categories and their corresponding elements into a hash
- for ($memberNumber = 1; $memberNumber < $totalMembersNumber; $memberNumber++) {
-
- $categoryMembersHash{$categoryElementsArray[$memberNumber]} = $categoriesArray[$lineCounter1];
- }
-
- $lineCounter1++;
-}
-
-#store the second input file into an array
-my @elementsData = ;
-
-#reset the value of $lineCounter2 to 0
-$lineCounter2 = 0;
-
-#iterate through the second input file in order to count the number of elements
-#in each category that satisfy each criterion
-foreach $elementLine (@elementsData){
- chomp ($elementLine);
-
- $lineCounter2++;
-
- @elementDataArray = split(/\t/, $elementLine);
-
- #if at the first line, get the total number of criteria and the total
- #number of catergories and initialize the two-dimensional array
- if ($lineCounter2 == 1){
- @criteriaArray = @elementDataArray;
- $totalCriteriaNumber = @elementDataArray;
-
- $totalCategoriesNumber = @categoriesArray;
-
- #initialize the two-dimensional array
- for ($row = 0; $row < $totalCategoriesNumber; $row++) {
-
- for ($column = 1; $column <= $totalCriteriaNumber; $column++) {
-
- $categoryCountersTwoDimArray [$row][$column] = 0;
- }
- }
- }
- else{
- #get the element data
- $elementName = $elementDataArray[0];
-
- #do the counting and store the result in the two-dimensional array
- for ($criteriaNumber = 0; $criteriaNumber < $totalCriteriaNumber; $criteriaNumber++) {
-
- if ($elementDataArray[$criteriaNumber + 1] > 0){
-
- $categoryName = $categoryMembersHash{$elementName};
-
- my ($categoryIndex) = grep $categoriesArray[$_] eq $categoryName, 0 .. $#categoriesArray;
-
- $categoryCountersTwoDimArray [$categoryIndex] [$criteriaNumber + 1] = $categoryCountersTwoDimArray [$categoryIndex] [$criteriaNumber + 1] + $elementDataArray[$criteriaNumber + 1];
- }
- }
- }
-}
-
-print OUTPUT "\t";
-
-#store the criteria names into the output file
-for ($column = 1; $column <= $totalCriteriaNumber; $column++) {
-
- if ($column < $totalCriteriaNumber){
- print OUTPUT $criteriaArray[$column - 1] . "\t";
- }
- else{
- print OUTPUT $criteriaArray[$column - 1] . "\n";
- }
-}
-
-#store the category names and their corresponding number of elements satisfying criteria into the output file
-for ($row = 0; $row < $totalCategoriesNumber; $row++) {
-
- for ($column = 0; $column <= $totalCriteriaNumber; $column++) {
-
- if ($column < $totalCriteriaNumber){
- print OUTPUT $categoryCountersTwoDimArray [$row][$column] . "\t";
- }
- else{
- print OUTPUT $categoryCountersTwoDimArray [$row][$column] . "\n";
- }
- }
-}
-
-#close the input and output file
-close(OUTPUT);
-close(INPUT2);
-close(INPUT1);
-
diff --git a/tools/regVariation/categorize_elements_satisfying_criteria.xml b/tools/regVariation/categorize_elements_satisfying_criteria.xml
deleted file mode 100644
index 16e1da20fb3..00000000000
--- a/tools/regVariation/categorize_elements_satisfying_criteria.xml
+++ /dev/null
@@ -1,78 +0,0 @@
-
- satisfying criteria
-
-
- categorize_elements_satisfying_criteria.pl $inputFile1 $inputFile2 $outputFile1
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-The program takes as input a set of categories, such that each category contains many elements. It also takes a table relating elements with criteria, such that each element is assigned a number representing the number of times the element satisfies a certain criterion.
-
-- The first input is a TABULAR format file, such that the left column represents the names of categories and, all other columns represent the names of elements in each category.
-- The second input is a TABULAR format file relating elements with criteria, such that the first line represents the names of criteria and the left column represents the names of elements.
-- The output is a TABULAR format file relating catergories with criteria, such that each categoy is assigned a number representing the total number of times its elements satisfies a certain criterion.. Each category is assigned as many numbers as criteria.
-
-
-**Example**
-
-Let the first input file be a group of motif categories as follows::
-
- Deletion_Hotspots deletionHoptspot1 deletionHoptspot2 deletionHoptspot3
- Dna_Pol_Pause_Frameshift dnaPolPauseFrameshift1 dnaPolPauseFrameshift2 dnaPolPauseFrameshift3 dnaPolPauseFrameshift4
- Indel_Hotspots indelHotspot1
- Insertion_Hotspots insertionHotspot1 insertionHotspot2
- Topoisomerase_Cleavage_Sites topoisomeraseCleavageSite1 topoisomeraseCleavageSite2 topoisomeraseCleavageSite3
-
-
-And let the second input file represent the number of times each motif occurs in a certain window size of indel flanking regions, as follows::
-
- 10bp 20bp 40bp
- deletionHoptspot1 1 1 2
- deletionHoptspot2 1 1 1
- deletionHoptspot3 0 0 0
- dnaPolPauseFrameshift1 1 1 1
- dnaPolPauseFrameshift2 0 2 1
- dnaPolPauseFrameshift3 0 0 0
- dnaPolPauseFrameshift4 0 1 2
- indelHotspot1 0 0 0
- insertionHotspot1 0 0 1
- insertionHotspot2 1 1 1
- topoisomeraseCleavageSite1 1 1 1
- topoisomeraseCleavageSite2 1 2 1
- topoisomeraseCleavageSite3 0 0 2
-
-Running the program will give the total number of times the motifs of each category occur in every window size of indel flanking regions::
-
- 10bp 20bp 40bp
- Deletion_Hotspots 2 2 3
- Dna_Pol_Pause_Frameshift 1 4 4
- Indel_Hotspots 0 0 0
- Insertion_Hotspots 1 1 2
- Topoisomerase_Cleavage_Sites 2 3 4
-
-
-
-
diff --git a/tools/regVariation/compute_motif_frequencies_for_all_motifs.pl b/tools/regVariation/compute_motif_frequencies_for_all_motifs.pl
deleted file mode 100644
index 8f828afe93f..00000000000
--- a/tools/regVariation/compute_motif_frequencies_for_all_motifs.pl
+++ /dev/null
@@ -1,153 +0,0 @@
-#!/usr/bin/perl -w
-
-# a program to compute the frequencies of each motif at a window size, determined by the user, in both
-# upstream and downstream sequences flanking indels in all chromosomes.
-# the first input is a TABULAR format file containing the motif names and sequences, such that the file
-# consists of two columns: the left column represents the motif names and the right column represents
-# the motif sequence, one line per motif.
-# the second input is a TABULAR format file containing the windows into which both upstream and downstream
-# sequences flanking indels have been divided.
-# the fourth input is an integer number representing the number of windows to be considered in both
-# upstream and downstream flanking sequences.
-# the output is a TABULAR format file consisting of three columns: the left column represents the motif
-# name, the middle column represents the motif frequency in the window of the upstream sequence flanking
-# an indel, and the the right column represents the motif frequency in the window of the downstream
-# sequence flanking an indel, one line per indel.
-# The total number of lines in the output file = number of motifs x number of indels.
-
-use strict;
-use warnings;
-
-#variable to handle the window information
-my $window = "";
-my $windowNumber = 0;
-my $totalWindowsNumber = 0;
-my $upstreamAndDownstreamFlankingSequencesWindows = "";
-
-#variable to handle the motif information
-my $motif = "";
-my $motifName = "";
-my $motifSequence = "";
-my $motifNumber = 0;
-my $totalMotifsNumber = 0;
-my $upstreamMotifFrequencyCounter = 0;
-my $downstreamMotifFrequencyCounter = 0;
-
-#arrays to sotre window and motif data
-my @windowsArray = ();
-my @motifNamesArray = ();
-my @motifSequencesArray = ();
-
-#variable to handle the indel information
-my $indelIndex = 0;
-
-#variable to store line counter value
-my $lineCounter = 0;
-
-# check to make sure having correct files
-my $usage = "usage: compute_motif_frequencies_for_all_motifs.pl [TABULAR.in] [TABULAR.in] [windowSize] [TABULAR.out] \n";
-die $usage unless @ARGV == 4;
-
-#get the input arguments
-my $motifsInputFile = $ARGV[0];
-my $indelFlankingSequencesWindowsInputFile = $ARGV[1];
-my $numberOfConsideredWindows = $ARGV[2];
-my $motifFrequenciesOutputFile = $ARGV[3];
-
-#open the input files
-open (INPUT1, "<", $motifsInputFile) || die("Could not open file $motifsInputFile \n");
-open (INPUT2, "<", $indelFlankingSequencesWindowsInputFile) || die("Could not open file indelFlankingSequencesWindowsInputFile \n");
-open (OUTPUT, ">", $motifFrequenciesOutputFile) || die("Could not open file $motifFrequenciesOutputFile \n");
-
-#store the motifs input file in the array @motifsData
-my @motifsData = ;
-
-#iterated through the motifs (lines) of the motifs input file
-foreach $motif (@motifsData){
- chomp ($motif);
- #print ($motif . "\n");
-
- #split the motif data into its name and its sequence
- my @motifNameAndSequenceArray = split(/\t/, $motif);
-
- #store the name of the motif into the array @motifNamesArray
- push @motifNamesArray, $motifNameAndSequenceArray[0];
-
- #store the sequence of the motif into the array @motifSequencesArray
- push @motifSequencesArray, $motifNameAndSequenceArray[1];
-}
-
-#compute the size of the motif names array
-$totalMotifsNumber = @motifNamesArray;
-
-
-#store the first output file containing the windows of both upstream and downstream flanking sequences in the array @windowsData
-my @windowsData = ;
-
-#check if the number of considered window entered by the user is 0 or negative, if so make it equal to 1
-if ($numberOfConsideredWindows <= 0){
- $numberOfConsideredWindows = 1;
-}
-
-#iterated through the motif sequences to check their occurrences in the considered windows
-#and store the count of their occurrences in the corresponding ouput file
-for ($motifNumber = 0; $motifNumber < $totalMotifsNumber; $motifNumber++){
-
- #get the motif name
- $motifName = $motifNamesArray[$motifNumber];
-
- #get the motif sequence
- $motifSequence = $motifSequencesArray[$motifNumber];
-
- #iterated through the lines of the second input file. Each line represents
- #the windows of the upstream and downstream flanking sequences of an indel
- foreach $upstreamAndDownstreamFlankingSequencesWindows (@windowsData){
-
- chomp ($upstreamAndDownstreamFlankingSequencesWindows);
- $lineCounter++;
-
- #split both upstream and downstream flanking sequences into their windows
- my @windowsArray = split(/\t/, $upstreamAndDownstreamFlankingSequencesWindows);
-
- if ($lineCounter == 1){
- $totalWindowsNumber = @windowsArray;
- $indelIndex = ($totalWindowsNumber - 1)/2;
- }
-
- #reset the motif frequency counters
- $upstreamMotifFrequencyCounter = 0;
- $downstreamMotifFrequencyCounter = 0;
-
- #iterate through the considered windows of the upstream flanking sequence and increment the motif frequency counter
- for ($windowNumber = $indelIndex - 1; $windowNumber > $indelIndex - $numberOfConsideredWindows - 1; $windowNumber--){
-
- #get the window
- $window = $windowsArray[$windowNumber];
-
- #if the motif is found in the window, then increment its corresponding counter
- if ($window =~ m/$motifSequence/i){
- $upstreamMotifFrequencyCounter++;
- }
- }
-
- #iterate through the considered windows of the upstream flanking sequence and increment the motif frequency counter
- for ($windowNumber = $indelIndex + 1; $windowNumber < $indelIndex + $numberOfConsideredWindows + 1; $windowNumber++){
-
- #get the window
- $window = $windowsArray[$windowNumber];
-
- #if the motif is found in the window, then increment its corresponding counter
- if ($window =~ m/$motifSequence/i){
- $downstreamMotifFrequencyCounter++;
- }
- }
-
- #store the result into the output file of the motif
- print OUTPUT $motifName . "\t" . $upstreamMotifFrequencyCounter . "\t" . $downstreamMotifFrequencyCounter . "\n";
- }
-}
-
-#close the input and output files
-close(OUTPUT);
-close(INPUT2);
-close(INPUT1);
\ No newline at end of file
diff --git a/tools/regVariation/compute_motif_frequencies_for_all_motifs.xml b/tools/regVariation/compute_motif_frequencies_for_all_motifs.xml
deleted file mode 100644
index 7156c3f2955..00000000000
--- a/tools/regVariation/compute_motif_frequencies_for_all_motifs.xml
+++ /dev/null
@@ -1,72 +0,0 @@
-
- motif by motif
-
-
- compute_motif_frequencies_for_all_motifs.pl $inputFile1 $inputFile2 $inputWindowSize3 $outputFile1
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This program computes the frequencies of each motif at a window size, determined by the user, in both upstream and downstream sequences flanking indels in all chromosomes.
-
-- The first input is a TABULAR format file containing the motif names and sequences, one line per motif, such that the file consists of two columns:
-
- - The left column represents the motif names
- - The right column represents the motif sequence, as follows::
-
- dnaPolPauseFrameshift1 GAG
- dnaPolPauseFrameshift2 ACG
- xSites1 CCG
-
-- The second input is a TABULAR format file representing the windows of both upstream and downstream flanking sequences. It consists of multiple left columns representing the windows of the upstream flanking sequences, followed by one column representing the indels, then followed by multiple right columns representing the windows of the downstream flanking sequences, as follows::
-
- cgaggtcagg agatcgagac catcctggct aacatggtga aatcccgtct ctactaaaaa indel aaatttatat ttataaacaa ttttaataca cctatgttta ttatacattt
- GCCAGTTTAT GGTCTAACAA GGAGAGAAAC AGGGGGCTGA AGGGGTTTCT TAACCTCCAG indel TTCCGGGCTC TGTCCCTAAC CCCCAGCTAG GTAAGTGGCA AAGCACTTCT
- CAGTGGGACC AAGCACTGAA CCACTTTGGG GAGAATCTCA CACTGGGGCC CTCTGACACC indel tatatatttt tttttttttt tttttttttt tttttttttg agatggtgtc
- AGAGCAGCAG CACCCACTTT TGCAGTGTGT GACGTTGGTG GAGCCATCGA AGTCTGTGCT indel GAGCCCTCCC CAGTGCTCCG AGGAGCTGCT GTTCCCCCTG GAGCTCAGAA
-
-- The third input is an integer number representing the number of windows to be considered starting from the indel and leftward for the upstream flanking sequence and, starting from the indel and rightward for the downstream flanking sequence.
-
-- The output is a TABULAR format file consisting of three columns:
-
- - The left column represents the motif name
- - The middle column represents the motif frequency in the specified windows of the upstream sequence flanking an indel
- - The right column represents the motif frequency in the specified windows of the downstream sequence flanking an indel
-
- There is line per indel in the output file, such that the total number of lines in the output file = number of motifs x number of indels.
-
-Note: The number of windows entered by the user must be a positive integer >= 1. if negative integer or 0 is entered by the user, the program will consider it as 1.
-
-
-
-
diff --git a/tools/regVariation/compute_motifs_frequency.pl b/tools/regVariation/compute_motifs_frequency.pl
deleted file mode 100755
index 4c74384a4d8..00000000000
--- a/tools/regVariation/compute_motifs_frequency.pl
+++ /dev/null
@@ -1,252 +0,0 @@
-#!/usr/bin/perl -w
-
-# a program to compute the frequency of each motif at each window in both upstream and downstream sequences flanking indels
-# in a chromosome/genome.
-# the first input is a TABULAR format file containing the motif names and sequences, such that the file consists of two
-# columns: the left column represents the motif names and the right column represents the motif sequence, one line per motif.
-# the second input is a TABULAR format file containing the upstream and downstream sequences flanking indels, one line per indel.
-# the fourth input is an integer number representing the window size according to which the upstream and downstream sequences
-# flanking each indel will be divided.
-# the first output is a TABULAR format file containing the windows into which both upstream and downstream sequences flanking
-# indels are divided.
-# the second output is a TABULAR format file containing the motifs and their corresponding frequencies at each window in both
-# upstream and downstream sequences flanking indels, one line per motif.
-
-use strict;
-use warnings;
-
-#variable to handle the falnking sequences information
-my $sequence = "";
-my $upstreamFlankingSequence = "";
-my $downstreamFlankingSequence = "";
-my $discardedSequenceLength = 0;
-my $lengthOfDownstreamFlankingSequenceAfterTrimming = 0;
-
-#variable to handle the window information
-my $window = "";
-my $windowStartIndex = 0;
-my $windowNumber = 0;
-my $totalWindowsNumber = 0;
-my $totalNumberOfWindowsInUpstreamSequence = 0;
-my $totalNumberOfWindowsInDownstreamSequence = 0;
-my $totalWindowsNumberInBothFlankingSequences = 0;
-my $totalWindowsNumberInMotifCountersTwoDimArray = 0;
-my $upstreamAndDownstreamFlankingSequencesWindows = "";
-
-#variable to handle the motif information
-my $motif = "";
-my $motifSequence = "";
-my $motifNumber = 0;
-my $totalMotifsNumber = 0;
-
-#arrays to sotre window and motif data
-my @windowsArray = ();
-my @motifNamesArray = ();
-my @motifSequencesArray = ();
-my @motifCountersTwoDimArray = ();
-
-#variables to store line counter values
-my $lineCounter1 = 0;
-my $lineCounter2 = 0;
-
-# check to make sure having correct files
-my $usage = "usage: compute_motifs_frequency.pl [TABULAR.in] [TABULAR.in] [windowSize] [TABULAR.out] [TABULAR.out]\n";
-die $usage unless @ARGV == 5;
-
-#get the input and output arguments
-my $motifsInputFile = $ARGV[0];
-my $indelFlankingSequencesInputFile = $ARGV[1];
-my $windowSize = $ARGV[2];
-my $indelFlankingSequencesWindowsOutputFile = $ARGV[3];
-my $motifFrequenciesOutputFile = $ARGV[4];
-
-#open the input and output files
-open (INPUT1, "<", $motifsInputFile) || die("Could not open file $motifsInputFile \n");
-open (INPUT2, "<", $indelFlankingSequencesInputFile) || die("Could not open file $indelFlankingSequencesInputFile \n");
-open (OUTPUT1, ">", $indelFlankingSequencesWindowsOutputFile) || die("Could not open file $indelFlankingSequencesWindowsOutputFile \n");
-open (OUTPUT2, ">", $motifFrequenciesOutputFile) || die("Could not open file $motifFrequenciesOutputFile \n");
-
-#store the motifs input file in the array @motifsData
-my @motifsData = ;
-
-#iterated through the motifs (lines) of the motifs input file
-foreach $motif (@motifsData){
- chomp ($motif);
- #print ($motif . "\n");
-
- #split the motif data into its name and its sequence
- my @motifNameAndSequenceArray = split(/\t/, $motif);
-
- #store the name of the motif into the array @motifNamesArray
- push @motifNamesArray, $motifNameAndSequenceArray[0];
-
- #store the sequence of the motif into the array @motifSequencesArray
- push @motifSequencesArray, $motifNameAndSequenceArray[1];
-}
-
-#compute the size of the motif names array
-$totalMotifsNumber = @motifNamesArray;
-
-#store the input file in the array @sequencesData
-my @sequencesData = ;
-
-#iterated through the sequences of the second input file in order to create windwos file
-foreach $sequence (@sequencesData){
- chomp ($sequence);
- $lineCounter1++;
-
- my @indelAndSequenceArray = split(/\t/, $sequence);
-
- #get the upstream falnking sequence
- $upstreamFlankingSequence = $indelAndSequenceArray[3];
-
- #if the window size is 0, then the whole upstream will be one window only
- if ($windowSize == 0){
- $totalNumberOfWindowsInUpstreamSequence = 1;
- $windowSize = length ($upstreamFlankingSequence);
- }
- else{
- #compute the total number of windows into which the upstream flanking sequence will be divided
- $totalNumberOfWindowsInUpstreamSequence = length ($upstreamFlankingSequence) / $windowSize;
-
- #compute the length of the subsequence to be discared from the upstream flanking sequence if any
- $discardedSequenceLength = length ($upstreamFlankingSequence) % $windowSize;
-
- #check if the sequence could be split into windows of equal sizes
- if ($discardedSequenceLength != 0) {
- #trim the upstream flanking sequence
- $upstreamFlankingSequence = substr($upstreamFlankingSequence, $discardedSequenceLength);
- }
- }
-
- #split the upstream flanking sequence into windows
- for ($windowNumber = 0; $windowNumber < $totalNumberOfWindowsInUpstreamSequence; $windowNumber++){
- $windowStartIndex = $windowNumber * $windowSize;
- print OUTPUT1 (substr($upstreamFlankingSequence, $windowStartIndex, $windowSize) . "\t");
- }
-
- #add a column representing the indel
- print OUTPUT1 ("indel" . "\t");
-
- #get the downstream falnking sequence
- $downstreamFlankingSequence = $indelAndSequenceArray[4];
-
- #if the window size is 0, then the whole upstream will be one window only
- if ($windowSize == 0){
- $totalNumberOfWindowsInDownstreamSequence = 1;
- $windowSize = length ($downstreamFlankingSequence);
- }
- else{
- #compute the total number of windows into which the downstream flanking sequence will be divided
- $totalNumberOfWindowsInDownstreamSequence = length ($downstreamFlankingSequence) / $windowSize;
-
- #compute the length of the subsequence to be discared from the upstream flanking sequence if any
- $discardedSequenceLength = length ($downstreamFlankingSequence) % $windowSize;
-
- #check if the sequence could be split into windows of equal sizes
- if ($discardedSequenceLength != 0) {
- #compute the length of the sequence to be discarded
- $lengthOfDownstreamFlankingSequenceAfterTrimming = length ($downstreamFlankingSequence) - $discardedSequenceLength;
-
- #trim the downstream flanking sequence
- $downstreamFlankingSequence = substr($downstreamFlankingSequence, 0, $lengthOfDownstreamFlankingSequenceAfterTrimming);
- }
- }
-
- #split the downstream flanking sequence into windows
- for ($windowNumber = 0; $windowNumber < $totalNumberOfWindowsInDownstreamSequence; $windowNumber++){
- $windowStartIndex = $windowNumber * $windowSize;
- print OUTPUT1 (substr($downstreamFlankingSequence, $windowStartIndex, $windowSize) . "\t");
- }
-
- print OUTPUT1 ("\n");
-}
-
-#compute the total number of windows on both upstream and downstream sequences flanking the indel
-$totalWindowsNumberInBothFlankingSequences = $totalNumberOfWindowsInUpstreamSequence + $totalNumberOfWindowsInDownstreamSequence;
-
-#add an additional cell to store the name of the motif and another one for the indel itself
-$totalWindowsNumberInMotifCountersTwoDimArray = $totalWindowsNumberInBothFlankingSequences + 1 + 1;
-
-#initialize the two dimensional array $motifCountersTwoDimArray. the first column will be initialized with motif names
-for ($motifNumber = 0; $motifNumber < $totalMotifsNumber; $motifNumber++){
-
- for ($windowNumber = 0; $windowNumber < $totalWindowsNumberInMotifCountersTwoDimArray; $windowNumber++){
-
- if ($windowNumber == 0){
- $motifCountersTwoDimArray [$motifNumber] [0] = $motifNamesArray[$motifNumber];
- }
- elsif ($windowNumber == $totalNumberOfWindowsInUpstreamSequence + 1){
- $motifCountersTwoDimArray [$motifNumber] [$windowNumber] = "indel";
- }
- else{
- $motifCountersTwoDimArray [$motifNumber] [$windowNumber] = 0;
- }
- }
-}
-
-close(OUTPUT1);
-
-#open the file the contains the windows of the upstream and downstream flanking sequences, which is actually the first output file
-open (INPUT3, "<", $indelFlankingSequencesWindowsOutputFile) || die("Could not open file $indelFlankingSequencesWindowsOutputFile \n");
-
-#store the first output file containing the windows of both upstream and downstream flanking sequences in the array @windowsData
-my @windowsData = ;
-
-#iterated through the lines of the first output file. Each line represents
-#the windows of the upstream and downstream flanking sequences of an indel
-foreach $upstreamAndDownstreamFlankingSequencesWindows (@windowsData){
-
- chomp ($upstreamAndDownstreamFlankingSequencesWindows);
- $lineCounter2++;
-
- #split both upstream and downstream flanking sequences into their windows
- my @windowsArray = split(/\t/, $upstreamAndDownstreamFlankingSequencesWindows);
-
- $totalWindowsNumber = @windowsArray;
-
- #iterate through the windows to search for matched motifs and increment their corresponding counters accordingly
- WINDOWS:
- for ($windowNumber = 0; $windowNumber < $totalWindowsNumber; $windowNumber++){
-
- #get the window
- $window = $windowsArray[$windowNumber];
-
- #if the window is the one that contains the indel, then skip the indel window
- if ($window eq "indel") {
- next WINDOWS;
- }
- else{ #iterated through the motif sequences to check their occurrences in the winodw
- #and increment their corresponding counters accordingly
-
- for ($motifNumber = 0; $motifNumber < $totalMotifsNumber; $motifNumber++){
- #get the motif sequence
- $motifSequence = $motifSequencesArray[$motifNumber];
-
- #if the motif is found in the window, then increment its corresponding counter
- if ($window =~ m/$motifSequence/i){
- $motifCountersTwoDimArray [$motifNumber] [$windowNumber + 1]++;
- }
- }
- }
- }
-}
-
-#store the motif counters values in the second output file
-for ($motifNumber = 0; $motifNumber < $totalMotifsNumber; $motifNumber++){
-
- for ($windowNumber = 0; $windowNumber <= $totalWindowsNumber; $windowNumber++){
-
- print OUTPUT2 $motifCountersTwoDimArray [$motifNumber] [$windowNumber] . "\t";
- #print ($motifCountersTwoDimArray [$motifNumber] [$windowNumber] . " ");
- }
- print OUTPUT2 "\n";
- #print ("\n");
-}
-
-#close the input and output files
-close(OUTPUT2);
-close(OUTPUT1);
-close(INPUT3);
-close(INPUT2);
-close(INPUT1);
\ No newline at end of file
diff --git a/tools/regVariation/compute_motifs_frequency.xml b/tools/regVariation/compute_motifs_frequency.xml
deleted file mode 100755
index e488ab2536e..00000000000
--- a/tools/regVariation/compute_motifs_frequency.xml
+++ /dev/null
@@ -1,109 +0,0 @@
-
- in indel flanking regions
-
-
-
- compute_motifs_frequency.pl $inputFile1 $inputFile2 $inputNumber3 $outputFile1 $outputFile2
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This program computes the frequency of motifs in the flanking regions of indels found in a chromosome or a genome.
-Each indel has an upstream flanking sequence and a downstream flanking one. Each of the upstream and downstream flanking
-sequences will be divided into a certain number of windows according to the window size input by the user.
-The frequency of a motif in a certain window in one of the two flanking sequences is the total sum of occurrences of
-that motif in that window of that flanking sequence over all indels. The indel flanking regions file will be taken
-from your history or it will be uploaded, whereas the motifs file should be uploaded.
-
-- The first input file is the motifs file and it is a tabular file consisting of two columns:
-
- - the first column represents the motif name
- - the second column represents the motif sequence, as follows::
-
- dnaPolPauseFrameshift1 GAG
- dnaPolPauseFrameshift2 ACG
- xSites1 CCG
-
-- The second input file is the indels flanking regions file and it is a tabular file consisting of five columns:
-
- - the first column represents the indel start coordinate
- - the second column represents the indel end coordinate
- - the third column represents the indel length
- - the fourth column represents the upstream flanking sequence
- - the fifth column represents the upstream flanking sequence, as follows::
-
- 16694766 16694768 3 GTGGGTCCTGCCCAGCCTCTGCCTCAGAGGGAAGAGTAGAGAACTGGG AGAGCAGGTCCTTAGGGAGCCCGAGGAAGTCCCTGACGCCAGCTGTTCTCGCGGACGAA
- 25169542 25169545 4 caagcccacaagccttcagaccatagcaCGGGCTCCAGAGGTGTGAGG CAGGTCAGGTGCTTTAGAAGTCAAAAACTCTCAGTAAGGCAAATCACCCCCTATCTCCT
- 41929580 41929585 6 ggctgtcgtatggaatctggggctcaggactctgtcccatttctctaa accattctgcTTCAACCCAGACACTGACTGTTTTCCAAATTTACTTGTTTGTTTGTTTT
-
-
------
-
-.. class:: warningmark
-
-**Notes**
-
-- The lengths of the upstream flanking sequences must be equal for all indels.
-- The lengths of the downstream flanking sequences must be equal for all indels.
-- If the length of the upstream flanking sequence L is not an integer multiple of the window size S, in other words if L/S = m + r where m is the result of division and r is the remainder, then the upstream flanking sequence will be divided into m windows only starting from the indel, and the rest of the sequence will not be considered. The same rule applies to the downstream flanking sequence.
-
------
-
-The **output** of this program is two files:
-
-- The first output file is a tabular file and represents the windows of both upstream and downstream flanking sequences. It consists of multiple left columns representing the windows of the upstream flanking sequence, followed by one column representing the indels, then followed by multiple right columns representing the windows of the downstream flanking sequence, as follows::
-
- cgaggtcagg agatcgagac catcctggct aacatggtga aatcccgtct ctactaaaaa indel aaatttatat ttataaacaa ttttaataca cctatgttta ttatacattt
- GCCAGTTTAT GGTCTAACAA GGAGAGAAAC AGGGGGCTGA AGGGGTTTCT TAACCTCCAG indel TTCCGGGCTC TGTCCCTAAC CCCCAGCTAG GTAAGTGGCA AAGCACTTCT
- CAGTGGGACC AAGCACTGAA CCACTTTGGG GAGAATCTCA CACTGGGGCC CTCTGACACC indel tatatatttt tttttttttt tttttttttt tttttttttg agatggtgtc
- AGAGCAGCAG CACCCACTTT TGCAGTGTGT GACGTTGGTG GAGCCATCGA AGTCTGTGCT indel GAGCCCTCCC CAGTGCTCCG AGGAGCTGCT GTTCCCCCTG GAGCTCAGAA
-
-- The second output file is a tabular file and represents the motif frequencies in every window of every flanking sequence. The first column on the left represents the names of motifs. The other columns represent the frequencies of motifs in the windows that correspond to the ones in the first output file, as follows::
-
- dnaPolPauseFrameshift1 2 3 1 0 1 2 indel 0 2 2 1 3
- dnaPolPauseFrameshift2 2 3 1 0 1 2 indel 0 2 2 1 3
- xSites1 3 2 0 1 1 2 indel 1 1 3 2 3
-
-
-
-
diff --git a/tools/regVariation/delete_overlapping_indels.pl b/tools/regVariation/delete_overlapping_indels.pl
deleted file mode 100644
index 7550b592206..00000000000
--- a/tools/regVariation/delete_overlapping_indels.pl
+++ /dev/null
@@ -1,94 +0,0 @@
-#!/usr/bin/perl -w
-
-# This program detects overlapping indels in a chromosome and keeps all non-overlapping indels. As for overlapping indels,
-# the first encountered one is kept and all others are removed. It requires three inputs:
-# The first input is a TABULAR format file containing coordinates of indels in blocks extracted from multi-alignment.
-# The second input is an integer number representing the number of the column where indel start coordinates are stored in the input file.
-# The third input is an integer number representing the number of the column where indel end coordinates are stored in the input file.
-# The output is a TABULAR format file containing all non-overlapping indels in the input file, and the first encountered indel of overlapping ones.
-# Note: The number of the first column is 1.
-
-use strict;
-use warnings;
-
-#varaibles to handle information related to indels
-my $indel1 = "";
-my $indel2 = "";
-my @indelArray1 = ();
-my @indelArray2 = ();
-my $lineCounter1 = 0;
-my $lineCounter2 = 0;
-my $totalNumberofNonOverlappingIndels = 0;
-
-# check to make sure having correct files
-my $usage = "usage: delete_overlapping_indels.pl [TABULAR.in] [indelStartColumn] [indelEndColumn] [TABULAR.out]\n";
-die $usage unless @ARGV == 4;
-
-my $inputFile = $ARGV[0];
-my $indelStartColumn = $ARGV[1] - 1;
-my $indelEndColumn = $ARGV[2] - 1;
-my $outputFile = $ARGV[3];
-
-#verifie column numbers
-if ($indelStartColumn < 0 ){
- die ("The indel start column number is invalid \n");
-}
-if ($indelEndColumn < 0 ){
- die ("The indel end column number is invalid \n");
-}
-
-#open the input and output files
-open (INPUT, "<", $inputFile) || die ("Could not open file $inputFile \n");
-open (OUTPUT, ">", $outputFile) || die ("Could not open file $outputFile \n");
-
-#store the input file in the array @rawData
-my @indelsRawData = ;
-
-#iterated through the indels of the input file
-INDEL1:
-foreach $indel1 (@indelsRawData){
- chomp ($indel1);
- $lineCounter1++;
-
- #get the first indel
- @indelArray1 = split(/\t/, $indel1);
-
- #our purpose is to detect overlapping indels and to store one copy of them only in the output file
- #all other non-overlapping indels will stored in the output file also
-
- $lineCounter2 = 0;
-
- #iterated through the indels of the input file
- INDEL2:
- foreach $indel2 (@indelsRawData){
- chomp ($indel2);
- $lineCounter2++;
-
- if ($lineCounter2 > $lineCounter1){
- #get the second indel
- @indelArray2 = split(/\t/, $indel2);
-
- #check if the two indels are overlapping
- if (($indelArray2[$indelEndColumn] >= $indelArray1[$indelStartColumn] && $indelArray2[$indelEndColumn] <= $indelArray1[$indelEndColumn]) || ($indelArray2[$indelStartColumn] >= $indelArray1[$indelStartColumn] && $indelArray2[$indelStartColumn] <= $indelArray1[$indelEndColumn])){
- #print ("There is an overlap between" . "\n" . $indel1 . "\n" . $indel2 . "\n");
- #print("The two overlapping indels are located at the lines: " . $lineCounter1 . " " . $lineCounter2 . "\n\n");
-
- #break out of the loop and go back to the outerloop
- next INDEL1;
- }
- else{
- #print("The two non-overlaapping indels are located at the lines: " . $lineCounter1 . " " . $lineCounter2 . "\n");
- }
- }
- }
-
- print OUTPUT $indel1 . "\n";
- $totalNumberofNonOverlappingIndels++;
-}
-
-#print("The total number of indels is: " . $lineCounter1 . "\n");
-#print("The total number of non-overlapping indels is: " . $totalNumberofNonOverlappingIndels . "\n");
-
-#close the input and output files
-close(OUTPUT);
-close(INPUT);
\ No newline at end of file
diff --git a/tools/regVariation/delete_overlapping_indels.xml b/tools/regVariation/delete_overlapping_indels.xml
deleted file mode 100644
index 15ec2ecb6e5..00000000000
--- a/tools/regVariation/delete_overlapping_indels.xml
+++ /dev/null
@@ -1,66 +0,0 @@
-
- from a chromosome indels file
-
-
- delete_overlapping_indels.pl $inputFile1 $inputIndelStartColumnNumber2 $inputIndelEndColumnNumber3 $outputFile1
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This program detects overlapping indels in a chromosome and keeps all non-overlapping indels. As for overlapping indels, the first encountered one is kept and all others are removed.
-It requires three inputs:
-
-- The first input is a TABULAR format file containing coordinates of indels in blocks extracted from multi-alignment.
-- The second input is an integer number representing the number of the column where indel start coordinates are stored in the input file.
-- The third input is an integer number representing the number of the column where indel end coordinates are stored in the input file.
-- The output is a TABULAR format file containing all non-overlapping indels in the input file, and the first encountered indel of overlapping ones.
-
-Note: The number of the first column is 1.
-
-
-**Example**
-
-Let us have the following insertions in the human genome. The start and end coordinates of insertions are on columns 5 and 6 respectively::
-
- 3 hg18.chr22_insert 3 hg18.chr22 14508610 14508612 3924 - panTro2.chr2b 132518950 132518951 3910 + rheMac2.chr17 14311798 14311799 3896 +
- 7 hg18.chr22_insert 13 hg18.chr22 14513678 14513690 348 - panTro2.chr2b 132517876 132517877 321 + rheMac2.chr17 14274462 14274463 337 +
- 7 hg18.chr22_insert 6 hg18.chr22 14513688 14513699 348 - panTro2.chr2b 132517879 132517880 321 + rheMac2.chr17 14274465 14274466 337 +
- 25 hg18.chr22_insert 9 hg18.chr22 14529501 14529509 385 - panTro2.chr22 14528775 14528776 376 - rheMac2.chr9 42869449 42869450 375 -
- 36 hg18.chr22_insert 4 hg18.chr22 14566316 14566319 540 - panTro2.chr2b 132492077 132492078 533 + rheMac2.chr10 59230438 59230439 533 -
- 40 hg18.chr22_insert 7 hg18.chr22 14508610 14508616 2337 - panTro2.chr2b 132487750 132487751 2313 + rheMac2.chr10 59128305 59128306 2332 +
- 41 hg18.chr22_insert 4 hg18.chr22 14571556 14571559 2483 - panTro2.chr2b 132485878 132485879 2481 + rheMac2.chr10 59126094 59126095 2508 +
-
-By removing the overlapping indels which, we get::
-
- 3 hg18.chr22_insert 3 hg18.chr22 14508610 14508612 3924 - panTro2.chr2b 132518950 132518951 3910 + rheMac2.chr17 14311798 14311799 3896 +
- 7 hg18.chr22_insert 13 hg18.chr22 14513678 14513690 348 - panTro2.chr2b 132517876 132517877 321 + rheMac2.chr17 14274462 14274463 337 +
- 25 hg18.chr22_insert 9 hg18.chr22 14529501 14529509 385 - panTro2.chr22 14528775 14528776 376 - rheMac2.chr9 42869449 42869450 375 -
- 36 hg18.chr22_insert 4 hg18.chr22 14566316 14566319 540 - panTro2.chr2b 132492077 132492078 533 + rheMac2.chr10 59230438 59230439 533 -
- 41 hg18.chr22_insert 4 hg18.chr22 14571556 14571559 2483 - panTro2.chr2b 132485878 132485879 2481 + rheMac2.chr10 59126094 59126095 2508 +
-
-
-
-
\ No newline at end of file
diff --git a/tools/regVariation/draw_stacked_barplots.pl b/tools/regVariation/draw_stacked_barplots.pl
deleted file mode 100644
index 9acd06d2e3b..00000000000
--- a/tools/regVariation/draw_stacked_barplots.pl
+++ /dev/null
@@ -1,78 +0,0 @@
-#!/usr/bin/perl -w
-
-# This program draws, in a pdf file, a stacked bars plot for different categories of data and for
-# different criteria. For each criterion a stacked bar is drawn, such that the height of each stacked
-# sub-bar represents the number of elements in each category satisfying that criterion.
-# The input consists of a TABULAR format file, where the left column represents the names of categories
-# and the other columns are headed by the names of criteria, such that each data value in the file
-# represents the number of elements in a certain category satisfying a certain criterion.
-# The output is a PDF file containing a stacked bars plot representing the number of elements in each
-# category satisfying each criterion. The drawing is done using R code.
-
-
-use strict;
-use warnings;
-
-my $criterion;
-my @criteriaArray = ();
-my $criteriaNumber = 0;
-my $lineCounter = 0;
-
-#variable to store the names of R script file
-my $r_script;
-
-# check to make sure having correct files
-my $usage = "usage: draw_stacked_bar_plot.pl [TABULAR.in] [PDF.out] \n";
-die $usage unless @ARGV == 2;
-
-my $categoriesInputFile = $ARGV[0];
-
-my $categories_criteria_bars_plot_outputFile = $ARGV[1];
-
-#open the input file
-open (INPUT, "<", $categoriesInputFile) || die("Could not open file $categoriesInputFile \n");
-open (OUTPUT, ">", $categories_criteria_bars_plot_outputFile) || die("Could not open file $categories_criteria_bars_plot_outputFile \n");
-
-# R script to implement the drawing of a stacked bar plot representing thes significant motifs in each category of motifs
-#construct an R script file
-$r_script = "motif_significance_bar_plot.r";
-open(Rcmd,">", $r_script) or die "Cannot open $r_script \n\n";
-print Rcmd "
- #store the table content of the first file into a matrix
- categoriesTable <- read.table(\"$categoriesInputFile\", header = TRUE);
- categoriesMatrix <- as.matrix(categoriesTable);
-
-
- #compute the sum of elements in the column with the maximum sum in each matrix
- columnSumsVector <- colSums(categoriesMatrix);
- maxColumn <- max (columnSumsVector);
-
- if (maxColumn %% 10 != 0){
- maxColumn <- maxColumn + 10;
- }
-
- plotHeight = maxColumn/8;
- criteriaVector <- names(categoriesTable);
-
- pdf(file = \"$categories_criteria_bars_plot_outputFile\", width = length(criteriaVector), height = plotHeight, family = \"Times\", pointsize = 12, onefile = TRUE);
-
-
-
- #draw the first barplot
- barplot(categoriesMatrix, ylab = \"No. of elements in each category\", xlab = \"Criteria\", ylim = range(0, maxColumn), col = \"black\", density = c(10, 20, 30, 40, 50, 60, 70, 80), angle = c(45, 90, 135), names.arg = criteriaVector);
-
- #draw the legend
- legendX = 0.2;
- legendY = maxColumn;
-
- legend (legendX, legendY, legend = rownames(categoriesMatrix), density = c(10, 20, 30, 40, 50, 60, 70, 80), angle = c(45, 90, 135));
-
- dev.off();
-
- #eof\n";
-close Rcmd;
-system("R --no-restore --no-save --no-readline < $r_script > $r_script.out");
-
-#close the input files
-close(OUTPUT);
-close(INPUT);
diff --git a/tools/regVariation/draw_stacked_barplots.xml b/tools/regVariation/draw_stacked_barplots.xml
deleted file mode 100644
index c995c734ae4..00000000000
--- a/tools/regVariation/draw_stacked_barplots.xml
+++ /dev/null
@@ -1,59 +0,0 @@
-
- for different categories and different criteria
-
-
- draw_stacked_barplots.pl $inputFile1 $outputFile1
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This program draws, in a pdf file, a stacked bars plot for different categories of data and for different criteria. For each criterion a stacked bar is
-drawn, such that the height of each stacked sub-bar represents the number of elements in each category satisfying that criterion.
-
-- The input consists of a TABULAR format file, where the left column represents the names of categories and the other columns are headed by the names of criteria, such that each data value in the file represents the number of elements in a certain category satisfying a certain criterion:
-
-- The output is a PDF file containing a stacked bars plot representing the number of elements in each category satisfying each criterion. The drawing is done using R code.
-
-**Example**
-
-Let us suppose that the input file represent the number of significant motifs in each motif category for each window size::
-
- 10bp 20bp 40bp 80bp 160bp 320bp 640bp 1280bp
- Deletion_Hotspots 2 3 4 4 5 6 7 7
- Dna_Pol_Pause/Frameshift_Hotspots 8 10 14 17 18 15 19 20
- Indel_Hotspots 1 1 1 2 1 0 0 0
- Insertion_Hotspots 0 0 1 2 2 2 2 5
- Topoisomerase_Cleavage_Sites 2 3 5 4 3 3 4 4
- Translin_Targets 0 0 2 2 3 3 3 2
- VDJ_Recombination_Signals 0 0 1 1 1 2 2 2
- X-like_Sites 4 4 4 5 6 7 7 10
-
-
-Runnig the program will give the following output::
-
- The stacked bars plot representing the data in the input file.
-
-.. image:: ${static_path}/operation_icons/stacked_bars_plot.png
-
-
-
-
diff --git a/tools/regVariation/getIndels_3way.xml b/tools/regVariation/getIndels_3way.xml
deleted file mode 100644
index 415afe024be..00000000000
--- a/tools/regVariation/getIndels_3way.xml
+++ /dev/null
@@ -1,53 +0,0 @@
-
- from 3-way alignments
-
- parseMAF_smallIndels.pl $input1 $out_file1 $outgroup
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This tool consists of the first module from the computational pipeline to identify indels as described in Kvikstad et al., 2007. Note that the generated output does not include subsequent filtering steps.
-
-Deletions in a particular species are identified as one or more consecutive gap columns within an alignment block, given that the orthologous positions in the other two species contain nucleotides of
-equal length.
-Similarly, insertions in a particular species are identified as one or more consecutive nucleotide columns within an alignment block, given that the orthologous positions in the other two
-species contain gaps.
-
-*Kvikstad E. M. et al. (2007). A Macaques-Eye View of Human Insertions and Deletions: Differences in Mechanisms. PLoS Computational Biology 3(9):e176*
-
------
-
-.. class:: warningmark
-
-**Note**
-
-Any block/s not containing exactly 3 sequences will be omitted.
-
-
-
-
-
\ No newline at end of file
diff --git a/tools/regVariation/microsatellite_birthdeath.pl b/tools/regVariation/microsatellite_birthdeath.pl
deleted file mode 100755
index 2954016b539..00000000000
--- a/tools/regVariation/microsatellite_birthdeath.pl
+++ /dev/null
@@ -1,4333 +0,0 @@
-#!/usr/bin/perl -w
-use strict;
-use warnings;
-use Term::ANSIColor;
-use Pod::Checker;
-use File::Basename;
-use IO::Handle;
-use Cwd;
-use File::Path qw(make_path remove_tree);
-use File::Temp qw/ tempfile tempdir /;
-my $tdir = tempdir( CLEANUP => 1 );
-chdir $tdir;
-my $dir = getcwd;
-# print "current dit=$dir\n";
-#;
-use vars qw (%treesToReject %template $printer $interr_poscord $interrcord $no_of_interruptionscord $stringfile @tags
-$infocord $typecord $startcord $strandcord $endcord $microsatcord $motifcord $sequencepos $no_of_species
-$gapcord %thresholdhash $tree_decipherer @sp_ident %revHash %sameHash %treesToIgnore %alternate @exactspecies_orig @exactspecies @exacttags
-$mono_flanksimplicityRepno $di_flanksimplicityRepno $prop_of_seq_allowedtoAT $prop_of_seq_allowedtoCG);
-use FileHandle;
-use IO::Handle; # 5.004 or higher
-
-
-
-#my @ar = ("/Users/ydk/work/rhesus_microsat/results/galay/chr22_5sp.maf.txt", "/Users/ydk/work/rhesus_microsat/results/galay/dataset_11.dat",
-#"/Users/ydk/work/rhesus_microsat/results/galay/chr22_5spec.maf.summ","hg18,panTro2,ponAbe2,rheMac2,calJac1","((((hg18, panTro2), ponAbe2), rheMac2), calJac1)","9,10,12,12",
-#"10","0.8");
-my @ar = @ARGV;
-my ($maf, $orth, $summout, $species_set, $tree_definition, $thresholds, $FLANK_SUPPORT, $SIMILARITY_THRESH) = @ar;
-$SIMILARITY_THRESH=$SIMILARITY_THRESH/100;
-#########################
-$SIMILARITY_THRESH = $SIMILARITY_THRESH/100;
-my $EDGE_DISTANCE = 10;
-my $COMPLEXITY_SUPPORT = 20;
-load_thresholds("9_10_12_12");
-my $FLANKINDEL_MAXTHRESH = 0.3;
-
-my $mono_flanksimplicityRepno=6;
-my $di_flanksimplicityRepno=10;
-my $prop_of_seq_allowedtoAT=0.5;
-my $prop_of_seq_allowedtoCG=0.66;
-
-#########################
-my $tspecies_set = $species_set;
-
-my %speciesReplacement = ();
-my %speciesReplacementTag = ();
-my %replacementArr= ();
-my %replacementArrTag= ();
-my %backReplacementArr= ();
-my %backReplacementArrTag= ();
-$tree_definition=~s/\s+//g;
-
-my $tree_definition_split = $tree_definition;
-$tree_definition_split =~ s/[\(\)]//g;
-my @gotSpecies = ($tree_definition_split =~ /(,)/g);
-# print "gotSpecies = @gotSpecies\n";
-
-if (scalar(@gotSpecies)+1 ==5){
-
- $speciesReplacement{1}="calJac1";
- $speciesReplacement{2}="rheMac2";
- $speciesReplacement{3}="ponAbe2";
- $speciesReplacement{4}="panTro2";
- $speciesReplacement{5}="hg18";
-
- $speciesReplacementTag{1}="M";
- $speciesReplacementTag{2}="R";
- $speciesReplacementTag{3}="O";
- $speciesReplacementTag{4}="C";
- $speciesReplacementTag{5}="H";
- $species_set="hg18,panTro2,ponAbe2,rheMac2,calJac1";
-
-}
-if (scalar(@gotSpecies)+1 ==4){
-
- $speciesReplacement{1}="rheMac2";
- $speciesReplacement{2}="ponAbe2";
- $speciesReplacement{3}="panTro2";
- $speciesReplacement{4}="hg18";
-
- $speciesReplacementTag{1}="R";
- $speciesReplacementTag{2}="O";
- $speciesReplacementTag{3}="C";
- $speciesReplacementTag{4}="H";
- $species_set="hg18,panTro2,ponAbe2,rheMac2";
-
-}
-
-# $tree_definition = "((((hg18,panTro2),ponAbe2),rheMac2),calJac1)";
-my $tree_definition_copy = $tree_definition;
-my $tree_definition_orig = $tree_definition;
-my $brackets = 0;
-
-while (1){
- #last if $tree_definition_copy !~ /\(/;
- $brackets++;
-# print "brackets = $brackets\n";
- last if $brackets > 6;
- $tree_definition_copy =~ s/^\(//g;
- $tree_definition_copy =~ s/\)$//g;
-# print "tree_definition_copy = $tree_definition_copy\n";
- my @arr = ();
-
- if ($tree_definition_copy =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)\)$/){
- @arr = $tree_definition_copy =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)$/;
-# print "arr = @arr\n";
- $tree_definition_copy = $2;
- $replacementArr{$1} = $speciesReplacement{$brackets};
- $backReplacementArr{$speciesReplacement{$brackets}}=$1;
-
- $replacementArrTag{$1} = $speciesReplacementTag{$brackets};
- $backReplacementArrTag{$speciesReplacementTag{$brackets}}=$1;
-# print "replacing $1 with $replacementArr{$1}\n";
-
- $sp_ident[$brackets-1] = $1;
-
- }
- elsif ($tree_definition_copy =~ /^\(([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/){
- @arr = $tree_definition_copy =~ /^([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/;
-# print "arr = @arr\n";
- $tree_definition_copy = $1;
- $replacementArr{$2} = $speciesReplacement{$brackets};
- $backReplacementArr{$speciesReplacement{$brackets}}=$2;
-
- $replacementArrTag{$2} = $speciesReplacementTag{$brackets};
- $backReplacementArrTag{$speciesReplacementTag{$brackets}}=$2;
-# print "replacing $2 with $replacementArr{$2}\n";
-
- $sp_ident[$brackets-1] = $2;
- }
- elsif ($tree_definition_copy =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_]+)$/){
- @arr = $tree_definition_copy =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_]+)$/;
-# print "arr = @arr .. TERMINAL\n";
- $tree_definition_copy = $1;
- $replacementArr{$2} = $speciesReplacement{$brackets};
- $replacementArr{$1} = $speciesReplacement{$brackets+1};
- $backReplacementArr{$speciesReplacement{$brackets}}=$2;
- $backReplacementArr{$speciesReplacement{$brackets+1}}=$1;
-
- $replacementArrTag{$1} = $speciesReplacementTag{$brackets+1};
- $backReplacementArrTag{$speciesReplacementTag{$brackets+1}}=$1;
-
- $replacementArrTag{$2} = $speciesReplacementTag{$brackets};
- $backReplacementArrTag{$speciesReplacementTag{$brackets}}=$2;
-# print "replacing $1 with $replacementArr{$1}\n";
-# print "replacing $2 with $replacementArr{$2}\n";
-# print "replacing $1 with $replacementArrTag{$1}\n";
-# print "replacing $2 with $replacementArrTag{$2}\n";
-
- $sp_ident[$brackets-1] = $2;
- $sp_ident[$brackets] = $1;
-
-
- last;
-
- }
- elsif ($tree_definition_copy =~ /^\(([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_\(\),]+)\)$/){
- $tree_definition_copy =~ s/^\(//g;
- $tree_definition_copy =~ s/\)$//g;
- $brackets--;
- }
-}
-
-foreach my $key (keys %replacementArr){
- my $replacement = $replacementArr{$key};
- $tree_definition =~ s/$key/$replacement/g;
-}
-@sp_ident = reverse(@sp_ident);
-# print "modified tree_definition = $tree_definition\n";
-# print "done .. tree_definition = $tree_definition\n";
-# print "sp_ident = @sp_ident\n";
-#;
-
-
-my $complexity=int($COMPLEXITY_SUPPORT * (1/40));
-
-#print "complexity=$complexity\n";
-#;
-
-$printer = 1;
-
-my $rando = int(rand(1000));
-my $localdate = `date`;
-$localdate =~ /([0-9]+):([0-9]+):([0-9]+)/;
-my $info = $rando.$1.$2.$3;
-
-#---------------------------------------------------------------------------
-# GETTING INPUT INFORMATION AND OPENING INPUT AND OUTPUT FILES
-
-
-my @thresharr = (0, split(/,/,$thresholds));
-my $randno=int(rand(100000));
-my $megamatch = $randno.".megamatch.net.axt"; #"/gpfs/home/ydk104/work/rhesus_microsat/axtNet/hg18.panTro2.ponAbe2.rheMac2.calJac1/chr1.hg18.panTro2.ponAbe2.rheMac2.calJac1.net.axt";
-my $megamatchlck = $megamatch.".lck";
-unlink $megamatchlck;
-
-my $selected= $orth;
-#my $eventfile = $orth;
- $selected = $selected."_SELECTED";
-#$selected = $selected."_".$SIMILARITY_THRESH;
-#my $runtime = $selected.".runtime";
-
-my $inputtags = "H:C:O:R:M";
-$inputtags = $ARGV[3] if exists $ARGV[3] && $ARGV[3] =~ /[A-Z]:[A-Z]/;
-
-my @all_tags = split(/:/, $inputtags);
-my $inputsp = "hg18:panTro2:ponAbe2:rheMac2:calJac1";
-$inputsp = $ARGV[4] if exists $ARGV[4] && $ARGV[3] =~ /[0-9]+:/;
-#@sp_ident = split(/:/,$inputsp);
-my $junkfile = $orth."_junk";
-
-my $sh = load_sameHash(1);
-my $rh = load_revHash(1);
-
-#print "inputs are : \n"; foreach(@ARGV){print $_,"\n";}
-#open (SELECT, ">$selected") or die "Cannot open selected file: $selected: $!";
-open (SUMMARY, ">$summout") or die "Cannot open summout file: $summout: $!";
-#open (RUN, ">$runtime") or die "Cannot open orth file: $runtime: $!";
-#my $ctlfile = "baseml\.ctl"; #$ARGV[4];
-#my $treefile = "/gpfs/home/ydk104/work/rhesus_microsat/codes/lib/"; #1 THIS IS THE THE TREE UNDER CONSIDERATION, IN NEWICK
-my %registeredTrees = ();
-my @removalReasons =
-("microsatellite is compound",
-"complex structure",
-"if no. if micros is more than no. of species",
-"if more than one micro per species ",
-"if microsat contains N",
-"different motif than required ",
-"more than zero interruptions",
-"microsat could not form key ",
-"orthologous microsats of different motif size ",
-"orthologous microsats of different motifs ",
-"microsats belong to different alignment blocks altogether",
-"microsat near edge",
-"microsat in low complexity region",
-"microsat flanks dont align well",
-"phylogeny not informative");
-my %allowedhash=();
-#---------------------------------------------------------------------------
-# WORKING ON MAKING THE MEGAMATCH FILE
-my $chromt=int(rand(10000));
-my $p_chr=$chromt;
-
-my $tree_definition_orig_copy = $tree_definition_orig;
-
-$tree_definition=~s/,/, /g;
-$tree_definition =~ s/, +/, /g;
-$tree_definition_orig=~s/,/, /g;
-$tree_definition_orig =~ s/, +/, /g;
-my @exactspeciesset_unarranged = split(/,/,$species_set);
-my @exactspeciesset_unarranged_orig = split(/,/,$tspecies_set);
-my $largesttree = "$tree_definition;";
-my $largesttree_orig = "$tree_definition_orig;";
-# print "largesttree = $largesttree\n";
-$tree_definition =~ s/\(//g;
-$tree_definition =~ s/\)//g;
-$tree_definition=~s/[\)\(, ]/\t/g;
-$tree_definition =~ s/\t+/\t/g;
-
-$tree_definition_orig =~ s/\(//g;
-$tree_definition_orig =~ s/\)//g;
-$tree_definition_orig =~s/[\)\(, ]/\t/g;
-$tree_definition_orig =~ s/\t+/\t/g;
-# print "tree_definition = $tree_definition tree_definition_orig = $tree_definition_orig\n";
-
-my @treespecies=split(/\t+/,$tree_definition);
-my @treespecies_orig=split(/\t+/,$tree_definition_orig);
-# print "tree_definition = $tree_definition .. treespecies=@treespecies ... treespecies_orig=@treespecies_orig\n";
-#;
-
-foreach my $spec (@treespecies){
- foreach my $espec (@exactspeciesset_unarranged){
-# print "spec=$spec and espec=$espec\n";
- push @exactspecies, $spec if $spec eq $espec;
- }
-}
-
-foreach my $spec (@treespecies_orig){
- foreach my $espec (@exactspeciesset_unarranged_orig){
-# print "spec=$spec and espec=$espec\n";
- push @exactspecies_orig, $spec if $spec eq $espec;
- }
-}
-
-my $focalspec = $exactspecies[0];
-my $focalspec_orig = $exactspecies_orig[0];
-# print "exactspecies=@exactspecies ... focalspec=$focalspec\n";
-# print "texactspecies=@exactspecies_orig ... focalspec_orig=$focalspec_orig\n";
-#;
-my $arranged_species_set = join(".",@exactspecies);
-my $arranged_species_set_orig = join(".",@exactspecies_orig);
-
-@exacttags=@exactspecies;
-my @exacttags_orig=@exactspecies_orig;
-
-foreach my $extag (@exacttags){
- $extag =~ s/hg18/H/g;
- $extag =~ s/panTro2/C/g;
- $extag =~ s/ponAbe2/O/g;
- $extag =~ s/rheMac2/R/g;
- $extag =~ s/calJac1/M/g;
-}
-
-foreach my $extag (@exacttags_orig){
- $extag =~ s/hg18/H/g;
- $extag =~ s/panTro2/C/g;
- $extag =~ s/ponAbe2/O/g;
- $extag =~ s/rheMac2/R/g;
- $extag =~ s/calJac1/M/g;
-}
-
-my $chr_name = join(".",("chr".$p_chr),$arranged_species_set, "net", "axt");
-#print "sending to maftoAxt_multispecies: $maf, $tree_definition, $chr_name, $species_set .. focalspec=$focalspec \n";
-
-maftoAxt_multispecies($maf, $tree_definition_orig_copy, $chr_name, $tspecies_set);
-#print "made files\n";
-my @filterseqfiles= ($chr_name);
-$largesttree =~ s/hg18/H/g;
-$largesttree =~ s/panTro2/C/g;
-$largesttree =~ s/ponAbe2/O/g;
-$largesttree =~ s/rheMac2/R/g;
-$largesttree =~ s/calJac1/M/g;
-#;
-#---------------------------------------------------------------------------
-
-my ($lagestnodes, $largestbranches) = get_nodes($largesttree);
-shift (@$lagestnodes);
-my @extendedtitle=();
-
-my $title = ();
-my $parttitle = ();
-my @titlearr = ();
-my @firsttitle=($focalspec_orig."chrom", $focalspec_orig."start", $focalspec_orig."end", $focalspec_orig."motif", $focalspec_orig."motifsize", $focalspec_orig."threshold");
-
-my @finames= qw(chr start end motif motifsize microsat mutation mutation.position mutation.from mutation.to insertion.details deletion.details);
-
-my @fititle=();
-
-foreach my $spec (split(",",$tspecies_set)){
- push @fititle, $spec;
- foreach my $name (@finames){
- push @fititle, $spec.".".$name;
- }
-}
-
-
-my @othertitle=qw(somechr somestart somened event source);
-
-my @fnames = ();
-push @fnames, qw(insertions_num deletions_num motinsertions_num motinsertionsf_num motdeletions_num motdeletionsf_num noninsertions_num nondeletions_num) ;
-push @fnames, qw(binsertions_num bdeletions_num bmotinsertions_num bmotinsertionsf_num bmotdeletions_num bmotdeletionsf_num bnoninsertions_num bnondeletions_num) ;
-push @fnames, qw(dinsertions_num ddeletions_num dmotinsertions_num dmotinsertionsf_num dmotdeletions_num dmotdeletionsf_num dnoninsertions_num dnondeletions_num) ;
-push @fnames, qw(ninsertions_num ndeletions_num nmotinsertions_num nmotinsertionsf_num nmotdeletions_num nmotdeletionsf_num nnoninsertions_num nnondeletions_num) ;
-push @fnames, qw(substitutions_num bsubstitutions_num dsubstitutions_num nsubstitutions_num indels_num subs_num);
-
-my @fullnames = ();
-# print "revising\n";
-# print "H = $backReplacementArrTag{H}\n";
-# print "C = $backReplacementArrTag{C}\n";
-# print "O = $backReplacementArrTag{O}\n";
-# print "R = $backReplacementArrTag{R}\n";
-# print "M = $backReplacementArrTag{M}\n";
-
-foreach my $lnode (@$lagestnodes){
- my @pair = @$lnode;
- my @nodemutarr = ();
- for my $p (@pair){
-# print "p = $p\n";
- $p =~ s/[\(\), ]+//g;
- $p =~ s/([A-Z])/$1./g;
- $p =~ s/\.$//g;
-
- $p =~ s/H/$backReplacementArrTag{H}/g;
- $p =~ s/C/$backReplacementArrTag{C}/g;
- $p =~ s/O/$backReplacementArrTag{O}/g;
- $p =~ s/R/$backReplacementArrTag{R}/g;
- $p =~ s/M/$backReplacementArrTag{M}/g;
- foreach my $n (@fnames) { push @fullnames, $p.".".$n;}
- }
-}
-
-#print SUMMARY "#",join("\t", @firsttitle, @fititle, @othertitle);
-
-#print SUMMARY "\t",join("\t", @fullnames);
-my $header = join("\t",@firsttitle, @fititle, @othertitle, @fullnames, @fnames, "tree", "cleancase");
-# print "header= $header\n";
-#;
-
-#print SUMMARY "\t",join("\t", @fnames);
-#$title= $title."\t".join("\t", @fnames);
-
-#print SUMMARY "\t","tree","\t", "cleancase", "\n";
-#$title= $title."\t"."tree"."\t"."cleancase". "\n";
-
-#print $title; #;
-
-#print "all_tags = @all_tags\n";
-
-for my $no (3 ... $#all_tags+1){
-# print "no=$no\n"; #;
- @tags = @all_tags[0 ... $no-1];
-# print "all_tags=>@all_tags< , tags = >@tags<\n" if $printer == 1; #;
- %template=();
- my @nextcounter = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
- #next if scalar(@tags) < 4;
-# print "now doing tags = @tags, no = $no\n";
- open (ORTH, "<$orth") or die "Cannot open orth file: $orth: $!";
-
-# print SUMMARY join "\t", qw (species chr start end branch motif microsat mutation position from to insertion deletion);
-
-
- ##################### T E M P O R A R Y #####################
- my @finaltitle=();
- my @singletitle = qw (species chr start end motif motifsize microsat strand microsatsize col10 col11 col12 col13);
- my $endtitle = ();
- foreach my $tag (@tags){
- my @tempsingle = ();
-
- foreach my $single (@singletitle){
- push @tempsingle, $tag.$single;
- }
- @finaltitle = (@finaltitle, @tempsingle);
- }
-
-# print SUMMARY join("\t",@finaltitle),"\n";
-
- #############################################################
-
- #---------------------------------------------------------------------------
- # GET THE TREE FROM TREE FILE
- my $tree = ();
- $tree = "((H, C), O)" if $no == 3;
- $tree = "(((H, C), O), R)" if $no == 4;
- $tree = "((((H, C), O), R), M)" if $no == 5;
-# $tree=~s/;$//g;
-# print "our tree = $tree\n";
- #---------------------------------------------------------------------------
- # LOADING HASH CONTAINING ALL POSSIBLE TREES:
- $tree_decipherer = "/gpfs/home/ydk104/work/rhesus_microsat/codes/lib/tree_analysis_".join("",@tags).".txt";
- %template=();
- %alternate=();
- load_allPossibleTrees($tree_decipherer, \%template, \%alternate);
-
- #---------------------------------------------------------------------------
- # LOADING THE TREES TO REJECT FOR BIRTH ANALYSIS
- %treesToReject=();
- %treesToIgnore=();
- load_treesToReject(@tags);
- load_treesToIgnore(@tags);
- #---------------------------------------------------------------------------
- # LOADING INPUT DATA INTO HASHES AND ARRAYS
-
-
- #1 THIS IS THE POINT WHERE WE CAN FILTER OUT LARGE MICROSAT CLUSTERS
- #2 AS WELL AS MULTIPLE-ALIGNMENT-BLOCKS-SPANNING MICROSATS (KIND OF
- #3 IMPLICIT IN THE FIRST PART OF THE SENTENCE ITSELF IN MOST CASES).
-
- my %orths=();
- my $counterm = 0;
- my $loaded = 0;
- my %seen = ();
- my @allowedchrs = ();
-# print "no = $no\n"; #;
-
- while (my $line = ){
- # print "line=$line\n";
- my $register1 = $line =~ s/>$exactspecies_orig[0]/>$replacementArrTag{$exactspecies_orig[0]}/g;
- my $register2 = $line =~ s/>$exactspecies_orig[1]/>$replacementArrTag{$exactspecies_orig[1]}/g;
- my $register3 = $line =~ s/>$exactspecies_orig[2]/>$replacementArrTag{$exactspecies_orig[2]}/g;
- my $register4 = $line =~ s/>$exactspecies_orig[3]/>$replacementArrTag{$exactspecies_orig[3]}/g;
- my $register5 = $line =~ s/>$exactspecies_orig[4]/>$replacementArrTag{$exactspecies_orig[4]}/g if exists $exactspecies_orig[4];
-
- # print "line = $line\n"; ;
-
-
- # next if $register1 + $register2 + $register3 + $register4 + $register5 > scalar(@tags);
- my @micros = split(/>/,$line); # LOADING ALL THE MICROSAT ENTRIES FROM THE CLUSTER INTO @micros
- #print "micros=",printarr(@micros),"\n"; #;
- shift @micros; # EMPTYING THE FIRST, EMTPY ELEMENT OF THE ARRAY
-
- $no_of_species = adjustCoordinates($micros[0]);
-# print "A: $no_of_species\n";
- next if $no_of_species != $no;
-# print "no = $no ... no_of_species=$no_of_species\n";#;
- $counterm++;
- #------------------------------------------------
- $nextcounter[0]++ if $line =~ /compound/;
- next if $line =~ /compound/; # GETTING RID OF COMPOUND MICROSATS
- #------------------------------------------------
- #next if $line =~ /[A-Za-z]>[a-zA-Z]/;
- #------------------------------------------------
- chomp $line;
- my $match_count = ($line =~ s/>/>/g); # COUNTING THE NUMBER OF MICROSAT ENTRIES IN THE CLUSTER
- #print "number of species = $match_count\n";
- my $stopper = 0;
- foreach my $mic (@micros){
- my @local = split(/\t/,$mic);
- if ($local[$typecord] =~ /\./ || exists($local[$no_of_interruptionscord+2])) {$stopper = 1; $nextcounter[1]++;
- last; }
- # REMOVING CLUSTERS WITH THE CYRPTIC, (UNRESOLVABLY COMPLEX) MICROSAT ENTRIES IN THEM
- }
- next if $stopper ==1;
- #------------------------------------------------
- $nextcounter[2]++ if (scalar(@micros) >$no_of_species);
-
- next if (scalar(@micros) >$no_of_species); #1 REMOVING MICROSAT CLUSTERS WITH MORE NUMBER OF MICROSAT ENTRIES THAN THE NUMBER OF SPECIES IN THE DATASET.
- #2 THIS IS SO BECAUSE SUCH CLUSTERS IMPLY THAT IN AT LEAST ONE SPECIES, THERE IS MORE THAN ONE MICROSAT ENTRY
- #3 IN THE CLUSTER. THUS, HERE WE ARE GETTING RID OF MICROSATS CLUSTERS THAT INCLUDE MULTUPLE, NEIGHBORING
- #4 MICROSATS, AND STICK TO CLEAN MICROSATS THAT DO NOT HAVE ANY MICROSATS IN NEIGHBORHOOD.
- #5 THIS 'NEIGHBORHOOD-RANGE' HAD BEEN DECIDED PREVIOUSLY IN OUR CODE multiSpecies_orthFinder4.pl
- my $nexter = 0;
- foreach my $tag (@tags){
- my $tagcount = ($line =~ s/>$tag\t/>$tag\t/g);
- if ($tagcount > 1) { $nexter =1; #print colored ['red'],"multiple entires per species : $tagcount of $tag\n" if $printer == 1;
- next;
- }
- }
-
- if ($nexter == 1){
- $nextcounter[3]++;
- next;
- }
- #------------------------------------------------
- foreach my $mic (@micros){ #1 REMOVING MICROSATELLITES WITH ANY 'N's IN THEM
- my @local = split(/\t/,$mic);
- if ($local[$microsatcord] =~ /N/) {$stopper =1; $nextcounter[4]++;
- last;}
- }
- next if $stopper ==1;
- #print "till here 1\n"; #;
- #------------------------------------------------
- my @micros_copy = @micros;
-
- my $tempmicro = shift(@micros_copy); #1 CURRENTLY OBTAINING INFORMATION FOR THE FIRST
- #2 MICROSAT IN THE CLUSTER.
- my @tempfields = split(/\t/,$tempmicro);
- my $prevtype = $tempfields[$typecord];
- my $tempmotif = $tempfields[$motifcord];
-
- my $tempfirstmotif = ();
- if (scalar(@tempfields) > $microsatcord + 2){
- if ($tempfields[$no_of_interruptionscord] >= 1) { #1 DISCARDING MICROSATS WITH MORE THAN ZERO INTERRUPTIONS
- #2 IN THE FIRST MICROSAT OF THE CLUSTER
- $nexter =1; #print colored ['blue'],"more than one interruptions \n" if $printer == 1;
- }
- }
- if ($nexter == 1){
- $nextcounter[6]++;
- next;
- } #1 DONE OBTAINING INFORMATION REGARDING
- #2 THE FIRST MICROSAT FROM THE CLUSTER
-
- if ($tempmotif =~ /^\[/){
- $tempmotif =~ s/^\[//g;
- $tempmotif =~ /([a-zA-Z]+)\].*/;
- $tempfirstmotif = $1; #1 OBTAINING THE FIRTS MOTIF OF MICROSAT
- }
- else {$tempfirstmotif = $tempmotif;}
- my $prevmotif = $tempfirstmotif;
-
- my $key = ();
- # print "searching temp micro for 0-9 $focalspec chr0-9a-zA-Z 0-9 0-9 \n";
- # print "tempmicro = $tempmicro .. looking for ([0-9]+)\s+($focalspec_orig)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)\n"; ;
- if ($tempmicro =~ /([0-9]+)\s+($focalspec_orig)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)/ ) {
- # print "B: $no_of_species\n";
- $key = join("_",$2, $3, $4, $5);
- }
- else{
-# print "counld not form a key for temp\n"; # if $printer == 1;
- $nextcounter[7]++;
- next;
- }
- #----------------- #1 NOW, AFTER OBTAINING INFORMATION ABOUT
- #2 THE FIRST MICROSAT IN THE CLUSTER, THE
- #3 FOLLOWING LOOP GOES THROUGH THE OTHER MICROSATS
- #4 TO SEE IF THEY SHARE THE REQUIRED FEATURES (BELOW)
-
- foreach my $micro (@micros_copy){
- my @fields = split(/\t/,$micro);
- #-----------------
- if (scalar(@fields) > $microsatcord + 2){ #1 DISCARDING MICROSATS WITH MORE THAN ONE INTERRUPTIONS
- if ($fields[$no_of_interruptionscord] >= 1) {$nexter =1; #print colored ['blue'],"more than one interruptions \n" if $printer == 1;
- $nextcounter[6]++;
- last; }
- }
- #-----------------
- if (($prevtype ne "0") && ($prevtype ne $fields[$typecord])) {
- $nexter =1; #print colored ['yellow'],"microsat of different type \n" if $printer == 1;
- $nextcounter[8]++;
- last; } #1 DISCARDING MICROSAT CLUSTERS WHERE MICROSATS BELONG
- #----------------- #2 TO DIFFERENT TYPES (MONOS, DIS, TRIS ETC.)
- $prevtype = $fields[$typecord];
-
- my $motif = $fields[$motifcord];
- my $firstmotif = ();
-
- if ($motif =~ /^\[/){
- $motif =~ s/^\[//g;
- $motif =~ /([a-zA-Z]+)\].*/;
- $firstmotif = $1;
- }
- else {$firstmotif = $motif;}
-
- my $motifpattern = $firstmotif.$firstmotif;
- my $prevmotifpattern = $prevmotif.$prevmotif;
-
- if (($prevmotif ne "0")&&(($motifpattern !~ /$prevmotif/i)||($prevmotifpattern !~ /$firstmotif/i)) ) {
- $nexter =1; #print colored ['green'],"different motifs used \n$line\n" if $printer == 1;
- $nextcounter[9]++;
- last;
- } #1 DISCARDING MICROSAT CLUSTERS WHERE MICROSATS BELONG
- #2 TO DIFFERENT MOTIFS
- my $prevmotif = $firstmotif;
- #-----------------
-
- for my $t (0 ... $#tags){ #1 DISCARDING MICROSAT CLUSTERS WHERE MICROSAT ENTRIES BELONG
- #2 DIFFERENT ALIGNMENT BLOCKS
- if ($micro =~ /([0-9]+)\s+($focalspec_orig)\s([_0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)/ ) {
- my $key2 = join("_",$2, $3, $4, $5);
-# print "key = $key .. key2 = $key2\n"; #;
- if ($key2 ne $key){
-# print "microsats belong to diffferent alignment blocks altogether\n" if $printer == 1;
- $nextcounter[10]++;
- $nexter = 1; last;
- }
- }
- else{
-# print "counld not form a key for $line\n"; # if $printer == 1;
- #;
- $nexter = 1; last;
- }
- }
- }
- #print "D2: $no_of_species\n";
-
- #####################
- if ($nexter == 1){
-# print "nexting\n"; # if $printer == 1;
- next;
- }
- else{
-# print "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n$key:\n$line\nvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv\n" if $printer == 1;
- push (@{$orths{$key}},$line);
- $loaded++;
- if ($line =~ /($focalspec_orig)\s([_a-zA-Z0-9]+)\s([0-9]+)\s([0-9]+)/ ) {
-
-# print "$line\n" if $printer == 1; #if $line =~ /Contig/;
-# print "################ ################\n" if $printer == 1;
- push @allowedchrs, $2 if !exists $allowedhash{$2};
- $allowedhash{$2} = 1;
- my $key = join("\t",$1, $2, $3, $4);
-# print "C: $no_of_species .. key = $key\n";#;
-# print "print the shit: $key\n" ; #if $printer == 1;
- $seen{$key} = 1;
- }
- else { #print "Key could not be formed in SPUT for ($focalspec_orig) (chrom) ([0-9]+) ([0-9]+)\n";
- }
- }
- }
- close ORTH;
-# print "now studying where we lost microsatellites: @nextcounter\n";
- for my $reason (0 ... $#nextcounter){
- #print $removalReasons[$reason]."\t".$nextcounter[$reason],"\n";
- }
-# print "\ntotal number of keys formed = ", scalar(keys %orths), " = \n";
-# print "done filtering .. counterm = $counterm and loaded = $loaded\n";
- #----------------------------------------------------------------------------------------------------------------
- # NOW GENERATING THE ALIGNMENT FILE WITH RELELEVENT ALIGNMENTS STORED ONLY.
-# print "adding files @filterseqfiles \n";
- #;
-
- while (1){
- if (-e $megamatchlck){
-# print "waiting to write into $megamatchlck\n";
- sleep 10;
- }
- else{
- open (MEGAMLCK, ">$megamatchlck") or die "Cannot open megamatchlck file $megamatchlck: $!";
- open (MEGAM, ">$megamatch") or die "Cannot open megamatch file $megamatch: $!";
- last;
- }
- }
- foreach my $seqfile (@filterseqfiles){
- my $fullpath = $seqfile;
- open (MATCH, "<$fullpath") or die "Cannot open MATCH file $fullpath: $!";
- my $matchlines = 0;
-
- while (my $line = ) {
- #print "checking $line";
- if ($line =~ /($focalspec_orig)\s([a-zA-Z0-9]+)\s([0-9]+)\s([0-9]+)/ ) {
- my $key = join("\t",$1, $2, $3, $4);
-# print "key = $key\n";
- #print "------------------------------------------------------\n";
- #print "asking $line\n";
- if (exists $seen{$key}){
-
- #print "seen $line \n"; ;
- while (1){
- $matchlines++;
- print MEGAM $line;
- $line = ;
- print MEGAM "\n" if $line !~ /[0-9a-zA-Z]/;
- last if $line !~/[0-9a-zA-Z]/;
- }
- }
- else{
-# print "not seen\n";
- }
- }
- }
-# print "matchlines = $matchlines\n";
- close MATCH;
- }
- close MEGAMLCK;
-
- unlink $megamatchlck;
- close MEGAM;
- undef %seen;
-# print "done writitn to $megamatch\n";#;
- #----------------------------------------------------------------------------------------------------------------
- #;
- #---------------------------------------------------------------------------
- # NOW, AFTER FILTERING MANY MICROSATS, AND LOADING THE FILTERED ONES INTO
- # THE HASH %orths , WE GO THROUGH THE ALIGNMENT FILE, AND STUDY THE
- # FLANKING SEQUENCES OF ALL THESE MICROSATS, TO FILTER THEM FURTHER
- #$printer = 1;
-
- my $microreadcounter=0;
- my $contigsentered=0;
- my $contignotrightcounter=0;
- my $keynotformedcounter=0;
- my $keynotfoundcounter= 0;
- my $dotcounter = 0;
-
-# print "opening $megamatch\n";
-
- open (BO, "<$megamatch") or die "Cannot open alignment file: $megamatch: $!";
-# print "doing $megamatch\n " ;
-
- #;
-
- while (my $line = ){
-# print $line; #;
-# print "." if $dotcounter % 100 ==0;
-# print "\n" if $dotcounter % 5000 ==0;
-# print "dotcounter = $dotcounter\n " if $printer == 1;
- next if $line !~ /^[0-9]+/;
- $dotcounter++;
-# print colored ['green'], "~" x 60, "\n" if $printer == 1;
-# print colored ['green'], $line;# if $printer == 1;
- chomp $line;
- my @fields2 = split(/\t/,$line);
- my $key2 = ();
- my $alignment_no = (); #1 TEMPORARY
- if ($line =~ /([0-9]+)\s+($focalspec_orig)\s([_\-s0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)/ ) {
-# $key2 = join("\t",$1, $2, $4, $5);
- $key2 = join("_",$2, $3, $4, $5);
-# print "key = $key2\n";
-
-# print "key = $key2\n";
- $alignment_no=$1;
- }
- else {print "seq line $line incompatible\n"; $keynotformedcounter++; next;}
-
- $no_of_species = adjustCoordinates($line);
-
- $contignotrightcounter++ if $no_of_species != $no;
-# print "contignotrightcounter=$contignotrightcounter\n";
-# print "no_of_species=$no_of_species\n";
-# print "no=$no\n";
-
- next if $no_of_species != $no;
-# print "D: $no_of_species\n";
-# print "E: $no_of_species\n";
- #;
- # print "key = $key2\n" if $printer == 1;
- my @clusters = (); #1 EXTRACTING MICROSATS CORRESPONDING TO THIS
- #2 ALIGNMENT BLOCK
- if (exists($orths{$key2})){
- @clusters = @{$orths{$key2}};
- $contigsentered++;
- delete $orths{$key2};
- }
- else{
-# print "orth does not exist\n";
- $keynotfoundcounter++;
- next;
- }
-
- my %sequences=(); #1 WILL STORE SEQUENCES IN THE CURRENT ALIGNMENT BLOCK
- my $humseq = ();
- foreach my $tag (@tags){ #1 READING THE ALIGNMENT FILE AND CAPTURING SEQUENCES
- my $seq = ; #2 OF ALL SPECIES.
- chomp $seq;
- $sequences{$tag} = " ".$seq;
- #print "sequences = $sequences{$tag}\n" if $printer == 1;
- $humseq = $seq if $tag =~ /H/;
- }
-
-
- foreach my $cluster (@clusters){ #1 NOW, GOING THROUGH THE CLUSTER OF MICROSATS
-# print "x" x 60, "\n" if $printer == 1;
-# print colored ['red'],"cluster = $cluster\n";
- $largesttree =~ s/hg18/H/g;
- $largesttree =~ s/panTro2/C/g;
- $largesttree =~ s/ponAbe2/O/g;
- $largesttree =~ s/rheMac2/R/g;
- $largesttree =~ s/calJac1/M/g;
-
- $microreadcounter++;
- my @micros = split(/>/,$cluster);
-
-
-
-
-
-
- shift @micros;
-
- my $edge_microsat=0; #1 THIS WILL HAVE VALUE "1" IF MICROSAT IS FOUND
- #2 TO BE TOO CLOSE TO THE EDGES OF ALIGNMENT BLOCK
-
- my @starts= (); my %start_hash=(); #1 STORES THE START AND END COORDINATES OF MICROSATELLITES
- my @ends = (); my %end_hash=(); #2 SO THAT LATER, WE WILL BE ABLE TO FIND THE EXTREME
- #3 COORDINATE VALUES OF THE ORTHOLOGOUS MIROSATELLITES.
-
- my %microhash=();
- my %microsathash=();
- my %nonmicrosathash=();
- my $motif=(); #1 BASIC MOTIF OF THE MICROSATELLITE.. THERE'S ONLY 1
-# print "tags=@tags\n";
- for my $i (0 ... $#tags){ #1 FINDING THE MICROSAT, AND THE ALIGNMENT SEQUENCE
- #2 CORRESPONDING TO THE PARTICULAR SPECIES (AS PER
- #3 THE VARIABLE $TAG;
- my $tag = $tags[$i];
- # print $seq;
- my $locus="NULL"; #1 THIS WILL STORE THE MICROSAT OF THIS SPECIES.
- #2 IF THERE IS NO MICROSAT, IT WILL REMAIN "NULL"
-
- foreach my $micro (@micros){
- # print "micro=$micro, tag=$tag\n";
- if ($micro =~ /^$tag/){ #1 MICROSAT OF THIS SPECIES FOUND..
- $locus = $micro;
- my @fields = split(/\t/,$micro);
- $motif = $fields[$motifcord];
- $microsathash{$tag}=$fields[$microsatcord];
- # print "fields=@fields, and startcord=$startcord = $fields[$startcord]\n";
- push(@starts, $fields[$startcord]);
- push(@ends, $fields[$endcord]);
- $start_hash{$tag}=$fields[$startcord];
- $end_hash{$tag}=$fields[$endcord];
- last;
- }
- else{$microsathash{$tag}="NULL"}
- }
- $microhash{$tag}=$locus;
-
- }
-
-
-
- my $extreme_start = smallest_number(@starts); #1 THESE TWO ARE THE EXTREME COORDINATES OF THE
- my $extreme_end = largest_number(@ends); #2 MICROSAT CLUSTER ACCROSS ALL THE SPECIES IN
- #3 WHOM IT IS FOUND TO BE ORTHOLOGOUS.
-
-# print "starts=@starts... ends=@ends\n";
-
- my %up_flanks = (); #1 CONTAINS UPSTEAM FLANKING REGIONS FOR EACH SPECIES
- my %down_flanks = (); #1 CONTAINS DOWNDTREAM FLANKING REGIONS FOR EACH SPECIES
-
- my %up_largeflanks = ();
- my %down_largeflanks = ();
-
- my %locusandflanks = ();
- my %locusandlargeflanks = ();
-
- my %up_internal_flanks=(); #1 CONTAINS SEQUENCE BETWEEN THE $extreme_start and the
- #2 ACTUAL START OF MICROSATELLITE IN THE SPECIES
- my %down_internal_flanks=(); #1 CONTAINS SEQUENCE BETWEEN THE $extreme_end and the
- #2 ACTUAL end OF MICROSATELLITE IN THE SPECIES
-
- my %alignment=(); #1 CONTAINS ACTUAL ALIGNMENT SEQUENCE BETWEEN THE TWO
- #2 EXTEME VALUES.
-
- my %microsatstarts=(); #1 WITHIN EACH ALIGNMENT, IF THERE EXISTS A MICROSATELLITE
- #2 THIS HASH CONTAINS THE START SITE OF THE MICROSATELLITE
- #3 WIHIN THE ALIGNMENT
- next if !defined $extreme_start;
- next if !defined $extreme_end;
- next if $extreme_start > length($sequences{$tags[0]});
- next if $extreme_start < 0;
- next if $extreme_end > length($sequences{$tags[0]});
-
- for my $i (0 ... $#tags){ #1 NOW THAT WE HAVE GATHERED INFORMATION REGARDING
- #2 SEQUENCE ALIGNMENT AND MICROSATELLITE COORDINATES
- #3 AS WELL AS THE EXTREME COORDINATES OF THE
- #4 MICROSAT CLUSTER, WE WILL PROCEED TO EXTRACT THE
- #5 FLANKING SEQUENCE OF ALL ORGS, AND STUDY IT IN
- #6 MORE DETAIL.
- my $tag = $tags[$i];
-# print "tag=$tag.. seqlength = ",length($sequences{$tag})," extreme_start=$extreme_start and extreme_end=$extreme_end\n";
- my $upstream_gaps = (substr($sequences{$tag}, 0, $extreme_start) =~ s/\-/-/g); #1 NOW MEASURING THE NUMBER OF GAPS IN THE UPSTEAM
- #2 AND DOWNSTREAM SEQUENCES OF THE MICROSATs IN THIS
- #3 CLUSTER.
-# print "seq length $tag = $sequences{$tag} = ",length($sequences{$tag})," extreme_end=$extreme_end\n" ;
- my $downstream_gaps = (substr($sequences{$tag}, $extreme_end) =~ s/\-/-/g);
- if (($extreme_start - $upstream_gaps )< $EDGE_DISTANCE || (length($sequences{$tag}) - $extreme_end - $downstream_gaps) < $EDGE_DISTANCE){
- $edge_microsat=1;
-
- last;
- }
- else{
- $up_flanks{$tag} = substr($sequences{$tag}, $extreme_start - $FLANK_SUPPORT, $FLANK_SUPPORT);
- $down_flanks{$tag} = substr($sequences{$tag}, $extreme_end+1, $FLANK_SUPPORT);
-
- $up_largeflanks{$tag} = substr($sequences{$tag}, $extreme_start - $COMPLEXITY_SUPPORT, $COMPLEXITY_SUPPORT);
- $down_largeflanks{$tag} = substr($sequences{$tag}, $extreme_end+1, $COMPLEXITY_SUPPORT);
-
-
- $alignment{$tag} = substr($sequences{$tag}, $extreme_start, $extreme_end-$extreme_start+1);
- $locusandflanks{$tag} = $up_flanks{$tag}."[".$alignment{$tag}."]".$down_flanks{$tag};
- $locusandlargeflanks{$tag} = $up_largeflanks{$tag}."[".$alignment{$tag}."]".$down_largeflanks{$tag};
-
- if ($microhash{$tag} ne "NULL"){
- $up_internal_flanks{$tag} = substr($sequences{$tag}, $extreme_start , $start_hash{$tag}-$extreme_start);
- $down_internal_flanks{$tag} = substr($sequences{$tag}, $end_hash{$tag} , $extreme_end-$end_hash{$tag});
- $microsatstarts{$tag}=$start_hash{$tag}-$extreme_start;
-# print "tag = $tag, internal flanks = $up_internal_flanks{$tag} and $down_internal_flanks{$tag} and start = $microsatstarts{$tag}\n" if $printer == 1;
- }
- else{
- $nonmicrosathash{$tag}=substr($sequences{$tag}, $extreme_start, $extreme_end-$extreme_start+1);
-
- }
- # print "up flank for species $tag = $up_flanks{$tag} \ndown flank for species $tag = $down_flanks{$tag} \n" if $printer == 1;
-
- }
-
- }
- $nextcounter[11]++ if $edge_microsat==1;
- next if $edge_microsat==1;
-
-
- my $low_complexity = 0; #1 VALUE WILL BE 1 IF ANY OF THE FLANKING REGIONS
- #2 IS FOUND TO BE OF LOW COMPLEXITY, BY USING THE
- #3 FUNCTION sub test_complexity
-
-
- for my $i (0 ... $#tags){
-# print "i = $tags[$i]\n" if $printer == 1;
- if (test_complexity($up_largeflanks{$tags[$i]}, $COMPLEXITY_SUPPORT) eq "LOW" || test_complexity($down_largeflanks{$tags[$i]}, $COMPLEXITY_SUPPORT) eq "LOW"){
-# print "i = $i, low complexity regions: $up_largeflanks{$tags[$i]}: ",test_complexity($up_largeflanks{$tags[$i]}, $COMPLEXITY_SUPPORT), " and $down_largeflanks{$tags[$i]} = ",test_complexity($down_largeflanks{$tags[$i]}, $COMPLEXITY_SUPPORT),"\n" if $printer == 1;
- $low_complexity =1; last;
- }
- }
-
- $nextcounter[12]++ if $low_complexity==1;
- next if $low_complexity == 1;
-
-
- my $sequence_dissimilarity = 0; #1 THIS VALYE WILL BE 1 IF THE SEQUENCE SIMILARITY
- #2 BETWEEN ANY OF THE SPECIES AGAINST THE HUMAN
- #3 FLANKING SEQUENCES IS BELOW A CERTAIN THRESHOLD
- #4 AS DESCRIBED IN FUNCTION sub sequence_similarity
- my %donepair = ();
- for my $i (0 ... $#tags){
- # print "i = $tags[$i]\n" if $printer == 1;
-# next if $i == 0;
- # print colored ['magenta'],"THIS IS UP\n" if $printer == 1;
-
- for my $b (0 ... $#tags){
- next if $b == $i;
- my $pair = ();
- $pair = $i."_".$b if $i < $b;
- $pair = $b."_".$i if $b < $i;
- next if exists $donepair{$pair};
- my ($up_similarity,$upnucdiffs, $upindeldiffs) = sequence_similarity($up_flanks{$tags[$i]}, $up_flanks{$tags[$b]}, $SIMILARITY_THRESH, $info);
- my ($down_similarity,$downnucdiffs, $downindeldiffs) = sequence_similarity($down_flanks{$tags[$i]}, $down_flanks{$tags[$b]}, $SIMILARITY_THRESH, $info);
- $donepair{$pair} = $up_similarity."_".$down_similarity;
-
-# print RUN "$up_similarity $upnucdiffs $upindeldiffs $down_similarity $downnucdiffs $downindeldiffs\n";
-
- if ( $up_similarity < $SIMILARITY_THRESH || $down_similarity < $SIMILARITY_THRESH){
- $sequence_dissimilarity =1;
- last;
- }
- }
- }
- $nextcounter[13]++ if $sequence_dissimilarity==1;
-
- next if $sequence_dissimilarity == 1;
- my ($simplified_microsat, $Hchrom, $Hstart, $Hend, $locusmotif, $locusmotifsize) = summarize_microsat($cluster, $humseq);
-# print "simplified_microsat=$simplified_microsat\n";
- my ($tree_analysis, $conformation) = treeStudy($simplified_microsat);
-# print "tree_analysis = $tree_analysis .. conformation=$conformation\n";
- #;
-
-# print SELECT "\"$conformation\"\t$tree_analysis\n";
-
- next if $tree_analysis =~ /DISCARD/;
- if (exists $treesToReject{$tree_analysis}){
- $nextcounter[14]++;
- next;
- }
-
-# print "F: $no_of_species\n";
-
-# my $adjuster=();
-# if ($no_of_species == 4){
-# my @sields = split(/\t/,$simplified_microsat);
-# my $somend = pop(@sields);
-# my $somestart = pop(@sields);
-# my $somechr = pop(@sields);
-# $adjuster = "NA\t" x 13 ;
-# $simplified_microsat = join ("\t", @sields, $adjuster).$somechr."\t".$somestart."\t".$somend;
-# }
-# if ($no_of_species == 3){
-# my @sields = split(/\t/,$simplified_microsat);
-# my $somend = pop(@sields);
-# my $somestart = pop(@sields);
-# my $somechr = pop(@sields);
-# $adjuster = "NA\t" x 26 ;
-# $simplified_microsat = join ("\t", @sields, $adjuster).$somechr."\t".$somestart."\t".$somend;
-# }
-#
- $registeredTrees{$tree_analysis} = 1 if !exists $registeredTrees{$tree_analysis};
- $registeredTrees{$tree_analysis}++ if exists $registeredTrees{$tree_analysis};
-
- if (exists $treesToIgnore{$tree_analysis}){
- my @appendarr = ();
-
-# print SUMMARY $Hchrom,"\t",$Hstart,"\t",$Hend,"\t",$locusmotif,"\t",$locusmotifsize,"\t", $thresharr[$locusmotifsize], "\t", $simplified_microsat,"\t", $tree_analysis,"\t", join("",@tags), "\t";
- #print "SUMMARY ",$Hchrom,"\t",$Hstart,"\t",$Hend,"\t",$locusmotif,"\t",$locusmotifsize,"\t", $thresharr[$locusmotifsize], "\t", $simplified_microsat,"\t", $tree_analysis,"\t", join("",@tags), "\t";
-# print SELECT $Hchrom,"\t",$Hstart,"\t",$Hend,"\t","NOEVENT", "\t\t", $cluster,"\n";
-
- foreach my $lnode (@$lagestnodes){
- my @pair = @$lnode;
- my @nodemutarr = ();
- for my $p (@pair){
- my @mutinfoarray1 = ();
- for (1 ... 38){
-# push (@mutinfoarray1, "NA")
- }
-# print SUMMARY join ("\t", @mutinfoarray1[0...($#mutinfoarray1)] ),"\t";
-# print join ("\t", @mutinfoarray1[0...($#mutinfoarray1)] ),"\t";
- }
-
- }
- for (1 ... 38){
- push (@appendarr, "NA")
- }
-# print SUMMARY join ("\t", @appendarr,"NULL", "NULL"),"\n";
-# print join ("\t", @appendarr,"NULL", "NULL"),"\n";
- # print "SUMMARY ",join ("\t", @appendarr,"NULL", "NULL"),"\n"; #;
- next;
- }
-# print colored ['blue'],"cluster = $cluster\n";
-
- my ($mutations_array, $nodes, $branches_hash, $alivehash, $primaryalignment) = peel_onion($tree, \%sequences, \%alignment, \@tags, \%microsathash, \%nonmicrosathash, $motif, $tree_analysis, $thresholdhash{length($motif)}, \%microsatstarts);
-
- if ($mutations_array eq "NULL"){
- # print "cluster = $cluster \n"; ;
- my @appendarr = ();
-
- # print SUMMARY $Hchrom,"\t",$Hstart,"\t",$Hend,"\t",$locusmotif,"\t",$locusmotifsize, "\t";
-
- # foreach my $lnode (@$lagestnodes){
- # my @pair = @$lnode;
- # my @nodemutarr = ();
- # for my $p (@pair){
- # my @mutinfoarray1 = ();
- # for (1 ... 38){
- # push (@mutinfoarray1, "NA")
- # }
- # print SUMMARY join ("\t", @mutinfoarray1[0...($#mutinfoarray1)] ),"\t";
- # print join ("\t", @mutinfoarray1[0...($#mutinfoarray1)] ),"\t";
- # }
- # }
- # for (1 ... 38){
- # push (@appendarr, "NA")
- # }
- # print SUMMARY join ("\t", @appendarr,"NULL", "NULL"),"\n";
- # print join ("\t", @appendarr,"NULL", "NULL"),"\n";
- # print join ("\t","SUMMARY", @appendarr,"NULL", "NULL"),"\n"; #;
- next;
- }
-
-
-# print "sent: \n" if $printer == 1;
-# print "nodes = @$nodes, branches array:\n" if $mutations_array ne "NULL" && $printer == 1;
-
- my ($newstatus, $newmutations_array, $newnodes, $newbranches_hash, $newalivehash, $finalalignment) = fillAlignmentGaps($tree, \%sequences, \%alignment, \@tags, \%microsathash, \%nonmicrosathash, $motif, $tree_analysis, $thresholdhash{length($motif)}, \%microsatstarts);
-# print "newmutations_array returned = \n",join("\n",@$newmutations_array),"\n" if $newmutations_array ne "NULL" && $printer == 1;
- my @finalmutations_array= ();
- @finalmutations_array = selectMutationArray($mutations_array, $newmutations_array, \@tags, $alivehash, \%alignment, $motif) if $newmutations_array ne "NULL";
- @finalmutations_array = selectMutationArray($mutations_array, $mutations_array, \@tags, $alivehash, \%alignment, $motif) if $newmutations_array eq "NULL";
-# print "alt = $alternate{$conformation}\n";
-
- my ($besttree, $treescore) = selectBetterTree($tree_analysis, $alternate{$conformation}, \@finalmutations_array);
- my $cleancase = "UNCLEAN";
- $cleancase = checkCleanCase($besttree, $finalalignment) if $treescore > 0 && $finalalignment ne "NULL" && $finalalignment =~ /\!/;
- $cleancase = checkCleanCase($besttree, $primaryalignment) if $treescore > 0 && $finalalignment eq "NULL" && $primaryalignment =~ /\!/ && $primaryalignment ne "NULL";
- $cleancase = "CLEAN" if $finalalignment eq "NULL" && $primaryalignment !~ /\!/ && $primaryalignment ne "NULL";
- $cleancase = "CLEAN" if $finalalignment ne "NULL" && $finalalignment !~ /\!/ ;
-# print "besttree = $besttree ... cleancase=$cleancase\n"; #;
-
- my @selects = ("-C","+C","-H","+H","-HC","+HC","-O","+O","-H.-C","-H.-O","-HC,+C","-HC,+H","-HC.-O","-HCO,+HC","-HCO,+O","-O.-C","-O.-H",
- "+C.+O","+H.+C","+H.+O","+HC,-C","+HC,-H","+HC.+O","+HCO,-C","+HCO,-H","+HCO,-HC","+HCO,-O","+O.+C","+O.+H","+H.+C.+O","-H.-C.-O","+HCO","-HCO");
- next if (oneOf(@selects, $besttree) == 0);
- if ( ($besttree =~ /,/ || $besttree =~ /\./) && $cleancase eq "UNCLEAN"){
- $besttree = "$besttree / $tree_analysis";
- }
-
- $besttree = "NULL" if $treescore <= 0;
-
- while ($besttree =~ /[A-Z][A-Z]/){
- $besttree =~ s/([A-Z])([A-Z])/$1:$2/g;
- }
-
- if ($besttree !~ /NULL/){
- my @elements = ($besttree =~ /([A-Z])/g);
-
- foreach my $ele (@elements){
-# print "replacing $ele with $backReplacementArrTag{$ele}\n";
- $besttree =~ s/$ele/$backReplacementArrTag{$ele}/g if exists $backReplacementArrTag{$ele};
- }
- }
- my $endendstate = $focalspec_orig.".".$Hchrom."\t".$Hstart."\t".$Hend."\t".$locusmotif."\t".$locusmotifsize."\t".$tree_analysis."\t";
- next if $endendstate =~ /NA\tNA\tNA/;
-
- print SUMMARY $focalspec_orig,".",$Hchrom,"\t",$Hstart,"\t",$Hend,"\t",$locusmotif,"\t",$locusmotifsize,"\t";
-# print "SUMMARY\t", $focalspec_orig,".",$Hchrom,"\t",$Hstart,"\t",$Hend,"\t",$locusmotif,"\t",$locusmotifsize,"\t",$tree_analysis,"\t" ;
-
- my @mutinfoarray =();
-
- foreach my $lnode (@$lagestnodes){
- my @pair = @$lnode;
- my $joint = "(".join(", ",@pair).")";
- my @nodemutarr = ();
-
- for my $p (@pair){
- foreach my $mut (@finalmutations_array){
- $mut =~ /node=([A-Z, \(\)]+)/;
- push @nodemutarr, $mut if $p eq $1;
- }
- @mutinfoarray = summarizeMutations(\@nodemutarr, $besttree);
-
- # print SUMMARY join ("\t", @mutinfoarray[0...($#mutinfoarray-1)] ),"\t";
- # print join ("\t", @mutinfoarray[0...($#mutinfoarray-1)] ),"\t";
- }
- }
-
-# print "G: $no_of_species\n";
-
- my @alignmentarr = ();
-
- foreach my $key (keys %alignment){
- push @alignmentarr, $backReplacementArrTag{$key}.":".$alignment{$key};
-
- }
-# print "alignmentarr = @alignmentarr"; ;
-
- @mutinfoarray = summarizeMutations(\@finalmutations_array, $besttree);
- print SUMMARY join ("\t", @mutinfoarray ),"\t";
- print SUMMARY join(",",@alignmentarr),"\n";
-# print join("\t","--------------","\n",$besttree, join("",@tags)),"\n" if scalar(@tags) < 5;
-# if scalar(@tags) < 5;
-# print $cleancase, "\n";
-# print join ("\t", @mutinfoarray,$cleancase,join(",",@alignmentarr)),"\n"; #;
-# print "summarized\n"; #;
-
-
-
- my %indelcatch = ();
- my %substcatch = ();
- my %typecatch = ();
- my %nodescatch = ();
- my $mutconcat = join("\t", @finalmutations_array)."\n";
- my %indelposcatch = ();
- my %subsposcatch = ();
-
- foreach my $fmut ( @finalmutations_array){
-# next if $fmut !~ /indeltype=[a-zA-Z]+/;
- #print RUN $fmut, "\n";
- $fmut =~ /node=([a-zA-Z, \(\)]+)/;
- my $lnode = $1;
- $nodescatch{$1}=1;
-
- if ($fmut =~ /type=substitution/){
- # print "fmut=$fmut\n";
- $fmut =~ /from=([a-zA-Z\-]+)\tto=([a-zA-Z\-]+)/;
- my $from=$1;
- # print "from=$from\n";
- my $to=$2;
- # print "to=$to\n";
- push @{$substcatch{$lnode}} , ("from:".$from." to:".$to);
- $fmut =~ /position=([0-9]+)/;
- push @{$subsposcatch{$lnode}}, $1;
- }
-
- if ($fmut =~ /insertion=[a-zA-Z\-]+/){
- $fmut =~ /insertion=([a-zA-Z\-]+)/;
- push @{$indelcatch{$lnode}} , $1;
- $fmut =~ /indeltype=([a-zA-Z]+)/;
- push @{$typecatch{$lnode}}, $1;
- $fmut =~ /position=([0-9]+)/;
- push @{$indelposcatch{$lnode}}, $1;
- }
- if ($fmut =~ /deletion=[a-zA-Z\-]+/){
- $fmut =~ /deletion=([a-zA-Z\-]+)/;
- push @{$indelcatch{$lnode}} , $1;
- $fmut =~ /indeltype=([a-zA-Z]+)/;
- push @{$typecatch{$lnode}}, $1;
- $fmut =~ /position=([0-9]+)/;
- push @{$indelposcatch{$lnode}}, $1;
- }
- }
-
- # print $simplified_microsat,"\t", $tree_analysis,"\t", join("",@tags), "\t" if $printer == 1;
- # print join ("<\t>", @mutinfoarray),"\n" if $printer == 1;
- # print "where mutinfoarray = @mutinfoarray\n" if $printer == 1;
- # #print RUN ".";
-
- # print colored ['red'], "-------------------------------------------------------------\n" if $printer == 1;
- # print colored ['red'], "-------------------------------------------------------------\n" if $printer == 1;
-
- # print colored ['red'],"finalmutations_array=\n" if $printer == 1;
-# foreach (@finalmutations_array) {
-# print colored ['red'], "$_\n" if $_ =~ /type=substitution/ && $printer == 1 ;
-# print colored ['yellow'], "$_\n" if $_ !~ /type=substitution/ && $printer == 1 ;
-
-# }# if $line =~ /cal/;# && $line =~ /chr4/;
-
-# print colored ['red'], "-------------------------------------------------------------\n" if $printer == 1;
-# print colored ['red'], "-------------------------------------------------------------\n" if $printer == 1;
-# print "tree analysis = $tree_analysis\n" if $printer == 1;
-
- # my $mutations = "@$mutations_array";
-
-
- next;
- for my $keys (@$nodes) {foreach my $key (@$keys){
- #print "key = $key, => $branches_hash->{$key}\n";
- }
- # print "x" x 50, "\n";
- }
- my ($birth_steps, $death_steps) = decipher_history($mutations_array,join("",@tags),$nodes,$branches_hash,$tree_analysis,$conformation, $alivehash, $simplified_microsat);
- }
- }
- close BO;
-# print "now studying where we lost microsatellites:\n";
-# print "x" x 60,"\n";
- for my $reason (0 ... $#nextcounter){
-# print $removalReasons[$reason]."\t".$nextcounter[$reason],"\n";
- }
-# print "x" x 60,"\n";
-# print "In total we read $microreadcounter microsatellites after reading through $contigsentered contigs\n";
-# print " we lost $keynotformedcounter contigs as they did not form the key, \n";
-# print "$contignotrightcounter contigs as they were not of the right species configuration\n";
-# print "$keynotfoundcounter contigs as they did not contain the microsats\n";
-# print "... In total we went through a file that had $dotcounter contigs...\n";
-# print join ("\n","remaining orth keys = ", (keys %orths),"");
-# print "------ ------ ------ ------ ------ ------ ------ ------ ------ ------ ------ \n";
-# print "now printing counted trees: \n";
- if (scalar(keys %registeredTrees) > 0){
- foreach my $keyb ( sort (keys %registeredTrees) )
- {
-# print "$keyb : $registeredTrees{$keyb}\n";
- }
- }
-
-
-}
-close SUMMARY;
-
-my @summarizarr = ("+C=+C +R.+C -HCOR,+C",
-"+H=+H +R.+H -HCOR,+H",
-"-C=-C -R.-C +HCOR,-C",
-"-H=-H -R.-H +HCOR,-H",
-"+HC=+HC",
-"-HC=-HC",
-"+O=+O -HCOR,+O",
-"-O=-O +HCOR,-O",
-"+HCO=+HCO",
-"-HCO=-HCO",
-"+R=+R +R.+C +R.+H",
-"-R=-R -R.-C -R.-H");
-
-foreach my $line (@summarizarr){
- next if $line !~ /[A-Za-z0-9]/;
-# print $line;
- chomp $line;
- my @fields = split(/=/,$line);
-# print "title = $fields[0]\n";
- my @parts=split(/ +/, $fields[1]);
- my %partshash = ();
- foreach my $part (@parts){$partshash{$part}=1;}
- my $count=0;
- foreach my $key ( sort keys %registeredTrees ){
- next if !exists $partshash{$key};
-# print "now adding $registeredTrees{$key} from $key\n";
- $count+=$registeredTrees{$key};
- }
-# print "$fields[0] : $count\n";
-}
-my $rootdir = $dir;
-$rootdir =~ s/\/[A-Za-z0-9\-_]+$//;
-chdir $rootdir;
-remove_tree($dir);
-
-
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-sub largest_number{
- my $counter = 0;
- my($max) = shift(@_);
- foreach my $temp (@_) {
-
- #print "finding largest array: $maxcounter \n";
- if($temp > $max){
- $max = $temp;
- }
- }
- return($max);
-}
-
-sub smallest_number{
- my $counter = 0;
- my($min) = shift(@_);
- foreach my $temp (@_) {
- #print "finding largest array: $maxcounter \n";
- if($temp < $min){
- $min = $temp;
- }
- }
- return($min);
-}
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-sub baseml_parser{
- my $outputfile = $_[0];
- open(BOUT,"<$outputfile") or die "Cannot open output of upstream baseml $outputfile: $!";
- my @info = ();
- my @branchields = ();
- my @distanceields = ();
- my @bout = ;
- #print colored ['red'], @bout ,"\n";
- for my $b (0 ... $#bout){
- my $bine=$bout[$b];
- #print colored ['yellow'], "sentence = ",$bine;
- if ($bine =~ /TREE/){
- $bine=$bout[$b++];
- $bine=$bout[$b++];
- $bine=$bout[$b++];
- #print "FOUND",$bine;
- chomp $bine;
- $bine =~ s/^\s+//g;
- @branchields = split(/\s+/,$bine);
- $bine=$bout[$b++];
- chomp $bine;
- $bine =~ s/^\s+//g;
- @distanceields = split(/\s+/,$bine);
- #print "LASTING..............\n";
- last;
- }
- else{
- }
- }
-
- close BOUT;
-# print "branchfields = @branchields and distanceields = @distanceields\n" if $printer == 1;
- my %distance_hash=();
- for my $d (0 ... $#branchields){
- $distance_hash{$branchields[$d]} = $distanceields[$d];
- }
-
- $info[0] = $distance_hash{"9..1"} + $distance_hash{"9..2"};
- $info[1] = $distance_hash{"9..1"} + $distance_hash{"8..9"}+ $distance_hash{"8..3"};
- $info[2] = $distance_hash{"9..1"} + $distance_hash{"8..9"}+$distance_hash{"7..8"}+$distance_hash{"7..4"};
- $info[3] = $distance_hash{"9..1"} + $distance_hash{"8..9"}+$distance_hash{"7..8"}+$distance_hash{"6..7"}+$distance_hash{"6..5"};
-
-# print "\nsending back: @info\n" if $printer == 1;
-
- return join("\t",@info);
-
-}
-
-
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-sub test_complexity{
- my $printer = 0;
- my $sequence = $_[0];
- #print "sequence = $sequence\n";
- my $COMPLEXITY_SUPPORT = $_[1];
- my $complexity=int($COMPLEXITY_SUPPORT * (1/40)); #1 THIS IS AN ARBITRARY THRESHOLD SET FOR LOW COMPLEXITY.
- #2 THE INSPIRATION WAS WEB MILLER'S MAIL SENT ON
- #3 19 Apr 2008 WHERE HE CLASSED AS HIGH COMPLEXITY
- #4 REGION, IF 40 BP OF SEQUENCE HAS AT LEAST 3 OF
- #5 EACH NUCLEOTIDE. HENCE, I NORMALIZE THIS PARAMETER
- #6 FOR THE ACTUAL LENGTH OF $FLANK_SUPPORT SET BY
- #7 THE USER.
- #8 WEB MILLER SENT THE MAIL TO YDK104@PSU.EDU
-
-
-
- my $As = ($sequence=~ s/A/A/gi);
- my $Ts = ($sequence=~ s/T/T/gi);
- my $Gs = ($sequence=~ s/G/G/gi);
- my $Cs = ($sequence=~ s/C/C/gi);
- my $dashes = ($sequence=~ s/\-/-/gi);
- $dashes = 0 if $sequence !~ /\-/;
-# print "seq = $sequence, As=$As, Ts=$Ts, Gs=$Gs, Cs=$Cs, dashes=$dashes\n";
- return "LOW" if $dashes > length($sequence)/2;
-
- my $ans = ();
-
- return "HIGH" if $As >= $complexity && $Ts >= $complexity && $Cs >= $complexity && $Gs >= $complexity;
-
- my @nts = ("A","T","G","C","-");
-
- my $lowcomplex = 0;
-
- foreach my $nt (@nts){
- $lowcomplex =1 if $sequence =~ /(($nt\-*){$mono_flanksimplicityRepno,})/i;
- $lowcomplex =1 if $sequence =~ /(($nt[A-Za-z]){$di_flanksimplicityRepno,})/i;
- $lowcomplex =1 if $sequence =~ /(([A-Za-z]$nt){$di_flanksimplicityRepno,})/i;
- my $nont = ($sequence=~ s/$nt/$nt/gi);
- $lowcomplex = 1 if $nont > (length($sequence) * $prop_of_seq_allowedtoAT) && ($nt =~ /[AT\-]/);
- $lowcomplex = 1 if $nont > (length($sequence) * $prop_of_seq_allowedtoCG) && ($nt =~ /[CG]/);
- }
-# print "leaving for now.. $sequence\n" if $printer == 1 && $lowcomplex == 0;
- #;
- return "HIGH" if $lowcomplex == 0;
- return "LOW" ;
-}
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-sub sequence_similarity{
- my $printer = 0;
- my @seq1 = split(/\s*/, $_[0]);
- my @seq2 = split(/\s*/, $_[1]);
- my $similarity_thresh = $_[2];
- my $info = $_[3];
-# print "input = @_\n" if $printer == 1;
- my $seq1str = $_[0];
- my $seq2str = $_[1];
- $seq1str=~s/\-//g; $seq2str=~s/\-//g;
- my $similarity=0;
-
- my $nucdiffs=0;
- my $nucsims=0;
- my $indeldiffs=0;
-
- for my $i (0...$#seq1){
- $similarity++ if $seq1[$i] =~ /$seq2[$i]/i ; #|| $seq1[$i] =~ /\-/i || $seq2[$i] =~ /\-/i ;
- $nucsims++ if $seq1[$i] =~ /$seq2[$i]/i && ($seq1[$i] =~ /[a-zA-Z]/i && $seq2[$i] =~ /[a-zA-Z]/i);
- $nucdiffs++ if $seq1[$i] !~ /$seq2[$i]/i && ($seq1[$i] =~ /[a-zA-Z]/i && $seq2[$i] =~ /[a-zA-Z]/i);
- $indeldiffs++ if $seq1[$i] !~ /$seq2[$i]/i && $seq1[$i] =~ /\-/i || $seq2[$i] =~ /\-/i;
- }
- my $sim = $similarity/length($_[0]);
- return ( $sim, $nucdiffs, $indeldiffs ); #<= $similarity_thresh;
-}
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-
-sub load_treesToReject{
- my @rejectlist = ();
- my $alltags = join("",@_);
- @rejectlist = qw (-HCOR +HCOR) if $alltags eq "HCORM";
- @rejectlist = qw ( -HCO|+R +HCO|-R) if $alltags eq "HCOR";
- @rejectlist = qw ( -HC|+O +HC|-O) if $alltags eq "HCO";
-
- %treesToReject=();
- $treesToReject{$_} = $_ foreach (@rejectlist);
- #print "loaded to reject for $alltags; ", $treesToReject{$_},"\n" foreach (@rejectlist); #;
-}
-#--------------------------------------------------------------------------------------------------------
-sub load_treesToIgnore{
- my @rejectlist = ();
- my $alltags = join("",@_);
- @rejectlist = qw (-HCOR +HCOR +HCORM -HCORM) if $alltags eq "HCORM";
- @rejectlist = qw ( -HCO|+R +HCO|-R +HCOR -HCOR) if $alltags eq "HCOR";
- @rejectlist = qw ( -HC|+O +HC|-O +HCO -HCO) if $alltags eq "HCO";
-
- %treesToIgnore=();
- $treesToIgnore{$_} = $_ foreach (@rejectlist);
- #print "loaded ", $treesToIgnore{$_},"\n" foreach (@rejectlist);
-}
-#--------------------------------------------------------------------------------------------------------
-sub load_thresholds{
- my @threshold_array=split(/[,_]/,$_[0]);
- unshift @threshold_array, "0";
- for my $size (1 ... 4){
- $thresholdhash{$size}=$threshold_array[$size];
- }
-}
-#--------------------------------------------------------------------------------------------------------
-sub load_allPossibleTrees{
- #1 THIS FILE STORES ALL POSSIBLE SCENARIOS OF MICROSATELLITE
- #2 BIRTH AND DEATH EVENTS ON A 5-PRIMATE TREE OF H,C,O,R,M
- #3 IN FORM OF A TEXT FILE. THIS WILL BE USED AS A TEMPLET
- #4 TO COMPARE EACH MICROSATELLITE CLUSTER TO UNDERSTAND THE
- #5 EVOLUTION OF EACH LOCUS. WE WILL THEN DISCARD SOME
- #6 MICROSATS ACCRODING TO THEIR EVOLUTIONARY BEHAVIOUR ON
- #7 THE TREE. MOST PROBABLY WE WILL REMOVE THOSE MICROSATS
- #8 THAT ARE NOT SUFFICIENTLY INFORMATIVE, LIKE IN CASE OF
- #9 AN OUTGROUP MICROSATELLITE BEING DIFFERENT FRON ALL OTHER
- #10 SPECIES IN THE TREE.
- my $tree_list = $_[0];
-# print "file to be loaded: $tree_list\n";
-
- my @trarr = ();
- @trarr = ("#H C O CONCLUSION ALTERNATE",
-"+ + + +HCO NA",
-"+ _ _ +H NA",
-"_ + _ +C NA",
-"_ _ + -HC|+O NA",
-"+ _ + -C +H",
-"_ + + -H +C",
-"+ + _ +HC|-O NA",
-"_ _ _ -HCO NA") if $tree_list =~ /_HCO\.txt/;
- @trarr = ("#H C O R CONCLUSION ALTERNATE",
-"_ _ _ _ -HCOR NA",
-"+ + + + +HCOR NA",
-"+ + + _ +HCO|-R +H.+C.+O",
-"+ + _ _ +HC +H.+C;-O",
-"+ _ _ _ +H +HC,-C;+HC,-C",
-"_ + _ _ +C +HC,-H;+HC,-H",
-"_ _ + _ +O -HC|-H.-C",
-"_ _ + + -HC -H.-C",
-"+ _ _ + +H|-C.-O +HC,-C",
-"_ + _ + +C -H.-O",
-"_ + + _ -H +C.+O",
-"_ _ _ + -HCO|+R NA",
-"+ _ + _ +H.+O|-C NA",
-"_ + + + -H -HC,+C",
-"+ _ + + -C -HC,+H",
-"+ + _ + -O +HC") if $tree_list =~ /_HCOR\.txt/;
-
- @trarr = ("#H C O R M CONCLUSION ALTERNATE",
-"+ + _ + + -O -HCO,+HC|-HCO,+HC;-HCO,(+H.+C)",
-"+ _ + + + -C -HC,+H;+HCO,(+H.+O)",
-"_ + + + + -H -HC,+C;-HCO,(+C.+O)",
-"_ _ + _ _ +O +HCO,-HC;+HCO,(-H.-C)",
-"_ + _ _ _ +C +HC,-H;+HCO,(-H.-O)",
-"+ _ _ _ _ +H +HC,-C;+HCO,(-C.-O)",
-"+ + + _ _ +HCO +H.+C.+O",
-"_ _ _ + + -HCO -HC.-O;-H.-C.-O",
-"+ _ _ + + -O.-C|-HCO,+H +R.+H;-HCO,(+R.+H)",
-"_ + _ + + -O.-H|-HCO,+C +R.+C;-HCO,(+R.+C)",
-"_ + + _ _ +HCO,-H|+O.+C NA",
-"+ _ + _ _ +HCO,-C|+O.+H NA",
-"_ _ + + + -HC -H.-C|-HCO,+O",
-"+ + _ _ _ +HC +H.+C|+HCO,-O|-HCO,+HC;-HCO,(+H.+C)",
-"+ + + + + +HCORM NA",
-"_ _ + _ + DISCARD +O;+HCO,-HC;+HCO,(-H.-C)",
-"_ + _ _ + +C +HC,-H;+HCO,(-H.-O)",
-"+ _ _ _ + +H +HC,-C;+HCO,(-C.-O)",
-"+ + _ _ + +HC -R.-O|+HCO,-O|+H.+C;-HCO,+HC;-HCO,(+H.+C)",
-"+ _ + _ + DISCARD -R.-C|+HCO,-C|+H.+O NA",
-"_ + + _ + DISCARD -R.-H|+HCO,-H|+C.+O NA",
-"_ _ _ _ + DISCARD -HCOR NA",
-"_ _ _ + _ DISCARD +R;-HC.-O;-H.-C.-O",
-"+ + _ + _ -O +R.+HC|-HCO,+HC;+H.+C.+R|-HCO,(+H.+C)",
-"+ + + + _ +HCOR NA",
-"+ + + _ + DISCARD -R;+HCO;+HC.+O;+H.+C.+O",
-"+ _ + + _ -C -HC,+H;+H.+O.+R|-HCO,(+H.+O)",
-"_ + + + _ -H -HC,+C;+C.+O.+R|-HCO,(+C.+O)",
-"_ _ + + _ -HC +R.+O|-HCO,+O|+HCO,-HC",
-"_ + _ + _ +C +R.+C|-HCO,+C|-HC,+C +HCO,(-H.-O)",
-"+ _ _ + _ +H +R.+H|-C.-O +HCO,(-C.-O)"
-) if $tree_list =~ /_HCORM\.txt/;
-
-
- my $template_p = $_[1];
- my $alternate_p = $_[2];
- #1 THIS IS THE HASH IN WHICH INFORMATION FROM THE ABOVE FILE
- #2 GETS STORED, USING THE WHILE LOOP BELOW. HERE, THE KEY
- #3 OF EACH ROW IS THE EVOLUTIONARY CONFIGURATION OF A LOCUS
- #4 ON THE PRIMATE TREE, BASED ON PRESENCE/ABSENCE OF A MICROSAT
- #5 AT THAT LOCUS, LIKE SAY "+ + + _ _" .. EACH COLUMN BELONGS
- #6 TO ONE SPECIES; HERE THE COLUMN NAMES ARE "H C O R M".
- #7 THE VALUE FOR EACH ENTRY IS THE MEANING OF THE ABOVE
- #8 CONFIGURATION (I.E., CONFIGURAION OF THE KEY. HERE, THE
- #9 VALUE WILL BE +HCO, SIGNIFYING A BIRTH IN HUMAN-CHIMP-ORANG
- #10 COMMON ANCESTOR. THIS HASH HAS BEEN LOADED HERE TO BE USED
- #11 LATER BY THE SUBROUTINE sub treeStudy{} THAT STUDIES
- #12 EVOLUTIONARY CONFIGURAION OF EACH MICROSAT LOCUS, AS
- #13 MENTIONED ABOVE.
- my @keys_array=();
- foreach my $line (@trarr){
-# print $line,"\n";
- next if $line =~ /^#/;
- chomp $line;
- my @fields = split("\t", $line);
- push @keys_array, $fields[0];
-# print "loading: $fields[0]\n";
- $template_p->{$fields[0]}[0] = $fields[1];
- $template_p->{$fields[0]}[1] = 0;
- $alternate_p->{$fields[0]} = $fields[2];
-# $alternate_p->{$fields[1]} = $fields[2];
-# print "loading alternate_p $fields[1] $fields[2]\n"; # if $fields[1] eq "+H";
- }
-# print "loaded the trees with keys: @keys_array\n";
- return $template_p, \@keys_array, $alternate_p;
-}
-
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-sub checkCleanCase{
- my $printer = 0;
- my $tree = $_[0];
- my $finalalignment = $_[1];
-
- #print "IN checkCleanCase: @_\n";
- #;
- my @indivspecies = $tree =~ /[A-Z]/g;
- $finalalignment =~ s/\./_/g;
- my @captured = $finalalignment =~ /[A-Za-z, \(\):]+\![:A-Za-z, \(\)]/g;
-
- my $unclean = 0;
-
- foreach my $sp (@indivspecies){
- foreach my $cap (@captured){
- $cap =~ s/:[A-Za-z\-]+//g;
- my @sps = $cap =~ /[A-Z]+/g;
- my $spsc = join("", @sps);
-# print "checking whether imp species $sp is present in $cap i.e, in $spsc\n " if $printer == 1;
- if ($spsc =~ /$sp/){
-# print "foind : $sp\n";
- $unclean = 1; last;
- }
- }
- last if $unclean == 1;
- }
- #;
- return "CLEAN" if $unclean == 0;
- return "UNCLEAN";
-}
-
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-#--------------------------------------------------------------------------------------------------------
-
-
-sub adjustCoordinates{
- my $line = $_[0];
- return 0 if !defined $line;
- #print "------x------x------x------x------x------x------x------x------\n";
- #print $line,"\n\n";
- 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;
- #print $line,"\n";
- #print "------x------x------x------x------x------x------x------x------\n\n\n";
-# my @got = ($line =~ s/(chr[0-9a-zA-Z]+)|(Contig[0-9a-zA-Z\._\-]+)/x/g);
-# print "line = $line\n";
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $motifcord = 2 + (4*$no_of_species) + 2 - 1;
- $gapcord = $motifcord+1;
- $startcord = $gapcord+1;
- $strandcord = $startcord+1;
- $endcord = $strandcord + 1;
- $microsatcord = $endcord + 1;
- $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
- $interr_poscord = $microsatcord + 3;
- $no_of_interruptionscord = $microsatcord + 4;
- $interrcord = $microsatcord + 2;
-# print "$line\n startcord = $startcord, and endcord = $endcord and no_of_species = $no_of_species\n" if $line !~ /calJac/i;
-
- return $no_of_species;
-}
-
-
-sub printhash{
- my $alivehash = $_[0];
- my @tags = @$_[1];
-# print "print hash\n";
- foreach my $tag (@tags){
-# print "$tag=",$alivehash->{$tag},"\n" if exists $alivehash->{$tag};
- }
-
- return "\n"
-}
-sub peel_onion{
- my $printer = 0;
-# print "received: @_\n" ; #;
- $printer = 0;
- my ($tree, $sequences, $alignment, $tagarray, $microsathash, $nonmicrosathash, $motif, $tree_analysis, $threshold, $microsatstarts) = @_;
-# print "in peel onion.. tree = $tree \n" if $printer == 1;
- my %sequence_hash=();
-
-
-# for my $i (0 ... $#sequences){ $sequence_hash{$species[$i]}=$sequences->[$i]; }
-
-
- my %node_sequences=();
-
- my %node_alignments = (); #NEW, Nov 28 2008
- my @tags=();
- my @locus_sequences=();
- my %alivehash=();
- foreach my $tag (@$tagarray) {
- #print "adding: $tag\n";
- push(@tags, $tag);
- $node_sequences{$tag}=join ".",split(/\s*/,$microsathash->{$tag}) if $microsathash->{$tag} ne "NULL";
- $alivehash{$tag}= $tag if $microsathash->{$tag} ne "NULL";
- $node_sequences{$tag}=join ".",split(/\s*/,$nonmicrosathash->{$tag}) if $microsathash->{$tag} eq "NULL";
- $node_alignments{$tag}=join ".",split(/\s*/,$alignment->{$tag}) ;
- push @locus_sequences, $node_sequences{$tag};
-# print "adding to node_seq: $tag = ",$node_alignments{$tag},"\n";
- }
-
- #;
-
- my ($nodes_arr, $branches_hash) = get_nodes($tree);
- my @nodes=@$nodes_arr;
-# print "recieved nodes = " if $printer == 1;
-# foreach my $key (@nodes) {print "@$key " if $printer == 1;}
-
-# print "\n" if $printer == 1;
-
- #POPULATE branches_hash WITH INFORMATION ABOUT LIVESTATUS
- foreach my $keys (@nodes){
- my @pair = @$keys;
- my $joint = "(".join(", ",@pair).")";
- my $copykey = join "", @pair;
- $copykey =~ s/[\W ]+//g;
-# print "for node: $keys, copykey = $copykey and joint = $joint\n" if $printer == 1;
- my $livestatus = 1;
- foreach my $copy (split(/\s*/,$copykey)){
- $livestatus = 0 if !exists $alivehash{$copy};
- }
- $alivehash{$joint} = $joint if !exists $alivehash{$joint} && $livestatus == 1;
-# print "alivehash = $alivehash{$joint}\n" if exists $alivehash{$joint} && $printer == 1;
- }
-
- @nodes = reverse(@nodes); #1 THIS IS IN ORDER TO GO THROUGH THE TREE FROM LEAVES TO ROOT.
-
- my @mutations_array=();
-
- my $joint = ();
- foreach my $node (@nodes){
- my @pair = @$node;
-# print "now in the nodes for loop, pair = @pair\n and sequences=\n" if $printer == 1;
- $joint = "(".join(", ",@pair).")";
- my @pair_sequences=();
-
- foreach my $tag (@pair){
-# print "$tag: $node_alignments{$tag}\n" if $printer == 1;
-# print $node_alignments{$tag},"\n" if $printer == 1;
- push @pair_sequences, $node_alignments{$tag};
- }
-# print "ppeel onion joint = $joint , pair_sequences=>@pair_sequences< , pair=>@pair<\n" if $printer == 1;
-
- my ($compared, $substitutions_list) = base_by_base_simple($motif,\@pair_sequences, scalar(@pair_sequences), @pair, $joint);
- $node_alignments{$joint}=$compared;
- push( @mutations_array,split(/:/,$substitutions_list));
-# print "newly added to node_sequences: $node_alignments{$joint} and list of mutations =\n", join("\n",@mutations_array),"\n" if $printer == 1;
- }
-
-
- my $analayzed_mutations = analyze_mutations(\@mutations_array, \@nodes, $branches_hash, $alignment, \@tags, \%alivehash, \%node_sequences, $microsatstarts, $motif);
-
- return ($analayzed_mutations, \@nodes, $branches_hash, \%alivehash, $node_alignments{$joint}) if scalar @mutations_array > 0;
- return ("NULL",\@nodes,$branches_hash, \%alivehash, "NULL") if scalar @mutations_array == 0;
-}
-
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-
-sub get_nodes{
- my $printer = 0;
-
- my $tree=$_[0];
- #$tree =~ s/ +//g;
- $tree =~ s/\t+//g;
- $tree=~s/;//g;
-# print "tree=$tree\n" if $printer == 1;
- my @nodes = ();
- my @onions=($tree);
- my %branches=();
- foreach my $bite (@onions){
- $bite=~ s/^\(|\)$//g;
- chomp $bite;
-# print "tree = $bite \n";
-# ;
- $bite=~ /([ ,\(\)A-Z]+)\,\s*([ ,\(\)A-Z]+)/;
- #$tree =~ /(\(\(\(H, C\), O\), R\))\, (M)/;
- my @raw_nodes = ($1, $2);
-# print "raw nodes = $1 and $2\n" if $printer == 1;
- push(@nodes, [@raw_nodes]);
- foreach my $node (@raw_nodes) {push (@onions, $node) if $node =~ /,/;}
- foreach my $node (@raw_nodes) {$branches{$node}="(".$bite.")"; }
-# print "onions = @onions\n" if $printer == 1; if $printer == 1;
- }
- $printer = 0;
- return \@nodes, \%branches;
-}
-
-
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-sub analyze_mutations{
- my ($mutations_array, $nodes, $branches_hash, $alignment, $tags, $alivehash, $node_sequences, $microsatstarts, $motif) = @_;
- my $locuslength = length($alignment->{$tags->[0]});
- my $printer = 0;
-
-
-# print " IN analyzed_mutations....\n" if $printer == 1; # \n mutations array = @$mutations_array, \nAND locuslength = $locuslength\n" if $printer == 1;
- my %mutation_hash=();
- my %froms_megahash=();
- my %tos_megahash=();
- my %position_hash=();
- my @solutions_array=();
- foreach my $mutation (@$mutations_array){
-# print "loadin mutation: $mutation\n" if $printer == 1;
- my %localhash= $mutation =~ /([\S ]+)=([\S ]+)/g;
- $mutation_hash{$localhash{"position"}} = {%localhash};
- push @{$position_hash{$localhash{"position"}}},$localhash{"node"};
-# print "feeding position hash with $localhash{position}: $position_hash{$localhash{position}}[0]\n" if $printer == 1;
- $froms_megahash{$localhash{"position"}}{$localhash{"node"}}=$localhash{"from"};
- $tos_megahash{$localhash{"position"}}{$localhash{"node"}}=$localhash{"to"};
-# print "just a trial: $mutation_hash{$localhash{position}}{position}\n" if $printer == 1;
-# print "loadin in tos_megahash: $localhash{position} {$localhash{node} = $localhash{to}\n" if $printer == 1;
-# print "loadin in from: $localhash{position} {$localhash{node} = $localhash{from}\n" if $printer == 1;
- }
-
-# print "now going through each position in loculength:\n" if $printer == 1;
- ## if $printer == 1;
-
- for my $pos (0 ... $locuslength-1){
-# print "at position: $pos\n" if $printer == 1;
-
- if (exists($mutation_hash{$pos})){
- my @local_nodes=@{$position_hash{$pos}};
-# print "found mutation: @{$position_hash{$pos}} : @local_nodes\n" if $printer == 1;
-
- foreach my $local_node (@local_nodes){
-# print "at local node: $local_node ... from state = $froms_megahash{$pos}{$local_node}\n" if $printer == 1;
- my $open_insertion=();
- my $open_deletion=();
- my $open_to_substitution=();
- my $open_from_substitution=();
- if ($froms_megahash{$pos}{$local_node} eq "-"){
- # print "here exists a microsatellite from $local_node to $branches_hash->{$local_node}\n" if $printer == 1 && exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};;
- # print "for localnode $local_node, amd the realated branches_hash:$branches_hash->{$local_node}, nexting as exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}}\n" if exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}} && $printer == 1;
- #next if exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};
- $open_insertion=$tos_megahash{$pos}{$local_node};
- for my $posnext ($pos+1 ... $locuslength-1){
-# print "in first if .... studying posnext: $posnext\n" if $printer == 1;
- last if !exists ($froms_megahash{$posnext}{$local_node});
-# print "for posnext: $posnext, there exists $froms_megahash{$posnext}{$local_node}.. already, open_insertion = $open_insertion.. checking is $froms_megahash{$posnext}{$local_node} matters\n" if $printer == 1;
- $open_insertion = $open_insertion.$tos_megahash{$posnext}{$local_node} if $froms_megahash{$posnext}{$local_node} eq "-";
-# print "now open_insertion=$open_insertion\n" if $printer == 1;
- delete $mutation_hash{$posnext} if $froms_megahash{$posnext}{$local_node} eq "-";
- }
-# print "1 Feeding in: ", join("\t", "node=$local_node","type=insertion" ,"position=$pos", "from=", "to=", "insertion=$open_insertion", "deletion="),"\n" if $printer == 1;
- push (@solutions_array, join("\t", "node=$local_node","type=insertion" ,"position=$pos", "from=", "to=", "insertion=$open_insertion", "deletion="));
- }
- elsif ($tos_megahash{$pos}{$local_node} eq "-"){
- # print "here exists a microsatellite to $local_node from $branches_hash->{$local_node}\n" if $printer == 1 && exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};;
- # print "for localnode $local_node, amd the realated branches_hash:$branches_hash->{$local_node}, nexting as exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}}\n" if exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};
- #next if exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};
- $open_deletion=$froms_megahash{$pos}{$local_node};
- for my $posnext ($pos+1 ... $locuslength-1){
-# print "in 1st elsif studying posnext: $posnext\n" if $printer == 1;
-# print "nexting as nextpos does not exist\n" if !exists ($tos_megahash{$posnext}{$local_node}) && $printer == 1;
- last if !exists ($tos_megahash{$posnext}{$local_node});
-# print "for posnext: $posnext, there exists $tos_megahash{$posnext}{$local_node}\n" if $printer == 1;
- $open_deletion = $open_deletion.$froms_megahash{$posnext}{$local_node} if $tos_megahash{$posnext}{$local_node} eq "-";
- delete $mutation_hash{$posnext} if $tos_megahash{$posnext}{$local_node} eq "-";
- }
-# print "2 Feeding in:", join("\t", "node=$local_node","type=deletion" ,"position=$pos", "from=", "to=", "insertion=", "deletion=$open_deletion"), "\n" if $printer == 1;
- push (@solutions_array, join("\t", "node=$local_node","type=deletion" ,"position=$pos", "from=", "to=", "insertion=", "deletion=$open_deletion"));
- }
- elsif ($tos_megahash{$pos}{$local_node} ne "-"){
- # print "here exists a microsatellite from $local_node to $branches_hash->{$local_node}\n" if $printer == 1 && exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};;
- # print "for localnode $local_node, amd the realated branches_hash:$branches_hash->{$local_node}, nexting as exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}}\n" if exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};
- #next if exists $alivehash->{$local_node} && exists $alivehash->{$branches_hash->{$local_node}};
- # print "microsatstart = $microsatstarts->{$local_node} \n" if exists $microsatstarts->{$local_node} && $pos < $microsatstarts->{$local_node} && $printer == 1;
- next if exists $microsatstarts->{$local_node} && $pos < $microsatstarts->{$local_node};
- $open_to_substitution=$tos_megahash{$pos}{$local_node};
- $open_from_substitution=$froms_megahash{$pos}{$local_node};
-# print "open from substitution: $open_from_substitution \n" if $printer == 1;
- for my $posnext ($pos+1 ... $locuslength-1){
- #print "in last elsif studying posnext: $posnext\n";
- last if !exists ($tos_megahash{$posnext}{$local_node});
-# print "for posnext: $posnext, there exists $tos_megahash{$posnext}{$local_node}\n" if $printer == 1;
- $open_to_substitution = $open_to_substitution.$tos_megahash{$posnext}{$local_node} if $tos_megahash{$posnext}{$local_node} ne "-";
- $open_from_substitution = $open_from_substitution.$froms_megahash{$posnext}{$local_node} if $tos_megahash{$posnext}{$local_node} ne "-";
- delete $mutation_hash{$posnext} if $tos_megahash{$posnext}{$local_node} ne "-" && $froms_megahash{$posnext}{$local_node} ;
- }
-# print "open from substitution: $open_from_substitution \n" if $printer == 1;
-
- #IS THE STRETCH OF SUBSTITUTION MICROSATELLITE-LIKE?
- my @motif_parts=split(/\s*/,$motif);
- #GENERATING THE FLEXIBLE LEFT END
- my $left_query=();
- for my $k (1 ... $#motif_parts) {
- $left_query= $motif_parts[$k]."|)";
- $left_query="(".$left_query;
- }
- $left_query=$left_query."?";
-# print "left_quewry = $left_query\n" if $printer == 1;
- #GENERATING THE FLEXIBLE RIGHT END
- my $right_query=();
- for my $k (0 ... ($#motif_parts-1)) {
- $right_query= "(|".$motif_parts[$k];
- $right_query=$right_query.")";
- }
- $right_query=$right_query."?";
-# print "right_query = $right_query\n" if $printer == 1;
-# print "Hence, searching for: ^$left_query($motif)+$right_query\$\n" if $printer == 1;
-
- my $motifcomb=$motif x 50;
-# print "motifcomb = $motifcomb\n" if $printer == 1;
- if ( ($motifcomb =~/$open_to_substitution/i) && (length ($open_to_substitution) >= length($motif)) ){
-# print "sequence microsat-like\n" if $printer == 1;
- my $all_microsat_like = 0;
-# print "3 feeding in: ", join("\t", "node=$local_node","type=deletion" ,"position=$pos", "from=", "to=", "insertion=", "deletion=$open_from_substitution"), "\n" if $printer == 1;
- push (@solutions_array, join("\t", "node=$local_node","type=deletion" ,"position=$pos", "from=", "to=", "insertion=", "deletion=$open_from_substitution"));
-# print "4 feeding in: ", join("\t", "node=$local_node","type=insertion" ,"position=$pos", "from=", "to=", "insertion=$open_to_substitution", "deletion="), "\n" if $printer == 1;
- push (@solutions_array, join("\t", "node=$local_node","type=insertion" ,"position=$pos", "from=", "to=", "insertion=$open_to_substitution", "deletion="));
-
- }
- else{
-# print "5 feeding in: ", join("\t", "node=$local_node","type=substitution" ,"position=$pos", "from=$open_from_substitution", "to=$open_to_substitution", "insertion=", "deletion="), "\n" if $printer == 1;
- push (@solutions_array, join("\t", "node=$local_node","type=substitution" ,"position=$pos", "from=$open_from_substitution", "to=$open_to_substitution", "insertion=", "deletion="));
- }
- #IS THE FROM-SEQUENCE MICROSATELLITE-LIKE?
-
- }
- # if $printer ==1;
- }
- # if $printer ==1;
- }
- }
-# print "\n", "#" x 50, "\n" if $printer == 1;
- foreach my $tag (@$tags){
-# print "$tag: $alignment->{$tag}\n" if $printer == 1;
- }
-# print "\n", "#" x 50, "\n" if $printer == 1;
-# print "returning SOLUTIONS ARRAY : \n",join("\n", @solutions_array),"\n" if $printer == 1;
- #print "end\n";
- # if
- return \@solutions_array;
-}
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#+++++++++++#
-
-sub base_by_base_simple{
- my $printer = 0;
- my ($motif, $locus, $no, $pair0, $pair1, $joint) = @_;
- my @seq_array=();
-# print "IN SUBROUTUNE base_by_base_simple.. information received = @_\n" if $printer == 1;
-# print "pair0 = $pair0 and pair1 = $pair1\n" if $printer == 1;
-
- my @example=split(/\./,$locus->[0]);
-# print "example, for length = @example\n" if $printer == 1;
- for my $i (0...$no-1){push(@seq_array, [split(/\./,$locus->[$i])]); }
-
- my @compared_sequence=();
- my @substitutions_list;
- for my $i (0...scalar(@example)-1){
-
- #print "i = $i\n" if $printer == 1;
- #print "comparing $seq_array[0][$i] and $seq_array[1][$i] \n" ;#if $printer == 1;
- if ($seq_array[0][$i] =~ /!/ && $seq_array[1][$i] !~ /!/){
-
- my $resolution= resolve_base($seq_array[0][$i],$seq_array[1][$i], $pair1 ,"keep" );
- # print "ancestral = $resolution\n" if $printer == 1;
-
- if ($resolution =~ /$seq_array[1][$i]/i && $resolution !~ /!/){
- push @substitutions_list, add_mutation($i, $pair0, $seq_array[0][$i], $resolution );
- }
- elsif ( $resolution !~ /!/){
- push @substitutions_list, add_mutation($i, $pair1, $seq_array[1][$i], $resolution);
- }
- push @compared_sequence,$resolution;
- }
- elsif ($seq_array[0][$i] !~ /!/ && $seq_array[1][$i] =~ /!/){
-
- my $resolution= resolve_base($seq_array[1][$i],$seq_array[0][$i], $pair0, "invert" );
- # print "ancestral = $resolution\n" if $printer == 1;
-
- if ($resolution =~ /$seq_array[0][$i]/i && $resolution !~ /!/){
- push @substitutions_list, add_mutation($i, $pair1, $seq_array[1][$i], $resolution);
- }
- elsif ( $resolution !~ /!/){
- push @substitutions_list, add_mutation($i, $pair0, $seq_array[0][$i], $resolution);
- }
- push @compared_sequence,$resolution;
- }
- elsif($seq_array[0][$i] =~ /!/ && $seq_array[1][$i] =~ /!/){
- push @compared_sequence, add_bases($seq_array[0][$i],$seq_array[1][$i], $pair0, $pair1, $joint );
- }
- else{
- if($seq_array[0][$i] !~ /^$seq_array[1][$i]$/i){
- push @compared_sequence, $pair0.":".$seq_array[0][$i]."!".$pair1.":".$seq_array[1][$i];
- }
- else{
- # print "perfect match\n" if $printer == 1;
- push @compared_sequence, $seq_array[0][$i];
- }
- }
- }
-# print "returning: comared = @compared_sequence \nand substitutions list =\n", join("\n",@substitutions_list),"\n" if $printer == 1;
- return join(".",@compared_sequence), join(":", @substitutions_list) if scalar (@substitutions_list) > 0;
- return join(".",@compared_sequence), "" if scalar (@substitutions_list) == 0;
-}
-
-
-sub resolve_base{
- my $printer = 0;
-# print "IN SUBROUTUNE resolve_base.. information received = @_\n" if $printer == 1;
- my ($optional, $single, $singlesp, $arg) = @_;
- my @options=split(/!/,$optional);
- foreach my $option(@options) {
- $option=~s/[A-Z\(\) ,]+://g;
- if ($option =~ /$single/i){
-# print "option = $option , returning single: $single\n" if $printer == 1;
- return $single;
- }
- }
-# print "returning ",$optional."!".$singlesp.":".$single. "\n" if $arg eq "keep" && $printer == 1;
-# print "returning ",$singlesp.":".$single."!".$optional. "\n" if $arg eq "invert" && $printer == 1;
- return $optional."!".$singlesp.":".$single if $arg eq "keep";
- return $singlesp.":".$single."!".$optional if $arg eq "invert";
-
-}
-
-sub same_length{
- my $printer = 0;
- my @locus = @_;
- my $temp = shift @locus;
- $temp=~s/-|,//g;
- foreach my $l (@locus){
- $l=~s/-|,//g;
- return 0 if length($l) != length($temp);
- $temp = $l;
- }
- return 1;
-}
-sub treeStudy{
- my $printer = 1;
-# print "template DEFINED.. received: @_\n" if defined %template;
-# print "only received = @_" if !defined %template;
- my $stopper = 0;
-# if (!defined %template){ TEMP MASKED OCT 18 2012
- $stopper = 1;
- %template=();
-# print "tree decipherer = $tree_decipherer\n" if $printer == 1;
- my ( $template_ref, $keys_array)=load_allPossibleTrees($tree_decipherer, \%template);
-# print "return = $template_ref and @{$keys_array}\n" if $printer == 1;
- foreach my $key (@$keys_array){
-# print "addding : $template_ref->{$key} for $key\n" if $printer == 1;
- $template{$key} = $template_ref->{$key};
- }
-# } TEMP MASK OCT 18 2012 END
-# ;
- for my $templet ( keys %template ) {
- # print "$templet => @{$template{$templet}}\n";
- }
-# if !defined %template;
-
- my $strict = 0;
-
- my $H = 0;
- my $Hchr = 1;
- my $Hstart = 2;
- my $Hend = 3;
- my $Hmotif = 4;
- my $Hmotiflen = 5;
- my $Hmicro = 6;
- my $Hstrand = 7;
- my $Hmicrolen = 8;
- my $Hinterpos = 9;
- my $Hrelativepos = 10;
- my $Hinter = 11;
- my $Hinterlen = 12;
-
- my $C = 13;
- my $Cchr = 14;
- my $Cstart = 15;
- my $Cend = 16;
- my $Cmotif = 17;
- my $Cmotiflen = 18;
- my $Cmicro = 19;
- my $Cstrand = 20;
- my $Cmicrolen = 21;
- my $Cinterpos = 22;
- my $Crelativepos = 23;
- my $Cinter = 24;
- my $Cinterlen = 25;
-
- my $O = 26;
- my $Ochr = 27;
- my $Ostart = 28;
- my $Oend = 29;
- my $Omotif = 30;
- my $Omotiflen = 31;
- my $Omicro = 32;
- my $Ostrand = 33;
- my $Omicrolen = 34;
- my $Ointerpos = 35;
- my $Orelativepos = 36;
- my $Ointer = 37;
- my $Ointerlen = 38;
-
- my $R = 39;
- my $Rchr = 40;
- my $Rstart = 41;
- my $Rend = 42;
- my $Rmotif = 43;
- my $Rmotiflen = 44;
- my $Rmicro = 45;
- my $Rstrand = 46;
- my $Rmicrolen = 47;
- my $Rinterpos = 48;
- my $Rrelativepos = 49;
- my $Rinter = 50;
- my $Rinterlen = 51;
-
- my $Mchr = 52;
- my $Mstart = 53;
- my $Mend = 54;
- my $M = 55;
- my $Mmotif = 56;
- my $Mmotiflen = 57;
- my $Mmicro = 58;
- my $Mstrand = 59;
- my $Mmicrolen = 60;
- my $Minterpos = 61;
- my $Mrelativepos = 62;
- my $Minter = 63;
- my $Minterlen = 64;
-
- #-------------------------------------------------------------------------------#
- my @analysis=();
-
-
- my %speciesOrder = ();
- $speciesOrder{"H"} = 0;
- $speciesOrder{"C"} = 1;
- $speciesOrder{"O"} = 2;
- $speciesOrder{"R"} = 3;
- $speciesOrder{"M"} = 4;
- #-------------------------------------------------------------------------------#
-
- my $line = $_[0];
- chomp $line;
-
- my @f = split(/\t/,$line);
-# print "received array : @f.. recieved tags = @tags\n" if $printer == 1;
-
- # collect all motifs
- my @motifs=();
- @motifs = ($f[$Hmotif], $f[$Cmotif], $f[$Omotif], $f[$Rmotif], $f[$Mmotif]) if $tags[$#tags] =~ /M/;
- @motifs = ($f[$Hmotif], $f[$Cmotif], $f[$Omotif], $f[$Rmotif]) if $tags[$#tags] =~ /R/;
- @motifs = ($f[$Hmotif], $f[$Cmotif], $f[$Omotif]) if $tags[$#tags] =~ /O/;
-# print "motifs in the array = $f[$Hmotif], $f[$Cmotif], $f[$Omotif], $f[$Rmotif]\n" if $tags[$#tags] =~ /R/;;
-# print "motifs = @motifs\n" if $printer == 1;
- my @translation = ();
- foreach my $motif (@motifs){
- push(@translation, "_") if $motif eq "NA";
- push(@translation, "+") if $motif ne "NA";
- }
- my $translate = join(" ", @translation);
-# print "translate = >$translate< and analysis = $template{$translate}[0].. on the other hand, ",$template{"- - +"}[0],"\n";
- my @analyses = split(/\|/,$template{$translate}[0]);
-# print "motifs = @motifs, analyses = @analyses\n" if $printer == 1;
-
- if (scalar(@analyses) == 1) {
- #print "analysis = $analyses[0]\n";
- if ($analyses[0] !~ /,|\./ ){
- if ($analyses[0] =~ /\+/){
- my $analysis = $analyses[0];
- $analysis =~ s/\+|\-//g;
- my @species = split(/\s*/,$analysis);
- my @currentMotifs = ();
- foreach my $specie (@species){ push(@currentMotifs, $motifs[$speciesOrder{$specie}]); #print "pushing into currentMotifs: $speciesOrder{$specie}: $motifs[$speciesOrder{$specie}]\n" if $printer == 1;
- }
-# print "current motifs = @currentMotifs and consistency? ", (consistency(@currentMotifs))," \n" if $printer == 1;
- $template{$translate}[1]++ if $strict == 1 && consistency(@currentMotifs) ne "NULL";
- $template{$translate}[1]++ if $strict == 0;
-# print "adding to template $translate: $template{$translate}[1]\n" if $printer == 1;
- }
- else{
- my $analysis = $analyses[0];
- $analysis =~ s/\+|\-//g;
- my @species = split(/\s*/,$analysis);
- my @currentMotifs = ();
- my @complementarySpecies = ();
- my $allSpecies = join("",@tags);
- foreach my $specie (@species){ $allSpecies =~ s/$specie//g; }
- foreach my $specie (split(/\s*/,$allSpecies)){ push(@currentMotifs, $motifs[$speciesOrder{$specie}]); #print "pushing into currentMotifs: $speciesOrder{$specie}: $motifs[$speciesOrder{$specie}]\n" if $printer == 1;;
- }
-# print "current motifs = @currentMotifs and consistency? ", (consistency(@currentMotifs))," \n" if $printer == 1;
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 1 && consistency(@currentMotifs) ne "NULL";
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 0;
-# print "adding to template $translate: $template{$translate}[1]\n" if $printer == 1;
- }
- }
-
- elsif ($analyses[0] =~ /,/) {
- my @events = split(/,/,$analyses[0]);
-# print "events = @events \n " if $printer == 1;
- if ($events[0] =~ /\+/){
- my $analysis1 = $events[0];
- $analysis1 =~ s/\+|\-//g;
- my $analysis2 = $events[1];
- $analysis2 =~ s/\+|\-//g;
- my @nSpecies = split(/\s*/,$analysis2);
-# print "original anslysis = $analysis1 " if $printer == 1;
- foreach my $specie (@nSpecies){ $analysis1=~ s/$specie//g;}
-# print "processed anslysis = $analysis1 \n" if $printer == 1;
- my @currentMotifs = ();
- foreach my $specie (split(/\s*/,$analysis1)){push(@currentMotifs, $motifs[$speciesOrder{$specie}]); }
-# print "current motifs = @currentMotifs and consistency? ", (consistency(@currentMotifs))," \n" if $printer == 1;
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 1 && consistency(@currentMotifs) ne "NULL";
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 0;
-# print "adding to template $translate: $template{$translate}[1]\n" if $printer == 1;
- }
- else{
- my $analysis1 = $events[0];
- $analysis1 =~ s/\+|\-//g;
- my $analysis2 = $events[1];
- $analysis2 =~ s/\+|\-//g;
- my @pSpecies = split(/\s*/,$analysis2);
- my @currentMotifs = ();
- foreach my $specie (@pSpecies){ push(@currentMotifs, $motifs[$speciesOrder{$specie}]); }
-# print "current motifs = @currentMotifs and consistency? ", (consistency(@currentMotifs))," \n" if $printer == 1;
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 1 && consistency(@currentMotifs) ne "NULL";
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 0;
-# print "adding to template $translate: $template{$translate}[1]\n" if $printer == 1;
-
- }
-
- }
- elsif ($analyses[0] =~ /\./) {
- my @events = split(/\./,$analyses[0]);
- foreach my $event (@events){
-# print "event = $event \n" if $printer == 1;
- if ($event =~ /\+/){
- my $analysis = $event;
- $analysis =~ s/\+|\-//g;
- my @species = split(/\s*/,$analysis);
- my @currentMotifs = ();
- foreach my $specie (@species){ push(@currentMotifs, $motifs[$speciesOrder{$specie}]); }
- #print consistency(@currentMotifs),"<- \n";
-# print "current motifs = @currentMotifs and consistency? ", (consistency(@currentMotifs))," \n" if $printer == 1;
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 1 && consistency(@currentMotifs) ne "NULL";
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 0;
-# print "adding to template $translate: $template{$translate}[1]\n" if $printer == 1;
- }
- else{
- my $analysis = $event;
- $analysis =~ s/\+|\-//g;
- my @species = split(/\s*/,$analysis);
- my @currentMotifs = ();
- my @complementarySpecies = ();
- my $allSpecies = join("",@tags);
- foreach my $specie (@species){ $allSpecies =~ s/$specie//g; }
- foreach my $specie (split(/\s*/,$allSpecies)){ push(@currentMotifs, $motifs[$speciesOrder{$specie}]); }
- #print consistency(@currentMotifs),"<- \n";
-# print "current motifs = @currentMotifs and consistency? ", (consistency(@currentMotifs))," \n" if $printer == 1;
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 1 && consistency(@currentMotifs) ne "NULL";
- $template{$translate}[1]=$template{$translate}[1]+1 if $strict == 0;
-# print "adding to template $translate: $template{$translate}[1]\n" if $printer == 1;
- }
- }
-
- }
- }
- else{
- my $finalanalysis = ();
- $template{$translate}[1]++;
- foreach my $analysis (@analyses){ ;}
- }
- # test if motifs where microsats are present, as indeed of same the motif composition
-
-
-
- for my $templet ( keys %template ) {
- if (@{ $template{$templet} }[1] > 0){
-
- $template{$templet}[1] = 0;
-# print "now returning: @{$template{$templet}}[0], $templet\n";
- return (@{$template{$templet}}[0], $templet);
- }
- }
- undef %template;
-# print "sending NULL\n" if $printer == 1;
- return ("NULL", "NULL");
-
-}
-
-
-sub consistency{
- my @motifs = @_;
-# print "in consistency \n" if $printer == 1;
-# print "motifs sent = >",join("|",@motifs),"< \n" if $printer == 1;
- return $motifs[0] if scalar(@motifs) == 1;
- my $prevmotif = shift(@motifs);
- my $stopper = 0;
- for my $i (0 ... $#motifs){
- next if $motifs[$i] eq "NA";
- my $templet = $motifs[$i].$motifs[$i];
- if ($templet !~ /$prevmotif/i){
- $stopper = 1; last;
- }
- }
- return $prevmotif if $stopper == 0;
- return "NULL" if $stopper == 1;
-}
-sub summarize_microsat{
- my $printer = 1;
- my $line = $_[0];
- my $humseq = $_[1];
-
- my @gaps = $line =~ /[0-9]+\t[0-9]+\t[\+\-]/g;
- my @starts = $line =~ /[0-9]+\t[\+\-]/g;
- my @ends = $line =~ /[\+\-]\t[0-9]+/g;
-# print "starts = @starts\tends = @ends\n" if $printer == 1;
- for my $i (0 ... $#gaps) {$gaps[$i] =~ s/\t[0-9]+\t[\+\-]//g;}
- for my $i (0 ... $#starts) {$starts[$i] =~ s/\t[\+\-]//g;}
- for my $i (0 ... $#ends) {$ends[$i] =~ s/[\+\-]\t//g;}
-
- my $minstart = array_smallest_number(@starts);
- my $maxend = array_largest_number(@ends);
-
- my $humupstream_st = substr($humseq, 0, $minstart);
- my $humupstream_en = substr($humseq, 0, $maxend);
- my $no_of_gaps_to_start = 0;
- my $no_of_gaps_to_end = 0;
- $no_of_gaps_to_start = ($humupstream_st =~ s/\-/x/g) if $humupstream_st=~/\-/;
- $no_of_gaps_to_end = ($humupstream_en =~ s/\-/x/g) if $humupstream_en=~/\-/;
-
- my $locusmotif = ();
-# print "IN SUB SUMMARIZE_MICROSAT $line\n" if $printer == 1;
- #return "NULL" if $line =~ /compound/;
- my $Hstart = "NA";
- my $Hend = "NA";
- chomp $line;
- my $match_count = ($line =~ s/>/>/g);
- #print "number of species = $match_count\n";
- my @micros = split(/>/,$line);
- shift @micros;
- my $stopper = 0;
-
-
- foreach my $mic (@micros){
- my @local = split(/\t/,$mic);
- if ($local[$microsatcord] =~ /N/) {$stopper =1; last;}
- }
- return "NULL" if $stopper ==1;
-
- #------------------------------------------------------
-
- my @arranged = ();
- for my $arr (0 ... $#exacttags) {$arranged[$arr] = '0';}
-
- foreach my $micro (@micros){
- for my $i (0 ... $#exacttags){
- if ($micro =~ /^$exacttags[$i]/){
- $arranged[$i] = $micro;
- last;
- }
- }
- }
-# print "arranged = @arranged \n" ; ;;
-
- my @endstatement = ();
- my $turn = 0;
- my $species_counter = 0;
- # print scalar(@arranged),"\n";
-
- my $species_no=0;
-
- my $orthHchr = 0;
-
- foreach my $micro (@arranged) {
- $micro =~ s/\t\t/\t \t/g;
- $micro =~ s/\t,/\t ,/g;
- $micro =~ s/,\t/, \t/g;
-# print "------------------------------------------------------------------------------------------\n" if $printer == 1;
- chomp $micro;
- if ($micro eq '0'){
- push(@endstatement, join("\t",$exacttags[$species_counter],"NA","NA","NA","NA",0 ,"NA", "NA", 0,"NA","NA","NA", "NA" ));
- $species_counter++;
- # print join("|","ENDSTATEMENT:",@endstatement),"\n" if $printer == 1;
- next;
- }
- # print $micro,"\n";
-# print "micro = $micro \n" if $printer == 1;
- my @fields = split(/\t/,$micro);
- my $microcopy = $fields[$microsatcord];
- $microcopy =~ s/\[|\]|-//g;
- my $microsatlength = length($microcopy);
-# print "microsat = $fields[$microsatcord] and microsatlength = $microsatlength\n" if $printer == 1;
-# print "sp_ident = @sp_ident.. species_no=$species_no\n";
- $micro =~ /$sp_ident[$species_no]\s([0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)/;
-# print "$micro =~ /$sp_ident[$species_no] ([0-9a-zA-Z_]+) ([0-9]+) ([0-9]+)/\n";
- my $sp_chr=$1;
- my $sp_start=$2 + $fields[$startcord] - $fields[$gapcord];
- my $sp_end= $sp_start + $microsatlength - 1;
-
- $species_no++;
-
- $micro =~ /$focalspec_orig\s(\S+)\s([0-9]+)\s([0-9]+)/;
- $orthHchr=$1;
- $Hstart=$2+$minstart-$no_of_gaps_to_start;
- $Hend=$2+$maxend-$no_of_gaps_to_end;
-# print "Hstart = $Hstart = $fields[4] + $fields[$startcord] - $fields[$gapcord]\n" if $printer == 1;
-
- my $motif = $fields[$motifcord];
- my $firstmotif = ();
- my $strand = $fields[$strandcord];
- # print "strand = $strand\n";
-
-
- if ($motif =~ /^\[/){
- $motif =~ s/^\[//g;
- $motif =~ /([a-zA-Z]+)\].*/;
- $firstmotif = $1;
- }
-
- else {$firstmotif = $motif;}
-# print "firstmotif =$firstmotif : \n" if $printer == 1;
- $firstmotif = allCaps($firstmotif);
-
- if (exists $revHash{$firstmotif} && $turn == 0) {
- $turn=1 if $species_counter==0;
- $firstmotif = $revHash{$firstmotif};
- }
-
- elsif (exists $revHash{$firstmotif} && $turn == 1) {$firstmotif = $revHash{$firstmotif}; $turn = 1;}
-# print "changed firstmotif =$firstmotif\n" if $printer == 1;
- # ;
- $locusmotif = $firstmotif;
-
- if (scalar(@fields) > $microsatcord + 2){
-# print "fields = @fields ... interr_poscord=$interr_poscord=$fields[$interr_poscord] .. interrcord=$interrcord=$fields[$interrcord]\n" if $printer == 1;
-
- my @interposes = ();
- @interposes = split(",",$fields[$interr_poscord]) if $fields[$interr_poscord] =~ /,/;
- $interposes[0] = $fields[$interr_poscord] if $fields[$interr_poscord] !~ /,/ ;
-# print "interposes=@interposes\n" if $printer == 1;
- my @relativeposes = ();
- my @interruptions = ();
- @interruptions = split(",",$fields[$interrcord]) if $fields[$interrcord] =~ /,/;
- $interruptions[0] = $fields[$interrcord] if $fields[$interrcord] !~ /,/;
- my @interlens = ();
-
-
- for my $i (0 ... $#interposes){
-
- my $interpos = $interposes[$i];
- my $nexter = 0;
- my $interruption = $interruptions[$i];
- my $interlen = length($interruption);
- push (@interlens, $interlen);
-
-
- my $relativepos = (100 * $interpos) / $microsatlength;
-# print "relativepos = $relativepos ,interpos=$interpos, interruption=$interruption, interlen=$interlen \n" if $printer == 1;
- $relativepos = (100 * ($interpos-$interlen)) / $microsatlength if $relativepos > 50;
-# print "--> = $relativepos\n" if $printer == 1;
- $interruption = "IND" if length($interruption) < 1;
-
- if ($turn == 1){
- $fields[$microsatcord] = switch_micro($fields[$microsatcord]);
- $interruption = switch_nucl($interruption) unless $interruption eq "IND";
- $interpos = ($microsatlength - $interpos) - $interlen + 2;
-# print "turn interpos = $interpos for $fields[$microsatcord]\n" if $printer == 1;
- $relativepos = (100 * $interpos) / $microsatlength;
- $relativepos = (100 * ($interpos-$interlen)) / $microsatlength if $relativepos > 50;
-
-
- $strand = '+' if $strand eq '-';
- $strand = '-' if $strand eq '+';
- }
-# print "final relativepos = $relativepos\n" if $printer == 1;
- push(@relativeposes, $relativepos);
- }
- push(@endstatement,join("\t",($exacttags[$species_counter],$sp_chr, $sp_start, $sp_end, $firstmotif,length($firstmotif),$fields[$microsatcord],$strand,$microsatlength,join(",",@interposes),join(",",@relativeposes),join(",",@interruptions), join(",",@interlens))));
- }
-
- else{
- push(@endstatement, join("\t",$exacttags[$species_counter],$sp_chr, $sp_start, $sp_end, $firstmotif,length($firstmotif),$fields[$microsatcord],$strand,$microsatlength,"NA","NA","NA", "NA"));
- }
-
- $species_counter++;
- }
-
- $locusmotif = $sameHash{$locusmotif} if exists $sameHash{$locusmotif};
- $locusmotif = $revHash{$locusmotif} if exists $revHash{$locusmotif};
-
- my $endst = join("\t", @endstatement, $orthHchr, $Hstart, $Hend);
-# print join("\t", @endstatement, $orthHchr, $Hstart, $Hend), "\n" if $printer == 1;
-
-
- return (join("\t", @endstatement, $orthHchr, $Hstart, $Hend), $orthHchr, $Hstart, $Hend, $locusmotif, length($locusmotif));
-
-}
-
-sub switch_nucl{
- my @strand = split(/\s*/,$_[0]);
- for my $i (0 ... $#strand){
- if ($strand[$i] =~ /c/i) {$strand[$i] = "G";next;}
- if ($strand[$i] =~ /a/i) {$strand[$i] = "T";next;}
- if ($strand[$i] =~ /t/i) { $strand[$i] = "A";next;}
- if ($strand[$i] =~ /g/i) {$strand[$i] = "C";next;}
- }
- return join("",@strand);
-}
-
-
-sub switch_micro{
- my $micro = reverse($_[0]);
- my @strand = split(/\s*/,$micro);
- for my $i (0 ... $#strand){
- if ($strand[$i] =~ /c/i) {$strand[$i] = "G";next;}
- if ($strand[$i] =~ /a/i) {$strand[$i] = "T";next;}
- if ($strand[$i] =~ /t/i) { $strand[$i] = "A";next;}
- if ($strand[$i] =~ /g/i) {$strand[$i] = "C";next;}
- if ($strand[$i] =~ /\[/i) {$strand[$i] = "]";next;}
- if ($strand[$i] =~ /\]/i) {$strand[$i] = "[";next;}
- }
- return join("",@strand);
-}
-sub decipher_history{
- my $printer = 0;
- my ($mutations_array, $tags_string, $nodes, $branches_hash, $tree_analysis, $confirmation_string, $alivehash) = @_;
- my %mutations_hash=();
- foreach my $mutation (@$mutations_array){
-# print "mutation = $mutation\n" if $printer == 1;
- my %local = $mutation =~ /([\S ]+)=([\S ]+)/g;
- push @{$mutations_hash{$local{"node"}}},$mutation;
-# print "just for confirmation: $local{node} pushed as: $mutation\n" if $printer == 1;
- }
- my @nodes;
- my @birth_steps=();
- my @death_steps=();
-
- my @tags=split(/\s*/,$tags_string);
- my @confirmation=split(/\s+/,$confirmation_string);
- my %info=();
-
- for my $i (0 ... $#tags){
- $info{$tags[$i]}=$confirmation[$i];
-# print "feeding info: $tags[$i] = $info{$tags[$i]}\n" if $printer == 1;
- }
-
- for my $keys (@$nodes) {
- foreach my $key (@$keys){
-# print "current key = $key\n";
- my $copykey = $key;
- $copykey =~ s/[\W ]+//g;
- my @copykeys=split(/\s*/,$copykey);
- my $states=();
- foreach my $copy (@copykeys){
- $states=$states.$info{$copy};
- }
-# print "reduced key = $copykey and state = $states\n" if $printer == 1;
-
- if (exists $mutations_hash{$key}) {
-
- if ($states=~/\+/){
- push @birth_steps, @{$mutations_hash{$key}};
- $birth_steps[$#birth_steps] =~ s/\S+=//g;
- delete $mutations_hash{$key};
- }
- else{
- push @death_steps, @{$mutations_hash{$key}};
- $death_steps[$#death_steps] =~ s/\S+=//g;
- delete $mutations_hash{$key};
- }
- }
- }
- }
-# print "conformation = $confirmation_string\n" if $printer == 1;
- push (@birth_steps, "NULL") if scalar(@birth_steps) == 0;
- push (@death_steps, "NULL") if scalar(@death_steps) == 0;
-# print "birth steps = ",join("\n",@birth_steps)," and death steps = ",join("\n",@death_steps),"\n" if $printer == 1;
- return \@birth_steps, \@death_steps;
-}
-
-sub fillAlignmentGaps{
- my $printer = 0;
-# print "received: @_\n" if $printer == 1;
- my ($tree, $sequences, $alignment, $tagarray, $microsathash, $nonmicrosathash, $motif, $tree_analysis, $threshold, $microsatstarts) = @_;
-# print "in fillAlignmentGaps.. tree = $tree \n" if $printer == 1;
- my %sequence_hash=();
-
- my @phases = ();
- my $concat = $motif.$motif;
- my $motifsize = length($motif);
-
- for my $i (1 ... $motifsize){
- push @phases, substr($concat, $i, $motifsize);
- }
-
- my $concatalignment = ();
- foreach my $tag (@tags){
- $concatalignment = $concatalignment.$alignment->{$tag};
- }
-# print "returningg NULL","NULL","NULL", "NULL\n" if $concatalignment !~ /-/;
- return 0, "NULL","NULL","NULL", "NULL","NULL" if $concatalignment !~ /-/;
-
-
-
- my %node_sequences_temp=();
- my %node_alignments_temp =(); #NEW, Nov 28 2008
-
- my @tags=();
- my @locus_sequences=();
- my %alivehash=();
-
-# print "IN fillAlignmentGaps\n";# ;
- my %fillrecord = ();
-
- my $change = 0;
- foreach my $tag (@$tagarray) {
- #print "adding: $tag\n";
- push(@tags, $tag);
- if (exists $microsathash->{$tag}){
- my $micro = $microsathash->{$tag};
- my $orig_micro = $micro;
- ($micro, $fillrecord{$tag}) = fillgaps($micro, \@phases);
- $change = 1 if uc($micro) ne uc($orig_micro);
- $node_sequences_temp{$tag}=$micro if $microsathash->{$tag} ne "NULL";
- }
- if (exists $nonmicrosathash->{$tag}){
- my $micro = $nonmicrosathash->{$tag};
- my $orig_micro = $micro;
- ($micro, $fillrecord{$tag}) = fillgaps($micro, \@phases);
- $change = 1 if uc($micro) ne uc($orig_micro);
- $node_sequences_temp{$tag}=$micro if $nonmicrosathash->{$tag} ne "NULL";
- }
-
- if (exists $alignment->{$tag}){
- my $micro = $alignment->{$tag};
- my $orig_micro = $micro;
- ($micro, $fillrecord{$tag}) = fillgaps($micro, \@phases);
- $change = 1 if uc($micro) ne uc($orig_micro);
- $node_alignments_temp{$tag}=$micro if $alignment->{$tag} ne "NULL";
- }
-
- #print "adding to node_sequences: $tag = ",$node_sequences_temp{$tag},"\n" if $printer == 1;
- #print "adding to node_alignments: $tag = ",$node_alignments_temp{$tag},"\n" if $printer == 1;
- }
-
-
- my %node_sequences=();
- my %node_alignments =(); #NEW, Nov 28 2008
- foreach my $tag (@$tagarray) {
- $node_sequences{$tag} = join ".",split(/\s*/,$node_sequences_temp{$tag});
- $node_alignments{$tag} = join ".",split(/\s*/,$node_alignments_temp{$tag});
- }
-# print "\n", "#" x 50, "\n" if $printer == 1;
- foreach my $tag (@tags){
-# print "$tag: $alignment->{$tag} = $node_alignments{$tag}\n" if $printer == 1;
- }
-# print "\n", "#" x 50, "\n" if $printer == 1;
-# print "change = $change\n";
- # if $concatalignment=~/\-/;
-
-# if $printer == 1 && $concatalignment =~ /\-/;
-
- return 0, "NULL","NULL","NULL", "NULL", "NULL" if $change == 0;
-
- my ($nodes_arr, $branches_hash) = get_nodes($tree);
- my @nodes=@$nodes_arr;
-# print "recieved nodes = @nodes\n" if $printer == 1;
-
-
- #POPULATE branches_hash WITH INFORMATION ABOUT LIVESTATUS
- foreach my $keys (@nodes){
- my @pair = @$keys;
- my $joint = "(".join(", ",@pair).")";
- my $copykey = join "", @pair;
- $copykey =~ s/[\W ]+//g;
-# print "for node: $keys, copykey = $copykey and joint = $joint\n" if $printer == 1;
- my $livestatus = 1;
- foreach my $copy (split(/\s*/,$copykey)){
- $livestatus = 0 if !exists $alivehash{$copy};
- }
- $alivehash{$joint} = $joint if !exists $alivehash{$joint} && $livestatus == 1;
-# print "alivehash = $alivehash{$joint}\n" if exists $alivehash{$joint} && $printer == 1;
- }
-
-
-
- @nodes = reverse(@nodes); #1 THIS IS IN ORDER TO GO THROUGH THE TREE FROM LEAVES TO ROOT.
-
- my @mutations_array=();
-
- my $joint = ();
- foreach my $node (@nodes){
- my @pair = @$node;
-# print "now in the nodes for loop, pair = @pair\n and sequences=\n" if $printer == 1;
- $joint = "(".join(", ",@pair).")";
-# print "joint = $joint \n" if $printer == 1;
- my @pair_sequences=();
-
- foreach my $tag (@pair){
-# print "tag = $tag: " if $printer == 1;
-# print $node_alignments{$tag},"\n" if $printer == 1;
- push @pair_sequences, $node_alignments{$tag};
- }
-# print "fillgap\n";
- my ($compared, $substitutions_list) = base_by_base_simple($motif,\@pair_sequences, scalar(@pair_sequences), @pair, $joint);
- $node_alignments{$joint}=$compared;
- push( @mutations_array,split(/:/,$substitutions_list));
-# print "newly added to node_sequences: $node_alignments{$joint} and list of mutations = @mutations_array\n" if $printer == 1;
- }
-# print "now sending for analyze_mutations: mutation_array=@mutations_array, nodes=@nodes, branches_hash=$branches_hash, alignment=$alignment, tags=@tags, alivehash=%alivehash, node_sequences=\%node_sequences, microsatstarts=$microsatstarts, motif=$motif\n" if $printer == 1;
-# if $printer == 1;
-
- my $analayzed_mutations = analyze_mutations(\@mutations_array, \@nodes, $branches_hash, $alignment, \@tags, \%alivehash, \%node_sequences, $microsatstarts, $motif);
-
-# print "returningt: ", $analayzed_mutations, \@nodes,"\n" if scalar @mutations_array > 0;;
-# print "returningy: NULL, NULL, NULL " if scalar @mutations_array == 0 && $printer == 1;
-# print "final node alignment after filling for $joint= " if $printer == 1;
-# print "$node_alignments{$joint}\n" if $printer == 1;
-
-
- return 1, $analayzed_mutations, \@nodes, $branches_hash, \%alivehash, $node_alignments{$joint} if scalar @mutations_array > 0 ;
- return 1, "NULL","NULL","NULL", "NULL", "NULL" if scalar @mutations_array == 0;
-}
-
-
-
-sub add_mutation{
- my $printer = 0;
-# print "IN SUBROUTUNE add_mutation.. information received = @_\n" if $printer == 1;
- my ($i , $bite, $to, $from) = @_;
-# print "bite = $bite.. all received info = ",join("^", @_),"\n" if $printer == 1;
-# print "to=$to\n" if $printer == 1;
-# print "tis split = ",join(" and ",split(/!/,$to)),"\n" if $printer == 1;
- my @toields = split "!",$to;
-# print "toilds = @toields\n" if $printer == 1;
- my @mutations=();
-
- foreach my $toield (@toields){
- my @toinfo=split(":",$toield);
-# print " at toinfo=@toinfo \n" if $printer == 1;
- next if $toinfo[1] =~ /$from/i;
- my @mutation = @toinfo if $toinfo[1] !~ /$from/i;
-# print "adding to mutaton list: ", join(",", "node=$mutation[0]","type=substitution" ,"position=$i", "from=$from", "to=$mutation[1]", "insertion=", "deletion="),"\n" if $printer == 1;
- push (@mutations, join("\t", "node=$mutation[0]","type=substitution" ,"position=$i", "from=$from", "to=$mutation[1]", "insertion=", "deletion="));
- }
- return @mutations;
-}
-
-
-sub add_bases{
-
- my $printer = 0;
-# print "IN SUBROUTUNE add_bases.. information received = @_\n" if $printer == 1;
- my ($optional0, $optional1, $pair0, $pair1,$joint) = @_;
- my $total_list=();
-
- my @total_list0=split(/!/,$optional0);
- my @total_list1=split(/!/,$optional1);
- my @all_list=();
- my %total_hash0=();
- foreach my $entry (@total_list0) {
- $entry = uc $entry;
- $entry =~ /(\S+):(\S+)/;
- $total_hash0{$2}=$1;
- push @all_list, $2;
- }
-
- my %total_hash1=();
- foreach my $entry (@total_list1) {
- $entry = uc $entry;
- $entry =~ /(\S+):(\S+)/;
- $total_hash1{$2}=$1;
- push @all_list, $2;
- }
-
- my %alphabetical_hash=();
- my @return_options=();
-
- for my $i (0 ... $#all_list){
- my $alph = $all_list[$i];
- if (exists $total_hash0{$alph} && exists $total_hash1{$alph}){
- push(@return_options, $joint.":".$alph);
- delete $total_hash0{$alph}; delete $total_hash1{$alph};
- }
- if (exists $total_hash0{$alph} && !exists $total_hash1{$alph}){
- push(@return_options, $pair0.":".$alph);
- delete $total_hash0{$alph};
- }
- if (!exists $total_hash0{$alph} && exists $total_hash1{$alph}){
- push(@return_options, $pair1.":".$alph);
- delete $total_hash1{$alph};
- }
-
- }
-# print "returning ",join "!",@return_options,"\n" if $printer == 1;
- return join "!",@return_options;
-
-}
-
-
-sub fillgaps{
-# print "IN fillgaps: @_\n";
- my ($micro, $phasesinput) = @_;
- #print "in microsathash ,,.. micro = $micro\n";
- return $micro if $micro !~ /\-/;
- my $orig_micro = $micro;
- my @phases = @$phasesinput;
-
- my %tested_patterns = ();
-
- foreach my $phase (@phases){
- # print "considering phase: $phase\n";
- my @phase_prefixes = ();
- my @prephase_left_contexts = ();
- my @prephase_right_contexts = ();
- my @pregapsize = ();
- my @prepostfilins = ();
-
- my @phase_suffixes;
- my @suffphase_left_contexts;
- my @suffphase_right_contexts;
- my @suffgapsize;
- my @suffpostfilins;
-
- my @postfilins = ();
- my $motifsize = length($phases[0]);
-
- my $change = 0;
-
- for my $u (0 ... $motifsize-1){
- my $concat = $phase.$phase.$phase.$phase;
- my @concatarr = split(/\s*/, $concat);
- my $l = 0;
- while ($l < $u){
- shift @concatarr;
- $l++;
- }
- $concat = join ("", @concatarr);
-
- for my $t (0 ... $motifsize-1){
- for my $k (1 ... $motifsize-1){
- push @phase_prefixes, substr($concat, $motifsize+$t, $k);
- push @prephase_left_contexts, substr ($concat, $t, $motifsize);
- push @prephase_right_contexts, substr ($concat, $motifsize+$t+$k+($motifsize-$k), 1);
- push @pregapsize, $k;
- push @prepostfilins, substr($concat, $motifsize+$t+$k, ($motifsize-$k));
- # print "reading: $concat, t=$t, k=$k prefix: $prephase_left_contexts[$#prephase_left_contexts] $phase_prefixes[$#phase_prefixes] -x$pregapsize[$#pregapsize] $prephase_right_contexts[$#prephase_right_contexts]\n";
- # print "phase_prefixes = $phase_prefixes[$#phase_prefixes]\n";
- # print "prephase_left_contexts = $prephase_left_contexts[$#prephase_left_contexts]\n";
- # print "prephase_right_contexts = $prephase_right_contexts[$#prephase_right_contexts]\n";
- # print "pregapsize = $pregapsize[$#pregapsize]\n";
- # print "prepostfilins = $prepostfilins[$#prepostfilins]\n";
- }
- }
- }
-
- # print "looking if $micro =~ /($phase\-{$motifsize})/i || $micro =~ /^(\-{$motifsize,}$phase)/i\n";
- if ($micro =~ /($phase\-{$motifsize,})$/i || $micro =~ /^(\-{$motifsize,}$phase)/i){
- # print "micro: $micro needs further gap removal: $1\n";
- while ($micro =~ /$phase(\-{$motifsize,})$/i || $micro =~ /^(\-{$motifsize,})$phase/i){
- # print "micro: $micro needs further gap removal: $1\n";
-
- # print "phase being considered = $phase\n";
- my $num = ();
- $num = $micro =~ s/$phase\-{$motifsize}/$phase$phase/gi if $micro =~ /$phase\-{$motifsize,}/i;
- $num = $micro =~ s/\-{$motifsize}$phase/$phase$phase/gi if $micro =~ /\-{$motifsize,}$phase/i;
- # print "num = $num\n";
- $change = 1 if $num == 1;
- }
- }
-
- elsif ($micro =~ /(($phase)+)\-{$motifsize,}(($phase)+)/i){
- while ($micro =~ /(($phase)+)\-{$motifsize,}(($phase)+)/i){
- # print "checking lengths of $1 and $3 for $micro... \n";
- my $num = ();
- if (length($1) >= length($3)){
- # print "$micro matches (($phase)+)\-{$motifsize,}(($phase)+) = $1, >= , $3 \n";
- $num = $micro =~ s/$phase\-{$motifsize}/$phase$phase/gi ;
- }
- if (length($1) < length($3)){
- # print "$micro matches (($phase)+)\-{$motifsize,}(($phase)+) = $1, < , $3 \n";
- $num = $micro =~ s/\-{$motifsize}$phase/$phase$phase/gi ;
- }
- # print "micro changed to $micro\n";
- }
- }
- elsif ($micro =~ /([A-Z]+)\-{$motifsize,}(($phase)+)/i){
- while ($micro =~ /([A-Z]+)\-{$motifsize,}(($phase)+)/i){
- # print "$micro matches ([A-Z]+)\-{$motifsize}(($phase)+) = 1=$1, - , 3=$3 \n";
- my $num = 0;
- $num = $micro =~ s/\-{$motifsize}$phase/$phase$phase/gi ;
- }
- }
- elsif ($micro =~ /(($phase)+)\-{$motifsize,}([A-Z]+)/i){
- while ($micro =~ /(($phase)+)\-{$motifsize,}([A-Z]+)/i){
- # print "$micro matches (($phase)+)\-{$motifsize,}([A-Z]+) = 1=$1, - , 3=$3 \n";
- my $num = 0;
- $num = $micro =~ s/$phase\-{$motifsize}/$phase$phase/gi ;
- }
- }
-
- # print "$orig_micro to $micro\n";
-
- #s ;
-
- for my $h (0 ... $#phase_prefixes){
- # print "searching using prefix : $prephase_left_contexts[$h]$phase_prefixes[$h]\-{$pregapsize[$h]}$prephase_right_contexts[$h]\n";
- my $pattern = $prephase_left_contexts[$h].$phase_prefixes[$h].$pregapsize[$h].$prephase_right_contexts[$h];
- # print "returning orig_micro = $orig_micro, micro = $micro \n" if exists $tested_patterns{$pattern};
- if ($micro =~ /$prephase_left_contexts[$h]$phase_prefixes[$h]\-{$pregapsize[$h]}$prephase_right_contexts[$h]/i){
- return $orig_micro if exists $tested_patterns{$pattern};
- while ($micro =~ /($prephase_left_contexts[$h]$phase_prefixes[$h]\-{$pregapsize[$h]}$prephase_right_contexts[$h])/i){
- $tested_patterns{$pattern} = $pattern;
- # print "micro: $micro needs further gap removal: $1\n";
-
- # print "prefix being considered = $phase_prefixes[$h]\n";
- my $num = ();
- $num = ($micro =~ s/$prephase_left_contexts[$h]$phase_prefixes[$h]\-{$pregapsize[$h]}$prephase_right_contexts[$h]/$prephase_left_contexts[$h]$phase_prefixes[$h]$prepostfilins[$h]$prephase_right_contexts[$h]/gi) ;
- # print "num = $num, micro = $micro\n";
- $change = 1 if $num == 1;
-
- return $orig_micro if $num > 1;
- }
- }
-
- }
- }
- return $orig_micro if length($micro) != length($orig_micro);
- return $micro;
-}
-
-sub selectMutationArray{
- my $printer =0;
-
- my $oldmutspt = $_[0];
- my $newmutspt = $_[1];
- my $tagstringpt = $_[2];
- my $alivehashpt = $_[3];
- my $alignmentpt = $_[4];
- my $motif = $_[5];
-
- my @alivehasharr=();
-
- my @tags = @$tagstringpt;
- my $alignmentln = length($alignmentpt->{$tags[0]});
-
- foreach my $key (keys %$alivehashpt) { push @alivehasharr, $key; }
-
- my %newside = ();
- my %oldside = ();
- my %newmuts = ();
-
- my %commons = ();
- my %olds = ();
- foreach my $old (@$oldmutspt){
- $olds{$old} = 1;
- }
- foreach my $new (@$newmutspt){
- $commons{$new} = 1 if exists $olds{$new};;
- }
-
-
- foreach my $pos ( 0 ... $alignmentln){
- #print "pos = $pos\n" if $printer == 1;
- my $newyes = 0;
- foreach my $mut (@$newmutspt){
- $newmuts{$mut} = 1;
- chomp $mut;
- $newyes++;
- $mut =~ s/=\t/= \t/g;
- $mut =~ s/=$/= /g;
-
- $mut =~ /node=([A-Z\(\), ]+)\stype=([a-zA-Z ]+)\sposition=([0-9 ]+)\sfrom=([a-zA-Z\- ]+)\sto=([a-zA-Z\- ]+)\sinsertion=([a-zA-Z\- ]+)\sdeletion=([a-zA-Z\- ]+)/;
- my $node = $1;
- next if $3 != $pos;
-# print "new mut = $mut\n" if $printer == 1;
-# print "node = $node, pos = $3 ... and alivehasharr = >@alivehasharr<\n" if $printer == 1;
- my $alivenode = 0;
- foreach my $key (@alivehasharr){
- $alivenode = 1 if $key =~ /$node/;
- }
- # next if $alivenode == 0;
- my $indel_type = " ";
- if ($2 eq "insertion" || $2 eq "deletion"){
- my $thisindel = ();
- $thisindel = $6 if $2 eq "insertion";
- $thisindel = $7 if $2 eq "deletion";
-
- $indel_type = "i".checkIndelType($node, $thisindel, $motif,$alignmentpt,$3, $2) if $2 eq "insertion";
- $indel_type = "d".checkIndelType($node, $thisindel, $motif,$alignmentpt, $3, $2) if $2 eq "deletion";
- $indel_type = $indel_type."f" if $indel_type =~ /mot/ && length($thisindel) >= length($motif);
- }
-# print "indeltype = $indel_type\n" if $printer == 1;
- my $added = 0;
-
- if (exists $newside{$pos} && $indel_type =~ /[a-z]+/){
-# print "we have a preexisting one for $pos\n" if $printer == 1;
- my @preexisting = @{$newside{$pos}};
- foreach my $pre (@preexisting){
-# print "looking at $pre\n" if $printer == 1;
- next if $pre !~ /node=$node/;
- next if $pre !~ /indeltype=([a-z]+)/;
- my $currtype = $1;
-
- if ($currtype =~ /inon/ && $indel_type =~ /dmot/){
- delete $newside{$pos};
- push @{$newside{$pos}}, $pre;
- $added = 1;
- }
- if ($currtype =~ /dnon/ && $indel_type =~ /imot/){
- delete $newside{$pos};
- push @{$newside{$pos}}, $pre;
- $added = 1;
- }
- if ($currtype =~ /dmot/ && $indel_type =~ /inon/){
- delete $newside{$pos};
- push @{$newside{$pos}}, $mut."\tindeltype=$indel_type";
- $added = 1;
- }
- if ($currtype =~ /imot/ && $indel_type =~ /dnon/){
- delete $newside{$pos};
- push @{$newside{$pos}}, $mut."\tindeltype=$indel_type";
- $added = 1;
- }
- }
- }
-# print "added = $added\n" if $printer == 1;
- push @{$newside{$pos}}, $mut."\tindeltype=$indel_type" if $added == 0;
-# print "for new pos,: $pos we have: @{$newside{$pos}}\n " if $printer == 1;
- }
- }
-
- foreach my $pos ( 0 ... $alignmentln){
- my $oldyes = 0;
- foreach my $mut (@$oldmutspt){
- chomp $mut;
- $oldyes++;
- $mut =~ s/=\t/= \t/g;
- $mut =~ s/=$/= /g;
- $mut =~ /node=([A-Z\(\), ]+)\ttype=([a-zA-Z ]+)\tposition=([0-9 ]+)\tfrom=([a-zA-Z\- ]+)\tto=([a-zA-Z\- ]+)\tinsertion=([a-zA-Z\- ]+)\tdeletion=([a-zA-Z\- ]+)/;
- my $node = $1;
- next if $3 != $pos;
-# print "old mut = $mut\n" if $printer == 1;
- my $alivenode = 0;
- foreach my $key (@alivehasharr){
- $alivenode = 1 if $key =~ /$node/;
- }
- #next if $alivenode == 0;
- my $indel_type = " ";
- if ($2 eq "insertion" || $2 eq "deletion"){
- $indel_type = "i".checkIndelType($node, $6, $motif,$alignmentpt, $3, $2) if $2 eq "insertion";
- $indel_type = "d".checkIndelType($node, $7, $motif,$alignmentpt, $3, $2) if $2 eq "deletion";
- next if $indel_type =~/non/;
- }
- else{ next;}
-
- my $imp=0;
- $imp = 1 if $indel_type =~ /dmot/ && $alivenode == 0;
- $imp = 1 if $indel_type =~ /imot/ && $alivenode == 1;
-
-
- if (exists $newside{$pos} && $indel_type =~ /[a-z]+/){
- my @preexisting = @{$newside{$pos}};
-# print "we have a preexisting one for $pos: @preexisting\n" if $printer == 1;
- next if $imp == 0;
-
- if (scalar(@preexisting) == 1){
- my $foundmut = $preexisting[0];
- $foundmut=~ /node=([A-Z, \(\)]+)/;
- next if $1 eq $node;
-
- if (exists $oldside{$pos} || exists $commons{$foundmut}){
-# print "not replacing, but just adding\n" if $printer == 1;
- push @{$newside{$pos}}, $mut."\tindeltype=$indel_type";
- push @{$oldside{$pos}}, $mut."\tindeltype=$indel_type";
- next;
- }
-
- delete $newside{$pos};
- push @{$oldside{$pos}}, $mut."\tindeltype=$indel_type";
- push @{$newside{$pos}}, $mut."\tindeltype=$indel_type";
-# print "now new one is : @{$newside{$pos}}\n" if $printer == 1;
- }
-# print "for pos: $pos: @{$newside{$pos}}\n" if $printer == 1;
- next;
- }
-
-
- my @news = @{$newside{$pos}} if exists $newside{$pos};
-# print "mut = $mut and news = @news\n" if $printer == 1;
- push @{$oldside{$pos}}, $mut."\tindeltype=$indel_type";
- push @{$newside{$pos}}, $mut."\tindeltype=$indel_type";
- }
- }
-# print "in the end, our collected mutations = \n" if $printer == 1;
- my @returnarr = ();
- foreach my $key (keys %newside) {push @returnarr,@{$newside{$key}};}
-# print join("\n", @returnarr),"\n" if $printer == 1;
- #;
- return @returnarr;
-
-}
-
-
-sub checkIndelType{
- my $printer = 0;
- my $node = $_[0];
- my $indel = $_[1];
- my $motif = $_[2];
- my $alignmentpt = $_[3];
- my $posit = $_[4];
- my $type = $_[5];
- my @phases =();
- my %prephases = ();
- my %postphases = ();
- #print "motif = $motif\n";
-# print "IN checkIndelType ... received: @_\n" if $printer == 1;
- my $concat = $motif.$motif.$motif.$motif;
- my $motiflength = length($motif);
-
- if ($motiflength > length ($indel)){
- return "non" if $motif !~ /$indel/i;
- return checkIndelType_ComplexAnalysis($node, $indel, $motif, $alignmentpt, $posit, $type);
- }
-
- my $firstpass = 0;
- for my $y (0 ... $motiflength-1){
- my $phase = substr($concat, $motiflength+$y, $motiflength);
- push @phases, $phase;
- $firstpass = 1 if $indel =~ /$phase/i;
- for my $k (0 ... length($motif)-1){
-# print "at: motiflength=$motiflength , y=$y , k=$k.. for pre: $motiflength+$y-$k and post: $motiflength+$y-$k+$motiflength in $concat\n" if $printer == 1;
- my $pre = substr($concat, $motiflength+$y-$k, $k );
- my $post = substr($concat, $motiflength+$y+$motiflength, $k);
-# print "adding to phases : $phase - $pre and $post\n" if $printer == 1;
- push @{$prephases{$phase}} , $pre;
- push @{$postphases{$phase}} , $post;
- }
-
- }
-# print "firstpass 1= $firstpass\n" if $printer == 1;
- return "non" if $firstpass ==0;
- $firstpass =0;
-
- foreach my $phase (@phases){
- my @pres = @{$prephases{$phase}};
- my @posts = @{$postphases{$phase}};
-
- foreach my $pre (@pres){
- foreach my $post (@posts){
-
- $firstpass = 1 if $indel =~ /($pre)?($phase)+($post)?/i && length($indel) > (3 * length($motif));
- $firstpass = 1 if $indel =~ /^($pre)?($phase)+($post)?$/i && length($indel) < (3 * length($motif));
-# print "matched here : ($pre)?($phase)+($post)?\n" if $printer == 1;
- last if $firstpass == 1;
- }
- last if $firstpass == 1;
- }
- last if $firstpass == 1;
- }
-# print "firstpass 2= $firstpass\n" if $printer == 1;
- return "non" if $firstpass ==0;
- return "mot" if $firstpass ==1;
-}
-
-
-sub checkIndelType_ComplexAnalysis{
- my $printer = 0;
- my $node = $_[0];
- my $indel = $_[1];
- my $motif = $_[2];
- my $alignmentpt = $_[3];
- my $pos = $_[4];
- my $type = $_[5];
- my @speciesinvolved = $node =~ /[A-Z]+/g;
-
- my @seqs = ();
- my $residualseq = length($motif) - length($indel);
-# print "IN COMPLEX ANALYSIS ... received: @_ .... speciesinvolved = @speciesinvolved\n" if $printer == 1;
-# print "we have position = $pos, sseq = $alignmentpt->{$speciesinvolved[0]}\n" if $printer == 1;
-# print "residualseq = $residualseq\n" if $printer == 1;
-# print "pos=$pos... got: @_\n" if $printer == 1;
- foreach my $sp (@speciesinvolved){
- my $spseq = $alignmentpt->{$sp};
- #print "orig spseq = $spseq\n";
- my $subseq = ();
-
- if ($type eq "deletion"){
- my @indelparts = split(/\s*/,$indel);
- my @seqparts = split(/\s*/,$spseq);
-
- for my $p ($pos ... $pos+length($indel)-1){
- $seqparts[$p] = shift @indelparts;
- }
- $spseq = join("",@seqparts);
- }
- #print "mod spseq = $spseq\n";
- # $spseq=~ s/\-//g if $type !~ /deletion/;
-# print "substr($spseq, $pos-($residualseq), length($indel)+$residualseq+$residualseq)\n" if $pos > 0 && $pos < (length($spseq) - length($motif)) && $printer == 1;
-# print "substr($spseq, 0, length($indel)+$residualseq)\n" if $pos == 0 && $printer == 1;
-# print "substr($spseq, $pos - $residualseq, length($indel)+$residualseq)\n" if $pos >= (length($spseq) - length($motif)) && $printer == 1;
-
- $subseq = substr($spseq, $pos-($residualseq), length($indel)+$residualseq+$residualseq) if $pos > 0 && $pos < (length($spseq) - length($motif)) ;
- $subseq = substr($spseq, 0, length($indel)+$residualseq) if $pos == 0;
- $subseq = substr($spseq, $pos - $residualseq, length($indel)+$residualseq) if $pos >= (length($spseq) - length($motif)) ;
-# print "spseq = $spseq . subseq=$subseq . type = $type\n" if $printer == 1;
- # if $subseq !~ /[a-z\-]/i;
- $subseq =~ s/\-/$indel/g if $type =~ /insertion/;
- push @seqs, $subseq;
-# print "seqs = @seqs\n" if $printer == 1;
- }
- return "non" if checkIfSeqsIdentical(@seqs) eq "NO";
-# print "checking for $seqs[0] \n" if $printer == 1;
-
- my @phases =();
- my %prephases = ();
- my %postphases = ();
- my $concat = $motif.$motif.$motif.$motif;
- my $motiflength = length($motif);
-
- my $firstpass = 0;
-
- for my $y (0 ... $motiflength-1){
- my $phase = substr($concat, $motiflength+$y, $motiflength);
- push @phases, $phase;
- $firstpass = 1 if $seqs[0] =~ /$phase/i;
- for my $k (0 ... length($motif)-1){
- my $pre = substr($concat, $motiflength+$y-$k, $k );
- my $post = substr($concat, $motiflength+$y+$motiflength, $k);
-# print "adding to phases : $phase - $pre and $post\n" if $printer == 1;
- push @{$prephases{$phase}} , $pre;
- push @{$postphases{$phase}} , $post;
- }
-
- }
-# print "firstpass 1= $firstpass.. also, res-d = ",(length($seqs[0]))%(length($motif)),"\n" if $printer == 1;
- return "non" if $firstpass ==0;
- $firstpass =0;
- foreach my $phase (@phases){
-
- $firstpass = 1 if $seqs[0] =~ /^($phase)+$/i && ((length($seqs[0]))%(length($motif))) == 0;
-
- if (((length($seqs[0]))%(length($motif))) != 0){
- my @pres = @{$prephases{$phase}};
- my @posts = @{$postphases{$phase}};
- foreach my $pre (@pres){
- foreach my $post (@posts){
- next if $pre !~ /\S/ && $post !~ /\S/;
- $firstpass = 1 if ($seqs[0] =~ /^($pre)($phase)+($post)$/i || $seqs[0] =~ /^($pre)($phase)+$/i || $seqs[0] =~ /^($phase)+($post)$/i);
-# print "caught with $pre $phase $post\n" if $printer == 1;
- last if $firstpass == 1;
- }
- last if $firstpass == 1;
- }
- }
-
- last if $firstpass == 1;
- }
-
- #print "indel = $indel.. motif = $motif.. firstpass 2= mot\n" if $firstpass ==1;
- #print "indel = $indel.. motif = $motif.. firstpass 2= non\n" if $firstpass ==0;
- #;# if $firstpass ==1;
- return "non" if $firstpass ==0;
- return "mot" if $firstpass ==1;
-
-}
-
-sub checkIfSeqsIdentical{
- my @seqs = @_;
- my $identical = 1;
-
- for my $j (1 ... $#seqs){
- $identical = 0 if uc($seqs[0]) ne uc($seqs[$j]);
- }
- return "NO" if $identical == 0;
- return "YES" if $identical == 1;
-
-}
-
-sub summarizeMutations{
- my $mutspt = $_[0];
- my @muts = @$mutspt;
- my $tree = $_[1];
-
- my @returnarr = ();
-
- for (1 ... 38){
- push @returnarr, "NA";
- }
- push @returnarr, "NULL";
- return @returnarr if $tree eq "NULL" || scalar(@muts) < 1;
-
-
- my @bspecies = ();
- my @dspecies = ();
- my $treecopy = $tree;
- $treecopy =~ s/[\(\)]//g;
- my @treeparts = split(/[\.,]+/, $treecopy);
-
- for my $part (@treeparts){
- if ($part =~ /\+/){
- $part =~ s/\+//g;
- #my @sp = split(/\s*/, $part);
- #foreach my $p (@sp) {push @bspecies, $p;}
- push @bspecies, $part;
- }
- if ($part =~ /\-/){
- $part =~ s/\-//g;
- #my @sp = split(/\s*/, $part);
- #foreach my $p (@sp) {push @dspecies, $p;}
- push @dspecies, $part;
- }
-
- }
- #print "-------------------------------------------------------\n";
-
- my ($insertions, $deletions, $motinsertions, $motinsertionsf, $motdeletions, $motdeletionsf, $noninsertions, $nondeletions) = (0,0,0,0,0,0,0,0);
- my ($binsertions, $bdeletions, $bmotinsertions,$bmotinsertionsf, $bmotdeletions, $bmotdeletionsf, $bnoninsertions, $bnondeletions) = (0,0,0,0,0,0,0,0);
- my ($dinsertions, $ddeletions, $dmotinsertions,$dmotinsertionsf, $dmotdeletions, $dmotdeletionsf, $dnoninsertions, $dnondeletions) = (0,0,0,0,0,0,0,0);
- my ($ninsertions, $ndeletions, $nmotinsertions,$nmotinsertionsf, $nmotdeletions, $nmotdeletionsf, $nnoninsertions, $nnondeletions) = (0,0,0,0,0,0,0,0);
- my ($substitutions, $bsubstitutions, $dsubstitutions, $nsubstitutions, $indels, $subs) = (0,0,0,0,"NA","NA");
-
- my @insertionsarr = (" ");
- my @deletionsarr = (" ");
-
- my @substitutionsarr = (" ");
-
-
- foreach my $mut (@muts){
- # print "mut = $mut\n";
- chomp $mut;
- $mut =~ s/=\t/= /g;
- $mut =~ s/=$/= /g;
- my %mhash = ();
- my @mields = split(/\t/,$mut);
-
- foreach my $m (@mields){
- my @fields = split(/=/,$m);
- next if $fields[1] eq " ";
- $mhash{$fields[0]} = $fields[1];
- }
-
- my $myutype = ();
- my $decided = 0;
-
- my $localnode = $mhash{"node"};
- $localnode =~ s/[\(\)\. ,]//g;
-
-
- foreach my $s (@bspecies){
- if ($localnode eq $s) {
- $decided = 1; $myutype = "b";
- }
- }
-
- foreach my $s (@dspecies){
- if ($localnode eq $s) {
- $decided = 1; $myutype = "d";
- }
- }
-
- $myutype = "n" if $decided != 1;
-
-
- # print "tree=$tree, birth species=@bspecies, death species=@dspecies, node=$mhash{node} .. myutype=$myutype .. \n";
- # if $mhash{"type"} eq "insertion" && $myutype eq "b";
-
-
- if ($mhash{"type"} eq "substitution"){
- $substitutions++;
- $bsubstitutions++ if $myutype eq "b";
- $dsubstitutions++ if $myutype eq "d";
- $nsubstitutions++ if $myutype eq "n";
- # print "substitution: from= $mhash{from}, to = $mhash{to}, and type = myutype\n";
- push @substitutionsarr, "$mhash{position}:".$mhash{"from"}.">".$mhash{"to"} if $myutype eq "b";
- push @substitutionsarr, "$mhash{position}:".$mhash{"from"}.">".$mhash{"to"} if $myutype eq "d";
- push @substitutionsarr, "$mhash{position}:".$mhash{"from"}.">".$mhash{"to"} if $myutype eq "n";
- # print "substitutionsarr = @substitutionsarr\n";
- # ;
- }
- else{
- #print "tree=$tree, birth species=@bspecies, death species=@dspecies, node=$mhash{node} .. myutype=$myutype .. indeltype=$mhash{indeltype}\n";
- if ($mhash{"type"} eq "deletion"){
- $deletions++;
-
- $motdeletions++ if $mhash{"indeltype"} =~ /dmot/;
- $motdeletionsf++ if $mhash{"indeltype"} =~ /dmotf/;
-
- $nondeletions++ if $mhash{"indeltype"} =~ /dnon/;
-
- $bdeletions++ if $myutype eq "b";
- $ddeletions++ if $myutype eq "d";
- $ndeletions++ if $myutype eq "n";
-
- $bmotdeletions++ if $mhash{"indeltype"} =~ /dmot/ && $myutype eq "b";
- $bmotdeletionsf++ if $mhash{"indeltype"} =~ /dmotf/ && $myutype eq "b";
- $bnondeletions++ if $mhash{"indeltype"} =~ /dnon/ && $myutype eq "b";
-
- $dmotdeletions++ if $mhash{"indeltype"} =~ /dmot/ && $myutype eq "d";
- $dmotdeletionsf++ if $mhash{"indeltype"} =~ /dmotf/ && $myutype eq "d";
- $dnondeletions++ if $mhash{"indeltype"} =~ /dnon/ && $myutype eq "d";
-
- $nmotdeletions++ if $mhash{"indeltype"} =~ /dmot/ && $myutype eq "n";
- $nmotdeletionsf++ if $mhash{"indeltype"} =~ /dmotf/ && $myutype eq "n";
- $nnondeletions++ if $mhash{"indeltype"} =~ /dnon/ && $myutype eq "n";
-
- push @deletionsarr, "$mhash{indeltype}:$mhash{position}:".$mhash{"deletion"} if $myutype eq "b";
- push @deletionsarr, "$mhash{indeltype}:$mhash{position}:".$mhash{"deletion"} if $myutype eq "d";
- push @deletionsarr, "$mhash{indeltype}:$mhash{position}:".$mhash{"deletion"} if $myutype eq "n";
- }
-
- if ($mhash{"type"} eq "insertion"){
- $insertions++;
-
- $motinsertions++ if $mhash{"indeltype"} =~ /imot/;
- $motinsertionsf++ if $mhash{"indeltype"} =~ /imotf/;
- $noninsertions++ if $mhash{"indeltype"} =~ /inon/;
-
- $binsertions++ if $myutype eq "b";
- $dinsertions++ if $myutype eq "d";
- $ninsertions++ if $myutype eq "n";
-
- $bmotinsertions++ if $mhash{"indeltype"} =~ /imot/ && $myutype eq "b";
- $bmotinsertionsf++ if $mhash{"indeltype"} =~ /imotf/ && $myutype eq "b";
- $bnoninsertions++ if $mhash{"indeltype"} =~ /inon/ && $myutype eq "b";
-
- $dmotinsertions++ if $mhash{"indeltype"} =~ /imot/ && $myutype eq "d";
- $dmotinsertionsf++ if $mhash{"indeltype"} =~ /imotf/ && $myutype eq "d";
- $dnoninsertions++ if $mhash{"indeltype"} =~ /inon/ && $myutype eq "d";
-
- $nmotinsertions++ if $mhash{"indeltype"} =~ /imot/ && $myutype eq "n";
- $nmotinsertionsf++ if $mhash{"indeltype"} =~ /imotf/ && $myutype eq "n";
- $nnoninsertions++ if $mhash{"indeltype"} =~ /inon/ && $myutype eq "n";
-
- push @insertionsarr, "$mhash{indeltype}:$mhash{position}:".$mhash{"insertion"} if $myutype eq "b";
- push @insertionsarr, "$mhash{indeltype}:$mhash{position}:".$mhash{"insertion"} if $myutype eq "d";
- push @insertionsarr, "$mhash{indeltype}:$mhash{position}:".$mhash{"insertion"} if $myutype eq "n";
-
- }
- }
- }
-
-
-
- $indels = "ins=".join(",",@insertionsarr).";dels=".join(",",@deletionsarr) if scalar(@insertionsarr) > 1 || scalar(@deletionsarr) > 1 ;
- $subs = join(",",@substitutionsarr) if scalar(@substitutionsarr) > 1;
- $indels =~ s/ //g;
- $subs =~ s/ //g ;
-
- #print "indels = $indels, subs=$subs\n";
- ## if $indels =~ /[a-zA-Z0-9]/ || $subs =~ /[a-zA-Z0-9]/ ;
- #print "tree = $tree, indels = $indels, subs = $subs, bspecies = @bspecies, dspecies = @dspecies \n";
- my @returnarray = ();
-
- push (@returnarray, $indels, $subs) ;
-
- push @returnarray, $tree;
-
- my @copy = @returnarray;
- #print "\n\nreturnarray = @returnarray ... binsertions=$binsertions dinsertions=$dinsertions bsubstitutions=$bsubstitutions dsubstitutions=$dsubstitutions\n";
- #;
- return (@returnarray);
-
-}
-
-sub selectBetterTree{
- my $printer = 1;
- my $treestudy = $_[0];
- my $alt = $_[1];
- my $mutspt = $_[2];
- my @muts = @$mutspt;
- my @trees = (); my @alternatetrees=();
-
- @trees = split(/\|/,$treestudy) if $treestudy =~ /\|/;
- @alternatetrees = split(/[\|;]/,$alt) if $alt =~ /[\|;\(\)]/;
-
- $trees[0] = $treestudy if $treestudy !~ /\|/;
- $alternatetrees[0] = $alt if $alt !~ /[\|;\(\)]/;
-
- my @alltrees = (@trees, @alternatetrees);
-# push(@alltrees,@alternatetrees);
-
- my %mutspecies = ();
-# print "IN selectBetterTree..treestudy=$treestudy. alt=$alt. for: @_. trees=@trees<. alternatetrees=@alternatetrees\n" if $printer == 1;
- #;
- foreach my $mut (@muts){
-# print colored ['green'],"mut = $mut\n" if $printer == 1;
- $mut =~ /node=([A-Z,\(\) ]+)/;
- my $node = $1;
- $node =~s/[,\(\) ]+//g;
- my @indivspecies = $node =~ /[A-Z]+/g;
- #print "adding node: $node\n" if $printer == 1;
- $mutspecies{$node} = $node;
-
- }
-
- my @treerecords = ();
- my $treecount = -1;
- foreach my $tree (@alltrees){
-# print "checking with tree $tree\n" if $printer == 1;
- $treecount++;
- $treerecords[$treecount] = 0;
- my @indivspecies = ($tree =~ /[A-Z]+/g);
-# print "indivspecies=@indivspecies\n" if $printer == 1;
- foreach my $species (@indivspecies){
-# print "checkin if exists species: $species\n" if $printer == 1;
- $treerecords[$treecount]+=2 if exists $mutspecies{$species} && $mutspecies{$species} !~ /indeltype=[a-z]mot/;
- $treerecords[$treecount]+=1.5 if exists $mutspecies{$species} && $mutspecies{$species} =~ /indeltype=[a-z]mot/;
- $treerecords[$treecount]-- if !exists $mutspecies{$species};
- }
-# print "for tree $tree, our treecount = $treerecords[$treecount]\n" if $printer == 1;
- }
-
- my @best_tree = array_largest_number_arrayPosition(@treerecords);
-# print "treerecords = @treerecords. hence, best tree = @best_tree = $alltrees[$best_tree[0]], $treerecords[$best_tree[0]]\n" if $printer == 1;
- #;
- return ($alltrees[$best_tree[0]], $treerecords[$best_tree[0]]) if scalar(@best_tree) == 1;
-# print "best_tree[0] = $best_tree[0], and treerecords = $treerecords[$best_tree[0]]\n" if $printer == 1;
- return ("NULL", -1) if $treerecords[$best_tree[0]] < 1;
- my $rando = int(rand($#trees));
- return ($alltrees[$rando], $treerecords[$rando]) if scalar(@best_tree) > 1;
-
-}
-
-
-
-
-sub load_sameHash{
- #my $g = %$_[0];
- $sameHash{"CAGT"}="AGTC";
- $sameHash{"ATGA"}="AATG";
- $sameHash{"CAAC"}="AACC";
- $sameHash{"GGAA"}="AAGG";
- $sameHash{"TAAG"}="AAGT";
- $sameHash{"CGAG"}="AGCG";
- $sameHash{"TAGG"}="AGGT";
- $sameHash{"GCAG"}="AGGC";
- $sameHash{"TAGA"}="ATAG";
- $sameHash{"TGA"}="ATG";
- $sameHash{"CAAG"}="AAGC";
- $sameHash{"CTAA"}="AACT";
- $sameHash{"CAAT"}="AATC";
- $sameHash{"GTAG"}="AGGT";
- $sameHash{"GAAG"}="AAGG";
- $sameHash{"CGA"}="ACG";
- $sameHash{"GTAA"}="AAGT";
- $sameHash{"ACAA"}="AAAC";
- $sameHash{"GCGG"}="GGGC";
- $sameHash{"ATCA"}="AATC";
- $sameHash{"TAAC"}="AACT";
- $sameHash{"GGCA"}="AGGC";
- $sameHash{"TGAG"}="AGTG";
- $sameHash{"AACA"}="AAAC";
- $sameHash{"GAGC"}="AGCG";
- $sameHash{"ACCA"}="AACC";
- $sameHash{"TGAA"}="AATG";
- $sameHash{"ACA"}="AAC";
- $sameHash{"GAAC"}="AACG";
- $sameHash{"GCA"}="AGC";
- $sameHash{"CCAC"}="ACCC";
- $sameHash{"CATA"}="ATAC";
- $sameHash{"CAC"}="ACC";
- $sameHash{"TACA"}="ATAC";
- $sameHash{"GGAC"}="ACGG";
- $sameHash{"AGA"}="AAG";
- $sameHash{"ATAA"}="AAAT";
- $sameHash{"CA"}="AC";
- $sameHash{"CCCA"}="ACCC";
- $sameHash{"TCAA"}="AATC";
- $sameHash{"CAGA"}="AGAC";
- $sameHash{"AATA"}="AAAT";
- $sameHash{"CCA"}="ACC";
- $sameHash{"AGAA"}="AAAG";
- $sameHash{"AGTA"}="AAGT";
- $sameHash{"GACG"}="ACGG";
- $sameHash{"TCAG"}="AGTC";
- $sameHash{"ACGA"}="AACG";
- $sameHash{"CGCA"}="ACGC";
- $sameHash{"GAGT"}="AGTG";
- $sameHash{"GA"}="AG";
- $sameHash{"TA"}="AT";
- $sameHash{"TAA"}="AAT";
- $sameHash{"CAG"}="AGC";
- $sameHash{"GATA"}="ATAG";
- $sameHash{"GTA"}="AGT";
- $sameHash{"CCAA"}="AACC";
- $sameHash{"TAG"}="AGT";
- $sameHash{"CAAA"}="AAAC";
- $sameHash{"AAGA"}="AAAG";
- $sameHash{"CACG"}="ACGC";
- $sameHash{"GTCA"}="AGTC";
- $sameHash{"GGA"}="AGG";
- $sameHash{"GGAT"}="ATGG";
- $sameHash{"CGGG"}="GGGC";
- $sameHash{"CGGA"}="ACGG";
- $sameHash{"AGGA"}="AAGG";
- $sameHash{"TAAA"}="AAAT";
- $sameHash{"GAGA"}="AGAG";
- $sameHash{"ACTA"}="AACT";
- $sameHash{"GCGA"}="AGCG";
- $sameHash{"CACA"}="ACAC";
- $sameHash{"AGAT"}="ATAG";
- $sameHash{"GAGG"}="AGGG";
- $sameHash{"CGAC"}="ACCG";
- $sameHash{"GGAG"}="AGGG";
- $sameHash{"GCCA"}="AGCC";
- $sameHash{"CCAG"}="AGCC";
- $sameHash{"GAAA"}="AAAG";
- $sameHash{"CAGG"}="AGGC";
- $sameHash{"GAC"}="ACG";
- $sameHash{"CAA"}="AAC";
- $sameHash{"GACC"}="ACCG";
- $sameHash{"GGCG"}="GGGC";
- $sameHash{"GGTA"}="AGGT";
- $sameHash{"AGCA"}="AAGC";
- $sameHash{"GATG"}="ATGG";
- $sameHash{"GTGA"}="AGTG";
- $sameHash{"ACAG"}="AGAC";
- $sameHash{"CGG"}="GGC";
- $sameHash{"ATA"}="AAT";
- $sameHash{"GACA"}="AGAC";
- $sameHash{"GCAA"}="AAGC";
- $sameHash{"CAGC"}="AGCC";
- $sameHash{"GGGA"}="AGGG";
- $sameHash{"GAG"}="AGG";
- $sameHash{"ACAT"}="ATAC";
- $sameHash{"GAAT"}="AATG";
- $sameHash{"CACC"}="ACCC";
- $sameHash{"GAT"}="ATG";
- $sameHash{"GCG"}="GGC";
- $sameHash{"GCAC"}="ACGC";
- $sameHash{"GAA"}="AAG";
- $sameHash{"TGGA"}="ATGG";
- $sameHash{"CCGA"}="ACCG";
- $sameHash{"CGAA"}="AACG";
-}
-
-
-
-sub load_revHash{
- $revHash{"CTGA"}="AGTC";
- $revHash{"TCTT"}="AAAG";
- $revHash{"CTAG"}="AGCT";
- $revHash{"GGTG"}="ACCC";
- $revHash{"GCC"}="GGC";
- $revHash{"GCTT"}="AAGC";
- $revHash{"GCGT"}="ACGC";
- $revHash{"GTTG"}="AACC";
- $revHash{"CTCC"}="AGGG";
- $revHash{"ATC"}="ATG";
- $revHash{"CGAT"}="ATCG";
- $revHash{"TTAA"}="AATT";
- $revHash{"GTTC"}="AACG";
- $revHash{"CTGC"}="AGGC";
- $revHash{"TCGA"}="ATCG";
- $revHash{"ATCT"}="ATAG";
- $revHash{"GGTT"}="AACC";
- $revHash{"CTTA"}="AAGT";
- $revHash{"TGGC"}="AGCC";
- $revHash{"CCG"}="GGC";
- $revHash{"CGGC"}="GGCC";
- $revHash{"TTAG"}="AACT";
- $revHash{"GTG"}="ACC";
- $revHash{"CTTT"}="AAAG";
- $revHash{"TGCA"}="ATGC";
- $revHash{"CGCT"}="AGCG";
- $revHash{"TTCC"}="AAGG";
- $revHash{"CT"}="AG";
- $revHash{"C"}="G";
- $revHash{"CTCT"}="AGAG";
- $revHash{"ACTT"}="AAGT";
- $revHash{"GGTC"}="ACCG";
- $revHash{"ATTC"}="AATG";
- $revHash{"GGGT"}="ACCC";
- $revHash{"CCTA"}="AGGT";
- $revHash{"CGCG"}="GCGC";
- $revHash{"GTGT"}="ACAC";
- $revHash{"GCCC"}="GGGC";
- $revHash{"GTCG"}="ACCG";
- $revHash{"TCCC"}="AGGG";
- $revHash{"TTCA"}="AATG";
- $revHash{"AGTT"}="AACT";
- $revHash{"CCCT"}="AGGG";
- $revHash{"CCGC"}="GGGC";
- $revHash{"CTT"}="AAG";
- $revHash{"TTGG"}="AACC";
- $revHash{"ATT"}="AAT";
- $revHash{"TAGC"}="AGCT";
- $revHash{"ACTG"}="AGTC";
- $revHash{"TCAC"}="AGTG";
- $revHash{"CTGT"}="AGAC";
- $revHash{"TGTG"}="ACAC";
- $revHash{"ATCC"}="ATGG";
- $revHash{"GTGG"}="ACCC";
- $revHash{"TGGG"}="ACCC";
- $revHash{"TCGG"}="ACCG";
- $revHash{"CGGT"}="ACCG";
- $revHash{"GCTC"}="AGCG";
- $revHash{"TACG"}="ACGT";
- $revHash{"GTTT"}="AAAC";
- $revHash{"CAT"}="ATG";
- $revHash{"CATG"}="ATGC";
- $revHash{"GTTA"}="AACT";
- $revHash{"CACT"}="AGTG";
- $revHash{"TCAT"}="AATG";
- $revHash{"TTA"}="AAT";
- $revHash{"TGTA"}="ATAC";
- $revHash{"TTTC"}="AAAG";
- $revHash{"TACT"}="AAGT";
- $revHash{"TGTT"}="AAAC";
- $revHash{"CTA"}="AGT";
- $revHash{"GACT"}="AGTC";
- $revHash{"TTGC"}="AAGC";
- $revHash{"TTC"}="AAG";
- $revHash{"GCT"}="AGC";
- $revHash{"GCAT"}="ATGC";
- $revHash{"TGGT"}="AACC";
- $revHash{"CCT"}="AGG";
- $revHash{"CATC"}="ATGG";
- $revHash{"CCAT"}="ATGG";
- $revHash{"CCCG"}="GGGC";
- $revHash{"TGCC"}="AGGC";
- $revHash{"TG"}="AC";
- $revHash{"TGCT"}="AAGC";
- $revHash{"GCCG"}="GGCC";
- $revHash{"TCTG"}="AGAC";
- $revHash{"TGT"}="AAC";
- $revHash{"TTAT"}="AAAT";
- $revHash{"TAGT"}="AACT";
- $revHash{"TATG"}="ATAC";
- $revHash{"TTTA"}="AAAT";
- $revHash{"CGTA"}="ACGT";
- $revHash{"TA"}="AT";
- $revHash{"TGTC"}="AGAC";
- $revHash{"CTAT"}="ATAG";
- $revHash{"TATA"}="ATAT";
- $revHash{"TAC"}="AGT";
- $revHash{"TC"}="AG";
- $revHash{"CATT"}="AATG";
- $revHash{"TCG"}="ACG";
- $revHash{"ATTT"}="AAAT";
- $revHash{"CGTG"}="ACGC";
- $revHash{"CTG"}="AGC";
- $revHash{"TCGT"}="AACG";
- $revHash{"TCCG"}="ACGG";
- $revHash{"GTT"}="AAC";
- $revHash{"ATGT"}="ATAC";
- $revHash{"CTTG"}="AAGC";
- $revHash{"CCTT"}="AAGG";
- $revHash{"GATC"}="ATCG";
- $revHash{"CTGG"}="AGCC";
- $revHash{"TTCT"}="AAAG";
- $revHash{"CGTC"}="ACGG";
- $revHash{"CG"}="GC";
- $revHash{"TATT"}="AAAT";
- $revHash{"CTCG"}="AGCG";
- $revHash{"TCTC"}="AGAG";
- $revHash{"TCCT"}="AAGG";
- $revHash{"TGG"}="ACC";
- $revHash{"ACTC"}="AGTG";
- $revHash{"CTC"}="AGG";
- $revHash{"CGC"}="GGC";
- $revHash{"TTG"}="AAC";
- $revHash{"ACCT"}="AGGT";
- $revHash{"TCTA"}="ATAG";
- $revHash{"GTAC"}="ACGT";
- $revHash{"TTGA"}="AATC";
- $revHash{"GTCC"}="ACGG";
- $revHash{"GATT"}="AATC";
- $revHash{"T"}="A";
- $revHash{"CGTT"}="AACG";
- $revHash{"GTC"}="ACG";
- $revHash{"GCCT"}="AGGC";
- $revHash{"TGC"}="AGC";
- $revHash{"TTTG"}="AAAC";
- $revHash{"GGCT"}="AGCC";
- $revHash{"TCA"}="ATG";
- $revHash{"GTGC"}="ACGC";
- $revHash{"TGAT"}="AATC";
- $revHash{"TAT"}="AAT";
- $revHash{"CTAC"}="AGGT";
- $revHash{"TGCG"}="ACGC";
- $revHash{"CTCA"}="AGTG";
- $revHash{"CTTC"}="AAGG";
- $revHash{"GCTG"}="AGCC";
- $revHash{"TATC"}="ATAG";
- $revHash{"TAAT"}="AATT";
- $revHash{"ACT"}="AGT";
- $revHash{"TCGC"}="AGCG";
- $revHash{"GGT"}="ACC";
- $revHash{"TCC"}="AGG";
- $revHash{"TTGT"}="AAAC";
- $revHash{"TGAC"}="AGTC";
- $revHash{"TTAC"}="AAGT";
- $revHash{"CGT"}="ACG";
- $revHash{"ATTA"}="AATT";
- $revHash{"ATTG"}="AATC";
- $revHash{"CCTC"}="AGGG";
- $revHash{"CCGG"}="GGCC";
- $revHash{"CCGT"}="ACGG";
- $revHash{"TCCA"}="ATGG";
- $revHash{"CGCC"}="GGGC";
- $revHash{"GT"}="AC";
- $revHash{"TTCG"}="AACG";
- $revHash{"CCTG"}="AGGC";
- $revHash{"TCT"}="AAG";
- $revHash{"GTAT"}="ATAC";
- $revHash{"GTCT"}="AGAC";
- $revHash{"GCTA"}="AGCT";
- $revHash{"TACC"}="AGGT";
-}
-
-
-sub allCaps{
- my $motif = $_[0];
- $motif =~ s/a/A/g;
- $motif =~ s/c/C/g;
- $motif =~ s/t/T/g;
- $motif =~ s/g/G/g;
- return $motif;
-}
-
-
-sub all_caps{
- my @strand = split(/\s*/,$_[0]);
- for my $i (0 ... $#strand){
- if ($strand[$i] =~ /c/) {$strand[$i] = "C";next;}
- if ($strand[$i] =~ /a/) {$strand[$i] = "A";next;}
- if ($strand[$i] =~ /t/) { $strand[$i] = "T";next;}
- if ($strand[$i] =~ /g/) {$strand[$i] = "G";next;}
- }
- return join("",@strand);
-}
-sub array_mean{
- return "NA" if scalar(@_) == 0;
- my $sum = 0;
- foreach my $val (@_){
- $sum = $sum + $val;
- }
- return ($sum/scalar(@_));
-}
-sub array_sum{
- return "NA" if scalar(@_) == 0;
- my $sum = 0;
- foreach my $val (@_){
- $sum = $sum + $val;
- }
- return ($sum);
-}
-
-sub variance{
- return "NA" if scalar(@_) == 0;
- return 0 if scalar(@_) == 1;
- my $mean = array_mean(@_);
- my $num = 0;
- return 0 if scalar(@_) == 1;
-# print "mean = $mean .. array = >@_<\n";
- foreach my $ele (@_){
- # print "$num = $num + ($ele-$mean)*($ele-$mean)\n";
- $num = $num + ($ele-$mean)*($ele-$mean);
- }
- my $var = $num / scalar(@_);
- return $var;
-}
-
-sub array_95confIntervals{
- return "NA" if scalar(@_) <= 0;
- my @sorted = sort { $a <=> $b } @_;
-# print "@sorted=",scalar(@sorted), "\n";
- my $aDeechNo = int((scalar(@sorted) * 2.5) / 100);
- my $saaDeNo = int((scalar(@sorted) * 97.5) / 100);
-
- return ($sorted[$aDeechNo], $sorted[$saaDeNo]);
-}
-
-sub array_median{
- return "NA" if scalar(@_) == 0;
- return $_[0] if scalar(@_) == 1;
- my @sorted = sort { $a <=> $b } @_;
- my $totalno = scalar(@sorted);
-
- #print "sorted = @sorted\n";
-
- my $pick = ();
- if ($totalno % 2 == 1){
- #print "odd set .. totalno = $totalno\n";
- my $mid = $totalno / 2;
- my $onehalfno = $mid - $mid % 1;
- my $secondhalfno = $onehalfno + 1;
- my $onehalf = $sorted[$onehalfno-1];
- my $secondhalf = $sorted[$secondhalfno-1];
- #print "onehalfno = $onehalfno and secondhalfno = $secondhalfno \n onehalf = $onehalf and secondhalf = $secondhalf\n";
-
- $pick = $secondhalf;
- }
- else{
- #print "even set .. totalno = $totalno\n";
- my $mid = $totalno / 2;
- my $onehalfno = $mid;
- my $secondhalfno = $onehalfno + 1;
- my $onehalf = $sorted[$onehalfno-1];
- my $secondhalf = $sorted[$secondhalfno-1];
- #print "onehalfno = $onehalfno and secondhalfno = $secondhalfno \n onehalf = $onehalf and secondhalf = $secondhalf\n";
- $pick = ($onehalf + $secondhalf )/2;
-
- }
- #print "pick = $pick..\n";
- return $pick;
-
-}
-
-
-sub array_numerical_sort{
- return "NA" if scalar(@_) == 0;
- my @sorted = sort { $a <=> $b } @_;
- return (@sorted);
-}
-
-sub array_smallest_number{
- return "NA" if scalar(@_) == 0;
- return $_[0] if scalar(@_) == 1;
- my @sorted = sort { $a <=> $b } @_;
- return $sorted[0];
-}
-
-
-sub array_largest_number{
- return "NA" if scalar(@_) == 0;
- return $_[0] if scalar(@_) == 1;
- my @sorted = sort { $a <=> $b } @_;
- return $sorted[$#sorted];
-}
-
-
-sub array_largest_number_arrayPosition{
- return "NA" if scalar(@_) == 0;
- return 0 if scalar(@_) == 1;
- my $maxpos = 0;
- my @maxposes = ();
- my @maxvals = ();
- my $maxval = array_smallest_number(@_);
- for my $i (0 ... $#_){
- if ($_[$i] > $maxval){
- $maxval = $_[$i];
- $maxpos = $i;
- }
- if ($_[$i] == $maxval){
- $maxval = $_[$i];
- if (scalar(@maxposes) == 0){
- push @maxposes, $i;
- push @maxvals, $_[$i];
-
- }
- elsif ($maxvals[0] == $maxval){
- push @maxposes, $i;
- push @maxvals, $_[$i];
- }
- else{
- @maxposes = (); @maxvals = ();
- push @maxposes, $i;
- push @maxvals, $_[$i];
- }
-
- }
-
- }
- return $maxpos if scalar(@maxposes) < 2;
- return (@maxposes);
-}
-
-sub array_smallest_number_arrayPosition{
- return "NA" if scalar(@_) == 0;
- return 0 if scalar(@_) == 1;
- my $minpos = 0;
- my @minposes = ();
- my @minvals = ();
- my $minval = array_largest_number(@_);
- my $maxval = array_smallest_number(@_);
- #print "starting with $maxval, ending with $minval\n";
- for my $i (0 ... $#_){
- if ($_[$i] < $minval){
- $minval = $_[$i];
- $minpos = $i;
- }
- if ($_[$i] == $minval){
- $minval = $_[$i];
- if (scalar(@minposes) == 0){
- push @minposes, $i;
- push @minvals, $_[$i];
-
- }
- elsif ($minvals[0] == $minval){
- push @minposes, $i;
- push @minvals, $_[$i];
- }
- else{
- @minposes = (); @minvals = ();
- push @minposes, $i;
- push @minvals, $_[$i];
- }
-
- }
-
- }
- #print "minposes=@minposes\n";
-
- return $minpos if scalar(@minposes) < 2;
- return (@minposes);
-}
-
-sub basic_stats{
- my @arr = @_;
-# print " array_smallest_number= ", array_smallest_number(@arr)," array_largest_number= ", array_largest_number(@arr), " array_mean= ",array_mean(@arr),"\n";
- return ":";
-}
-#xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx
-
-sub maftoAxt_multispecies {
- my $printer = 0;
- #print "in maftoAxt_multispecies : got @_\n";
- my $fname=$_[0];
- open(IN,"<$_[0]") or die "Cannot open $_[0]: $! \n";
- my $treedefinition = $_[1];
- #print "treedefinition= $treedefinition\n";
-
- my @treedefinitions = MakeTrees($treedefinition);
-
-
- open(OUT,">$_[2]") or die "Cannot open $_[2]: $! \n";
- my $counter = 0;
- my $exactspeciesset = $_[3];
- my @exactspeciesset_unarranged = split(/,/,$exactspeciesset);
-
- $treedefinition=~s/[\)\(, ]/\t/g;
- my @species=split(/\t+/,$treedefinition);
- @exactspeciesset_unarranged = @species;
-# print "species=@species\n";
-
- my @exactspeciesarr=();
-
-
- foreach my $def (@treedefinitions){
- $def=~s/[\)\(, ]/\t/g;
- my @specs = split(/\t+/,$def);
- my @exactspecies=();
- foreach my $spec (@specs){
- foreach my $espec (@exactspeciesset_unarranged){
- # print "pushing >$spec< nd >$espec<\n" if $spec eq $espec && $espec =~ /[a-zA-Z0-9]/;
- push @exactspecies, $spec if $spec eq $espec && $espec =~ /[a-zA-Z0-9]/;
- }
-
- }
- #print "exactspecies = >@exactspecies<\n";
- push @exactspeciesarr, [@exactspecies];
- }
- #;
- #print "exactspeciesarr=@exactspeciesarr\n";
-
- ###########
- my $select = 2;
- #select = 1 if all species need sequences to be present for each block otherwise, it is 0
- #select = 2 only the allowed set make up the alignment. use the removeset
- # information to detect alignmenets that have other important genomes aligned.
- ###########
- my @allowedset = ();
- @allowedset = split(/;/,allowedSetOfSpecies(join("_",@species))) if $select == 0;
- @allowedset = join("_",0,@species) if $select == 1;
- #print "species = @species , allowedset =",join("\n", @allowedset) ," \n";
-
-
- foreach my $set (@exactspeciesarr){
- my @openset = @$set;
- push @allowedset, join("_",0,@openset) if $select == 2;
- # print "openset = >@openset<, allowedset = @allowedset and exactspecies = @exactspecies\n";
- }
-# ;
- my $start = 0;
- my @sequences = ();
- my @titles = ();
- my $species_counter = "0";
- my $countermatch = 0;
- my $outsideSpecies=0;
-
- while(my $line = ){
- next if $line =~ /^#/;
- next if $line =~ /^i/;
- # print "$line .. species = @species\n";
- chomp $line;
- my @fields = split(/\s+/,$line);
- chomp $line;
- if ($line =~ /^a /){
- $start = 1;
- }
-
- if ($line =~ /^s /){
- # print "fields1 = $fields[1] , start = $start\n";
-
- foreach my $sp (@species){
- if ($fields[1] =~ /$sp/){
- $species_counter = $species_counter."_".$sp;
- push(@sequences, $fields[6]);
- my @sp_info = split(/\./,$fields[1]);
- my $title = join(" ",@sp_info, $fields[2], ($fields[2]+$fields[3]), $fields[4]);
- push(@titles, $title);
-
- }
- }
- }
-
- if (($line !~ /^a/) && ($line !~ /^s/) && ($line !~ /^#/) && ($line !~ /^i/) && ($start = 1)){
-
- my $arranged = reorderSpecies($species_counter, @species);
-# print "species_counter=$species_counter .. arranged = $arranged\n";
-
- my $stopper = 1;
- my $arrno = 0;
- foreach my $set (@allowedset){
-# print "checking $set with $arranged\n";
- if ($arranged eq $set){
-# print "checked $set with $arranged\n";
- $stopper = 0; last;
- }
- $arrno++;
- }
-
- if ($stopper == 0) {
- # print " accepted\n";
- @titles = split ";", orderInfo(join(";", @titles), $species_counter, $arranged) if $species_counter ne $arranged;
-
- @sequences = split ";", orderInfo(join(";", @sequences), $species_counter, $arranged) if $species_counter ne $arranged;
- my $filteredseq = filter_gaps(@sequences);
-
- if ($filteredseq ne "SHORT"){
- $counter++;
- print OUT join (" ",$counter, @titles), "\n";
- print OUT $filteredseq, "\n";
- print OUT "\n";
- $countermatch++;
- }
- # my @filtered_seq = split(/\t/,filter_gaps(@sequences) );
- }
- else{#print "\n";
- }
-
- @sequences = (); @titles = (); $start = 0;$species_counter = "0";
- next;
-
- }
- }
- close IN;
- close OUT;
-# print "countermatch = $countermatch\n";
-# ;
-}
-
-sub reorderSpecies{
- my @inarr=@_;
- my $currSpecies = shift (@inarr);
- my $ordered_species = 0;
- my @species=@inarr;
- foreach my $order (@species){
- $ordered_species = $ordered_species."_".$order if $currSpecies=~ /$order/;
- }
- return $ordered_species;
-
-}
-
-sub filter_gaps{
- my @sequences = @_;
-# print "sequences sent are @sequences\n";
- my $seq_length = length($sequences[0]);
- my $seq_no = scalar(@sequences);
- my $allgaps = ();
- for (1 ... $seq_no){
- $allgaps = $allgaps."-";
- }
-
- my @seq_array = ();
- my $seq_counter = 0;
- foreach my $seq (@sequences){
-# my @sequence = split(/\s*/,$seq);
- $seq_array[$seq_counter] = [split(/\s*/,$seq)];
-# push @seq_array, [@sequence];
- $seq_counter++;
- }
- my $g = 0;
- while ( $g < $seq_length){
- last if (!exists $seq_array[0][$g]);
- my $bases = ();
- for my $u (0 ... $#seq_array){
- $bases = $bases.$seq_array[$u][$g];
- }
-# print $bases, "\n";
- if ($bases eq $allgaps){
-# print "bases are $bases, position is $g \n";
- for my $seq (@seq_array){
- splice(@$seq , $g, 1);
- }
- }
- else {
- $g++;
- }
- }
-
- my @outs = ();
-
- foreach my $seq (@seq_array){
- push(@outs, join("",@$seq));
- }
- return "SHORT" if length($outs[0]) <=100;
- return (join("\n", @outs));
-}
-
-
-sub allowedSetOfSpecies{
- my @allowed_species = split(/_/,$_[0]);
- unshift @allowed_species, 0;
-# print "allowed set = @allowed_species \n";
- my @output = ();
- for (0 ... scalar(@allowed_species) - 4){
- push(@output, join("_",@allowed_species));
- pop @allowed_species;
- }
- return join(";",reverse(@output));
-
-}
-
-
-sub orderInfo{
- my @info = split(/;/,$_[0]);
-# print "info = @info";
- my @old = split(/_/,$_[1]);
- my @new = split(/_/,$_[2]);
- shift @old; shift @new;
- my @outinfo = ();
- foreach my $spe (@new){
- for my $no (0 ... $#old){
- if ($spe eq $old[$no]){
- push(@outinfo, $info[$no]);
- }
- }
- }
-# print "outinfo = @outinfo \n";
- return join(";", @outinfo);
-}
-
-#xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx
-
-sub printarr {
-# print ">::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::\n";
-# foreach my $line (@_) {print "$line\n";}
-# print "::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::<\n";
-}
-
-sub oneOf{
- my @arr = @_;
- my $element = $arr[$#arr];
- @arr = @arr[0 ... $#arr-1];
- my $present = 0;
-
- foreach my $el (@arr){
- $present = 1 if $el eq $element;
- }
- return $present;
-}
-
-#xxxxxxxxxxxxxx MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx
-
-sub MakeTrees{
- my $tree = $_[0];
-# my @parts=($tree);
- my @parts=();
-
-# print "parts=@parts\n";
-
- while (1){
- $tree =~ s/^\(//g;
- $tree =~ s/\)$//g;
- my @arr = ();
-
- if ($tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)\)$/){
- @arr = $tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)$/;
- push @parts, "(".$tree.")";
- $tree = $2;
- }
- elsif ($tree =~ /^\(([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/){
- @arr = $tree =~ /^([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/;
- push @parts, "(".$tree.")";
- $tree = $1;
- }
- elsif ($tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_]+)$/){
- last;
- }
- }
- #print "parts=@parts\n";
- return @parts;
-}
-
-
diff --git a/tools/regVariation/microsatellite_birthdeath.xml b/tools/regVariation/microsatellite_birthdeath.xml
deleted file mode 100755
index 850bd7d1184..00000000000
--- a/tools/regVariation/microsatellite_birthdeath.xml
+++ /dev/null
@@ -1,104 +0,0 @@
-
- and causal mutational mechanisms from previously identified orthologous microsatellite sets
-
- microsatellite_birthdeath.pl
- $alignment
- $orthfile
- $outfile
- $species
- "$tree_definition"
- $thresholds
- $separation
- $simthresh
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This tool uses raw orthologous microsatellite clusters (identified by the tool "Extract orthologous microsatellites") to identify microsatellite births and deaths along individual lineages of a phylogenetic tree.
------
-
-.. class:: warningmark
-
-**Note**
-
-A tab-separated output table (depending on the species being considered) is generated where each row contains all information for a microsatellite locus from multiple species.
-The table typically reads like this:
-
-hg18.chr22 16153057 16153074 A 1 ins=,imot:0:tt;dels= ,9:t>c -panTro2 hg18:tttttttttttttttttt,ponAbe2:--tttttttttttttttt,panTro2:-----ttttctttttttt
-
-hg18.chr22 16131711 16131722 ATGC 4 NA ,2:C>T +ponAbe2 hg18:CACGCATGCATG,ponAbe2:CATGCATGCATG,panTro2:CACGCATGCATG,rheMac2:CACGCGTGCATG
-
-Where columns list the following:
-
-1: Chromosome/scaffold/contig of one of the species. The species chosen is the first species readable in the Newick tree submitted by the user.
-
-2: Start coordinate
-
-3: End coordinate
-
-4: Motif of microsatellite
-
-5: Motif size
-
-6: Insertion and deletion details. Insertions are separated from deletions by a ";", and individual insertions and deletions are separated from others by a comma. For the purpose of illustration, consider the first row listed above:
-"imot:0:tt", where imot/imotf again suggest insertion, the number indicates position of insertion within the microsatellite's alignment, and this is followed by identity of nucleotides that are inserted.
-
-7: Substitution details. Individual substitutions are separated by commas. Each entry contains the position of substitution event in the microsatellites' alignment, and the nature of substitution.
-
-8: Inference of birth/death event. Births are indicated by "+", and deaths by "-". Events such as "-hg18:panTro2" suggest death in the common ancestor of hg18 and panTro2, whereas events such as "-hg18.panTro2" indicate parallel, independent death events along the two lineages. Alternative interpretations of the event may also be listed, following a "/", such as:
-"+hg18.+panTro2 / +hg18:panTro2"
-
-9: Actual sequences in the alignment, separated by commas.
-
-
-
-
-
diff --git a/tools/regVariation/multispecies_MicrosatDataGenerator_interrupted_GALAXY.pl b/tools/regVariation/multispecies_MicrosatDataGenerator_interrupted_GALAXY.pl
deleted file mode 100755
index c739f051c84..00000000000
--- a/tools/regVariation/multispecies_MicrosatDataGenerator_interrupted_GALAXY.pl
+++ /dev/null
@@ -1,5606 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use warnings;
-use Term::ANSIColor;
-use File::Basename;
-use IO::Handle;
-use Cwd;
-use File::Path;
-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);
-use File::Path qw(make_path remove_tree);
-use File::Temp qw/ tempfile tempdir /;
-my $tdir = tempdir( CLEANUP => 1 );
-chdir $tdir;
-my $dir = getcwd;
-#print "dir = $dir\n";
-
-#$ENV{'PATH'} .= ':' . dirname($0);
-my $date = `date`;
-
-my ($mafile, $mafile_sputt, $orthfile, $threshold_array, $allspeciesin, $tree_definition_all, $separation) = @ARGV;
-if (!$mafile or !$mafile_sputt or !$orthfile or !$threshold_array or !$separation or !$tree_definition_all or !$allspeciesin) { die "missing arguments\n"; }
-
-$tree_definition_all =~ s/\s+//g;
-$threshold_array =~ s/\s+//g;
-$allspeciesin =~ s/\s+//g;
-#-------------------------------------------------------------------------------
-# WHICH SPUTNIK USED?
-my $sputnikpath = ();
-$sputnikpath = "sputnik_lowthresh_MATCH_MIN_SCORE3" ;
-#$sputnikpath = "/Users/ydk/work/rhesus_microsat/codes/./sputnik_Mac-PowerPC";
-#print "sputnik_Mac-PowerPC non-existant\n" if !-e $sputnikpath;
-#exit if !-e $sputnikpath;
-#$sputnikpath = "bx-sputnik" ;
-#print "ARGV input = @ARGV\n";
-#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";
-#-------------------------------------------------------------------------------
-# RUNFILE
-#-------------------------------------------------------------------------------
-$distance = 1; #bp
-$distance++;
-my @tree_definitions=MakeTrees($tree_definition_all);
-my $allspeciesset = $tree_definition_all;
-$allspeciesset =~ s/[\(\) ]+//g;
-@allspecies = split(/,/,$allspeciesset);
-
-my @outputfiles = ();
-my $round = 0;
-#my $tdir = tempdir( CLEANUP => 0 );
-#chdir $tdir;
-
-foreach my $tree_definition (@tree_definitions){
- my @commas = ($tree_definition =~ /,/g) ;
- #print "commas = @commas\n"; ;
- next if scalar(@commas) <= 1;
- #print "species_set = $species_set\n";
- $treeSpeciesNum = scalar(@commas) + 1;
- $species_set = $tree_definition;
- $species_set =~ s/[\)\( ;]+//g;
- #print "species_set = $species_set\n"; ;
-
- $round++;
- #-------------------------------------------------------------------------------
- # MICROSATELLITE THRESHOLD SETTINGS (LENGTH, BP)
- $threshold_array=~ s/,/_/g;
- my @thresharr = split("_",$threshold_array);
- @thresholds=@thresharr;
- #my $threshold_array = join("_",($mono_threshold, $di_threshold, $tri_threshold, $tetra_threshold));
- #print "current dit=$dir\n";
- #-------------------------------------------------------------------------------
- # CREATE AXT FILES IN FORWARD AND REVERSE ORDERS IF NECESSARY
- my @chrfiles=();
-
- #my $mafile = "/Users/ydk/work/rhesus_microsat/results/galay/align.txt"; #$ARGV[0];
- my $chromt=int(rand(10000));
- my $p_chr=$chromt;
-
-
- my @exactspeciesset_unarranged = split(/,/,$species_set);
- $tree_definition=~s/[\)\(, ]/\t/g;
- my @treespecies=split(/\t+/,$tree_definition);
- my @exactspecies=();
-
- foreach my $spec (@treespecies){
- foreach my $espec (@exactspeciesset_unarranged){
- push @exactspecies, $spec if $spec eq $espec;
- }
- }
- #print "exactspecies=@exactspecies\n";
- $focalspec = $exactspecies[0];
- my $arranged_species_set=join(".",@exactspecies);
- my $chr_name = join(".",("chr".$p_chr),$arranged_species_set, "net", "axt");
- my $chr_name_sputt = join(".",("chr".$p_chr),$arranged_species_set, "net", "axt_sputt");
- #print "sending to maftoAxt_multispecies: $mafile, $tree_definition, $chr_name, $species_set .. focalspec=$focalspec \n";
- maftoAxt_multispecies($mafile, $tree_definition, $chr_name, $species_set);
- maftoAxt_multispecies($mafile_sputt, $tree_definition, $chr_name_sputt, $species_set);
- #print "done maf to axt conversion\n";
- my $reverse_chr_name = join(".",("chr".$p_chr."r"),$arranged_species_set, "net", "axt");
- artificial_axdata_inverter ($chr_name, $reverse_chr_name);
- #print "reverse_chr_name=$reverse_chr_name\n";
- #-------------------------------------------------------------------------------
- # FIND THE CORRESPONDING CHIMP CHROMOSOME FROM FILE ORTp_chrS.TXT
- foreach my $direct ("reverse_direction","forward_direction"){
- $p_chr=$chromt;
- #print "direction = $direct\n";
- $p_chr = $p_chr."r" if $direct eq "reverse_direction";
- $p_chr = $p_chr if $direct eq "forward_direction";
- my $config = $species_set;
- $config=~s/,/./g;
- my @orgs = split(/\./,$arranged_species_set);
- #print "ORGS= @orgs\n";
- my @tag=@orgs;
-
-
- my $tags = join(",", @tag);
- my @tags=@tag;
- chomp $p_chr;
- $tags = join("_", split(/,/, $tags));
- my $pchr = "chr".$p_chr;
-
- my $ptag = $orgs[0]."-".$pchr.".".join(".",@orgs[1 ... scalar(@orgs)-1])."-".$threshold_array;
- my @sp_tags = ();
-
-# print "$ptag _ orthfile\n"; ;
- #print "orgs=@orgs, pchr=$pchr, hence, ptag = $ptag\n";
- foreach my $sp (@tag){
- push(@sp_tags, ($sp.".".$ptag));
- }
-
- my $preptag = $orgs[0]."-".$pchr.".".join(".",@orgs[1 ... scalar(@orgs)-1]);
- my @presp_tags = ();
-
- foreach my $sp (@tag){
- push(@presp_tags, ($sp.".".$preptag));
- }
-
- my $resultdir = "";
- my $orthdir = "";
- my $filtereddir = "";
- my $pipedir = "";
-
- my @title_queries = ();
- push(@title_queries, "^[0-9]+");
- my $sep="\\s";
- for my $or (0 ... $#orgs){
- my $title = join($sep, ($orgs[$or], "[A-Za-z_]+[0-9a-zA-Z]+", "[0-9]+", "[0-9]+", "[\\-\\+]"));
- #$title =~ s/chr\\+\\s+\+/chr/g;
- push(@title_queries, $title);
- }
- my $title_query = join($sep, @title_queries);
- #print "title_queries=@title_queries\n";
- #print "query = >$title_query<\n";
- #print "orgs = @orgs\n";
- #-------------------------------------------------------------------------------
- # GET AXTNET FILES, EDIT THEM AND SPLIT THEM INTO HUMAN AND CHIMP INPUT FILES
- my $t1input = $pchr.".".$arranged_species_set.".net.axt";
-
- my @t1outputs = ();
-
- foreach my $sp (@presp_tags){
- push(@t1outputs, $sp."_gap_op");
- }
-
-
-
- multi_species_t1($t1input,$tags,(join(",", @t1outputs)), $title_query);
- #print "t1outputs=@t1outputs\n";
- #print "done t1\n"; ;
- #-------------------------------------------------------------------------------
- #START T2.PL
-
- my $stag = (); my $tag1 = (); my $tag2 = (); my $schrs = ();
-
- for my $t (0 ... scalar(@tags)-1){
- multi_species_t2($t1outputs[$t], $tag[$t]);
- }
- #-------------------------------------------------------------------------------
- #START T2.2.PL
-
- my @temp_tags = @tag;
-
- foreach my $sp (@presp_tags){
- my $t2input = $sp."_nogap_op_unrand";
- multi_species_t2_2($t2input, shift(@temp_tags));
- }
- undef (@temp_tags);
-
- #-------------------------------------------------------------------------------
- #START SPUTNIK
-
- my @jobIDs = ();
- @temp_tags = @tag;
- my @sput_filelist = ();
-
- foreach my $sp (@presp_tags){
- #print "sp = $sp\n";
- my $sputnikoutput = $pipedir.$sp."_sput_op0";
- my $sputnikinput = $pipedir.$sp."_nogap_op_unrand";
- push(@sput_filelist, $sputnikinput);
- my $sputnikcommand = $sputnikpath." ".$sputnikinput." > ".$sputnikoutput;
- # print "$sputnikcommand\n";
- my @sputnikcommand_system = $sputnikcommand;
- system(@sputnikcommand_system);
- }
-
- #-------------------------------------------------------------------------------
- #START SPUTNIK OUTPUT CORRECTOR
-
- foreach my $sp (@presp_tags){
- my $corroutput = $pipedir.$sp."_sput_op1";
- my $corrinput = $pipedir.$sp."_sput_op0";
- sputnikoutput_corrector($corrinput,$corroutput);
-
- my $t4output = $pipedir.$sp."_sput_op2";
- multi_species_t4($corroutput,$t4output);
-
- my $t5output = $pipedir.$sp."_sput_op3";
- multi_species_t5($t4output,$t5output);
- #print "done t5.pl for $sp\n";
-
- my $t6output = $pipedir.$sp."_sput_op4";
- multi_species_t6($t5output,$t6output,scalar(@orgs));
- }
- #-------------------------------------------------------------------------------
- #START T9.PL FOR T10.PL AND FOR INTERRUPTED HUNTING
-
- foreach my $sp (@presp_tags){
- my $t9output = $pipedir.$sp."_gap_op_unrand_match";
- my $t9sequence = $pipedir.$sp."_gap_op_unrand2";
- my $t9micro = $pipedir.$sp."_sput_op4";
- t9($t9micro,$t9sequence,$t9output);
-
- my $t9output2 = $pipedir.$sp."_nogap_op_unrand2_match";
- my $t9sequence2 = $pipedir.$sp."_nogap_op_unrand2";
- t9($t9micro,$t9sequence2,$t9output2);
- }
- #print "done both t9.pl for all orgs\n";
-
- #-------------------------------------------------------------------------------
- # FIND COMPOUND MICROSATELLITES
-
- @jobIDs = ();
- my $species_counter = 0;
-
- foreach my $sp (@presp_tags){
- my $simple_microsats=$pipedir.$sp."_sput_op4_simple";
- my $compound_microsats=$pipedir.$sp."_sput_op4_compound";
- my $input_micro = $pipedir.$sp."_sput_op4";
- my $input_seq = $pipedir.$sp."_nogap_op_unrand2_match";
- multiSpecies_compound_microsat_hunter3($input_micro,$input_seq,$simple_microsats,$compound_microsats,$orgs[$species_counter], scalar(@sp_tags), $threshold_array );
- $species_counter++;
- }
-
- #-------------------------------------------------------------------------------
- # READING AND FILTERING SIMPLE MICROSATELLITES
- my $spcounter2=0;
- foreach my $sp (@sp_tags){
- my $presp = $presp_tags[$spcounter2];
- $spcounter2++;
- my $simple_microsats=$pipedir.$presp."_sput_op4_simple";
- my $simple_filterout = $pipedir.$sp."_sput_op4_simple_filtered";
- my $simple_residue = $pipedir.$sp."_sput_op4_simple_residue";
- multiSpecies_filtering_interrupted_microsats($simple_microsats, $simple_filterout, $simple_residue,$threshold_array,$threshold_array,scalar(@sp_tags));
- }
-
- #-------------------------------------------------------------------------------
- # ANALYZE COMPOUND MICROSATELLITES FOR BEING INTERRUPTED MICROSATS
-
- $species_counter = 0;
- foreach my $sp (@sp_tags){
- my $presp = $presp_tags[$species_counter];
- my $compound_microsats = $pipedir.$presp."_sput_op4_compound";
- my $analyzed_simple_microsats=$pipedir.$presp."_sput_op4_compound_interrupted";
- my $analyzed_compound_microsats=$pipedir.$presp."_sput_op4_compound_pure";
- my $seq_file = $pipedir.$presp."_nogap_op_unrand2_match";
- multiSpecies_compound_microsat_analyzer($compound_microsats,$seq_file,$analyzed_simple_microsats,$analyzed_compound_microsats,$orgs[$species_counter], scalar(@sp_tags));
- $species_counter++;
- }
- #-------------------------------------------------------------------------------
- # REANALYZE COMPOUND MICROSATELLITES FOR PRESENCE OF SIMPLE ONES WITHIN THEM..
- $species_counter = 0;
-
- foreach my $sp (@sp_tags){
- my $presp = $presp_tags[$species_counter];
- my $compound_microsats = $pipedir.$presp."_sput_op4_compound_pure";
- my $compound_interrupted = $pipedir.$presp."_sput_op4_compound_clarifiedInterrupted";
- my $compound_compound = $pipedir.$presp."_sput_op4_compound_compound";
- my $seq_file = $pipedir.$presp."_nogap_op_unrand2_match";
- 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");
- $species_counter++;
- }
- #-------------------------------------------------------------------------------
- # READING AND FILTERING SIMPLE AND COMPOUND MICROSATELLITES
- $species_counter = 0;
-
- foreach my $sp (@sp_tags){
- my $presp = $presp_tags[$species_counter];
-
- my $simple_microsats=$pipedir.$presp."_sput_op4_compound_clarifiedInterrupted";
- my $simple_filterout = $pipedir.$sp."_sput_op4_compound_clarifiedInterrupted_filtered";
- my $simple_residue = $pipedir.$sp."_sput_op4_compound_clarifiedInterrupted_residue";
- multiSpecies_filtering_interrupted_microsats($simple_microsats, $simple_filterout, $simple_residue,$threshold_array,$threshold_array,scalar(@sp_tags));
-
- my $simple_microsats2 = $pipedir.$presp."_sput_op4_compound_interrupted";
- my $simple_filterout2 = $pipedir.$sp."_sput_op4_compound_interrupted_filtered";
- my $simple_residue2 = $pipedir.$sp."_sput_op4_compound_interrupted_residue";
- multiSpecies_filtering_interrupted_microsats($simple_microsats2, $simple_filterout2, $simple_residue2,$threshold_array,$threshold_array,scalar(@sp_tags));
-
- my $compound_microsats=$pipedir.$presp."_sput_op4_compound_compound";
- my $compound_filterout = $pipedir.$sp."_sput_op4_compound_compound_filtered";
- my $compound_residue = $pipedir.$sp."_sput_op4_compound_compound_residue";
- multispecies_filtering_compound_microsats($compound_microsats, $compound_filterout, $compound_residue,$threshold_array,$threshold_array,scalar(@sp_tags));
- $species_counter++;
- }
- #print "done filtering both simple and compound microsatellites \n";
-
- #-------------------------------------------------------------------------------
-
- my @combinedarray = ();
- my @combinedarray_indicators = ("mononucleotide", "dinucleotide", "trinucleotide", "tetranucleotide");
- my @combinedarray_tags = ("mono", "di", "tri", "tetra");
- $species_counter = 0;
-
- foreach my $sp (@sp_tags){
- my $simple_interrupted = $pipedir.$sp."_simple_analyzed_simple";
- 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";
- $species_counter++;
- }
-
- #-------------------------------------------------------------------------------
- # PUT TOGETHER THE INTERRUPTED AND SIMPLE MICROSATELLITES BASED ON THEIR MOTIF SIZE FOR FURTHER EXTENTION
- my $sp_counter = 0;
- foreach my $sp (@sp_tags){
- my $analyzed_simple = $pipedir.$sp."_sput_op4_compound_interrupted_filtered";
- my $clarifyed_simple = $pipedir.$sp."_sput_op4_compound_clarifiedInterrupted_filtered";
- my $simple = $pipedir.$sp."_sput_op4_simple_filtered";
- my $simple_analyzed_simple = $pipedir.$sp."_simple_analyzed_simple";
- `cat $analyzed_simple $clarifyed_simple $simple > $simple_analyzed_simple`;
- for my $i (0 ... 3){
- `grep "$combinedarray_indicators[$i]" $simple_analyzed_simple > $combinedarray[$sp_counter][$i]`;
- }
- $sp_counter++;
- }
- #print "\ndone grouping interrupted & simple microsats based on their motif size for further extention\n";
-
- #-------------------------------------------------------------------------------
- # BREAK CHROMOSOME INTO PARTS OF CERTAIN NO. CONTIGS EACH, FOR FUTURE SEARCHING OF INTERRUPTED MICROSATELLITES
- # ESPECIALLY DI, TRI AND TETRANUCLEOTIDE MICROSATELLITES
- @temp_tags = @sp_tags;
- my $increment = 1000000;
- my @splist = ();
- my $targetdir = $pipedir;
- $species_counter=0;
-
- foreach my $sp (@sp_tags){
- my $presp = $presp_tags[$species_counter];
- $species_counter++;
- my $localtag = shift @temp_tags;
- my $locallist = $targetdir.$localtag."_".$p_chr."_list";
- push(@splist, $locallist);
- my $input = $pipedir.$presp."_nogap_op_unrand2_match";
- chromosome_unrand_breaker($input,$targetdir,$locallist,$increment, $localtag, $pchr);
- }
-
-
- my @unionarray = ();
- #print "splist=@splist\n";
- #-------------------------------------------------------------------------------
- # FIND INTERRUPTED MICROSATELLITES
-
- $species_counter = 0;
-
- for my $i (0 .. $#combinedarray){
-
- @jobIDs = ();
- open (JLIST1, "$splist[$i]") or die "Cannot open file $splist[$i]: $!";
-
- while (my $sp1 = ){
- #print "$splist[$i]: sp1=$sp1\n";
- chomp $sp1;
-
- for my $j (0 ... $#combinedarray_tags){
- my $interr = $sp1."_interr_".$combinedarray_tags[$j];
- my $simple = $sp1."_simple_".$combinedarray_tags[$j];
- push @{$unionarray[$i]}, $interr, $simple;
- multiSpecies_interruptedMicrosatHunter($combinedarray[$i][$j],$sp1,$interr ,$simple, $orgs[$species_counter], scalar(@sp_tags), "3_4_6_8");
- }
- }
- $species_counter++;
- }
- close JLIST1;
- #-------------------------------------------------------------------------------
- # REUNION AND ZIPPING BEFORE T10.PL
-
- my @allarray = ();
-
- for my $i (0 ... $#sp_tags){
- my $localfile = $pipedir.$sp_tags[$i]."_allmicrosats";
- unlink $localfile if -e $localfile;
- push(@allarray, $localfile);
-
- my $unfiltered_localfile= $localfile."_unfiltered";
- my $residue_localfile= $localfile."_residue";
-
- unlink $unfiltered_localfile;
- #unlink $unfiltered_localfile;
- for my $j (0 ... $#{$unionarray[$i]}){
- #print "listing files for species $i and list number $j= \n$unionarray[$i][$j] \n";
- `cat $unionarray[$i][$j] >> $unfiltered_localfile`;
- unlink $unionarray[$i][$j];
- }
-
- multiSpecies_filtering_interrupted_microsats($unfiltered_localfile, $localfile, $residue_localfile,$threshold_array,$threshold_array,scalar(@sp_tags) );
- my $analyzed_compound = $pipedir.$sp_tags[$i]."_sput_op4_compound_compound_filtered";
- my $simple_residue = $pipedir.$sp_tags[$i]."_sput_op4_simple_residue";
- my $compound_residue = $pipedir.$sp_tags[$i]."_sput_op4_compound_residue";
-
- `cat $analyzed_compound >> $localfile`;
- }
- #-------------------------------------------------------------------------------
- # MERGING MICROSATELLITES THAT ARE VERY CLOSE TO EACH OTHER, INCLUDING THOSE FOUND BY SEARCHING IN 2 OPPOSIT DIRECTIONS
-
- my $toescape=0;
-
-
- for my $i (0 ... $#sp_tags){
- my $localfile = $pipedir.$sp_tags[$i]."_allmicrosats";
- $localfile =~ /$focalspec\-(chr[0-9a-zA-Z]+)\./;
- my $direction = $1;
- #print "localfile = $localfile , direction = $direction\n";
- # `gzip $reverse_chr_name` if $direction =~ /chr[0-9a-zA-Z]+r/ && $switchboard{"deleting_processFiles"} != 1;
- $toescape =1 if $direction =~ /chr[0-9a-zA-Z]+r/;
- last if $direction =~ /chr[0-9a-zA-Z]+r/;
- my $nogap_sequence = $pipedir.$presp_tags[$i]."_nogap_op_unrand2_match";
- my $gap_sequence = $pipedir.$presp_tags[$i]."_gap_op_unrand_match";
- my $reverselocal = $localfile;
- $reverselocal =~ s/\-chr([0-9a-zA-Z]+)\./-chr$1r./g;
- merge_interruptedMicrosats($nogap_sequence,$localfile, $reverselocal ,scalar(@sp_tags));
- #-------------------------------------------------------------------------------
- my $forward_separate = $localfile."_separate";
- my $reverse_separate = $reverselocal."_separate";
- my $diff = $forward_separate."_diff";
- my $miss = $forward_separate."_miss";
- my $common = $forward_separate."_common";
- forward_reverse_sputoutput_comparer($nogap_sequence,$forward_separate, $reverse_separate, $diff, $miss, $common ,scalar(@sp_tags));
- #-------------------------------------------------------------------------------
- my $symmetrical_file = $localfile."_symmetrical";
- my $merged_file = $localfile."_merged";
- #print "cating: $merged_file $common into -> $symmetrical_file \n";
- `cat $merged_file $common > $symmetrical_file`;
- #-------------------------------------------------------------------------------
- my $t10output = $symmetrical_file."_fin_hit_all_2";
- new_multispecies_t10($gap_sequence, $symmetrical_file, $t10output, join(".", @orgs));
- #-------------------------------------------------------------------------------
- }
- next if $toescape == 1;
- #------------------------------------------------------------------------------------------------
- # BRINGING IT ALL TOGETHER: FINDING ORTHOLOGOUS MICROSATELLITES AMONG THE SPECIES
-
-
- my @micros_array = ();
- my $sampletag = ();
- for my $i (0 ... $#sp_tags){
- my $finhitFile = $pipedir.$sp_tags[$i]."_allmicrosats_symmetrical_fin_hit_all_2";
- push(@micros_array, $finhitFile);
- $sampletag = $sp_tags[$i];
- }
- #$sampletag =~ s/^([A-Z]+\.)/ORTH_/;
- #$sampletag = $sampletag."_monoThresh-".$mono_threshold."bp";
- my $orthfiletemp = $ptag."_orthfile";
- my $orthanswer = multiSpecies_orthFinder4($t1input, join(":",@micros_array), $orthfiletemp, join(":", @orgs), $separation);
-
- my $maskedorthfiletemp = $ptag."_orthfile_masked";
- qualityFilter ($orthfiletemp, $chr_name_sputt, $maskedorthfiletemp);
-
- push @outputfiles , $maskedorthfiletemp;
- }
- $date = `date`;
-}
-
-`cat @outputfiles > $orthfile`;
-
-my $rootdir = $dir;
-$rootdir =~ s/\/[A-Za-z0-9\-_]+$//;
-chdir $rootdir;
-remove_tree($dir);
-
-#print "date = $date\n";
-#remove_tree($tdir);
-#------------------------------------------------------------------------------------------------
-#------------------------------------------------------------------------------------------------
-#------------------------------------------------------------------------------------------------
-#------------------------------------------------------------------------------------------------
-
-#xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx
-
-sub maftoAxt_multispecies {
- #print "in maftoAxt_multispecies : got @_\n";
- my $fname=$_[0];
- open(IN,"<$_[0]") or die "Cannot open $_[0]: $! \n";
- my $treedefinition = $_[1];
- open(OUT,">$_[2]") or die "Cannot open $_[2]: $! \n";
- my $counter = 0;
- my $exactspeciesset = $_[3];
- my @exactspeciesset_unarranged = split(/,/,$exactspeciesset);
-
- $treedefinition=~s/[\)\(, ]/\t/g;
- my @species=split(/\t+/,$treedefinition);
- my @exactspecies=();
-
- foreach my $spec (@species){
- foreach my $espec (@exactspeciesset_unarranged){
- push @exactspecies, $spec if $spec eq $espec;
- }
- }
- #print "exactspecies=@exactspecies\n";
-
- ###########
- my $select = 2;
- #select = 1 if all species need sequences to be present for each block otherwise, it is 0
- #select = 2 only the allowed set make up the alignment. use the removeset
- # information to detect alignmenets that have other important genomes aligned.
- ###########
- my @allowedset = ();
- @allowedset = split(/;/,allowedSetOfSpecies(join("_",@species))) if $select == 0;
- @allowedset = join("_",0,@species) if $select == 1;
- #print "species = @species , allowedset =",join("\n", @allowedset) ," \n";
- @allowedset = join("_",0,@exactspecies) if $select == 2;
- #print "allowedset = @allowedset and exactspecies = @exactspecies\n";
-
- my $start = 0;
- my @sequences = ();
- my @titles = ();
- my $species_counter = "0";
- my $countermatch = 0;
- my $outsideSpecies=0;
-
- while(my $line = ){
-# print $line;
- next if $line =~ /^#/;
- next if $line =~ /^i/;
- chomp $line;
- my @fields = split(/\s+/,$line);
- chomp $line;
- if ($line =~ /^a /){
- $start = 1;
- }
-
- if ($line =~ /^s /){
-
- foreach my $sp (@allspecies){
-# print "checking species $sp\n";
- if ($fields[1] =~ /$sp/){
- $species_counter = $species_counter."_".$sp;
- push(@sequences, $fields[6]);
- my @sp_info = split(/\./,$fields[1]);
- my $title = join(" ",@sp_info, $fields[2], ($fields[2]+$fields[3]), $fields[4]);
- push(@titles, $title);
-# print "species_counter = $species_counter\n";
- }
- }
- }
-
- if (($line !~ /^a/) && ($line !~ /^s/) && ($line !~ /^#/) && ($line !~ /^i/) && ($start = 1)){
-# print "species_counter = $species_counter\n";
- my $arranged = reorderSpecies($species_counter, @allspecies);
- my $stopper = 1;
- my $arrno = 0;
-
-# print "checking if ", scalar(@sequences), " match @exactspecies allowedset=@allowedset\n";
- if (scalar(@sequences) == scalar(@exactspecies)){
- foreach my $set (@allowedset){
-# print "testing $arranged against $set\n";
- if ($arranged eq $set){
- $stopper = 0; last;
- }
- $arrno++;
- }
- }
- else{
- $stopper = 1;
- }
-
-
- if ($stopper == 0) {
- @titles = split ";", orderInfo(join(";", @titles), $species_counter, $arranged) if $species_counter ne $arranged;
- @sequences = split ";", orderInfo(join(";", @sequences), $species_counter, $arranged) if $species_counter ne $arranged;
- my $filteredseq = filter_gaps(@sequences);
-
- if ($filteredseq ne "SHORT"){
- #print "printing"; ;
- $counter++;
- print OUT join (" ",$counter, @titles), "\n";
- print OUT $filteredseq, "\n";
- print OUT "\n";
- $countermatch++;
- }
- }
- else{ #print "nexting\n";;
- }
-
- @sequences = (); @titles = (); $start = 0;$species_counter = "0";
- next;
-
- }
- }
-# print "countermatch = $countermatch\n";
-}
-
-sub reorderSpecies{
- my @inarr=@_;
- my $currSpecies = shift (@inarr);
- my $ordered_species = 0;
- my @species=@inarr;
- #print "species = @species\n";
- foreach my $order (@species){
- $ordered_species = $ordered_species."_".$order if $currSpecies=~ /$order/;
- }
- return $ordered_species;
-
-}
-
-sub filter_gaps{
- my @sequences = @_;
-# print "sequences sent are @sequences\n";
- my $seq_length = length($sequences[0]);
- my $seq_no = scalar(@sequences);
- my $allgaps = ();
- for (1 ... $seq_no){
- $allgaps = $allgaps."-";
- }
-
- my @seq_array = ();
- my $seq_counter = 0;
- foreach my $seq (@sequences){
-# my @sequence = split(/\s*/,$seq);
- $seq_array[$seq_counter] = [split(/\s*/,$seq)];
-# push @seq_array, [@sequence];
- $seq_counter++;
- }
- my $g = 0;
- while ( $g < $seq_length){
- last if (!exists $seq_array[0][$g]);
- my $bases = ();
- for my $u (0 ... $#seq_array){
- $bases = $bases.$seq_array[$u][$g];
- }
-# print $bases, "\n";
- if ($bases eq $allgaps){
-# print "bases are $bases, position is $g \n";
- for my $seq (@seq_array){
- splice(@$seq , $g, 1);
- }
- }
- else {
- $g++;
- }
- }
-
- my @outs = ();
-
- foreach my $seq (@seq_array){
- push(@outs, join("",@$seq));
- }
- return "SHORT" if length($outs[0]) <=100;
- return (join("\n", @outs));
-}
-
-
-sub allowedSetOfSpecies{
- my @allowed_species = split(/_/,$_[0]);
- unshift @allowed_species, 0;
-# print "allowed set = @allowed_species \n";
- my @output = ();
- for (0 ... scalar(@allowed_species) - 4){
- push(@output, join("_",@allowed_species));
- pop @allowed_species;
- }
- return join(";",reverse(@output));
-
-}
-
-
-sub orderInfo{
- my @info = split(/;/,$_[0]);
-# print "info = @info";
- my @old = split(/_/,$_[1]);
- my @new = split(/_/,$_[2]);
- shift @old; shift @new;
- my @outinfo = ();
- foreach my $spe (@new){
- for my $no (0 ... $#old){
- if ($spe eq $old[$no]){
- push(@outinfo, $info[$no]);
- }
- }
- }
-# print "outinfo = @outinfo \n";
- return join(";", @outinfo);
-}
-
-#xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx xxxxxxx maftoAxt_multispecies xxxxxxx
-
-#xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx
-sub artificial_axdata_inverter{
- open(IN,"<$_[0]") or die "Cannot open file $_[0]: $!";
- open(OUT,">$_[1]") or die "Cannot open file $_[1]: $!";
- my $linecounter=0;
- while (my $line = ){
- $linecounter++;
- #print "$linecounter\n";
- chomp $line;
- my $final_line = $line;
- my $trycounter = 0;
- if ($line =~ /^[a-zA-Z\-]/){
- # while ($final_line eq $line){
- my @fields = split(/\s*/,$line);
-
- $final_line = join("",reverse(@fields));
- # print colored ['red'], "$line\n$final_line\n" if $final_line eq $line && $line !~ /chr/ && $line =~ /[a-zA-Z]/;
- # $trycounter++;
- # print "trying again....$trycounter : $final_line\n" if $final_line eq $line;
- # }
- }
-
- # print colored ['yellow'], "$line\n$final_line\n" if $final_line eq $line && $line !~ /chr/ && $line =~ /[a-zA-Z]/;
- if ($line =~ /^[0-9]/){
- $line =~ s/chr([A-Z0-9a-b]+)/chr$1r/g;
- $final_line = $line;
- }
- print OUT $final_line,"\n";
- #print "$line\n$final_line\n" if $final_line eq $line && $line !~ /chr/ && $line =~ /[a-zA-Z]/;
- }
- close OUT;
-}
-#xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx xxxxxxx artificial_axdata_inverter xxxxxxx
-
-
-#xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx
-
-sub multi_species_t1 {
-
- my $input1 = $_[0];
- #print "@_\n"; ;
- my @tags = split(/_/, $_[1]);
- my @outputs = split(/,/, $_[2]);
- my $title_query = $_[3];
- my @handles = ();
-
- open(FILEB,"<$input1")or die "Cannot open file: $input1 $!";
- my $i = 0;
- foreach my $path (@outputs){
- $handles[$i] = IO::Handle->new();
- open ($handles[$i], ">$path") or die "Can't open $path : $!";
- $i++;
- }
-
- my $curdef;
- my $start = 0;
-
- while (my $line = ) {
- if ($line =~ /^\d/){
- $line =~ s/ +/\t/g;
- my @fields = split(/\s+/, $line);
- if (($line =~ /$title_query/)){
- my $title = $line;
- my $counter = 0;
- foreach my $tag (@tags){
- $line = ;
- print {$handles[$counter]} ">",$tag,"\t",$title, " ",$line;
- $counter++;
- }
- }
- else{
- foreach my $tag (@tags){
- my $tine = ;
- }
- }
-
- }
- }
-
- foreach my $hand (@handles){
- $hand->close();
- }
-
- close FILEB;
-}
-
-#xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx xxxxxxx multi_species_t1 xxxxxxx
-
-#xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx
-
-sub multi_species_t2{
-
- my $input = $_[0];
- my $species = $_[1];
- my $output1 = $input."_unr";
-
- #------------------------------------------------------------------------------------------
- open (FILEF1, "<$input") or die "Cannot open file $input :$!";
- open (FILEF2, ">$output1") or die "Cannot open file $output1 :$!";
-
- my $line1 = ;
-
- while($line1){
- {
- # chomp($line);
- if ($line1 =~ (m/^\>$species/)){
- chomp($line1);
- print FILEF2 $line1;
- $line1 = ;
- chomp($line1);
- print FILEF2 "\t", $line1,"\n";
- }
- }
- $line1 = ;
- }
-
- close FILEF1;
- close FILEF2;
- #------------------------------------------------------------------------------------------
-
- my $output2 = $output1."and";
- my $output3 = $output1."and2";
- open(IN,"<$output1");
- open (FILEF3, ">$output2");
- open (FILEF4, ">$output3");
-
-
- while (){
- my $line = $_;
- chomp($line);
- my @fields=split (/\t/, $line);
- # print $line,"\n"; ;
- if($line !~ /random/){
- print FILEF3 join ("\t",@fields[0 ... scalar(@fields)-2]), "\n", $fields[scalar(@fields)-1], "\n";
- print FILEF4 join ("\t",@fields[0 ... scalar(@fields)-2]), "\t", $fields[scalar(@fields)-1], "\n";
- }
- }
-
-
- close IN;
- close FILEF3;
- close FILEF4;
- unlink $output1;
-
- #------------------------------------------------------------------------------------------
- # OLD T3.PL RUDIMENT
-
- my $t3output = $output2;
- $t3output =~ s/gap_op_unrand/nogap_op_unrand/g;
-
- open(IN,"<$output2");
- open(OUTA,">$t3output");
-
-
- while (){
- s/-//g unless /^>/;
- print OUTA;
- }
-
- close IN;
- close OUTA;
- #------------------------------------------------------------------------------------------
-}
-#xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx xxxxxxx multi_species_t2 xxxxxxx
-
-
-#xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxxmulti_species_t2_2 xxxxxxx
-sub multi_species_t2_2{
- #print "IN multi_species_t2_2 : @_\n";
- my $input = $_[0];
- my $species = $_[1];
- my $output1 = $input."2";
-
-
- open (FILEF1, "<$input");
- open (FILEF2, ">$output1");
-
- my $line1 = ;
-
- while($line1){
- {
- # chomp($line);
- if ($line1 =~ (m/^\>$species/)){
- chomp($line1);
- print FILEF2 $line1;
- $line1 = ;
- chomp($line1);
- print FILEF2 "\t", $line1,"\n";
- }
- }
- $line1 = ;
- }
-
- close FILEF1;
- close FILEF2;
-}
-
-#xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxx multi_species_t2_2 xxxxxxx xxxxxxx multi_species_t2_2 xxxxxxx
-
-
-#xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx
-sub sputnikoutput_corrector{
- my $input = $_[0];
- my $output = $_[1];
- open(IN,"<$input") or die "Cannot open file $input :$!";
- open(OUT,">$output") or die "Cannot open file $output :$!";
- my $tine;
- while (my $line=){
- if($line =~/length /){
- $tine = $line;
- $tine =~ s/\s+/\t/g;
- my @fields = split(/\t/,$tine);
- if ($fields[6] > 60){
- print OUT $line;
- $line = ;
-
- while (($line !~ /nucleotide/) && ($line !~ /^>/)){
- chomp $line;
- print OUT $line;
- $line = ;
- }
- print OUT "\n";
- print OUT $line;
- }
- else{
- print OUT $line;
- }
- }
- else{
- print OUT $line;
- }
- }
- close IN;
- close OUT;
-}
-#xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx xxxxxxx sputnikoutput_corrector xxxxxxx
-
-
-#xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx
-sub multi_species_t4{
-# print "multi_species_t4 : @_\n";
- my $input = $_[0];
- my $output = $_[1];
- open (FILEA, "<$input");
- open (FILEB, ">$output");
-
- my $line = ;
-
- while ($line) {
- # chomp $line;
- if ($line =~ />/) {
- chomp $line;
- print FILEB $line, "\n";
- }
-
-
- if ($line =~ /^m/ | $line =~ /^d/ | $line =~ /^t/ | $line =~ /^p/){
- chomp $line;
- print FILEB $line, " " ;
- $line = ;
- chomp $line;
- print FILEB $line,"\n";
- }
-
- $line = ;
- }
-
-
- close FILEA;
- close FILEB;
-
-}
-
-#xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx xxxxxxx multi_species_t4 xxxxxxx
-
-
-#xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx
-sub multi_species_t5{
-
- my $input = $_[0];
- my $output = $_[1];
-
- open(FILEB,"<$input");
- open(FILEC,">$output");
-
- my $curdef;
-
- while (my $line = ) {
-
- if ($line =~ /^>/){
- chomp $line;
- $curdef = $line;
- next;
- }
-
- if ($line =~ /^m/ | $line =~ /^d/ | $line =~ /^t/ | $line =~ /^p/){
- print FILEC $curdef," ",$line;
- }
-
- }
-
-
- close FILEB;
- close FILEC;
-
-}
-#xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx xxxxxxx multi_species_t5 xxxxxxx
-
-
-#xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx
-sub multi_species_t6{
- my $input = $_[0];
- my $output = $_[1];
- my $focalstrand=$_[3];
-# print "inpput = @_\n";
- open (FILE, "<$input");
- open (FILE_MICRO, ">$output");
- my $linecounter=0;
- while (my $line = ){
- $linecounter++;
- chomp $line;
- #print "line = $line\n";
- #MONO#
- $line =~ /$focalspec\s[a-zA-Z]+[0-9a-zA-Z]+\s[0-9]+\s[0-9]+\s([+\-])/;
- my $strand=$1;
- my $no_of_species = ($line =~ s/\s+[+\-]\s+/ /g);
- #print "line = $line\n";
- my $specfieldsend = 2 + ($no_of_species*4) - 1;
- my @fields = split(/\s+/, $line);
- my @speciesdata = @fields[0 ... $specfieldsend];
- $line =~ /([a-z]+nucleotide)\s([0-9]+)\s:\s([0-9]+)/;
- my ($tide, $start, $end) = ($1, $2, $3);
- #print "no_of_species=$no_of_species.. speciesdata = @speciesdata and ($tide, $start, $end)\n";
- if($line =~ /mononucleotide/){
- print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields], mono($fields[$#fields]),),"\n";
- }
- #DI#
- elsif($line =~ /dinucleotide/){
- print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields], di($fields[$#fields]),),"\n";
- }
- #TRI#
- elsif($line =~ /trinucleotide/ ){
- print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields], tri($fields[$#fields]),),"\n";
- }
- #TETRA#
- elsif($line =~ /tetranucleotide/){
- print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields], tetra($fields[$#fields]),),"\n";
- }
- #PENTA#
- elsif($line =~ /pentanucleotide/){
- #print FILE_MICRO join("\t",@speciesdata, $tide, $start, $strand,$end, $fields[$#fields], penta($fields[$#fields]),),"\n";
- }
- else{
- # print "not: @fields\n";
- }
- }
-# print "linecounter=$linecounter\n";
- close FILE;
- close FILE_MICRO;
-}
-
-sub mono {
- my $st = $_[0];
- my $tp = unpack "A1"x(length($st)/1),$st;
- my $var1 = substr($tp, 0, 1);
- return join ("\t", $var1);
-}
-sub di {
- my $st = $_[0];
- my $tp = unpack "A2"x(length($st)/2),$st;
- my $var1 = substr($tp, 0, 2);
- return join ("\t", $var1);
-}
-sub tri {
- my $st = $_[0];
- my $tp = unpack "A3"x(length($st)/3),$st;
- my $var1 = substr($tp, 0, 3);
- return join ("\t", $var1);
-}
-sub tetra {
- my $st = $_[0];
- my $tp = unpack "A4"x(length($st)/4),$st;
- my $var1 = substr($tp, 0, 4);
- return join ("\t", $var1);
-}
-sub penta {
- my $st = $_[0];
- my $tp = unpack "A5"x(length($st)/5),$st;
- my $var1 = substr($tp, 0, 5);
- return join ("\t", $var1);
-}
-
-#xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx xxxxxxx multi_species_t6 xxxxxxx
-
-
-#xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx
-sub t9{
- my $input1 = $_[0];
- my $input2 = $_[1];
- my $output = $_[2];
-
-
- open(IN1,"<$input1") if -e $input1;
- open(IN2,"<$input2") or die "cannot open file $_[1] : $!";
- open(OUT,">$output") or die "cannot open file $_[2] : $!";
-
-
- my %seen = ();
- my $prevkey = 0;
-
- if (-e $input1){
- while (my $line = ){
- chomp($line);
- my @fields = split(/\t/,$line);
- my $key1 = join ("_K10K1_",@fields[0,1,3,4,5]);
- # print "key in t9 = $key1\n";
- $seen{$key1}++ if ($prevkey ne $key1) ;
- $prevkey = $key1;
- }
-# print "done first hash\n";
- close IN1;
- }
-
- while (my $line = ){
- # print $line, "**\n";
- if (-e $input1){
- chomp($line);
- my @fields = split(/\t/,$line);
- my $key2 = join ("_K10K1_",@fields[0,1,3,4,5]);
- if (exists $seen{$key2}){
- print OUT "$line\n" ;
- delete $seen{$key2};
- }
- }
- else {
- print OUT "$line\n" ;
-# print "$line\n" ;
- }
- }
-
- close IN2;
- close OUT;
-}
-#xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx xxxxxxxxxxxxxx t9 xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx
-
-
-sub multiSpecies_compound_microsat_hunter3{
-
- my $input1 = $_[0]; ###### the *_sput_op4_ii file
- my $input2 = $_[1]; ###### looks like this: my $t8humanoutput = $pipedir.$ptag."_nogap_op_unrand2"
- my $output1 = $_[2]; ###### plain microsatellite file
- my $output2 = $_[3]; ###### compound microsatellite file
- my $org = $_[4]; ###### 1 or 2
- $no_of_species = $_[5];
- #print "IN multiSpecies_compound_microsat_hunter3: @_\n";
- #my @tags = split(/\t/,$info);
- sub compoundify;
- open(IN,"<$input1") or die "Cannot open file $input1 $!";
- open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
- open(OUT,">$output1") or die "Cannot open file $output1 $!";
- open(OUT2,">$output2") or die "Cannot open file $output2 $!";
- $infocord = 2 + (4*$no_of_species) - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
- my $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
-
- my @thresholds = ("0");
- push(@thresholds, split(/_/,$_[6]));
- sub thresholdCheck;
- my %micros = ();
- while (my $line = ){
- # print "$org\t(chr[0-9]+)\t([0-9]+)\t([0-9])+\t \n";
- next if $line =~ /\t\t/;
- 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/ ) {
- my $key = join("\t",$1, $2, $3, $4, $5);
- # print $key, "#-#-#-#-#-#-#-#\n";
- push (@{$micros{$key}},$line);
- }
- else{
- }
- }
- close IN;
- my @deletedlines = ();
-
- my $linecount = 0;
-
- while(my $sine = ){
- my %microstart=();
- my %microend=();
-
- my @sields = split(/\t/,$sine);
-
- my $key = ();
-
- 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/ ) {
- $key = join("\t",$1, $2, $3, $4, $5);
- # print $key, "<-<-<-<-<-<-<-<\n";
- }
- else{
- }
-
- if (exists $micros{$key}){
- $linecount++;
- my @microstring = @{$micros{$key}};
- my @tempmicrostring = @{$micros{$key}};
-
- foreach my $line (@tempmicrostring){
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- push (@{$microstart{$start}},$line);
- push (@{$microend{$end}},$line);
- }
- my $firstflag = 'down';
- while( my $line =shift(@microstring)){
- # print "-----------\nline = $line ";
- chomp $line;
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- my $startmicro = $line;
- my $endmicro = $line;
-
- # print "fields=@fields, start = $start end=$end, startcord=$startcord, endcord=$endcord\n";
-
- delete ($microstart{$start});
- delete ($microend{$end});
- my $flag = 'down';
- my $startflag = 'down';
- my $endflag = 'down';
- my $prestart = $start - $distance;
- my $postend = $end + $distance;
- my @compoundlines = ();
- my %compoundhash = ();
- push (@compoundlines, $line);
- push (@{$compoundhash{$line}},$line);
- my $startrank = 1;
- my $endrank = 1;
-
- while( ($startflag eq "down") || ($endflag eq "down") ){
- if ((($prestart < 0) && $firstflag eq "up") || (($postend > length($sields[$sequencepos])) && $firstflag eq "up") ) {
-# print "coming to the end of sequence,prestart = $prestart & post end = $postend and sequence length =", length($sields[$sequencepos])," so exiting\n";
- last;
- }
-
- $firstflag = "up";
- if ($startflag eq "down"){
- for my $i ($prestart ... $start){
-
- if(exists $microend{$i}){
- chomp $microend{$i}[0];
- if(exists $compoundhash{$microend{$i}[0]}) {next;}
- # print "sending from microend $startmicro, $microend{$i}[0] |||\n";
- if (identityMatch_thresholdCheck($startmicro, $microend{$i}[0], $startrank) eq "proceed"){
- push(@compoundlines, $microend{$i}[0]);
- # print "accepted\n";
- my @tields = split(/\t/,$microend{$i}[0]);
- $startmicro = $microend{$i}[0];
- chomp $startmicro;
- $start = $tields[$startcord];
- $flag = 'down';
- $startrank++;
- # print "startcompund = $microend{$i}[0]\n";
- delete $microend{$i};
- delete $microstart{$start};
- $startflag = 'down';
- $prestart = $start - $distance;
- last;
- }
- else{
- $flag = 'up';
- $startflag = 'up';
- }
- }
- else{
- $flag = 'up';
- $startflag = 'up';
- }
- }
- }
-
- $endrank = $startrank;
-
- if ($endflag eq "down"){
- for my $i ($end ... $postend){
-
- if(exists $microstart{$i} ){
- chomp $microstart{$i}[0];
- if(exists $compoundhash{$microstart{$i}[0]}) {next;}
- # print "sending from microstart $endmicro, $microstart{$i}[0] |||\n";
-
- if(identityMatch_thresholdCheck($endmicro,$microstart{$i}[0], $endrank) eq "proceed"){
- push(@compoundlines, $microstart{$i}[0]);
- # print "accepted\n";
- my @tields = split(/\t/,$microstart{$i}[0]);
- $end = $tields[$endcord]-0;
- $endmicro = $microstart{$i}[0];
- $endrank++;
- chomp $endmicro;
- $flag = 'down';
- # print "endcompund = $microstart{$i}[0]\n";
- delete $microstart{$i};
- delete $microend{$end};
- shift @microstring;
- $postend = $end + $distance;
- $endflag = 'down';
- last;
- }
- else{
- $flag = 'up';
- $endflag = 'up';
- }
- }
- else{
- $flag = 'up';
- $endflag = 'up';
- }
- }
- }
- # print "for next turn, flag status: startflag = $startflag and endflag = $endflag \n";
- } #end while( $flag eq "down")
- # print "compoundlines = @compoundlines \n";
- if (scalar (@compoundlines) == 1){
- print OUT $line,"\n";
- }
- if (scalar (@compoundlines) > 1){
- my $compoundline = compoundify(\@compoundlines, $sields[$sequencepos]);
- # print $compoundline,"\n";
- print OUT2 $compoundline,"\n";
- }
- } #end foreach my $line (@microstring){
- } #if (exists $micros{$key}){
-
-
- }
-
- close OUT;
- close OUT2;
-}
-
-
-#------------------------------------------------------------------------------------------------
-sub compoundify{
- my ($compoundlines, $sequence) = @_;
-# print "\nfound to compound : @$compoundlines and$sequence \n";
- my $noOfComps = @$compoundlines;
-# print "Number of elements in hash is $noOfComps\n";
- my @starts;
- my @ends;
- foreach my $line (@$compoundlines){
-# print "compoundify.. line = $line \n";
- chomp $line;
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- # print "start = $start, end = $end \n";
- push(@starts, $start);
- push(@ends,$end);
- }
- my @temp = @$compoundlines;
- my $startline=$temp[0];
- my @mields = split(/\t/,$startline);
- my $startcoord = $mields[$startcord];
- my $startgapsign=$mields[$endcord];
- my @startsorted = sort { $a <=> $b } @starts;
- my @endsorted = sort { $a <=> $b } @ends;
- my @intervals;
- for my $end (0 ... (scalar(@endsorted)-2)){
- my $interval = substr($sequence,($endsorted[$end]+1),(($startsorted[$end+1])-($endsorted[$end])-1));
- push(@intervals,$interval);
- # print "interval = $interval =\n";
- # print "substr(sequence,($endsorted[$end]+1),(($startsorted[$end+1])-($endsorted[$end])-1))\n";
- }
- push(@intervals,"");
- my $compoundmicrosat=();
- my $multiunit="";
- foreach my $line (@$compoundlines){
- my @fields = split(/\t/,$line);
- my $component="[".$fields[$microsatcord]."]".shift(@intervals);
- $compoundmicrosat=$compoundmicrosat.$component;
- $multiunit=$multiunit."[".$fields[$motifcord]."]";
-# print "multiunit = $multiunit\n";
- }
- my $compoundcopy = $compoundmicrosat;
- $compoundcopy =~ s/\[|\]//g;
- my $compoundlength = $mields[$startcord] + length($compoundcopy) - 1;
-
-
- my $compoundline = join("\t",(@mields[0 ... $infocord], "compound",@mields[$startcord ... $startcord+1],$compoundlength,$compoundmicrosat, $multiunit));
- return $compoundline;
-}
-
-#------------------------------------------------------------------------------------------------
-
-sub identityMatch_thresholdCheck{
- my $line1 = $_[0];
- my $line2 = $_[1];
- my $rank = $_[2];
- my @lields1 = split(/\t/,$line1);
- my @lields2 = split(/\t/,$line2);
-# print "recieved $line1 && $line2\n motif comparison: ", length($lields1[$motifcord])," : ",length($lields2[$motifcord]),"\n";
-
- if (length($lields1[$motifcord]) == length($lields2[$motifcord])){
- my $probe = $lields1[$motifcord].$lields1[$motifcord];
- #print "$probe :: $lields2[$motifcord]\n";
- return "proceed" if $probe =~ /$lields2[$motifcord]/;
- #print "line recieved\n";
- if ($rank ==1){
- return "proceed" if thresholdCheck($line1) eq "proceed" && thresholdCheck($line2) eq "proceed";
- }
- else {
- return "proceed" if thresholdCheck($line2) eq "proceed";
- return "stop";
- }
- }
- else{
- if ($rank ==1){
- return "proceed" if thresholdCheck($line1) eq "proceed" && thresholdCheck($line2) eq "proceed";
- }
- else {
- return "proceed" if thresholdCheck($line2) eq "proceed";
- return "stop";
- }
- }
- return "stop";
-}
-#------------------------------------------------------------------------------------------------
-
-sub thresholdCheck{
- my @checkthresholds=(0,@thresholds);
- #print "IN thresholdCheck: @_\n";
- my $line = $_[0];
- my @lields = split(/\t/,$line);
- return "proceed" if length($lields[$microsatcord]) >= $checkthresholds[length($lields[$motifcord])];
- return "stop";
-}
-#xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx multiSpecies_compound_microsat_hunter3 xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx
-
-sub multiSpecies_filtering_interrupted_microsats{
-# print "IN multiSpecies_filtering_interrupted_microsats: @_\n";
- my $unfiltered = $_[0];
- my $filtered = $_[1];
- my $residue = $_[2];
- my $no_of_species = $_[5];
- open(UNF,"<$unfiltered") or die "Cannot open file $unfiltered: $!";
- open(FIL,">$filtered") or die "Cannot open file $filtered: $!";
- open(RES,">$residue") or die "Cannot open file $residue: $!";
-
- $infocord = 2 + (4*$no_of_species) - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
-
-
- my @sub_thresholds = (0);
-
- push(@sub_thresholds, split(/_/,$_[3]));
- my @thresholds = (0);
-
- push(@thresholds, split(/_/,$_[4]));
-
- while (my $line = ) {
- next if $line !~ /[a-z]/;
- #print $line;
- chomp $line;
- my @fields = split(/\t/,$line);
- my $motif = $fields[$motifcord];
- my $realmotif = $motif;
- #print "motif = $motif\n";
- if ($motif =~ /^\[/){
- $motif =~ s/^\[//g;
- my @motifs = split(/\]/,$motif);
- $realmotif = $motifs[0];
- }
-# print "realmotif = $realmotif";
- my $motif_size = length($realmotif);
-
- my $microsat = $fields[$microsatcord];
-# print "microsat = $microsat\n";
- $microsat =~ s/^\[|\]$//sg;
- my @microsats = split(/\][a-zA-Z|-]*\[/,$microsat);
-
- $microsat = join("",@microsats);
- if (length($microsat) < $thresholds[$motif_size]) {
- # print length($microsat)," < ",$thresholds[$motif_size],"\n";
- print RES $line,"\n"; next;
- }
- my @lengths = ();
- foreach my $mic (@microsats){
- push(@lengths, length($mic));
- }
- if (largest_microsat(@lengths) < $sub_thresholds[$motif_size]) {
- # print largest_microsat(@lengths)," < ",$sub_thresholds[$motif_size],"\n";
- print RES $line,"\n"; next;}
- else {print FIL $line,"\n"; next;
- }
- }
- close FIL;
- close RES;
-
-}
-
-sub largest_microsat{
- my $counter = 0;
- my($max) = shift(@_);
- foreach my $temp (@_) {
- #print "finding largest array: $maxcounter \n";
- if($temp > $max){
- $max = $temp;
- }
- }
- return($max);
-}
-
-#xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx multiSpecies_filtering_interrupted_microsats xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx
-sub multiSpecies_compound_microsat_analyzer{
- ####### PARAMETER ########
- ##########################
-
- my $input1 = $_[0]; ###### the *_sput_op4_ii file
- my $input2 = $_[1]; ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
- my $output1 = $_[2]; ###### interrupted microsatellite file, in new .interrupted format
- my $output2 = $_[3]; ###### the pure compound microsatellites
- my $org = $_[4];
- my $no_of_species = $_[5];
-# print "IN multiSpecies_compound_microsat_analyzer: $input1\n $input2\n $output1\n $output2\n $org\n $no_of_species\n";
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
-
- open(IN,"<$input1") or die "Cannot open file $input1 $!";
- open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
-
- open(OUT,">$output1") or die "Cannot open file $output1 $!";
- open(OUT2,">$output2") or die "Cannot open file $output2 $!";
-
-
-# print "opened files \n";
- my %micros = ();
- my $keycounter=0;
- my $linecounter=0;
- while (my $line = ){
- $linecounter++;
- 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/ ) {
- my $key = join("\t",$1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
- push (@{$micros{$key}},$line);
- $keycounter++;
- }
- else{
- # print "no key\n";
- }
- }
- close IN;
- my @deletedlines = ();
-# print "done hash . linecounter=$linecounter, keycounter=$keycounter\n";
- #---------------------------------------------------------------------------------------------------
- # NOW READING THE SEQUENCE FILE
- my $keyfound=0;
- my $keyexists=0;
- my $inter=0;
- my $pure=0;
-
- while(my $sine = ){
- my %microstart=();
- my %microend=();
- my @sields = split(/\t/,$sine);
- my $key = 0;
- 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/ ) {
- $key = join("\t",$1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
- # print $sine;
- # print $key;
- $keyfound++;
- }
- else{
-
- }
- # if !defined $key;
-
- if (exists $micros{$key}){
- $keyexists++;
- my @microstring = @{$micros{$key}};
-
- my @filteredmicrostring;
-
- foreach my $line (@microstring){
- chomp $line;
- my $copy_line = $line;
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- # FOR COMPOUND MICROSATELLITES
- if ($fields[$typecord] eq "compound"){
- $line = compound_microsat_analyser($line);
- if ($line eq "NULL") {
- print OUT2 "$copy_line\n";
- $pure++;
- next;
- }
- else{
- print OUT "$line\n";
- $inter++;
- next;
- }
- }
- }
-
- } #if (exists $micros{$key}){
- }
- close OUT;
- close OUT2;
-# print "keyfound=$keyfound, keyexists=$keyexists, pure=$pure, inter=$inter\n";
-}
-
-sub compound_microsat_analyser{
- my $line = $_[0];
- my @fields = split(/\t/,$line);
- my $motifline = $fields[$motifcord];
- my $microsat = $fields[$microsatcord];
- $motifline =~ s/^\[|\]$//g;
- $microsat =~ s/^\[|\]$//g;
- $microsat =~ s/-//g;
- my @interruptions = ();
- my @motields = split(/\]\[/,$motifline);
- my @microields = split(/\][a-zA-Z|-]*\[/,$microsat);
- my @inields = split(/[.*]/,$microsat);
- shift @inields;
- my @motifcount = scalar(@motields);
- my $prevmotif = $motields[0];
- my $prevmicro = $microields[0];
- my $prevphase = substr($microields[0],-(length($motields[0])),length($motields[0]));
- my $localflag = 'down';
- my @infoarray = ();
-
- for my $l (1 ... (scalar(@motields)-1)){
- my $probe = $prevmotif.$prevmotif;
- if (length $prevmotif != length $motields[$l]) {$localflag = "up"; last;}
-
- if ($probe =~ /$motields[$l]/i){
- my $curr_endphase = substr($microields[$l],-length($motields[$l]),length($motields[$l]));
- my $curr_startphase = substr($microields[$l],0,length($motields[$l]));
- if ($curr_startphase =~ /$prevphase/i) {
- $infoarray[$l-1] = "insertion";
- }
- else {
- $infoarray[$l-1] = "indel/substitution";
- }
-
- $prevmotif = $motields[$l]; $prevmicro = $microields[$l]; $prevphase = $curr_endphase;
- next;
- }
- else {$localflag = "up"; last;}
- }
- if ($localflag eq 'up') {return "NULL";}
-
- if (length($prevmotif) == 1) {$fields[$typecord] = "mononucleotide";}
- if (length($prevmotif) == 2) {$fields[$typecord] = "dinucleotide";}
- if (length($prevmotif) == 3) {$fields[$typecord] = "trinucleotide";}
- if (length($prevmotif) == 4) {$fields[$typecord] = "tetranucleotide";}
- if (length($prevmotif) == 5) {$fields[$typecord] = "pentanucleotide";}
-
- @microields = split(/[\[|\]]/,$microsat);
- my @microsats = ();
- my @positions = ();
- my $lengthtracker = 0;
-
- for my $i (0 ... (scalar(@microields ) - 1)){
- if ($i%2 == 0){
- push(@microsats,$microields[$i]);
- $lengthtracker = $lengthtracker + length($microields[$i]);
-
- }
- else{
- push(@interruptions,$microields[$i]);
- push(@positions, $lengthtracker+1);
- $lengthtracker = $lengthtracker + length($microields[$i]);
- }
-
- }
- my $returnline = join("\t",(join("\t",@fields),join(",",(@infoarray)),join(",",(@interruptions)),join(",",(@positions)),scalar(@interruptions)));
- return($returnline);
-}
-
-#xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx multiSpecies_compound_microsat_analyzer xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx
-
-sub multiSpecies_compoundClarifyer{
-# print "IN multiSpecies_compoundClarifyer: @_\n";
- my $input1 = $_[0]; ###### the *_sput_compound
- my $input2 = $_[1]; ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
- my $output1 = $_[2]; ###### interrupted microsatellite file, in new .interrupted format
- my $output2 = $_[3]; ###### compound file
- my $org = $_[4];
- my $no_of_species = $_[5];
- @thresholds = "0";
- push(@thresholds, split(/_/,$_[6]));
-
-
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
- $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
-
- $interr_poscord = $motifcord + 3;
- $no_of_interruptionscord = $motifcord + 4;
- $interrcord = $motifcord + 2;
- $interrtypecord = $motifcord + 1;
-
-
- open(IN,"<$input1") or die "Cannot open file $input1 $!";
- open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
-
- open(INT,">$output1") or die "Cannot open file $output2 $!";
- open(COMP,">$output2") or die "Cannot open file $output2 $!";
- #open(CH,">changed") or die "Cannot open file changed $!";
-
-# print "opened files \n";
- my $linecounter = 0;
- my $microcounter = 0;
-
- my %micros = ();
- while (my $line = ){
- # print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
- $linecounter++;
- if ($line =~ /($focalspec)\s+([0-9a-zA-Z_\-]+)\s+([0-9]+)\s+([0-9]+)/ ) {
- my $key = join("\t",$1, $2, $3, $4);
- # print $key, "#-#-#-#-#-#-#-#\n";
- # print "key = $key\n";
- push (@{$micros{$key}},$line);
- $microcounter++;
- }
- else {#print $line," key not made\n"; ;
- }
- }
-# print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
- close IN;
- my @deletedlines = ();
-# print "done hash \n";
- $linecounter = 0;
- #---------------------------------------------------------------------------------------------------
- # NOW READING THE SEQUENCE FILE
- my @microsat_types = qw(_ mononucleotide dinucleotide trinucleotide tetranucleotide);
- $printer = 0;
-
- while(my $sine = ){
- my %microstart=();
- my %microend=();
- my @sields = split(/\t/,$sine);
- my $key = ();
-
-# print "sine = $sine. focalspec = $focalspec \n"; #;
-
- if ($sine =~ /($focalspec)\s+([0-9a-zA-Z_\-]+)\s+([0-9]+)\s+([0-9]+)/ ) {
-
-# 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/ ) {
- $key = join("\t",$1, $2, $3, $4);
-# print "key = $key\n";
- }
- else{
-# 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";
- }
-
- if (exists $micros{$key}){
- my @microstring = @{$micros{$key}};
- delete $micros{$key};
-
- foreach my $line (@microstring){
-# print "#---------#---------#---------#---------#---------#---------#---------#---------\n" if $printer == 1;
-# print "microsat = $line" if $printer == 1;
- $linecounter++;
- my $copy_line = $line;
- my @mields = split(/\t/,$line);
- my @fields = @mields;
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- my $microsat = $fields[$microsatcord];
- my $motifline = $fields[$motifcord];
- my $microsatcopy = $microsat;
- my $positioner = $microsat;
- $positioner =~ s/[a-zA-Z|-]/_/g;
- $microsatcopy =~ s/^\[|\]$//gs;
- chomp $microsatcopy;
- my @microields = split(/\][a-zA-Z|-]*\[/,$microsatcopy);
- my @inields = split(/\[[a-zA-Z|-]*\]/,$microsat);
- my $absolutstart = 1; my $absolutend = $absolutstart + ($end-$start);
-# print "absolut: start = $absolutstart, end = $absolutend\n" if $printer == 1;
- shift @inields;
- #print "inields =@inields<\n";
- $motifline =~ s/^\[|\]$//gs;
- chomp $motifline;
- #print "microsat = $microsat, its copy = $microsatcopy motifline = $motifline<\n";
- my @motields = split(/\]\[/,$motifline);
- my $seq = $microsatcopy;
- $seq =~ s/\[|\]//g;
- my $seqlen = length($seq);
- $seq = " ".$seq;
-
- my $longestmotif_no = longest_array_element(@motields);
- my $shortestmotif_no = shortest_array_element(@motields);
- #print "shortest motif = $motields[$shortestmotif_no], longest motif = $motields[$longestmotif_no] \n";
-
- my $search = $motields[$longestmotif_no].$motields[$longestmotif_no];
- if ((length($motields[$longestmotif_no]) == length($motields[$shortestmotif_no])) && ($search !~ /$motields[$shortestmotif_no]/) ){
- print COMP $line;
- next;
- }
-
- my @shortestmotif_nos = ();
- for my $m (0 ... $#motields){
- push(@shortestmotif_nos, $m) if (length($motields[$m]) == length($motields[$shortestmotif_no]) );
- }
- ## LOOKING AT LEFT OF THE SHORTEST MOTIF------------------------------------------------
- my $newleft =();
- my $leftstopper = 0; my $rightstopper = 0;
- foreach my $shortmotif_no (@shortestmotif_nos){
- next if $shortmotif_no == 0;
- my $last_left = $shortmotif_no; #$#motields;
- my $last_hitter = 0;
- for (my $i =($shortmotif_no-1); $i>=0; $i--){
- my $search = $motields[$shortmotif_no];
- if (length($motields[$shortmotif_no]) == 1){ $search = $motields[$shortmotif_no].$motields[$shortmotif_no] ;}
- if( (length($motields[$i]) > length($motields[$shortmotif_no])) && length($microields[$i]) > (2.5 * length($motields[$i])) ){
- $last_hitter = 1;
- $last_left = $i+1; last;
- }
- my $probe = $motields[$i];
- if (length($motields[$shortmotif_no]) == length($motields[$i])) {$probe = $motields[$i].$motields[$i];}
-
- if ($probe !~ /$search/){
- $last_hitter = 1;
- $last_left = $i+1;
- # print "hit the last match: before $microields[$i]..last left = $last_left.. exiting.\n";
- last;
- }
- $last_left--;$last_hitter = 1;
- # print "passed tests, last left = $last_left\n";
- }
- # print "comparing whether $last_left < $shortmotif_no, lasthit = $last_hitter\n";
- if (($last_left) < $shortmotif_no && $last_hitter == 1) {$leftstopper=0; last;}
- else {$leftstopper = 1;
- # print "leftstopper = 1\n";
- }
- }
-
- ## LOOKING AT LEFT OF THE SHORTEST MOTIF------------------------------------------------
- my $newright =();
- foreach my $shortmotif_no (@shortestmotif_nos){
- next if $shortmotif_no == $#motields;
- my $last_right = $shortmotif_no;# -1;
- for my $i ($shortmotif_no+1 ... $#motields){
- my $search = $motields[$shortmotif_no];
- if (length($motields[$shortmotif_no]) == 1 ){ $search = $motields[$shortmotif_no].$motields[$shortmotif_no] ;}
- if ( (length($motields[$i]) > length($motields[$shortmotif_no])) && length($microields[$i]) > (2.5 * length($motields[$i])) ){
- $last_right = $i-1; last;
- }
- my $probe = $motields[$i];
- if (length($motields[$shortmotif_no]) == length($motields[$i])) {$probe = $motields[$i].$motields[$i];}
- if ( $probe !~ /$search/){
- $last_right = $i-1; last;
- }
- $last_right++;
- }
- if (($last_right) > $shortmotif_no) {$rightstopper=0; last;# print "rightstopper = 0\n";
- }
- else {$rightstopper = 1;
- }
- }
-
-
- if ($rightstopper == 1 && $leftstopper == 1){
- print COMP $line;
-# print "rightstopper == 1 && leftstopper == 1\n" if $printer == 1;
- next;
- }
-
-# print "pased initial testing phase \n" if $printer == 1;
- my @outputs = ();
- my @orig_starts = ();
- my @orig_ends = ();
- for my $mic (0 ... $#microields){
- my $miclen = length($microields[$mic]);
- my $microleftlen = 0;
- #print "\nmic = $mic\n";
- if($mic > 0){
- for my $submin (0 ... $mic-1){
- my $interval = ();
- if (!exists $inields[$submin]) {$interval = "";}
- else {$interval = $inields[$submin];}
- #print "inield =$interval< and microield =$microields[$submin]<\n ";
- $microleftlen = $microleftlen + length($microields[$submin]) + length($interval);
- }
- }
- push(@orig_starts,($microleftlen+1));
- push(@orig_ends, ($microleftlen+1 + $miclen -1));
- }
-
- ############# F I N A L L Y S T U D Y I N G S E Q U E N C E S #########@@@@#########@@@@#########@@@@#########@@@@#########@@@@
-
-
- for my $mic (0 ... $#microields){
- my $miclen = length($microields[$mic]);
- my $microleftlen = 0;
- if($mic > 0){
- for my $submin (0 ... $mic-1){
- # if(!exists $inields[$submin]) {$inields[$submin] = "";}
- my $interval = ();
- if (!exists $inields[$submin]) {$interval = "";}
- else {$interval = $inields[$submin];}
- #print "inield =$interval< and microield =$microields[$submin]<\n ";
- $microleftlen = $microleftlen + length($microields[$submin]) + length($interval);
- }
- }
- $fields[$startcord] = $microleftlen+1;
- $fields[$endcord] = $fields[$startcord] + $miclen -1;
- $fields[$typecord] = $microsat_types[length($motields[$mic])];
- $fields[$microsatcord] = $microields[$mic];
- $fields[$motifcord] = $motields[$mic];
- my $templine = join("\t", (@fields[0 .. $motifcord]) );
- my $orig_templine = join("\t", (@fields[0 .. $motifcord]) );
- my $newline;
- my $lefter = 1; my $righter = 1;
- if ( $fields[$startcord] < 2){$lefter = 0;}
- if ($fields[$endcord] == $seqlen){$righter = 0;}
-
- while($lefter == 1){
- $newline = left_extender($templine, $seq,$org);
-# print "returned line from left extender= $newline \n" if $printer == 1;
- if ($newline eq $templine){$templine = $newline; last;}
- else {$templine = $newline;}
-
- if (left_extention_permission_giver($templine) eq "no") {last;}
- }
- while($righter == 1){
- $newline = right_extender($templine, $seq,$org);
-# print "returned line from right extender= $newline \n" if $printer == 1;
- if ($newline eq $templine){$templine = $newline; last;}
- else {$templine = $newline;}
- if (right_extention_permission_giver($templine) eq "no") {last;}
- }
- my @tempfields = split(/\t/,$templine);
- $tempfields[$microsatcord] =~ s/\]|\[//g;
- $tempfields[$motifcord] =~ s/^\[|\]$//gs;
- my @tempmotields = split(/\]\[/,$tempfields[$motifcord]);
-
- if (scalar(@tempmotields) == 1 && $templine eq $orig_templine) {
-# print "scalar ( tempmotields) = 1\n" if $printer == 1;
- next;
- }
- my $prevmotif = shift(@tempmotields);
- my $stopper = 0;
-
- foreach my $tempmot (@tempmotields){
- if (length($tempmot) != length($prevmotif)) {$stopper = 1; last;}
- my $search = $prevmotif.$prevmotif;
- if ($search !~ /$tempmot/) {$stopper = 1; last;}
- $prevmotif = $tempmot;
- }
- if ( $stopper == 1) {
-# print "length tempmot != length prevmotif\n" if $printer == 1;
- next;
- }
- my $lastend = 0;
- #----------------------------------------------------------
- my $left_captured = (); my $right_captured = ();
- my $left_bp = (); my $right_bp = ();
- # print "new startcord = $tempfields[$startcord] , new endcord = $tempfields[$endcord].. orig strts = @orig_starts and orig ends = @orig_ends\n";
- for my $o (0 ... $#orig_starts){
-# print "we are talking abut tempstart:$tempfields[$startcord] >= origstart:$lastend && tempstart:$tempfields[$startcord] <= origend: $orig_ends[$o] \n" if $printer == 1;
-# print "we are talking abut tempend:$tempfields[$endcord] >= origstart:$lastend && tempstart:$tempfields[$endcord] >= origend: $orig_ends[$o] \n" if $printer == 1;
-
- if (($tempfields[$startcord] > $lastend) && ($tempfields[$startcord] <= $orig_ends[$o])){ # && ($tempfields[$startcord] != $fields[$startcord])
-# print "motif captured on left is $microields[$o] from $microsat\n" if $printer == 1;
- $left_captured = $o;
- $left_bp = $orig_ends[$o] - $tempfields[$startcord] + 1;
- }
- elsif ($tempfields[$endcord] > $lastend && $tempfields[$endcord] <= $orig_ends[$o]){ #&& $tempfields[$endcord] != $fields[$endcord])
-# print "motif captured on right is $microields[$o] from $microsat\n" if $printer == 1;
- $right_captured = $o;
- $right_bp = $tempfields[$endcord] - $orig_starts[$o] + 1;
- }
- $lastend = $orig_ends[$o]
- }
-# print "leftcaptured = $left_captured, right = $right_captured\n" if $printer==1;
- my $leftmotif = (); my $left_trashed = ();
- if ($tempfields[$startcord] != $fields[$startcord]) {
- $leftmotif = $motields[$left_captured];
-# print "$left_captured in @microields: $motields[$left_captured]\n" if $printer == 1;
- if ( $left_captured !~ /[0-9]+/) {#print $line,"\n", $templine,"\n";
- }
- $left_trashed = length($microields[$left_captured]) - $left_bp;
- }
- my $rightmotif = (); my $right_trashed = ();
- if ($tempfields[$endcord] != $fields[$endcord]) {
-# print "$right_captured in @microields: $motields[$right_captured]\n" if $printer == 1;
- $rightmotif = $motields[$right_captured];
- $right_trashed = length($microields[$right_captured]) - $right_bp;
- }
-
- ########## P A R A M S #####################@@@@#########@@@@#########@@@@#########@@@@#########@@@@#########@@@@#########@@@@
- $stopper = 0;
- my $deletioner = 0;
- #if($tempfields[$startcord] != $fields[$startcord]){
-# print "enter left: tempfields,startcord : $tempfields[$startcord] != $absolutstart && left_captured: $left_captured != 0 \n" if $printer==1;
- if ($left_captured != 0){
-# print "at line 370, going: 0 ... $left_captured-1 \n" if $printer == 1;
- for my $e (0 ... $left_captured-1){
- if( length($motields[$e]) > 2 && length($microields[$e]) > (3* length($motields[$e]) )){
-# print "motif on left not included too big to be ignored : $microields[$e] \n" if $printer == 1;
- $deletioner++; last;
- }
- if( length($motields[$e]) == 2 && length($microields[$e]) > (3* length($motields[$e]) )){
-# print "motif on left not included too big to be ignored : $microields[$e] \n" if $printer == 1;
- $deletioner++; last;
- }
- if( length($motields[$e]) == 1 && length($microields[$e]) > (4* length($motields[$e]) )){
-# print "motif on left not included too big to be ignored : $microields[$e] \n" if $printer == 1;
- $deletioner++; last;
- }
- }
- }
- #}
-# print "after left search, deletioner = $deletioner\n" if $printer == 1;
- if ($deletioner >= 1) {
-# print "deletioner = $deletioner\n" if $printer == 1;
- next;
- }
-
- $deletioner = 0;
-
- #if($tempfields[$endcord] != $fields[$endcord]){
-# print "if tempfields endcord: $tempfields[$endcord] != absolutend: $absolutend\n and $right_captured != $#microields\n" if $printer==1;
- if ($right_captured != $#microields){
-# print "at line 394, going: $right_captured+1 ... $#microields \n" if $printer == 1;
- for my $e ($right_captured+1 ... $#microields){
- if( length($motields[$e]) > 2 && length($microields[$e]) > (3* length($motields[$e])) ){
-# print "motif on right not included too big to be ignored : $microields[$e] \n" if $printer == 1;
- $deletioner++; last;
- }
- if( length($motields[$e]) == 2 && length($microields[$e]) > (3* length($motields[$e]) )){
-# print "motif on right not included too big to be ignored : $microields[$e] \n" if $printer == 1;
- $deletioner++; last;
- }
- if( length($motields[$e]) == 1 && length($microields[$e]) > (4* length($motields[$e]) )){
-# print "motif on right not included too big to be ignored : $microields[$e] \n" if $printer == 1;
- $deletioner++; last;
- }
- }
- }
- #}
-# print "deletioner = $deletioner\n" if $printer == 1;
- if ($deletioner >= 1) {
- next;
- }
- my $leftMotifs_notCaptured = ();
- my $rightMotifs_notCaptured = ();
-
- if ($tempfields[$startcord] != $fields[$startcord] ){
- #print "in left params: (length($leftmotif) == 1 && $tempfields[$startcord] != $fields[$startcord]) ... and .... $left_trashed > (1.5* length($leftmotif]) && ($tempfields[$startcord] != $fields[$startcord])\n";
- if (length($leftmotif) == 1 && $left_trashed > 3){
-# print "invaded left motif is long mononucleotide" if $printer == 1;
- next;
-
- }
- elsif ((length($leftmotif) != 1 && $left_trashed > ( thrashallow($leftmotif)) && ($tempfields[$startcord] != $fields[$startcord]) ) ){
-# print "invaded left motif too long" if $printer == 1;
- next;
- }
- }
- if ($tempfields[$endcord] != $fields[$endcord] ){
- #print "in right params: after $tempfields[$endcord] != $fields[$endcord] ..... (length($rightmotif)==1 && $tempfields[$endcord] != $fields[$endcord]) ... and ... $right_trashed > (1.5* length($rightmotif))\n";
- if (length($rightmotif)==1 && $right_trashed){
-# print "invaded right motif is long mononucleotide" if $printer == 1;
- next;
-
- }
- elsif (length($rightmotif) !=1 && ($right_trashed > ( thrashallow($rightmotif)) && $tempfields[$endcord] != $fields[$endcord])){
-# print "invaded right motif too long" if $printer == 1;
- next;
-
- }
- }
- push @outputs, $templine;
- }
- if (scalar(@outputs) == 0){ print COMP $line; next;}
- # print "outputs are:", join("\n",@outputs),"\n";
- if (scalar(@outputs) == 1){
- my @oields = split(/\t/,$outputs[0]);
- my $start = $oields[$startcord]+$mields[$startcord]-1;
- my $end = $start+($oields[$endcord]-$oields[$startcord]);
- $oields[$startcord] = $start; $oields[$endcord] = $end;
- print INT join("\t",@oields), "\n";
- # print CH $line,;
- }
- if (scalar(@outputs) > 1){
- my $motif_min = 10;
- my $chosen_one = $outputs[0];
- foreach my $micro (@outputs){
- my @oields = split(/\t/,$micro);
- my $tempmotif = $oields[$motifcord];
- $tempmotif =~ s/^\[|\]$//gs;
- my @omots = split(/\]\[/, $tempmotif);
- # print "motif_min = $motif_min, current motif = $tempmotif\n";
- my $start = $oields[$startcord]+$mields[$startcord]-1;
- my $end = $start+($oields[$endcord]-$oields[$startcord]);
- $oields[$startcord] = $start; $oields[$endcord] = $end;
- if(length($omots[0]) < $motif_min) {
- $chosen_one = join("\t",@oields);
- $motif_min = length($omots[0]);
- }
- }
- print INT $chosen_one, "\n";
- # print "chosen one is ".$chosen_one, "\n";
- # print CH $line;
-
-
- }
-
- }
-
- } #if (exists $micros{$key}){
- else{
- }
- }
- close INT;
- close COMP;
-}
-sub left_extender{
- #print "left extender\n";
- my ($line, $seq, $org) = @_;
-# print "in left extender... line passed = $line and sequence is $seq\n";
- chomp $line;
- my @fields = split(/\t/,$line);
- my $rstart = $fields[$startcord];
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/\[|\]//g;
- my $rend = $rstart + length($microsat)-1;
- $microsat =~ s/-//g;
- my $motif = $fields[$motifcord];
- my $firstmotif = ();
-
- if ($motif =~ /^\[/){
- $motif =~ s/^\[//g;
- $motif =~ /([a-zA-Z]+)\].*/;
- $firstmotif = $1;
- }
- else {$firstmotif = $motif;}
-
- #print "hacked microsat = $microsat, motif = $motif, firstmotif = $firstmotif\n";
- my $leftphase = substr($microsat, 0,length($firstmotif));
- my $phaser = $leftphase.$leftphase;
- my @phase = split(/\s*/,$leftphase);
- my @phases;
- my @copy_phases = @phases;
- my $crawler=0;
- for (0 ... (length($leftphase)-1)){
- push(@phases, substr($phaser, $crawler, length($leftphase)));
- $crawler++;
- }
-
- my $start = $rstart;
- my $end = $rend;
-
- my $leftseq = substr($seq, 0, $start);
-# print "left phases are @phases , start = $start left sequence = ",substr($leftseq, -10),"\n";
- my @extentions = ();
- my @trappeds = ();
- my @intervalposs = ();
- my @trappedposs = ();
- my @trappedphases = ();
- my @intervals = ();
- my $firstmotif_length = length($firstmotif);
- foreach my $phase (@phases){
-# print "left phase\t",substr($leftseq, -10),"\t$phase\n";
-# print "search patter = (($phase)+([a-zA-Z|-]{0,$firstmotif_length})) \n";
- if ($leftseq =~ /(($phase)+([a-zA-Z|-]{0,$firstmotif_length}))$/i){
-# print "in left pattern\n";
- my $trapped = $1;
- my $trappedpos = length($leftseq)-length($trapped);
- my $interval = $3;
- my $intervalpos = index($trapped, $interval) + 1;
-# print "left trapped = $trapped, interval = $interval, intervalpos = $intervalpos\n";
-
- my $extention = substr($trapped, 0, length($trapped)-length($interval));
- my $leftpeep = substr($seq, 0, ($start-length($trapped)));
- my @passed_overhangs;
-
- for my $i (1 ... length($phase)-1){
- my $overhang = substr($phase, -length($phase)+$i);
-# print "current overhang = $overhang, leftpeep = ",substr($leftpeep,-10)," whole sequence = ",substr($seq, ($end - ($end-$start) - 20), (($end-$start)+20)),"\n";
- #TEMPORARY... BETTER METHOD NEEDED
- $leftpeep =~ s/-//g;
- if ($leftpeep =~ /$overhang$/i){
- push(@passed_overhangs,$overhang);
-# print "l overhang\n";
- }
- }
-
- if(scalar(@passed_overhangs)>0){
- my $overhang = $passed_overhangs[longest_array_element(@passed_overhangs)];
- $extention = $overhang.$extention;
- $trapped = $overhang.$trapped;
- #print "trapped extended to $trapped \n";
- $trappedpos = length($leftseq)-length($trapped);
- }
-
- push(@extentions,$extention);
-# print "extentions = @extentions \n";
-
- push(@trappeds,$trapped );
- push(@intervalposs,length($extention)+1);
- push(@trappedposs, $trappedpos);
-# print "trappeds = @trappeds\n";
- push(@trappedphases, substr($extention,0,length($phase)));
- push(@intervals, $interval);
- }
- }
- if (scalar(@trappeds == 0)) {return $line;}
-
- my $nikaal = shortest_array_element(@intervals);
-
- if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
- $fields[$motifcord] = "[".$trappedphases[$nikaal]."]".$fields[$motifcord];
- ##print "new fields 9 = $fields[9]\n";
- $fields[$startcord] = $fields[$startcord]-length($trappeds[$nikaal]);
-
- if($fields[$microsatcord] !~ /^\[/i){
- $fields[$microsatcord] = "[".$fields[$microsatcord]."]";
- }
-
- $fields[$microsatcord] = "[".$extentions[$nikaal]."]".$intervals[$nikaal].$fields[$microsatcord];
-
- if (exists ($fields[$motifcord+1])){
- $fields[$motifcord+1] = "indel/deletion,".$fields[$motifcord+1];
- }
- else{$fields[$motifcord+1] = "indel/deletion";}
- ##print "new fields 14 = $fields[14]\n";
-
- if (exists ($fields[$motifcord+2])){
- $fields[$motifcord+2] = $intervals[$nikaal].",".$fields[$motifcord+2];
- }
- else{$fields[$motifcord+2] = $intervals[$nikaal];}
- my @seventeen=();
- if (exists ($fields[$motifcord+3])){
- @seventeen = split(/,/,$fields[$motifcord+3]);
- # #print "scalarseventeen =@seventeen<-\n";
- for (0 ... scalar(@seventeen)-1) {$seventeen[$_] = $seventeen[$_]+length($trappeds[$nikaal]);}
- $fields[$motifcord+3] = ($intervalposs[$nikaal]).",".join(",",@seventeen);
- $fields[$motifcord+4] = $fields[$motifcord+4]+1;
- }
-
- else {$fields[$motifcord+3] = $intervalposs[$nikaal]; $fields[$motifcord+4]=1}
-
- ##print "new fields 16 = $fields[16]\n";
- ##print "new fields 17 = $fields[17]\n";
-
-
- my $returnline = join("\t",@fields);
- my $pastline = $returnline;
- if ($fields[$microsatcord] =~ /\[/){
- $returnline = multiSpecies_compoundClarifyer_merge($returnline);
- }
- return $returnline;
-}
-sub right_extender{
- my ($line, $seq, $org) = @_;
- chomp $line;
- my @fields = split(/\t/,$line);
- my $rstart = $fields[$startcord];
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/\[|\]//g;
- my $rend = $rstart + length($microsat)-1;
- $microsat =~ s/-//g;
- my $motif = $fields[$motifcord];
- my $temp_lastmotif = ();
-
- if ($motif =~ /\]$/s){
- $motif =~ s/\]$//sg;
- $motif =~ /.*\[([a-zA-Z]+)/;
- $temp_lastmotif = $1;
- }
- else {$temp_lastmotif = $motif;}
- my $lastmotif = substr($microsat,-length($temp_lastmotif));
- ##print "hacked microsat = $microsat, motif = $motif, lastmotif = $lastmotif\n";
- my $rightphase = substr($microsat, -length($lastmotif));
- my $phaser = $rightphase.$rightphase;
- my @phase = split(/\s*/,$rightphase);
- my @phases;
- my @copy_phases = @phases;
- my $crawler=0;
- for (0 ... (length($rightphase)-1)){
- push(@phases, substr($phaser, $crawler, length($rightphase)));
- $crawler++;
- }
-
- my $start = $rstart;
- my $end = $rend;
-
- my $rightseq = substr($seq, $end+1);
- my @extentions = ();
- my @trappeds = ();
- my @intervalposs = ();
- my @trappedposs = ();
- my @trappedphases = ();
- my @intervals = ();
- my $lastmotif_length = length($lastmotif);
- foreach my $phase (@phases){
- if ($rightseq =~ /^(([a-zA-Z|-]{0,$lastmotif_length}?)($phase)+)/i){
- my $trapped = $1;
- my $trappedpos = $end+1;
- my $interval = $2;
- my $intervalpos = index($trapped, $interval) + 1;
-
- my $extention = substr($trapped, length($interval));
- my $rightpeep = substr($seq, ($end+length($trapped))+1);
- my @passed_overhangs = "";
-
- #TEMPORARY... BETTER METHOD NEEDED
- $rightpeep =~ s/-//g;
-
- for my $i (1 ... length($phase)-1){
- my $overhang = substr($phase,0, $i);
-# #print "current extention = $extention, overhang = $overhang, rightpeep = ",substr($rightpeep,0,10),"\n";
- if ($rightpeep =~ /^$overhang/i){
- push(@passed_overhangs, $overhang);
-# #print "r overhang\n";
- }
- }
- if (scalar(@passed_overhangs) > 0){
- my $overhang = @passed_overhangs[longest_array_element(@passed_overhangs)];
- $extention = $extention.$overhang;
- $trapped = $trapped.$overhang;
-# #print "trapped extended to $trapped \n";
- }
-
- push(@extentions,$extention);
- ##print "extentions = @extentions \n";
-
- push(@trappeds,$trapped );
- push(@intervalposs,$intervalpos);
- push(@trappedposs, $trappedpos);
-# #print "trappeds = @trappeds\n";
- push(@trappedphases, substr($extention,0,length($phase)));
- push(@intervals, $interval);
- }
- }
- if (scalar(@trappeds == 0)) {return $line;}
-
-# my $nikaal = longest_array_element(@trappeds);
- my $nikaal = shortest_array_element(@intervals);
-
-# #print "longest element found = $nikaal \n";
-
- if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
- $fields[$motifcord] = $fields[$motifcord]."[".$trappedphases[$nikaal]."]";
- ##print "new fields 9 = $fields[9]";
- $fields[$endcord] = $fields[$endcord] + length($trappeds[$nikaal]);
-
- ##print "new fields 11 = $fields[11]\n";
-
- if($fields[$microsatcord] !~ /^\[/i){
- $fields[$microsatcord] = "[".$fields[$microsatcord]."]";
- }
-
- $fields[$microsatcord] = $fields[$microsatcord].$intervals[$nikaal]."[".$extentions[$nikaal]."]";
- ##print "new fields 12 = $fields[12]\n";
-
- ##print "scalar of fields = ",scalar(@fields),"\n";
- if (exists ($fields[$motifcord+1])){
-# print " print fields = @fields.. scalar=", scalar(@fields),".. motifcord+1 = $motifcord + 1 \n " if !exists $fields[$motifcord+1];
-# if !exists $fields[$motifcord+1];
- $fields[$motifcord+1] = $fields[$motifcord+1].",indel/deletion";
- }
- else{$fields[$motifcord+1] = "indel/deletion";}
- ##print "new fields 14 = $fields[14]\n";
-
- if (exists ($fields[$motifcord+2])){
- $fields[$motifcord+2] = $fields[$motifcord+2].",".$intervals[$nikaal];
- }
- else{$fields[$motifcord+2] = $intervals[$nikaal];}
- ##print "new fields 15 = $fields[15]\n";
-
- my @seventeen=();
- if (exists ($fields[$motifcord+3])){
- ##print "at 608 we are doing this:length($microsat)+$intervalposs[$nikaal]\n";
-# print " print fields = @fields\n " if !exists $fields[$motifcord+3];
- if !exists $fields[$motifcord+3];
- my $currpos = length($microsat)+$intervalposs[$nikaal];
- $fields[$motifcord+3] = $fields[$motifcord+3].",".$currpos;
- $fields[$motifcord+4] = $fields[$motifcord+4]+1;
-
- }
-
- else {$fields[$motifcord+3] = length($microsat)+$intervalposs[$nikaal]; $fields[$motifcord+4]=1}
-
- ##print "new fields 16 = $fields[16]\n";
-
- ##print "new fields 17 = $fields[17]\n";
- my $returnline = join("\t",@fields);
- my $pastline = $returnline;
- if ($fields[$microsatcord] =~ /\[/){
- $returnline = multiSpecies_compoundClarifyer_merge($returnline);
- }
- #print "finally right-extended line = ",$returnline,"\n";
- return $returnline;
-}
-sub longest_array_element{
- my $counter = 0;
- my($max) = shift(@_);
- my $maxcounter = 0;
- foreach my $temp (@_) {
- $counter++;
- #print "finding largest array: $maxcounter \n" if $prinkter == 1;
- if(length($temp) > length($max)){
- $max = $temp;
- $maxcounter = $counter;
- }
- }
- return($maxcounter);
-}
-sub shortest_array_element{
- my $counter = 0;
- my($min) = shift(@_);
- my $mincounter = 0;
- foreach my $temp (@_) {
- $counter++;
- #print "finding largest array: $mincounter \n" if $prinkter == 1;
- if(length($temp) < length($min)){
- $min = $temp;
- $mincounter = $counter;
- }
- }
- return($mincounter);
-}
-
-
-sub left_extention_permission_giver{
- my @fields = split(/\t/,$_[0]);
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/(^\[)|-//g;
- my $motif = $fields[$motifcord];
- my $firstmotif = ();
- my $firststretch = ();
- my @stretches=();
- if ($motif =~ /^\[/){
- $motif =~ s/^\[//g;
- $motif =~ /([a-zA-Z]+)\].*/;
- $firstmotif = $1;
- @stretches = split(/\]/,$microsat);
- $firststretch = $stretches[0];
- ##print "firststretch = $firststretch\n";
- }
- else {$firstmotif = $motif;$firststretch = $microsat;}
-
- if (length($firststretch) < $thresholds[length($firstmotif)]){
- return "no";
- }
- else {return "yes";}
-
-}
-sub right_extention_permission_giver{
- my @fields = split(/\t/,$_[0]);
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/-|(\]$)//sg;
- my $motif = $fields[$motifcord];
- my $temp_lastmotif = ();
- my $laststretch = ();
- my @stretches=();
-
-
- if ($motif =~ /\]/){
- $motif =~ s/\]$//gs;
- $motif =~ /.*\[([a-zA-Z]+)$/;
- $temp_lastmotif = $1;
- @stretches = split(/\[/,$microsat);
- $laststretch = pop(@stretches);
- ##print "last stretch = $laststretch\n";
- }
- else {$temp_lastmotif = $motif; $laststretch = $microsat;}
-
- if (length($laststretch) < $thresholds[length($temp_lastmotif)]){
- return "no";
- }
- else { return "yes";}
-
-
-}
-sub multiSpecies_compoundClarifyer_merge{
- my $line = $_[0];
- #print "sent for mering: $line \n";
- my @mields = split(/\t/,$line);
- my @fields = @mields;
- my $microsat = $fields[$microsatcord];
- my $motifline = $fields[$motifcord];
- my $microsatcopy = $microsat;
- $microsatcopy =~ s/^\[|\]$//sg;
- my @microields = split(/\][a-zA-Z|-]*\[/,$microsatcopy);
- my @inields = split(/\[[a-zA-Z|-]*\]/,$microsat);
- shift @inields;
- #print "inields =@inields<\n";
- $motifline =~ s/^\[|\]$//sg;
- my @motields = split(/\]\[/,$motifline);
- my @firstmotifs = ();
- my @lastmotifs = ();
- for my $i (0 ... $#microields){
- $firstmotifs[$i] = substr($microields[$i],0,length($motields[$i]));
- $lastmotifs[$i] = substr($microields[$i],-length($motields[$i]));
- }
- #print "firstmotif = @firstmotifs... lastmotif = @lastmotifs\n";
- my @mergelist = ();
- my @inter_poses = split(/,/,$fields[$interr_poscord]);
- my $no_of_interruptions = $fields[$no_of_interruptionscord];
- my @interruptions = split(/,/,$fields[$interrcord]);
- my @interrtypes = split(/,/,$fields[$interrtypecord]);
- my $stopper = 0;
- for my $i (0 ... $#motields-1){
- #print "studying connection of $motields[$i] and $motields[$i+1], i = $i in $microsat\n";
- if (($lastmotifs[$i] eq $firstmotifs[$i+1]) && !exists $inields[$i]){
- $stopper = 1;
- push(@mergelist, ($i)."_".($i+1));
- }
- }
-
- return $line if scalar(@mergelist) == 0;
-
- foreach my $merging (@mergelist){
- my @sets = split(/_/, $merging);
- my @tempmicro = ();
- my @tempmot = ();
- for my $i (0 ... $sets[0]-1){
- push(@tempmicro, "[".$microields[$i]."]");
- push(@tempmicro, $inields[$i]);
- push(@tempmot, "[".$motields[$i]."]");
- #print "adding pre-motifs number $i\n";
- }
- my $pusher = "[".$microields[$sets[0]].$microields[$sets[1]]."]";
- push (@tempmicro, $pusher);
- push(@tempmot, "[".$motields[$sets[0]]."]");
- my $outcoming = -2;
- for my $i ($sets[1]+1 ... $#microields-1){
- push(@tempmicro, "[".$microields[$i]."]");
- push(@tempmicro, $inields[$i]);
- push(@tempmot, "[".$motields[$i]."]");
- #print "adding post-motifs number $i\n";
- $outcoming = $i;
- }
- if ($outcoming != -2){
- #print "outcoming = $outcoming \n";
- push(@tempmicro, "[".$microields[$outcoming+1 ]."]");
- push(@tempmot,"[". $motields[$outcoming+1]."]");
- }
- $fields[$microsatcord] = join("",@tempmicro);
- $fields[$motifcord] = join("",@tempmot);
-
- splice(@interrtypes, $sets[0], 1);
- $fields[$interrtypecord] = join(",",@interrtypes);
- splice(@interruptions, $sets[0], 1);
- $fields[$interrcord] = join(",",@interruptions);
- splice(@inter_poses, $sets[0], 1);
- $fields[$interr_poscord] = join(",",@inter_poses);
- $no_of_interruptions = $no_of_interruptions - 1;
- }
-
- if ($no_of_interruptions == 0){
- $fields[$microsatcord] =~ s/^\[|\]$//sg;
- $fields[$motifcord] =~ s/^\[|\]$//sg;
- $line = join("\t", @fields[0 ... $motifcord]);
- }
- else{
- $line = join("\t", @fields);
- }
- return $line;
-}
-
-sub thrashallow{
- my $motif = $_[0];
- return 4 if length($motif) == 2;
- return 6 if length($motif) == 3;
- return 8 if length($motif) == 4;
-
-}
-
-#xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx multiSpecies_compoundClarifyer xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx
-sub multispecies_filtering_compound_microsats{
- my $unfiltered = $_[0];
- my $filtered = $_[1];
- my $residue = $_[2];
- my $no_of_species = $_[5];
- open(UNF,"<$unfiltered") or die "Cannot open file $unfiltered: $!";
- open(FIL,">$filtered") or die "Cannot open file $filtered: $!";
- open(RES,">$residue") or die "Cannot open file $residue: $!";
-
- $infocord = 2 + (4*$no_of_species) - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
-
- my @sub_thresholds = ("0");
- push(@sub_thresholds, split(/_/,$_[3]));
- my @thresholds = ("0");
- push(@thresholds, split(/_/,$_[4]));
-
- while (my $line = ) {
- if ($line !~ /compound/){
- print FIL $line,"\n"; next;
- }
- chomp $line;
- my @fields = split(/\t/,$line);
- my $motifline = $fields[$motifcord];
- $motifline =~ s/^\[|\]$//g;
- my @motifs = split(/\]\[/,$motifline);
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/^\[|\]$|-//g;
- my @microsats = split(/\][a-zA-Z|-]*\[/,$microsat);
-
- my $stopper = 0;
- for my $i (0 ... $#motifs){
- my @common = ();
- my $probe = $motifs[$i].$motifs[$i];
- my $motif_size = length($motifs[$i]);
-
- for my $j (0 ... $#motifs){
- next if length($motifs[$i]) != length($motifs[$j]);
- push(@common, length($microsats[$j])) if $probe =~ /$motifs[$j]/i;
- }
-
- if (largest_microsat(@common) < $sub_thresholds[$motif_size]) {$stopper = 1; last;}
- else {next;}
- }
-
- if ($stopper == 1){
- print RES $line,"\n";
- }
- else { print FIL $line,"\n"; }
- }
- close FIL;
- close RES;
-}
-
-#xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx multispecies_filtering_compound_microsats xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx
-
-sub chromosome_unrand_breaker{
-# print "IN chromosome_unrand_breaker: @_\n ";
- my $input1 = $_[0]; ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
- my $dir = $_[1]; ###### directory where subsets are put
- my $output2 = $_[2]; ###### list of subset files
- my $increment = $_[3];
- my $info = $_[4];
- my $chr = $_[5];
- open(SEQ,"<$input1") or die "Cannot open file $input1 $!";
-
- open(OUT,">$output2") or die "Cannot open file $output2 $!";
-
- #---------------------------------------------------------------------------------------------------
- # NOW READING THE SEQUENCE FILE
-
- my $seed = 0;
- my $subset = $dir.$info."_".$chr."_".$seed."_".($seed+$increment);
- print OUT $subset,"\n";
- open(SUB,">$subset");
-
- while(my $sine = ){
- $seed++;
- print SUB $sine;
-
- if ($seed%$increment == 0 ){
- close SUB;
- $subset = $dir.$info."_".$chr."_".$seed."_".($seed+$increment);
- open(SUB,">$subset");
- print SUB $sine;
- print OUT $subset,"\n";
- # print $subset,"\n";
- }
- }
- close OUT;
- close SUB;
-}
-#xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx chromosome_unrand_breaker xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx
-sub multiSpecies_interruptedMicrosatHunter{
-# print "IN multiSpecies_interruptedMicrosatHunter: @_\n";
- my $input1 = $_[0]; ###### the *_sput_op4_ii file
- my $input2 = $_[1]; ###### looks like this: my $t8humanoutput = "*_nogap_op_unrand2_match"
- my $output1 = $_[2]; ###### interrupted microsatellite file, in new .interrupted format
- my $output2 = $_[3]; ###### uninterrupted microsatellite file
- my $org = $_[4];
- my $no_of_species = $_[5];
-
- my @thresholds = "0";
- push(@thresholds, split(/_/,$_[6]));
-
-# print "thresholds = @thresholds \n";
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
- $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
-
- $interr_poscord = $motifcord + 3;
- $no_of_interruptionscord = $motifcord + 4;
- $interrcord = $motifcord + 2;
- $interrtypecord = $motifcord + 1;
-
-
- $prinkter = 0;
-# print "prionkytet = $prinkter\n";
-
- open(IN,"<$input1") or die "Cannot open file $input1 $!";
- open(SEQ,"<$input2") or die "Cannot open file $input2 $!";
-
- open(INT,">$output1") or die "Cannot open file $output2 $!";
- open(UNINT,">$output2") or die "Cannot open file $output2 $!";
-
-# print "opened files !!\n";
- my $linecounter = 0;
- my $microcounter = 0;
-
- my %micros = ();
- while (my $line = ){
- # print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
- $linecounter++;
- 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/ ) {
- my $key = join("\t",$1, $2, $3, $4, $5);
- # print $key, "#-#-#-#-#-#-#-#\n" if $prinkter == 1;
- push (@{$micros{$key}},$line);
- $microcounter++;
- }
- else {#print $line if $prinkter == 1;
- }
- }
-# print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
- close IN;
- my @deletedlines = ();
-# print "done hash \n";
- $linecounter = 0;
- #---------------------------------------------------------------------------------------------------
- # NOW READING THE SEQUENCE FILE
- while(my $sine = ){
- #print $linecounter,"\n" if $linecounter % 1000 == 0;
- my %microstart=();
- my %microend=();
- my @sields = split(/\t/,$sine);
- my $key = ();
- 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/ ) {
- $key = join("\t",$1, $2, $3, $4, $5);
- # print $key, "<-<-<-<-<-<-<-<\n";
- }
-
- # $prinkter = 1 if $sine =~ /^>H\t499\t/;
-
- if (exists $micros{$key}){
- my @microstring = @{$micros{$key}};
- delete $micros{$key};
- my @filteredmicrostring;
-# print "sequence = $sields[$sequencepos]" if $prinkter == 1;
- foreach my $line (@microstring){
- $linecounter++;
- my $copy_line = $line;
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
-
-# print $line if $prinkter == 1;
- #LOOKING FOR LEFTWARD EXTENTION OF MICROSATELLITE
- my $newline;
- while(1){
- # print "\n before left sequence = $sields[$sequencepos]\n" if $prinkter == 1;
- if (multiSpecies_interruptedMicrosatHunter_left_extention_permission_giver($line) eq "no") {last;}
-
- $newline = multiSpecies_interruptedMicrosatHunter_left_extender($line, $sields[$sequencepos],$org);
- if ($newline eq $line){$line = $newline; last;}
- else {$line = $newline;}
-
- if (multiSpecies_interruptedMicrosatHunter_left_extention_permission_giver($line) eq "no") {last;}
-# print "returned line from left extender= $line \n" if $prinkter == 1;
- }
- while(1){
- # print "sequence = $sields[$sequencepos]\n" if $prinkter == 1;
- if (multiSpecies_interruptedMicrosatHunter_right_extention_permission_giver($line) eq "no") {last;}
-
- $newline = multiSpecies_interruptedMicrosatHunter_right_extender($line, $sields[$sequencepos],$org);
- if ($newline eq $line){$line = $newline; last;}
- else {$line = $newline;}
-
- if (multiSpecies_interruptedMicrosatHunter_right_extention_permission_giver($line) eq "no") {last;}
-# print "returned line from right extender= $line \n" if $prinkter == 1;
- }
-# print "\n>>>>>>>>>>>>>>>>\n In the end, the line is: \n$line\n<<<<<<<<<<<<<<<<\n" if $prinkter == 1;
-
- my @tempfields = split(/\t/,$line);
- if ($tempfields[$microsatcord] =~ /\[/){
- print INT $line,"\n";
- }
- else{
- print UNINT $line,"\n";
- }
-
- if ($line =~ /NULL/){ next; }
- push(@filteredmicrostring, $line);
- push (@{$microstart{$start}},$line);
- push (@{$microend{$end}},$line);
- }
-
- my $firstflag = 'down';
-
- } #if (exists $micros{$key}){
- }
- close INT;
- close UNINT;
-# print "final number of lines = $linecounter\n";
-}
-
-sub multiSpecies_interruptedMicrosatHunter_left_extender{
- my ($line, $seq, $org) = @_;
-# print "left extender, like passed = $line\n" if $prinkter == 1;
-# print "in left extender... line passed = $line and sequence is $seq\n" if $prinkter == 1;
- chomp $line;
- my @fields = split(/\t/,$line);
- my $rstart = $fields[$startcord];
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/\[|\]//g;
- my $rend = $rstart + length($microsat)-1;
- $microsat =~ s/-//g;
- my $motif = $fields[$motifcord];
- my $firstmotif = ();
-
- if ($motif =~ /^\[/){
- $motif =~ s/^\[//g;
- $motif =~ /([a-zA-Z]+)\].*/;
- $firstmotif = $1;
- }
- else {$firstmotif = $motif;}
-
-# print "hacked microsat = $microsat, motif = $motif, firstmotif = $firstmotif\n" if $prinkter == 1;
- my $leftphase = substr($microsat, 0,length($firstmotif));
- my $phaser = $leftphase.$leftphase;
- my @phase = split(/\s*/,$leftphase);
- my @phases;
- my @copy_phases = @phases;
- my $crawler=0;
- for (0 ... (length($leftphase)-1)){
- push(@phases, substr($phaser, $crawler, length($leftphase)));
- $crawler++;
- }
-
- my $start = $rstart;
- my $end = $rend;
-
- my $leftseq = substr($seq, 0, $start);
-# print "left phases are @phases , start = $start left sequence = ",substr($leftseq, -10),"\n" if $prinkter == 1;
- my @extentions = ();
- my @trappeds = ();
- my @intervalposs = ();
- my @trappedposs = ();
- my @trappedphases = ();
- my @intervals = ();
- my $firstmotif_length = length($firstmotif);
- foreach my $phase (@phases){
-# print "left phase\t",substr($leftseq, -10),"\t$phase\n" if $prinkter == 1;
-# print "search patter = (($phase)+([a-zA-Z|-]{0,$firstmotif_length})) \n" if $prinkter == 1;
- if ($leftseq =~ /(($phase)+([a-zA-Z|-]{0,$firstmotif_length}))$/i){
-# print "in left pattern\n" if $prinkter == 1;
- my $trapped = $1;
- my $trappedpos = length($leftseq)-length($trapped);
- my $interval = $3;
- my $intervalpos = index($trapped, $interval) + 1;
-# print "left trapped = $trapped, interval = $interval, intervalpos = $intervalpos\n" if $prinkter == 1;
-
- my $extention = substr($trapped, 0, length($trapped)-length($interval));
- my $leftpeep = substr($seq, 0, ($start-length($trapped)));
- my @passed_overhangs;
-
- for my $i (1 ... length($phase)-1){
- my $overhang = substr($phase, -length($phase)+$i);
-# print "current overhang = $overhang, leftpeep = ",substr($leftpeep,-10)," whole sequence = ",substr($seq, ($end - ($end-$start) - 20), (($end-$start)+20)),"\n" if $prinkter == 1;
- #TEMPORARY... BETTER METHOD NEEDED
- $leftpeep =~ s/-//g;
- if ($leftpeep =~ /$overhang$/i){
- push(@passed_overhangs,$overhang);
-# print "l overhang\n" if $prinkter == 1;
- }
- }
-
- if(scalar(@passed_overhangs)>0){
- my $overhang = $passed_overhangs[longest_array_element(@passed_overhangs)];
- $extention = $overhang.$extention;
- $trapped = $overhang.$trapped;
-# print "trapped extended to $trapped \n" if $prinkter == 1;
- $trappedpos = length($leftseq)-length($trapped);
- }
-
- push(@extentions,$extention);
-# print "extentions = @extentions \n" if $prinkter == 1;
-
- push(@trappeds,$trapped );
- push(@intervalposs,length($extention)+1);
- push(@trappedposs, $trappedpos);
-# print "trappeds = @trappeds\n" if $prinkter == 1;
- push(@trappedphases, substr($extention,0,length($phase)));
- push(@intervals, $interval);
- }
- }
- if (scalar(@trappeds == 0)) {return $line;}
-
-############################ my $nikaal = longest_array_element(@trappeds);
- my $nikaal = shortest_array_element(@intervals);
-
-# print "longest element found = $nikaal \n" if $prinkter == 1;
-
- if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
- $fields[$motifcord] = "[".$trappedphases[$nikaal]."]".$fields[$motifcord];
- #print "new fields 9 = $fields[9]\n" if $prinkter == 1;
- $fields[$startcord] = $fields[$startcord]-length($trappeds[$nikaal]);
-
- #print "new fields 9 = $fields[9]\n" if $prinkter == 1;
-
- if($fields[$microsatcord] !~ /^\[/i){
- $fields[$microsatcord] = "[".$fields[$microsatcord]."]";
- }
-
- $fields[$microsatcord] = "[".$extentions[$nikaal]."]".$intervals[$nikaal].$fields[$microsatcord];
- #print "new fields 14 = $fields[12]\n" if $prinkter == 1;
-
- #print "scalar of fields = ",scalar(@fields),"\n" if $prinkter == 1;
-
-
- if (scalar(@fields) > $motifcord+1){
- $fields[$motifcord+1] = "indel/deletion,".$fields[$motifcord+1];
- }
- else{$fields[$motifcord+1] = "indel/deletion";}
- #print "new fields 14 = $fields[14]\n" if $prinkter == 1;
-
- if (scalar(@fields)>$motifcord+2){
- $fields[$motifcord+2] = $intervals[$nikaal].",".$fields[$motifcord+2];
- }
- else{$fields[$motifcord+2] = $intervals[$nikaal];}
- #print "new fields 15 = $fields[15]\n" if $prinkter == 1;
-
- my @seventeen=();
-
- if (scalar(@fields)>$motifcord+3){
- @seventeen = split(/,/,$fields[$motifcord+3]);
- # print "scalarseventeen =@seventeen<-\n" if $prinkter == 1;
- for (0 ... scalar(@seventeen)-1) {$seventeen[$_] = $seventeen[$_]+length($trappeds[$nikaal]);}
- $fields[$motifcord+3] = ($intervalposs[$nikaal]).",".join(",",@seventeen);
- $fields[$motifcord+4] = $fields[$motifcord+4]+1;
- }
-
- else {$fields[$motifcord+3] = $intervalposs[$nikaal]; $fields[$motifcord+4]=1}
-
- #print "new fields 16 = $fields[16]\n" if $prinkter == 1;
- #print "new fields 17 = $fields[17]\n" if $prinkter == 1;
-
-# return join("\t",@fields);
- my $returnline = join("\t",@fields);
- my $pastline = $returnline;
- if ($fields[$microsatcord] =~ /\[/){
- $returnline = multiSpecies_interruptedMicrosatHunter_merge($returnline);
- }
-# print "finally left-extended line = ",$returnline,"\n" if $prinkter == 1;
- return $returnline;
-}
-
-sub multiSpecies_interruptedMicrosatHunter_right_extender{
-# print "right extender\n" if $prinkter == 1;
- my ($line, $seq, $org) = @_;
-# print "in right extender... line passed = $line\n" if $prinkter == 1;
-# print "line = $line, sequence = ",$seq, "\n" if $prinkter == 1;
- chomp $line;
- my @fields = split(/\t/,$line);
- my $rstart = $fields[$startcord];
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/\[|\]//g;
- my $rend = $rstart + length($microsat)-1;
- $microsat =~ s/-//g;
- my $motif = $fields[$motifcord];
- my $temp_lastmotif = ();
-
- if ($motif =~ /\]$/){
- $motif =~ s/\]$//g;
- $motif =~ /.*\[([a-zA-Z]+)/;
- $temp_lastmotif = $1;
- }
- else {$temp_lastmotif = $motif;}
- my $lastmotif = substr($microsat,-length($temp_lastmotif));
-# print "hacked microsat = $microsat, motif = $motif, lastmotif = $lastmotif\n" if $prinkter == 1;
- my $rightphase = substr($microsat, -length($lastmotif));
- my $phaser = $rightphase.$rightphase;
- my @phase = split(/\s*/,$rightphase);
- my @phases;
- my @copy_phases = @phases;
- my $crawler=0;
- for (0 ... (length($rightphase)-1)){
- push(@phases, substr($phaser, $crawler, length($rightphase)));
- $crawler++;
- }
-
- my $start = $rstart;
- my $end = $rend;
-
- my $rightseq = substr($seq, $end+1);
-# print "length of sequence = " ,length($seq), "the coordinate to start from = ", $end+1, "\n" if $prinkter == 1;
-# print "right phases are @phases , end = $end right sequence = ",substr($rightseq,0,10),"\n" if $prinkter == 1;
- my @extentions = ();
- my @trappeds = ();
- my @intervalposs = ();
- my @trappedposs = ();
- my @trappedphases = ();
- my @intervals = ();
- my $lastmotif_length = length($lastmotif);
- foreach my $phase (@phases){
-# print "right phase\t$phase\t",substr($rightseq,0,10),"\n" if $prinkter == 1;
-# print "search patter = (([a-zA-Z|-]{0,$lastmotif_length})($phase)+) \n" if $prinkter == 1;
- if ($rightseq =~ /^(([a-zA-Z|-]{0,$lastmotif_length}?)($phase)+)/i){
-# print "in right pattern\n" if $prinkter == 1;
- my $trapped = $1;
- my $trappedpos = $end+1;
- my $interval = $2;
- my $intervalpos = index($trapped, $interval) + 1;
-# print "trapped = $trapped, interval = $interval\n" if $prinkter == 1;
-
- my $extention = substr($trapped, length($interval));
- my $rightpeep = substr($seq, ($end+length($trapped))+1);
- my @passed_overhangs = "";
-
- #TEMPORARY... BETTER METHOD NEEDED
- $rightpeep =~ s/-//g;
-
- for my $i (1 ... length($phase)-1){
- my $overhang = substr($phase,0, $i);
-# print "current extention = $extention, overhang = $overhang, rightpeep = ",substr($rightpeep,0,10),"\n" if $prinkter == 1;
- if ($rightpeep =~ /^$overhang/i){
- push(@passed_overhangs, $overhang);
-# print "r overhang\n" if $prinkter == 1;
- }
- }
- if (scalar(@passed_overhangs) > 0){
- my $overhang = @passed_overhangs[longest_array_element(@passed_overhangs)];
- $extention = $extention.$overhang;
- $trapped = $trapped.$overhang;
-# print "trapped extended to $trapped \n" if $prinkter == 1;
- }
-
- push(@extentions,$extention);
- #print "extentions = @extentions \n" if $prinkter == 1;
-
- push(@trappeds,$trapped );
- push(@intervalposs,$intervalpos);
- push(@trappedposs, $trappedpos);
-# print "trappeds = @trappeds\n" if $prinkter == 1;
- push(@trappedphases, substr($extention,0,length($phase)));
- push(@intervals, $interval);
- }
- }
- if (scalar(@trappeds == 0)) {return $line;}
-
-################################### my $nikaal = longest_array_element(@trappeds);
- my $nikaal = shortest_array_element(@intervals);
-
-# print "longest element found = $nikaal \n" if $prinkter == 1;
-
- if ($fields[$motifcord] !~ /\[/i) {$fields[$motifcord] = "[".$fields[$motifcord]."]";}
- $fields[$motifcord] = $fields[$motifcord]."[".$trappedphases[$nikaal]."]";
- $fields[$endcord] = $fields[$endcord] + length($trappeds[$nikaal]);
-
-
- if($fields[$microsatcord] !~ /^\[/i){
- $fields[$microsatcord] = "[".$fields[$microsatcord]."]";
- }
-
- $fields[$microsatcord] = $fields[$microsatcord].$intervals[$nikaal]."[".$extentions[$nikaal]."]";
-
-
- if (scalar(@fields) > $motifcord+1){
- $fields[$motifcord+1] = $fields[$motifcord+1].",indel/deletion";
- }
- else{$fields[$motifcord+1] = "indel/deletion";}
-
- if (scalar(@fields)>$motifcord+2){
- $fields[$motifcord+2] = $fields[$motifcord+2].",".$intervals[$nikaal];
- }
- else{$fields[$motifcord+2] = $intervals[$nikaal];}
-
- my @seventeen=();
- if (scalar(@fields)>$motifcord+3){
- #print "at 608 we are doing this:length($microsat)+$intervalposs[$nikaal]\n" if $prinkter == 1;
- my $currpos = length($microsat)+$intervalposs[$nikaal];
- $fields[$motifcord+3] = $fields[$motifcord+3].",".$currpos;
- $fields[$motifcord+4] = $fields[$motifcord+4]+1;
-
- }
-
- else {$fields[$motifcord+3] = length($microsat)+$intervalposs[$nikaal]; $fields[$motifcord+4]=1}
-
-# print "finally right-extended line = ",join("\t",@fields),"\n" if $prinkter == 1;
-# return join("\t",@fields);
-
- my $returnline = join("\t",@fields);
- my $pastline = $returnline;
- if ($fields[$microsatcord] =~ /\[/){
- $returnline = multiSpecies_interruptedMicrosatHunter_merge($returnline);
- }
-# print "finally right-extended line = ",$returnline,"\n" if $prinkter == 1;
- return $returnline;
-
-}
-
-sub multiSpecies_interruptedMicrosatHunter_left_extention_permission_giver{
- my @fields = split(/\t/,$_[0]);
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/(^\[)|-//sg;
- my $motif = $fields[$motifcord];
- chomp $motif;
-# print $motif, "\n" if $motif !~ /^\[/;
- my $firstmotif = ();
- my $firststretch = ();
- my @stretches=();
-
-# print "motif = $motif, microsat = $microsat\n" if $prinkter == 1;
- if ($motif =~ /^\[/){
- $motif =~ s/^\[//sg;
- $motif =~ /([a-zA-Z]+)\].*/;
- $firstmotif = $1;
- @stretches = split(/\]/,$microsat);
- $firststretch = $stretches[0];
- #print "firststretch = $firststretch\n" if $prinkter == 1;
- }
- else {$firstmotif = $motif;$firststretch = $microsat;}
-# print "if length:firststretch - length($firststretch) < threshes length :firstmotif ($firstmotif) - $thresholds[length($firstmotif)]\n" if $prinkter == 1;
- if (length($firststretch) < $thresholds[length($firstmotif)]){
- return "no";
- }
- else {return "yes";}
-
-}
-sub multiSpecies_interruptedMicrosatHunter_right_extention_permission_giver{
- my @fields = split(/\t/,$_[0]);
- my $microsat = $fields[$microsatcord];
- $microsat =~ s/-|(\]$)//sg;
- my $motif = $fields[$motifcord];
- chomp $motif;
- my $temp_lastmotif = ();
- my $laststretch = ();
- my @stretches=();
-
-
- if ($motif =~ /\]/){
- $motif =~ s/\]$//sg;
- $motif =~ /.*\[([a-zA-Z]+)$/;
- $temp_lastmotif = $1;
- @stretches = split(/\[/,$microsat);
- $laststretch = pop(@stretches);
- #print "last stretch = $laststretch\n" if $prinkter == 1;
- }
- else {$temp_lastmotif = $motif; $laststretch = $microsat;}
-
- if (length($laststretch) < $thresholds[length($temp_lastmotif)]){
- return "no";
- }
- else { return "yes";}
-
-
-}
-sub checking_substitutions{
-
- my ($line, $seq, $startprobes, $endprobes) = @_;
- #print "sequence = $seq \n" if $prinkter == 1;
- #print "COMMAND = \n $line, \n $seq, \n $startprobes \n, $endprobes\n";
- # ;
- my @seqarray = split(/\s*/,$seq);
- my @startsubst_probes = split(/\|/,$startprobes);
- my @endsubst_probes = split(/\|/,$endprobes);
- chomp $line;
- my @fields = split(/\t/,$line);
- my $start = $fields[11] - $fields[10];
- my $end = $fields[13] - $fields[10];
- my $motif = $fields[9]; #IN FUTURE, USE THIS AS A PROBE, LIKE MOTIF = $FIELDS[9].$FIELDS[9]
- $motif =~ s/\[|\]//g;
- my $microsat = $fields[14];
- $microsat =~ s/\[|\]//g;
- #------------------------------------------------------------------------
- # GETTING START AND END PHASES
- my $startphase = substr($microsat,0, length($motif));
- my $endphase = substr($microsat,-length($motif), length($motif));
- #print "start and end phases are - $startphase and $endphase\n";
- my $startflag = 'down';
- my $endflag = 'down';
- my $substitution_distance = length($motif);
- my $prestart = $start - $substitution_distance;
- my $postend = $end + $substitution_distance;
- my @endadds = ();
- my @startadds = ();
- if (($prestart < 0) || ($postend > scalar(@seqarray))) {
- last;
- }
- #------------------------------------------------------------------------#------------------------------------------------------------------------
- # CHECKING FOR SUBSTITUTION PROBES NOW
-
- if ($fields[8] ne "mononucleotide"){
- while ($startflag eq "down"){
- my $search = join("",@seqarray[$prestart...($start-1)]);
- #print "search is from $prestart...($start-1) = $search\n";
- foreach my $probe (@startsubst_probes){
- #print "\t\tprobe = $probe\n";
- if ($search =~ /^$probe/){
- #print "\tfound addition to the left - $search \n";
- my $copyprobe = $probe;
- my $type;
- my $subspos = 0;
- my $interruption = "";
- if ($search eq $startphase) { $type = "NONE";}
- else{
- $copyprobe =~ s/\[a-zA-Z\]/^/g;
- $subspos = index($copyprobe,"^") + 1;
- $type = "substitution";
- $interruption = substr($search, $subspos,1);
- }
- my $addinfo = join("\t",$prestart, $start, $search, $type, $interruption, $subspos);
- #print "adding information: $addinfo \n";
- push(@startadds, $addinfo);
- $prestart = $prestart - $substitution_distance;
- $start = $start-$substitution_distance;
- $startflag = 'down';
-
- last;
- }
- else{
- $startflag = 'up';
- }
- }
- }
- #;
- while ($endflag eq "down"){
- my $search = join("",@seqarray[($end+1)...$postend]);
- #print "search is from ($end+1)...$postend] = $search\n";
-
- foreach my $probe (@endsubst_probes){
- #print "\t\tprobe = $probe\n";
- if ($search =~ /$probe$/){
- my $copyprobe = $probe;
- my $type;
- my $subspos = 0;
- my $interruption = "";
- if ($search eq $endphase) { $type = "NONE";}
- else{
- $copyprobe =~ s/\[a-zA-Z\]/^/g;
- $subspos = index($copyprobe,"^") + 1;
- $type = "substitution";
- $interruption = substr($search, $subspos,1);
- }
- my $addinfo = join("\t",$end, $postend, $search, $type, $interruption, $subspos);
- #print "adding information: $addinfo \n";
- push(@endadds, $addinfo);
- $postend = $postend + $substitution_distance;
- $end = $end+$substitution_distance;
- push(@endadds, $search);
- $endflag = 'down';
- last;
- }
- else{
- $endflag = 'up';
- }
- }
- }
- #print "startadds = @startadds, endadds = @endadds \n";
-
- }
-}
-sub microsat_packer{
- my $microsat = $_[0];
- my $addition = $_[1];
-
-
-
-}
-sub multiSpecies_interruptedMicrosatHunter_merge{
- $prinkter = 0;
-# print "~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~|||~~~~~~~~\n";
- my $line = $_[0];
-# print "sent for mering: $line \n" if $prinkter ==1;
- my @mields = split(/\t/,$line);
- my @fields = @mields;
- my $microsat = allCaps($fields[$microsatcord]);
- my $motifline = allCaps($fields[$motifcord]);
- my $microsatcopy = $microsat;
-# print "microsat = $microsat|\n" if $prinkter ==1;
- $microsatcopy =~ s/^\[|\]$//sg;
- chomp $microsatcopy;
- my @microields = split(/\][a-zA-Z|-]*\[/,$microsatcopy);
- my @inields = split(/\[[a-zA-Z|-]*\]/,$microsat);
- shift @inields;
-# print "inields =",join("|",@inields)," microields = ",join("|",@microields)," and count of microields = ", $#microields,"\n" if $prinkter ==1;
- $motifline =~ s/^\[|\]$//sg;
- my @motields = split(/\]\[/,$motifline);
- my @firstmotifs = ();
- my @lastmotifs = ();
- for my $i (0 ... $#microields){
- $firstmotifs[$i] = substr($microields[$i],0,length($motields[$i]));
- $lastmotifs[$i] = substr($microields[$i],-length($motields[$i]));
- }
-# print "firstmotif = @firstmotifs... lastmotif = @lastmotifs\n" if $prinkter ==1;
- my @mergelist = ();
- my @inter_poses = split(/,/,$fields[$interr_poscord]);
- my $no_of_interruptions = $fields[$no_of_interruptionscord];
- my @interruptions = split(/,/,$fields[$interrcord]);
- my @interrtypes = split(/,/,$fields[$interrtypecord]);
- my $stopper = 0;
- for my $i (0 ... $#motields-1){
-# 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;
- if ((allCaps($lastmotifs[$i]) eq allCaps($firstmotifs[$i+1])) && (!exists $inields[$i] || $inields[$i] !~ /[a-zA-Z]/)){
- $stopper = 1;
- push(@mergelist, ($i)."_".($i+1)); # if $prinkter ==1;
- }
- }
-
-# print "mergelist = @mergelist\n" if $prinkter ==1;
- return $line if scalar(@mergelist) == 0;
-# print "merging @mergelist\n" if $prinkter ==1;
-# if $prinkter ==1;
-
- foreach my $merging (@mergelist){
- my @sets = split(/_/, $merging);
-# print "sets = @sets\n" if $prinkter ==1;
- my @tempmicro = ();
- my @tempmot = ();
-# print "for loop going from 0 ... ", $sets[0]-1, "\n" if $prinkter ==1;
- for my $i (0 ... $sets[0]-1){
-# print " adding pre- i = $i adding: microields= $microields[$i]. motields = $motields[$i], inields = |$inields[$i]|\n" if $prinkter ==1;
- push(@tempmicro, "[".$microields[$i]."]");
- push(@tempmicro, $inields[$i]);
- push(@tempmot, "[".$motields[$i]."]");
-# print "adding pre-motifs number $i\n" if $prinkter ==1;
-# print "tempmot = @tempmot, tempmicro = @tempmicro \n" if $prinkter ==1;
- }
-# print "tempmot = @tempmot, tempmicro = @tempmicro \n" if $prinkter ==1;
-# print "now pushing ", "[",$microields[$sets[0]]," and ",$microields[$sets[1]],"]\n" if $prinkter ==1;
- my $pusher = "[".$microields[$sets[0]].$microields[$sets[1]]."]";
-# print "middle is, from @motields - @sets, number 0 which is is\n";
-# print ": $motields[$sets[0]]\n";
- push (@tempmicro, $pusher);
- push(@tempmot, "[".$motields[$sets[0]]."]");
- push (@tempmicro, $inields[$sets[1]]) if $sets[1] != $#microields && exists $sets[1] && exists $inields[$sets[1]];
- my $outcoming = -2;
-# print "tempmot = @tempmot, tempmicro = @tempmicro \n" if $prinkter ==1;
-# print "for loop going from ",$sets[1]+1, " ... ", $#microields, "\n" if $prinkter ==1;
- for my $i ($sets[1]+1 ... $#microields){
-# print " adding post- i = $i adding: microields= $microields[$i]. motields = $motields[$i]\n" if $prinkter ==1;
- push(@tempmicro, "[".$microields[$i]."]") if exists $microields[$i];
- push(@tempmicro, $inields[$i]) unless $i == $#microields || !exists $inields[$i];
- push(@tempmot, "[".$motields[$i]."]");
-# print "adding post-motifs number $i\n" if $prinkter ==1;
- $outcoming = $i;
- }
-# print "____________________________________________________________________________\n";
- $prinkter = 0;
- $fields[$microsatcord] = join("",@tempmicro);
- $fields[$motifcord] = join("",@tempmot);
-# print "tempmot = @tempmot, tempmicro = @tempmicro . microsat = $fields[$microsatcord] and motif = $fields[$motifcord] \n" if $prinkter ==1;
-
- splice(@interrtypes, $sets[0], 1);
- $fields[$interrtypecord] = join(",",@interrtypes);
- splice(@interruptions, $sets[0], 1);
- $fields[$interrcord] = join(",",@interruptions);
- splice(@inter_poses, $sets[0], 1);
- $fields[$interr_poscord] = join(",",@inter_poses);
- $no_of_interruptions = $no_of_interruptions - 1;
- }
-
- if ($no_of_interruptions == 0 && $line !~ /compound/){
- $fields[$microsatcord] =~ s/^\[|\]$//sg;
- $fields[$motifcord] =~ s/^\[|\]$//sg;
- $line = join("\t", @fields[0 ... $motifcord]);
- }
- else{
- $line = join("\t", @fields);
- }
-# print "post merging, the line is $line\n" if $prinkter ==1;
- # if $stopper ==1;
- return $line;
-}
-sub interval_asseser{
- my $pre_phase = $_[0]; my $post_phase = $_[1]; my $inter = $_[3];
-}
-#---------------------------------------------------------------------------------------------------
-sub allCaps{
- my $motif = $_[0];
- $motif =~ s/a/A/g;
- $motif =~ s/c/C/g;
- $motif =~ s/t/T/g;
- $motif =~ s/g/G/g;
- return $motif;
-}
-
-
-#xxxxxxxxxxxxxx multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx chromosome_unrand_breamultiSpecies_interruptedMicrosatHunterker xxxxxxxxxxxxxx multiSpecies_interruptedMicrosatHunter xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx
-sub merge_interruptedMicrosats{
-# print "IN merge_interruptedMicrosats: @_\n";
- my $input0 = $_[0]; ######looks like this: my $t8humanoutput = $pipedir.$ptag."_nogap_op_unrand2"
- my $input1 = $_[1]; ###### the *_sput_op4_ii file
- my $input2 = $_[2]; ###### the *_sput_op4_ii file
- $no_of_species = $_[3];
-
- my $output1 = $_[1]."_separate"; #$_[3]; ###### plain microsatellite file forward
- my $output2 = $_[2]."_separate"; ##$_[4]; ###### plain microsatellite file reverse
- my $output3 = $_[1]."_merged"; ##$_[5]; ###### plain microsatellite file forward
- #my $output4 = $_[2]."_merged"; ##$_[6]; ###### plain microsatellite file reverse
- #my $info = $_[4];
- #my @tags = split(/\t/,$info);
-
- open(SEQ,"<$input0") or die "Cannot open file $input0 $!";
- open(INF,"<$input1") or die "Cannot open file $input1 $!";
- open(INR,"<$input2") or die "Cannot open file $input2 $!";
- open(OUTF,">$output1") or die "Cannot open file $output1 $!";
- open(OUTR,">$output2") or die "Cannot open file $output2 $!";
- open(MER,">$output3") or die "Cannot open file $output3 $!";
- #open(MERR,">$output4") or die "Cannot open file $output4 $!";
-
-
-
- $printer = 0;
-
-# print "files opened \n";
- $infocord = 2 + (4*$no_of_species) - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
- $typecord = $infocord + 1;
- my $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
-
- $interrtypecord = $motifcord + 1;
- $interrcord = $motifcord + 2;
- $interr_poscord = $motifcord + 3;
- $no_of_interruptionscord = $motifcord + 4;
- $mergestarts = $no_of_interruptionscord+ 1;
- $mergeends = $no_of_interruptionscord+ 2;
- $mergemicros = $no_of_interruptionscord+ 3;
-
- # NOW ADDING FORWARD MICROSATELLITES TO HASH
- my %fmicros = ();
- my $microcounter=0;
- my $linecounter = 0;
- while (my $line = ){
- # print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
- $linecounter++;
- 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/ ) {
- my $key = join("\t",$1, $2, $4, $5);
- # print $key, "#-#-#-#-#-#-#-#\n";
- push (@{$fmicros{$key}},$line);
- $microcounter++;
- }
- else {
- #print $line;
- }
- }
-# print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
- close INF;
- my @deletedlines = ();
-# print "done forward hash \n";
- $linecounter = 0;
- #---------------------------------------------------------------------------------------------------
- # NOW ADDING REVERSE MICROSATELLITES TO HASH
- my %rmicros = ();
- $microcounter=0;
- while (my $line = ){
- # print "$org\t(chr[0-9a-zA-Z]+)\t([0-9]+)\t([0-9])+\t \n";
- $linecounter++;
- 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/ ) {
- my $key = join("\t",$1, $2, $4, $5);
- # print $key, "#-#-#-#-#-#-#-#\n";
- push (@{$rmicros{$key}},$line);
- $microcounter++;
- }
- else {
- #print "cant make key\n";
- }
- }
-# print "number of reverse microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
- close INR;
-# print "done reverse hash \n";
- $linecounter = 0;
-
- #------------------------------------------------------------------------------------------------
-
- while(my $sine = ){
- # if $sine =~ /16349128/;
- next if $sine !~ /[a-zA-Z0-9]/;
-# print "-" x 150, "\n" if $printer == 1;
- my @sields = split(/\t/,$sine);
- my @merged = ();
-
- my $key = ();
-
- 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/ ) {
- $key = join("\t",$1, $2, $4, $5);
- # print $key, "<-<-<-<-<-<-<-<\n";
- }
- # print "key = $key\n";
-
- my @sets1;
- my @sets2;
- chomp $sields[$sequencepos];
- my $rev_sequence = reverse($sields[$sequencepos]);
- $rev_sequence =~ s/ //g;
- $rev_sequence = " ".$rev_sequence;
- next if (!exists $fmicros{$key} && !exists $rmicros{$key});
-
- if (exists $fmicros{$key}){
- # print "line no : $linecount\n";
- my @raw_microstring = @{$fmicros{$key}};
- my %starts = (); my %ends = ();
-# print colored ['yellow'],"unsorted, unfiltered microats = \n" if $printer == 1; foreach (@raw_microstring) {print colored ['blue'],$_,"\n" if $printer == 1;}
- my @microstring=();
- for my $u (0 ... $#raw_microstring){
- my @tields = split(/\t/,$raw_microstring[$u]);
- next if exists $starts{$tields[$startcord]} && exists $ends{$tields[$endcord]};
- push(@microstring, $raw_microstring[$u]);
- $starts{$tields[$startcord]} = $tields[$startcord];
- $ends{$tields[$endcord]} = $tields[$endcord];
- }
-
- # print "founf microstring in forward\n: @microstring\n";
- chomp @microstring;
- my $clusterresult = (find_clusters(@microstring, $sields[$sequencepos]));
- @sets1 = split("\=", $clusterresult);
- my @temp = split(/_X0X_/,$sets1[0]) ; $microscanned+= scalar(@temp);
- # print "sets = ", join("", @sets1), "\n<<-sets1\n"; ;
- } #if (exists $micros{$key}){
-
- if (exists $rmicros{$key}){
- # print "line no : $linecount\n";
- my @raw_microstring = @{$rmicros{$key}};
- my %starts = (); my %ends = ();
-# print colored ['yellow'],"unsorted, unfiltered microats = \n" if $printer == 1; foreach (@raw_microstring) {print colored ['blue'],$_,"\n" if $printer == 1;}
- my @microstring=();
- for my $u (0 ... $#raw_microstring){
- my @tields = split(/\t/,$raw_microstring[$u]);
- next if exists $starts{$tields[$startcord]} && exists $ends{$tields[$endcord]};
- push(@microstring, $raw_microstring[$u]);
- $starts{$tields[$startcord]} = $tields[$startcord];
- $ends{$tields[$endcord]} = $tields[$endcord];
- }
- # print "founf microstring in reverse\n: @microstring\n"; ;
- chomp @microstring;
- # print "sending reversed sequence\n";
- my $clusterresult = (find_clusters(@microstring, $rev_sequence ) );
- @sets2 = split("\=", $clusterresult);
- my @temp = split(/_X0X_/,$sets2[0]) ; $microscanned+= scalar(@temp);
- } #if (exists $micros{$key}){
-
- my @popout1 = ();
- my @popout2 = ();
- my @forwardset = ();
- if (exists $sets2[1] ){
- if(exists $sets1[0]) {
- push (@popout1, $sets1[0],$sets2[1]);
- my @forwardset = split("=", popOuter(@popout1, $rev_sequence ));#
- print OUTF join("\n",split("_X0X_", $forwardset[0])), "\n";
- my @localmerged = split("_X0X_", $forwardset[1]);
- my $sequence = $sields[$sequencepos];
- $sequence =~ s/ //g;
-# print "\nforwardset = @forwardset\n";
- for my $j (0 ... $#localmerged){
- $localmerged[$j] = invert_justCoordinates ($localmerged[$j], length($sequence));
- }
-
- push (@merged, @localmerged);
-
- }
- else{
- my @localmerged = split("_X0X_", $sets2[1]);
- my $sequence = $sields[$sequencepos];
- $sequence =~ s/ //g;
- for my $j (0 ... $#localmerged){
-# print "\nlocalmerged = @localmerged\n";
- $localmerged[$j] = invert_justCoordinates ($localmerged[$j], length($sequence));
- }
-
- push (@merged, @localmerged);
- }
- }
- elsif (exists $sets1[0]){
- print OUTF join("\n",split("_X0X_", $sets1[0])), "\n";
- }
-
- my @reverseset= ();
- if (exists $sets1[1]){
- if (exists $sets2[0]){
- push (@popout2, $sets2[0],$sets1[1]);
- # print "popout2 = @popout2\n";
- my @reverseset = split("=", popOuter(@popout2, $sields[$sequencepos]));
- #print "reverseset = $reverseset[1] < --- reverseset1\n";
- print OUTR join("\n",split("_X0X_", $reverseset[0])), "\n";
- push(@merged, (split("_X0X_", $reverseset[1])));
- }
- else{
- push(@merged, (split("_X0X_", $sets1[1])));
- }
- }
- elsif (exists $sets2[0]){
- print OUTR join("\n",split("_X0X_", $sets2[0])), "\n";
-
- }
-
- if (scalar @merged > 0){
- my @filtered_merged = split("__",(filterDuplicates_merged(@merged)));
- print MER join("\n", @filtered_merged),"\n";
- }
- # if $sine =~ /16349128/;
-
- }
- close(SEQ);
- close(INF);
- close(INR);
- close(OUTF);
- close(OUTR);
- close(MER);
-
-}
-sub find_clusters{
- my @input = @_;
- my $sequence = pop(@input);
- $sequence =~ s/ //g;
- my @microstring0 = @input;
-# print "IN: find_clusters:\n";
- my %microstart=();
- my %microend=();
- my @nonmerged = ();
- my @mergedSet = ();
-# print "set of microsats = @microstring \n";
- my @microstring = map { $_->[0] } sort custom map { [$_, split /\t/ ] } @microstring0;
-# print "microstring = ", join("\n",@microstring0) ," \n---->\n", join("\n", @microstring),"\n ,,+." if $printer == 1;
- # if $printer == 1;
- my @tempmicrostring = @microstring;
- foreach my $line (@tempmicrostring){
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- next if $start !~ /[0-9]+/ || $end !~ /[0-9]+/;
- # print " starts >>> start: $start = $fields[11] - $fields[10] || $end = $fields[13] - $fields[10]\n";
- push (@{$microstart{$start}},$line);
- push (@{$microend{$end}},$line);
- }
- my $firstflag = 'down';
- while( my $line =shift(@microstring)){
-# print "-----------\nline = $line \n" if $printer == 1;
- chomp $line;
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- next if $start !~ /[0-9]+/ || $end !~ /[0-9]+/ || $distance !~ /[0-9]+/ ;
- my $startmicro = $line;
- my $endmicro = $line;
-# print "start: $start = $fields[11] - $fields[10] || $end = $fields[13] - $fields[10]\n";
-
- delete ($microstart{$start});
- delete ($microend{$end});
- my $flag = 'down';
- my $startflag = 'down';
- my $endflag = 'down';
- my $prestart = $start - $distance;
- my $postend = $end + $distance;
- my @compoundlines = ();
- my %compoundhash = ();
- push (@compoundlines, $line);
- push (@{$compoundhash{$line}},$line);
- my $startrank = 1;
- my $endrank = 1;
-
- while( ($startflag eq "down") || ($endflag eq "down") ){
-# print "prestart=$prestart, post end =$postend.. seqlen =", length($sequence)," firstflag = $firstflag \n" if $printer == 1;
- if ( (($prestart < 0) && $firstflag eq "up") || (($postend > length($sequence) && $firstflag eq "up")) ){
-# print "coming to the end of sequence,post end = $postend and sequence length =", length($sequence)," so exiting\n" if $printer == 1;
- last;
- }
-
- $firstflag = "up";
- if ($startflag eq "down"){
- for my $i ($prestart ... $end){
- if(exists $microend{$i}){
- chomp $microend{$i}[0];
- if(exists $compoundhash{$microend{$i}[0]}) {next;}
- chomp $microend{$i}[0];
- push(@compoundlines, $microend{$i}[0]);
- my @tields = split(/\t/,$microend{$i}[0]);
- $startmicro = $microend{$i}[0];
- chomp $startmicro;
- $flag = 'down';
- $startrank++;
-# print "deleting $microend{$i}[0] and $microstart{$tields[$startcord]}[0]\n" if $printer == 1;
- delete $microend{$i};
- delete $microstart{$tields[$startcord]};
- $end = $tields[$endcord];
- $startflag = 'down';
- $prestart = $tields[$startcord] - $distance;
- last;
- }
- else{
- $flag = 'up';
- $startflag = 'up';
- }
- }
- }
-
- if ($endflag eq "down"){
-
- for my $i ($start ... $postend){
-# print "$start ----> $i -----> $postend\n" if $printer == 1;
- if(exists $microstart{$i} ){
- chomp $microstart{$i}[0];
- if(exists $compoundhash{$microstart{$i}[0]}) {next;}
- chomp $microstart{$i}[0];
- push(@compoundlines, $microstart{$i}[0]);
- my @tields = split(/\t/,$microstart{$i}[0]);
- $endmicro = $microstart{$i}[0];
- $endrank++;
- chomp $endmicro;
- $flag = 'down';
-# print "deleting $microend{$tields[$endcord]}[0]\n" if $printer == 1;
-
- delete $microstart{$i} if exists $microstart{$i} ;
- delete $microend{$tields[$endcord]} if exists $microend{$tields[$endcord]};
-# print "done\n" if $printer == 1;
-
- shift @microstring;
- $end = $tields[$endcord];
- $postend = $tields[$endcord] + $distance;
- $endflag = 'down';
- last;
- }
- else{
- $flag = 'up';
- $endflag = 'up';
- }
-# print "out of the if\n" if $printer == 1;
- }
-# print "out of the for\n" if $printer == 1;
-
- }
-# print "for next turn, flag status: startflag = $startflag and endflag = $endflag \n";
- } #end while( $flag eq "down")
-# print "compoundlines = @compoundlines \n" if $printer == 1;
-
- if (scalar (@compoundlines) == 1){
- push(@nonmerged, $line);
-
- }
- if (scalar (@compoundlines) > 1){
-# print "FROM CLUSTERER\n" if $printer == 1;
- push(@mergedSet,merge_microsats(@compoundlines, $sequence) );
- }
- } #end foreach my $line (@microstring){
-# print join("\n",@mergedSet),"<-----mergedSet\n" if $printer == 1;
-# if scalar(@mergedSet) > 0;
-# print "EXIT: find_clusters\n";
-return (join("_X0X_",@nonmerged). "=".join("_X0X_",@mergedSet));
-}
-
-sub custom {
- $a->[$startcord+1] <=> $b->[$startcord+1];
-}
-
-sub popOuter {
-# print "\nIN: popOuter @_\n"; ;
- my @all = split ("_X0X_",$_[0]);
-# if !defined $_[0];
- my @merged = split ("_X0X_",$_[1]);
- my $sequence = $_[2];
- my $seqlen = length($sequence);
- my %microstart=();
- my %microend=();
- my @mergedSet = ();
- my @nonmerged = ();
-
- foreach my $line (@all){
- my @fields = split(/\t/,$line);
- my $start = $seqlen - $fields[$startcord]+ 1;
- my $end = $seqlen - $fields[$endcord] + 1;
- push (@{$microstart{$start}},$line);
- push (@{$microend{$end}},$line);
- }
- my $firstflag = 'down';
- my %forPopouting = ();
-
- while( my $line =shift(@merged)){
- # print "\n MErgedline: $line .. startcord = $startcord ... endcord = $endcord\n" ;
- chomp $line;
- my @fields = split(/\t/,$line);
- my $start = $fields[$startcord];
- my $end = $fields[$endcord];
- my $startmicro = $line;
- my $endmicro = $line;
-
-
- delete ($microstart{$start});
- delete ($microend{$end});
- my $flag = 'down';
- my $startflag = 'down';
- my $endflag = 'down';
- my $prestart = $start - $distance;
- my $postend = $end + $distance;
- my @compoundlines = ();
- my %compoundhash = ();
- push (@compoundlines, $line);
- my $startrank = 1;
- my $endrank = 1;
-
- # print "\nstart = $start, end = $end\n";
- # ;
- for my $i ($start ... $end){
- if(exists $microend{$i}){
- # print "\nmicrosat exists: $microend{$i}[0] microsat exists\n";
- chomp $microend{$i}[0];
- my @fields = split(/\t/,$microend{$i}[0]);
- delete $microstart{$seqlen - $fields[$startcord] + 1};
- my $invertseq = $sequence;
- $invertseq =~ s/ //g;
- push(@compoundlines, invert_microsat($microend{$i}[0] , $invertseq ));
- delete $microend{$i};
-
- }
-
- if(exists $microstart{$i} ){
- # print "\nmicrosat exists: $microstart{$i}[0] microsat exists\n";
-
- chomp $microstart{$i}[0];
- my @fields = split(/\t/,$microstart{$i}[0]);
- delete $microend{$seqlen - $fields[$endcord] + 1};
- my $invertseq = $sequence;
- $invertseq =~ s/ //g;
- push(@compoundlines, invert_microsat($microstart{$i}[0], $invertseq) );
- delete $microstart{$i};
- }
- }
-
- if (scalar (@compoundlines) == 1){
- push(@mergedSet,join("\t",@compoundlines) );
- }
- else {
-# print "FROM POPOUTER\n" if $printer == 1;
- push(@mergedSet, merge_microsats(@compoundlines, $sequence) );
- }
- }
-
- foreach my $key (sort keys %microstart) {
- push(@nonmerged,$microstart{$key}[0]);
- }
-
- return (join("_X0X_",@nonmerged). "=".join("_X0X_",@mergedSet) );
-}
-
-
-
-sub invert_justCoordinates{
- my $microsat = $_[0];
-# print "IN invert_justCoordinates ... @_\n" ; ;
- chomp $microsat;
- my $seqLength = $_[1];
- my @fields = split(/\t/,$microsat);
- my $start = $seqLength - $fields[$endcord] + 1;
- my $end = $seqLength - $fields[$startcord] + 1;
- $fields[$startcord] = $start;
- $fields[$endcord] = $end;
- $fields[$microsatcord] = reverse_micro($fields[$microsatcord]);
-# print "RETURNIG: ", join("\t",@fields), "\n" if $printer == 1;
- return join("\t",@fields);
-}
-
-sub largest_number{
- my $counter = 0;
- my($max) = shift(@_);
- foreach my $temp (@_) {
- #print "finding largest array: $maxcounter \n";
- if($temp > $max){
- $max = $temp;
- }
- }
- return($max);
-}
-sub smallest_number{
- my $counter = 0;
- my($min) = shift(@_);
- foreach my $temp (@_) {
- #print "finding largest array: $maxcounter \n";
- if($temp < $min){
- $min = $temp;
- }
- }
- return($min);
-}
-
-
-sub filterDuplicates_merged{
- my @merged = @_;
- my %revmerged = ();
- my @fmerged = ();
- foreach my $micro (@merged) {
- my @fields = split(/\t/,$micro);
- if ($fields[3] =~ /chr[A-Z0-9a-z]+r/){
- my $key = join("_K0K_",$fields[1], $fields[$startcord], $fields[$endcord]);
- # print "adding ... \n$key\n$micro\n";
- push(@{$revmerged{$key}}, $micro);
- }
- else{
- # print "pushing.. $micro\n";
- push(@fmerged, $micro);
- }
- }
-# print "\n";
- foreach my $micro (@fmerged) {
- my @fields = split(/\t/,$micro);
- my $key = join("_K0K_",$fields[1], $fields[$startcord], $fields[$endcord]);
- # print "searching for key $key\n";
- if (exists $revmerged{$key}){
- # print "deleting $revmerged{$key}[0]\n";
- delete $revmerged{$key};
- }
- }
- foreach my $key (sort keys %revmerged) {
- push(@fmerged,$revmerged{$key}[0]);
- }
-# print "returning ", join("\n", @fmerged),"\n" ;
- return join("__", @fmerged);
-}
-
-sub invert_microsat{
- my $micro = $_[0];
- chomp $micro;
- if ($micro =~ /chr[A-Z0-9a-z]+r/) { $micro =~ s/chr([0-9a-b]+)r/chr$1/g ;}
- else { $micro =~ s/chr([0-9a-b]+)/chr$1r/g ; }
- my $sequence = $_[1];
- $sequence =~ s/ //g;
- my $seqlen = length($sequence);
- my @fields = split(/\t/,$micro);
- my $start = $seqlen - $fields[$endcord] +1;
- my $end = $seqlen - $fields[$startcord] +1;
- $fields[$startcord] = $start;
- $fields[$endcord] = $end;
- $fields[$motifcord] = reverse_micro($fields[$motifcord]);
- $fields[$microsatcord] = reverse_micro($fields[$microsatcord]);
- if ($fields[$typecord] ne "compound" && exists $fields[$no_of_interruptionscord] ){
- my @intertypes = split(/,/,$fields[$interrtypecord]);
- my @inters = split(/,/,$fields[$interrcord]);
- my @interposes = split(/,/,$fields[$interr_poscord]);
- $fields[$interrtypecord] = join(",",reverse(@intertypes));
- $fields[$no_of_interruptionscord] = scalar(@interposes);
- for my $i (0 ... $fields[$no_of_interruptionscord]-1){
- if (exists $inters[$i] && $inters[$i] =~ /[a-zA-Z]/){
- $inters[$i] = reverse($inters[$i]);
- $interposes[$i] = $interposes[$i] + length($inters[$i]) - 1;
- }
- else{
- $inters[$i] = "";
- $interposes[$i] = $interposes[$i] - 1;
- }
- $interposes[$i] = ($end - $start + 1) - $interposes[$i] + 1;
- }
-
- $fields[$interrcord] = join(",",reverse(@inters));
- $fields[$interr_poscord] = join(",",reverse(@interposes));
- }
-
- my $finalmicrosat = join("\t", @fields);
- return $finalmicrosat;
-
-}
-sub reverse_micro{
- my $micro = reverse($_[0]);
- my @strand = split(/\s*/,$micro);
- for my $i (0 ... $#strand){
- if ($strand[$i] =~ /\[/i) {$strand[$i] = "]";next;}
- if ($strand[$i] =~ /\]/i) {$strand[$i] = "[";next;}
- }
- return join("",@strand);
-}
-
-#xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx merge_interruptedMicrosats xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx
-
-sub forward_reverse_sputoutput_comparer {
-# print "IN forward_reverse_sputoutput_comparer: @_\n";
- my $input0 = $_[0]; ###### the *nogap_unrand_match file
- my $input1 = $_[1]; ###### the real file, *sput* data
- my $input2 = $_[2]; ###### the reverse file, *sput* data
- my $output1 = $_[3]; ###### microsats different in real file
- my $output2 = $_[4]; ###### microsats missing in real file
- my $output3 = $_[5]; ###### microsats common among real and reverse file
- my $no_of_species = $_[6];
-
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
- $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
- $interrtypecord = $motifcord + 1;
- $interrcord = $motifcord + 2;
- $interr_poscord = $motifcord + 3;
- $no_of_interruptionscord = $motifcord + 4;
- $mergestarts = $no_of_interruptionscord+ 1;
- $mergeends = $no_of_interruptionscord+ 2;
- $mergemicros = $no_of_interruptionscord+ 3;
-
-
- open(SEQ,"<$input0") or die "Cannot open file $input0 $!";
- open(INF,"<$input1") or die "Cannot open file $input1 $!";
- open(INR,"<$input2") or die "Cannot open file $input2 $!";
-
- open(DIFF,">$output1") or die "Cannot open file $output1 $!";
- #open(MISS,">$output2") or die "Cannot open file $output2 $!";
- open(SAME,">$output3") or die "Cannot open file $output3 $!";
-
-
-# print "opened files \n";
- my $linecounter = 0;
- my $fcounter = 0;
- my $rcounter = 0;
-
- $printer = 0;
- #---------------------------------------------------------------------------------------------------
- # NOW ADDING FORWARD MICROSATELLITES TO HASH
- my %fmicros = ();
- my $microcounter=0;
- while (my $line = ){
- $linecounter++;
- 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/ ) {
- my $key = join("\t",$1, $3, $4, $5, $7, $8, $9, $11, $12);
- # print $key, "#-#-#-#-#-#-#-#\n";
- push (@{$fmicros{$key}},$line);
- $microcounter++;
- }
- else {
- #print $line;
- }
- }
-# print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
- close INF;
- my @deletedlines = ();
-# print "done forward hash \n";
- $linecounter = 0;
- #---------------------------------------------------------------------------------------------------
- # NOW ADDING REVERSE MICROSATELLITES TO HASH
- my %rmicros = ();
- $microcounter=0;
- while (my $line = ){
- $linecounter++;
- 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/ ) {
- my $key = join("\t",$1, $3, $4, $5, $7, $8, $9, $11, $12);
- # print $key, "#-#-#-#-#-#-#-#\n";
- push (@{$rmicros{$key}},$line);
- $microcounter++;
- }
- else {}
- }
-# print "number of microsatellites added to hash = $microcounter\nnumber of lines scanned = $linecounter\n";
- close INR;
-# print "done reverse hash \n";
- $linecounter = 0;
- #---------------------------------------------------------------------------------------------------
- #---------------------------------------------------------------------------------------------------
- # NOW READING THE SEQUENCE FILE
- while(my $sine = ){
- my %microstart=();
- my %microend=();
- my @sields = split(/\t/,$sine);
- my $key = ();
- 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/ ) {
- $key = join("\t",$1, $3, $4, $5, $7, $8, $9, $11, $12);
- }
- else {
- next;
- }
- $printer = 0;
- my $sequence = $sields[$sequencepos];
- chomp $sequence;
- $sequence =~ s/ //g;
- my @localfs = ();
- my @localrs = ();
-
- if (exists $fmicros{$key}){
- @localfs = @{$fmicros{$key}};
- delete $fmicros{$key};
- }
-
- my %forwardstarts = ();
- my %forwardends = ();
-
- foreach my $f (@localfs){
- my @fields = split(/\t/,$f);
- push (@{$forwardstarts{$fields[$startcord]}},$f);
- push (@{$forwardends{$fields[$endcord]}},$fields[$startcord]);
- }
-
- if (exists $rmicros{$key}){
- @localrs = @{$rmicros{$key}};
- delete $rmicros{$key};
- }
- else{
- }
-
- foreach my $r (@localrs){
- chomp $r;
- my @rields = split(/\t/,$r);
-# print "rields = @rields\n" if $printer == 1;
- my $reciprocalstart = length($sequence) - $rields[$endcord] + 1;
- my $reciprocalend = length($sequence) - $rields[$startcord] + 1;
-# print "reciprocal start = $reciprocalstart = ",length($sequence)," - $rields[$endcord] + 1\n" if $printer == 1;
- my $microsat = reverse_micro(all_caps($rields[$microsatcord]));
- my @localcollection=();
- for my $i ($reciprocalstart+1 ... $reciprocalend-1){
- if (exists $forwardstarts{$i}){
- push(@localcollection, $forwardstarts{$i}[0] );
- delete $forwardstarts{$i};
- }
- if (exists $forwardends{$i}){
- next if !exists $forwardstarts{$forwardends{$i}[0]};
- push(@localcollection, $forwardstarts{$forwardends{$i}[0]}[0] );
- }
- }
- if (exists $forwardstarts{$reciprocalstart} && exists $forwardends{$reciprocalend}) {push(@localcollection,$forwardstarts{$reciprocalstart}[0]);}
-
- if (scalar(@localcollection) == 0){
- print SAME invert_microsat($r,($sequence) ), "\n";
- }
-
- elsif (scalar(@localcollection) == 1){
-# print "f microsat = $localcollection[0]\n" if $printer == 1;
- my @lields = split(/\t/,$localcollection[0]);
- $lields[$microsatcord]=all_caps($lields[$microsatcord]);
-# print "comparing: $microsat and $lields[$microsatcord]\n" if $printer == 1;
-# print "coordinates are: $lields[$startcord]-$lields[$endcord] and $reciprocalstart-$reciprocalend\n" if $printer == 1;
- if ($microsat eq $lields[$microsatcord]){
- chomp $localcollection[0];
- print SAME $localcollection[0], "\n";
- }
- if ($microsat ne $lields[$microsatcord]){
- chomp $localcollection[0];
- my $newmicro = microsatChooser(join("\t",@lields), join("\t",@rields), $sequence);
-# print "newmicro = $newmicro\n" if $printer == 1;
- if ($newmicro =~ /[a-zA-Z]/){
- print SAME $newmicro,"\n";
- }
- else{
- print DIFF join("\t",$localcollection[0],"-->",$rields[$typecord],$reciprocalstart,$reciprocalend, $rields[$microsatcord], reverse_micro($rields[$motifcord]), @rields[$motifcord+1 ... $#rields] ),"\n";
-# print join("\t",$localcollection[0],"-->",$rields[$typecord],$reciprocalstart,$reciprocalend, $rields[$microsatcord], reverse_micro($rields[$motifcord]), @rields[$motifcord+1 ... $#rields] ),"\n" if $printer == 1;
-# print "@rields\n@lields\n" if $printer == 1;
- }
- }
- }
- else{
-# print "multiple found for $r --> ", join("\t",@localcollection),"\n" if $printer == 1;
- }
- }
- }
-
- close(SEQ);
- close(INF);
- close(INR);
- close(DIFF);
- close(SAME);
-
-}
-sub all_caps{
- my @strand = split(/\s*/,$_[0]);
- for my $i (0 ... $#strand){
- if ($strand[$i] =~ /c/) {$strand[$i] = "C";next;}
- if ($strand[$i] =~ /a/) {$strand[$i] = "A";next;}
- if ($strand[$i] =~ /t/) { $strand[$i] = "T";next;}
- if ($strand[$i] =~ /g/) {$strand[$i] = "G";next;}
- }
- return join("",@strand);
-}
-sub microsatChooser{
- my $forward = $_[0];
- my $reverse = $_[1];
- my $sequence = $_[2];
- my $seqLength = length($sequence);
- $sequence =~ s/ //g;
- my @fields = split(/\t/,$forward);
- my @rields = split(/\t/,$reverse);
- my $r_start = $seqLength - $rields[$endcord] + 1;
- my $r_end = $seqLength - $rields[$startcord] + 1;
-
-
- my $f_microsat = $fields[$microsatcord];
- my $r_microsat = $rields[$microsatcord];
-
- if ($fields[$typecord] =~ /\./ && $rields[$typecord] =~ /\./) {
- return $forward if length($f_microsat) >= length($r_microsat);
- return invert_microsat($reverse, $sequence) if length($f_microsat) < length($r_microsat);
- }
- return $forward if all_caps($fields[$motifcord]) eq all_caps($rields[$motifcord]) && $fields[$startcord] == $rields[$startcord] && $fields[$endcord] == $rields[$endcord];
-
- my $f_microsat_copy = $f_microsat;
- my $r_microsat_copy = $r_microsat;
- $f_microsat_copy =~ s/^\[|\]$//g;
- $r_microsat_copy =~ s/^\[|\]$//g;
-
- my @f_microields = split(/\][a-zA-Z]*\[/,$f_microsat_copy);
- my @r_microields = split(/\][a-zA-Z]*\[/,$r_microsat_copy);
- my @f_intields = split(/\][a-zA-Z]*\[/,$f_microsat_copy);
- my @r_intields = split(/\][a-zA-Z]*\[/,$r_microsat_copy);
-
- my $f_motif = $fields[$motifcord];
- my $r_motif = $rields[$motifcord];
- my $f_motif_copy = $f_motif;
- my $r_motif_copy = $r_motif;
- $f_motif_copy =~ s/^\[|\]$//g;
- $r_motif_copy =~ s/^\[|\]$//g;
-
- my @f_motields = split(/\]\[/,$f_motif_copy);
- my @r_motields = split(/\]\[/,$r_motif_copy);
-
- my $f_purestretch = join("",@f_microields);
- my $r_purestretch = join("",@r_microields);
-
- if ($fields[$typecord]=~/nucleotide/ && $rields[$typecord]=~/nucleotide/){
-# print "now.. studying $forward\n$reverse\n" if $printer == 1;
- if ($fields[$typecord] eq $rields[$typecord]){
-# print "comparing motifs::", all_caps($fields[$motifcord]) ," and ", all_caps(reverse_micro($rields[$motifcord])), "\n" if $printer == 1;
-
- if(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 1){
- my $subset_answer = isSubset($forward, $reverse, $seqLength);
-# print "subset answer = $subset_answer\n" if $printer == 1;
- return $forward if $subset_answer == 1;
- return invert_microsat($reverse, $sequence) if $subset_answer == 2;
- return $forward if $subset_answer == 0 && length($f_purestretch) >= length($r_purestretch);
- return invert_microsat($reverse, $sequence) if $subset_answer == 0 && length($f_purestretch) < length($r_purestretch);
- return $forward if $subset_answer == 3 && slided_microsat($forward, $reverse, $seqLength) == 0 && length($f_purestretch) >= length($r_purestretch);
- return invert_microsat($reverse, $sequence) if $subset_answer == 3 && slided_microsat($forward, $reverse, $seqLength) == 0 && length($f_purestretch) < length($r_purestretch);
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence) if $subset_answer == 3 ;
- }
- elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 0){
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
- elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 2){
- return $forward;
- }
- elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 3){
- return invert_microsat($reverse, $sequence);
- }
- }
- else{
- my $fmotlen = ();
- my $rmotlen = ();
- $fmotlen =1 if $fields[$typecord] eq "mononucleotide";
- $fmotlen =2 if $fields[$typecord] eq "dinucleotide";
- $fmotlen =3 if $fields[$typecord] eq "trinucleotide";
- $fmotlen =4 if $fields[$typecord] eq "tetranucleotide";
- $rmotlen =1 if $rields[$typecord] eq "mononucleotide";
- $rmotlen =2 if $rields[$typecord] eq "dinucleotide";
- $rmotlen =3 if $rields[$typecord] eq "trinucleotide";
- $rmotlen =4 if $rields[$typecord] eq "tetranucleotide";
-
- if ($fmotlen < $rmotlen){
- if (abs($fields[$startcord] - $r_start) <= $fmotlen || abs($fields[$endcord] - $r_end) <= $fmotlen ){
- return $forward;
- }
- else{
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
- }
- if ($fmotlen > $rmotlen){
- if (abs($fields[$startcord] - $r_start) <= $rmotlen || abs($fields[$endcord] - $r_end) <= $rmotlen){
- return invert_microsat($reverse, $sequence);
- }
- else{
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
- }
- }
- }
- if ($fields[$typecord] eq "compound" && $rields[$typecord] eq "compound"){
-# print "comparing compound motifs::", all_caps($fields[$motifcord]) ," and ", all_caps(reverse_micro($rields[$motifcord])), "\n" if $printer == 1;
- if(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 1){
- my $subset_answer = isSubset($forward, $reverse, $seqLength);
-# print "subset answer = $subset_answer\n" if $printer == 1;
- return $forward if $subset_answer == 1;
- return invert_microsat($reverse, $sequence) if $subset_answer == 2;
-# print length($f_purestretch) ,">", length($r_purestretch)," \n" if $printer == 1;
- return $forward if $subset_answer == 0 && length($f_purestretch) >= length($r_purestretch);
- return invert_microsat($reverse, $sequence) if $subset_answer == 0 && length($f_purestretch) < length($r_purestretch);
- if ($subset_answer == 3){
- if ($fields[$startcord] < $r_start || $fields[$endcord] > $r_end){
- if (abs($fields[$startcord] - $r_start) < length($f_motields[0]) || abs($fields[$endcord] - $r_end) < length($f_motields[$#f_motields]) ){
- return $forward;
- }
- else{
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
- }
- if ($fields[$startcord] > $r_start || $fields[$endcord] < $r_end){
- if (abs($fields[$startcord] - $r_start) < length($r_motields[0]) || abs($fields[$endcord] - $r_end) < length($r_motields[$#r_motields]) ){
- return invert_microsat($reverse, $sequence);
- }
- else{
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
- }
- }
- }
- elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 0){
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
- elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 2){
- return $forward;
- }
- elsif(motifBYmotif_match(all_caps($fields[$motifcord]), all_caps(reverse_micro($rields[$motifcord]))) == 3){
- return invert_microsat($reverse, $sequence);
- }
-
- }
-
- if ($fields[$typecord] eq "compound" && $rields[$typecord] =~ /nucleotide/){
-# print "one compound, one nucleotide\n" if $printer == 1;
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
- if ($fields[$typecord] =~ /nucleotide/ && $rields[$typecord]eq "compound"){
-# print "one compound, one nucleotide\n" if $printer == 1;
- return merge_microsats($forward, invert_microsat($reverse, $sequence), $sequence);
- }
-}
-
-sub isSubset{
- my $forward = $_[0]; my @fields = split(/\t/,$forward);
- my $reverse = $_[1]; my @rields = split(/\t/,$reverse);
- my $seqLength = $_[2];
- my $r_start = $seqLength - $rields[$endcord] + 1;
- my $r_end = $seqLength - $rields[$startcord] + 1;
-# print "we have $fields[$startcord] -> $fields[$endcord] && $r_start -> $r_end\n" if $printer == 1;
- return "0" if $fields[$startcord] == $r_start && $fields[$endcord] == $r_end;
- return "1" if $fields[$startcord] <= $r_start && $fields[$endcord] >= $r_end;
- return "2" if $r_start <= $fields[$startcord] && $r_end >= $fields[$endcord];
- return "3";
-}
-
-sub motifBYmotif_match{
- my $forward = $_[0];
- my $reverse = $_[1];
- $forward =~ s/^\[|\]$//g;
- $reverse =~ s/^\[|\]$//g;
- my @f_motields=split(/\]\[/, $forward);
- my @r_motields=split(/\]\[/, $reverse);
- my $finalresult = 0;
-
- if (scalar(@f_motields) != scalar(@r_motields)){
- my $subresult = 0;
- my @mega = (); my @sub = ();
- @mega = @f_motields if scalar(@f_motields) > scalar(@r_motields);
- @sub = @f_motields if scalar(@f_motields) > scalar(@r_motields);
- @mega = @r_motields if scalar(@f_motields) < scalar(@r_motields);
- @sub = @r_motields if scalar(@f_motields) < scalar(@r_motields);
-
- for my $i (0 ... $#sub){
- my $probe = $sub[$i].$sub[$i];
-# print "probing $probe and $mega[$i]\n" if $printer == 1;
- if ($probe =~ /$mega[$i]/) {$subresult = 1; }
- else {$subresult = 0; last; }
- }
-
- return 0 if $subresult == 0;
- return 2 if $subresult == 1 && scalar(@f_motields) > scalar(@r_motields); # r is subset of f
- return 3 if $subresult == 1 && scalar(@f_motields) < scalar(@r_motields); # ^reverse
-
- }
- else{
- for my $i (0 ... $#f_motields){
- my $probe = $f_motields[$i].$f_motields[$i];
- if ($probe =~ /$r_motields[$i]/) {$finalresult = 1 ;}
- else {$finalresult = 0 ;last;}
- }
- }
-# print "finalresult = $finalresult\n" if $printer == 1;
- return $finalresult;
-}
-
-sub merge_microsats{
- my @input = @_;
- my $sequence = pop(@input);
- $sequence =~ s/ //g;
- my @seq_string = @input;
-# print "IN: merge_microsats\n";
-# print "recieved for merging: ", join("\n", @seq_string), "\nsequence = $sequence\n";
- my $start;
- my $end;
- my @micros = map { $_->[0] } sort custom map { [$_, split /\t/ ] } @seq_string;
-# print "\nrearranged into @micros \n";
- my (@motifs, @microsats, @interruptiontypes, @interruptions, @interrposes, @no_of_interruptions, @types, @starts, @ends, @mergestart, @mergeend, @mergemicro) = ();
- my @fields = ();
- for my $i (0 ... $#micros){
- chomp $micros[$i];
- @fields = split(/\t/,$micros[$i]);
- push(@types, $fields[$typecord]);
- push(@motifs, $fields[$motifcord]);
-
- if (exists $fields[$interrtypecord]){ push(@interruptiontypes, $fields[$interrtypecord]);}
- else { push(@interruptiontypes, "NA"); }
- if (exists $fields[$interrcord]) {push(@interruptions, $fields[$interrcord]);}
- else { push(@interruptions, "NA"); }
- if (exists $fields[$interr_poscord]) { push(@interrposes, $fields[$interr_poscord]);}
- else { push(@interrposes, "NA"); }
- if (exists $fields[$no_of_interruptionscord]) {push(@no_of_interruptions, $fields[$no_of_interruptionscord]);}
- else { push(@no_of_interruptions, "NA"); }
- if(exists $fields[$mergestarts]) { @mergestart = (@mergestart, split(/\./,$fields[$mergestarts]));}
- else { push(@mergestart, $fields[$startcord]); }
- if(exists $fields[$mergeends]) { @mergeend = (@mergeend, split(/\./,$fields[$mergeends]));}
- else { push(@mergeend, $fields[$endcord]); }
- if(exists $fields[$mergemicros]) { push(@mergemicro, $fields[$mergemicros]);}
- else { push(@mergemicro, $fields[$microsatcord]); }
-
-
- }
- $start = smallest_number(@mergestart);
- $end = largest_number(@mergeend);
- my $microsat_entry = "[".substr( $sequence, $start-1, ($end - $start + 1) )."]";
- 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));
- return $microsat;
-}
-
-sub slided_microsat{
- my $forward = $_[0]; my @fields = split(/\t/,$forward);
- my $reverse = $_[1]; my @rields = split(/\t/,$reverse);
- my $seqLength = $_[2];
- my $r_start = $seqLength - $rields[$endcord] + 1;
- my $r_end = $seqLength - $rields[$startcord] + 1;
- my $motlen =();
- $motlen =1 if $fields[$typecord] eq "mononucleotide";
- $motlen =2 if $fields[$typecord] eq "dinucleotide";
- $motlen =3 if $fields[$typecord] eq "trinucleotide";
- $motlen =4 if $fields[$typecord] eq "tetranucleotide";
-
- if (abs($fields[$startcord] - $r_start) < $motlen || abs($fields[$endcord] - $r_end) < $motlen ) {
- return 0;
- }
- else{
- return 1;
- }
-
-}
-
-#xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx forward_reverse_sputoutput_comparer xxxxxxxxxxxxxx
-
-
-
-#xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx
-sub new_multispecies_t10{
- my $input1 = $_[0]; #gap_op_unrand_match
- my $input2 = $_[1]; #sput
- my $output = $_[2]; #output
- my $bin = $output."_bin";
- my $orgs = join("|",split(/\./,$_[3]));
- my @organisms = split(/\./,$_[3]);
- my $no_of_species = scalar(@organisms); #3
- my $t10info = $output."_info";
- $prinkter = 0;
-
- open (MATCH, "<$input1");
- open (SPUT, "<$input2");
- open (OUT, ">$output");
- open (INFO, ">$t10info");
-
-
- sub microsat_bracketer;
- sub custom;
- my %seen = ();
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $startcord = 2 + (4*$no_of_species) + 2 - 1;
- $strandcord = 2 + (4*$no_of_species) + 3 - 1;
- $endcord = 2 + (4*$no_of_species) + 4 - 1;
- $microsatcord = 2 + (4*$no_of_species) + 5 - 1;
- $motifcord = 2 + (4*$no_of_species) + 6 - 1;
- $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
- #---------------------------------------------------------------------------------------------------------------#
- # MAKING A HASH FROM SPUT, WITH HASH KEYS GENERATED BELOW AND SEQUENCES STORED AS VALUES #
- #---------------------------------------------------------------------------------------------------------------#
- my $linecounter = 0;
- my $microcounter = 0;
- while (my $line = ){
- chomp $line;
- # print "$org\t(chr[0-9]+)\t([0-9]+)\t([0-9])+\t \n";
- next if $line !~ /[0-9a-z]+/;
- $linecounter++;
- # my $key = join("\t",$1 , $2, $4, $5, $6, $8, $9, $10, $12, $13);
- # print $key, "#-#-#-#-#-#-#-#\n";
- if ($line =~ /([0-9]+)\s+([0-9a-zA-Z]+)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)\s/ ) {
- my $key = join("\t",$1, $2, $3, $4, $5);
-# print "key = $key\n" if $prinkter == 1;
- push (@{$seen{$key}},$line);
- $microcounter++;
- }
- else {
- #print "could not make ker in SPUT : \n$line \n";
- }
- }
-# print "done hash.. linecounter = $linecounter, microcounter = $microcounter and total keys entered = ",scalar(keys %seen),"\n";
-# print INFO "done hash.. linecounter = $linecounter, microcounter = $microcounter and total keys entered = ",scalar(keys %seen),"\n";
- close SPUT;
-
- #----------------------------------------------------------------------------------------------------------------
-
- #-------------------------------------------------------------------------------------------------------#
- # THE ENTIRE CODE BELOW IS DEVOTED TO GENERATING HASH KEYS FROM MATCH FOLLOWED BY #
- # USING THESE HASH KEYS TO CORRESPOND EACH SEQUENCE IN FIRST FILE TO ITS MICROSAT REPEATS IN #
- # SECOND FILE FOLLOWED BY #
- # FINDING THE EXACT LOCATION OF EACH MICROSAT REPEAT WITHIN EACH SEQUENCE USING THE 'index' FUNCTION #
- #-------------------------------------------------------------------------------------------------------#
- my $ref = 0;
- my $ref2 = 0;
- my $ref3 = 0;
- my $ref4 = 0;
- my $deletes= 0;
- my $duplicates = 0;
- my $neighbors = 0;
- my $tooshort = 0;
- my $prevmicrol=();
- my $startnotfound = 0;
- my $matchkeysformed = 0;
- my $keysused = 0;
-
- while (my $line = ) {
-# print colored ['magenta'], $line if $prinkter == 1;
- next if $line !~ /[a-zA-Z0-9]/;
- chomp $line;
- my @fields2 = split(/\t/,$line);
- my $key2 = ();
- # $key2 = join("\t",$1 , $2, $4, $5, $6, $8, $9, $10, $12, $13);
- if ($line =~ /([0-9]+)\s+([0-9a-zA-Z]+)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)\s/ ) {
- $matchkeysformed++;
- $key2 = join("\t",$1, $2, $3, $4, $5);
-# print "key = $key2 \n" if $prinkter == 1;
- }
- else{
-# print "could not make ker in SEQ : $line\n";
- next;
- }
- my $sequence = $fields2[$sequencepos];
- $sequence =~ s/\*/-/g;
- my $count = 0;
- if (exists $seen{$key2}){
- $keysused++;
- my @unsorted_raw = @{$seen{$key2}};
- delete $seen{$key2};
- my @sequencearr = split(/\s*/, $sequence);
-
-# print "sequencearr = @sequencearr\n" if $prinkter == 1;
-
- my $counter;
-
- my %start_database = ();
- my %end_database = ();
- foreach my $uns (@unsorted_raw){
- my @uields = split(/\t/,$uns);
- $start_database{$uields[$startcord]} = $uns;
- $end_database{$uields[$endcord]} = $uns;
- }
-
- my @unsorted = ();
- my %starts = (); my %ends = ();
-# print colored ['yellow'],"unsorted, unfiltered microats = \n" if $prinkter == 1; foreach (@unsorted_raw) {print colored ['blue'],$_,"\n" if $prinkter == 1;}
- for my $u (0 ... $#unsorted_raw){
- my @tields = split(/\t/,$unsorted_raw[$u]);
- next if exists $starts{$tields[$startcord]} && exists $ends{$tields[$endcord]};
- push(@unsorted, $unsorted_raw[$u]);
- $starts{$tields[$startcord]} = $unsorted_raw[$u];
-# print "in starts : $tields[$startcord] -> $unsorted_raw[$u]\n" if $prinkter == 1;
- }
-
- my $basecounter= 0;
- my $gapcounter = 0;
- my $poscounter = 0;
-
- for my $s (@sequencearr){
-
- $poscounter++;
- if ($s eq "-"){
- $gapcounter++; next;
- }
- else{
- $basecounter++;
- }
-
-
- #print "s = $s, poscounter = $poscounter, basecounter = $basecounter, gapcpunter = $gapcounter\n" if $prinkter == 1;
- #print "s = $s, basecounter = $basecounter, gapcpunter = $gapcounter\n" if $prinkter == 1;
- #print "s = $s, gapcpunter = $gapcounter\n" if $prinkter == 1;
-
- if (exists $starts{$basecounter}){
- my $locus = $starts{$basecounter};
-# print "locus identified = $locus\n" if $prinkter == 1;
- my @fields3 = split(/\t/,$locus);
- my $start = $fields3[$startcord];
- my $end = $fields3[$endcord];
- my $motif = $fields3[$motifcord];
- my $microsat = $fields3[$microsatcord];
- my @leftbracketpos = ();
- my @rightbracketpos = ();
- my $bracket_picker = 'no';
- my $leftbrackets=();
- my $rightbrackets = ();
- my $micro_cpy = $microsat;
-# print "microsat = $microsat\n" if $prinkter == 1;
- while($microsat =~ m/\[/g) {push(@leftbracketpos, (pos($microsat))); $leftbrackets = join("__",@leftbracketpos);$bracket_picker='yes';}
- while($microsat =~ m/\]/g) {push(@rightbracketpos, (pos($microsat))); $rightbrackets = join("__",@rightbracketpos);}
- $microsat =~ s/[\[\]\-\*]//g;
-# print "microsat = $microsat\n" if $prinkter == 1;
- my $human_search = join '-*', split //, $microsat;
- my $temp = substr($sequence, $poscounter-1);
-# print "with poscounter = $poscounter\n" if $prinkter == 1;
- my $search_result = ();
- my $posnow = ();
-
-# print "for $line, temp $temp or human_search $human_search not defined\n" if !defined $temp || !defined $human_search;
-# if !defined $temp || !defined $human_search;
-
- while ($temp =~ /($human_search)/gi){
- $search_result = $1;
- # $posnow = pos($temp);
- last;
- }
-
- my @gapspos = ();
- next if !defined $search_result;
-
- while($search_result =~ m/-/g) {push(@gapspos, (pos($search_result))); }
- my $gaps = join("__",@gapspos);
-
- my $final_microsat = $search_result;
- if ($bracket_picker eq "yes"){
- $final_microsat = microsat_bracketer($search_result, $gaps,$leftbrackets,$rightbrackets);
- }
-
- my $outsentence = join("\t",join ("\t",@fields3[0 ... $infocord]),$fields3[$typecord],$fields3[$motifcord],$gapcounter,$poscounter,$fields3[$strandcord],$poscounter + length($search_result) -1 ,$final_microsat);
-
- if ($bracket_picker eq "yes") {
- $outsentence = $outsentence."\t".join("\t",@fields3[($motifcord+1) ... $#fields3]);
- }
- print OUT $outsentence,"\n";
- }
- }
- }
- }
- my $unusedkeys = scalar(keys %seen);
-# print INFO "in hash = $ref, looped = $ref4, captured = $ref3\n REMOVED: \nmicrosats with too long gaps = $deletes\n";
-# print INFO "exact duplicated removed = $duplicates \nmicrosats removed due to multiple microsats defined in +-10 bp neighboring region: $neighbors \n";
-# print INFO "microsatellites too short = $tooshort\n";
-# print INFO "keysused = $keysused...starts not found = $startnotfound ... matchkeysformed=$matchkeysformed ... unusedkeys=$unusedkeys\n";
-
- #print "in hash = $ref, looped = $ref4, captured = $ref3\n REMOVED: \nmicrosats with too long gaps = $deletes\n";
- #print "exact duplicated removed = $duplicates \nmicrosats removed due to multiple microsats defined in +-10 bp neighboring region: $neighbors \n";
- #print "microsatellites too short = $tooshort\n";
- #print "keysused = $keysused...starts not found = $startnotfound ... matchkeysformed=$matchkeysformed ... unusedkeys=$unusedkeys\n";
- #print "unused keys = \n",join("\n", (keys %seen)),"\n";
- close (MATCH);
- close (SPUT);
- close (OUT);
- close (INFO);
-}
-
-sub microsat_bracketer{
-# print "in bracketer: @_\n";
- my ($microsat, $gapspos, $leftbracketpos, $rightbracketpos) = @_;
- my @gaps = split(/__/,$gapspos);
- my @lefts = split(/__/,$leftbracketpos);
- my @rights = split(/__/,$rightbracketpos);
- my @new=();
- my $pure = $microsat;
- $pure =~ s/-//g;
- my $off = 0;
- my $finallength = length($microsat) + scalar(@lefts)+scalar(@rights);
- push(@gaps, 0);
- push(@lefts,0);
- push(@rights,0);
-
- for my $i (1 ... $finallength){
-# print "1 current i = >$i<>, right = >$rights[0]< gap = $gaps[0] left = >$lefts[0]< and $rights[0] == $i\n";
- if($rights[0] == $i){
- # print "pushed a ]\n";
- push(@new, "]");
- shift(@rights);
- push(@rights,0);
- for my $j (0 ... scalar(@gaps)-1) {$gaps[$j]++;}
- next;
- }
- if($gaps[0] == $i){
- # print "pushed a -\n";
- push(@new, "-");
- shift(@gaps);
- push(@gaps, 0);
- for my $j (0 ... scalar(@rights)-1) {$rights[$j]++;}
- for my $j (0 ... scalar(@lefts)-1) {$lefts[$j]++;}
-
- next;
- }
- if($lefts[0] == $i){
-# print "pushed a [\n";
- push(@new, "[");
- shift(@lefts);
- push(@lefts,0);
- for my $j (0 ... scalar(@gaps)-1) {$gaps[$j]++;}
- next;
- }
- else{
- my $pushed = substr($pure,$off,1);
- $off++;
- push(@new,$pushed );
-# print "pushed an alphabet, now new = @new, pushed = $pushed\n";
- next;
- }
- }
- my $returnmicrosat = join("",@new);
-# print "final microsat = $returnmicrosat \n";
- return($returnmicrosat);
-}
-
-#xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx new_multispecies_t10 xxxxxxxxxxxxxx
-
-
-#xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx
-sub multiSpecies_orthFinder4{
- #print "IN multiSpecies_orthFinder4: @_\n";
- my @handles = ();
- #1 SEPT 30TH 2008
- #2 THIS CODE (multiSpecies_orthFinder4.pl) IS BEING MADE SO THAT IN THE REMOVAL OF MICROSATELLITES THAT ARE CLOSER TO EACH OTHER
- #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
- #4 POTENTIALLY REMOVE EVEN MORE MICROSATELLITES THAN BEFORE, BUT THIS WILL RESCUE THOSE MICROSATELLITES THAT WERE LOST
- #5 DUE TO OUR PREVIOUS REQUIREMENT FROM VERSION 3, THAT MICROSATELLITES THAT ARE CLOSER TO THE BOUNDARY THAN 25 BP NEED TO BE REMOVED
- #6 SUCH A REQUIREMENT WAS A CRUDE WAY TO IMPOSE THE ABOVE 50 BP RADIUS OF EXCLUSION ACCROSS THE ALIGNMENT BLOCKS WITHOUT ACTUALLY
- #7 CHECKING COORDINATES OF THE EXCLUDED MICROSATELLITES.
- #8 IN ORDER TO TAKE CARE OF THE CASES WHERE MICROSATELLITES ARE PRELIOUSLY CLOSE TO ENDS OF THE ALIGNMENT BLOCKS, WE IMPOSE HERE
- #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
- #10 ON EITHER SIDE OF IT.. GAPLESS. THIS INFORMATION IS STORED IN THE VARIABLE: $FLANK_SUPPORT. THIS PART, INSTEAD OF BEING INCLUDED IN
- #11 THIS CODE, WILL BE INCLUDED IN A NEW CODE THAT WE WILL BE WRITING AS PART OF THE PIPELINE: multiSpecies_microsatSetSelector.pl
-
- #1 trial run:
- #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
-
- $prinkter=0;
-
- #############
- my $CLUSTER_DIST = $_[4];
- #############
-
-
- my $aligns = $_[0];
- my @micros = split(/:/, $_[1]);
- my $orth = $_[2];
- #my $not_orth = "notorth";
- @tags = split(/:/, $_[3]);
-
- $no_of_species=scalar(@tags);
- my $junkfile = $orth."_junk";
- #open(JUNK,">$junkfile");
-
- #my $info = $output1."_info";
- #print "inputs are : \n"; foreach(@micros){print $_,"\n";}
- #print "info = @_\n";
-
-
- open (BO, "<$aligns") or die "Cannot open alignment file: $aligns: $!";
- open (ORTH, ">$orth");
- my $output=$orth."_out";
- open (OUTP, ">$output");
-
-
- #open (NORTH, ">$not_orth");
- #open (INF, ">$info");
- my $i = 0;
- foreach my $path (@micros){
- $handles[$i] = IO::Handle->new();
- open ($handles[$i], "<$path") or die "Can't open microsat file $path : $!";
- $i++;
- }
-
- #print "Opened files\n";
-
-
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $motifcord = $typecord + 1;
- $gapcord = $motifcord+1;
- $startcord = $gapcord + 1;
- $strandcord = $startcord + 1;
- $endcord = $strandcord + 1;
- $microsatcord = $endcord + 1;
- $sequencepos = 2 + (4*$no_of_species) + 1 -1 ;
- #$sequencepos = 17;
- # GENERATING HASHES CONTAINING CHIMP AND HUMAN DATA FROM ABOVE FILES
- #----------------------------------------------------------------------------------------------------------------
- my @hasharr = ();
- foreach my $path (@micros){
- open(READ, "<$path") or die "Cannot open file $path :$!";
- my %single_hash = ();
- my $key = ();
- my $counter = 0;
- while (my $line = ){
- $counter++;
- # print $line;
- chomp $line;
- my @fields1 = split(/\t/,$line);
- if ($line =~ /([0-9]+)\s+($focalspec)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)/ ) {
- $key = join("\t",$1, $2, $4, $5);
-
-# print "key = : $key\n" if $prinkter == 1;
-
-# print $line if $prinkter == 1;
- push (@{$single_hash{$key}},$line);
- }
- else{
- # print "microsat line incompatible\n";
- }
- }
- push @hasharr, {%single_hash};
- # print "@{$single_hash{$key}} \n";
-# print "done $path: counter = $counter\n" if $prinkter == 1;
- close READ;
- }
-# print "Done hashes\n";
- #----------------------------------------------------------------------------------------------------------------
- my $question=();
- #----------------------------------------------------------------------------------------------------------------
- my @contigstarts = ();
- my @contigends = ();
-
- my %contigclusters = ();
- my %contigclustersFirstStartOnly=();
- my %contigclustersLastEndOnly=();
- my %contigclustersLastEndLengthOnly=();
- my %contigclustersFirstStartLengthOnly=();
- my %contigpath=();
- my $dotcounter = 0;
- while (my $line = ){
-# print "x" x 60, "\n" if $prinkter == 1;
- $dotcounter++;
-# print "." if $dotcounter % 100 ==0;
-# print "\n" if $dotcounter % 5000 ==0;
- next if $line !~ /^[0-9]+/;
-# print $line if $prinkter == 1;
- chomp $line;
- my @fields2 = split(/\t/,$line);
- my $key2 = ();
- if ($line =~ /([0-9]+)\s+($focalspec)\s(chr[0-9a-zA-Z]+)\s([0-9]+)\s([0-9]+)/ ) {
- $key2 = join("\t",$1, $2, $4, $5);
- }
- else {
-# print "seq line $line incompatible\n" if $prinkter == 1;
- next;}
-
-
-
-
-
-
- my @sequences = ();
- for (0 ... $#tags){
- my $seq = ;
- # print $seq;
- chomp $seq;
- push(@sequences , " ".$seq);
- }
- my @origsequences = @sequences;
- my $seqcopy = $sequences[0];
- my @strings = ();
- $seqcopy =~ s/[a-zA-Z]|-/x/g;
- my @string = split(/\s*/,$seqcopy);
-
- for my $s (0 ... $#tags){
- $sequences[$s] =~ s/-//g;
- $sequences[$s] =~ s/[a-zA-Z]/x/g;
- # print "length of sequence = ",length($sequences[$s]),"\n";
- my @tempstring = split(/\s*/,$sequences[$s]);
- push(@strings, [@tempstring])
-
- }
-
- my @species_list = ();
- my @micro_count = 0;
- my @starthash = ();
- my $stopper = 1;
- my @endhash = ();
-
- my @currentcontigstarts=();
- my @currentcontigends=();
- my @currentcontigchrs=();
-
- for my $i (0 ... $#tags){
-# print "searching for : if exists hasharr: $i : $tags[$i] : $key2 \n" if $prinkter == 1;
- my @temparr = ();
-
- if (exists $hasharr[$i]{$key2}){
- @temparr = @{$hasharr[$i]{$key2}};
-
- $line =~ /$tags[$i]\s([a-zA-Z0-9_]+)\s([0-9]+)\s([0-9]+)/;
-## 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;
-# print "org = $tags[$i], and chr = $1, start = $2, end =$3 \n" if $prinkter == 1;
- my $startkey = $1."_SK0SK_".$2; #print "adding start key for this alignmebt block: $startkey to species $tags[$i]\n" if $prinkter == 1;
- my $endkey = $1."_EK0EK_".$3; #print "adding end key for this alignmebt block: $endkey to species $tags[$i]\n" if $prinkter == 1;
- $contigstarts[$i]{$startkey}= $key2;
- $contigends[$i]{$endkey}= $key2;
-# print "confirming existance: \n" if $prinkter == 1;
-# print "present \n" if exists $contigends[$i]{$endkey} && $prinkter == 1;
-# print "absent \n" if !exists $contigends[$i]{$endkey} && $prinkter == 1;
- $currentcontigchrs[$i]=$1;
- $currentcontigstarts[$i]=$2;
- $currentcontigends[$i]=$3;
-
- } # print "exists: @{$hasharr[$i]{$key2}}[0]\n"}
- else {
- push (@starthash, {0 => "0"});
- push (@endhash, {0 => "0"});
- $currentcontigchrs[$i] = 0;
- next;
- }
- $stopper = 0;
- # print "exists: @temparr\n" if $prinkter == 1;
- push(@micro_count, scalar(@temparr));
- push(@species_list, [@temparr]);
- my @tempstart = (); my @tempend = ();
- my %localends = ();
- my %localhash = ();
- # print "---------------------------\n";
-
- foreach my $templine (@temparr){
-# print "templine = $templine\n" if $prinkter == 1;
- my @tields = split(/\t/,$templine);
- my $start = $tields[$startcord]; # - $tields[$gapcord];
- my $end = $tields[$endcord]; #- $tields[$gapcord];
- my $realstart = $tields[$startcord]- $tields[$gapcord];
- my $gapsinmicrosat = ($tields[$microsatcord] =~ s/-/-/g);
- $gapsinmicrosat = 0 if $gapsinmicrosat !~ /[0-9]+/;
- # print "infocord = $infocord typecord = $typecord motifcord = $motifcord gapcord = $gapcord startcord = $startcord strandcord = $strandcord endcord = $endcord microsatcord = $microsatcord sequencepos = $sequencepos\n";
- my $realend = $tields[$endcord]- $tields[$gapcord]- $gapsinmicrosat;
- # print "real start = $realstart, realend = $realend \n";
- for my $pos ($realstart ... $realend){ $strings[$i][$pos] = $strings[$i][$pos].",".$i.":".$start."-".$end;}
- push(@tempstart, $start);
- push(@tempend, $end);
- $localhash{$start."-".$end} = $templine;
- }
- push @starthash, {%localhash};
- my $foundclusters =findClusters(join("!",@{$strings[$i]}), $CLUSTER_DIST);
-
-# print "foundclusters = $foundclusters\n";
-
- my @clusters = split(/_/,$foundclusters);
-
- my $clustno = 0;
-
- foreach my $cluster (@clusters) {
- my @constituenst = split(/,/,$cluster);
-# print "clusters returned: @constituenst\n" if $prinkter == 1;
- }
-
- @string = split("_S0S_",stringPainter(join("_C0C_",@string),$foundclusters));
-
-
- }
- next if $stopper == 1;
-
-# print colored ['blue'],"FINAL:\n" if $prinkter == 1;
- my $finalclusters =findClusters(join("!",@string), 1);
-# print "finalclusters = $finalclusters\n";
-# print colored ['blue'],"----------------------\n" if $prinkter == 1;
- my @clusters = split(/,/,$finalclusters);
-# print "@string\n" if $prinkter == 1;
-# print "@clusters\n" if $prinkter == 1;
-# print "------------------------------------------------------------------\n" if $prinkter == 1;
-
- my $clustno = 0;
-
- # foreach my $cluster (@clusters) {
- # my @constituenst = split(/,/,$cluster);
- # print "clusters returned: @constituenst\n";
- # }
-
- next if (scalar @clusters == 0);
-
- my @contigcluster=();
- my $clusterno=0;
- my @contigClusterstarts=();
- my @contigClusterends = ();
-
- foreach my $clust (@clusters){
- # print "cluster: $clust\n";
- $clusterno++;
- my @localclust = split(/\./, $clust);
- my @result = ();
- my @starts = ();
- my @ends = ();
-
- for my $i (0 ... $#localclust){
- # print "localclust[$i]: $localclust[$i]\n";
- my @pattern = split(/:/, $localclust[$i]);
- my @cords = split(/-/, $pattern[1]);
- push (@starts, $cords[0]);
- push (@ends, $cords[1]);
- }
-
- my $extremestart = smallest_number(@starts);
- my $extremeend = largest_number(@ends);
- push(@contigClusterstarts, $extremestart);
- push(@contigClusterends, $extremeend);
-# print "cluster starts from $extremestart and ends at $extremeend \n" if $prinkter == 1 ;
-
- foreach my $clustparts (@localclust){
- my @pattern = split(/:/, $clustparts);
- # print "printing from pattern: $pattern[1]: $starthash[$pattern[0]]{$pattern[1]}\n";
- push (@result, $starthash[$pattern[0]]{$pattern[1]});
- }
- push(@contigcluster, join("\t", @result));
-# print join("\t", @result),"<-result \n" if $prinkter == 1 ;
- }
-
-
- my $firstclusterstart = smallest_number(@contigClusterstarts);
- my $lastclusterend = largest_number(@contigClusterends);
-
-
- $contigclustersFirstStartOnly{$key2}=$firstclusterstart;
- $contigclustersLastEndOnly{$key2} = $lastclusterend;
- $contigclusters{$key2}=[ @contigcluster ];
-# print "currentcontigchr are @currentcontigchrs , firstclusterstart = $firstclusterstart, lastclusterend = $lastclusterend\n " if $prinkter == 1;
- for my $i (0 ... $#tags){
- #1 check if there exists adjacent alignment block wrt coordinates of this species.
- next if $currentcontigchrs[$i] eq "0"; #1 this means that there are no microsats in this species in this alignment block..
- #2 no need to worry about proximity of anything in adjacent block!
-
- #1 BELOW, the following is really to calclate the distance between the end coordinate of the
- #2 cluster and the end of the gap-free sequence of each species. this is so that if an
- #3 adjacent alignment block is found lateron, the exact distance between the potentially
- #4 adjacent microsat clusters can be found here. the exact start coordinate will be used
- #5 immediately below.
- # print "full sequence = $origsequences[$i] and its length = ",length($origsequences[$i])," \n" if $prinkter == 1;
-
- my $species_startsubstring = substr($origsequences[$i], 0, $firstclusterstart);
- my $species_endsubstring = ();
-
- if (length ($origsequences[$i]) <= $lastclusterend+1){ $species_endsubstring = "";}
- else{ $species_endsubstring = substr($origsequences[$i], $lastclusterend+1);}
-
-# print "\nnot defined species_endsubstring...\n" if !defined $species_endsubstring && $prinkter == 1;
-# print "for species: $tags[$i]: \n" if $prinkter == 1;
-
- $species_startsubstring =~ s/-| //g;
- $species_endsubstring =~ s/-| //g;
- $contigclustersLastEndLengthOnly{$key2}[$i]=length($species_endsubstring);
- $contigclustersFirstStartLengthOnly{$key2}[$i]=length($species_startsubstring);
-
-
-
-# print "species_startsubstring = $species_startsubstring, and its length =",length($species_startsubstring)," \n" if $prinkter == 1;
-# print "species_endsubstring = $species_endsubstring, and its length =",length($species_endsubstring)," \n" if $prinkter == 1;
-# print "attaching to contigclustersLastEndOnly: $key2: $i\n" if $prinkter == 1;
-
-# print "just confirming: $contigclustersLastEndLengthOnly{$key2}[$i] \n" if $prinkter == 1;
-
- }
-
-
- }
-# print "\ndone the job of filling... \n";
- #///////////////////////////////////////////////////////////////////////////////////////
- #///////////////////////////////////////////////////////////////////////////////////////
- #///////////////////////////////////////////////////////////////////////////////////////
- #///////////////////////////////////////////////////////////////////////////////////////
- $prinkter=0;
- open (BO, "<$aligns") or die "Cannot open alignment file: $aligns: $!";
-
- my %clusteringpaths=();
- my %clustersholder=();
- my %foundkeys=();
- my %clusteringpathsRev=();
-
-
- my $totalcount=();
- my $founkeys_enteredcount=();
- my $transfered=0;
- my $complete_transfered=0;
- my $plain_transfered=0;
- my $existing_removed=0;
-
- while (my $line = ){
-# print "x" x 60, "\n" if $prinkter == 1;
- next if $line !~ /^[0-9]+/;
- #print $line;
- chomp $line;
- my @fields2 = split(/\t/,$line);
- my $key2 = ();
- if ($line =~ /([0-9]+)\s+($focalspec)\s(chr[0-9a-zA-Z_]+)\s([0-9]+)\s([0-9]+)/ ) {
- $key2 = join("\t",$1, $2, $4, $5);
- }
-
- else {
- # print "seq line $line incompatible\n";
- next;
- }
-# print "KEY = : $key2\n" if $prinkter == 1;
-
-
- my @currentcontigstarts=();
- my @currentcontigends=();
- my @currentcontigchrs=();
- my @clusters = ();
- my @clusterscopy=();
- if (exists $contigclusters{$key2}){
- @clusters = @{$contigclusters{$key2}};
- @clusterscopy=@clusters;
- for my $i (0 ... $#tags){
- # 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;
- if ($line =~ /$tags[$i]\s([a-zA-Z0-9_]+)\s([0-9]+)\s([0-9]+)/){
- # print "org = $tags[$i], and chr = $1, start = $2, end =$3 \n" if $prinkter == 1;
- my $startkey = $1."_S0E_".$2; #print "adding start key for this alignmebt block: $startkey to species $tags[$i]\n" if $prinkter == 1;
- my $endkey = $1."_S0E_".$3; #print "adding end key for this alignmebt block: $endkey to species $tags[$i]\n" if $prinkter == 1;
- $currentcontigchrs[$i]=$1;
- $currentcontigstarts[$i]=$2;
- $currentcontigends[$i]=$3;
- }
- else {
- $currentcontigchrs[$i] = 0;
- # print "no microsat clusters for $key2\n" if $prinkter == 1; next;
- }
- }
- } # print "exists: @{$hasharr[$i]{$key2}}[0]\n"}
-
- my @sequences = ();
- for (0 ... $#tags){
- my $seq = ;
- # print $seq;
- chomp $seq;
- push(@sequences , " ".$seq);
- }
-
- next if scalar @currentcontigchrs == 0;
-
- # print "contigchrs= @currentcontigchrs \n" if $prinkter == 1;
- my %visitedcontigs=();
-
- for my $i (0 ... $#tags){
- #1 check if there exists adjacent alignment block wrt coordinates of this species.
- next if $currentcontigchrs[$i] eq "0"; #1 this means that there are no microsats in this species in this alignment block..
- #2 no need to worry about proximity of anything in adjacent block!
- @clusters=@clusterscopy;
- #1 BELOW, the following is really to calclate the distance between the end coordinate of the
- #2 cluster and the end of the gap-free sequence of each species. this is so that if an
- #3 adjacent alignment block is found lateron, the exact distance between the potentially
- #4 adjacent microsat clusters can be found here. the exact start coordinate will be used
- #5 immediately below.
- my $firstclusterstart = $contigclustersFirstStartOnly{$key2};
- my $lastclusterend = $contigclustersLastEndOnly{$key2};
-
- my $key3 = $currentcontigchrs[$i]."_S0E_".($currentcontigstarts[$i]);
-# print "check if exists $key3 in contigends for $i\n" if $prinkter == 1;
-
- if (exists($contigends[$i]{$key3}) && !exists $visitedcontigs{$contigends[$i]{$key3}}){
- $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#
- # print "just checking the hash visitedcontigs: ",$visitedcontigs{$contigends[$i]{$key3}} ,"\n" if $prinkter == 1;
-
- #1 extract coordinates of the last cluster of this found alignment block
-# print "key of the found alignment block = ", $contigends[$i]{$key3},"\n" if $prinkter == 1;
- # print "we are trying to mine: contigclustersAllLastEndLengthOnly_raw: $contigends[$i]{$key3}: $i \n" if $prinkter == 1;
- # print "EXISTS\n" if exists $contigclusters{$contigends[$i]{$key3}} && $prinkter == 1;
- # print "does NOT EXIST\n" if !exists $contigclusters{$contigends[$i]{$key3}} && $prinkter == 1;
- my @contigclustersAllFirstStartLengthOnly_raw=@{$contigclustersFirstStartLengthOnly{$key2}};
- my @contigclustersAllLastEndLengthOnly_raw=@{$contigclustersLastEndLengthOnly{$contigends[$i]{$key3}}};
- my @contigclustersAllFirstStartLengthOnly=(); my @contigclustersAllLastEndLengthOnly=();
-
- for my $val (0 ... $#contigclustersAllFirstStartLengthOnly_raw){
- # print "val = $val\n" if $prinkter == 1;
- if (defined $contigclustersAllFirstStartLengthOnly_raw[$val]){
- push(@contigclustersAllFirstStartLengthOnly, $contigclustersAllFirstStartLengthOnly_raw[$val]) if $contigclustersAllFirstStartLengthOnly_raw[$val] =~ /[0-9]+/;
- }
- }
- # print "-----\n" if $prinkter == 1;
- for my $val (0 ... $#contigclustersAllLastEndLengthOnly_raw){
- # print "val = $val\n" if $prinkter == 1;
- if (defined $contigclustersAllLastEndLengthOnly_raw[$val]){
- push(@contigclustersAllLastEndLengthOnly, $contigclustersAllLastEndLengthOnly_raw[$val]) if $contigclustersAllLastEndLengthOnly_raw[$val] =~ /[0-9]+/;
- }
- }
-
-
- # print "our two arrays are: starts = <@contigclustersAllFirstStartLengthOnly> ......... and ends = <@contigclustersAllLastEndLengthOnly>\n" if $prinkter == 1;
- # 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;
-
- # if ($contigclustersFirstStartLengthOnly{$key2}[$i] + $contigclustersLastEndLengthOnly{$contigends[$i]{$key3}}[$i] < 50){
- if (smallest_number(@contigclustersAllFirstStartLengthOnly) + smallest_number(@contigclustersAllLastEndLengthOnly) < $CLUSTER_DIST){
- my @regurgitate = @{$contigclusters{$contigends[$i]{$key3}}};
- $regurgitate[$#regurgitate]=~s/\n//g;
- $regurgitate[$#regurgitate] = $regurgitate[$#regurgitate]."\t".shift(@clusters);
- delete $contigclusters{$contigends[$i]{$key3}};
- $contigclusters{$contigends[$i]{$key3}}=[ @regurgitate ];
- delete $contigclusters{$key2};
- $contigclusters{$key2}= [ @clusters ] if scalar(@clusters) >0;
- $contigclusters{$key2}= [ "" ] if scalar(@clusters) ==0;
-
- if (scalar(@clusters) < 1){
- # print "$key2-> $clusteringpaths{$key2} in the loners\n" if exists $foundkeys{$key2};
- $clusteringpaths{$key2}=$contigends[$i]{$key3};
- $clusteringpathsRev{$contigends[$i]{$key3}}=$key2;
- print OUTP "$contigends[$i]{$key3} -> $clusteringpathsRev{$contigends[$i]{$key3}}\n";
- # print " clusteringpaths $key2 -> $contigends[$i]{$key3}\n";
- $founkeys_enteredcount-- if exists $foundkeys{$key2};
- $existing_removed++ if exists $foundkeys{$key2};
-# print "$key2->",@{$contigclusters{$key2}},"->>$foundkeys{$key2}\n" if exists $foundkeys{$key2} && $prinkter == 1;
- delete $foundkeys{$key2} if exists $foundkeys{$key2};
- $complete_transfered++;
- }
- else{
- print OUTP "$key2-> 0 not so lonely\n" if !exists $clusteringpathsRev{$key2};
- $clusteringpaths{$key2}=$key2 if !exists $clusteringpaths{$key2};
- $clusteringpathsRev{$key2}=0 if !exists $clusteringpathsRev{$key2};
-
- $founkeys_enteredcount++ if !exists $foundkeys{$key2};
- $foundkeys{$key2} = $key2 if !exists $foundkeys{$key2};
- # print "adding foundkeys entry $foundkeys{$key2}\n";
- $transfered++;
- }
- #$contigclusters{$key2}=[ @contigcluster ];
- }
- }
- else{
- # print "adjacent block with species $tags[$i] does not exist\n" if $prinkter == 1;
- $plain_transfered++;
- print OUTP "$key2-> 0 , going straight\n" if exists $contigclusters{$key2} && !exists $clusteringpathsRev{$key2};
- $clusteringpaths{$key2}=$key2 if exists $contigclusters{$key2} && !exists $clusteringpaths{$key2};
- $clusteringpathsRev{$key2}=0 if exists $contigclusters{$key2} && !exists $clusteringpathsRev{$key2};
- $founkeys_enteredcount++ if !exists $foundkeys{$key2} && exists $contigclusters{$key2};
- $foundkeys{$key2} = $key2 if !exists $foundkeys{$key2} && exists $contigclusters{$key2};
- # print "adding foundkeys entry $foundkeys{$key2}\n";
-
- }
- $totalcount++;
-
- }
-
-
- }
- close BO;
- #close (NORTH);
- #///////////////////////////////////////////////////////////////////////////////////////
- #///////////////////////////////////////////////////////////////////////////////////////
- #///////////////////////////////////////////////////////////////////////////////////////
- #///////////////////////////////////////////////////////////////////////////////////////
-
- my $founkeys_count=();
- my $nopath_count=();
- my $pathed_count=0;
- foreach my $key2 (keys %foundkeys){
- #print "x" x 60, "\n";
-# print "x" if $dotcounter % 100 ==0;
-# print "\n" if $dotcounter % 5000 ==0;
- $founkeys_count++;
- my $key = $key2;
-# print "$key2 -> $clusteringpaths{$key2}\n" if $prinkter == 1;
- if ($clusteringpaths{$key} eq $key){
-# print "printing hit the alignment block immediately... no path needed\n" if $prinkter == 1;
- $nopath_count++;
- delete $foundkeys{$key2};
- print ORTH join ("\n",@{$contigclusters{$key2}}),"\n";
- }
- else{
- my @pool=();
- my $key3=();
- $pathed_count++;
-# print "going reverse... clusteringpathsRev, $key = $clusteringpathsRev{$key}\n" if exists $clusteringpathsRev{$key} && $prinkter == 1;
-# print "going reverse... clusteringpathsRev $key does not exist\n" if !exists $clusteringpathsRev{$key} && $prinkter == 1;
- if ($clusteringpathsRev{$key} eq "0") {
- next;
- }
- else{
- my $yek3 = $clusteringpathsRev{$key};
- my $yek = $key;
-# print "caught in the middle of a path, now goin down from $yek to $yek3, which is $clusteringpathsRev{$key} \n" if $prinkter == 1;
- while ($yek3 ne "0"){
-# print "$yek->$yek3," if $prinkter == 1;
- $yek = $yek3;
- $yek3 = $clusteringpathsRev{$yek};
- }
-# 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;
- $key3 = $clusteringpaths{$yek};
- $key = $yek;
- }
-
-# print "now that we are at bottom of the path, lets start climbing up again\n" if $prinkter == 1;
-
- while($key ne $key3){
-# print "KEEY $key->$key3\n" if $prinkter == 1;
-# print "our contigcluster = @{$contigclusters{$key}}\n----------\n" if $prinkter == 1;
-
- if (scalar(@{$contigclusters{$key}}) > 0) {push @pool, @{$contigclusters{$key}};
- # print "now pool = @pool\n" if $prinkter == 1;
- }
- delete $foundkeys{$key3};
- $key=$key3;
- $key3=$clusteringpaths{$key};
- }
-# print "\nfinally, adding the first element of path: @{$contigclusters{$key}}\n AND printing the contents:\n" if $prinkter == 1;
- my @firstcontig= @{$contigclusters{$key}};
- delete $foundkeys{$key2} if exists $foundkeys{$key2} ;
- delete $foundkeys{$key} if exists $foundkeys{$key};
-
- unshift @pool, pop @firstcontig;
-# print join("\t",@pool),"\n" if $prinkter == 1;
- print ORTH join ("\n",@firstcontig),"\n" if scalar(@firstcontig) > 0;
- print ORTH join ("\t",@pool),"\n";
- # join();
- }
-
- }
- #close (NORTH);
-# 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;
- close (BO);
- close (ORTH);
- close (OUTP);
- return 1;
-
-}
-sub stringPainter{
- my @string = split(/_C0C_/,$_[0]);
-# print $_[0], " <- in stringPainter\n";
-# print $_[1], " <- in clusters\n";
-
- my @clusters = split(/,/, $_[1]);
- for my $i (0 ... $#clusters){
- my $cluster = $clusters[$i];
-# print "cluster = $cluster\n";
- my @parts = split(/\./,$cluster);
- my @cord = split(/:|-/,shift(@parts));
- my $minstart = $cord[1];
- my $maxend = $cord[2];
-# print "minstart = $minstart , maxend = $maxend\n";
-
- for my $j (0 ... $#parts){
-# print "oing thri $parts[$j]\n";
- my @cord = split(/:|-/,$parts[$j]);
- $minstart = $cord[1] if $cord[1] < $minstart;
- $maxend = $cord[2] if $cord[2] > $maxend;
- }
-# print "minstart = $minstart , maxend = $maxend\n";
- for my $pos ($minstart ... $maxend){ $string[$pos] = $string[$pos].",".$cluster;}
-
-
- }
-# print "@string <-done from function stringPainter\n";
- return join("_S0S_",@string);
-}
-
-sub findClusters{
- my $continue = 0;
- my @mapped_clusters = ();
- my $clusterdist = $_[1];
- my $previous = 'x';
- my @localcluster = ();
- my $cluster_starts = ();
- my $cluster_ends = ();
- my $localcluster_start = ();
- my $localcluster_end = ();
- my @record_cluster = ();
- my @string = split(/\!/, $_[0]);
- my $zerolength=0;
-
- for my $pos_pos (1 ... $#string){
- my $pos = $string[$pos_pos];
-# print $pos, "\n";
- if ($continue == 0 && $pos eq "x") {next;}
-
- if ($continue == 1 && $pos eq "x" && $zerolength <= $clusterdist){
- if ($zerolength == 0) {$localcluster_end = $pos_pos-1};
- $zerolength++;
- $continue = 1;
- }
-
- if ($continue == 1 && $pos eq "x" && $zerolength > $clusterdist) {
- $zerolength = 0;
- $continue = 0;
- my %seen;
- my @uniqed = grep !$seen{$_}++, @localcluster;
-# print "caught cluster : @uniqed \n";
- push(@mapped_clusters, [@uniqed]);
-# print "clustered:\n@uniqed\n";
- @localcluster = ();
- @record_cluster = ();
-
- }
-
- if ($pos ne "x"){
- $zerolength = 0;
- $continue = 1;
- $pos =~ s/x,//g;
- my @entries = split(/,/,$pos);
- $localcluster_end = 0;
- $localcluster_start = 0;
- push(@record_cluster,$pos);
-
- if ($continue == 0){
- @localcluster = ();
- @localcluster = (@localcluster, @entries);
- $localcluster_start = $pos_pos;
- }
-
- if ($continue == 1 ) {
- @localcluster = (@localcluster, @entries);
- }
- }
- }
-
- if (scalar(@localcluster) > 0){
- my %seen;
- my @uniqed = grep !$seen{$_}++, @localcluster;
- # print "caught cluster : @uniqed \n";
- push(@mapped_clusters, [@uniqed]);
- # print "clustered:\n@uniqed\n";
- @localcluster = ();
- @record_cluster = ();
- }
-
- my @returner = ();
-
- foreach my $clust (@mapped_clusters){
- my @localclust = @$clust;
- my @result = ();
- foreach my $clustparts (@localclust){
- push(@result,$clustparts);
- }
- push(@returner , join(".",@result));
- }
-# print "returnig: ", join(",",@returner), "\n";
- return join(",",@returner);
-}
-#xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx multiSpecies_orthFinder4 xxxxxxxxxxxxxx
-
-#xxxxxxxxxxxxxx MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx MakeTrees xxxxxxxxxxxxxxxxxxxxxxxxxxxx
-
-sub MakeTrees{
- my $tree = $_[0];
- my @parts=($tree);
-# my @parts=();
-
- while (1){
- $tree =~ s/^\(//g;
- $tree =~ s/\)$//g;
- my @arr = ();
-
- if ($tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)\)$/){
- @arr = $tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_\(\),]+)$/;
- $tree = $2;
- push @parts, $tree;
- }
- elsif ($tree =~ /^\(([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/){
- @arr = $tree =~ /^([a-zA-Z0-9_\(\),]+),([a-zA-Z0-9_]+)$/;
- $tree = $1;
- push @parts, $tree;
- }
- elsif ($tree =~ /^([a-zA-Z0-9_]+),([a-zA-Z0-9_]+)$/){
- last;
- }
- }
- return @parts;
-}
-
-#xxxxxxxxxxxxxx qualityFilter xxxxxxxxxxxxxxxxxxxxxxxxxxxx qualityFilter xxxxxxxxxxxxxxxxxxxxxxxxxxxx qualityFilter xxxxxxxxxxxxxxxxxxxxxxxxxxxx
-
-sub qualityFilter{
- my $unmaskedorthfile = $_[0];
- my $seqfile = $_[1];
- my $maskedorthfile = $_[2];
- my $filteredout = $maskedorthfile."_residue";
- open (PMORTH, "<$unmaskedorthfile") or die "Cannot open unmaskedorthfile file: $unmaskedorthfile: $!";
-
- my %keyhash = ();
-
- while (my $line = ){
- my $key = join("\t", $1,$2,$3,$4) if $line =~ /($focalspec)\s+([a-zA-Z0-9\-_]+)\s+([0-9]+)\s+([0-9]+)/;
- push @{$keyhash{$key}}, $line;
- }
-
- open (SEQ, "<$seqfile") or die "Cannot open seqfile file: $seqfile: $!";
- open (MORTH, ">$maskedorthfile") or die "Cannot open maskedorthfile file: $maskedorthfile: $!";
- open (RES, ">$filteredout") or die "Cannot open filteredout file: $filteredout: $!";
-
-
-
- while (my $line = ){
- chomp $line;
- if ($line =~ /($focalspec)\s+([a-zA-Z0-9\-_]+)\s+([0-9]+)\s+([0-9]+)/){
- my $key = join("\t", $1,$2,$3,$4);
- next if !exists $keyhash{$key};
- my @orths = @{$keyhash{$key}} if exists $keyhash{$key};
- delete $keyhash{$key};
-
- my $sine = ;
-
- foreach my $orth (@orths){
- #print "-----------------------------------------------------------------\n";
- #print $orth;
- my $orthcopy = $orth;
- $orth =~ s/^>//;
- my @parts = split(/>/,$orth);
-
- my @starts = ();
- my @ends = ();
-
- foreach my $part (@parts){
- my $no_of_species = adjustCoordinates($part);
- my @pields = split(/\t/,$part);
-
- # print "pields = @pields .. no_of_species = $no_of_species .. startcord = $pields[$startcord]\n";
-
- push @starts, $pields[$startcord];
- push @ends, $pields[$endcord];
- }
-
- #print "starts = @starts ... ends = @ends\n";
-
- my $leftend = smallest_number(@starts)-10;
- my $rightend = largest_number(@ends)+10;
-
- my $maskarea = substr($sine, $leftend, $rightend-$leftend+1);
- print RES $orth if $maskarea =~ /#/;
-
-
- next if $maskarea =~ /#/;
-
- print MORTH $orthcopy;
- }
- }
- else{
- next;
- }
-
-
- }
-
-# print "UNDONE: ", scalar(keys %keyhash),"\n";
-# print MORTH "UNDONE: ", scalar(keys %keyhash),"\n";
-
-}
-
-sub adjustCoordinates{
- my $line = $_[0];
- 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;
- my @got = ($line =~ s/(chr[0-9a-zA-Z]+)|(Contig[0-9a-zA-Z\._\-]+)/x/g);
-# print "line = $line\n";
- $infocord = 2 + (4*$no_of_species) - 1;
- $typecord = 2 + (4*$no_of_species) + 1 - 1;
- $motifcord = 2 + (4*$no_of_species) + 2 - 1;
- $gapcord = $motifcord+1;
- $startcord = $gapcord+1;
- $strandcord = $startcord+1;
- $endcord = $strandcord + 1;
- $microsatcord = $endcord + 1;
- $sequencepos = 2 + (5*$no_of_species) + 1 -1 ;
- $interr_poscord = $microsatcord + 3;
- $no_of_interruptionscord = $microsatcord + 4;
- $interrcord = $microsatcord + 2;
-# print "$line\n startcord = $startcord, and endcord = $endcord and no_of_species = $no_of_species\n" if $line !~ /calJac/i;
- return $no_of_species;
-}
-
-
-
-
diff --git a/tools/regVariation/multispecies_MicrosatDataGenerator_interrupted_GALAXY.xml b/tools/regVariation/multispecies_MicrosatDataGenerator_interrupted_GALAXY.xml
deleted file mode 100755
index 6ef070bc5e6..00000000000
--- a/tools/regVariation/multispecies_MicrosatDataGenerator_interrupted_GALAXY.xml
+++ /dev/null
@@ -1,93 +0,0 @@
-
- for multiple (>2) species alignments
-
- multispecies_MicrosatDataGenerator_interrupted_GALAXY.pl
- $input1
- $input2
- $out_file1
- $thresholds
- $species
- "$treedefinition"
- $separation
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- bx-sputnik
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This tool finds ortholgous microsatellite blocks between aligned species
-
------
-
-.. class:: warningmark
-
-**Note**
-
-A non-tabular format is created in which each row contains all information pertaining to a microsatellite locus from multiple species in the alignment.
-The rows read like this:
-
->hg18 15 hg18 chr22 16092941 16093413 panTro2 chr22 16103944 16104421 ponAbe2 chr22 13797750 13798215 rheMac2 chr10 61890946 61891409 calJac1 Contig6986 140254 140728 mononucleotide A 0 13 + 29 aaaaa------aaaAAA >rheMac2 15 hg18 chr22 16092941 16093413 panTro2 chr22 16103944 16104421 ponAbe2 chr22 13797750 13798215 rheMac2 chr10 61890946 61891409 calJac1 Contig6986 140254 140728 mononucleotide A 0 13 + 29 aaaaaaaa---AAAAAA
-
-Information from each species starts with an ">" followed by the species name, for instance, ">rheMac2". Below we describe all information listed for a microsatellite sequence in each species.
-
-After the species tag the alignemnt number is listed.
-What follows is details of the alignment block from all the species, including the chromosome number, start and end coordinates in each species. For instance:
-
-hg18 chr22 16092941 16093413 panTro2 chr22 16103944 16104421 ponAbe2 chr22 13797750 13798215 rheMac2 chr10 61890946 61891409 calJac1 Contig6986 140254 140728
-
-suggests that the alignment block as five species: hg18, panTro2, ponAbe2, rheMac2 and calJac1.
-
-Then the type of microsatellite is written, for instance, "mononucleotide".
-
-Then the microsatellite motif.
-
-Then the number of gaps in the alignment, in the respective species (as noted above, rheMac2 in this case).
-
-Then the start coordinate, the strand, and the end coordinate WITHIN the alignment block.
-
-At the end is listed the microsatellite sequence.
-
-If the microsatellite contains interruptions (which are not important for this tool), then the interruptions' information will be written out after the microsatellite sequence.
-
-
-
-
-
-
diff --git a/tools/regVariation/parseMAF_smallIndels.pl b/tools/regVariation/parseMAF_smallIndels.pl
deleted file mode 100644
index 1c5e305ca6d..00000000000
--- a/tools/regVariation/parseMAF_smallIndels.pl
+++ /dev/null
@@ -1,698 +0,0 @@
-#!/usr/bin/perl -w
-# a program to get indels
-# input is a MAF format 3-way alignment file
-# from 3-way blocks only at this time
-# translate seq2, seq3, etc coordinates to + if align orient is reverse complement
-
-use strict;
-use warnings;
-
-# declare and initialize variables
-my $fh; # variable to store filehandle
-my $record;
-my $offset;
-my $library = $ARGV[0];
-my $count = 0;
-my $count2 = 0;
-my $count3 = 0;
-my $count4 = 0;
-my $start1 = my $start2 = my $start3 = my $start4 = my $start5 = my $start6 = 0;
-my $orient = "";
-my $outgroup = $ARGV[2];
-my $ingroup1 = my $ingroup2 = "";
-my $count_seq1insert = my $count_seq1delete = 0;
-my $count_seq2insert = my $count_seq2delete = 0;
-my $count_seq3insert = my $count_seq3delete = 0;
-my @seq1_insert_lengths = my @seq1_delete_lengths = ();
-my @seq2_insert_lengths = my @seq2_delete_lengths = ();
-my @seq3_insert_lengths = my @seq3_delete_lengths = ();
-my @seq1_insert = my @seq1_delete = my @seq2_insert = my @seq2_delete = my @seq3_insert = my @seq3_delete = ();
-my @seq1_insert_startOnly = my @seq1_delete_startOnly = my @seq2_insert_startOnly = my @seq2_delete_startOnly = ();
-my @seq3_insert_startOnly = my @seq3_delete_startOnly = ();
-my @indels = ();
-
-# check to make sure correct files
-my $usage = "usage: parseMAF_smallIndels.pl [MAF.in] [small_Indels_summary.out] [outgroup]\n";
-die $usage unless @ARGV == 3;
-
-# perform some standard subroutines
-$fh = open_file($library);
-
-$offset = tell($fh);
-
-#my $ofile = $ARGV[2];
-#unless (open(OFILE, ">$ofile")){
-# print "Cannot open output file \"$ofile\"\n\n";
-# exit;
-#}
-
-my $ofile2 = $ARGV[1];
-unless (open(OFILE2, ">$ofile2")){
- print "Cannot open output file \"$ofile2\"\n\n";
- exit;
-}
-
-
-# header line for output files
-#print OFILE "# small indel events, parsed from MAF 3-way alignment file, coords are translated from (-) to (+) if necessary\n";
-#print OFILE "#align\tingroup1\tingroup1_coord\tingroup1_orient\tingroup2\tingroup2_coord\tingroup2_orient\toutgroup\toutgroup_coord\toutgroup_orient\tindel_type\n";
-
-#print OFILE2 "# small indels summary, parsed from MAF 3-way alignment file, coords are translated from (-) to (+) if necessary\n";
-print OFILE2 "#block\tindel_type\tindel_length\tingroup1\tingroup1_start\tingroup1_end\tingroup1_alignSize\tingroup1_orient\tingroup2\tingroup2_start\tingroup2_end\tingroup2_alignSize\tingroup2_orient\toutgroup\toutgroup_start\toutgroup_end\toutgroup_alignSize\toutgroup_orient\n";
-
-# main body of program
-while ($record = get_next_record($fh) ){
- if ($record=~ m/\s*##maf(.*)\s*# maf/s){
- next;
- }
-
- my @sequences = get_sequences_within_block($record);
- my @seq_info = get_indels_within_block(@sequences);
- get_indels_lengths(@seq_info);
-
- $offset = tell($fh);
- $count++;
-
-}
-
-get_starts_only(@seq1_insert);
-get_starts_only(@seq1_delete);
-get_starts_only(@seq2_insert);
-get_starts_only(@seq2_delete);
-get_starts_only(@seq3_insert);
-get_starts_only(@seq3_delete);
-
-# print some things to keep track of progress
-#print "# $library\n";
-#print "# number of records = $count\n";
-#print "# number of sequence \"s\" lines = $count2\n";
-if ($count3 != 0){
- print "Skipped $count3 blocks with only 2 seqs;\n";
-}
-#print "# number of records with only h-m = $count4\n\n";
-
-print "Ingroup1 = $ingroup1; Ingroup2 = $ingroup2; Outgroup = $outgroup;\n";
-print "# of ingroup1 inserts = $count_seq1insert;\n";
-print "# of ingroup1 deletes = $count_seq1delete;\n";
-print "# of ingroup2 inserts = $count_seq2insert;\n";
-print "# of ingroup2 deletes = $count_seq2delete;\n";
-print "# of outgroup3 inserts = $count_seq3insert;\n";
-print "# of outgroup3 deletes = $count_seq3delete\n";
-
-
-#close OFILE;
-
-if ($count == $count3){
- print STDERR "Skipped all blocks since none of them contain 3-way alignments.\n";
- exit -1;
-}
-
-###################SUBROUTINES#####################################
-
-# subroutine to open file
-sub open_file {
- my($filename) = @_;
- my $fh;
-
- unless (open($fh, $filename)){
- print "Cannot open file $filename\n";
- exit;
- }
- return $fh;
-}
-
-# get next record
-sub get_next_record {
- my ($fh) = @_;
- my ($offset);
- my ($record) = "";
- my ($save_input_separator) = $/;
-
- $/ = "a score";
-
- $record = <$fh>;
-
- $/ = $save_input_separator;
- return $record;
-}
-
-# get header info
-sub get_sequences_within_block{
- my (@alignment) = @_;
- my @lines = ();
-
- my @sequences = ();
-
- @lines = split ("\n", $record);
- foreach (@lines){
- chomp($_);
- if (m/^\s*$/){
- next;
- }
- elsif (m/^\s*=(\d+\.*\d*)/){
-
- }elsif (m/^\s*s(.*)$/){
- $count2++;
-
- push (@sequences,$_);
- }
- }
- return @sequences;
-}
-
-sub get_indels_within_block{
- my (@sequences) = @_;
- my $line1 = my $line2 = my $line3 = "";
- my @line1 = my @line2 = my @line3 = ();
- my $score = 0;
- my $start1 = my $align_length1 = my $end1 = my $seq_length1 = 0;
- my $start2 = my $align_length2 = my $end2 = my $seq_length2 = 0;
- my $start3 = my $align_length3 = my $end3 = my $seq_length3 = 0;
- my $seq1 = my $orient1 = "";
- my $seq2 = my $orient2 = "";
- my $seq3 = my $orient3 = "";
- my $start1_plus = my $end1_plus = 0;
- my $start2_plus = my $end2_plus = 0;
- my $start3_plus = my $end3_plus = 0;
- my @test = ();
- my $test = "";
- my $header = "";
- my @header = ();
- my $sequence1 = my $sequence2 = my $sequence3 ="";
- my @array_return = ();
- my $test1 = 0;
- my $line1_stat = my $line2_stat = my $line3_stat = "";
-
- # process 3-way blocks only
- if (scalar(@sequences) == 3){
- $line1 = $sequences[0];
- chomp ($line1);
- $line2 = $sequences[1];
- chomp ($line2);
- $line3 = $sequences[2];
- chomp ($line3);
- # check order of sequences and assign uniformly seq1= human, seq2 = chimp, seq3 = macaque
- if ($line1 =~ m/$outgroup/){
- $line1_stat = "out";
- $line2=~ s/^\s*//;
- $line2 =~ s/\s+/\t/g;
- @line2 = split(/\t/, $line2);
- if (($ingroup1 eq "") || ($line2[1] =~ m/$ingroup1/)){
- $line2_stat = "in1";
- $line3_stat = "in2";
- }
- else{
- $line3_stat = "in1";
- $line2_stat = "in2"; }
- }
- elsif ($line2 =~ m/$outgroup/){
- $line2_stat = "out";
- $line1=~ s/^\s*//;
- $line1 =~ s/\s+/\t/g;
- @line1 = split(/\t/, $line1);
- if (($ingroup1 eq "") || ($line1[1] =~ m/$ingroup1/)){
- $line1_stat = "in1";
- $line3_stat = "in2";
- }
- else{
- $line3_stat = "in1";
- $line1_stat = "in2"; }
- }
- elsif ($line3 =~ m/$outgroup/){
- $line3_stat = "out";
- $line1=~ s/^\s*//;
- $line1 =~ s/\s+/\t/g;
- @line1 = split(/\t/, $line1);
- if (($ingroup1 eq "") || ($line1[1] =~ m/$ingroup1/)){
- $line1_stat = "in1";
- $line2_stat = "in2";
- }
- else{
- $line2_stat = "in1";
- $line1_stat = "in2"; }
- }
-
- #print "# l1 = $line1_stat\n";
- #print "# l2 = $line2_stat\n";
- #print "# l3 = $line3_stat\n";
- my $linei1 = my $linei2 = my $lineo = "";
- my @linei1 = my @linei2 = my @lineo = ();
-
- if ($line1_stat eq "out"){
- $lineo = $line1;
- }
- elsif ($line1_stat eq "in1"){
- $linei1 = $line1;
- }
- else{
- $linei2 = $line1;
- }
-
- if ($line2_stat eq "out"){
- $lineo = $line2;
- }
- elsif ($line2_stat eq "in1"){
- $linei1 = $line2;
- }
- else{
- $linei2 = $line2;
- }
-
- if ($line3_stat eq "out"){
- $lineo = $line3;
- }
- elsif ($line3_stat eq "in1"){
- $linei1 = $line3;
- }
- else{
- $linei2 = $line3;
- }
-
- $linei1=~ s/^\s*//;
- $linei1 =~ s/\s+/\t/g;
- @linei1 = split(/\t/, $linei1);
- $end1 =($linei1[2]+$linei1[3]-1);
- $seq1 = $linei1[1].":".$linei1[3];
- $ingroup1 = (split(/\./, $seq1))[0];
- $start1 = $linei1[2];
- $align_length1 = $linei1[3];
- $orient1 = $linei1[4];
- $seq_length1 = $linei1[5];
- $sequence1 = $linei1[6];
- $test1 = length($sequence1);
- my $total_length1 = $test1+$start1;
- my @array1 = ($start1,$end1,$orient1,$seq_length1);
- ($start1_plus, $end1_plus) = convert_coords(@array1);
-
- $linei2=~ s/^\s*//;
- $linei2 =~ s/\s+/\t/g;
- @linei2 = split(/\t/, $linei2);
- $end2 =($linei2[2]+$linei2[3]-1);
- $seq2 = $linei2[1].":".$linei2[3];
- $ingroup2 = (split(/\./, $seq2))[0];
- $start2 = $linei2[2];
- $align_length2 = $linei2[3];
- $orient2 = $linei2[4];
- $seq_length2 = $linei2[5];
- $sequence2 = $linei2[6];
- my $test2 = length($sequence2);
- my $total_length2 = $test2+$start2;
- my @array2 = ($start2,$end2,$orient2,$seq_length2);
- ($start2_plus, $end2_plus) = convert_coords(@array2);
-
- $lineo=~ s/^\s*//;
- $lineo =~ s/\s+/\t/g;
- @lineo = split(/\t/, $lineo);
- $end3 =($lineo[2]+$lineo[3]-1);
- $seq3 = $lineo[1].":".$lineo[3];
- $start3 = $lineo[2];
- $align_length3 = $lineo[3];
- $orient3 = $lineo[4];
- $seq_length3 = $lineo[5];
- $sequence3 = $lineo[6];
- my $test3 = length($sequence3);
- my $total_length3 = $test3+$start3;
- my @array3 = ($start3,$end3,$orient3,$seq_length3);
- ($start3_plus, $end3_plus) = convert_coords(@array3);
-
- #print "# l1 = $ingroup1\n";
- #print "# l2 = $ingroup2\n";
- #print "# l3 = $outgroup\n";
-
- my $ABC = "";
- my $coord1 = my $coord2 = my $coord3 = 0;
- $coord1 = $start1_plus;
- $coord2 = $start2_plus;
- $coord3 = $start3_plus;
-
- for (my $position = 0; $position < $test1; $position++) {
- my $indelType = "";
- my $indel_line = "";
- # seq1 deletes
- if ((substr($sequence1,$position,1) eq "-")
- && (substr($sequence2,$position,1) !~ m/[-*\#$?^@]/)
- && (substr($sequence3,$position,1) !~ m/[-*\#$?^@]/)){
- $ABC = join("",($ABC,"X"));
- my @s = split(/:/, $seq1);
- $indelType = $s[0]."_delete";
-
- #print OFILE "$count\t$seq1\t$coord1\t$orient1\t$seq2\t$coord2\t$orient2\t$seq3\t$coord3\t$orient3\t$indelType\n";
- $indel_line = join("\t",($count,$seq1,$coord1,$orient1,$seq2,$coord2,$orient2,$seq3,$coord3,$orient3,$indelType));
- push (@indels,$indel_line);
- push (@seq1_delete,$indel_line);
- $coord2++; $coord3++;
- }
- # seq2 deletes
- elsif ((substr($sequence1,$position,1) !~ m/[-*\#$?^@]/)
- && (substr($sequence2,$position,1) eq "-")
- && (substr($sequence3,$position,1) !~ m/[-*\$?^]/)){
- $ABC = join("",($ABC,"Y"));
- my @s = split(/:/, $seq2);
- $indelType = $s[0]."_delete";
- #print OFILE "$count\t$seq1\t$coord1\t$orient1\t$seq2\t$coord2\t$orient2\t$seq3\t$coord3\t$orient3\t$indelType\n";
- $indel_line = join("\t",($count,$seq1,$coord1,$orient1,$seq2,$coord2,$orient2,$seq3,$coord3,$orient3,$indelType));
- push (@indels,$indel_line);
- push (@seq2_delete,$indel_line);
- $coord1++;
- $coord3++;
-
- }
- # seq1 inserts
- elsif ((substr($sequence1,$position,1) !~ m/[-*\#$?^@]/)
- && (substr($sequence2,$position,1) eq "-")
- && (substr($sequence3,$position,1) eq "-")){
- $ABC = join("",($ABC,"Z"));
- my @s = split(/:/, $seq1);
- $indelType = $s[0]."_insert";
- #print OFILE "$count\t$seq1\t$coord1\t$orient1\t$seq2\t$coord2\t$orient2\t$seq3\t$coord3\t$orient3\t$indelType\n";
- $indel_line = join("\t",($count,$seq1,$coord1,$orient1,$seq2,$coord2,$orient2,$seq3,$coord3,$orient3,$indelType));
- push (@indels,$indel_line);
- push (@seq1_insert,$indel_line);
- $coord1++;
- }
- # seq2 inserts
- elsif ((substr($sequence1,$position,1) eq "-")
- && (substr($sequence2,$position,1) !~ m/[-*\#$?^@]/)
- && (substr($sequence3,$position,1) eq "-")){
- $ABC = join("",($ABC,"W"));
- my @s = split(/:/, $seq2);
- $indelType = $s[0]."_insert";
- #print OFILE "$count\t$seq1\t$coord1\t$orient1\t$seq2\t$coord2\t$orient2\t$seq3\t$coord3\t$orient3\t$indelType\n";
- $indel_line = join("\t",($count,$seq1,$coord1,$orient1,$seq2,$coord2,$orient2,$seq3,$coord3,$orient3,$indelType));
- push (@indels,$indel_line);
- push (@seq2_insert,$indel_line);
- $coord2++;
- }
- # seq3 deletes
- elsif ((substr($sequence1,$position,1) !~ m/[-*\#$?^@]/)
- && (substr($sequence2,$position,1) !~ m/[-*\#$?^@]/)
- && (substr($sequence3,$position,1) eq "-")){
- $ABC = join("",($ABC,"S"));
- my @s = split(/:/, $seq3);
- $indelType = $s[0]."_delete";
- #print OFILE "$count\t$seq1\t$coord1\t$orient1\t$seq2\t$coord2\t$orient2\t$seq3\t$coord3\t$orient3\t$indelType\n";
- $indel_line = join("\t",($count,$seq1,$coord1,$orient1,$seq2,$coord2,$orient2,$seq3,$coord3,$orient3,$indelType));
- push (@indels,$indel_line);
- push (@seq3_delete,$indel_line);
- $coord1++; $coord2++;
- }
- # seq3 inserts
- elsif ((substr($sequence1,$position,1) eq "-")
- && (substr($sequence2,$position,1) eq "-")
- && (substr($sequence3,$position,1) !~ m/[-*\#$?^@]/)){
- $ABC = join("",($ABC,"T"));
- my @s = split(/:/, $seq3);
- $indelType = $s[0]."_insert";
- #print OFILE "$count\t$seq1\t$coord1\t$orient1\t$seq2\t$coord2\t$orient2\t$seq3\t$coord3\t$orient3\t$indelType\n";
- $indel_line = join("\t",($count,$seq1,$coord1,$orient1,$seq2,$coord2,$orient2,$seq3,$coord3,$orient3,$indelType));
- push (@indels,$indel_line);
- push (@seq3_insert,$indel_line);
- $coord3++;
- }else{
- $ABC = join("",($ABC,"N"));
- $coord1++; $coord2++; $coord3++;
- }
-
- }
- @array_return=($seq1,$seq2,$seq3,$ABC);
- return (@array_return);
-
- }
- # ignore pairwise cases for now, just count the number of blocks
- elsif (scalar(@sequences) == 2){
- my $ABC = "";
- my $coord1 = my $coord2 = my $coord3 = 0;
- $count3++;
-
- $line1 = $sequences[0];
- $line2 = $sequences[1];
- chomp ($line1);
- chomp ($line2);
-
- if ($line2 !~ m/$ingroup2/){
- $count4++;
- }
- }
-}
-
-
-sub get_indels_lengths{
- my (@array) = @_;
- if (scalar(@array) == 4){
- my $seq1 = $array[0]; my $seq2 = $array[1]; my $seq3 = $array[2]; my $ABC = $array[3];
-
- while ($ABC =~ m/(X+)/g) {
- push (@seq1_delete_lengths,length($1));
- $count_seq1delete++;
- }
-
- while ($ABC =~ m/(Y+)/g) {
- push (@seq2_delete_lengths,length($1));
- $count_seq2delete++;
- }
- while ($ABC =~ m/(S+)/g) {
- push (@seq3_delete_lengths,length($1));
- $count_seq3delete++;
- }
- while ($ABC =~ m/(Z+)/g) {
- push (@seq1_insert_lengths,length($1));
- $count_seq1insert++;
- }
- while ($ABC =~ m/(W+)/g) {
- push(@seq2_insert_lengths,length($1));
- $count_seq2insert++;
- }
- while ($ABC =~ m/(T+)/g) {
- push (@seq3_insert_lengths,length($1));
- $count_seq3insert++;
- }
- }
- elsif (scalar(@array) == 0){
- next;
- }
-
-}
-# convert to coordinates to + strand if align orient = -
-sub convert_coords{
- my (@array) = @_;
- my $s = $array[0];
- my $e = $array[1];
- my $o = $array[2];
- my $l = $array[3];
- my $start_plus = my $end_plus = 0;
-
- if ($o eq "-"){
- $start_plus = ($l - $e);
- $end_plus = ($l - $s);
- }elsif ($o eq "+"){
- $start_plus = $s;
- $end_plus = $e;
- }
-
- return ($start_plus, $end_plus);
-}
-
-# get first line only for each event
-sub get_starts_only{
- my (@test) = @_;
- my $seq1 = my $seq2 = my $seq3 = my $indelType = my $old_seq1 = my $old_seq2 = my $old_seq3 = my $old_indelType = my $old_line = "";
- my $coord1 = my $coord2 = my $coord3 = my $old_coord1 = my $old_coord2 = my $old_coord3 = 0;
-
- my @matches = ();
- my @seq1_insert = my @seq1_delete = my @seq2_insert = my @seq2_delete = my @seq3_insert = my @seq3_delete = ();
-
-
- foreach my $line (@test){
- chomp($line);
- $line =~ s/^\s*//;
- $line =~ s/\s+/\t/g;
- my @line1 = split(/\t/, $line);
- $seq1 = $line1[1];
- $coord1 = $line1[2];
- $seq2 = $line1[4];
- $coord2 = $line1[5];
- $seq3 = $line1[7];
- $coord3 = $line1[8];
- $indelType = $line1[10];
- if ($indelType =~ m/$ingroup1/ && $indelType =~ m/insert/){
- if ($coord1 != $old_coord1+1 || ($coord2 != $old_coord2 || $coord3 != $old_coord3)){
- $start1++;
- push (@seq1_insert_startOnly,$line);
- }
- }
- elsif ($indelType =~ m/$ingroup1/ && $indelType =~ m/delete/){
- if ($coord1 != $old_coord1 || ($coord2 != $old_coord2+1 || $coord3 != $old_coord3+1)){
- $start2++;
- push(@seq1_delete_startOnly,$line);
- }
- }
- elsif ($indelType =~ m/$ingroup2/ && $indelType =~ m/insert/){
- if ($coord2 != $old_coord2+1 || ($coord1 != $old_coord1 || $coord3 != $old_coord3)){
- $start3++;
- push(@seq2_insert_startOnly,$line);
- }
- }
- elsif ($indelType =~ m/$ingroup2/ && $indelType =~ m/delete/){
- if ($coord2 != $old_coord2 || ($coord1 != $old_coord1+1 || $coord3 != $old_coord3+1)){
- $start4++;
- push(@seq2_delete_startOnly,$line);
- }
- }
- elsif ($indelType =~ m/$outgroup/ && $indelType =~ m/insert/){
- if ($coord3 != $old_coord3+1 || ($coord1 != $old_coord1 || $coord2 != $old_coord2)){
- $start5++;
- push(@seq3_insert_startOnly,$line);
- }
- }
- elsif ($indelType =~ m/$outgroup/ && $indelType =~ m/delete/){
- if ($coord3 != $old_coord3 || ($coord1 != $old_coord1+1 ||$coord2 != $old_coord2+1)){
- $start6++;
- push(@seq3_delete_startOnly,$line);
- }
- }
- $old_indelType = $indelType;
- $old_seq1 = $seq1;
- $old_coord1 = $coord1;
- $old_seq2 = $seq2;
- $old_coord2 = $coord2;
- $old_seq3 = $seq3;
- $old_coord3 = $coord3;
- $old_line = $line;
- }
-}
-# append lengths to each event start line
-my $counter1; my $counter2; my $counter3; my $counter4; my $counter5; my $counter6;
-my @final1 = my @final2 = my @final3 = my @final4 = my @final5 = my @final6 = ();
-my $final_line1 = my $final_line2 = my $final_line3 = my $final_line4 = my $final_line5 = my $final_line6 = "";
-
-
-for ($counter1 = 0; $counter1 < @seq3_insert_startOnly; $counter1++){
- $final_line1 = join("\t",($seq3_insert_startOnly[$counter1],$seq3_insert_lengths[$counter1]));
- push (@final1,$final_line1);
-}
-
-for ($counter2 = 0; $counter2 < @seq3_delete_startOnly; $counter2++){
- $final_line2 = join("\t",($seq3_delete_startOnly[$counter2],$seq3_delete_lengths[$counter2]));
- push(@final2,$final_line2);
-}
-
-for ($counter3 = 0; $counter3 < @seq2_insert_startOnly; $counter3++){
- $final_line3 = join("\t",($seq2_insert_startOnly[$counter3],$seq2_insert_lengths[$counter3]));
- push(@final3,$final_line3);
-}
-
-for ($counter4 = 0; $counter4 < @seq2_delete_startOnly; $counter4++){
- $final_line4 = join("\t",($seq2_delete_startOnly[$counter4],$seq2_delete_lengths[$counter4]));
- push(@final4,$final_line4);
-}
-
-for ($counter5 = 0; $counter5 < @seq1_insert_startOnly; $counter5++){
- $final_line5 = join("\t",($seq1_insert_startOnly[$counter5],$seq1_insert_lengths[$counter5]));
- push(@final5,$final_line5);
-}
-
-for ($counter6 = 0; $counter6 < @seq1_delete_startOnly; $counter6++){
- $final_line6 = join("\t",($seq1_delete_startOnly[$counter6],$seq1_delete_lengths[$counter6]));
- push(@final6,$final_line6);
-}
-
-# format final output
-# # if inserts, increase coords for the sequence inserted, other sequences give coords for 5' and 3' bases flanking the gap
-# # for deletes, increase coords for other 2 sequences and the one deleted give coords for 5' and 3' bases flanking the gap
-
-get_final_format(@final5);
-get_final_format(@final6);
-get_final_format(@final3);
-get_final_format(@final4);
-get_final_format(@final1);
-get_final_format(@final2);
-
-sub get_final_format{
- my (@final) = @_;
- foreach (@final){
- my $event_line = $_;
- my @events = split(/\t/, $event_line);
- my $event_type = $events[10];
- my @name_align1 = split(/:/, $events[1]);
- my @name_align2 = split(/:/, $events[4]);
- my @name_align3 = split(/:/, $events[7]);
- my $seq1_event_start = my $seq1_event_end = my $seq2_event_start = my $seq2_event_end = my $seq3_event_start = my $seq3_event_end = 0;
- my $final_event_line = "";
- # seq1_insert
- if ($event_type =~ m/$ingroup1/ && $event_type =~ m/insert/){
- # only increase coord for human
- # remember that other two sequnences, the gap spans (coord - 1) --> coord
- $seq1_event_start = ($events[2]);
- $seq1_event_end = ($events[2]+$events[11]-1);
- $seq2_event_start = ($events[5]-1);
- $seq2_event_end = ($events[5]);
- $seq3_event_start = ($events[8]-1);
- $seq3_event_end = ($events[8]);
- $final_event_line = join("\t",($events[0],$event_type,$events[11],$name_align1[0],$seq1_event_start,$seq1_event_end,$name_align1[1],$events[3],$name_align2[0],$seq2_event_start,$seq2_event_end,$name_align2[1],$events[6],$name_align3[0],$seq3_event_start,$seq3_event_end,$name_align3[1],$events[9]));
- }
- # seq1_delete
- elsif ($event_type =~ m/$ingroup1/ && $event_type =~ m/delete/){
- # only increase coords for seq2 and seq3
- # remember for seq1, the gap spans (coord - 1) --> coord
- $seq1_event_start = ($events[2]-1);
- $seq1_event_end = ($events[2]);
- $seq2_event_start = ($events[5]);
- $seq2_event_end = ($events[5]+$events[11]-1);
- $seq3_event_start = ($events[8]);
- $seq3_event_end = ($events[8]+$events[11]-1);
- $final_event_line = join("\t",($events[0],$event_type,$events[11],$name_align1[0],$seq1_event_start,$seq1_event_end,$name_align1[1],$events[3],$name_align2[0],$seq2_event_start,$seq2_event_end,$name_align2[1],$events[6],$name_align3[0],$seq3_event_start,$seq3_event_end,$name_align3[1],$events[9]));
- }
- # seq2_insert
- elsif ($event_type =~ m/$ingroup2/ && $event_type =~ m/insert/){
- # only increase coords for seq2
- # remember that other two sequnences, the gap spans (coord - 1) --> coord
- $seq1_event_start = ($events[2]-1);
- $seq1_event_end = ($events[2]);
- $seq2_event_start = ($events[5]);
- $seq2_event_end = ($events[5]+$events[11]-1);
- $seq3_event_start = ($events[8]-1);
- $seq3_event_end = ($events[8]);
- $final_event_line = join("\t",($events[0],$event_type,$events[11],$name_align1[0],$seq1_event_start,$seq1_event_end,$name_align1[1],$events[3],$name_align2[0],$seq2_event_start,$seq2_event_end,$name_align2[1],$events[6],$name_align3[0],$seq3_event_start,$seq3_event_end,$name_align3[1],$events[9]));
- }
- # seq2_delete
- elsif ($event_type =~ m/$ingroup2/ && $event_type =~ m/delete/){
- # only increase coords for seq1 and seq3
- # remember for seq2, the gap spans (coord - 1) --> coord
- $seq1_event_start = ($events[2]);
- $seq1_event_end = ($events[2]+$events[11]-1);
- $seq2_event_start = ($events[5]-1);
- $seq2_event_end = ($events[5]);
- $seq3_event_start = ($events[8]);
- $seq3_event_end = ($events[8]+$events[11]-1);
- $final_event_line = join("\t",($events[0],$event_type,$events[11],$name_align1[0],$seq1_event_start,$seq1_event_end,$name_align1[1],$events[3],$name_align2[0],$seq2_event_start,$seq2_event_end,$name_align2[1],$events[6],$name_align3[0],$seq3_event_start,$seq3_event_end,$name_align3[1],$events[9]));
- }
- # start testing w/seq3_insert
- elsif ($event_type =~ m/$outgroup/ && $event_type =~ m/insert/){
- # only increase coord for rheMac
- # remember that other two sequnences, the gap spans (coord - 1) --> coord
- $seq1_event_start = ($events[2]-1);
- $seq1_event_end = ($events[2]);
- $seq2_event_start = ($events[5]-1);
- $seq2_event_end = ($events[5]);
- $seq3_event_start = ($events[8]);
- $seq3_event_end = ($events[8]+$events[11]-1);
- $final_event_line = join("\t",($events[0],$event_type,$events[11],$name_align1[0],$seq1_event_start,$seq1_event_end,$name_align1[1],$events[3],$name_align2[0],$seq2_event_start,$seq2_event_end,$name_align2[1],$events[6],$name_align3[0],$seq3_event_start,$seq3_event_end,$name_align3[1],$events[9]));
- }
- # seq3_delete
- elsif ($event_type =~ m/$outgroup/ && $event_type =~ m/delete/){
- # only increase coords for seq1 and seq2
- # remember for seq3, the gap spans (coord - 1) --> coord
- $seq1_event_start = ($events[2]);
- $seq1_event_end = ($events[2]+$events[11]-1);
- $seq2_event_start = ($events[5]);
- $seq2_event_end = ($events[5]+$events[11]-1);
- $seq3_event_start = ($events[8]-1);
- $seq3_event_end = ($events[8]);
- $final_event_line = join("\t",($events[0],$event_type,$events[11],$name_align1[0],$seq1_event_start,$seq1_event_end,$name_align1[1],$events[3],$name_align2[0],$seq2_event_start,$seq2_event_end,$name_align2[1],$events[6],$name_align3[0],$seq3_event_start,$seq3_event_end,$name_align3[1],$events[9]));
-
- }
-
- print OFILE2 "$final_event_line\n";
- }
-}
-close OFILE2;
diff --git a/tools/regVariation/t_test_two_samples.pl b/tools/regVariation/t_test_two_samples.pl
deleted file mode 100644
index d5fb25a50d0..00000000000
--- a/tools/regVariation/t_test_two_samples.pl
+++ /dev/null
@@ -1,109 +0,0 @@
-# A program to implement the non-pooled t-test for two samples where the alternative hypothesis is two-sided or one-sided.
-# The first input file is a TABULAR format file representing the first sample and consisting of one column only.
-# The second input file is a TABULAR format file representing the first sample nd consisting of one column only.
-# The third input is the sidedness of the t-test: either two-sided or, one-sided with m1 less than m2 or,
-# one-sided with m1 greater than m2.
-# The fourth input is the equality status of the standard deviations of both populations
-# The output file is a TXT file representing the result of the two sample t-test.
-
-use strict;
-use warnings;
-
-#variable to handle the motif information
-my $motif;
-my $motifName = "";
-my $motifNumber = 0;
-my $totalMotifsNumber = 0;
-my @motifNamesArray = ();
-
-# check to make sure having correct files
-my $usage = "usage: non_pooled_t_test_two_samples_galaxy.pl [TABULAR.in] [TABULAR.in] [testSidedness] [standardDeviationEquality] [TXT.out] \n";
-die $usage unless @ARGV == 5;
-
-#get the input arguments
-my $firstSampleInputFile = $ARGV[0];
-my $secondSampleInputFile = $ARGV[1];
-my $testSidedness = $ARGV[2];
-my $standardDeviationEquality = $ARGV[3];
-my $outputFile = $ARGV[4];
-
-#open the input files
-open (INPUT1, "<", $firstSampleInputFile) || die("Could not open file $firstSampleInputFile \n");
-open (INPUT2, "<", $secondSampleInputFile) || die("Could not open file $secondSampleInputFile \n");
-open (OUTPUT, ">", $outputFile) || die("Could not open file $outputFile \n");
-
-
-#variables to store the name of the R script file
-my $r_script;
-
-# R script to implement the two-sample test on the motif frequencies in upstream flanking region
-#construct an R script file and save it in the same directory where the perl file is located
-$r_script = "non_pooled_t_test_two_samples.r";
-
-open(Rcmd,">", $r_script) or die "Cannot open $r_script \n\n";
-print Rcmd "
- sampleTable1 <- read.table(\"$firstSampleInputFile\", header=FALSE);
- sample1 <- sampleTable1[, 1];
-
- sampleTable2 <- read.table(\"$secondSampleInputFile\", header=FALSE);
- sample2 <- sampleTable2[, 1];
-
- testSideStatus <- \"$testSidedness\";
- STEqualityStatus <- \"$standardDeviationEquality\";
-
- #open the output a text file
- sink(file = \"$outputFile\");
-
- #check if the t-test is two-sided
- if (testSideStatus == \"two-sided\"){
-
- #check if the standard deviations are equal in both populations
- if (STEqualityStatus == \"equal\"){
- #two-sample t-test where standard deviations are assumed to be unequal, the test is two-sided
- testResult <- t.test(sample1, sample2, var.equal = TRUE);
- } else{
- #two-sample t-test where standard deviations are assumed to be unequal, the test is two-sided
- testResult <- t.test(sample1, sample2, var.equal = FALSE);
- }
- } else{ #the t-test is one sided
-
- #check if the t-test is two-sided with m1 < m2
- if (testSideStatus == \"one-sided:_m1_less_than_m2\"){
-
- #check if the standard deviations are equal in both populations
- if (STEqualityStatus == \"equal\"){
- #two-sample t-test where standard deviations are assumed to be unequal, the test is one-sided: Halt: m1 < m2
- testResult <- t.test(sample1, sample2, var.equal = TRUE, alternative = \"less\");
- } else{
- #two-sample t-test where standard deviations are assumed to be unequal, the test is one-sided: Halt: m1 < m2
- testResult <- t.test(sample1, sample2, var.equal = FALSE, alternative = \"less\");
- }
- } else{ #the t-test is one-sided with m1 > m2
- #check if the standard deviations are equal in both populations
- if (STEqualityStatus == \"equal\"){
- #two-sample t-test where standard deviations are assumed to be unequal, the test is one-sided: Halt: m1 < m2
- testResult <- t.test(sample1, sample2, var.equal = TRUE, alternative = \"greater\");
- } else{
- #two-sample t-test where standard deviations are assumed to be unequal, the test is one-sided: Halt: m1 < m2
- testResult <- t.test(sample1, sample2, var.equal = FALSE, alternative = \"greater\");
- }
- }
- }
-
- #save the output of the t-test into the output text file
- testResult;
-
- #close the output text file
- sink();
-
- #eof" . "\n";
-
-close Rcmd;
-
-system("R --no-restore --no-save --no-readline < $r_script > $r_script.out");
-
-#close the input and output files
-close(OUTPUT);
-close(INPUT2);
-close(INPUT1);
-
diff --git a/tools/regVariation/t_test_two_samples.xml b/tools/regVariation/t_test_two_samples.xml
deleted file mode 100644
index 1b2c75bf8a5..00000000000
--- a/tools/regVariation/t_test_two_samples.xml
+++ /dev/null
@@ -1,160 +0,0 @@
-
-
-
-
- t_test_two_samples.pl $inputFile1 $inputFile2 $inputTestSidedness3 $inputStandardDeviationEquality4 $outputFile1
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-.. class:: infomark
-
-**What it does**
-
-This program implements the non-pooled t-test for two samples where the alternative hypothesis is two-sided or one-sided. The program takes four inputs:
-
-- The first input file is a TABULAR format file representing the first sample and consisting of one column only.
-- The second input file is a TABULAR format file representing the first sample and consisting of one column only.
-- The third input is the sidedness of the t-test: either two-sided or, one-sided with m1 less than m2 or, one-sided with m1 greater than m2.
-- The fourth input is the equality status of the standard deviations of both populations.
-- The output file is a TXT file representing the result of the two-sample t-test.
-
-
-**Example**
-
-Let us have the first input file representing the first sample as follows::
-
- 5
- 4
- 8
- 6
- 7
- 2
- 1
- 1
- 0
- 6
- 4
- 5
- 7
- 5
- 3
- 2
- 5
- 8
- 7
- 6
- 4
-
-And the second input file representing the second sample as follows::
-
- 2
- 3
- 5
- 1
- 2
- 7
- 5
- 4
- 3
- 2
- 7
- 6
- 0
- 8
- 4
- 6
- 9
- 2
- 4
- 5
- 6
-
-Runnig the program and choosing "Two-sided" and "Equal" as parameters will give the following output::
-
- Two Sample t-test
-
- data: sample1 and sample2
- t = -0.3247, df = 40, p-value = 0.7471
- alternative hypothesis: true difference in means is not equal to 0
- 95 percent confidence interval:
- -1.720030 1.243839
- sample estimates:
- mean of x mean of y
- 4.333333 4.571429
-
-
-
-
-
diff --git a/tools/samtools/bam_to_sam.py b/tools/samtools/bam_to_sam.py
deleted file mode 100644
index 17fb8688ef7..00000000000
--- a/tools/samtools/bam_to_sam.py
+++ /dev/null
@@ -1,129 +0,0 @@
-#!/usr/bin/env python
-"""
-Converts BAM data to sorted SAM data.
-usage: bam_to_sam.py [options]
- --input1: SAM file to be converted
- --output1: output dataset in bam format
-"""
-
-import optparse, os, sys, subprocess, tempfile, shutil
-from galaxy import eggs
-import pkg_resources; pkg_resources.require( "bx-python" )
-from bx.cookbook import doc_optparse
-#from galaxy import util
-
-def stop_err( msg ):
- sys.stderr.write( '%s\n' % msg )
- sys.exit()
-
-def __main__():
- #Parse Command Line
- parser = optparse.OptionParser()
- parser.add_option( '', '--input1', dest='input1', help='The input SAM dataset' )
- parser.add_option( '', '--output1', dest='output1', help='The output BAM dataset' )
- parser.add_option( '', '--header', dest='header', action='store_true', default=False, help='Write SAM Header' )
- ( options, args ) = parser.parse_args()
-
- # output version # of tool
- try:
- tmp = tempfile.NamedTemporaryFile().name
- tmp_stdout = open( tmp, 'wb' )
- proc = subprocess.Popen( args='samtools 2>&1', shell=True, stdout=tmp_stdout )
- tmp_stdout.close()
- returncode = proc.wait()
- stdout = None
- for line in open( tmp_stdout.name, 'rb' ):
- if line.lower().find( 'version' ) >= 0:
- stdout = line.strip()
- break
- if stdout:
- sys.stdout.write( 'Samtools %s\n' % stdout )
- else:
- raise Exception
- except:
- sys.stdout.write( 'Could not determine Samtools version\n' )
-
- tmp_dir = tempfile.mkdtemp( dir='.' )
-
- try:
- # exit if input file empty
- if os.path.getsize( options.input1 ) == 0:
- raise Exception, 'Initial BAM file empty'
- # Sort alignments by leftmost coordinates. File .bam will be created. This command
- # may also create temporary files .%d.bam when the whole alignment cannot be fitted
- # into memory ( controlled by option -m ).
- tmp_sorted_aligns_file = tempfile.NamedTemporaryFile( dir=tmp_dir )
- tmp_sorted_aligns_file_base = tmp_sorted_aligns_file.name
- tmp_sorted_aligns_file_name = '%s.bam' % tmp_sorted_aligns_file.name
- tmp_sorted_aligns_file.close()
- command = 'samtools sort %s %s' % ( options.input1, tmp_sorted_aligns_file_base )
- tmp = tempfile.NamedTemporaryFile( dir=tmp_dir ).name
- tmp_stderr = open( tmp, 'wb' )
- proc = subprocess.Popen( args=command, shell=True, cwd=tmp_dir, stderr=tmp_stderr.fileno() )
- returncode = proc.wait()
- tmp_stderr.close()
- # get stderr, allowing for case where it's very large
- tmp_stderr = open( tmp, 'rb' )
- stderr = ''
- buffsize = 1048576
- try:
- while True:
- stderr += tmp_stderr.read( buffsize )
- if not stderr or len( stderr ) % buffsize != 0:
- break
- except OverflowError:
- pass
- tmp_stderr.close()
- if returncode != 0:
- raise Exception, stderr
- # exit if sorted BAM file empty
- if os.path.getsize( tmp_sorted_aligns_file_name) == 0:
- raise Exception, 'Intermediate sorted BAM file empty'
- except Exception, e:
- #clean up temp files
- if os.path.exists( tmp_dir ):
- shutil.rmtree( tmp_dir )
- stop_err( 'Error sorting alignments from (%s), %s' % ( options.input1, str( e ) ) )
-
-
- try:
- # Extract all alignments from the input BAM file to SAM format ( since no region is specified, all the alignments will be extracted ).
- if options.header:
- view_options = "-h"
- else:
- view_options = ""
- command = 'samtools view %s -o %s %s' % ( view_options, options.output1, tmp_sorted_aligns_file_name )
- tmp = tempfile.NamedTemporaryFile( dir=tmp_dir ).name
- tmp_stderr = open( tmp, 'wb' )
- proc = subprocess.Popen( args=command, shell=True, cwd=tmp_dir, stderr=tmp_stderr.fileno() )
- returncode = proc.wait()
- tmp_stderr.close()
- # get stderr, allowing for case where it's very large
- tmp_stderr = open( tmp, 'rb' )
- stderr = ''
- buffsize = 1048576
- try:
- while True:
- stderr += tmp_stderr.read( buffsize )
- if not stderr or len( stderr ) % buffsize != 0:
- break
- except OverflowError:
- pass
- tmp_stderr.close()
- if returncode != 0:
- raise Exception, stderr
- except Exception, e:
- #clean up temp files
- if os.path.exists( tmp_dir ):
- shutil.rmtree( tmp_dir )
- stop_err( 'Error extracting alignments from (%s), %s' % ( options.input1, str( e ) ) )
- #clean up temp files
- if os.path.exists( tmp_dir ):
- shutil.rmtree( tmp_dir )
- # check that there are results in the output file
- if os.path.getsize( options.output1 ) > 0:
- sys.stdout.write( 'BAM file converted to SAM' )
- else:
- stop_err( 'The output file is empty, there may be an error with your input file.' )
-
-if __name__=="__main__": __main__()
diff --git a/tools/samtools/bam_to_sam.xml b/tools/samtools/bam_to_sam.xml
deleted file mode 100644
index e9ea217c3f7..00000000000
--- a/tools/samtools/bam_to_sam.xml
+++ /dev/null
@@ -1,66 +0,0 @@
-
-
- samtools
-
- converts BAM format to SAM format
-
- bam_to_sam.py
- --input1=$input1
- --output1=$output1
- $header
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What it does**
-
-This tool uses the SAMTools_ toolkit to produce a SAM file from a BAM file.
-
-.. _SAMTools: http://samtools.sourceforge.net/samtools.shtml
-
-------
-
-**Citation**
-
-For the underlying tool, please cite `Li H, Handsaker B, Wysoker A, Fennell T, Ruan J, Homer N, Marth G, Abecasis G, Durbin R; 1000 Genome Project Data Processing Subgroup. The Sequence Alignment/Map format and SAMtools. Bioinformatics. 2009 Aug 15;25(16):2078-9. <http://www.ncbi.nlm.nih.gov/pubmed/19505943>`_
-
-
-
diff --git a/tools/samtools/pileup_interval.py b/tools/samtools/pileup_interval.py
deleted file mode 100644
index 455b8cad1e5..00000000000
--- a/tools/samtools/pileup_interval.py
+++ /dev/null
@@ -1,117 +0,0 @@
-#!/usr/bin/env python
-
-"""
-Condenses pileup format into ranges of bases.
-
-usage: %prog [options]
- -i, --input=i: Input pileup file
- -o, --output=o: Output pileup
- -c, --coverage=c: Coverage
- -f, --format=f: Pileup format
- -b, --base=b: Base to select
- -s, --seq_column=s: Sequence column
- -l, --loc_column=l: Base location column
- -r, --base_column=r: Reference base column
- -C, --cvrg_column=C: Coverage column
-"""
-
-from galaxy import eggs
-import pkg_resources; pkg_resources.require( "bx-python" )
-from bx.cookbook import doc_optparse
-import sys
-
-def stop_err( msg ):
- sys.stderr.write( msg )
- sys.exit()
-
-def __main__():
- strout = ''
- #Parse Command Line
- options, args = doc_optparse.parse( __doc__ )
- coverage = int(options.coverage)
- fin = file(options.input, 'r')
- fout = file(options.output, 'w')
- inLine = fin.readline()
- if options.format == 'six':
- seqIndex = 0
- locIndex = 1
- baseIndex = 2
- covIndex = 3
- elif options.format == 'ten':
- seqIndex = 0
- locIndex = 1
- if options.base == 'first':
- baseIndex = 2
- else:
- baseIndex = 3
- covIndex = 7
- else:
- seqIndex = int(options.seq_column) - 1
- locIndex = int(options.loc_column) - 1
- baseIndex = int(options.base_column) - 1
- covIndex = int(options.cvrg_column) - 1
- lastSeq = ''
- lastLoc = -1
- locs = []
- startLoc = -1
- bases = []
- while inLine.strip() != '':
- lineParts = inLine.split('\t')
- try:
- seq, loc, base, cov = lineParts[seqIndex], int(lineParts[locIndex]), lineParts[baseIndex], int(lineParts[covIndex])
- except IndexError, ei:
- if options.format == 'ten':
- stop_err( 'It appears that you have selected 10 columns while your file has 6. Make sure that the number of columns you specify matches the number in your file.\n' + str( ei ) )
- else:
- stop_err( 'There appears to be something wrong with your column index values.\n' + str( ei ) )
- except ValueError, ev:
- if options.format == 'six':
- stop_err( 'It appears that you have selected 6 columns while your file has 10. Make sure that the number of columns you specify matches the number in your file.\n' + str( ev ) )
- else:
- stop_err( 'There appears to be something wrong with your column index values.\n' + str( ev ) )
-# strout += str(startLoc) + '\n'
-# strout += str(bases) + '\n'
-# strout += '%s\t%s\t%s\t%s\n' % (seq, loc, base, cov)
- if loc == lastLoc+1 or lastLoc == -1:
- if cov >= coverage:
- if seq == lastSeq or lastSeq == '':
- if startLoc == -1:
- startLoc = loc
- locs.append(loc)
- bases.append(base)
- else:
- if len(bases) > 0:
- fout.write('%s\t%s\t%s\t%s\n' % (lastSeq, startLoc-1, lastLoc, ''.join(bases)))
- startLoc = loc
- locs = [loc]
- bases = [base]
- else:
- if len(bases) > 0:
- fout.write('%s\t%s\t%s\t%s\n' % (lastSeq, startLoc-1, lastLoc, ''.join(bases)))
- startLoc = -1
- locs = []
- bases = []
- else:
- if len(bases) > 0:
- fout.write('%s\t%s\t%s\t%s\n' % (lastSeq, startLoc-1, lastLoc, ''.join(bases)))
- if cov >= coverage:
- startLoc = loc
- locs = [loc]
- bases = [base]
- else:
- startLoc = -1
- locs = []
- bases = []
- lastSeq = seq
- lastLoc = loc
- inLine = fin.readline()
- if len(bases) > 0:
- fout.write('%s\t%s\t%s\t%s\n' % (lastSeq, startLoc-1, lastLoc, ''.join(bases)))
- fout.close()
- fin.close()
-
-# import sys
-# strout += file(fout.name,'r').read()
-# sys.stderr.write(strout)
-
-if __name__ == "__main__" : __main__()
diff --git a/tools/samtools/pileup_interval.xml b/tools/samtools/pileup_interval.xml
deleted file mode 100644
index 24c045ec6d6..00000000000
--- a/tools/samtools/pileup_interval.xml
+++ /dev/null
@@ -1,189 +0,0 @@
-
- condenses pileup format into ranges of bases
-
- samtools
-
-
- pileup_interval.py
- --input=$input
- --output=$output
- --coverage=$coverage
- --format=$format_type.format
- #if $format_type.format == "ten":
- --base=$format_type.which_base
- --seq_column="None"
- --loc_column="None"
- --base_column="None"
- --cvrg_column="None"
- #elif $format_type.format == "manual":
- --base="None"
- --seq_column=$format_type.seq_column
- --loc_column=$format_type.loc_column
- --base_column=$format_type.base_column
- --cvrg_column=$format_type.cvrg_column
- #else:
- --base="None"
- --seq_column="None"
- --loc_column="None"
- --base_column="None"
- --cvrg_column="None"
- #end if
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-**What is does**
-
-Reduces the size of a results set by taking a pileup file and producing a condensed version showing consecutive sequences of bases meeting coverage criteria. The tool works on six and ten column pileup formats produced with *samtools pileup* command. You also can specify columns for the input file manually. The tool assumes that the pileup dataset was produced by *samtools pileup* command (although you can override this by setting column assignments manually).
-
---------
-
-**Types of pileup datasets**
-
-The description of pileup format below is largely based on information that can be found on SAMTools_ documentation page. The 6- and 10-column variants are described below.
-
-.. _SAMTools: http://samtools.sourceforge.net/pileup.shtml
-
-**Six column pileup**::
-
- 1 2 3 4 5 6
- ---------------------------------
- chrM 412 A 2 ., II
- chrM 413 G 4 ..t, IIIH
- chrM 414 C 4 ...a III2
- chrM 415 C 4 TTTt III7
-
-where::
-
- Column Definition
- ------ ----------------------------
- 1 Chromosome
- 2 Position (1-based)
- 3 Reference base at that position
- 4 Coverage (# reads aligning over that position)
- 5 Bases within reads where (see Galaxy wiki for more info)
- 6 Quality values (phred33 scale, see Galaxy wiki for more)
-
-**Ten column pileup**
-
-The `ten-column`__ pileup incorporates additional consensus information generated with *-c* option of *samtools pileup* command::
-
-
- 1 2 3 4 5 6 7 8 9 10
- ------------------------------------------------
- chrM 412 A A 75 0 25 2 ., II
- chrM 413 G G 72 0 25 4 ..t, IIIH
- chrM 414 C C 75 0 25 4 ...a III2
- chrM 415 C T 75 75 25 4 TTTt III7
-
-where::
-
- Column Definition
- ------- ----------------------------
- 1 Chromosome
- 2 Position (1-based)
- 3 Reference base at that position
- 4 Consensus bases
- 5 Consensus quality
- 6 SNP quality
- 7 Maximum mapping quality
- 8 Coverage (# reads aligning over that position)
- 9 Bases within reads where (see Galaxy wiki for more info)
- 10 Quality values (phred33 scale, see Galaxy wiki for more)
-
-
-.. __: http://samtools.sourceforge.net/cns0.shtml
-
-------
-
-**The output format**
-
-The output file condenses the information in the pileup file so that consecutive bases are listed together as sequences. The starting and ending points of the sequence range are listed, with the starting value converted to a 0-based value.
-
-Given the following input with minimum coverage set to 3::
-
- 1 2 3 4 5 6
- ---------------------------------
- chr1 112 G 3 ..Ta III6
- chr1 113 T 2 aT.. III5
- chr1 114 A 5 ,,.. IIH2
- chr1 115 C 4 ,., III
- chrM 412 A 2 ., II
- chrM 413 G 4 ..t, IIIH
- chrM 414 C 4 ...a III2
- chrM 415 C 4 TTTt III7
- chrM 490 T 3 a I
-
-the following would be the output::
-
- 1 2 3 4
- -------------------
- chr1 111 112 G
- chr1 113 115 AC
- chrM 412 415 GCC
- chrM 489 490 T
-
-where::
-
- Column Definition
- ------- ----------------------------
- 1 Chromosome
- 2 Starting position (0-based)
- 3 Ending position (1-based)
- 4 Sequence of bases
-
-
-
-
-
diff --git a/tools/samtools/pileup_parser.pl b/tools/samtools/pileup_parser.pl
deleted file mode 100755
index 27b4126d0a9..00000000000
--- a/tools/samtools/pileup_parser.pl
+++ /dev/null
@@ -1,121 +0,0 @@
-#! /usr/bin/perl -w
-
-use strict;
-use POSIX;
-
-
-die "Usage: pileup_parser.pl