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

   1
   2
   3 =head1 NAME
   4
   5 CXGN::Cview::Map::SGN::Fish - a class to generate cytological fish maps.
   6
   7 =head1 SYNOPSYS
   8
   9  my $fish = CXGN::Cview::Map::SGN::Fish->new($dbh, 13);
  10  $fish->fetch_pachytene_idiogram();
  11  my $chr = $fish->get_chromosome(2);
  12
  13  # etc...
  14
  15 =head1 DESCRIPTION
  16
  17 A class to generate cytological fish maps. Two idiograms are supported: "stack" and "dejong", which differ slightly, but no fundamentally. The "dejong" represenation was used till Oct 2009, upon Steve's request we changed to the "stack"representation by default. The third argument in the constructor can still be given as "dejong" to produce the De Jong idiograms.
  18
  19 =head1 AUTHOR(S)
  20
  21 Lukas Mueller <lam87@cornell.edu>
  22
  23 =head1 VERSION
  24
  25 1.1
  26
  27 =head1 COPYRIGHT & LICENSE
  28
  29 Copyright (c) 2009 Boyce Thompson Institute for Plant Research
  30
  31 This program is free software; you can redistribute it and/or modify
  32 it under the same terms as Perl itself.
  33
  34
  35 =head1 FUNCTIONS
  36
  37 This class implements the following functions:
  38
  39 =cut
  40
  41 use strict;
  42 use warnings;
  43
  44 package CXGN::Cview::Map::SGN::Fish;
  45
  46 use CXGN::Cview::Map;
  47 use CXGN::Cview::Map::Tools;
  48 use CXGN::Cview::Marker::FISHMarker;
  49
  50 use base qw | CXGN::Cview::Map::SGN::Genetic |;
  51
  52 =head2 constructor new()
  53
  54   Synopsis:     my $pi = CXGN::Cview::Map::SGN::Fish->new(
  55                    $dbh, $id, $version );
  56   Arguments:    a database handle
  57                 an id (for SGN, this is map_id=13
  58                 a version (either "stack" or "dejong", used
  59                 to draw the pachytene representation accordingly).
  60   Returns:      a CXGN::Cview::Map::SGN::Fish object
  61
  62 =cut
  63
  64 sub new {
  65     my $class = shift;
  66     my $dbh = shift;
  67     my $id = shift;
  68     my $args = shift;
  69
  70     my $self = $class->SUPER::new($dbh, $id);
  71     $self->set_id($id);
  72
  73     $self->{pachytene_version} = $args->{pachytene_version};
  74     $self->{basepath} = $args->{basepath};
  75     $self->{documents_subdir} = $args->{documents_subdir};
  76     $self->{pachytene_file} = $args->{pachytene_file};
  77
  78     $self->set_preferred_chromosome_width(12);
  79     $self->set_chromosome_names("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12");
  80     $self->set_chromosome_count(12);
  81     $self->fetch_pachytene_idiograms();
  82     $self->set_units("%");
  83     $self->set_legend(CXGN::Cview::Legend->new());
  84     return $self;
  85 }
  86
  87 =head2 function fetch_pachytene_idiogram()
  88
  89   Synopsis:     $pi->fetch_pachytene_idiogram
  90   Arguments:    loads the pachytene idiogram from a standard location.
  91   Returns:      nothing
  92   Side effects: the idiogram definition fetched will be the
  93                 basis for the chromosome rendering
  94   Description:
  95
  96 =cut
  97
  98 sub fetch_pachytene_idiograms {
  99     my $self = shift;
 100
 101     #my $file_name = "pachytene_stack.txt";
 102
 103     #if (defined($self->{pachytene_version}) && $self->{pachytene_version} =~/dejong/i ) {
 104 #       $file_name = "pachytene_tomato_dapi.txt";
 105  #   }
 106
 107    # my $data_folder="../../documents/cview/pachytene";
 108
 109     #print STDERR "DATA FOLDER: $data_folder\n";
 110
 111     open (my $F, '<', $self->{pachytene_file}) || die "Can't open pachytene def file: $self->{pachytene_file} ... $!";
 112     my %chr_len=();;
 113     @{$self->{pachytene_idiograms}} = ();
 114     for my $n ($self->get_chromosome_names()) {
 115         push @{$self->{pachytene_idiograms}}, CXGN::Cview::Chromosome::PachyteneIdiogram->new();
 116     }
 117     my $short_arm=0;
 118     my $long_arm=0;
 119
 120     my $old_chr = "";
 121     my ($chr, $type, $start, $end) = (undef, undef, undef, undef);
 122     while (<$F>) {
 123         chomp;
 124
 125         # skip comment lines.
 126         if (/^\#/) { next(); }
 127         ($chr, $type, $start, $end) = split/\t/;
 128
 129         if ($chr ne $old_chr) {
 130             $chr_len{$old_chr}=($short_arm + $long_arm);
 131             $short_arm = 0;
 132             $long_arm = 0;
 133             $old_chr = $chr;
 134         }
 135
 136         #print STDERR "Adding feature $type ($start, $end)\n";
 137         $self->{pachytene_idiograms}->[$chr-1] -> add_feature($type, $start, $end);
 138
 139         if ($type eq "short_arm") {
 140             $short_arm = abs($start) + abs($end);
 141         }
 142         if ($type eq "long_arm") {
 143             $long_arm = abs($start) + abs($end);
 144         }
 145
 146     }
 147     # deal with the last entry
 148     $chr_len{$chr}=($short_arm + $long_arm);
 149
 150     my @chr_len = ();
 151     foreach my $n ($self->get_chromosome_names()) {
 152         push @chr_len, $chr_len{$n};
 153     }
 154     #print STDERR "Setting chromosome lengths to : ".(join " ", @chr_len)."\n";
 155     $self->set_chromosome_lengths(@chr_len);
 156     #print STDERR "Getting chromosome lengths: ".(join " ", $self->get_chromosome_lengths())."\n";
 157
 158 }
 159
 160
 161
 162 sub get_pachytene_idiogram {
 163     my $self = shift;
 164     my $chr_index = shift;
 165     return $self->{pachytene_idiograms}->[$chr_index];
 166 }
 167
 168 =head2 function get_chromosome()
 169
 170 See parent class for description
 171
 172 =cut
 173
 174 sub get_chromosome {
 175     my $self = shift;
 176     my $chr_nr = shift;
 177
 178     my $chromosome = $self->get_pachytene_idiogram($chr_nr-1);
 179
 180     # The following query is a composition of 3 subqueries (look for the 'AS'
 181     # keywords), joined using the clone_id.  Here's what the subqueries do:
 182     #
 183     # * clone_id_and_percent: gets the average percent distance from the
 184     #   centromere as a signed float between -1.0 and +1.0, for each
 185     #   BAC on a given chromosome.  This is done by first computing the
 186     #   average absolute distance from the centromere (signed, in um),
 187     #   and then dividing by the length of the arm that the average
 188     #   would be located on.
 189     #
 190     # * min_marker_for_clone: finds one marker associated with the BAC
 191     #   (if any).
 192     #
 193     # * clone_info: finds the library shortname and clone name components.
 194     my $query = "
 195    SELECT shortname, clone_id, platenum, wellrow, wellcol, percent, marker_id
 196      FROM (SELECT clone_id, (CASE WHEN absdist < 0
 197                                        THEN absdist / short_arm_length
 198                                        ELSE absdist / long_arm_length END) AS percent
 199              FROM (SELECT clone_id, chromo_num,
 200                           AVG(percent_from_centromere * arm_length *
 201                               CASE WHEN r.chromo_arm = 'P' THEN -1 ELSE 1 END)
 202                               AS absdist
 203                      FROM fish_result r
 204                      JOIN fish_karyotype_constants k USING (chromo_num, chromo_arm)
 205                     WHERE chromo_num = ?
 206                     GROUP BY clone_id, chromo_num) AS clone_id_and_absdist
 207              JOIN (SELECT k1.chromo_num, k1.arm_length AS short_arm_length,
 208                           k2.arm_length AS long_arm_length
 209                      FROM fish_karyotype_constants k1
 210                      JOIN fish_karyotype_constants k2 USING (chromo_num)
 211                     WHERE k1.chromo_arm = 'P' AND k2.chromo_arm = 'Q')
 212                    AS karyotype_rearranged USING (chromo_num))
 213        AS clone_id_and_percent
 214
 215 LEFT JOIN physical.bac_marker_matches ON (clone_id=bac_id)
 216
 217 LEFT JOIN (SELECT shortname, clone_id, platenum, wellrow, wellcol
 218              FROM genomic.clone
 219              JOIN genomic.library USING (library_id))
 220        AS clone_info USING (clone_id)
 221 GROUP BY clone_id, shortname, platenum, wellrow, wellcol, percent, marker_id ORDER BY percent
 222 ";
 223
 224     my $sth = $self->get_dbh()->prepare($query);
 225     $sth->execute($chr_nr);
 226     while (my ($library_name, $clone_id, $platenum, $wellcol, $wellrow, $percent, $marker_id) = $sth->fetchrow_array()) {
 227         my $offset = 0;
 228         my $factor = 0;
 229         $offset = $percent * 100;
 230
 231         #print STDERR "OFFSET $offset \%\n";
 232
 233         my $clone_name = CXGN::Genomic::Clone->retrieve($clone_id)->clone_name();
 234
 235         my $m = CXGN::Cview::Marker::FISHMarker -> new($chromosome, $marker_id, $clone_name, "", 3, $offset+100, "", $offset );
 236         $m -> set_url("/maps/physical/clone_info.pl?id=".$clone_id);
 237         $chromosome->add_marker($m);
 238     }
 239     return $chromosome;
 240 }
 241
 242 =head2 function get_overgo_chromosome()
 243
 244 See parent class for description
 245
 246 =cut
 247
 248 sub get_overgo_chromosome {
 249     my $self = shift;
 250     my $chr_nr = shift;
 251     my $chr = $self->get_chromosome($chr_nr);
 252
 253     $chr->set_vertical_offset_centromere();
 254     return $chr;
 255
 256 }
 257
 258 =head2 function get_chromosome_connections()
 259
 260 See parent class for description
 261
 262 =cut
 263
 264 sub get_chromosome_connections {
 265     my $self = shift;
 266     my $chr_nr = shift;
 267     my @chr_list = ();
 268     my $map_version_id = CXGN::Cview::Map::Tools::find_current_version($self->get_dbh(), CXGN::Cview::Map::Tools::current_tomato_map_id );
 269     #print STDERR "Map_version_id is : $map_version_id. \n";
 270     push @chr_list, { map_version_id=>$map_version_id, short_name=>"F2-2000", lg_name=>$chr_nr, marker_count=>"?" };
 271     return @chr_list;
 272
 273 }
 274
 275
 276 =head2 function get_preferred_chromosome_width()
 277
 278 This function returns 12. Yep.
 279
 280 =cut
 281
 282 sub get_preferred_chromosome_width {
 283     return 12;
 284 }
 285
 286 =head2 function collapsed_marker_count()
 287
 288 This function returns a large number (hard-coded) to make sure that no fish experiments are hidden from the chromosome view (if the number of fish experiments becomes really large this will need to be revisited).
 289
 290 =cut
 291
 292 sub collapsed_marker_count {
 293     return 2000;
 294 }
 295
 296 sub can_zoom {
 297     return 0;
 298 }
 299
 300 =head2 function get_map_stats()
 301
 302 See parent class for description.
 303
 304 =cut
 305
 306 sub get_map_stats {
 307     my $self = shift;
 308     my $query = "SELECT count(distinct(clone_id)) FROM sgn.fish_result";
 309     my $sth = $self->get_dbh()->prepare($query);
 310     $sth->execute();
 311     my ($count) = $sth->fetchrow_array();
 312     return "Total number of fished clones: $count\n";
 313 }
 314
 315 =head2 function get_marker_count()
 316
 317 See parent class for description.
 318
 319 =cut
 320
 321 sub get_marker_count {
 322     my $self = shift;
 323     my $chr_nr = shift;
 324     my $query = "SELECT count(distinct(clone_id)) FROM sgn.fish_result WHERE chromo_num=?";
 325     my $sth = $self->get_dbh()->prepare($query);
 326     $sth->execute($chr_nr);
 327     my ($count) = $sth->fetchrow_array();
 328     return $count;
 329
 330 }
 331
 332 1;