From: martinahansen Date: Tue, 27 Oct 2009 17:02:09 +0000 (+0000) Subject: more work on KISS X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=e1e762bac3e7a906a748d33c5298d626305060d1;p=biopieces.git more work on KISS git-svn-id: http://biopieces.googlecode.com/svn/trunk@712 74ccb610-7750-0410-82ae-013aeee3265d --- diff --git a/bp_bin/upload_to_KISS b/bp_bin/upload_to_KISS index 28ccde3..6ca989d 100755 --- a/bp_bin/upload_to_KISS +++ b/bp_bin/upload_to_KISS @@ -154,15 +154,15 @@ sub create_table my ( @fields, $field_str, $sql ); @fields = ( - "S_ID VARCHAR(256), INDEX S_ID_index (S_ID)", - "S_BEG INT, INDEX S_BEG_index (S_BEG)", - "S_END INT, INDEX S_END_index (S_END)", - "Q_ID VARCHAR(256), INDEX Q_ID_index (Q_ID)", - "SCORE FLOAT, INDEX SCORE_index (SCORE)", - "STRAND CHAR(1), INDEX STRAND_index (STRAND)", - "HITS INT, INDEX HITS_index (HITS)", + "S_ID VARCHAR(256)", + "S_BEG INT, INDEX S_BEG_index (S_BEG)", + "S_END INT, INDEX S_END_index (S_END)", + "Q_ID VARCHAR(256)", + "SCORE FLOAT", + "STRAND CHAR(1)", + "HITS INT", "ALIGN VARCHAR(256)", - "BLOCK_COUNT TINYINT, INDEX BLOCK_COUNT_index (BLOCK_COUNT)", + "BLOCK_COUNT TINYINT", "BLOCK_BEGS VARCHAR(1024)", "BLOCK_LENS VARCHAR(1024)", "BLOCK_TYPE VARCHAR(1024)", @@ -198,3 +198,18 @@ END __END__ + + @fields = ( + "S_ID VARCHAR(256), INDEX S_ID_index (S_ID)", + "S_BEG INT, INDEX S_BEG_index (S_BEG)", + "S_END INT, INDEX S_END_index (S_END)", + "Q_ID VARCHAR(256), INDEX Q_ID_index (Q_ID)", + "SCORE FLOAT, INDEX SCORE_index (SCORE)", + "STRAND CHAR(1), INDEX STRAND_index (STRAND)", + "HITS INT, INDEX HITS_index (HITS)", + "ALIGN VARCHAR(256)", + "BLOCK_COUNT TINYINT, INDEX BLOCK_COUNT_index (BLOCK_COUNT)", + "BLOCK_BEGS VARCHAR(1024)", + "BLOCK_LENS VARCHAR(1024)", + "BLOCK_TYPE VARCHAR(1024)", + ); diff --git a/code_perl/Maasha/Calc.pm b/code_perl/Maasha/Calc.pm index 1316434..363648a 100644 --- a/code_perl/Maasha/Calc.pm +++ b/code_perl/Maasha/Calc.pm @@ -65,10 +65,18 @@ sub commify # Insert comma in long numbers. - my ( $num, # number reference to commify + my ( $num, # number to commify ) = @_; - ${ $num } =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; + # Returns a string. + + my ( $copy ); + + $copy = $num; + + $copy =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; + + return $copy; } diff --git a/code_perl/Maasha/KISS/Draw.pm b/code_perl/Maasha/KISS/Draw.pm index 100b330..af48ac1 100644 --- a/code_perl/Maasha/KISS/Draw.pm +++ b/code_perl/Maasha/KISS/Draw.pm @@ -22,7 +22,7 @@ package Maasha::KISS::Draw; # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -# Routines for creating KISS graphics. +# Routines for creating KISS graphics using Cairo and Pango. # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -31,7 +31,8 @@ package Maasha::KISS::Draw; use warnings; use strict; use Data::Dumper; -use SVG; +use Cairo; +use Pango; use vars qw( @ISA @EXPORT ); @@ -41,196 +42,94 @@ use vars qw( @ISA @EXPORT ); # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -sub svg_init +sub track_text { - # Martin A. Hansen, October 2005. + # Given a sequence list add this to + # a Cairo::Context object. - # inititalizes SVG object, which is returned. - - my ( $height, # Height in pixels - $width, # Width in pixels - ) = @_; - - my $svg; - - $svg = SVG->new( - id => 'KISS', - height => $height, - width => $width, - ); - - return $svg; -} - - -sub svg_frame -{ - # Martin A. Hansen, October 2009. - - # Adds a top level layer frame of given - # height and width to an SVG object. - - my ( $height, # Height in pixels - $width, # Width in pixels - $svg, # SVG objact - ) = @_; - - # Returns nothing. - - my ( $frame ); - - $frame = $svg->group( - id => 'GROUP_FRAME', - ); - - $frame->rectangle( - id => 'FRAME', - x => 0, - y => 0, - width => $width, - height => $height, - rx => 10, - ry => 10, - style => { - fill => 'none', - 'stroke' => 'red', - 'stroke-width' => 3, - } - ); -} - - -sub svg_track_dna -{ - # Martin A. Hansen, October 2009. - - # Given a DNA sequence as a list add a string - # of chars to a SVG object. - - my ( $width, # width - $svg, # SVG object - $dna, + my ( $cr, # Cairo::Context object + $text, # List of hashrefs { txt =>, x => y => } + $color, # Color of features ) = @_; # Returns nothing. - my ( $track ); + $cr->set_source_rgb( color_name2rgb( $color ) ); - $dna = 'GAACGACGAGCATCAGCGGACACTACATCATATACTACATC'; + my ( $txt ); - $track = $svg->group( - id => 'TRACK_DNA', - style => { - # 'stroke-width' => 5, - # stroke => 'black', # TODO can this be removed? - 'font-family' => 'Courier New', - 'font-size' => '15px', - 'letter-spacing' => '15', - } - ); + $cr->set_font_size( 10 ); - $track->text( - id => 'DNA', - x => 0, - y => 20, - -cdata => $dna, - ); + foreach $txt ( @{ $text } ) + { + $cr->move_to( $txt->{ 'x' }, $txt->{ 'y' } ); + $cr->show_text( $txt->{ 'txt' } ); + $cr->stroke(); + } } -sub svg_track_feature +sub track_feature { - # Martin A. Hansen, October 2009. - # Given a list of features add these to - # a SVG object. + # a Cairo::Context object. - my ( $height, # Height in pixels - $width, # Width in pixels - $svg, # SVG object + my ( $cr, # Cairo::Context object $features, # List of features - $track_id, # Unique track id $color, # Color of features ) = @_; # Returns nothing. - my ( $track, $i, $id, $x, $y, $w, $h ); - - $track = $svg->group( - id => $track_id, - style => { - 'stroke-width' => 5, - stroke => $color, - } - ); + my ( $feature ); - for ( $i = 0; $i < @{ $features }; $i++ ) - { - $id = "FEAT_$i"; - $x = $features->[ $i ]->{ 'x' }; - $y = $features->[ $i ]->{ 'y' }; - $h = $features->[ $i ]->{ 'height' }; - $w = $features->[ $i ]->{ 'width' }; + $cr->set_source_rgb( color_name2rgb( $color ) ); - # $track->rectangle( id => $id, x => $x, y => $y, width => $w, height => $h ); + $cr->set_line_width( 5 ); - $track->line( id => $id, x1 => $x, y1 => $y, x2 => $x + $w, y2 => $y ); + foreach $feature ( @{ $features } ) + { + $cr->move_to( $feature->{ 'x1' }, $feature->{ 'y1' } ); + $cr->line_to( $feature->{ 'x2' }, $feature->{ 'y2' } ); + $cr->stroke; } } -sub svg_track_histogram +sub color_name2rgb { - # 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 + my ( $color_name ) = @_; - # Returns nothing. - - my ( $track, $i ); + my ( %color_hash, $rgb ); - $track = $svg->group( - id => $track_id, - style => { - 'stroke-width' => 5, - stroke => $color, - } + %color_hash = ( + 'green' => [ 0, 255, 0 ], ); - 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' }, - ); + if ( exists $color_hash{ $color_name } ) { + $rgb = $color_hash{ $color_name }; + } else { + $rgb = [ 0, 0, 0 ]; } + + return wantarray ? @{ $rgb } : $rgb; } -sub svg_print +sub file_png { # Martin A. Hansen, October 2009. - # Prints XML output from a SVG object. + # Prints a Cairo::Surface object to a PNG file. - my ( $svg, # SVG object - $fh, # file handle - OPTIONAL + my ( $surface, # Cairo::Surface object + $file, # path to PNG file ) = @_; # Returns nothing - $fh ||= \*STDOUT; - - print $fh $svg->xmlify; + $surface->write_to_png( $file ); } diff --git a/code_perl/Maasha/KISS/IO.pm b/code_perl/Maasha/KISS/IO.pm index 5ff6a51..1020b3e 100644 --- a/code_perl/Maasha/KISS/IO.pm +++ b/code_perl/Maasha/KISS/IO.pm @@ -154,7 +154,8 @@ sub kiss_sql_get my ( $sql, $entries ); - $sql = "SELECT * FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end"; + # $sql = "SELECT * FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end ORDER BY S_BEG,S_END"; + $sql = "SELECT S_BEG,S_END FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end"; $entries = Maasha::SQL::query_hashref_list( $dbh, $sql ); diff --git a/code_perl/Maasha/KISS/Track.pm b/code_perl/Maasha/KISS/Track.pm index 5b147d5..1ae1c86 100644 --- a/code_perl/Maasha/KISS/Track.pm +++ b/code_perl/Maasha/KISS/Track.pm @@ -40,15 +40,58 @@ use vars qw( @ISA @EXPORT ); # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -sub entries_sort +sub track_ruler { - my ( $entries, # list of KISS entries + my ( $width, # draw window width + $y_offset, # y axis draw offset + $beg, # base window beg + $end, # base window end ) = @_; - # Returns nothing. + my ( $factor, $step, $i, $txt, $x, @ruler ); - @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or - $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries }; + $factor = $width / ( $end - $beg ); + + $step = 10; + + while ( ( $end - $beg ) / $step > 20 ) + { + $step *= 5; + } + + for ( $i = $beg; $i < $end; $i++ ) + { + if ( ( $i % $step ) == 0 ) + { + $txt = "$i|"; + $x = sprintf( "%.0f", ( $i - $beg - length $txt ) * $factor ); + + push @ruler, { txt => $txt, x => $x, y => $y_offset }; + } + } + + return wantarray ? @ruler : \@ruler; +} + + +sub track_seq +{ + my ( $width, # draw window width + $y_offset, # y axis draw offset + $seq, # sequence to draw + ) = @_; + + my ( @chars, $factor, $i, @seq_list ); + + @chars = split //, $seq; + + $factor = $width / @chars; + + for ( $i = 0; $i < @chars; $i++ ) { + push @seq_list, { txt => $chars[ $i ], x => sprintf( "%.0f", $i * $factor ), y => $y_offset }; + } + + return wantarray ? @seq_list : \@seq_list; } @@ -58,12 +101,14 @@ sub track_feature $y_offset, # y axis draw offset $beg, # base window beg $end, # base window end - $entries, # list of sorted KISS entries + $entries, # list of unsorted KISS entries ) = @_; # Returns a list. - my ( $factor, $entry, $y_step, @ladder, $i, $x, $y, $w, @features ); + my ( $factor, $entry, $y_step, @ladder, $w, $x1, $y1, $x2, $y2, @features ); + + @{ $entries } = sort { $a->{ 'S_BEG' } <=> $b->{ 'S_BEG' } or $a->{ 'S_END' } <=> $b->{ 'S_END' } } @{ $entries }; $factor = $width / ( $end - $beg ); $y_step = 0; @@ -74,24 +119,23 @@ sub track_feature if ( $w >= 1 ) { - $x = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor ); + $x1 = sprintf( "%.0f", ( $entry->{ 'S_BEG' } - $beg ) * $factor ); for ( $y_step = 0; $y_step < @ladder; $y_step++ ) { - last if $x >= $ladder[ $y_step ] + 1; + last if $x1 >= $ladder[ $y_step ] + 1; } - $y = $y_offset + ( 5 * $y_step ); + $y1 = $y_offset + ( 5 * $y_step ); push @features, { -# id => $entry->{ 'Q_ID' }, - x => $x, - y => $y, - height => 5, - width => $w, + x1 => $x1, + y1 => $y1, + x2 => $x1 + $w, + y2 => $y1, }; - $ladder[ $y_step ] = $x + $w; + $ladder[ $y_step ] = $x1 + $w; } } @@ -105,12 +149,12 @@ sub track_histogram $y_offset, # y axis draw offset $min, # minimum base position $max, # maximum base position - $entries, # list of sorted KISS entries + $entries, # list of unsorted 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 ); + my ( $hist_height, $bucket_width, $factor_heigth, $factor_width, $entry, $min_bucket, $max_height, $bucket_beg, $bucket_end, $i, @buckets, $bucket, @hist, $x, $h ); return if $max == $min; @@ -119,6 +163,7 @@ sub track_histogram $factor_width = ( $width / $bucket_width ) / ( $max - $min ); + $min_bucket = 999999999; $max_height = 0; foreach $entry ( @{ $entries } ) @@ -126,8 +171,8 @@ sub track_histogram $bucket_beg = int( $entry->{ 'S_BEG' } * $factor_width ); $bucket_end = int( $entry->{ 'S_END' } * $factor_width ); - # print "$bucket_beg $bucket_end\n"; - + $min_bucket = Maasha::Calc::min( $min_bucket, $bucket_beg ); + for ( $i = $bucket_beg; $i <= $bucket_end; $i++ ) { $buckets[ $i ]++; @@ -136,16 +181,13 @@ sub track_histogram } } - # 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++ ) + for ( $i = $min_bucket; $i < @buckets; $i++ ) { if ( defined $buckets[ $i ] ) { diff --git a/code_perl/Maasha/SQL.pm b/code_perl/Maasha/SQL.pm index 7098524..9f27375 100644 --- a/code_perl/Maasha/SQL.pm +++ b/code_perl/Maasha/SQL.pm @@ -34,7 +34,7 @@ use warnings; use DBI; use Data::Dumper; - +use Time::HiRes; use Maasha::Common; use vars qw( @ISA @EXPORT ); @@ -219,7 +219,6 @@ sub query_array # Returns a list. my ( $sth, $table, $errstr, @status ); - if ( not $sth = $dbh->prepare( $sql ) ) { $errstr = $DBI::errstr; @@ -235,7 +234,7 @@ sub query_array disconnect( $dbh ); die qq(ERROR: $errstr, "SQL EXECUTE ERROR" ); } - + if ( $table = $sth->fetchall_arrayref( $out ) ) { return wantarray ? @{ $table } : $table; @@ -263,7 +262,7 @@ sub query_hashref_list # Returns datastructure. - my $table = $dbh->selectall_arrayref( $sql, { Slice => {} } ); # This call is slow! :o( + my $table = $dbh->selectall_arrayref( $sql, { Slice => {} } ); return wantarray ? @{ $table } : $table; } diff --git a/www/cgi-bin/index.cgi b/www/cgi-bin/index.cgi index f2e6460..1459279 100755 --- a/www/cgi-bin/index.cgi +++ b/www/cgi-bin/index.cgi @@ -26,10 +26,13 @@ use warnings; use lib "/Users/maasha/biopieces/code_perl/"; use CGI; +use Cairo; +use Pango; use Data::Dumper; use Time::HiRes; use Maasha::Common; use Maasha::Filesys; +use Maasha::Calc; use Maasha::XHTML; use Maasha::Biopieces; use Maasha::KISS::IO; @@ -46,7 +49,6 @@ $password = Maasha::Biopieces::biopiecesrc( "MYSQL_PASSWORD" ); $dbh = Maasha::SQL::connect( $database, $user, $password ); - $script = Maasha::Common::get_scriptname(); push @html, Maasha::XHTML::html_header( @@ -99,9 +101,6 @@ 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 => [ @@ -109,8 +108,8 @@ sub sec_navigate Maasha::XHTML::menu( name => "nav_genome", options => $list_genome, selected => $def_genome ), Maasha::XHTML::menu( name => "nav_assembly", options => $list_assembly, selected => $def_assembly ), Maasha::XHTML::menu( name => "nav_contig", options => $list_contig, selected => $def_contig ), - Maasha::XHTML::text( name => "nav_start", value => $def_start, size => 20 ), - Maasha::XHTML::text( name => "nav_end", value => $def_end, size => 20 ), + Maasha::XHTML::text( name => "nav_start", value => Maasha::Calc::commify( $def_start ), size => 20 ), + Maasha::XHTML::text( name => "nav_end", value => Maasha::Calc::commify( $def_end ), size => 20 ), Maasha::XHTML::submit( name => "nav_submit", value => "Submit" ), ] ); push @html, Maasha::XHTML::table_end; @@ -148,7 +147,21 @@ sub sec_browse # Returns a list. - my ( $t0, $t1, $table, $entries, $features, $svg, $file, $fh, @html ); + my ( $t0, $t1, $ruler, $index, $index_beg, $index_len, $fh, $seq, $dna, $table, $entries, $features, $surface, $cr, $file, @html ); + + $ruler = Maasha::KISS::Track::track_ruler( 1200, 25, $start, $end ); + + $index = Maasha::Fasta::index_retrieve( "$ENV{ 'BP_DATA' }/genomes/S_aur_COL/fasta/S_aur_COL.index" ); + + ( $index_beg, $index_len ) = @{ $index->{ 'S_aur_COL' } }; + + $fh = Maasha::Filesys::file_read_open( "$ENV{ 'BP_DATA' }/genomes/S_aur_COL/fasta/S_aur_COL.fna" ); + + $seq = Maasha::Filesys::file_read( $fh, $index_beg + $start, $end - $start + 1 ); + + close $fh; + + $dna = Maasha::KISS::Track::track_seq( 1200, 50, $seq ) if length $seq <= 220; $table = 'Solexa'; @@ -156,24 +169,18 @@ sub sec_browse $entries = Maasha::KISS::IO::kiss_sql_get( $dbh, $table, $start, $end ); $t1 = Time::HiRes::gettimeofday(); - push @html, Maasha::XHTML::p( txt => "Feature count: " . scalar @$entries ); + push @html, Maasha::XHTML::p( txt => "Feature count: " . Maasha::Calc::commify( 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 ) ); - - $t0 = Time::HiRes::gettimeofday(); - - my $MAX = 4000; # FIXME should depend on hieght of track as well + my $MAX = 4000; # FIXME should depend on height of track as well if ( @$entries > $MAX ) { - $features = Maasha::KISS::Track::track_histogram( 1200, 50, $start, $end, $entries ); + $features = Maasha::KISS::Track::track_histogram( 1200, 75, $start, $end, $entries ); } else { - $features = Maasha::KISS::Track::track_feature( 1200, 50, $start, $end, $entries ); + $features = Maasha::KISS::Track::track_feature( 1200, 75, $start, $end, $entries ); } $t1 = Time::HiRes::gettimeofday(); @@ -183,36 +190,25 @@ sub sec_browse push @html, Maasha::XHTML::p( txt => "Time Track: " . ( $t1 - $t0 ) ); - $file = "fisk.svg"; + $file = "fisk.png"; - $fh = Maasha::Filesys::file_write_open( $file ); - - $svg = Maasha::KISS::Draw::svg_init( 800, 1200 ); + $surface = Cairo::ImageSurface->create( 'argb32', 1200, 800 ); + $cr = Cairo::Context->create( $surface ); $t0 = Time::HiRes::gettimeofday(); - Maasha::KISS::Draw::svg_frame( 800, 1200, $svg ); - Maasha::KISS::Draw::svg_track_dna( 1200, $svg, 'dna', 'ATCG' ); + Maasha::KISS::Draw::track_text( $cr, $ruler, "red" ) if $ruler; + Maasha::KISS::Draw::track_text( $cr, $dna, "red" ) if $dna; - 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::track_feature( $cr, $features, 'green' ) if $features; + + Maasha::KISS::Draw::file_png( $surface, $file ); - Maasha::KISS::Draw::svg_print( $svg, $fh ); $t1 = Time::HiRes::gettimeofday(); push @html, Maasha::XHTML::p( txt => "Time Draw: " . ( $t1 - $t0 ) ); - close $fh; - - push @html, Maasha::XHTML::object( type => "image/svg+xml", - # data => "/Users/maasha/test.svg", - data => $file, - name => "owMain", - width => "1200", - height => "800" ); + push @html, Maasha::XHTML::p( txt => Maasha::XHTML::img( src => $file, alt => "Browser Tracks", height => 800, width => 1200, class => "foo", id => "pix_id", usemap => "map" ) ); return wantarray ? @html : \@html; }