]> git.donarmstrong.com Git - biopieces.git/blobdiff - code_perl/Maasha/BGB/Track.pm
added keys to assemble_pairs2
[biopieces.git] / code_perl / Maasha / BGB / Track.pm
index 6e2d0867844cbeea9188806a7a6ca72f7dc9b030..f536bbb3a41975c6ad3991a2dbc8d463d676a89d 100644 (file)
@@ -31,6 +31,7 @@ package Maasha::BGB::Track;
 use warnings;
 use strict;
 use Data::Dumper;
+use Time::HiRes;
 use Maasha::Common;
 use Maasha::Calc;
 use Maasha::Filesys;
@@ -61,6 +62,36 @@ use constant {
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
+sub track_grid
+{
+    # Martin A. Hansen, March 2010.
+    # Create a grid of vertical lines for the browser image.
+
+    my ( $cookie,   # browser cookie
+       ) = @_;
+
+    # Returns a list.
+
+    my ( @grid, $i );
+
+    for ( $i = 0; $i < $cookie->{ 'IMG_WIDTH' }; $i += 20 )
+    {
+        push @grid, {
+            type       => 'grid',
+            line_width => 1,
+            color      => [ 0.82, 0.89, 1 ],
+            x1         => $i,
+            y1         => 0,
+            x2         => $i,
+            y2         => $cookie->{ 'TRACK_OFFSET' },
+        };
+    }
+
+    return wantarray ? @grid : \@grid;
+}
+
+
 sub track_ruler
 {
     # Martin A. Hansen, November 2009.
@@ -77,7 +108,7 @@ sub track_ruler
 
     $beg    = $cookie->{ 'NAV_START' };
     $end    = $cookie->{ 'NAV_END' };
-    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
+    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
     
     $step = 10;
 
@@ -85,25 +116,30 @@ sub track_ruler
         $step *= 5;
     }
 
-    for ( $i = $beg; $i < $end; $i++ )
+    $i = 0;
+
+    while ( $i <= $beg ) {
+        $i += $step;
+    }
+
+    while ( $i < $end )
     {
-        if ( ( $i % $step ) == 0 )
-        {
-            $txt = "|" . Maasha::Calc::commify( $i );
-            $x   = sprintf( "%.0f", ( ( $i - $beg ) * $factor ) + 2 );
+        $txt = "|" . Maasha::Calc::commify( $i );
+        $x   = sprintf( "%.0f", ( ( $i - $beg ) * $factor ) + 2 );
 
-            if ( $x > 0 and $x + ( $cookie->{ 'RULER_FONT_SIZE' } * length $txt ) < $cookie->{ 'IMG_WIDTH' } )
-            {
-                push @ruler, {
-                    type      => 'text',
-                    txt       => $txt,
-                    font_size => $cookie->{ 'RULER_FONT_SIZE' },
-                    color     => $cookie->{ 'RULER_COLOR' },
-                    x1        => $x,
-                    y1        => $cookie->{ 'TRACK_OFFSET' },
-                };
-            }
+        if ( $x > 0 and $x + ( $cookie->{ 'RULER_FONT_SIZE' } * length $txt ) < $cookie->{ 'IMG_WIDTH' } )
+        {
+            push @ruler, {
+                type      => 'text',
+                txt       => $txt,
+                font_size => $cookie->{ 'RULER_FONT_SIZE' },
+                color     => $cookie->{ 'RULER_COLOR' },
+                x1        => $x,
+                y1        => $cookie->{ 'TRACK_OFFSET' },
+            };
         }
+
+        $i += $step;
     }
 
     $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'TRACK_SPACE' };
@@ -173,38 +209,50 @@ sub track_feature
 
     # Returns a list.
 
-    my ( $data_wig, $data_kiss, $track_name, $features );
+    my ( $data_wig, $data_kiss, $track_pretty, $track_name, $features, $color );
 
     $track_name = ( split "/", $track )[ -1 ];
-    $track_name =~ s/^\d+_//;
-    $track_name =~ s/_/ /g;
+
+    $track_pretty = $track_name;
+    $track_pretty =~ s/^\d+_//;
+    $track_pretty =~ s/_/ /g;
+
+    if ( track_hide( $cookie, $track_name ) ) {
+        $color = [ 0.6, 0.6, 0.6 ];
+    } else {
+        $color = $cookie->{ 'SEQ_COLOR' };
+    }
 
     push @{ $features }, {
-        type      => 'text',
-        txt       => $track_name,
+        type      => 'track_name',
+        track     => $track_name,
+        txt       => $track_pretty,
         font_size => $cookie->{ 'SEQ_FONT_SIZE' },
-        color     => $cookie->{ 'SEQ_COLOR' },
+        color     => $color,
         x1        => 0,
         y1        => $cookie->{ 'TRACK_OFFSET' },
     };
 
     $cookie->{ 'TRACK_OFFSET' } += 10;
 
-    if ( -f "$track/track_data.wig" )
+    if ( not track_hide( $cookie, $track_name ) )
     {
-        $data_wig = Maasha::BGB::Wiggle::wiggle_retrieve( "$track/track_data.wig", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } ); 
+        if ( -f "$track/track_data.wig" )
+        {
+            $data_wig = Maasha::BGB::Wiggle::wiggle_retrieve( "$track/track_data.wig", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } ); 
 
-        push @{ $features }, track_wiggle( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_wig );
-    }
-    elsif ( -f "$track/track_data.kiss" )
-    {
-        $data_kiss = Maasha::KISS::kiss_retrieve( "$track/track_data.kiss", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
+            push @{ $features }, track_wiggle( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_wig );
+        }
+        elsif ( -f "$track/track_data.kiss" )
+        {
+            $data_kiss = Maasha::KISS::kiss_retrieve( "$track/track_data.kiss", $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' } );
 
-        push @{ $features }, track_linear( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_kiss );
-    }
-    else
-    {
-        Maasha::Common::error( "Unknown track data type" );
+            push @{ $features }, track_linear( $cookie, $cookie->{ 'NAV_START' }, $cookie->{ 'NAV_END' }, $data_kiss );
+        }
+        else
+        {
+            Maasha::Common::error( "Unknown track data type" );
+        }
     }
 
     return wantarray ? @{ $features } : $features;
@@ -225,47 +273,57 @@ sub track_wiggle
 
     # Returns a list.
 
-    my ( $i, $height, $max_val, $min_val, $max, $factor, $x1, $y1, $x2, $y2, @features );
+    my ( $i, $max_val, $min_val, $factor, $factor_height, $x1, $y1, $x2, $y2, $block_max, $mean, @features );
 
-    $height  = 75;   # pixels
+    $cookie->{ 'TRACK_OFFSET' } += 10;
 
-    ( $min_val, $max_val ) = Maasha::Calc::minmax( $vals );
+    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
 
-    $vals    = Maasha::BGB::Wiggle::wiggle_normalize( $vals, $cookie->{ 'IMG_WIDTH' } );
+    ( $min_val, $max_val ) = Maasha::Calc::minmax( $vals );
 
-    $max     = Maasha::Calc::list_max( $vals );
-    $max   ||= 1;
+    if ( $max_val == 0 ) {
+        $factor_height = $cookie->{ 'WIGGLE_HEIGHT' } / 1;
+    } else {
+        $factor_height = $cookie->{ 'WIGGLE_HEIGHT' } / $max_val;
+    }
 
-    $factor = $height / $max;
+    $block_max = 0;
 
     $x1 = 0;
-    $y1 = $cookie->{ 'TRACK_OFFSET' } + $height;
+    $y1 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' };
 
     for ( $i = 0; $i < scalar @{ $vals }; $i++ )
     {
-        $x2 = $i;
-        $y2 = $cookie->{ 'TRACK_OFFSET' } + $height - sprintf( "%.0f", $vals->[ $i ] * $factor );
+        $block_max = Maasha::Calc::max( $block_max, $vals->[ $i ] );
 
-        push @features, {
-            type  => 'wiggle',
-            color => $cookie->{ 'FEAT_COLOR' },
-            line_width => 1,
-            x1         => $x1,
-            y1         => $y1,
-            x2         => $x2,
-            y2         => $y2,
-        };
+        $x2 = int( $i * $factor );
+
+        if ( $x2 > $x1 )
+        {
+            $y2 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' } - sprintf( "%.0f", $block_max * $factor_height );
 
-        $x1 = $x2;
-        $y1 = $y2;
+            push @features, {
+                type       => 'wiggle',
+                color      => $cookie->{ 'FEAT_COLOR' },
+                line_width => 1,
+                x1         => $x1,
+                y1         => $y1,
+                x2         => $x2,
+                y2         => $y2,
+            };
+
+            $x1 = $x2;
+            $y1 = $y2;
+
+            $block_max = 0;
+        }
     }
 
-    $x2 = $i;
-    $y2 = $cookie->{ 'TRACK_OFFSET' } + $height;
+    $y2 = $cookie->{ 'TRACK_OFFSET' } + $cookie->{ 'WIGGLE_HEIGHT' };
 
     push @features, {
-        type  => 'wiggle',
-        color => $cookie->{ 'FEAT_COLOR' },
+        type       => 'wiggle',
+        color      => $cookie->{ 'FEAT_COLOR' },
         line_width => 1,
         x1         => $x1,
         y1         => $y1,
@@ -279,10 +337,10 @@ sub track_wiggle
         font_size => $cookie->{ 'SEQ_FONT_SIZE' } - 2,
         color     => $cookie->{ 'SEQ_COLOR' },
         x1        => 0,
-        y1        => $cookie->{ 'TRACK_OFFSET' },
+        y1        => $cookie->{ 'TRACK_OFFSET' } - 5,
     };
 
-    $cookie->{ 'TRACK_OFFSET' } += $height + $cookie->{ 'TRACK_SPACE' };
+    $cookie->{ 'TRACK_OFFSET' } += $cookie->{ 'WIGGLE_HEIGHT' } + $cookie->{ 'TRACK_SPACE' };
 
     return wantarray ? @features : \@features;
 }
