t/Map/Physical.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use Bio::Root::Test;
   8
   9     test_begin(-tests => 40);
  10
  11     use_ok('Bio::Map::Physical');
  12     use_ok('Bio::MapIO');
  13 }
  14
  15 ok my $phm = Bio::Map::Physical->new();
  16 is $phm->version(2), 2;
  17 is $phm->version(), 2;
  18 is $phm->modification_user('me'), 'me';
  19 is $phm->modification_user(), 'me';
  20
  21 is $phm->group_type('xx'), 'xx';
  22 is $phm->group_type(), 'xx';
  23
  24 is $phm->group_abbr('xx'), 'xx';
  25 is $phm->group_abbr(), 'xx';
  26
  27 is $phm->core_exists, undef, 'code holds and returns a string, definition requires a boolean';
  28
  29 is $phm->core_exists(3), 1, 'code holds and returns a string, definition requires a boolean';
  30
  31 is $phm->core_exists(1), 1;
  32 is $phm->core_exists(), 1;
  33
  34 my $fpcpath = test_input_file('biofpc.fpc');
  35
  36 # TODO? get Bio::MapIO::fpc to load from a Bio::MapIO call
  37 my $mapio = Bio::MapIO->new(-format => "fpc", -species => 'demo', -readcor => 1, -file => $fpcpath);
  38 my $fobj = $mapio->next_map();
  39
  40 is $fobj->group_abbr(), "Chr";
  41 is $fobj->core_exists(), 1;
  42
  43 test_clones($fobj);
  44 test_contigs($fobj);
  45 test_markers($fobj);
  46
  47 #########################################################
  48
  49 sub test_markers
  50 {
  51     my $nmrk = 0;
  52     my $nrem = 0;
  53     my %types;
  54     my $nanch = 0;
  55     my $nfrm = 0;
  56     my %grps;
  57     my $pos = 0;
  58     my @ctgpos;
  59
  60     my $f = shift;
  61     foreach my $mid ($f->each_markerid())
  62     {
  63         $nmrk++;
  64         my $mobj = $f->get_markerobj($mid);
  65         if (not defined $mobj)
  66         {
  67             is 1, 0;
  68             next;
  69         }
  70         my @remarks = split /\n/, $mobj->remark();
  71         $nrem += scalar(@remarks);
  72         $types{$mobj->type()} = 1;
  73         if ($mobj->anchor())
  74         {
  75             $nanch++;
  76             $grps{$mobj->group()} = 1;
  77             $pos += $mobj->global();
  78         }
  79         if ($mobj->framework())
  80         {
  81             $nfrm++;
  82         }
  83         foreach my $ctgid ($f->each_contigid())
  84         {
  85             push @ctgpos, $mobj->position($ctgid);
  86         }
  87     }
  88     is $nmrk, 15;
  89     is $nrem, 17;
  90     is scalar(keys %types), 2;
  91     is $nanch, 9;
  92     is $nfrm, 7;
  93     is scalar (keys %grps), 4;
  94     is $pos, 36;
  95     is @ctgpos, 165;
  96     my $sum = 0;
  97     $sum += $_ for @ctgpos;
  98     is $sum, 1177;
  99 }
 100
 101 #########################################################
 102
 103 sub test_contigs
 104 {
 105     my $f = shift;
 106     my $nchr = 0;
 107     my $nuser = 0;
 108     my $ntrace = 0;
 109     my $nctg = 0;
 110     my $ncb = 0;
 111     my $psum = 0;
 112     my %grps;
 113
 114     foreach my $cid ($f->each_contigid())
 115     {
 116         $nctg++;
 117         my $cobj = $f->get_contigobj($cid);
 118         if (not defined $cobj)
 119         {
 120             is 1, 0;
 121             next;
 122         }
 123         if ($cobj->chr_remark() ne "")
 124         {
 125             $nchr++;
 126         }
 127         if ($cobj->user_remark() eq "test")
 128         {
 129             $nuser++;
 130         }
 131         if ($cobj->trace_remark() eq "test")
 132         {
 133             $ntrace++;
 134         }
 135         if ($cid > 0)
 136         {
 137             $ncb += ($cobj->range()->end() - $cobj->range()->start() + 1);
 138         }
 139         if ($cobj->anchor())
 140         {
 141             $psum += $cobj->position();
 142             $grps{$cobj->group()} = 1;
 143         }
 144     }
 145     is $nctg, 11;
 146     is $nchr, 3;
 147     is $nuser, 1;
 148     is $ntrace, 1;
 149     is $ncb, 880;
 150     is $psum, 15.55;
 151     is scalar(keys %grps), 3;
 152 }
 153
 154 #########################################################
 155
 156 sub test_clones
 157 {
 158     my $f = shift;
 159     my $nclones = 0;
 160     my $nbands = 0;
 161     my $nrem = 0;
 162     my %ctgs;
 163     my $nmrkhits = 0;
 164     my $nfprem = 0;
 165     my %stati;
 166     foreach my $cid ($f->each_cloneid())
 167     {
 168         $nclones++;
 169         my $cobj = $f->get_cloneobj($cid);
 170         if (not defined $cobj)
 171         {
 172             is 1, 0;
 173             next;
 174         }
 175         my $pbands = $cobj->bands();
 176         $nbands += scalar(@$pbands);
 177         $ctgs{$cobj->contigid()} = 1;
 178         if ($cobj->contigid() > 0)
 179         {
 180             if (not defined $cobj->range()->start() or
 181                 not defined $cobj->range()->end() or
 182                 $cobj->range()->end() < $cobj->range()->start())
 183             {
 184                 is 1, 0;
 185             }
 186         }
 187         foreach my $mid ($cobj->each_markerid())
 188         {
 189             $nmrkhits++;
 190         }
 191         my @remarks;
 192         if ($cobj->remark) {
 193             @remarks = split /\n/, $cobj->remark();
 194             $nrem += scalar(@remarks);
 195         }
 196         if ($cobj->fpc_remark) {
 197             @remarks = split /\n/, $cobj->fpc_remark();
 198             $nfprem += scalar(@remarks);
 199         }
 200         $stati{$cobj->sequence_status()} = 1 if $cobj->sequence_status;
 201     }
 202     is $nclones, 355;
 203     is $nbands, 9772;
 204     is scalar(keys %ctgs), 11;
 205     is $nmrkhits, 46;
 206     is $nrem, 12;
 207     is $nfprem, 162;
 208     is scalar(keys %stati), 5;
 209 }