t/PhysicalMap.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib 't/lib';
   8     use BioperlTest;
   9
  10     test_begin(-tests => 39);
  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 = 0;
  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             $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, 1249;
  97 }
  98
  99 #########################################################
 100
 101 sub test_contigs
 102 {
 103     my $f = shift;
 104     my $nchr = 0;
 105     my $nuser = 0;
 106     my $ntrace = 0;
 107     my $nctg = 0;
 108     my $ncb = 0;
 109     my $psum = 0;
 110     my %grps;
 111
 112     foreach my $cid ($f->each_contigid())
 113     {
 114         $nctg++;
 115         my $cobj = $f->get_contigobj($cid);
 116         if (not defined $cobj)
 117         {
 118             is 1, 0;
 119             next;
 120         }
 121         if ($cobj->chr_remark() ne "")
 122         {
 123             $nchr++;
 124         }
 125         if ($cobj->user_remark() eq "test")
 126         {
 127             $nuser++;
 128         }
 129         if ($cobj->trace_remark() eq "test")
 130         {
 131             $ntrace++;
 132         }
 133         if ($cid > 0)
 134         {
 135             $ncb += ($cobj->range()->end() - $cobj->range()->start() + 1);
 136         }
 137         if ($cobj->anchor())
 138         {
 139             $psum += $cobj->position();
 140             $grps{$cobj->group()} = 1;
 141         }
 142     }
 143     is $nctg, 11;
 144     is $nchr, 3;
 145     is $nuser, 1;
 146     is $ntrace, 1;
 147     is $ncb, 880;
 148     is $psum, 15.55;
 149     is scalar(keys %grps), 3;
 150 }
 151
 152 #########################################################
 153
 154 sub test_clones
 155 {
 156     my $f = shift;
 157     my $nclones = 0;
 158     my $nbands = 0;
 159     my $nrem = 0;
 160     my %ctgs;
 161     my $nmrkhits = 0;
 162     my $nfprem = 0;
 163     my %stati;
 164     foreach my $cid ($f->each_cloneid())
 165     {
 166         $nclones++;
 167         my $cobj = $f->get_cloneobj($cid);
 168         if (not defined $cobj)
 169         {
 170             is 1, 0;
 171             next;
 172         }
 173         my $pbands = $cobj->bands();
 174         $nbands += scalar(@$pbands);
 175         $ctgs{$cobj->contigid()} = 1;
 176         if ($cobj->contigid() > 0)
 177         {
 178             if (not defined $cobj->range()->start() or
 179                 not defined $cobj->range()->end() or
 180                 $cobj->range()->end() < $cobj->range()->start())
 181             {
 182                 is 1, 0;
 183             }
 184         }
 185         foreach my $mid ($cobj->each_markerid())
 186         {
 187             $nmrkhits++;
 188         }
 189         my @remarks;
 190         if ($cobj->remark) {
 191             @remarks = split /\n/, $cobj->remark();
 192             $nrem += scalar(@remarks);
 193         }
 194         if ($cobj->fpc_remark) {
 195             @remarks = split /\n/, $cobj->fpc_remark();
 196             $nfprem += scalar(@remarks);
 197         }
 198         $stati{$cobj->sequence_status()} = 1 if $cobj->sequence_status;
 199     }
 200     is $nclones, 355;
 201     is $nbands, 9772;
 202     is scalar(keys %ctgs), 11;
 203     is $nmrkhits, 46;
 204     is $nrem, 12;
 205     is $nfprem, 162;
 206     is scalar(keys %stati), 5;
 207 }