t/PhysicalMap.t

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