@@ -305,7 +363,7 @@ sub track_linear
     
     my ( $factor, $entry, $y_step, @ladder, $y_max, $w, $x1, $y1, $x2, $y2, $feature, @features );
 
-    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg + 1 );
+    $factor = $cookie->{ 'IMG_WIDTH' } / ( $end - $beg );
     $y_step = 0;
     $y_max  = 0;
 
@@ -316,12 +374,16 @@ sub track_linear
         if ( $w >= 1 )
         {
             $x1 = sprintf( "%.0f", ( $entry->[ S_BEG ] - $beg ) * $factor );
+            $x2 = $x1 + $w;
+            $x1 = 0 if $x1 < 0;
+            $x2 = $cookie->{ 'IMG_WIDTH' } if $x2 > $cookie->{ 'IMG_WIDTH' };
 
             for ( $y_step = 0; $y_step < @ladder; $y_step++ ) {
                 last if $x1 >= $ladder[ $y_step ] + 1; 
             }
 
             $y1 = $cookie->{ 'TRACK_OFFSET' } + ( ( 1.1 + $cookie->{ 'FEAT_WIDTH' } ) * $y_step );
+            $y2 = $y1 + $cookie->{ 'FEAT_WIDTH' };
 
             $feature = {
                 line_width => $cookie->{ 'FEAT_WIDTH' },
@@ -333,8 +395,8 @@ sub track_linear
                 strand     => $entry->[ STRAND ],
                 x1         => $x1,
                 y1         => $y1,
-                x2         => $x1 + $w,
-                y2         => $y1 + $cookie->{ 'FEAT_WIDTH' },
+                x2         => $x2,
+                y2         => $y2,
             };
 
             if ( $entry->[ STRAND ] eq '+' or $entry->[ STRAND ] eq '-' ) {
@@ -349,7 +411,8 @@ sub track_linear
 
             push @features, feature_align( $entry, $beg, $y1, $factor, $cookie->{ 'FEAT_WIDTH' } ) if $entry->[ ALIGN ] ne '.';
 
-            $ladder[ $y_step ] = $x1 + $w;
+            # $ladder[ $y_step ] = $x1 + $w;
+            $ladder[ $y_step ] =  sprintf( "%.0f", ( $entry->[ S_BEG ] - $beg ) * $factor ) + $w;
         }
     }
 
