lib/CXGN/Cview/Map/SGN/Genetic.pm

   1 package CXGN::Cview::Map::SGN::Genetic;
   2
   3 =head1 NAME
   4
   5 CXGN::Cview::Map::SGN::Genetic - a class implementing a genetic map
   6
   7 =head1 DESCRIPTION
   8
   9 This class implements a genetic map populated from the SGN database. This class inherits from L<CXGN::Cview::Map>.
  10
  11 Note: the common name (available through get_common_name()) for the map organism is now taken through the following join: sgn.accession -> public.organism -> sgn.organismgroup_member ->sgn.organism_group (July 2010).
  12
  13 =head1 AUTHOR(S)
  14
  15 Lukas Mueller <lam87@cornell.edu>
  16
  17 =head1 FUNCTIONS
  18
  19 This class implements the following functions (for more information, see L<CXGN::Cview::Map>):
  20
  21 =cut
  22
  23 use strict;
  24 use warnings;
  25
  26 use CXGN::Cview::Legend::Genetic;
  27 use CXGN::Cview::Map;
  28 use CXGN::Cview::Map::Tools;
  29
  30 use base qw | CXGN::Cview::Map |;
  31
  32 =head2 function new
  33
  34   Synopsis:     my $genetic = CXGN::Cview::Map::SGN::Genetic->
  35                   new( $dbh, $map_version_id);
  36   Arguments:    (1) a database handle, preferably generated with
  37                     CXGN::DB::Connection
  38                 (2) the map version id for the desired map.
  39   Returns:      a Genetic map object
  40   Side effects: accesses the database
  41   Description:
  42
  43 =cut
  44
  45 sub new {
  46     my $class = shift;
  47     my $dbh = shift;
  48     my $map_version_id = shift;
  49
  50     my $self = $class->SUPER::new($dbh);
  51     $self->set_id($map_version_id);
  52     $self->fetch();
  53
  54     # set some defaults
  55     $self->set_preferred_chromosome_width(20);
  56
  57     # fetch the chromosome lengths
  58     #
  59     my $query = "SELECT lg_name, max(position) FROM sgn.linkage_group JOIN sgn.marker_location USING(lg_id) WHERE linkage_group.map_version_id=? GROUP BY lg_name, lg_order ORDER BY lg_order";
  60     my $sth = $self->get_dbh()->prepare($query);
  61     $sth->execute($self->get_id());
  62     my @chromosome_lengths = ();
  63     while (my ($lg_name, $length) = $sth->fetchrow_array()) {
  64         push @chromosome_lengths, $length;
  65     }
  66     $self->set_chromosome_lengths(@chromosome_lengths);
  67
  68     if ($self->get_chromosome_count() == 0) { return undef; }
  69
  70     my $legend = CXGN::Cview::Legend::Genetic->new($self);
  71 #    $legend->set_mode("marker_types");
  72     $self->set_legend($legend);
  73
  74     $self->set_marker_link("/search/markers/markerinfo.pl?marker_id=");
  75
  76     return $self;
  77 }
  78
  79 sub fetch {
  80     my $self = shift;
  81
  82     # get the map metadata
  83     #
  84     my $query = "
  85          SELECT map_version_id, map_type, short_name, long_name,
  86                 parent1_stock_id, parent2_stock_id,
  87                 abstract, public.organism.species, organismgroup.name
  88          FROM sgn.map JOIN sgn.map_version using(map_id)
  89               LEFT JOIN public.stock on(parent1_stock_id=stock.stock_id)
  90               LEFT JOIN public.organism on (stock.organism_id=public.organism.organism_id)
  91               LEFT JOIN sgn.organismgroup_member on (stock.organism_id=organismgroup_member.organism_id)
  92               LEFT JOIN sgn.organismgroup using(organismgroup_id)
  93          WHERE map_version_id=?";
  94
  95     my $sth = $self->get_dbh()->prepare($query);
  96     $sth->execute($self->get_id());
  97     my ($map_version_id, $map_type, $short_name, $long_name, $parent1_stock_id, $parent2_stock_id, $abstract, $organism_name, $common_name) = $sth->fetchrow_array();
  98     $self->set_id($map_version_id);
  99     $self->set_type($map_type);
 100     $self->set_short_name($short_name);
 101     $self->set_long_name($long_name);
 102     $self->set_parent1_stock_id($parent1_stock_id);
 103     $self->set_parent2_stock_id($parent2_stock_id);
 104     $self->set_abstract($abstract);
 105     $self->set_organism($organism_name);
 106     $self->set_common_name($common_name);
 107     $self->set_units("cM");
 108
 109     # get information about associated linkage_groups
 110     #
 111     my $chr_name_q = "SELECT distinct(linkage_group.lg_name), lg_order FROM sgn.linkage_group WHERE map_version_id=? ORDER BY lg_order";
 112     my $chr_name_h = $self->get_dbh()->prepare($chr_name_q);
 113     $chr_name_h->execute($self->get_id());
 114     my @names = ();
 115     while (my ($lg_name) = $chr_name_h->fetchrow_array()) {
 116         push @names, $lg_name;
 117     }
 118     $self->set_chromosome_names(@names);
 119     $self->set_chromosome_count(scalar(@names));
 120     $self->set_preferred_chromosome_width(20);
 121
 122     # get the location of  the centromeres
 123     #
 124     my $centromere_q = "SELECT lg_name, min(position) as north_centromere, max(position) as south_centromere FROM linkage_group left join marker_location on (north_location_id=location_id or south_location_id=location_id) where linkage_group.map_version_id=? group by linkage_group.lg_id, linkage_group.map_version_id, lg_order, lg_name order by lg_order";
 125     my $centromere_h = $self->get_dbh()->prepare($centromere_q);
 126     $centromere_h->execute($self->get_id());
 127     while (my ($lg_name, $north, $south) = $centromere_h->fetchrow_array()) {
 128         $self->set_centromere($lg_name, $north, $south);
 129     }
 130
 131
 132 }
 133
 134 =head2 function get_chromosome
 135   Synopsis:     see L<CXGN::Cview::Map>
 136   Arguments:
 137   Returns:
 138   Side effects:
 139   Description:
 140
 141 =cut
 142
 143 sub get_chromosome {
 144     my $self = shift;
 145     my $chr_nr = shift;
 146 #    my $marker_confidence_cutoff = shift; # the confidence cutoff. 3=frame 2=coseg 1=interval LOD=2 0=interval
 147
 148 #    if (!$marker_confidence_cutoff) { $marker_confidence_cutoff=-1; }
 149
 150     my $chromosome = CXGN::Cview::Chromosome->new();
 151     $chromosome->set_name($chr_nr);
 152     $chromosome->set_caption($chr_nr);
 153
 154     my %seq_bac = ();
 155
 156     my $physical = 'physical';
 157
 158     if ($self->get_id() == CXGN::Cview::Map::Tools::find_current_version($self->get_dbh(), CXGN::Cview::Map::Tools::current_tomato_map_id())) {
 159
 160         # get the sequenced BACs
 161         #
 162         my $Sequenced_BAC_query =
 163         "
 164             SELECT
 165                 distinct $physical.bac_marker_matches.bac_id,
 166                 $physical.bac_marker_matches.cornell_clone_name,
 167                 $physical.bac_marker_matches.marker_id,
 168                 $physical.bac_marker_matches.position
 169             FROM
 170                 $physical.bac_marker_matches
 171                 LEFT JOIN sgn.linkage_group USING (lg_id)
 172                 LEFT JOIN sgn_people.bac_status USING (bac_id)
 173             WHERE
 174                 sgn.linkage_group.lg_name=?
 175                 AND sgn_people.bac_status.status='complete'
 176         ";
 177         my $sth2 = $self->get_dbh->prepare($Sequenced_BAC_query);
 178         $sth2->execute($chr_nr);
 179         while (my ($bac_id, $name, $marker_id, $offset)=$sth2->fetchrow_array()) {
 180 # print STDERR "Sequenced BAC for: $bac_id, $name, $marker_id, $offset...\n";
 181             $name = CXGN::Genomic::Clone->retrieve($bac_id)->clone_name();
 182
 183             my $m = CXGN::Cview::Marker::SequencedBAC->new($chromosome, $bac_id, $name, "", "", "", "", $offset);
 184             $m->get_label()->set_text_color(200,200,80);
 185             $m->get_label()->set_line_color(200,200,80);
 186             $seq_bac{$marker_id}=$m;
 187         }
 188     }
 189
 190     # get the "normal" markers
 191     #
 192     my $query =     "
 193         SELECT
 194             marker_experiment.marker_id,
 195             alias,
 196             mc_name,
 197             confidence_id,
 198             0,
 199             subscript,
 200             position,
 201             0
 202         FROM
 203             sgn.map_version
 204             inner join sgn.linkage_group using (map_version_id)
 205             inner join sgn.marker_location using (lg_id)
 206             inner join sgn.marker_experiment using (location_id)
 207             inner join sgn.marker_alias using (marker_id)
 208             inner join sgn.marker_confidence using (confidence_id)
 209             left join sgn.marker_collectible using (marker_id)
 210             left join sgn.marker_collection using (mc_id)
 211         WHERE
 212             map_version.map_version_id=?
 213             and lg_name=?
 214
 215          ORDER BY
 216             position,
 217             confidence_id desc
 218     ";
 219
 220     #print STDERR "MY ID: ".$self->get_id()." MY CHR NR: ".$chr_nr."\n";
 221
 222     my $sth =  $self->get_dbh -> prepare($query);
 223     $sth -> execute($self->get_id(), $chr_nr);
 224
 225
 226     # hairy code to group all the synonyms correctly
 227     my %marker_info = ();
 228
 229     my ($marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, $loc_type);
 230     my $previous_name = '';
 231     my %synonyms = ();
 232     while (($marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, $loc_type) = $sth->fetchrow_array()) {
 233
 234         push @{$synonyms{$marker_id}}, $marker_name;
 235         $marker_info{$marker_id} = { marker_name        => $marker_name,
 236                                      marker_type        => $marker_type,
 237                                      confidence         => $confidence,
 238                                      order_in_loc       => $order_in_loc,
 239                                      location_subscript => $location_subscript,
 240                                      offset             => $offset,
 241                                      loc_type           => $loc_type,
 242         };
 243
 244     }
 245     foreach my $marker_id (keys %marker_info) {
 246
 247         #print STDERR "Marker Read: $marker_id\t$marker_name\t$marker_type\t$offset\n";
 248         my $m = CXGN::Cview::Marker -> new($chromosome,
 249                                            $marker_id,
 250                                            $marker_info{$marker_id}->{marker_name},
 251                                            $marker_info{$marker_id}->{marker_type},
 252                                            $marker_info{$marker_id}->{confidence},
 253                                            $marker_info{$marker_id}->{order_in_loc},
 254                                            $marker_info{$marker_id}->{location_subscript},
 255                                            $marker_info{$marker_id}->{offset},
 256                                            undef ,
 257                                            $marker_info{$marker_id}->{loc_type},
 258                                            0);
 259
 260         $m->set_synonyms( $synonyms{$marker_id} );
 261
 262         #print STDERR "dataadapter baccount = $bac_count!\n";
 263         if ($loc_type == 100) { $m -> set_frame_marker(); }
 264         if ($self->get_link_by_name()) {
 265             $m->set_url($self->get_marker_link($m->get_marker_name));
 266         }
 267         else {
 268             $m -> set_url( $self->get_marker_link($m->get_id()));
 269         }
 270         $self->set_marker_color($m, $self->get_legend()->get_mode());
 271
 272         #print STDERR "CURRENT MODE IS: ".$self->get_legend()->get_mode()."\n";
 273         $chromosome->add_marker($m);
 274
 275         if (exists($seq_bac{$marker_id})) {
 276             #print STDERR "Adding Sequenced BAC [".($seq_bac{$marker_id}->get_name())."] to map...[$marker_id]\n";
 277             $chromosome->add_marker($seq_bac{$marker_id});
 278         }
 279     }
 280
 281
 282
 283
 284     foreach my $mi ($self->get_map_items()) {
 285
 286         my ($chr, $offset, $name) = split /\s+/, $mi;
 287
 288
 289         if (!$chr || !$offset || !$name) { next; }
 290
 291         if ($chr ne $chr_nr) { next; }
 292
 293         my $m = CXGN::Cview::Marker->new($chromosome);
 294
 295         $m->get_label()->set_label_text($name);
 296         $m->set_offset($offset);
 297         $m->get_label()->set_hilited(1);
 298         $m->show_label();
 299         $m->get_label()->set_url('');
 300         $m->set_marker_name($name); # needed for proper marker ordering in the chromosome
 301         $chromosome->add_marker($m);
 302
 303
 304     }
 305
 306     $chromosome->sort_markers();
 307
 308     $chromosome -> _calculate_chromosome_length();
 309
 310     return $chromosome;
 311 }
 312
 313
 314 =head2 function get_chromosome_section
 315
 316   Synopsis:     my $chr_section = $map->get_chromosome_section(5, 120, 180);
 317   Arguments:    linkage group number, start offset, end offset
 318   Returns:
 319   Side effects:
 320   Description:
 321
 322 =cut
 323
 324 sub get_chromosome_section {
 325     my $self = shift;
 326     my $chr_nr = shift;     # the chromosome number
 327     my $start = shift;      # the start of the section in cM
 328     my $end = shift;        # the end of the section in cM
 329
 330     my $chromosome = CXGN::Cview::Chromosome->new();
 331
 332     # main query to get the marker data, including the BACs that
 333     # are associated with this marker -- needs to be refactored to
 334     # work with the materialized views for speed improvements.
 335     #
 336     my $query =
 337     "
 338         SELECT
 339             marker_experiment.marker_id,
 340             alias,
 341             mc_name,
 342             confidence_id,
 343             0,
 344             subscript,
 345             position,
 346             0,
 347             min(physical.probe_markers.overgo_probe_id),
 348             count(distinct(physical.overgo_associations.bac_id)),
 349             max(physical.oa_plausibility.plausible)
 350         FROM
 351             map_version
 352             inner join linkage_group using (map_version_id)
 353             inner join marker_location using (lg_id)
 354             inner join marker_experiment using (location_id)
 355             inner join marker_alias using (marker_id)
 356             inner join marker_confidence using (confidence_id)
 357             left join marker_collectible using (marker_id)
 358             left join marker_collection using (mc_id)
 359             LEFT JOIN physical.probe_markers ON (marker_experiment.marker_id=physical.probe_markers.marker_id)
 360             LEFT JOIN physical.overgo_associations USING (overgo_probe_id)
 361             LEFT JOIN physical.oa_plausibility USING (overgo_assoc_id)
 362         WHERE
 363             map_version.map_version_id=?
 364             and lg_name=?
 365             and preferred='t'
 366             -- and current_version='t'
 367             AND position >= ?
 368             AND position <= ?
 369         GROUP BY
 370             marker_experiment.marker_id,
 371             alias,
 372             mc_name,
 373             confidence_id,
 374             subscript,
 375             position
 376         ORDER BY
 377             position,
 378             confidence_id desc,
 379             max(physical.oa_plausibility.plausible),
 380             max(physical.probe_markers.overgo_probe_id)
 381     ";
 382
 383
 384     my $sth =  $self->get_dbh()-> prepare($query);
 385 #    print STDERR "START/END: $start/$end\n";
 386     $sth -> execute($self->get_id(), $chr_nr, $start, $end);
 387
 388     # for each marker, look if there is a associated fully sequenced BAC, and add that
 389     # as a marker of type Sequenced_BAC to the map at the right location
 390     #
 391     my $bac_status_q =
 392     "
 393         SELECT
 394             cornell_clone_name,
 395             bac_id
 396         FROM
 397             physical.bac_marker_matches
 398             JOIN sgn_people.bac_status using (bac_id)
 399         WHERE
 400             physical.bac_marker_matches.marker_id=?
 401             AND sgn_people.bac_status.status='complete'
 402     ";
 403
 404     my $bac_status_h = $self->get_dbh()->prepare($bac_status_q);
 405     my $seq_bac;
 406
 407     while (my ($marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, $loc_type, $overgo, $bac_count, $plausible, $status, $bac_name, $bac_id) = $sth->fetchrow_array()) {
 408         #print STDERR "Marker Read: $marker_id\t$marker_name\t$marker_type\toffset: $offset\tovergo: $overgo\tbac_count: $bac_count\tplausible: $plausible\n";
 409         my $seq_bac=undef;
 410         my $seq_bac_name="";
 411         my $seq_bac_id="";
 412         if (!$plausible || $plausible == 0)  { $bac_count = 0; }
 413         my $m = CXGN::Cview::Marker -> new($chromosome, $marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, , $loc_type, 0, $overgo, $bac_count);
 414
 415         if ($self->get_link_by_name()) {
 416             $m->set_url($self->get_marker_link($m->get_marker_name()));
 417         }
 418         else {
 419             $m->set_url($self->get_marker_link($m->get_id()));
 420         }
 421         $self->set_marker_color($m, $self->get_legend()->get_mode());
 422         #print STDERR "dataadapter baccount = $bac_count!\n";
 423         if ($loc_type == 100) { $m -> set_frame_marker(); }
 424
 425         # only add the sequenced BAC information to the F2-2000.
 426         #
 427         if ($self->get_id() == CXGN::Cview::Map::Tools::find_current_version($self->get_dbh(), CXGN::Cview::Map::Tools::current_tomato_map_id())) {
 428
 429             $bac_status_h->execute($marker_id);
 430             ($seq_bac_name, $seq_bac_id) = $bac_status_h->fetchrow_array();
 431
 432             # change the name to look more standard
 433             #
 434             if ($seq_bac_name) {
 435                  if ($seq_bac_name =~ m/(\d+)([A-Z])(\d+)/i) {
 436                     $seq_bac_name = sprintf ("%3s%04d%1s%02d", "HBa",$1,$2,$3);
 437                 }
 438                 $seq_bac = CXGN::Cview::Marker::SequencedBAC->new($chromosome, $seq_bac_id, $seq_bac_name, "", "", "", "", $offset);
 439             }
 440         }
 441
 442         # add the marker $m to the chromosome
 443         #
 444         $chromosome->add_marker($m);
 445
 446         if ($m->has_overgo()) {
 447                 $m->set_mark_color(100, 100, 100); # draw a gray circle for overgos
 448                 $m->set_show_mark(1);
 449                 $m->set_mark_link( "/tools/seedbac/sbfinder.pl?marker=".$m->get_marker_name()  );
 450             }
 451         #print STDERR "# BACS: ".($m2[$i]->has_bacs())."\n";
 452         if ($m->has_bacs()) {
 453             $m->set_mark_color(180, 0, 0); # draw a red circle for associated bacs
 454             $m->set_show_mark(1);
 455             $m->set_mark_link("/tools/seedbac/sbfinder.pl?marker=".$m->get_marker_name());
 456         }
 457         if (!$m->is_visible()) {
 458             $m->set_show_mark(0);
 459         }
 460
 461         # add the sequenced BAC to the chromosome
 462         # -url link needs to be changed
 463         # -add a confidence level of 3 so that it is always displayed.
 464         #
 465         if ($seq_bac) {
 466             $seq_bac->set_confidence(3);
 467             $seq_bac->set_url("/maps/physical/clone_info.pl?id=$seq_bac_id");
 468             $chromosome->add_marker($seq_bac);
 469         }
 470     }
 471     $chromosome->set_section($start, $end);
 472     $chromosome -> _calculate_chromosome_length();
 473
 474
 475
 476     return $chromosome;
 477 }
 478
 479 =head2 function get_overview_chromosome
 480
 481   Synopsis:
 482   Arguments:
 483   Returns:
 484   Side effects:
 485   Description:
 486
 487 =cut
 488
 489 sub get_overview_chromosome {
 490     my $self = shift;
 491     my $chr_nr = shift;
 492     my $chr = $self->get_chromosome($chr_nr);
 493     $chr->set_width( $self->get_preferred_chromosome_width()/2 );
 494     foreach my $m ($chr->get_markers()) {
 495         $m->hide_label();
 496         $m->hide_mark();
 497     }
 498     return $chr;
 499 }
 500
 501 =head2 get_chromosome_connections()
 502
 503  Usage:        @list = $map->get_chromosome_connections($lg_name)
 504  Args:         a linkage group name from the current map
 505  Returns:      a list of hashrefs, containing 4 keys
 506                map_version_id, lg_name, marker_count, short_name
 507                and the corresponding values
 508  Side Effects: the information will be used to populate the
 509                drop down menu in the comparative viewer.
 510  Example:
 511
 512 =cut
 513
 514 sub get_chromosome_connections {
 515     my $self = shift;
 516     my $chr_nr = shift;
 517
 518     my $query =
 519         "
 520         SELECT
 521             c_map_version.map_version_id,
 522             c_map.short_name,
 523             c_linkage_group.lg_name,
 524             count(distinct(marker.marker_id)) as marker_count
 525         from
 526             marker
 527             join marker_experiment using(marker_id)
 528             join marker_location using (location_id)
 529             join linkage_group on (marker_location.lg_id=linkage_group.lg_id)
 530             join map_version on (linkage_group.map_version_id=map_version.map_version_id)
 531
 532             join marker_experiment as c_marker_experiment on
 533                  (marker.marker_id=c_marker_experiment.marker_id)
 534             join marker_location as c_marker_location on
 535                  (c_marker_experiment.location_id=c_marker_location.location_id)
 536             join linkage_group as c_linkage_group on (c_marker_location.lg_id=c_linkage_group.lg_id)
 537             join map_version as c_map_version on
 538                  (c_linkage_group.map_version_id=c_map_version.map_version_id)
 539             join map as c_map on (c_map.map_id=c_map_version.map_id)
 540         where
 541             map_version.map_version_id=?
 542             and linkage_group.lg_name=?
 543             and c_map_version.map_version_id !=map_version.map_version_id
 544             and c_map_version.current_version='t'
 545         group by
 546             c_map_version.map_version_id,
 547             c_linkage_group.lg_name,
 548             c_map.short_name
 549         order by
 550             marker_count desc
 551     ";
 552
 553     my $sth = $self->get_dbh() -> prepare($query);
 554     $sth -> execute($self->get_id(), $chr_nr);
 555     my @chr_list = ();
 556
 557     #print STDERR "***************** Done with query..\n";
 558     while (my $hashref = $sth->fetchrow_hashref()) {
 559         #print STDERR "READING----> $hashref->{map_version_id} $hashref->{lg_name} $hashref->{marker_count}\n";
 560         push @chr_list, $hashref;
 561
 562     }
 563
 564     # hard code some connections to agp and fish maps.
 565     #
 566     my $tomato_version_id = CXGN::Cview::Map::Tools::find_current_version($self->get_dbh(), CXGN::Cview::Map::Tools::current_tomato_map_id());
 567     ###print STDERR $self->get_id()." VERSUS $tomato_version_id\n\n";
 568
 569     if ($self->get_id() == $tomato_version_id) {
 570
 571         ##print STDERR "***** Map ".$self->get_id(). " pushing agp and fish map!\n\n";
 572         push @chr_list, { map_version_id => "agp",
 573                           short_name => "Tomato AGP map",
 574                           lg_name => $chr_nr,
 575                           marker_count => "?"
 576                           };
 577         push @chr_list, { map_version_id => 25,
 578                           short_name => "FISH map",
 579                           lg_name => $chr_nr,
 580                           marker_count => "?"
 581                           };
 582     }
 583     else {
 584         warn $self->get_id()." has no other associated maps...\n\n";
 585     }
 586
 587     return @chr_list;
 588 }
 589
 590 =head2 function has_linkage_group
 591
 592   Synopsis:
 593   Arguments:
 594   Returns:
 595   Side effects:
 596   Description:
 597
 598 =cut
 599
 600 sub has_linkage_group {
 601     my $self = shift;
 602     my $candidate = shift;
 603     foreach my $lg ($self->get_chromosome_names()) {
 604         if ($lg eq $candidate) {
 605             return 1;
 606         }
 607     }
 608     return 0;
 609 }
 610
 611 =head2 function get_marker_count
 612
 613 accesses the database to count the marker on the given map/chromosome.
 614
 615 =cut
 616
 617 sub get_marker_count {
 618     my $self =shift;
 619     my $chr_name = shift;
 620     my $query = "SELECT count(distinct(location_id)) FROM sgn.map_version JOIN marker_location using (map_version_id)
 621                             JOIN linkage_group using (lg_id)
 622                       WHERE linkage_group.lg_name=? and map_version.map_version_id=?";
 623     my $sth = $self->get_dbh()->prepare($query);
 624     $sth->execute($chr_name, $self->get_id());
 625     my ($count) = $sth->fetchrow_array();
 626     return $count;
 627
 628 }
 629
 630 sub get_map_stats {
 631     my $self = shift;
 632     my $query =
 633     "
 634         select
 635             mc_name,
 636             count(distinct(marker.marker_id))
 637         from
 638             marker join marker_collectible using (marker_id)
 639             join marker_collection using(mc_id)
 640             join marker_experiment on (marker.marker_id=marker_experiment.marker_id)
 641             join marker_location on (marker_experiment.location_id=marker_location.location_id)
 642         where
 643             marker_location.map_version_id=?
 644         group by
 645             mc_name
 646     ";
 647
 648     my $total_count = 0;
 649
 650     my $s = <<"";
 651 <table summary="">
 652 <tr><td colspan="2"><b>Marker collections</b></td></tr>
 653
 654     my $sth = $self->get_dbh() -> prepare($query);
 655     $sth -> execute($self->get_id());
 656
 657     my $map_name = $self->get_short_name();
 658     $map_name =~ s/ /\+/g;
 659
 660     while (my ($type, $count)= $sth->fetchrow_array()) {
 661         $s .= <<"";
 662 <tr>
 663   <td>$type</td>
 664   <td align="right">
 665      <a href="/search/markers/markersearch.pl?types=$type&amp;maps=$map_name">$count</a>
 666   </td>
 667 </tr>
 668
 669         $total_count += $count;
 670     }
 671     $s .= <<"";
 672 <tr><td>&nbsp;</td><td>&nbsp;</td></tr>
 673 <tr>
 674   <td><b>Total</b>:</td>
 675   <td align="right">
 676       <a style="font-weight: bold" href="/search/markers/markersearch.pl?maps=$map_name">$total_count</a>
 677   </td>
 678 </tr>
 679 </table>
 680
 681     my $protocol_q = "SELECT distinct(marker_experiment.protocol), count(distinct(marker_experiment.marker_experiment_id))
 682                         FROM marker
 683                         JOIN marker_experiment using (marker_id)
 684                         JOIN marker_location using (location_id)
 685                         JOIN linkage_group using (map_version_id)
 686                        WHERE map_version_id=?
 687                        GROUP BY marker_experiment.protocol";
 688     my $pqh = $self->get_dbh()->prepare($protocol_q);
 689     $pqh ->execute($self->get_id());
 690
 691     my $total_protocols = 0;
 692     $s .= <<"";
 693 <br /><br />
 694 <table>
 695   <tr>
 696      <td colspan="2"><b>Protocols</b></td>
 697   </tr>
 698
 699     while (my ($protocol, $count) = $pqh->fetchrow_array()) {
 700         $s.= qq { <tr><td>$protocol</td><td align="right">$count</td></tr> };
 701         $total_protocols += $count;
 702     }
 703
 704     $s .= <<"";
 705 <tr><td colspan="2">&nbsp;</td></tr>
 706 <tr>
 707    <td><b>Total:</b></td>
 708    <td align="right"><b>$total_protocols</b></td>
 709 </tr>
 710 </table>
 711
 712     return $s;
 713 }
 714
 715
 716
 717 =head2 function has_IL
 718
 719   Synopsis:
 720   Arguments:
 721   Returns:
 722   Side effects:
 723   Description:
 724
 725 =cut
 726
 727 sub has_IL {
 728     my $self =shift;
 729
 730     if ($self->get_short_name()=~/1992|2000/) {
 731         #print STDERR "Map ".$self->get_short_name()." has an associated IL map.\n";
 732         return 1;
 733     }
 734     #print STDERR "Map ".$self->get_short_name()." does not have an associated IL map.\n";
 735     return 0;
 736 }
 737
 738 =head2 function has_physical
 739
 740   Synopsis:
 741   Arguments:
 742   Returns:
 743   Side effects:
 744   Description:
 745
 746 =cut
 747
 748 sub has_physical {
 749     my $self = shift;
 750     if ($self->get_short_name()=~/2000/) {
 751         return 1;
 752     }
 753     return 0;
 754 }
 755
 756 =head2 function can_zoom
 757
 758 Whether this map support zooming in. These ones do.
 759
 760 =cut
 761
 762 sub can_zoom {
 763     return 1;
 764 }
 765
 766
 767
 768 =head2 function set_marker_color()
 769
 770   Synopsis:
 771   Parameters:   marker object [CXGN::Cview::Marker], color model [string]
 772   Returns:      nothing
 773   Side effects: sets the marker color according to the supplied marker color model
 774                 the color model is a string from the list:
 775                 "marker_types", "confidence"
 776   Status:       implemented
 777   Example:
 778   Note:         this function was moved to Utils from ChromosomeViewer, such that
 779                 it is available for other scripts, such as view_maps.pl
 780
 781 =cut
 782
 783 sub set_marker_color {
 784     my $self = shift;
 785     my $m = shift;
 786     my $color_model = shift || '';
 787
 788     if ($color_model eq "marker_types") {
 789         if ($m->get_marker_type() =~ /RFLP/i) {
 790             $m->set_color(255, 0, 0);
 791             $m->set_label_line_color(255, 0,0);
 792             $m->set_text_color(255,0,0);
 793         }
 794         elsif ($m->get_marker_type() =~ /SSR/i) {
 795             $m->set_color(0, 255, 0);
 796             $m->set_label_line_color(0, 255,0);
 797             $m->set_text_color(0,255,0);
 798         }
 799         elsif ($m->get_marker_type() =~ /CAPS/i) {
 800             $m->set_color(0, 0, 255);
 801             $m->set_label_line_color(0, 0,255);
 802             $m->set_text_color(0,0,255);
 803         }
 804         elsif ($m->get_marker_type() =~ /COS/i) {
 805             $m->set_color(255,0 , 255);
 806             $m->set_label_line_color(255,0, 255);
 807             $m->set_text_color(255,0,255);
 808         }
 809         else {
 810             $m->set_color(0, 0, 0);
 811             $m->set_label_line_color(0, 0,0);
 812             $m->set_text_color(0,0,0);
 813         }
 814
 815     }
 816     else {
 817         my $c = $m -> get_confidence();
 818         if ($c==0) {
 819             $m->set_color(0,0,0);
 820             $m->set_label_line_color(0,0,0);
 821             $m->set_text_color(0,0,0);
 822         }
 823         if ($c==1) {
 824             $m->set_color(0,0,255);
 825             $m->set_label_line_color(0,0,255);
 826             $m->set_text_color(0,0,255);
 827
 828         }
 829         if ($c==2) {
 830             $m->set_color(0,255, 0);
 831             $m->set_label_line_color(0,255,0);
 832             $m->set_text_color(0,255,0);
 833         }
 834         if ($c==3) {
 835             $m->set_color(255, 0, 0);
 836             $m->set_label_line_color(255, 0,0);
 837             $m->set_text_color(255, 0,0);
 838         }
 839         if ($c==4) {
 840             $m->set_color(128, 128, 128);
 841             $m->set_label_line_color(128, 128, 128);
 842             $m->set_text_color(128, 128, 128);
 843         }
 844     }
 845 }
 846
 847 sub can_overlay {
 848     return 1;
 849 }
 850
 851 sub get_stock_name {
 852     my $self = shift;
 853     my $id = shift;
 854     my $q = "SELECT name FROM stock WHERE stock_id=?";
 855     my $h = $self->get_dbh()->prepare($q);
 856     $h->execute($id);
 857     my ($name) = $h->fetchrow_array();
 858     return $name;
 859 }
 860
 861 sub get_parent1_stock_name {
 862     my $self = shift;
 863     return $self->get_stock_name($self->get_parent1_stock_id);
 864 }
 865
 866 sub get_parent2_stock_name {
 867     my $self = shift;
 868     return $self->get_stock_name($self->get_parent2_stock_id);
 869 }
 870
 871
 872 1;