From: martinahansen Date: Sat, 24 Oct 2009 20:26:48 +0000 (+0000) Subject: added zoom and move to KISS X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=4fe7b6cbb90bf089e349f5b8e4298c0193ece415;p=biopieces.git added zoom and move to KISS git-svn-id: http://biopieces.googlecode.com/svn/trunk@709 74ccb610-7750-0410-82ae-013aeee3265d --- diff --git a/code_perl/Maasha/Calc.pm b/code_perl/Maasha/Calc.pm index b894168..1316434 100644 --- a/code_perl/Maasha/Calc.pm +++ b/code_perl/Maasha/Calc.pm @@ -59,6 +59,19 @@ sub is_a_number } +sub commify +{ + # Martin A. Hansen, October 2009. + + # Insert comma in long numbers. + + my ( $num, # number reference to commify + ) = @_; + + ${ $num } =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; +} + + sub dist_point2line { # Martin A. Hansen, June 2004. diff --git a/code_perl/Maasha/KISS/Draw.pm b/code_perl/Maasha/KISS/Draw.pm index a35f73f..df21300 100644 --- a/code_perl/Maasha/KISS/Draw.pm +++ b/code_perl/Maasha/KISS/Draw.pm @@ -100,6 +100,12 @@ sub svg_frame } +sub svg_track_dna +{ + +} + + sub svg_track_feature { # Martin A. Hansen, October 2009. @@ -142,6 +148,42 @@ sub svg_track_feature } +sub svg_track_histogram +{ + # Given a list of features add these to + # a SVG object. + + my ( $svg, # SVG object + $features, # List of features + $track_id, # Unique track id + $color, # Color of features + ) = @_; + + # Returns nothing. + + my ( $track, $i ); + + $track = $svg->group( + id => $track_id, + style => { + 'stroke-width' => 5, + stroke => $color, + } + ); + + for ( $i = 0; $i < @{ $features }; $i++ ) + { + $track->line( + id => "HIST_$i", + x1 => $features->[ $i ]->{ 'x1' }, + y1 => $features->[ $i ]->{ 'y1' }, + x2 => $features->[ $i ]->{ 'x2' }, + y2 => $features->[ $i ]->{ 'y2' }, + ); + } +} + + sub svg_print { # Martin A. Hansen, October 2009. @@ -160,6 +202,22 @@ sub svg_print } +sub hdump +{ + my ( $foo ) = @_; + + my ( @html ); + + @html = "Content-Type: text/html; charset=ISO-8859-1\n\n"; + + push @html, "
\n";
+    push @html, Dumper( $foo );
+    push @html, "
\n"; + + return wantarray ? @html : \@html; +} + + # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 1; diff --git a/code_perl/Maasha/KISS/Track.pm b/code_perl/Maasha/KISS/Track.pm index f6639ea..5b147d5 100644 --- a/code_perl/Maasha/KISS/Track.pm +++ b/code_perl/Maasha/KISS/Track.pm @@ -84,7 +84,7 @@ sub track_feature $y = $y_offset + ( 5 * $y_step ); push @features, { - id => $entry->{ 'Q_ID' }, +# id => $entry->{ 'Q_ID' }, x => $x, y => $y, height => 5, @@ -99,6 +99,96 @@ sub track_feature } +sub track_histogram +{ + my ( $width, # draw window width + $y_offset, # y axis draw offset + $min, # minimum base position + $max, # maximum base position + $entries, # list of sorted KISS entries + ) = @_; + + # Returns a list. + + my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h ); + + return if $max == $min; + + $hist_height = 100; # pixels + $bucket_width = 5; # pixels + + $factor_width = ( $width / $bucket_width ) / ( $max - $min ); + + $max_height = 0; + + foreach $entry ( @{ $entries } ) + { + $bucket_beg = int( $entry->{ 'S_BEG' } * $factor_width ); + $bucket_end = int( $entry->{ 'S_END' } * $factor_width ); + + # print "$bucket_beg $bucket_end\n"; + + for ( $i = $bucket_beg; $i <= $bucket_end; $i++ ) + { + $buckets[ $i ]++; + + $max_height = Maasha::Calc::max( $max_height, $buckets[ $i ] ); + } + } + + # print Maasha::KISS::Draw::hdump( \@buckets ); + #print Dumper( $max_height ); + + if ( $max_height > 0 ) + { + $factor_heigth = $hist_height / $max_height; + + $x = 0; + + for ( $i = int( $entries->[ 0 ]->{ 'S_BEG' } * $factor_width ); $i < @buckets; $i++ ) + { + if ( defined $buckets[ $i ] ) + { + $h = sprintf( "%.0f", $buckets[ $i ] * $factor_heigth ); + + if ( $h >= 1 ) + { + push @hist, { + x1 => $x, + y1 => $y_offset + $hist_height, + x2 => $x, + y2 => $y_offset + $hist_height - $h, + }; + } + } + + $x += $bucket_width; + } + } + + return wantarray ? @hist : \@hist; +} + + +sub bucket_round +{ + my ( $num, + $bucket_size, + ) = @_; + + my ( $div, $int ); + + $div = $num / $bucket_size; + $int = int $div; + + if ( $div - $int >= 0.5 ) { + return $bucket_size * ( $int + 1 ); + } else { + return $bucket_size * $int; + } +} + + # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 1; diff --git a/code_perl/Maasha/SQL.pm b/code_perl/Maasha/SQL.pm index be60999..7098524 100644 --- a/code_perl/Maasha/SQL.pm +++ b/code_perl/Maasha/SQL.pm @@ -263,7 +263,7 @@ sub query_hashref_list # Returns datastructure. - my $table = $dbh->selectall_arrayref( $sql, { Slice => {} } ); + my $table = $dbh->selectall_arrayref( $sql, { Slice => {} } ); # This call is slow! :o( return wantarray ? @{ $table } : $table; } diff --git a/www/cgi-bin/index.cgi b/www/cgi-bin/index.cgi index b1827d4..525dfd1 100755 --- a/www/cgi-bin/index.cgi +++ b/www/cgi-bin/index.cgi @@ -27,6 +27,7 @@ use lib "/Users/maasha/biopieces/code_perl/"; use CGI; use Data::Dumper; +use Time::HiRes; use Maasha::Common; use Maasha::Filesys; use Maasha::XHTML; @@ -62,7 +63,7 @@ push @html, Maasha::XHTML::h1( txt => "KISS Genome Browser", class => "center" ) push @html, Maasha::XHTML::form_beg( action => $script, method => "get", enctype => "multipart/form-data" ); push @html, sec_navigate( $cgi ); -push @html, sec_browse( $cgi, $dbh ); +push @html, sec_browse( $dbh, $cgi->param( 'nav_start' ), $cgi->param( 'nav_end' ) ); push @html, Maasha::XHTML::form_end; push @html, Maasha::XHTML::body_end; @@ -88,6 +89,9 @@ sub sec_navigate $list_assembly = nav_list_assembly(); $list_contig = nav_list_contig(); + nav_zoom( $cgi ); + nav_move( $cgi, 2_800_000 ); # FIXME + $def_clade = nav_def_clade( $cgi ); $def_genome = nav_def_genome( $cgi ); $def_assembly = nav_def_assembly( $cgi ); @@ -95,6 +99,9 @@ sub sec_navigate $def_start = nav_def_start( $cgi ); $def_end = nav_def_end( $cgi ); + Maasha::Calc::commify( \$def_start ); + Maasha::Calc::commify( \$def_end ); + push @html, Maasha::XHTML::table_beg( summary => "Navigation table" ); push @html, Maasha::XHTML::table_row_simple( tr => [ qw( Clade Genome Assembly Contig Start End ) ], align => 'center' ); push @html, Maasha::XHTML::table_row_simple( tr => [ @@ -108,29 +115,73 @@ sub sec_navigate ] ); push @html, Maasha::XHTML::table_end; + push @html, Maasha::XHTML::table_beg( summary => "Zoom table" ); + push @html, Maasha::XHTML::table_row_simple( tr => [ + Maasha::XHTML::p( txt => 'Move:' ), + Maasha::XHTML::submit( name => "move_left3", value => "<<<", title => "move 95% to the left" ), + Maasha::XHTML::submit( name => "move_left2", value => "<<", title => "move 47.5% to the left" ), + Maasha::XHTML::submit( name => "move_left1", value => "<", title => "move 10% to the left" ), + Maasha::XHTML::submit( name => "move_right1", value => ">", title => "move 10% to the rigth" ), + Maasha::XHTML::submit( name => "move_right2", value => ">>", title => "move 47.5% to the rigth" ), + Maasha::XHTML::submit( name => "move_right3", value => ">>>", title => "move 95% to the right" ), + Maasha::XHTML::p( txt => 'Zoom in:' ), + Maasha::XHTML::submit( name => "zoom_in1", value => "1.5x" ), + Maasha::XHTML::submit( name => "zoom_in2", value => "3x" ), + Maasha::XHTML::submit( name => "zoom_in3", value => "10x" ), + Maasha::XHTML::p( txt => 'Zoom out:' ), + Maasha::XHTML::submit( name => "zoom_out1", value => "1.5x" ), + Maasha::XHTML::submit( name => "zoom_out2", value => "3x" ), + Maasha::XHTML::submit( name => "zoom_out3", value => "10x" ), + ] ); + push @html, Maasha::XHTML::table_end; + return wantarray ? @html : \@html; } sub sec_browse { - my ( $cgi, # CGI object - $dbh, # Database handle + my ( $dbh, # Database handle + $start, # Browse start position + $end, # Browse end position ) = @_; # Returns a list. - my ( $table, $def_start, $def_end, $entries, $features, $svg, $file, $fh, @html ); + my ( $t0, $t1, $table, $entries, $features, $svg, $file, $fh, @html ); + + $table = 'Solexa'; - $table = 'Solexa'; - $def_start = nav_def_start( $cgi ); - $def_end = nav_def_end( $cgi ); + $t0 = Time::HiRes::gettimeofday(); + $entries = Maasha::KISS::IO::kiss_sql_get( $dbh, $table, $start, $end ); + $t1 = Time::HiRes::gettimeofday(); - $entries = Maasha::KISS::IO::kiss_sql_get( $dbh, $table, $def_start, $def_end ); + push @html, Maasha::XHTML::p( txt => "Feature count: " . scalar @$entries ); + push @html, Maasha::XHTML::p( txt => "Time SQL: " . ( $t1 - $t0 ) ); + + $t0 = Time::HiRes::gettimeofday(); Maasha::KISS::Track::entries_sort( $entries ); + $t1 = Time::HiRes::gettimeofday(); + + push @html, Maasha::XHTML::p( txt => "Time sort: " . ( $t1 - $t0 ) ); - $features = Maasha::KISS::Track::track_feature( 1200, 50, $def_start, $def_end, $entries ); + $t0 = Time::HiRes::gettimeofday(); + + my $MAX = 4000; # FIXME should depend on hieght of track as well + + if ( @$entries > $MAX ) { + $features = Maasha::KISS::Track::track_histogram( 1200, 50, $start, $end, $entries ); + } else { + $features = Maasha::KISS::Track::track_feature( 1200, 50, $start, $end, $entries ); + } + + $t1 = Time::HiRes::gettimeofday(); + + # push @html, Maasha::KISS::Draw::hdump( $entries ); + # push @html, Maasha::KISS::Draw::hdump( $features ); + + push @html, Maasha::XHTML::p( txt => "Time Track: " . ( $t1 - $t0 ) ); $file = "fisk.svg"; @@ -138,9 +189,19 @@ sub sec_browse $svg = Maasha::KISS::Draw::svg_init( 800, 1200 ); + $t0 = Time::HiRes::gettimeofday(); Maasha::KISS::Draw::svg_frame( 800, 1200, $svg ); - Maasha::KISS::Draw::svg_track_feature( 800, 1200, $svg, $features, 'track id', 'green' ); + + if ( @$entries > $MAX ) { + Maasha::KISS::Draw::svg_track_histogram( $svg, $features, 'track id', 'green' ) if $features; + } else { + Maasha::KISS::Draw::svg_track_feature( 800, 1200, $svg, $features, 'track id2', 'green' ) if $features; + } + Maasha::KISS::Draw::svg_print( $svg, $fh ); + $t1 = Time::HiRes::gettimeofday(); + + push @html, Maasha::XHTML::p( txt => "Time Draw: " . ( $t1 - $t0 ) ); close $fh; @@ -195,8 +256,104 @@ sub nav_list_contig } +sub nav_zoom +{ + my ( $cgi, # CGI object + ) = @_; + + my ( $start, $end, $dist, $new_dist, $dist_diff, $new_start, $new_end ); + + if ( defined $cgi->param( 'nav_start' ) and $cgi->param( 'nav_end' ) ) + { + $start = $cgi->param( 'nav_start' ); + $end = $cgi->param( 'nav_end' ); + + $start =~ tr/,//d; + $end =~ tr/,//d; + + $dist = $end - $start; + + if ( defined $cgi->param( 'zoom_in1' ) ) { + $new_dist = $dist / 1.5; + } elsif ( defined $cgi->param( 'zoom_in2' ) ) { + $new_dist = $dist / 3; + } elsif ( defined $cgi->param( 'zoom_in3' ) ) { + $new_dist = $dist / 10; + } elsif ( defined $cgi->param( 'zoom_out1' ) ) { + $new_dist = $dist * 1.5; + } elsif ( defined $cgi->param( 'zoom_out2' ) ) { + $new_dist = $dist * 3; + } elsif ( defined $cgi->param( 'zoom_out3' ) ) { + $new_dist = $dist * 10; + } + + if ( $new_dist ) + { + $dist_diff = $dist - $new_dist; + $new_start = int( $start + ( $dist_diff / 2 ) ); + $new_end = int( $end - ( $dist_diff / 2 ) ); + + $cgi->param( 'nav_start', $new_start ); + $cgi->param( 'nav_end', $new_end ); + } + } +} + + +sub nav_move +{ + my ( $cgi, # CGI object + $max, # Max end position + ) = @_; + + my ( $start, $end, $dist, $shift, $new_start, $new_end ); + + if ( defined $cgi->param( 'nav_start' ) and $cgi->param( 'nav_end' ) ) + { + $start = $cgi->param( 'nav_start' ); + $end = $cgi->param( 'nav_end' ); + + $start =~ tr/,//d; + $end =~ tr/,//d; + + $dist = $end - $start; + + if ( defined $cgi->param( 'move_left1' ) ) { + $shift = -1 * $dist * 0.10; + } elsif ( defined $cgi->param( 'move_left2' ) ) { + $shift = -1 * $dist * 0.475; + } elsif ( defined $cgi->param( 'move_left3' ) ) { + $shift = -1 * $dist * 0.95; + } elsif ( defined $cgi->param( 'move_right1' ) ) { + $shift = $dist * 0.10; + } elsif ( defined $cgi->param( 'move_right2' ) ) { + $shift = $dist * 0.475; + } elsif ( defined $cgi->param( 'move_right3' ) ) { + $shift = $dist * 0.95; + } + + if ( $shift ) + { + $new_start = int( $start + $shift ); + $new_end = int( $end + $shift ); + + print "HERRRR: shift: $shift start: $new_start end: $new_end\n"; + + if ( $new_start > 0 and $new_end < $max ) + { + $cgi->param( 'nav_start', $new_start ); + $cgi->param( 'nav_end', $new_end ); + } + } + } +} + + sub nav_def_clade { + my ( $cgi, # CGI object + ) = @_; + my ( $def_clade ); if ( defined $cgi->param( 'nav_clade' ) ) @@ -214,6 +371,9 @@ sub nav_def_clade sub nav_def_genome { + my ( $cgi, # CGI object + ) = @_; + my ( $def_genome ); if ( defined $cgi->param( 'nav_genome' ) ) @@ -231,6 +391,9 @@ sub nav_def_genome sub nav_def_assembly { + my ( $cgi, # CGI object + ) = @_; + my ( $def_assembly ); if ( defined $cgi->param( 'nav_assembly' ) ) @@ -248,6 +411,9 @@ sub nav_def_assembly sub nav_def_contig { + my ( $cgi, # CGI object + ) = @_; + my ( $def_contig ); if ( defined $cgi->param( 'nav_contig' ) ) @@ -265,47 +431,62 @@ sub nav_def_contig sub nav_def_start { + my ( $cgi, # CGI object + ) = @_; + my ( $def_start ); - if ( defined $cgi->param( 'nav_start' ) ) - { + if ( defined $cgi->param( 'nav_start' ) ) { $def_start = $cgi->param( 'nav_start' ); + } else { + $def_start = 1; } - else - { + + $def_start =~ tr/,//d; + + if ( $def_start <= 0 ) { $def_start = 1; } + $cgi->param( 'nav_start', $def_start ); + return $def_start; } sub nav_def_end { + my ( $cgi, # CGI object + ) = @_; + my ( $def_end ); - if ( defined $cgi->param( 'nav_end' ) ) - { + if ( defined $cgi->param( 'nav_end' ) ) { $def_end = $cgi->param( 'nav_end' ); + } else { + $def_end = 2809422; + $def_end = 2000; } - else - { + + $def_end =~ tr/,//d; + + if ( $def_end > 2809422 ) { $def_end = 2809422; - $def_end = 1000; } + $cgi->param( 'nav_end', $def_end ); + return $def_end; } # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + END { Maasha::SQL::disconnect( $dbh ) if $dbh; } -__END__ - - +__END__