code_perl/Maasha/test/test_AlignTwoSeq.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Test::More 'no_plan';
   6 use Data::Dumper;
   7 use Maasha::AlignTwoSeq;
   8
   9 test_new_space();
  10 test_new_space_left();
  11 test_new_space_right();
  12
  13 test_matches_select();
  14
  15 test_word_size_calc();
  16 test_seq_index();
  17 test_seq_scan();
  18 test_matches_find();
  19
  20 test_match_expand_forward_end_space();
  21 test_match_expand_forward_end_match();
  22 test_match_expand_backward_end_space();
  23 test_match_expand_backward_end_match();
  24 test_match_expand_end_space();
  25 test_match_expand_end_match();
  26
  27 test_match_redundant_add();
  28 test_match_redundant();
  29
  30 test_matches_filter();
  31
  32 test_match_score_narrow();
  33 test_match_score_diag();
  34 test_match_score_len();
  35 test_match_score();
  36
  37 test_align_two_seq();
  38
  39 test_insert_indels();
  40
  41
  42 sub test_new_space
  43 {
  44     my $space = { Q_SEQ => \"ATCG", S_SEQ => \"atcg" };
  45
  46     Maasha::AlignTwoSeq::new_space( $space );
  47
  48     is( ${ $space->{ 'Q_SEQ' } }, "ATCG" );
  49     is( ${ $space->{ 'S_SEQ' } }, "atcg" );
  50     ok( $space->{ 'Q_MIN' } == 0 );
  51     ok( $space->{ 'S_MIN' } == 0 );
  52     ok( $space->{ 'Q_MAX' } == 3 );
  53     ok( $space->{ 'S_MAX' } == 3 );
  54 }
  55
  56
  57 sub test_new_space_left
  58 {
  59     my ( $best_match, $space, $new_space );
  60
  61     $best_match = {
  62         Q_BEG => 2,
  63         Q_END => 3,
  64         S_BEG => 2,
  65         S_END => 3,
  66         SCORE => 0,
  67         LEN   => 2,
  68     };
  69
  70     $space = {
  71         Q_SEQ => \"ATCG",
  72         S_SEQ => \"atcg",
  73         Q_MIN => 0,
  74         S_MIN => 0,
  75         Q_MAX => 3,
  76         S_MAX => 3,
  77     };
  78
  79     $new_space = Maasha::AlignTwoSeq::new_space_left( $best_match, $space );
  80
  81     ok( defined $new_space );
  82     is( ${ $new_space->{ 'Q_SEQ' } }, "ATCG" );
  83     is( ${ $new_space->{ 'S_SEQ' } }, "atcg" );
  84     ok( $new_space->{ 'Q_MIN' } == 0 );
  85     ok( $new_space->{ 'S_MIN' } == 0 );
  86     ok( $new_space->{ 'Q_MAX' } == 1 );
  87     ok( $new_space->{ 'S_MAX' } == 1 );
  88 }
  89
  90
  91 sub test_new_space_right
  92 {
  93     my ( $best_match, $space, $new_space );
  94
  95     $best_match = {
  96         Q_BEG => 0,
  97         Q_END => 1,
  98         S_BEG => 0,
  99         S_END => 1,
 100         SCORE => 0,
 101         LEN   => 2,
 102     };
 103
 104     $space = {
 105         Q_SEQ => \"ATCG",
 106         S_SEQ => \"atcg",
 107         Q_MIN => 0,
 108         S_MIN => 0,
 109         Q_MAX => 3,
 110         S_MAX => 3,
 111     };
 112
 113     $new_space = Maasha::AlignTwoSeq::new_space_right( $best_match, $space );
 114
 115     ok( defined $new_space );
 116     is( ${ $new_space->{ 'Q_SEQ' } }, "ATCG" );
 117     is( ${ $new_space->{ 'S_SEQ' } }, "atcg" );
 118     ok( $new_space->{ 'Q_MIN' } == 2 );
 119     ok( $new_space->{ 'S_MIN' } == 2 );
 120     ok( $new_space->{ 'Q_MAX' } == 3 );
 121     ok( $new_space->{ 'S_MAX' } == 3 );
 122 }
 123
 124
 125 sub test_matches_select
 126 {
 127     my ( $matches, $space );
 128
 129     $matches = [
 130         { Q_BEG => 9,  S_BEG =>  9, Q_END => 10, S_END => 10 },
 131         { Q_BEG => 10, S_BEG => 10, Q_END => 20, S_END => 20 },
 132         { Q_BEG => 20, S_BEG => 20, Q_END => 21, S_END => 21 },
 133     ];
 134
 135     $space = {
 136         Q_SEQ => \"ATCG",
 137         S_SEQ => \"atcg",
 138         Q_MIN => 10,
 139         S_MIN => 10,
 140         Q_MAX => 20,
 141         S_MAX => 20,
 142     };
 143
 144     Maasha::AlignTwoSeq::matches_select( $matches, $space );
 145
 146     ok( scalar @{ $matches } == 1 );
 147 }
 148
 149
 150 sub test_word_size_calc
 151 {
 152     ok( Maasha::AlignTwoSeq::word_size_calc( { Q_MIN => 0, S_MIN => 0, Q_MAX => 1, S_MAX => 1 } ) == 1 );
 153     ok( Maasha::AlignTwoSeq::word_size_calc( { Q_MIN => 0, S_MIN => 0, Q_MAX => 200, S_MAX => 200 } ) == 10 + 1 );
 154 }
 155
 156
 157 sub test_seq_index
 158 {
 159     my ( $space, $word_size, $index );
 160
 161     $space = {
 162         Q_SEQ => \"ATCG",
 163         S_SEQ => \"atcg",
 164         Q_MIN => 0,
 165         S_MIN => 0,
 166         Q_MAX => 3,
 167         S_MAX => 3,
 168     };
 169
 170     $word_size = 2;
 171
 172     $index = Maasha::AlignTwoSeq::seq_index( $space, $word_size );
 173
 174     ok( scalar keys %{ $index } == 3 );
 175     ok( exists $index->{ 'AT' } );
 176     ok( exists $index->{ 'TC' } );
 177     ok( exists $index->{ 'CG' } );
 178     ok( $index->{ 'AT' }->[ 0 ] == 0 );
 179     ok( $index->{ 'TC' }->[ 0 ] == 1 );
 180     ok( $index->{ 'CG' }->[ 0 ] == 2 );
 181 }
 182
 183
 184 sub test_seq_scan
 185 {
 186     my ( $space, $word_size, $index, $matches );
 187
 188     $space = {
 189         Q_SEQ => \"ATCG",
 190         S_SEQ => \"atcg",
 191         Q_MIN => 0,
 192         S_MIN => 0,
 193         Q_MAX => 3,
 194         S_MAX => 3,
 195     };
 196
 197     $word_size = 2;
 198
 199     $index   = Maasha::AlignTwoSeq::seq_index( $space, $word_size );
 200     $matches = Maasha::AlignTwoSeq::seq_scan( $index, $space, $word_size );
 201
 202     ok( scalar @{ $matches } == 1 );
 203     ok( $matches->[ 0 ]->{ 'Q_BEG' } == 0 );
 204     ok( $matches->[ 0 ]->{ 'S_BEG' } == 0 );
 205     ok( $matches->[ 0 ]->{ 'Q_END' } == 3 );
 206     ok( $matches->[ 0 ]->{ 'S_END' } == 3 );
 207     ok( $matches->[ 0 ]->{ 'LEN' }   == 4 );
 208     ok( $matches->[ 0 ]->{ 'SCORE' } == 0 );
 209 }
 210
 211
 212 sub test_matches_find
 213 {
 214     my ( $space, $matches );
 215
 216     $space = { Q_SEQ => \"ATCG", S_SEQ => \"ATCG", Q_MIN => 0, S_MIN => 0, Q_MAX => 3, S_MAX => 3 };
 217
 218     $matches = Maasha::AlignTwoSeq::matches_find( $space );
 219
 220     ok( scalar @{ $matches } == 1 );
 221     ok( $matches->[ 0 ]->{ 'Q_BEG' } == 0 );
 222     ok( $matches->[ 0 ]->{ 'S_BEG' } == 0 );
 223     ok( $matches->[ 0 ]->{ 'Q_END' } == 3 );
 224     ok( $matches->[ 0 ]->{ 'S_END' } == 3 );
 225     ok( $matches->[ 0 ]->{ 'LEN' }   == 4 );
 226
 227     $space = { Q_SEQ => \"ATXXGAT", S_SEQ => \"ATCGAT", Q_MIN => 0, S_MIN => 0, Q_MAX => 6, S_MAX => 5 };
 228
 229     $matches = Maasha::AlignTwoSeq::matches_find( $space );
 230
 231     ok( scalar @{ $matches } == 4 );
 232     ok( $matches->[ 0 ]->{ 'Q_BEG' } == 0 );
 233     ok( $matches->[ 0 ]->{ 'S_BEG' } == 0 );
 234     ok( $matches->[ 0 ]->{ 'Q_END' } == 1 );
 235     ok( $matches->[ 0 ]->{ 'S_END' } == 1 );
 236     ok( $matches->[ 0 ]->{ 'LEN' }   == 2 );
 237     ok( $matches->[ 1 ]->{ 'Q_BEG' } == 5 );
 238     ok( $matches->[ 1 ]->{ 'S_BEG' } == 0 );
 239     ok( $matches->[ 1 ]->{ 'Q_END' } == 6 );
 240     ok( $matches->[ 1 ]->{ 'S_END' } == 1 );
 241     ok( $matches->[ 1 ]->{ 'LEN' }   == 2 );
 242     ok( $matches->[ 2 ]->{ 'Q_BEG' } == 4 );
 243     ok( $matches->[ 2 ]->{ 'S_BEG' } == 3 );
 244     ok( $matches->[ 2 ]->{ 'Q_END' } == 6 );
 245     ok( $matches->[ 2 ]->{ 'S_END' } == 5 );
 246     ok( $matches->[ 2 ]->{ 'LEN' }   == 3 );
 247     ok( $matches->[ 3 ]->{ 'Q_BEG' } == 0 );
 248     ok( $matches->[ 3 ]->{ 'S_BEG' } == 4 );
 249     ok( $matches->[ 3 ]->{ 'Q_END' } == 1 );
 250     ok( $matches->[ 3 ]->{ 'S_END' } == 5 );
 251     ok( $matches->[ 3 ]->{ 'LEN' }   == 2 );
 252 }
 253
 254 sub test_match_expand_forward_end_space
 255 {
 256     my ( $match, $space );
 257
 258     $match = {
 259         Q_BEG => 1,
 260         Q_END => 2,
 261         S_BEG => 1,
 262         S_END => 2,
 263         SCORE => 0,
 264         LEN   => 2,
 265     };
 266
 267     $space = {
 268         Q_SEQ => \"ATCG",
 269         S_SEQ => \"atcg",
 270         Q_MIN => 0,
 271         S_MIN => 0,
 272         Q_MAX => 3,
 273         S_MAX => 3,
 274     };
 275
 276     Maasha::AlignTwoSeq::match_expand_forward( $match, $space );
 277
 278     ok( $match->{ 'Q_BEG' } == 1 );
 279     ok( $match->{ 'S_BEG' } == 1 );
 280     ok( $match->{ 'Q_END' } == 3 );
 281     ok( $match->{ 'S_END' } == 3 );
 282     ok( $match->{ 'LEN' }   == 3 );
 283 }
 284
 285
 286 sub test_match_expand_forward_end_match
 287 {
 288     my ( $match, $space );
 289
 290     $match = {
 291         Q_BEG => 1,
 292         Q_END => 2,
 293         S_BEG => 1,
 294         S_END => 2,
 295         SCORE => 0,
 296         LEN   => 2,
 297     };
 298
 299     $space = {
 300         Q_SEQ => \"ATCGXX",
 301         S_SEQ => \"atcgnn",
 302         Q_MIN => 0,
 303         S_MIN => 0,
 304         Q_MAX => 6,
 305         S_MAX => 6,
 306     };
 307
 308     Maasha::AlignTwoSeq::match_expand_forward( $match, $space );
 309
 310     ok( $match->{ 'Q_BEG' } == 1 );
 311     ok( $match->{ 'S_BEG' } == 1 );
 312     ok( $match->{ 'Q_END' } == 3 );
 313     ok( $match->{ 'S_END' } == 3 );
 314     ok( $match->{ 'LEN' }   == 3 );
 315 }
 316
 317
 318 sub test_match_expand_backward_end_space
 319 {
 320     my ( $match, $space );
 321
 322     $match = {
 323         Q_BEG => 1,
 324         Q_END => 2,
 325         S_BEG => 1,
 326         S_END => 2,
 327         SCORE => 0,
 328         LEN   => 2,
 329     };
 330
 331     $space = {
 332         Q_SEQ => \"ATCG",
 333         S_SEQ => \"atcg",
 334         Q_MIN => 0,
 335         S_MIN => 0,
 336         Q_MAX => 3,
 337         S_MAX => 3,
 338     };
 339
 340     Maasha::AlignTwoSeq::match_expand_backward( $match, $space );
 341
 342     ok( $match->{ 'Q_BEG' } == 0 );
 343     ok( $match->{ 'S_BEG' } == 0 );
 344     ok( $match->{ 'Q_END' } == 2 );
 345     ok( $match->{ 'S_END' } == 2 );
 346     ok( $match->{ 'LEN' }   == 3 );
 347 }
 348
 349
 350 sub test_match_expand_backward_end_match
 351 {
 352     my ( $match, $space );
 353
 354     $match = {
 355         Q_BEG => 2,
 356         Q_END => 3,
 357         S_BEG => 2,
 358         S_END => 3,
 359         SCORE => 0,
 360         LEN   => 2,
 361     };
 362
 363     $space = {
 364         Q_SEQ => \"XATCG",
 365         S_SEQ => \"natcg",
 366         Q_MIN => 0,
 367         S_MIN => 0,
 368         Q_MAX => 4,
 369         S_MAX => 4,
 370     };
 371
 372     Maasha::AlignTwoSeq::match_expand_backward( $match, $space );
 373
 374     ok( $match->{ 'Q_BEG' } == 1 );
 375     ok( $match->{ 'S_BEG' } == 1 );
 376     ok( $match->{ 'Q_END' } == 3 );
 377     ok( $match->{ 'S_END' } == 3 );
 378     ok( $match->{ 'LEN' }   == 3 );
 379 }
 380
 381
 382 sub test_match_expand_end_space
 383 {
 384     my ( $match, $space );
 385
 386     $match = {
 387         Q_BEG => 1,
 388         Q_END => 2,
 389         S_BEG => 1,
 390         S_END => 2,
 391         SCORE => 0,
 392         LEN   => 2,
 393     };
 394
 395     $space = {
 396         Q_SEQ => \"ATCG",
 397         S_SEQ => \"atcg",
 398         Q_MIN => 0,
 399         S_MIN => 0,
 400         Q_MAX => 3,
 401         S_MAX => 3,
 402     };
 403
 404     Maasha::AlignTwoSeq::match_expand( $match, $space );
 405
 406     ok( $match->{ 'Q_BEG' } == 0 );
 407     ok( $match->{ 'S_BEG' } == 0 );
 408     ok( $match->{ 'Q_END' } == 3 );
 409     ok( $match->{ 'S_END' } == 3 );
 410     ok( $match->{ 'LEN' }   == 4 );
 411 }
 412
 413
 414 sub test_match_expand_end_match
 415 {
 416     my ( $match, $space );
 417
 418     $match = {
 419         Q_BEG => 2,
 420         Q_END => 3,
 421         S_BEG => 2,
 422         S_END => 3,
 423         SCORE => 0,
 424         LEN   => 2,
 425     };
 426
 427     $space = {
 428         Q_SEQ => \"XATCGX",
 429         S_SEQ => \"natcgn",
 430         Q_MIN => 0,
 431         S_MIN => 0,
 432         Q_MAX => 6,
 433         S_MAX => 6,
 434     };
 435
 436     Maasha::AlignTwoSeq::match_expand( $match, $space );
 437
 438     ok( $match->{ 'Q_BEG' } == 1 );
 439     ok( $match->{ 'S_BEG' } == 1 );
 440     ok( $match->{ 'Q_END' } == 4 );
 441     ok( $match->{ 'S_END' } == 4 );
 442     ok( $match->{ 'LEN' }   == 4 );
 443 }
 444
 445
 446 sub test_match_redundant_add
 447 {
 448     my ( $redundant );
 449
 450     $redundant = {};
 451
 452     Maasha::AlignTwoSeq::match_redundant_add( { Q_BEG => 10, Q_END => 20, S_BEG => 110, S_END => 120 }, $redundant );
 453     Maasha::AlignTwoSeq::match_redundant_add( { Q_BEG => 15, Q_END => 25, S_BEG => 210, S_END => 220 }, $redundant );
 454
 455     ok( scalar keys %{ $redundant } == 16 );
 456 }
 457
 458
 459 sub test_match_redundant
 460 {
 461     my ( $redundant );
 462
 463     $redundant = {};
 464
 465     Maasha::AlignTwoSeq::match_redundant_add( { Q_BEG => 10, Q_END => 20, S_BEG => 110, S_END => 120 }, $redundant );
 466     Maasha::AlignTwoSeq::match_redundant_add( { Q_BEG => 15, Q_END => 25, S_BEG => 210, S_END => 220 }, $redundant );
 467
 468     ok( Maasha::AlignTwoSeq::match_redundant( { Q_BEG => 10, Q_END => 20, S_BEG => 110, S_END => 120 }, $redundant ) );
 469     ok( not Maasha::AlignTwoSeq::match_redundant( { Q_BEG => 1, Q_END => 2, S_BEG => 110, S_END => 120 }, $redundant ) );
 470 }
 471
 472
 473 sub test_matches_filter
 474 {
 475     ok( 0 );
 476 }
 477
 478
 479 sub test_match_score_narrow
 480 {
 481     ok( 0 );
 482 }
 483
 484
 485 sub test_match_score_diag
 486 {
 487     ok( 0 );
 488 }
 489
 490
 491 sub test_match_score_len
 492 {
 493     ok( 0 );
 494 }
 495
 496
 497 sub test_match_score
 498 {
 499     ok( 0 );
 500 }
 501
 502
 503 sub test_align_two_seq
 504 {
 505     my ( $space, $matches );
 506
 507     $space = {
 508         Q_SEQ => \"ATXCG",
 509         S_SEQ => \"ATCG",
 510     };
 511
 512     $matches = Maasha::AlignTwoSeq::align_two_seq( $space, [] );
 513
 514 #    print Dumper( $matches );
 515
 516     ok( 0 );
 517 }
 518
 519
 520 sub test_insert_indels
 521 {
 522     my ( $matches, $q_seq, $s_seq );
 523
 524     $matches = [
 525         { Q_BEG => 1, S_BEG => 1, Q_END => 4, S_END => 4 }
 526     ];
 527
 528     $q_seq = "XATCG";
 529     $s_seq = "PATCG";
 530
 531     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 532
 533     is( $q_seq, "XATCG" );
 534     is( $s_seq, "PATCG" );
 535
 536     $matches = [
 537         { Q_BEG => 0, S_BEG => 1, Q_END => 3, S_END => 4 }
 538     ];
 539
 540     $q_seq = "ATCG";
 541     $s_seq = "PATCG";
 542
 543     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 544
 545     is( $q_seq, "-ATCG" );
 546     is( $s_seq, "PATCG" );
 547
 548     $matches = [
 549         { Q_BEG => 1, S_BEG => 0, Q_END => 4, S_END => 3 }
 550     ];
 551
 552     $q_seq = "XATCG";
 553     $s_seq = "ATCG";
 554
 555     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 556
 557     is( $q_seq, "XATCG" );
 558     is( $s_seq, "-ATCG" );
 559
 560     $matches = [
 561         { Q_BEG => 0, S_BEG => 0, Q_END => 3, S_END => 3 },
 562         { Q_BEG => 6, S_BEG => 6, Q_END => 9, S_END => 9 },
 563     ];
 564
 565     $q_seq = "ATCGXXATCG";
 566     $s_seq = "ATCGNNATCG";
 567
 568     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 569
 570     is( $q_seq, "ATCGXXATCG" );
 571     is( $s_seq, "ATCGNNATCG" );
 572
 573     $matches = [
 574         { Q_BEG => 0, S_BEG => 0, Q_END => 3, S_END => 3 },
 575         { Q_BEG => 6, S_BEG => 4, Q_END => 9, S_END => 7 },
 576     ];
 577
 578     $q_seq = "ATCGXXATCG";
 579     $s_seq = "ATCGATCG";
 580
 581     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 582
 583     is( $q_seq, "ATCGXXATCG" );
 584     is( $s_seq, "ATCG--ATCG" );
 585
 586     $matches = [
 587         { Q_BEG => 0, S_BEG => 1, Q_END => 2, S_END => 3 },
 588         { Q_BEG => 5, S_BEG => 4, Q_END => 8, S_END => 7 },
 589     ];
 590
 591     $q_seq = "TCGXXATCG";
 592     $s_seq = "ATCGATCG";
 593
 594     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 595
 596     is( $q_seq, "-TCGXXATCG" );
 597     is( $s_seq, "ATCG--ATCG" );
 598
 599     $matches = [
 600         { Q_BEG => 1, S_BEG => 0, Q_END => 3, S_END => 2 },
 601         { Q_BEG => 6, S_BEG => 3, Q_END => 9, S_END => 6 },
 602     ];
 603
 604     $q_seq = "ATCGXXATCG";
 605     $s_seq = "TCGATCG";
 606
 607     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 608
 609     is( $q_seq, "ATCGXXATCG" );
 610     is( $s_seq, "-TCG--ATCG" );
 611
 612     $matches = [
 613         { Q_BEG => 1, Q_END =>  3, S_BEG => 0, S_END => 2 },
 614         { Q_BEG => 6, Q_END =>  7, S_BEG => 3, S_END => 4 },
 615         { Q_BEG => 9, Q_END => 10, S_BEG => 7, S_END => 8 },
 616     ];
 617
 618     $q_seq = "ATCGXXATACG";
 619     $s_seq = "TCGATNTCG";
 620
 621     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 622
 623     is( $q_seq, "ATCGXXAT-ACG" );
 624     #             |||  ||  ||
 625     is( $s_seq, "-TCG--ATNTCG" );
 626
 627     $matches = [
 628         { Q_BEG => 1, Q_END =>  3, S_BEG => 0, S_END => 2 },
 629         { Q_BEG => 6, Q_END =>  7, S_BEG => 3, S_END => 4 },
 630         { Q_BEG => 9, Q_END => 10, S_BEG => 7, S_END => 8 },
 631     ];
 632
 633     $q_seq = "ATCGXXATACG";
 634     $s_seq = "TCGATNTCGXX";
 635
 636     Maasha::AlignTwoSeq::insert_indels( $matches, \$q_seq, \$s_seq );
 637
 638     is( $q_seq, "ATCGXXAT-ACG--" );
 639     #             |||  ||  ||
 640     is( $s_seq, "-TCG--ATNTCGXX" );
 641 }