lib/CXGN/Cview/Map_overviews/QTL_overview.pm

   1
   2
   3
   4 =head1 NAME
   5
   6 CXGN::Cview::Map_overviews::Generic - a class to display generic genetic map overviews.
   7
   8 =head1 SYNOPSYS
   9
  10 see L<CXGN::Cview::Map_overviews>.
  11
  12 =head1 DESCRIPTION
  13
  14
  15 =head1 AUTHOR(S)
  16
  17 Lukas Mueller (lam87@cornell.edu)
  18
  19 Isaak Tecle (iyt2@cornell.edu)
  20
  21 =head1 VERSION
  22
  23
  24 =head1 LICENSE
  25
  26
  27 =head1 FUNCTIONS
  28
  29 This class implements the following functions:
  30
  31 =cut
  32
  33
  34
  35 use strict;
  36
  37 package CXGN::Cview::Map_overviews::QTL_overview;
  38
  39 use CXGN::Cview::Map::Tools;
  40 use CXGN::Marker::Tools qw | clean_marker_name |;
  41 use CXGN::Cview::Chromosome::LineGraph;
  42 use base qw ( CXGN::Cview::Map_overviews::Generic );
  43
  44
  45 =head2 function new()
  46
  47  Synopsis:      my $overview = CXGN::Cview::Map_overviews::QTL_overview->
  48                  new(CXGN::Cview::Map::SGN::Genetic->new(9),$qtl_file);
  49  Arguments:     (1) The a CXGN::Cview::Map object for the map to be
  50                     displayed.
  51                 (2) the QTL file from R/QTL
  52                     this file has the format:
  53                     marker_name \t chromosome \t position \t lod score
  54  Returns:       an overview object (constructor)
  55  Side effects:  sets up the overview object.
  56  Description:
  57
  58 =cut
  59
  60 sub new {
  61     my $class = shift;
  62     my $map = shift;
  63     my $qtl_file =shift;
  64     my $force = shift;
  65
  66     my $self = $class -> SUPER::new($map, $force);
  67
  68     #print STDERR "We are in the constructure now\n";
  69     if (!$map) { exit(); }
  70     $self->set_qtl_file($qtl_file);
  71     $self->set_map($map);
  72     return $self;
  73 }
  74
  75
  76 # sub render {
  77 #     my $self = shift;
  78 #     my $map_width=$self->get_image_width();
  79 #     my $image_height = $self->get_image_height();
  80 #     my $top_margin = 40;
  81
  82 #     my @c = ();
  83
  84 #     $self->set_chromosomes(\@c);
  85 # }
  86
  87 sub render {
  88     my $self = shift;
  89     my $map_width=$self->get_image_width();
  90     my $image_height = $self->get_image_height();
  91     my $top_margin = 40;
  92     $self->{map_image}= CXGN::Cview::MapImage->new("", $map_width, $image_height);
  93
  94     $self->SUPER::render($map_width, $image_height);
  95
  96     my $c = $self->get_chromosomes();
  97
  98     my @graphs = ();
  99
 100     my $maximum = -99999;
 101
 102     #print STDERR "Current QTL file is ".$self->get_qtl_file()."\n";
 103     open (my $F, "<", $self->get_qtl_file()) || die "Can't open qtl file ".$self->get_qtl_file()." $!";
 104     my $first_line = <$F>;
 105     while (<$F>) {
 106         chomp;
 107         my ($marker, $chr, $pos, $lod) = split /\s+/;
 108
 109         #print STDERR "$marker, $chr, $pos, $lod\n";
 110
 111         if ($lod>$maximum) { $maximum = $lod; }
 112         if (!exists($graphs[$chr])) {
 113             $graphs[$chr]=CXGN::Cview::Chromosome::LineGraph->new();
 114             $graphs[$chr]->set_width($self->get_horizontal_spacing() - $c->[$chr-1]->get_width() -8);
 115             $graphs[$chr]->set_horizontal_offset($c->[$chr-1]->get_horizontal_offset() + $c->[$chr-1]->get_width()/2 + $graphs[$chr]->get_width()/2 + 4) ;
 116
 117             $graphs[$chr]->set_vertical_offset($c->[$chr-1]->get_vertical_offset() );
 118
 119             $graphs[$chr]->set_length($c->[$chr-1]->get_length());
 120             $graphs[$chr]->set_height($c->[$chr-1]->get_height());
 121
 122         }
 123         $graphs[$chr]->add_association("LOD", $pos, $lod);
 124     }
 125
 126     #print STDERR "The map has ".scalar(@$c)." chromosomes!\n";
 127     for (my $i=0; $i<@$c; $i++) {
 128         #print STDERR "Adding graph to chromosome in slot $i...\n";
 129         $c->[$i]->set_name($i);
 130         $c->[$i]->set_bargraph($graphs[$i+1]);
 131         $c->[$i]->show_bargraph();
 132
 133         $graphs[$i+1]->set_maximum($maximum);
 134         $graphs[$i+1]->set_caption("");
 135     }
 136
 137 }
 138
 139 sub render_map {
 140     my $self = shift;
 141
 142     die "We are in render_map in QTL_overview...\n";
 143     # set up the cache
 144     $self->get_cache()->set_key($self->get_map()->get_id()."-".($self->get_image_height())."-".(join "-", ($self->get_hilite_markers())).__PACKAGE__ );
 145     $self->get_cache()->set_map_name("mapmap");
 146
 147     if ($self->get_cache()->is_valid())  {
 148         return;
 149     }
 150
 151     #print STDERR "Regenerating the map ".$self->get_map()->get_id()."\n";
 152     $self->render();
 153
 154     $self->get_cache()->set_image_data( $self->{map_image}->render_png_string());
 155     $self->get_cache()->set_image_map_data( $self->{map_image}->get_image_map("mapmap") );
 156
 157
 158 }
 159
 160 sub is_fish_map {
 161     my $self = shift;
 162     if ($self->get_map()->get_type() =~/fish/i) { return 1;    }
 163     else {
 164         return 0;
 165     }
 166 }
 167
 168
 169 =head2 function get_map
 170
 171  Synopsis:
 172  Arguments:
 173  Returns:       gets the map object to refer to.
 174  Side effects:
 175  Description:
 176
 177 =cut
 178
 179 sub get_map {
 180     my $self=shift;
 181     return $self->{map};
 182 }
 183
 184 =head2 function set_map
 185
 186  Synopsis:
 187  Arguments:     the map object to refer to
 188  Returns:       nothing
 189  Side effects:  the data about map object will be displayed
 190  Description:
 191
 192 =cut
 193
 194 sub set_map {
 195     my $self=shift;
 196     $self->{map}=shift;
 197 }
 198
 199
 200 =head2 accessors get_qtl_file, set_qtl_file
 201
 202  Usage:
 203  Desc:
 204  Property
 205  Side Effects:
 206  Example:
 207
 208 =cut
 209
 210 sub get_qtl_file {
 211   my $self = shift;
 212   return $self->{qtl_file};
 213 }
 214
 215 sub set_qtl_file {
 216   my $self = shift;
 217   $self->{qtl_file} = shift;
 218 }
 219
 220
 221
 222 # no need to override this function here because the default
 223 # in the parent class are fine for our purposes.
 224 #
 225 # =head2 function get_cache_key
 226
 227 #   Synopsis:
 228 #   Arguments:
 229 #   Returns:
 230 #   Side effects:
 231 #   Description:
 232
 233 # =cut
 234
 235 # sub get_cache_key {
 236 #     my $self = shift;
 237 #     my $key =  $self->get_map()->map_id()."-".(join "-", ($self->get_hilite_markers())).__PACKAGE__;
 238 #     print STDERR "Setting cache key to : $key\n";
 239 #     return $key;
 240 # }
 241
 242
 243 # A deprecated package name.
 244 # but providing a compatibility layer...
 245 #
 246 package CXGN::Cview::Map_overviews::generic_map_overview;
 247
 248 use base qw | CXGN::Cview::Map_overviews::Generic | ;
 249
 250 sub new {
 251     my $class = shift;
 252     my $self = $class->SUPER::new(@_);
 253     return $self;
 254 }
 255
 256
 257 return 1;