t/Map/Physical.t

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