1 package CXGN
::Cview
::Map
::SGN
::Genetic
;
5 CXGN::Cview::Map::SGN::Genetic - a class implementing a genetic map
9 This class implements a genetic map populated from the SGN database. This class inherits from L<CXGN::Cview::Map>.
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).
15 Lukas Mueller <lam87@cornell.edu>
19 This class implements the following functions (for more information, see L<CXGN::Cview::Map>):
26 use CXGN
::Cview
::Legend
::Genetic
;
28 use CXGN
::Cview
::Map
::Tools
;
30 use base qw
| CXGN
::Cview
::Map
|;
34 Synopsis: my $genetic = CXGN::Cview::Map::SGN::Genetic->
35 new( $dbh, $map_version_id);
36 Arguments: (1) a database handle, preferably generated with
38 (2) the map version id for the desired map.
39 Returns: a Genetic map object
40 Side effects: accesses the database
48 my $map_version_id = shift;
50 my $self = $class->SUPER::new
($dbh);
51 $self->set_id($map_version_id);
55 $self->set_preferred_chromosome_width(20);
57 # fetch the chromosome lengths
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;
66 $self->set_chromosome_lengths(@chromosome_lengths);
68 if ($self->get_chromosome_count() == 0) { return undef; }
70 my $legend = CXGN
::Cview
::Legend
::Genetic
->new($self);
71 # $legend->set_mode("marker_types");
72 $self->set_legend($legend);
74 $self->set_marker_link("/search/markers/markerinfo.pl?marker_id=");
82 # get the map metadata
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=?";
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");
109 # get information about associated linkage_groups
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());
115 while (my ($lg_name) = $chr_name_h->fetchrow_array()) {
116 push @names, $lg_name;
118 $self->set_chromosome_names(@names);
119 $self->set_chromosome_count(scalar(@names));
120 $self->set_preferred_chromosome_width(20);
122 # get the location of the centromeres
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);
134 =head2 function get_chromosome
135 Synopsis: see L<CXGN::Cview::Map>
146 # my $marker_confidence_cutoff = shift; # the confidence cutoff. 3=frame 2=coseg 1=interval LOD=2 0=interval
148 # if (!$marker_confidence_cutoff) { $marker_confidence_cutoff=-1; }
150 my $chromosome = CXGN
::Cview
::Chromosome
->new();
151 $chromosome->set_name($chr_nr);
152 $chromosome->set_caption($chr_nr);
156 my $physical = 'physical';
158 if ($self->get_id() == CXGN
::Cview
::Map
::Tools
::find_current_version
($self->get_dbh(), CXGN
::Cview
::Map
::Tools
::current_tomato_map_id
())) {
160 # get the sequenced BACs
162 my $Sequenced_BAC_query =
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
170 $physical.bac_marker_matches
171 LEFT JOIN sgn.linkage_group USING (lg_id)
172 LEFT JOIN sgn_people.bac_status USING (bac_id)
174 sgn.linkage_group.lg_name=?
175 AND sgn_people.bac_status.status='complete'
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();
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;
190 # get the "normal" markers
194 marker_experiment.marker_id,
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)
212 map_version.map_version_id=?
220 #print STDERR "MY ID: ".$self->get_id()." MY CHR NR: ".$chr_nr."\n";
222 my $sth = $self->get_dbh -> prepare
($query);
223 $sth -> execute
($self->get_id(), $chr_nr);
226 # hairy code to group all the synonyms correctly
227 my %marker_info = ();
229 my ($marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, $loc_type);
230 my $previous_name = '';
232 while (($marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, $loc_type) = $sth->fetchrow_array()) {
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,
241 loc_type
=> $loc_type,
245 foreach my $marker_id (keys %marker_info) {
247 #print STDERR "Marker Read: $marker_id\t$marker_name\t$marker_type\t$offset\n";
248 my $m = CXGN
::Cview
::Marker
-> new
($chromosome,
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
},
257 $marker_info{$marker_id}->{loc_type
},
260 $m->set_synonyms( $synonyms{$marker_id} );
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));
268 $m -> set_url
( $self->get_marker_link($m->get_id()));
270 $self->set_marker_color($m, $self->get_legend()->get_mode());
272 #print STDERR "CURRENT MODE IS: ".$self->get_legend()->get_mode()."\n";
273 $chromosome->add_marker($m);
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});
284 foreach my $mi ($self->get_map_items()) {
286 my ($chr, $offset, $name) = split /\s+/, $mi;
289 if (!$chr || !$offset || !$name) { next; }
291 if ($chr ne $chr_nr) { next; }
293 my $m = CXGN
::Cview
::Marker
->new($chromosome);
295 $m->get_label()->set_label_text($name);
296 $m->set_offset($offset);
297 $m->get_label()->set_hilited(1);
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);
306 $chromosome->sort_markers();
308 $chromosome -> _calculate_chromosome_length
();
314 =head2 function get_chromosome_section
316 Synopsis: my $chr_section = $map->get_chromosome_section(5, 120, 180);
317 Arguments: linkage group number, start offset, end offset
324 sub get_chromosome_section
{
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
330 my $chromosome = CXGN
::Cview
::Chromosome
->new();
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.
339 marker_experiment.marker_id,
347 min(physical.probe_markers.overgo_probe_id),
348 count(distinct(physical.overgo_associations.bac_id)),
349 max(physical.oa_plausibility.plausible)
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)
363 map_version.map_version_id=?
366 -- and current_version='t'
370 marker_experiment.marker_id,
379 max(physical.oa_plausibility.plausible),
380 max(physical.probe_markers.overgo_probe_id)
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);
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
397 physical.bac_marker_matches
398 JOIN sgn_people.bac_status using (bac_id)
400 physical.bac_marker_matches.marker_id=?
401 AND sgn_people.bac_status.status='complete'
404 my $bac_status_h = $self->get_dbh()->prepare($bac_status_q);
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";
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);
415 if ($self->get_link_by_name()) {
416 $m->set_url($self->get_marker_link($m->get_marker_name()));
419 $m->set_url($self->get_marker_link($m->get_id()));
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
(); }
425 # only add the sequenced BAC information to the F2-2000.
427 if ($self->get_id() == CXGN
::Cview
::Map
::Tools
::find_current_version
($self->get_dbh(), CXGN
::Cview
::Map
::Tools
::current_tomato_map_id
())) {
429 $bac_status_h->execute($marker_id);
430 ($seq_bac_name, $seq_bac_id) = $bac_status_h->fetchrow_array();
432 # change the name to look more standard
435 if ($seq_bac_name =~ m/(\d+)([A-Z])(\d+)/i) {
436 $seq_bac_name = sprintf ("%3s%04d%1s%02d", "HBa",$1,$2,$3);
438 $seq_bac = CXGN
::Cview
::Marker
::SequencedBAC
->new($chromosome, $seq_bac_id, $seq_bac_name, "", "", "", "", $offset);
442 # add the marker $m to the chromosome
444 $chromosome->add_marker($m);
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() );
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());
457 if (!$m->is_visible()) {
458 $m->set_show_mark(0);
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.
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);
471 $chromosome->set_section($start, $end);
472 $chromosome -> _calculate_chromosome_length
();
479 =head2 function get_overview_chromosome
489 sub get_overview_chromosome
{
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()) {
501 =head2 get_chromosome_connections()
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.
514 sub get_chromosome_connections
{
521 c_map_version.map_version_id,
523 c_linkage_group.lg_name,
524 count(distinct(marker.marker_id)) as marker_count
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)
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)
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'
546 c_map_version.map_version_id,
547 c_linkage_group.lg_name,
553 my $sth = $self->get_dbh() -> prepare
($query);
554 $sth -> execute
($self->get_id(), $chr_nr);
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;
564 # hard code some connections to agp and fish maps.
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";
569 if ($self->get_id() == $tomato_version_id) {
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",
577 push @chr_list, { map_version_id
=> 25,
578 short_name
=> "FISH map",
584 warn $self->get_id()." has no other associated maps...\n\n";
590 =head2 function has_linkage_group
600 sub has_linkage_group
{
602 my $candidate = shift;
603 foreach my $lg ($self->get_chromosome_names()) {
604 if ($lg eq $candidate) {
611 =head2 function get_marker_count
613 accesses the database to count the marker on the given map/chromosome.
617 sub get_marker_count
{
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();
636 count(distinct(marker.marker_id))
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)
643 marker_location.map_version_id=?
652 <tr
><td colspan
="2"><b
>Marker collections
</b></td
></tr
>
654 my $sth = $self->get_dbh() -> prepare
($query);
655 $sth -> execute
($self->get_id());
657 my $map_name = $self->get_short_name();
658 $map_name =~ s/ /\+/g;
660 while (my ($type, $count)= $sth->fetchrow_array()) {
665 <a href
="/search/markers/markersearch.pl?types=$type&maps=$map_name">$count</a
>
669 $total_count += $count;
672 <tr
><td
> 
;</td><td> </td
></tr
>
674 <td
><b
>Total
</b>:</td
>
676 <a style
="font-weight: bold" href
="/search/markers/markersearch.pl?maps=$map_name">$total_count</a
>
681 my $protocol_q = "SELECT distinct(marker_experiment.protocol), count(distinct(marker_experiment.marker_experiment_id))
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());
691 my $total_protocols = 0;
696 <td colspan
="2"><b
>Protocols
</b></td
>
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;
705 <tr
><td colspan
="2"> 
;</td></tr
>
707 <td
><b
>Total
:</b></td
>
708 <td align
="right"><b
>$total_protocols</b></td
>
717 =head2 function has_IL
730 if ($self->get_short_name()=~/1992|2000/) {
731 #print STDERR "Map ".$self->get_short_name()." has an associated IL map.\n";
734 #print STDERR "Map ".$self->get_short_name()." does not have an associated IL map.\n";
738 =head2 function has_physical
750 if ($self->get_short_name()=~/2000/) {
756 =head2 function can_zoom
758 Whether this map support zooming in. These ones do.
768 =head2 function set_marker_color()
771 Parameters: marker object [CXGN::Cview::Marker], color model [string]
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"
778 Note: this function was moved to Utils from ChromosomeViewer, such that
779 it is available for other scripts, such as view_maps.pl
783 sub set_marker_color
{
786 my $color_model = shift || '';
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);
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);
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);
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);
810 $m->set_color(0, 0, 0);
811 $m->set_label_line_color(0, 0,0);
812 $m->set_text_color(0,0,0);
817 my $c = $m -> get_confidence
();
819 $m->set_color(0,0,0);
820 $m->set_label_line_color(0,0,0);
821 $m->set_text_color(0,0,0);
824 $m->set_color(0,0,255);
825 $m->set_label_line_color(0,0,255);
826 $m->set_text_color(0,0,255);
830 $m->set_color(0,255, 0);
831 $m->set_label_line_color(0,255,0);
832 $m->set_text_color(0,255,0);
835 $m->set_color(255, 0, 0);
836 $m->set_label_line_color(255, 0,0);
837 $m->set_text_color(255, 0,0);
840 $m->set_color(128, 128, 128);
841 $m->set_label_line_color(128, 128, 128);
842 $m->set_text_color(128, 128, 128);
854 my $q = "SELECT name FROM stock WHERE stock_id=?";
855 my $h = $self->get_dbh()->prepare($q);
857 my ($name) = $h->fetchrow_array();
861 sub get_parent1_stock_name
{
863 return $self->get_stock_name($self->get_parent1_stock_id);
866 sub get_parent2_stock_name
{
868 return $self->get_stock_name($self->get_parent2_stock_id);