t/consed.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 #####
   5 #
   6 # this script simply tests parsing ace* files
   7 # - it cares nothing about the chromat_dir,phd_dir,edit_dir types of things
   8 #
   9 #####
  10
  11 use strict;
  12
  13 BEGIN {
  14     use lib 't/lib';
  15         use BioperlTest;
  16
  17         test_begin(-tests => 15,
  18                            -excludes_os => 'mswin');
  19
  20         use_ok('Bio::Tools::Alignment::Consed');
  21 }
  22
  23 my $DEBUG = test_debug();
  24
  25 # scope some variables
  26 my($o_consed,@singlets,@singletons,@pairs,@doublets,@multiplets,$invoker);
  27
  28 # instantiate a new object
  29 my $passed_in_acefile = test_input_file('acefile.ace.1');
  30 $o_consed = Bio::Tools::Alignment::Consed->new(-acefile => $passed_in_acefile);
  31 ok defined $o_consed, 'new CSM::Consed object was created';
  32
  33 $o_consed->verbose($DEBUG);
  34
  35 isa_ok($o_consed,'Bio::Tools::Alignment::Consed');
  36
  37 isnt($o_consed->set_singlets(), 1,  'singlets can be successfully set');
  38
  39 @singlets = $o_consed->get_singlets();
  40 is (scalar(@singlets), 65, 'singlets can be retrieved');
  41
  42 isnt ($o_consed->set_doublets(), 1, 'doublets can be set');
  43
  44 ok @doublets = $o_consed->get_doublets(), 'doublets can be retreived';
  45
  46 print(scalar(@doublets)." doublets were found\n") if ($DEBUG > 0);
  47 is (scalar(@doublets), 45, 'doublets can be retrieved');
  48
  49 @pairs = $o_consed->get_pairs();
  50 is (scalar(@pairs),1, 'pairs can be retrieved');
  51
  52 @multiplets = $o_consed->get_multiplets();
  53 is (scalar(@multiplets), 4, 'multiplets can be retrieved');
  54
  55 @singletons = $o_consed->get_singletons();
  56 is (scalar(@singletons), 3, 'singletons can be retrieved');
  57 my($total_object_sequences, $total_grep_sequences);
  58 is($total_grep_sequences = $o_consed->count_sequences_with_grep(), 179, 'how many sequences there are in the acefile _and_ in the singlets file');
  59
  60 is($total_object_sequences = $o_consed->sum_lets("total_only"),179, 'statistics from the Bio::Tools::Alignment::Consed object to compare the total number of sequences accounted for there to the number of sequences found via grep');
  61 print("Match?\n") if($DEBUG > 0) ;
  62 is ($total_object_sequences, $total_grep_sequences);
  63
  64 print("These are the statistics. Look right? ".$o_consed->sum_lets()."\n") if($DEBUG > 0);
  65 is($o_consed->sum_lets(),'Singt/singn/doub/pair/mult/total : 65,3,45(90),1(2),4(19),179');
  66
  67 print("Dumping out the hash in a compact way...\n")if($DEBUG > 0)  ;
  68 $o_consed->dump_hash_compact() if($DEBUG > 0)  ;
  69
  70 # print("Dumping out the hash in an ugly way...\n");
  71 # $o_consed->dump_hash();
  72
  73 sub allele_script {
  74         my($a,$trunc,$rev);
  75         ok defined $a,
  76         isa_ok $a, 'Bio::Variation::Allele';
  77
  78         is $a->accession_number(), 'X677667';
  79         is $a->seq(), 'ACTGACTGACTG';
  80         is $a->display_id(),'new-id' ;
  81         is $a->desc, 'Sample Bio::Seq object';
  82         is $a->moltype(), 'dna';
  83
  84         ok defined($trunc = $a->trunc(1,4));
  85         is $trunc->seq(), 'ACTG', "Expecting ACTG. Got ". $trunc->seq();
  86
  87         ok defined($rev = $a->revcom());
  88         is $rev->seq(), 'CAGTCAGTCAGT';
  89
  90         $a->is_reference(1);
  91         ok $a->is_reference;
  92
  93         $a->repeat_unit('ACTG');
  94         is $a->repeat_unit, 'ACTG';
  95
  96         $a->repeat_count(3);
  97         is $a->repeat_count, 3;
  98 }