2 # NOTE: THIS MODULE IS DEPRECATED AND WILL BE REMOVED SOON.
8 use CXGN
::Cview
::Marker
;
9 use CXGN
::Cview
::Marker
::SequencedBAC
;
10 use CXGN
::Cview
::Marker
::FISHMarker
;
12 use CXGN
::Genomic
::Clone
;
15 package CXGN
::Cview
::Cview_data_adapter
;
17 =head2 function get_chromosome()
19 Synopsis: gets a chromosome object of the appropriate type given a map_version_id
20 Arguments: database handle, CXGN::Map object, and a chr_nr.
21 Returns: a chromosome object of the appropriate type.
29 my $map = shift; # CXGN::Map object
33 unless (defined($type)) {$type='';}
34 if ($type =~ /fish/i) {
35 $c=CXGN
::Cview
::Chromosome
::PachyteneIdiogram
-> new
($chr_nr, 100, 100, 40);
36 CXGN
::Cview
::Cview_data_adapter
::fetch_pachytene_idiogram
($c, $chr_nr);
37 CXGN
::Cview
::Cview_data_adapter
::fetch_fish_chromosome
($dbh, $c, $map, $chr_nr, 0, $type);
43 $c= CXGN
::Cview
::Chromosome
-> new
($chr_nr, 60, 100, 40);
44 CXGN
::Cview
::Cview_data_adapter
::fetch_chromosome
($dbh, $c, $map, $chr_nr, 0, $type);
50 sub fetch_chromosome
{
52 my $chromosome = shift; # the chromosome object
53 my $map = shift; # CXGN::Map object
54 my $chr_nr = shift; # the chromosome name
55 my $marker_confidence_cutoff = shift; # the confidence cutoff. 3=frame 2=coseg 1=interval LOD=2 0=interval
58 # if ($type=~/fish/i) {
59 # return fetch_fish_chromosome($dbh, $chromosome, $map_id, $chr_nr);
63 if (!$marker_confidence_cutoff) { $marker_confidence_cutoff=-1; }
67 my $sgn = $dbh->qualify_schema('sgn');
68 my $physical = $dbh->qualify_schema('physical');
70 if ($map->map_id() == CXGN
::Map
::Tools
::current_tomato_map_id
()) {
72 my $Sequenced_BAC_query =
75 distinct $physical.bac_marker_matches.bac_id,
76 $physical.bac_marker_matches.cornell_clone_name,
77 $physical.bac_marker_matches.marker_id,
78 $physical.bac_marker_matches.position
80 $physical.bac_marker_matches
81 LEFT JOIN $sgn.linkage_group USING (lg_id)
82 LEFT JOIN sgn_people.bac_status USING (bac_id)
84 $sgn.linkage_group.lg_name=?
85 AND sgn_people.bac_status.status='complete'
87 my $sth2 = $dbh->prepare($Sequenced_BAC_query);
88 $sth2->execute($chr_nr);
89 while (my ($bac_id, $name, $marker_id, $offset)=$sth2->fetchrow_array()) {
90 # print STDERR "Sequenced BAC for: $bac_id, $name, $marker_id, $offset...\n";
91 $name = CXGN
::Genomic
::Clone
->retrieve($bac_id)->clone_name();
93 my $m = CXGN
::Cview
::Marker
::SequencedBAC
->new($chromosome, $bac_id, $name, "", "", "", "", $offset);
94 $m->get_label()->set_text_color(200,200,80);
95 $m->get_label()->set_line_color(200,200,80);
96 $seq_bac{$marker_id}=$m;
100 # get the "normal" markers
105 marker_experiment.marker_id,
115 inner join $sgn.linkage_group using (map_version_id)
116 inner join $sgn.marker_location using (lg_id)
117 inner join $sgn.marker_experiment using (location_id)
118 inner join $sgn.marker_alias using (marker_id)
119 inner join $sgn.marker_confidence using (confidence_id)
120 left join $sgn.marker_collectible using (marker_id)
121 left join $sgn.marker_collection using (mc_id)
123 map_version.map_version_id=?
135 # marker_types.type_name,
137 # marker_locations.order_in_loc,
138 # location_subscript,
142 my $sth = $dbh -> prepare
($query);
143 $sth -> execute
($map->map_version_id(), $chr_nr);
145 while (my ($marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, $loc_type) = $sth->fetchrow_array()) {
146 #print STDERR "Marker Read: $marker_id\t$marker_name\t$marker_type\t$offset\n";
147 my $m = CXGN
::Cview
::Marker
-> new
($chromosome, $marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $offset, undef , $loc_type, 0);
148 #print STDERR "dataadapter baccount = $bac_count!\n";
149 if ($loc_type == 100) { $m -> set_frame_marker
(); }
150 $m -> set_url
("/search/markers/markerinfo.pl?marker_id=".$m->get_id());
151 $chromosome->add_marker($m);
153 if (exists($seq_bac{$marker_id})) {
154 #print STDERR "Adding Sequenced BAC [".($seq_bac{$marker_id}->get_name())."] to map...[$marker_id]\n";
155 $chromosome->add_marker($seq_bac{$marker_id});
159 $chromosome -> _calculate_chromosome_length
();
162 sub fetch_fish_chromosome
{
164 my $chromosome = shift;
165 my $map = shift; # CXGN::Map object
167 # The following query is a composition of 3 subqueries (look for the 'AS'
168 # keywords), joined using the clone_id. Here's what the subqueries do:
170 # * clone_id_and_percent: gets the average percent distance from the
171 # centromere as a signed float between -1.0 and +1.0, for each
172 # BAC on a given chromosome. This is done by first computing the
173 # average absolute distance from the centromere (signed, in um),
174 # and then dividing by the length of the arm that the average
175 # would be located on.
177 # * min_marker_for_clone: finds one marker associated with the BAC
180 # * clone_info: finds the library shortname and clone name components.
182 SELECT shortname, clone_id, platenum, wellrow, wellcol, percent, marker_id
183 FROM (SELECT clone_id, (CASE WHEN absdist < 0
184 THEN absdist / short_arm_length
185 ELSE absdist / long_arm_length END) AS percent
186 FROM (SELECT clone_id, chromo_num,
187 AVG(percent_from_centromere * arm_length *
188 CASE WHEN r.chromo_arm = 'P' THEN -1 ELSE 1 END)
191 JOIN fish_karyotype_constants k USING (chromo_num, chromo_arm)
193 GROUP BY clone_id, chromo_num) AS clone_id_and_absdist
194 JOIN (SELECT k1.chromo_num, k1.arm_length AS short_arm_length,
195 k2.arm_length AS long_arm_length
196 FROM fish_karyotype_constants k1
197 JOIN fish_karyotype_constants k2 USING (chromo_num)
198 WHERE k1.chromo_arm = 'P' AND k2.chromo_arm = 'Q')
199 AS karyotype_rearranged USING (chromo_num))
200 AS clone_id_and_percent
201 LEFT JOIN (SELECT clone_id, MIN (m.marker_id) AS marker_id
202 FROM sgn.fish_result AS c
203 LEFT JOIN physical.overgo_associations a ON (c.clone_id = a.bac_id)
204 LEFT JOIN physical.probe_markers m USING (overgo_probe_id)
205 LEFT JOIN marker_experiment e ON (m.marker_id = e.marker_id)
206 LEFT JOIN marker_location l ON (l.location_id = e.location_id)
207 LEFT JOIN linkage_group g ON (g.lg_id = l.lg_id)
208 LEFT JOIN map_version v ON (g.map_version_id = v.map_version_id)
209 WHERE (v.current_version = 't' OR v.current_version IS NULL)
210 AND (v.map_id = ? OR v.map_id IS NULL)
212 AS min_marker_for_clone USING (clone_id)
213 LEFT JOIN (SELECT shortname, clone_id, platenum, wellrow, wellcol
215 JOIN genomic.library USING (library_id))
216 AS clone_info USING (clone_id)
220 my $sth = $dbh -> prepare
($query);
221 $sth->execute($chr_nr, CXGN
::Map
::Tools
::current_tomato_map_id
);
222 while (my ($library_name, $clone_id, $platenum, $wellcol, $wellrow, $percent, $marker_id) = $sth->fetchrow_array()) {
223 #print STDERR "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Adding marker BAC:$library_name, $wellrow, $wellcol, $chromo_arm etc.\n";
226 $offset = $percent * 100;
228 my $clone_name = CXGN
::Genomic
::Clone
->retrieve($clone_id)->clone_name();
230 my $m = CXGN
::Cview
::Marker
::FISHMarker
-> new
($chromosome, $marker_id, $clone_name, "", 3, $offset+100, "", $offset );
231 $m -> set_url
("/maps/physical/clone_info.pl?id=".$clone_id);
232 $chromosome->add_marker($m);
238 # sub get_overgo_bac_data {
245 # if (physical.probe_markers.overgo_probe_id IS NULL, 0, 1),
246 # count(distinct(physical.overgo_associations.bac_id))
249 # left join physical.probe_markers using (marker_id)
250 # left join physical.overgo_associations using (overgo_probe_id)
257 # my $sth = $dbh -> prepare($query);
258 # $sth -> execute($m->get_id());
260 # if (my ($probes, $bacs) = $sth -> fetchrow_array()) {
261 # if ($probes) { $m->set_has_overgo(); }
262 # if ($bacs) { $m->set_has_bacs($bacs); }
268 sub fetch_chromosome_overgo
{
270 my $chromosome = shift; # the chromosome object
271 my $map = shift; # CXGN::Map object
272 my $chr_nr = shift; # the chromosome number
273 my $start = shift; # the start of the section in cM
274 my $end = shift; # the end of the section in cM
276 # main query to get the marker data, including the BACs that are associated with this
277 # marker -- needs to be refactored to work with the materialized views for speed improvements.
282 marker_experiment.marker_id,
290 min(physical.probe_markers.overgo_probe_id),
291 count(distinct(physical.overgo_associations.bac_id)),
292 max(physical.oa_plausibility.plausible)
295 inner join linkage_group using (map_version_id)
296 inner join marker_location using (lg_id)
297 inner join marker_experiment using (location_id)
298 inner join marker_alias using (marker_id)
299 inner join marker_confidence using (confidence_id)
300 left join marker_collectible using (marker_id)
301 left join marker_collection using (mc_id)
302 LEFT JOIN physical.probe_markers ON (marker_experiment.marker_id=physical.probe_markers.marker_id)
303 LEFT JOIN physical.overgo_associations USING (overgo_probe_id)
304 LEFT JOIN physical.oa_plausibility USING (overgo_assoc_id)
306 map_version.map_version_id=?
309 -- and current_version='t'
313 marker_experiment.marker_id,
322 max(physical.oa_plausibility.plausible),
323 max(physical.probe_markers.overgo_probe_id)
327 my $sth = $dbh -> prepare
($query);
328 # print STDERR "START/END: $start/$end\n";
329 $sth -> execute
($map->map_version_id, $chr_nr, $start, $end);
331 # for each marker, look if there is a associated fully sequenced BAC, and add that
332 # as a marker of type Sequenced_BAC to the map at the right location
340 physical.bac_marker_matches
341 JOIN sgn_people.bac_status using (bac_id)
343 physical.bac_marker_matches.marker_id=?
344 AND sgn_people.bac_status.status='complete'
347 my $bac_status_h = $dbh->prepare($bac_status_q);
350 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()) {
351 #print STDERR "Marker Read: $marker_id\t$marker_name\t$marker_type\toffset: $offset\tovergo: $overgo\tbac_count: $bac_count\tplausible: $plausible\n";
355 if (!$plausible || $plausible == 0) { $bac_count = 0; }
356 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);
357 #print STDERR "dataadapter baccount = $bac_count!\n";
358 if ($loc_type == 100) { $m -> set_frame_marker
(); }
360 # only add the sequenced BAC information to the F2-2000.
362 if ($map->map_id == CXGN
::Map
::Tools
::current_tomato_map_id
()) {
364 $bac_status_h->execute($marker_id);
365 ($seq_bac_name, $seq_bac_id) = $bac_status_h->fetchrow_array();
367 # change the name to look more standard
370 if ($seq_bac_name =~ m/(\d+)([A-Z])(\d+)/i) {
371 $seq_bac_name = sprintf ("%3s%04d%1s%02d", "HBa",$1,$2,$3);
373 $seq_bac = CXGN
::Cview
::Marker
::SequencedBAC
->new($chromosome, $seq_bac_id, $seq_bac_name, "", "", "", "", $offset);
377 # add the marker $m to the chromosome
379 $chromosome->add_marker($m);
381 # add the sequenced BAC to the chromosome
382 # -url link needs to be changed
383 # -add a confidence level of 3 so that it is always displayed.
386 $seq_bac->set_confidence(3);
387 $seq_bac->set_url("/maps/physical/clone_info.pl?id=$seq_bac_id");
388 $chromosome->add_marker($seq_bac);
391 $chromosome -> _calculate_chromosome_length
();
395 =head2 fetch_chromosome_connections
406 sub fetch_chromosome_connections
{
408 my $map = shift; # CXGN::Map object
414 c_map_version.map_version_id,
416 c_linkage_group.lg_name,
417 count(distinct(marker.marker_id)) as marker_count
420 join marker_experiment using(marker_id)
421 join marker_location using (location_id)
422 join linkage_group on (marker_location.lg_id=linkage_group.lg_id)
423 join map_version on (linkage_group.map_version_id=map_version.map_version_id)
425 join marker_experiment as c_marker_experiment on
426 (marker.marker_id=c_marker_experiment.marker_id)
427 join marker_location as c_marker_location on
428 (c_marker_experiment.location_id=c_marker_location.location_id)
429 join linkage_group as c_linkage_group on (c_marker_location.lg_id=c_linkage_group.lg_id)
430 join map_version as c_map_version on
431 (c_linkage_group.map_version_id=c_map_version.map_version_id)
432 join map as c_map on (c_map.map_id=c_map_version.map_id)
434 map_version.map_version_id=?
435 and linkage_group.lg_name=?
436 and c_map_version.map_version_id !=map_version.map_version_id
437 and c_map_version.current_version='t'
439 c_map_version.map_version_id,
440 c_linkage_group.lg_name,
446 my $sth = $dbh -> prepare
($query);
447 $sth -> execute
($map->map_version_id(), $chr_nr);
450 #print STDERR "***************** Done with query..\n";
451 while (my $hashref = $sth->fetchrow_hashref()) {
452 #print STDERR "READING----> $hashref->{map_version_id} $hashref->{chr_nr} $hashref->{marker_count}\n";
453 push @chr_list, $hashref;
459 =head2 fetch_available_maps
470 sub fetch_available_maps
{
473 my $query = "SELECT map_version.map_version_id, short_name
474 FROM map_version JOIN map using (map_id)
475 WHERE current_version='t' order by short_name";
476 my $sth = $dbh -> prepare
($query);
480 while (my $map_ref = $sth -> fetchrow_hashref
()) {
481 push @maps, $map_ref;
488 my $physical = shift;
489 my $map = shift; # CXGN::Map object
495 distinct(physical.bacs.bac_id),
496 marker_experiment.marker_id,
500 inner join linkage_group using (map_version_id)
501 inner join marker_location using (lg_id)
502 inner join marker_experiment using (location_id)
503 inner join physical.probe_markers using (marker_id)
504 inner join physical.overgo_associations using (overgo_probe_id)
505 inner join physical.bacs using (bac_id)
506 inner join physical.oa_plausibility using (overgo_assoc_id)
508 map_version.map_version_id=?
510 and current_version='t'
511 and physical.oa_plausibility.plausible=1
514 # print STDERR "Query: $query\n";
515 my $sth = $dbh->prepare($query);
516 $sth -> execute
($map->map_version_id, $chr_nr);
517 while (my ($bac_id, $marker_id, $offset) = $sth->fetchrow_array()) {
518 #print STDERR "Physical: Marker Read: $bac_id\t$marker_id\t$offset\n";
519 $physical -> add_bac_association
($offset, $bac_id, "overgo");
522 my $sgn = $dbh -> qualify_schema
("sgn");
523 my $computational_query = "
524 SELECT distinct(physical.computational_associations.clone_id),
525 physical.computational_associations.marker_id,
526 marker_location.position
527 FROM physical.computational_associations
528 JOIN $sgn.marker_experiment using(marker_id)
529 JOIN $sgn.marker_location using (location_id)
530 JOIN $sgn.linkage_group using (lg_id)
531 JOIN $sgn.map_version on (map_version.map_version_id=linkage_group.map_version_id)
532 WHERE map_version.map_version_id=?
533 AND linkage_group.lg_name=?
534 ORDER BY marker_location.position
537 my $cq_sth = $dbh->prepare($computational_query);
538 $cq_sth->execute($map->map_version_id(), $chr_nr);
540 while (my ($clone_id, $marker_id, $offset)=$cq_sth->fetchrow_array()) {
541 $physical -> add_bac_association
($offset, $clone_id, "computational");
554 my @m2 = $IL -> get_markers
();
555 foreach my $m (@m2) {
556 $marker_pos{$m->get_name()} = $m-> get_offset
();
557 #print STDERR $m->get_name()." ".$m->get_offset()." \n";
560 my $vhost_conf=CXGN
::VHost
->new();
561 my $data_folder=$vhost_conf->get_conf('basepath').$vhost_conf->get_conf('documents_subdir');
562 open (F
, "$data_folder/cview/IL_defs/$IL_name".".txt") || die "Can't open IL file IL_defs/$IL_name\n";
566 my ($chromosome, $name, $start_marker, $end_marker) = split/\t/;
568 if ($chr_nr == $chromosome) {
569 $start_marker =~ s/^\s+(.*)/$1/;
570 $start_marker =~ s/(.*)\s+/$1/;
571 $end_marker =~ s/^\s+(.*)/$1/;
572 $end_marker =~ s/(.*)\s+/$1/;
573 if (exists($marker_pos{$start_marker}) && exists($marker_pos{$end_marker})) {
574 if ($name=~ /^\d+\-\w+/) {
575 $IL -> add_section
($name, $start_marker, $marker_pos{$start_marker}, $end_marker, $marker_pos{$end_marker});
577 elsif ($name =~/IL/i) {
578 $IL -> add_fragment
($name, $start_marker, $marker_pos{$start_marker},$end_marker,$marker_pos{$end_marker});
581 else { print STDERR
"$start_marker or $end_marker where not found.\n";}
589 =head2 fetch_pachytene_idiogram(pachytene_object, chromosome_number)
591 for a pachytene object, fetches the definition data from a file. The tab delimited file has the following columns:
594 feature type ( can be short_arm, telomere, centromere, )
595 feature start (a signed integer, negative numbers are on the short (top) arm, in arbitrary units, positive values on the long arm.
598 Comment lines starting with # are ignored.
603 sub fetch_pachytene_idiogram
{
604 my $pachytene_object = shift;
605 my $chromosome_number = shift;
607 #print STDERR "Fetching $chromosome_number pachytene\n";
608 my $vhost_conf=CXGN
::VHost
->new();
609 my $data_folder=$vhost_conf->get_conf('basepath').$vhost_conf->get_conf('documents_subdir');
610 open (F
, "<$data_folder/cview/pachytene/pachytene_tomato_dapi.txt") || die "Can't open pachytene def file";
615 my ($chr, $type, $start, $end) = split/\t/;
617 # skip comment lines.
618 if (/^\#/) { next(); }
620 if ($chr == $chromosome_number) {
621 #print STDERR "Adding feature $type ($start, $end)\n";
622 $pachytene_object -> add_feature
($type, $start, $end);