@@ -384,7 +447,7 @@ sub feature_align
     {
         foreach $align ( split /,/, $entry->[ ALIGN ] )
         {
-            if ( $align =~ /(\d+):([ATCGN-])>([ATCGN-])/ )
+            if ( $align =~ /(\d+):([ATCGRYKMSWBDHVN-])>([ATCGRYKMSWBDHVN-])/ )
             {
                 $pos       = $1;
                 $nt_before = $2;
@@ -449,7 +512,7 @@ sub track_feature_histogram
     $hist_height  = 100;   # pixels
     $bucket_width = 5;
     $bucket_count = $cookie->{ 'IMG_WIDTH' } / $bucket_width;
-    $factor       = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min + 1 );
+    $factor       = ( $cookie->{ 'IMG_WIDTH' } / $bucket_width ) / ( $max - $min );
 
     $min_bucket = 999999999;
     $max_height = 0;
@@ -581,52 +644,6 @@ sub path_seq
 }
 
 
-sub path_tracks
-{
-    # Martin A. Hansen, November 2009.
-    
-    # Returns a list of paths to all tracks for a specified
-    # contig as written in the cookie.
-
-    my ( $cookie,   # cookie path
-       ) = @_;
-
-    # Returns a list.
-
-    my ( $path, @tracks );
-
-    die qq(ERROR: no USER in cookie.\n)     if not $cookie->{ 'USER' };
-    die qq(ERROR: no CLADE in cookie.\n)    if not $cookie->{ 'CLADE' };
-    die qq(ERROR: no GENOME in cookie.\n)   if not $cookie->{ 'GENOME' };
-    die qq(ERROR: no ASSEMBLY in cookie.\n) if not $cookie->{ 'ASSEMBLY' };
-    die qq(ERROR: no CONTIG in cookie.\n)   if not $cookie->{ 'CONTIG' };
-
-    $path = join( "/",
-        $cookie->{ 'DATA_DIR' },
-        "Users",
-        $cookie->{ 'USER' },
-        $cookie->{ 'CLADE' },
-        $cookie->{ 'GENOME' },
-        $cookie->{ 'ASSEMBLY' },
-        $cookie->{ 'CONTIG' },
-        "Tracks",
-    );
-
-    if ( -d $path )
-    {
-        @tracks = Maasha::Filesys::ls_dirs( $path );
-
-        @tracks = grep { $_ !~ /\/\.\.?$/ } @tracks;
-
-        return wantarray ? @tracks : \@tracks;
-    }
-    else
-    {
-        return wantarray ? () : [];
-    }
-}
-
-
 sub search_tracks
 {
     # Martin A. Hansen, December 2009.
@@ -657,7 +674,7 @@ sub search_tracks
     {
         $cookie->{ 'CONTIG' } = $contig;
 
-        push @tracks, path_tracks( $cookie );
+        push @tracks, list_track_dir( $cookie->{ 'USER' }, $cookie->{ 'CLADE' }, $cookie->{ 'GENOME' }, $cookie->{ 'ASSEMBLY' }, $cookie->{ 'CONTIG' } );
     }
 
     foreach $track ( @tracks )
@@ -847,7 +864,9 @@ sub list_assembly_dir
 
     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 
-    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
+    if ( $user and $clade and $genome ) {
+        @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
+    }
 
     @assemblies = grep { $_ !~ /\/\.\.?$/ } @dirs;
 
@@ -898,7 +917,9 @@ sub list_contig_dir
 
     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 
-    @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
+    if ( $user and $clade and $genome and $assembly ) {
+        @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
+    }
 
     @contigs = grep { $_ !~ /\/\.\.?$/ } @dirs;
 
@@ -1023,6 +1044,35 @@ sub max_track
 }
 
 
+sub track_hide
+{
+    # Martin A. Hansen, March 2010.
+
+    # Check cookie information to see if a given track
+    # should be hidden or not.
+
+    my ( $cookie,   # cookie hash
+         $track,    # track name
+       ) = @_;
+
+    # Returns boolean.
+
+    my ( $clade, $genome, $assembly );
+
+    $clade    = $cookie->{ 'CLADE' };
+    $genome   = $cookie->{ 'GENOME' };
+    $assembly = $cookie->{ 'ASSEMBLY' };
+
+    if ( exists $cookie->{ 'TRACK_STATUS' }->{ $clade }->{ $genome }->{ $assembly }->{ $track } and
+                $cookie->{ 'TRACK_STATUS' }->{ $clade }->{ $genome }->{ $assembly }->{ $track } )
+    {
+        return 1;
+    }
+
+    return 0;
+}
+
+
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 1;
@@ -1060,7 +1110,7 @@ sub search_tracks_nc
     {
         $cookie->{ 'CONTIG' } = $contig;
 
-        push @tracks, path_tracks( $cookie );
+        push @tracks, list_track_dir( $cookie->{ 'USER' }, $cookie->{ 'CLADE' }, $cookie->{ 'GENOME' }, $cookie->{ 'ASSEMBLY' }, $cookie->{ 'CONTIG' } );
     }
 
     foreach $track ( @tracks )
@@ -1135,3 +1185,7 @@ sub track_feature
 
     return wantarray ? @{ $features } : $features;
 }
+
+
+my $t0 = Time::HiRes::gettimeofday();
+my $t1 = Time::HiRes::gettimeofday(); print STDERR "Time: " . ( $t1 - $t0 ) . "\n";