lib/CXGN/Cview/VectorViewer.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Cview::VectorViewer - a class to view and manipulate vectors
   5
   6 =head1 DESCRIPTION
   7
   8 This class implements a viewer/editor for circular vector sequences.
   9
  10 It can either use a genbank record as an input, or its native data format. It can also detect restriction sites in the sequence.
  11
  12 A figure is produced that represents the vector.
  13
  14 The native format contains a type column (containing either "FEATURE", "NAME", "SEQUENCE" etc.) and has the following comma delimited columns for the type FEATURE:
  15
  16  FEATURE
  17  name
  18  start coord
  19  end coord
  20  orientation
  21  color
  22
  23 The columns for the type NAME:
  24
  25  NAME
  26  the_name
  27
  28 Columns for type SEQUENCE:
  29
  30  SEQUENCE
  31  the_sequence
  32
  33
  34
  35
  36 =head1 AUTHOR
  37
  38 Lukas Mueller <lam87@cornell.edu>
  39
  40 =head1 METHODS
  41
  42 This class implements the following methods:
  43
  44 =cut
  45
  46 use strict;
  47
  48 package CXGN::Cview::VectorViewer;
  49
  50 use Bio::SeqIO;
  51 use Bio::Restriction::Analysis;
  52
  53 use CXGN::Cview::MapImage;
  54 use CXGN::Cview::Chromosome::Vector;
  55 use CXGN::Cview::Marker::VectorFeature;
  56
  57 =head2 new
  58
  59  Usage:        $vv = CXGN::Cview::VectorViewer->
  60                  new($map_name, $map_width, $map_height);
  61  Desc:         creates a new vector viewer object
  62  Args:         a map name, image width, image height
  63  Side Effects:
  64  Example:
  65
  66 =cut
  67
  68 sub new {
  69     my $class = shift;
  70     my $name = shift;
  71     my $width = shift;
  72     my $height = shift;
  73     my $self = bless {}, $class;
  74
  75     $self->{map_image} = CXGN::Cview::MapImage->new($name, $width, $height);
  76
  77     return $self;
  78
  79 }
  80
  81
  82 =head2 parse_native
  83
  84  Usage:        $vv->parse_native(@commands)
  85  Desc:         parses the native commands given in
  86                the lines of the list @commands
  87  Ret:          nothing
  88  Args:         a list of lines containing the commands
  89  Side Effects: stores the commands using set_commands_ref()
  90  Example:
  91
  92 =cut
  93
  94 sub parse_native {
  95     my $self = shift;
  96     my @input = @_;
  97
  98     my @commands = ();
  99
 100     foreach my $line (@input) {
 101         chomp($line);
 102         $line =~ s/\r//g;
 103         my @tokens = split /\s*,\s*/, $line;
 104
 105         if (!$tokens[0]) { next(); }
 106         push @commands, \@tokens;
 107
 108         if ($tokens[0] eq "SEQUENCE") { $self->set_sequence($tokens[1]); }
 109         if ($tokens[0] eq "LENGTH") { $self->set_seq_length($tokens[1]); }
 110     }
 111     $self->set_commands_ref(\@commands);
 112 }
 113
 114
 115
 116
 117 =head2 parse_genbank
 118
 119  Usage:        $vv->parse_genbank($fh)
 120  Desc:         parses the genbank file at $fh.
 121  Ret:
 122  Args:
 123  Side Effects: modifies the internal drawing commands.
 124  Example:
 125
 126 =cut
 127
 128 sub parse_genbank {
 129     my $self = shift;
 130     my $fh = shift;
 131
 132     my $sio = Bio::SeqIO->new( -fh => $fh, -format=>'genbank');
 133     my $s = $sio->next_seq();
 134     my @commands = ();
 135     my @features = $s -> get_SeqFeatures();
 136     foreach my $f (@features) {
 137         my $dir = "F";
 138         if ($f->strand() != 1) { $dir = "R"; }
 139         push @commands, [ "FEATURE", $f->primary_tag(), $f->start(), $f->end(), $dir ];
 140     }
 141     $self->set_sequence($s->seq());
 142     push @commands, [ "SEQUENCE", $self->get_sequence() ];
 143
 144     $self->set_commands_ref(\@commands);
 145 }
 146
 147
 148
 149 =head2 accessors get_commands_ref, set_commands_ref
 150
 151  Usage:        $c_ref = $vv -> get_commands_ref();
 152  Desc:         set/get the native drawing commands
 153                as a listref.
 154  Property:     the commands that are used to draw the vector.
 155
 156 =cut
 157
 158 sub get_commands_ref {
 159   my $self = shift;
 160   return $self->{commands};
 161 }
 162
 163 sub set_commands_ref {
 164   my $self = shift;
 165   $self->{commands} = shift;
 166 }
 167
 168 =head2 add_command
 169
 170  Usage:
 171  Desc:
 172  Ret:
 173  Args:
 174  Side Effects:
 175  Example:
 176
 177 =cut
 178
 179 sub add_command {
 180     my $self = shift;
 181     my @tokens = @_;
 182
 183     if (!$tokens[0]) { return; }
 184
 185     if ($tokens[0] eq "SEQUENCE") { $self->set_sequence($tokens[1]); }
 186     if ($tokens[0] eq "LENGTH") {  $self->set_seq_len($tokens[1]); }
 187
 188     push @{$self->{commands}}, \@tokens;
 189 }
 190
 191
 192
 193 =head2 accessors get_seq_length, set_seq_length
 194
 195  Usage:
 196  Desc:
 197  Property
 198  Side Effects:
 199  Example:
 200
 201 =cut
 202
 203 sub get_seq_length {
 204   my $self = shift;
 205   return $self->{seq_length};
 206 }
 207
 208 sub set_seq_length {
 209   my $self = shift;
 210   $self->{seq_length} = shift;
 211 }
 212
 213 =head2 accessors get_sequence, set_sequence
 214
 215  Usage:
 216  Desc:
 217  Property
 218  Side Effects:
 219  Example:
 220
 221 =cut
 222
 223 sub get_sequence {
 224   my $self = shift;
 225   return $self->{sequence};
 226 }
 227
 228 sub set_sequence {
 229   my $self = shift;
 230   $self->{sequence} = shift;
 231 }
 232
 233 =head2 restriction_analysis
 234
 235  Usage:        my $vv->restriction_analysis($ra_type)
 236  Desc:         performs the restriction analysis on the sequence.
 237                $ra_type can be any of the following:
 238                "all": all enzymes are shown. Usually overwhelming.
 239                "unique": the restriction enzymes that cut the sequence
 240                          only once are shown.
 241                "popular6bp": Popular 6bp restriction enzymes are shown
 242                "popular4bp": Popular 4bp restriction enzymes are shown
 243  Ret:
 244  Args:
 245  Side Effects: adds the restriction enzymes found to the drawing
 246                commands.
 247  Example:
 248
 249 =cut
 250
 251 sub restriction_analysis {
 252     my $self = shift;
 253     my $ra_type = shift;
 254
 255     my $seq = Bio::Seq->new( -seq=>$self->get_sequence());
 256     $seq->is_circular(1);
 257     if (!$seq->is_circular()) { die "It is not circular!"; }
 258     my $ra = Bio::Restriction::Analysis->new($seq);
 259     my $cutters;
 260     if ($ra_type eq "unique") {
 261         $cutters = $ra->unique_cutters();
 262     }
 263     else {
 264         $cutters = $ra->cutters();
 265     }
 266     foreach my $c ($cutters->each_enzyme()) {
 267         my $enzyme = $c->name();
 268         if ($ra_type eq "popular6bp") {
 269             if (!(grep /^$enzyme$/, ($self->popular_6bp_enzymes()))) {
 270                 next();
 271             }
 272         }
 273         if ($ra_type eq "popular4bp") {
 274             if (!(grep /^$enzyme$/, ($self->popular_4bp_enzymes()))) {
 275                 next();
 276             }
 277         }
 278
 279         my @fragments = $ra ->fragment_maps($c->name());
 280         foreach my $f (@fragments) {
 281             $self->add_command( "FEATURE",  $c->name(), $f->{start}, $f->{end}, "F", "gray");
 282         }
 283
 284     }
 285 }
 286
 287
 288 =head2 generate_image
 289
 290  Usage:        $vv->generate_image()
 291  Desc:         generates the png and html map for the vector
 292  Ret:          returns the html to display the image and
 293                the image map.
 294  Args:         none
 295  Side Effects: none
 296  Example:      none
 297
 298 =cut
 299
 300 sub generate_image {
 301     my $self = shift;
 302
 303     my $vh = CXGN::VHost->new();
 304
 305     my $cache = CXGN::Tools::WebImageCache->new();
 306     $cache->set_key("abc");
 307     $cache->set_force(1);
 308     $cache->set_expiration_time(86400); # seconds, this would be a day.
 309     $cache->set_map_name("map_name"); # what's in the <map name='map_name' tag.
 310     $cache->set_temp_dir($vh->get_conf("tempfiles_subdir")."/cview");
 311     $cache->set_basedir($vh->get_conf("basepath"));
 312
 313     my %color = ( red => [ 255, 0, 0], blue => [ 0, 0, 255], green=> [0, 255, 0], gray=>[100, 100, 100], yellow=>[255, 255, 0]);
 314     my $img_data;
 315     if (! $cache->is_valid()) {
 316
 317         my ($img_data, $img_map_data) = $self->render();
 318
 319
 320         $cache->set_image_data($img_data);
 321         $cache->set_image_map_data($img_map_data);
 322     }
 323
 324     my $image_html = $cache->get_image_html();
 325     return $image_html;
 326 }
 327
 328 =head2 render
 329
 330  Usage:        $vv->render()
 331  Desc:         renders the vector image on a GD::Image
 332  Ret:
 333  Args:
 334  Side Effects:
 335  Example:
 336
 337 =cut
 338
 339 sub render {
 340     my $self = shift;
 341
 342     my $image_width = $self->{map_image}->get_width();
 343     my $image_height = $self->{map_image}->get_height();
 344
 345     my $vector = CXGN::Cview::Chromosome::Vector->new(0, $image_height/3, $image_width/2, $image_height/2);
 346
 347     $vector->set_width(20);
 348     $vector->set_height($image_height/2);
 349     $vector->set_X($image_width/2);
 350     $vector->set_Y($image_height/2);
 351     $vector->set_length(length($self->get_sequence()));
 352
 353     my $identifier = 1;
 354
 355     foreach my $c (@{$self->get_commands_ref()}) {
 356         if ($c->[0] eq "NAME") { $vector->set_name($c->[1]); next(); }
 357         if ($c->[0] ne "FEATURE") { next(); }
 358         my $marker = CXGN::Cview::Marker::VectorFeature->new($vector);
 359         #die " Now adding a marker...";
 360         $marker->set_range_coords($c->[2], $c->[3]);
 361         my $label = $c->[1] . " (".$c->[2]."-".$c->[3]." ".$c->[4].")" ;
 362         if (!$marker->has_range()) { $label = $c->[1]." (".$c->[2].")"; }
 363         $marker->get_label()->set_name($label);
 364         $marker->set_name($identifier);
 365         if ($c->[4] !~ /R|F/i) { $c->[4]="F"; }
 366         $marker->set_orientation( $c->[4]);
 367         if (!$c->[5]) {
 368             if ($marker->has_range()) { $c->[5] = "red"; }
 369             else { $c->[5] = "gray"; }
 370         }
 371
 372         $marker->set_color(@{$self->get_color($c->[5])});
 373         $marker->get_label()->set_text_color(@{$self->get_color($c->[5])});
 374         $marker->get_label()->set_line_color(@{$self->get_color($c->[5])});
 375         $marker->get_label()->set_url("");
 376         if ($c->[6] eq "hilite") { $marker->get_label()->set_hilited(1); }
 377         $vector->add_marker($marker);
 378         $vector->set_caption($self->{map_image}->get_name());
 379         $identifier++;
 380     }
 381
 382     $self->{map_image}->add_chromosome($vector);
 383
 384     $vector->layout();
 385
 386     my $img_data = $self->{map_image}->render_png_string();
 387     my $img_map_data = $self->{map_image}->get_image_map();
 388
 389     return ($img_data, $img_map_data);
 390 }
 391
 392 =head2 popular_6bp_enzymes
 393
 394  Usage:        my @enzymes = $vv->popular_6bp_enzymes()
 395  Desc:         returns a list of popular 6bp enzymes
 396  Ret:
 397  Args:
 398  Side Effects:
 399  Example:
 400
 401 =cut
 402
 403 sub popular_6bp_enzymes {
 404     return qw | ClaI EcoRI EcoRV SmaI SmaIII HindIII BamHI KpnI SalI ScaI SphI PstI NotI XbaI XhoI SacI |;
 405 }
 406
 407 =head2 popular_4bp_enzymes
 408
 409  Usage:        my @enzymes = $vv->popular_4bp_enzymes()
 410  Desc:         returns a list of popular 4bp enzymes
 411  Ret:
 412  Args:
 413  Side Effects:
 414  Example:
 415
 416 =cut
 417
 418 sub popular_4bp_enzymes {
 419     return qw | MboI AluI HaeIII Sau3A TaqI |;
 420
 421 }
 422
 423 =head2 get_color
 424
 425  Usage:
 426  Desc:
 427  Ret:
 428  Args:
 429  Side Effects:
 430  Example:
 431
 432 =cut
 433
 434 sub get_color {
 435     my $self = shift;
 436     my $color = shift;
 437     my %color = ( red => [ 255, 0, 0], blue => [ 0, 0, 255], green=> [0, 255, 0], gray=>[100, 100, 100], yellow=>[255, 255, 0]);
 438     return $color{$color};
 439
 440 }
 441
 442
 443
 444 return 1;