Mercurial > repos > cpt > cpt_psm_plotter
view lib/CPT/Analysis/PAUSE/SVG.pm @ 1:8691c1c61a8e draft default tip
planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author | cpt |
---|---|
date | Mon, 05 Jun 2023 02:48:47 +0000 |
parents | |
children |
line wrap: on
line source
package CPT::Analysis::PAUSE::SVG; # ABSTRACT: Library for use in PAUSE analysis use strict; use warnings; use Moose; use Data::Dumper; use List::MoreUtils qw(each_array); use SVG; has 'svg' => ( is => 'rw' ); has 'width' => ( is => 'rw', isa => 'Int' ); has 'height' => ( is => 'rw', isa => 'Int' ); has 'vertical_offset' => ( is => 'rw', isa => 'Int' ); has 'start_end_max_num' => ( is => 'rw', isa => 'Int' ); has 'num_rows' => ( is => 'rw', isa => 'Int' ); has 'row_size' => ( is => 'rw', isa => 'Int' ); has 'row_width' => ( is => 'rw', isa => 'Int' ); has 'x_border' => ( is => 'rw', isa => 'Int' ); has 'y_border' => ( is => 'rw', isa => 'Int' ); has 'line_height' => ( is => 'rw', isa => 'Int' ); has 'inter_line_spacing' => ( is => 'rw', isa => 'Int' ); has 'max' => ( is => 'rw', isa => 'Int' ); has 'fasta_id' => ( is => 'rw', isa => 'Any' ); sub setup { my ($self) = @_; $self->svg( SVG->new( width => $self->width(), height => $self->height(), ) ); } sub add_header { my ( $self, @refs ) = @_; $self->plot_title( 'Plot of ' . $self->fasta_id() ); my $i = 0; foreach (@refs) { my @subrefs = @{$_}; foreach (@subrefs) { $i++; my %d = %{$_}; $self->plot_key( $d{name}, $d{line}, $d{fill}, $i ); } } $self->vertical_offset( $self->vertical_offset() - ( $i - 1 ) * 20 ); } my $global_pline_idx = 0; sub plot_track { my ( $self, $points_ref, $stroke, $fill, $id ) = @_; $global_pline_idx++; $self->svg()->polyline( %{$points_ref}, id => 'pline_' . $id . '-' . $global_pline_idx, style => { 'fill-opacity' => .5, 'stroke' => $stroke, 'fill' => $fill, } ) } sub make_scale { my ( $self, $i, $start, $stop ) = @_; # Left axis label, must be rotated my $tmp_x = $self->fix_x_value(-30); #$self->x_border()-30; my $tmp_y = $self->fix_y_value($i) + 50; $self->svg()->text( id => 'left_side_label_row_' . $i, x => $tmp_x - 20, y => $tmp_y - 20, 'font-family' => 'Helvetica, sans-serif', 'transform' => sprintf( 'rotate(-90 %s %s)', $tmp_x, $tmp_y ), )->cdata('Start/End Hit Count Scale'); # Right axis label, must be rotated $tmp_x = $self->fix_x_value( $self->row_width() + 60 ); $tmp_y = $self->fix_y_value($i); $self->svg()->text( id => 'right_side_label_row_' . $i, x => $tmp_x - 20, y => $tmp_y, 'font-family' => 'Helvetica, sans-serif', 'transform' => sprintf( 'rotate(-90 %s %s)', $tmp_x, $tmp_y ), )->cdata('Coverage Density'); # Horizontal increments for ( my $k = -4 ; $k <= 4 ; $k++ ) { # Left side label my $y_position = $k / 4 * $self->line_height(); $self->svg()->text( id => sprintf( 'label_left_side_row_%s_%s', $i, $k ), x => $self->fix_x_value(-30), y => $self->fix_y_value( $i, $y_position ), 'font-family' => 'Helvetica, sans-serif', )->cdata( int( $self->start_end_max_num() * abs( $k / 4 ) ) ); # Right side label $self->svg()->text( id => sprintf( 'label_right_side_row_%s_%s', $i, $k ), x => $self->fix_x_value( $self->row_width() + 10 ), y => $self->fix_y_value( $i, $y_position ), 'font-family' => 'Helvetica, sans-serif', )->cdata( int( $self->max() * abs( $k / 4 ) ) ); # Vertical lines $self->svg()->line( x1 => $self->fix_x_value( $self->row_width() ), x2 => $self->fix_x_value(0), y1 => $self->fix_y_value( $i, $y_position ), y2 => $self->fix_y_value( $i, $y_position ), id => sprintf( 'vertical_increment_row_%s_%s', $i, $k ), opacity => .25, stroke => 'rgb(0,0,0)', 'stroke-width' => '2', ); } # Vertical Increments my $number_of_increments = 10; for ( my $k = 0 ; $k <= $self->row_width() ; $k += ( $self->row_width() / $number_of_increments ) ) { # We get % of way across (k/num_inc) and we multiply by the width value, to get % of width which we adjust with start to get correct value my $b = ( $k / $self->row_width() ) * ( $stop - $start ) + $start; my $kb = $b / 1000; $self->svg()->text( id => sprintf( 'vertical_line_label_row_%s_%s', $i, $k ), x => $self->fix_x_value($k), y => $self->fix_y_value( $i, $self->line_height() + 20 ), 'font-family' => 'Helvetica, sans-serif', )->cdata( ($kb) . ' kb' ); $self->svg()->line( x1 => $self->fix_x_value($k), x2 => $self->fix_x_value($k), y1 => $self->fix_y_value( $i, -$self->line_height() ), y2 => $self->fix_y_value( $i, $self->line_height() ), id => sprintf( 'vertical_line_row_%s_%s', $i, $k ), opacity => .5, stroke => 'rgb(0,0,0)', 'stroke-width' => '1', ); } } sub plot_title { my ( $self, $string ) = @_; $self->svg()->text( id => 'label_plot_title', x => $self->x_border(), y => 50 + $self->vertical_offset(), 'font-family' => 'Helvetica, sans-serif', 'font-size' => '150%', )->cdata($string); $self->vertical_offset( $self->vertical_offset() + 25 ); } sub plot_key { my ( $self, $text, $stroke, $colour, $i ) = @_; $self->svg()->rectangle( x => $self->x_border(), y => 50 + $self->vertical_offset() - 15, width => 15, height => 15, id => 'label_key_example' . $i, 'fill-opacity' => .5, 'stroke' => $stroke, 'fill' => $colour, ); $self->svg()->text( id => 'label_key_string' . $i, x => $self->x_border() + 20, y => 50 + $self->vertical_offset(), 'font-family' => 'Helvetica, sans-serif', )->cdata($text); $self->vertical_offset( $self->vertical_offset + 20 ); } sub xmlify { my ($self) = @_; return $self->svg()->xmlify(); } sub x_values_for_range_scaled { my ( $self, $start, $end, $pieces ) = @_; my @vals = ($start); my $by = ( $end - $start ) / $pieces; ## For all values from the x_border to xborder+row_width, add a value of row_width split/row_size (i.e., how far for EACH INDIVIDUAL value) for ( my $i = $start ; $i < $end ; $i += $by ) { push( @vals, $i ); } push( @vals, $end ); return @vals; } sub fix_x_values { my ( $self, @values ) = @_; return map { $self->fix_x_value($_) } @values; } sub fix_x_value { my ( $self, $val ) = @_; return $val + $self->x_border(); } sub fix_y_value { my ( $self, $i, $val ) = @_; return ( $self->vertical_offset() + $val - $self->line_height() + ( ( ( 2 + $i ) * $self->line_height() ) + ( $i * $self->inter_line_spacing() ) + $self->y_border() ) ); } sub fix_all_y_values { my ( $self, $i, @arrays_to_fix, ) = @_; for ( my $j = 0 ; $j < scalar @arrays_to_fix ; $j++ ) { # For each array in postive_y (AoA) # # we cast to array, then we map this, then we have this # in an anonymous array which means we can just # replace. This is probably not as efficient as looking # at every value directly and doing "in place" # replacement, but I don't know how that would be # written here... $arrays_to_fix[$j] = [ map { $self->fix_y_value( $i, $_ ) } @{ $arrays_to_fix[$j] } ]; } return @arrays_to_fix; } sub copy_data { my ( $self, $start, $stop, $data_to_ref, $data_from_ref, $max ) = @_; # Copy data from the original array to the new one, transforming out # the subset of interest. This is done across an AoA my @data_to = @{$data_to_ref}; my @data_from = @{$data_from_ref}; for ( my $k = 0 ; $k < scalar @data_from ; $k++ ) { foreach ( my $j = $start ; $j < $stop ; $j++ ) { #1 to 10_000 in the genome if ( defined ${ $data_from[$k] }[$j] ) { push( @{ $data_to[$k] }, -( $self->line_height() * ${ $data_from[$k] }[$j] / $max ) ); } else { push( @{ $data_to[$k] }, 0 ); } } } return @data_to; } sub plot_individual_row { my ( $self, $start, $stop, $i, $regular_ref, $rescale_ref ) = @_; my @regular = map { ${$_}{data} } @{$regular_ref}; my @rescale = map { ${$_}{data} } @{$rescale_ref}; my @regular_y; my @rescale_y; ## Ensure we duplicate the number of arrays. foreach (@regular) { push( @regular_y, [] ); } foreach (@rescale) { push( @rescale_y, [] ); } # Determine bounds of row $self->push_all( \@regular_y, 0 ); $self->push_all( \@rescale_y, 0 ); @regular_y = $self->copy_data( $start, $stop, \@regular_y, \@regular, $self->start_end_max_num() ); @rescale_y = $self->copy_data( $start, $stop, \@rescale_y, \@rescale, $self->max() ); #print @rescale_y; # Set up our X values my @x_values = $self->fix_x_values( $self->x_values_for_range_scaled( 0, $self->row_width(), ( $stop - $start ) ) ); #my @x_values_rescale = $self->fix_x_values( $self->x_values_for_range_scaled(0, $self->row_width(), ( $stop - $start ))); $self->push_all( \@regular_y, 0 ); $self->push_all( \@rescale_y, 0 ); # Fix the ys @regular_y = $self->fix_all_y_values( $i, @regular_y ); @rescale_y = $self->fix_all_y_values( $i, @rescale_y ); # Prepare our styling my @regular_line = map { ${$_}{line} } @{$regular_ref}; my @rescale_line = map { ${$_}{line} } @{$rescale_ref}; my @regular_fill = map { ${$_}{fill} } @{$regular_ref}; my @rescale_fill = map { ${$_}{fill} } @{$rescale_ref}; # Add data to plot $self->svg_add_track( \@x_values, \@regular_y, \@regular_line, \@regular_fill, "$i-$start-$stop" ); $self->svg_add_track( \@x_values, \@rescale_y, \@rescale_line, \@rescale_fill, "$i-$start-$stop" ); # scale $self->make_scale( $i, $start, $stop ); } sub debug { my ( $self, $title, @arrs ) = @_; print "=" x 16 . "\n"; foreach (@arrs) { my @arr = @{$_}; printf "Array %s : %s\n", $title, scalar @arr; print "\t" . join( ',', map { sprintf( '%-10d', int($_) ) } @arr[ 0 .. 10 ] ) . "\n"; my $a = scalar(@arr) - 11; my $b = scalar(@arr) - 1; print "\t" . join( ',', map { sprintf( '%-10d', int($_) ) } @arr[ $a .. $b ] ) . "\n"; } } sub svg_add_track { my ( $self, $x_values_ref, $data_ref, $line_ref, $fill_ref, $base_track_id ) = @_; my @x_values = @{$x_values_ref}; my @data = @{$data_ref}; my @lines = @{$line_ref}; my @fills = @{$fill_ref}; my $it = each_array( @data, @lines, @fills ); while ( my ( $pry, $prl, $prf ) = $it->() ) { my $plot_data = $self->svg()->get_path( x => \@x_values, y => $pry, -type => 'polyline', -closed => 'false' #specify that the polyline is closed. ); $self->plot_track( $plot_data, $prl, $prf, "$base_track_id" ); } } sub plot_data { my ( $self, %d ) = @_; $self->add_header( $d{regular}, $d{rescale} ); ##loop through rows foreach ( my $i = 0 ; $i < $self->num_rows() ; $i++ ) { my ( $start, $stop ) = ( $i * $self->row_size(), ( $i + 1 ) * $self->row_size() ); $self->plot_individual_row( $start, $stop, $i, $d{regular}, $d{rescale}, ); } } sub plot_data_subset { my ( $self, %d ) = @_; $self->add_header( $d{regular}, $d{rescale} ); ##loop through rows $self->plot_individual_row( $d{from}, $d{to}, 0, $d{regular}, $d{rescale}, ); } sub push_all { my ( $self, $array_ref, @values ) = @_; foreach ( @{$array_ref} ) { push( @{$_}, @values ); } } no Moose; 1; __END__ =pod =encoding UTF-8 =head1 NAME CPT::Analysis::PAUSE::SVG - Library for use in PAUSE analysis =head1 VERSION version 1.96 =head1 AUTHOR Eric Rasche <rasche.eric@yandex.ru> =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Eric Rasche. This is free software, licensed under: The GNU General Public License, Version 3, June 2007 =cut