t/Map.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 => 150);
  11
  12     use_ok('Bio::Map::SimpleMap');
  13     use_ok('Bio::Map::Marker');
  14     use_ok('Bio::Map::Position');
  15     use_ok('Bio::Map::Relative');
  16     use_ok('Bio::Map::Mappable');
  17 }
  18
  19 ###
  20 # We explicitly test Bio::Map::SimpleMap, Bio::Map::Mappable, Bio::Map::Position,
  21 # Bio::Map::Marker and Bio::Map::Relative.
  22 #
  23 # We implicitly test Bio::Map::MapI, Bio::Map::MappableI, Bio::Map::PositionI,
  24 # and Bio::Map::PositionHandler.
  25 ###
  26
  27 # Test map basics
  28 my $map;
  29 {
  30     ok $map = Bio::Map::SimpleMap->new(-name  => 'my');
  31     ok $map->type('cyto');
  32     is $map->type, 'cyto';
  33     is $map->units, '';
  34     is $map->length, 0, "Length is ". $map->length;
  35     is $map->name, 'my';
  36     is $map->species('human'), 'human';
  37     is $map->species, 'human';
  38     is $map->unique_id, '1';
  39 }
  40
  41 # Test marker basics
  42 my $marker;
  43 {
  44     # make a plane one and add details after
  45     ok $marker = Bio::Map::Marker->new();
  46     is $marker->name('gene1'), 'gene1';
  47     ok $marker->position($map, 100);
  48     is $marker->position->value, 100;
  49     is $marker->map, $map;
  50
  51     # make positions a little easier to add by setting a default map first
  52     ok my $marker2 = Bio::Map::Marker->new(-name => 'gene3');
  53     ok $map->add_element($marker2); # one way of setting default
  54     is $marker2->default_map, $map;
  55     $marker2 = Bio::Map::Marker->new(-name => 'gene3');
  56     ok $marker2->default_map($map); # the other way of setting default
  57     is $marker2->default_map, $map;
  58     ok $marker2->position(300);
  59     is $marker2->position->value, 300;
  60     ok my $position = $marker2->position();
  61     is $position->value, 300;
  62
  63     # make one with details set in new()
  64     ok my $marker3 = Bio::Map::Marker->new(-name => 'gene2', -position => [$map, 200]);
  65     is $marker3->default_map, $map;
  66     is $marker3->position->value, 200;
  67
  68     # make one with multiple positions on multiple maps
  69     my $map2 = Bio::Map::SimpleMap->new();
  70     $marker2->positions([[$map, 150], [$map, 200], [$map2, 200], [$map2, 400]]);
  71     my @p = map($_->numeric, $marker2->each_position);
  72     is $p[0], 150;
  73     is $p[1], 200;
  74     is $p[2], 200;
  75     is $p[3], 300;
  76     is $p[4], 400;
  77     $marker2->purge_positions($map2);
  78     @p = map($_->numeric, $marker2->each_position);
  79     is $p[0], 150;
  80     is $p[1], 200;
  81     is $p[2], 300;
  82
  83     # make sure we can add positions with 0 value
  84     my $map3 = Bio::Map::SimpleMap->new();
  85     $marker->add_position($map3, 0);
  86     ok my @positions = $marker->get_positions($map3);
  87     is @positions, 1;
  88     is $positions[0]->value, 0;
  89 }
  90
  91 # Test position basics
  92 my $pos;
  93 {
  94     ok $pos = Bio::Map::Position->new();
  95     ok $pos->map($map);
  96     is $pos->map(), $map;
  97     ok $pos->element($marker);
  98     is $pos->element(), $marker;
  99
 100     ok $pos->value('10');
 101     is $pos->value(), '10';
 102     is $pos->numeric, 10;
 103     is $pos->sortable, 10;
 104     is $pos->start, 10;
 105     is $pos->end, 10;
 106
 107     # give a marker a single position with explicit position creation
 108     ok $pos = Bio::Map::Position->new(-map => $map, -value => 500);
 109     ok $marker->position($pos);
 110     ok my $got_pos = $marker->position();
 111     is $got_pos, $pos;
 112     is $marker->position->value, 500;
 113
 114     # add a position
 115     my $map2 = Bio::Map::SimpleMap->new(-name => 'genethon', -type => 'Genetic');
 116     my $pos2 = Bio::Map::Position->new(-map => $map2, -value => 100);
 117     $marker->add_position($pos2);
 118     ok my @positions = $marker->get_positions($map2);
 119     is @positions, 1;
 120     is $positions[0]->value, 100;
 121 }
 122
 123 # Test interaction of Markers and Maps via Positions
 124 {
 125     # markers know what maps they are on
 126     $marker->purge_positions;
 127     is $marker->known_maps, 0;
 128     $pos->element($marker);
 129     is $marker->known_maps, 1;
 130     ok $marker->in_map(1);
 131     ok $marker->in_map($map);
 132
 133     # maps know what markers are on themselves
 134     $map->purge_positions;
 135     my @els = $map->get_elements;
 136     is @els, 0;
 137     $pos->map($map);
 138     ok my @elements = $map->get_elements;
 139     is @elements, 1;
 140     is $elements[0], $marker;
 141
 142     # positions know what marker they are for and what map they are on
 143     is $pos->map, $map;
 144     is $pos->element, $marker;
 145 }
 146
 147 # We can compare Map objects to their own kind
 148 {
 149     # positions to positions
 150     {
 151         ok $pos->equals($pos);
 152         # these get tested properly when testing Relative, later
 153     }
 154
 155     # markers to markers
 156     {
 157         ok $marker->equals($marker);
 158         # these get tested properly when testing Mappables, later
 159     }
 160
 161     # maps to maps
 162     {
 163         my $human = Bio::Map::SimpleMap->new();
 164         my $mouse = Bio::Map::SimpleMap->new();
 165         my $chicken = Bio::Map::SimpleMap->new();
 166         my $aardvark = Bio::Map::SimpleMap->new();
 167
 168         # scenario 1: we have information about where some factors bind upstream
 169         # of a gene in 4 different species. Which factors are found in all the
 170         # species?
 171         my $fac1 = Bio::Map::Mappable->new();
 172         my $pos1 = Bio::Map::Position->new(-map => $human, -element => $fac1);
 173         my $pos2 = Bio::Map::Position->new(-map => $mouse, -element => $fac1);
 174         my $pos3 = Bio::Map::Position->new(-map => $chicken, -element => $fac1);
 175         my $pos4 = Bio::Map::Position->new(-map => $aardvark, -element => $fac1);
 176         my $fac2 = Bio::Map::Mappable->new();
 177         my $pos5 = Bio::Map::Position->new(-map => $human, -element => $fac2);
 178         my $pos6 = Bio::Map::Position->new(-map => $mouse, -element => $fac2);
 179         my $pos7 = Bio::Map::Position->new(-map => $chicken, -element => $fac2);
 180         my $fac3 = Bio::Map::Mappable->new();
 181         my $pos8 = Bio::Map::Position->new(-map => $human, -element => $fac3);
 182         my $pos9 = Bio::Map::Position->new(-map => $mouse, -element => $fac3);
 183
 184         # scenario 1 answer:
 185         ok my @factors = $human->common_elements([$mouse, $chicken, $aardvark]);
 186         is @factors, 1;
 187         ok @factors = $human->common_elements([$mouse, $chicken, $aardvark], -min_percent => 50);
 188         is @factors, 3;
 189         ok @factors = $human->common_elements([$mouse, $chicken, $aardvark], -min_percent => 50, -min_num => 3);
 190         is @factors, 2;
 191         ok @factors = $chicken->common_elements([$mouse, $human, $aardvark], -min_percent => 50, -require_self => 1);
 192         is @factors, 2;
 193         ok @factors = Bio::Map::SimpleMap->common_elements([$human, $mouse, $human, $aardvark], -min_percent => 50, -required => [$aardvark]);
 194         is @factors, 1;
 195     }
 196 }
 197
 198 # Test relative positions
 199 {
 200     my $map = Bio::Map::SimpleMap->new();
 201     my $pos1 = Bio::Map::Position->new(-map => $map, -start => 50, -length => 5);
 202     my $pos2 = Bio::Map::Position->new(-map => $map, -start => 100, -length => 5);
 203     ok my $relative = Bio::Map::Relative->new(-position => $pos2);
 204     ok $pos1->relative($relative);
 205     is $pos1->start, 50;
 206     is $pos1->absolute(1), 1;
 207     is $pos1->start, 150;
 208     is $pos1->absolute(0), 0;
 209     ok my $relative2 = Bio::Map::Relative->new(-map => 10);
 210     my $pos3 = Bio::Map::Position->new(-map => $map, -element => $marker, -start => -5, -length => 5);
 211     $pos3->relative($relative2);
 212     my $relative3 = Bio::Map::Relative->new(-position => $pos3);
 213     is $pos1->start($relative3), 145;
 214     is $pos1->numeric($relative3), 145;
 215     is $pos1->end($relative3), 149;
 216
 217     # Test the RangeI-related methods on relative positions
 218     {
 219         my $pos1 = Bio::Map::Position->new(-map => $map, -start => 50, -length => 10);
 220         my $pos2 = Bio::Map::Position->new(-map => $map, -start => 100, -length => 10);
 221         my $pos3 = Bio::Map::Position->new(-map => $map, -start => 45, -length => 1);
 222         my $pos4 = Bio::Map::Position->new(-map => $map, -start => 200, -length => 1);
 223         my $relative = Bio::Map::Relative->new(-position => $pos3);
 224         my $relative2 = Bio::Map::Relative->new(-position => $pos4);
 225         ok ! $pos1->overlaps($pos2);
 226         $pos1->relative($relative);
 227         ok $pos1->overlaps($pos2);
 228         ok $pos2->overlaps($pos1);
 229         ok $pos1->overlaps($pos2, undef, $relative2);
 230
 231         # Make sure it works with normal Ranges
 232         use Bio::Range;
 233         my $range = Bio::Range->new(-start => 100, -end => 109);
 234         ok $pos1->overlaps($range);
 235         ok ! $range->overlaps($pos1);
 236         $pos1->absolute(1);
 237         ok $range->overlaps($pos1);
 238         $pos1->absolute(0);
 239
 240         # Try the other methods briefly
 241         ok my $i = $pos1->intersection($pos2); # returns a mappable
 242         ($i) = $i->get_positions; # but we're just interested in the first (and only) position of mappable
 243         is $i->toString, '100..104';
 244         ok $i = $pos1->intersection($pos2, undef, $relative2);
 245         ($i) = $i->get_positions;
 246         is $i->toString, '-100..-96';
 247         is $i->map, $map;
 248         is $i->relative, $relative2;
 249         $i->absolute(1);
 250         is $i->toString, '100..104';
 251
 252         ok my $u = $pos1->union($pos2);
 253         ($u) = $u->get_positions;
 254         is $u->toString, '95..109';
 255         ok $u = $pos1->union($pos2, $relative2);
 256         ($u) = $u->get_positions;
 257         is $u->toString, '-105..-91';
 258         is $u->map, $map;
 259         is $u->relative, $relative2;
 260         $u->absolute(1);
 261         is $u->toString, '95..109';
 262
 263         ok ! $pos1->contains($pos2);
 264         $pos2->end(104);
 265         ok $pos1->contains($pos2);
 266         ok $pos1->contains(100);
 267
 268         ok ! $pos1->equals($pos2);
 269         $pos2->start(95);
 270         ok $pos1->equals($pos2);
 271     }
 272 }
 273
 274 # Test Mappables
 275 {
 276     ok my $gene = Bio::Map::Mappable->new();
 277     my $human = Bio::Map::SimpleMap->new();
 278     my $mouse = Bio::Map::SimpleMap->new();
 279     ok my $pos1 = Bio::Map::Position->new(-map => $human, -element => $gene, -start => 50, -length => 1000);
 280     my $pos2 = Bio::Map::Position->new(-map => $mouse, -start => 100, -length => 1000);
 281     $gene->add_position($pos2);
 282     my $gene_rel = Bio::Map::Relative->new(-element => $gene);
 283
 284     # scenario 1a: we know where a TF binds upstream of a gene in human.
 285     # we use four different programs to predict the site; how good were they?
 286     # scenaria 1b: to what extent do the predictions and known agree?
 287     my $factor = Bio::Map::Mappable->new();
 288     my $pos3 = Bio::Map::Position->new(-map => $human, -element => $factor, -start => -25, -length => 10, -relative => $gene_rel);
 289     my $perfect_prediction = Bio::Map::Mappable->new();
 290     my $pos4 = Bio::Map::Position->new(-map => $human, -element => $perfect_prediction, -start => 25, -length => 10);
 291     my $good_prediction = Bio::Map::Mappable->new();
 292     my $pos5 = Bio::Map::Position->new(-map => $human, -element => $good_prediction, -start => 24, -length => 10);
 293     my $ok_prediction = Bio::Map::Mappable->new();
 294     my $pos6 = Bio::Map::Position->new(-map => $human, -element => $ok_prediction, -start => 20, -length => 10);
 295     my $bad_prediction = Bio::Map::Mappable->new();
 296     my $pos7 = Bio::Map::Position->new(-map => $human, -element => $bad_prediction, -start => 10, -length => 10);
 297
 298     # scenario 2: we have the same program making a prediciton for a site
 299     # in two different species; is the predicted site conserved in terms of
 300     # its position relative to the gene?
 301     my $human_prediction = Bio::Map::Mappable->new();
 302     my $pos8 = Bio::Map::Position->new(-map => $human, -element => $human_prediction, -start => 25, -length => 10);
 303     my $mouse_prediction = Bio::Map::Mappable->new();
 304     my $pos9 = Bio::Map::Position->new(-map => $mouse, -element => $mouse_prediction, -start => 75, -length => 10);
 305
 306     # Test the RangeI-related methods
 307     {
 308         # scenario 1a answers:
 309         ok $perfect_prediction->equals($factor);
 310         ok $perfect_prediction->contains($factor);
 311         ok ! $ok_prediction->equals($factor);
 312         ok $ok_prediction->overlaps($factor);
 313         ok ! $bad_prediction->overlaps($factor);
 314         ok $bad_prediction->less_than($factor);
 315         ok ! $bad_prediction->greater_than($factor);
 316         ok $factor->greater_than($bad_prediction);
 317
 318         # scenario 1b answer:
 319         my $predictions = [$perfect_prediction, $good_prediction, $ok_prediction, $bad_prediction];
 320         ok my @groups = $factor->overlapping_groups($predictions, -relative => $gene_rel);
 321         is @groups, 2;
 322         is ${$groups[0]}[0], $pos7;
 323         is ${$groups[1]}[0], $pos6;
 324         is ${$groups[1]}[1], $pos5;
 325         is ${$groups[1]}[2]->toString($gene_rel), $pos4->toString($gene_rel);
 326         is ${$groups[1]}[3]->toString($gene_rel), $pos3->toString($gene_rel);
 327         ok my $di = $factor->disconnected_intersections($predictions, -relative => $gene_rel, -min_mappables_num => 3);
 328         my @di = $di->get_positions;
 329         is @di, 1;
 330         is $di[0]->toString, '-25..-21';
 331         ok my $du = $factor->disconnected_unions($predictions, -relative => $gene_rel, -min_mappables_num => 3);
 332         my @du = $du->get_positions;
 333         is @du, 1;
 334         is $du[0]->toString, '-30..-16';
 335
 336         # test the flags on overlapping_groups a bit more
 337         @groups = $factor->overlapping_groups($predictions, -relative => $gene_rel, -min_pos_num => 2);
 338         is @groups, 1;
 339         @groups = $factor->overlapping_groups($predictions, -relative => $gene_rel, -min_pos_num => 1, -min_mappables_num => 2);
 340         is @groups, 1;
 341         @groups = $factor->overlapping_groups($predictions, -relative => $gene_rel, -min_pos_num => 1, -min_mappables_num => 1, -min_mappables_percent => 50);
 342         is @groups, 1;
 343         @groups = $factor->overlapping_groups($predictions, -relative => $gene_rel, -min_pos_num => 1, -min_mappables_num => 1, -min_mappables_percent => 5);
 344         is @groups, 2;
 345         @groups = $factor->overlapping_groups($predictions, -relative => $gene_rel, -require_self => 1);
 346         is @groups, 1;
 347         @groups = $factor->overlapping_groups($predictions, -relative => $gene_rel, -required => [$factor]);
 348         is @groups, 1;
 349
 350         # scenario 2 answer:
 351         ok ! $human_prediction->overlaps($mouse_prediction);
 352         ok $human_prediction->overlaps($mouse_prediction, -relative => $gene_rel);
 353     }
 354 }