Mercurial > repos > cpt > cpt_psm_plotter

comparison lib/CPT/Analysis/PAUSE/SVG.pm @ 1:8691c1c61a8e draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author cpt
date Mon, 05 Jun 2023 02:48:47 +0000
parents
children
comparison
equal deleted inserted replaced
0:54c7a3ea81e2 1:8691c1c61a8e
1 package CPT::Analysis::PAUSE::SVG;
2
3 # ABSTRACT: Library for use in PAUSE analysis
4 use strict;
5 use warnings;
6 use Moose;
7 use Data::Dumper;
8 use List::MoreUtils qw(each_array);
9 use SVG;
10
11 has 'svg' => ( is => 'rw' );
12 has 'width' => ( is => 'rw', isa => 'Int' );
13 has 'height' => ( is => 'rw', isa => 'Int' );
14 has 'vertical_offset' => ( is => 'rw', isa => 'Int' );
15 has 'start_end_max_num' => ( is => 'rw', isa => 'Int' );
16 has 'num_rows' => ( is => 'rw', isa => 'Int' );
17 has 'row_size' => ( is => 'rw', isa => 'Int' );
18 has 'row_width' => ( is => 'rw', isa => 'Int' );
19 has 'x_border' => ( is => 'rw', isa => 'Int' );
20 has 'y_border' => ( is => 'rw', isa => 'Int' );
21 has 'line_height' => ( is => 'rw', isa => 'Int' );
22 has 'inter_line_spacing' => ( is => 'rw', isa => 'Int' );
23 has 'max' => ( is => 'rw', isa => 'Int' );
24 has 'fasta_id' => ( is => 'rw', isa => 'Any' );
25
26 sub setup {
27 my ($self) = @_;
28 $self->svg(
29 SVG->new(
30 width => $self->width(),
31 height => $self->height(),
32 )
33 );
34 }
35
36 sub add_header {
37 my ( $self, @refs ) = @_;
38
39 $self->plot_title( 'Plot of ' . $self->fasta_id() );
40
41 my $i = 0;
42 foreach (@refs) {
43 my @subrefs = @{$_};
44 foreach (@subrefs) {
45 $i++;
46 my %d = %{$_};
47 $self->plot_key( $d{name}, $d{line}, $d{fill}, $i );
48 }
49 }
50 $self->vertical_offset( $self->vertical_offset() - ( $i - 1 ) * 20 );
51 }
52
53 my $global_pline_idx = 0;
54
55 sub plot_track {
56 my ( $self, $points_ref, $stroke, $fill, $id ) = @_;
57
58 $global_pline_idx++;
59 $self->svg()->polyline(
60 %{$points_ref},
61 id => 'pline_' . $id . '-' . $global_pline_idx,
62 style => {
63 'fill-opacity' => .5,
64 'stroke' => $stroke,
65 'fill' => $fill,
66 }
67 )
68
69 }
70
71 sub make_scale {
72 my ( $self, $i, $start, $stop ) = @_;
73
74 # Left axis label, must be rotated
75 my $tmp_x = $self->fix_x_value(-30); #$self->x_border()-30;
76 my $tmp_y = $self->fix_y_value($i) + 50;
77 $self->svg()->text(
78 id => 'left_side_label_row_' . $i,
79 x => $tmp_x - 20,
80 y => $tmp_y - 20,
81 'font-family' => 'Helvetica, sans-serif',
82 'transform' => sprintf( 'rotate(-90 %s %s)', $tmp_x, $tmp_y ),
83 )->cdata('Start/End Hit Count Scale');
84
85 # Right axis label, must be rotated
86 $tmp_x = $self->fix_x_value( $self->row_width() + 60 );
87 $tmp_y = $self->fix_y_value($i);
88 $self->svg()->text(
89 id => 'right_side_label_row_' . $i,
90 x => $tmp_x - 20,
91 y => $tmp_y,
92 'font-family' => 'Helvetica, sans-serif',
93 'transform' => sprintf( 'rotate(-90 %s %s)', $tmp_x, $tmp_y ),
94 )->cdata('Coverage Density');
95
96 # Horizontal increments
97 for ( my $k = -4 ; $k <= 4 ; $k++ ) {
98
99 # Left side label
100 my $y_position = $k / 4 * $self->line_height();
101 $self->svg()->text(
102 id => sprintf( 'label_left_side_row_%s_%s', $i, $k ),
103 x => $self->fix_x_value(-30),
104 y => $self->fix_y_value( $i, $y_position ),
105 'font-family' => 'Helvetica, sans-serif',
106 )->cdata( int( $self->start_end_max_num() * abs( $k / 4 ) ) );
107
108 # Right side label
109 $self->svg()->text(
110 id => sprintf( 'label_right_side_row_%s_%s', $i, $k ),
111 x => $self->fix_x_value( $self->row_width() + 10 ),
112 y => $self->fix_y_value( $i, $y_position ),
113 'font-family' => 'Helvetica, sans-serif',
114 )->cdata( int( $self->max() * abs( $k / 4 ) ) );
115
116 # Vertical lines
117 $self->svg()->line(
118 x1 => $self->fix_x_value( $self->row_width() ),
119 x2 => $self->fix_x_value(0),
120 y1 => $self->fix_y_value( $i, $y_position ),
121 y2 => $self->fix_y_value( $i, $y_position ),
122 id => sprintf( 'vertical_increment_row_%s_%s', $i, $k ),
123 opacity => .25,
124 stroke => 'rgb(0,0,0)',
125 'stroke-width' => '2',
126 );
127 }
128
129 # Vertical Increments
130 my $number_of_increments = 10;
131 for (
132 my $k = 0 ;
133 $k <= $self->row_width() ;
134 $k += ( $self->row_width() / $number_of_increments )
135 )
136 {
137 # 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
138 my $b =
139 ( $k / $self->row_width() ) * ( $stop - $start ) + $start;
140 my $kb = $b / 1000;
141 $self->svg()->text(
142 id =>
143 sprintf( 'vertical_line_label_row_%s_%s', $i, $k ),
144 x => $self->fix_x_value($k),
145 y =>
146 $self->fix_y_value( $i, $self->line_height() + 20 ),
147 'font-family' => 'Helvetica, sans-serif',
148 )->cdata( ($kb) . ' kb' );
149
150 $self->svg()->line(
151 x1 => $self->fix_x_value($k),
152 x2 => $self->fix_x_value($k),
153 y1 => $self->fix_y_value( $i, -$self->line_height() ),
154 y2 => $self->fix_y_value( $i, $self->line_height() ),
155 id => sprintf( 'vertical_line_row_%s_%s', $i, $k ),
156 opacity => .5,
157 stroke => 'rgb(0,0,0)',
158 'stroke-width' => '1',
159 );
160 }
161 }
162
163 sub plot_title {
164 my ( $self, $string ) = @_;
165 $self->svg()->text(
166 id => 'label_plot_title',
167 x => $self->x_border(),
168 y => 50 + $self->vertical_offset(),
169 'font-family' => 'Helvetica, sans-serif',
170 'font-size' => '150%',
171 )->cdata($string);
172 $self->vertical_offset( $self->vertical_offset() + 25 );
173 }
174
175 sub plot_key {
176 my ( $self, $text, $stroke, $colour, $i ) = @_;
177
178 $self->svg()->rectangle(
179 x => $self->x_border(),
180 y => 50 + $self->vertical_offset() - 15,
181 width => 15,
182 height => 15,
183 id => 'label_key_example' . $i,
184 'fill-opacity' => .5,
185 'stroke' => $stroke,
186 'fill' => $colour,
187 );
188 $self->svg()->text(
189 id => 'label_key_string' . $i,
190 x => $self->x_border() + 20,
191 y => 50 + $self->vertical_offset(),
192 'font-family' => 'Helvetica, sans-serif',
193 )->cdata($text);
194 $self->vertical_offset( $self->vertical_offset + 20 );
195 }
196
197 sub xmlify {
198 my ($self) = @_;
199 return $self->svg()->xmlify();
200 }
201
202 sub x_values_for_range_scaled {
203 my ( $self, $start, $end, $pieces ) = @_;
204 my @vals = ($start);
205 my $by = ( $end - $start ) / $pieces;
206 ## 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)
207 for ( my $i = $start ; $i < $end ; $i += $by ) {
208 push( @vals, $i );
209 }
210 push( @vals, $end );
211 return @vals;
212 }
213
214 sub fix_x_values {
215 my ( $self, @values ) = @_;
216 return map { $self->fix_x_value($_) } @values;
217 }
218
219 sub fix_x_value {
220 my ( $self, $val ) = @_;
221 return $val + $self->x_border();
222 }
223
224 sub fix_y_value {
225 my ( $self, $i, $val ) = @_;
226 return (
227 $self->vertical_offset() + $val - $self->line_height() + (
228 ( ( 2 + $i ) * $self->line_height() ) +
229 ( $i * $self->inter_line_spacing() ) +
230 $self->y_border()
231 )
232 );
233 }
234
235 sub fix_all_y_values {
236 my ( $self, $i, @arrays_to_fix, ) = @_;
237 for ( my $j = 0 ; $j < scalar @arrays_to_fix ; $j++ ) {
238
239 # For each array in postive_y (AoA)
240 #
241 # we cast to array, then we map this, then we have this
242 # in an anonymous array which means we can just
243 # replace. This is probably not as efficient as looking
244 # at every value directly and doing "in place"
245 # replacement, but I don't know how that would be
246 # written here...
247 $arrays_to_fix[$j] =
248 [ map { $self->fix_y_value( $i, $_ ) }
249 @{ $arrays_to_fix[$j] } ];
250 }
251 return @arrays_to_fix;
252 }
253
254 sub copy_data {
255 my ( $self, $start, $stop, $data_to_ref, $data_from_ref, $max ) = @_;
256
257 # Copy data from the original array to the new one, transforming out
258 # the subset of interest. This is done across an AoA
259 my @data_to = @{$data_to_ref};
260 my @data_from = @{$data_from_ref};
261 for ( my $k = 0 ; $k < scalar @data_from ; $k++ ) {
262 foreach ( my $j = $start ; $j < $stop ; $j++ )
263 { #1 to 10_000 in the genome
264 if ( defined ${ $data_from[$k] }[$j] ) {
265 push(
266 @{ $data_to[$k] },
267 -(
268 $self->line_height() *
269 ${ $data_from[$k] }[$j] /
270 $max
271 )
272 );
273 }
274 else {
275 push( @{ $data_to[$k] }, 0 );
276 }
277 }
278 }
279 return @data_to;
280 }
281
282 sub plot_individual_row {
283 my ( $self, $start, $stop, $i, $regular_ref, $rescale_ref ) = @_;
284
285 my @regular = map { ${$_}{data} } @{$regular_ref};
286 my @rescale = map { ${$_}{data} } @{$rescale_ref};
287 my @regular_y;
288 my @rescale_y;
289 ## Ensure we duplicate the number of arrays.
290 foreach (@regular) {
291 push( @regular_y, [] );
292 }
293 foreach (@rescale) {
294 push( @rescale_y, [] );
295 }
296
297 # Determine bounds of row
298 $self->push_all( \@regular_y, 0 );
299 $self->push_all( \@rescale_y, 0 );
300
301 @regular_y =
302 $self->copy_data( $start, $stop, \@regular_y, \@regular,
303 $self->start_end_max_num() );
304 @rescale_y =
305 $self->copy_data( $start, $stop, \@rescale_y, \@rescale,
306 $self->max() );
307
308 #print @rescale_y;
309
310 # Set up our X values
311 my @x_values = $self->fix_x_values(
312 $self->x_values_for_range_scaled(
313 0, $self->row_width(), ( $stop - $start )
314 )
315 );
316
317 #my @x_values_rescale = $self->fix_x_values( $self->x_values_for_range_scaled(0, $self->row_width(), ( $stop - $start )));
318
319 $self->push_all( \@regular_y, 0 );
320 $self->push_all( \@rescale_y, 0 );
321
322 # Fix the ys
323 @regular_y = $self->fix_all_y_values( $i, @regular_y );
324 @rescale_y = $self->fix_all_y_values( $i, @rescale_y );
325
326 # Prepare our styling
327 my @regular_line = map { ${$_}{line} } @{$regular_ref};
328 my @rescale_line = map { ${$_}{line} } @{$rescale_ref};
329 my @regular_fill = map { ${$_}{fill} } @{$regular_ref};
330 my @rescale_fill = map { ${$_}{fill} } @{$rescale_ref};
331
332 # Add data to plot
333 $self->svg_add_track(
334 \@x_values, \@regular_y, \@regular_line,
335 \@regular_fill, "$i-$start-$stop"
336 );
337 $self->svg_add_track(
338 \@x_values, \@rescale_y, \@rescale_line,
339 \@rescale_fill, "$i-$start-$stop"
340 );
341
342 # scale
343 $self->make_scale( $i, $start, $stop );
344 }
345
346 sub debug {
347 my ( $self, $title, @arrs ) = @_;
348 print "=" x 16 . "\n";
349 foreach (@arrs) {
350 my @arr = @{$_};
351 printf "Array %s : %s\n", $title, scalar @arr;
352 print "\t"
353 . join( ',',
354 map { sprintf( '%-10d', int($_) ) } @arr[ 0 .. 10 ] )
355 . "\n";
356 my $a = scalar(@arr) - 11;
357 my $b = scalar(@arr) - 1;
358 print "\t"
359 . join( ',',
360 map { sprintf( '%-10d', int($_) ) } @arr[ $a .. $b ] )
361 . "\n";
362 }
363 }
364
365 sub svg_add_track {
366 my (
367 $self, $x_values_ref, $data_ref,
368 $line_ref, $fill_ref, $base_track_id
369 ) = @_;
370 my @x_values = @{$x_values_ref};
371 my @data = @{$data_ref};
372 my @lines = @{$line_ref};
373 my @fills = @{$fill_ref};
374
375 my $it = each_array( @data, @lines, @fills );
376 while ( my ( $pry, $prl, $prf ) = $it->() ) {
377 my $plot_data = $self->svg()->get_path(
378 x => \@x_values,
379 y => $pry,
380 -type => 'polyline',
381 -closed => 'false' #specify that the polyline is closed.
382 );
383 $self->plot_track( $plot_data, $prl, $prf, "$base_track_id" );
384 }
385 }
386
387 sub plot_data {
388 my ( $self, %d ) = @_;
389 $self->add_header( $d{regular}, $d{rescale} );
390
391 ##loop through rows
392 foreach ( my $i = 0 ; $i < $self->num_rows() ; $i++ ) {
393 my ( $start, $stop ) =
394 ( $i * $self->row_size(), ( $i + 1 ) * $self->row_size() );
395 $self->plot_individual_row( $start, $stop, $i, $d{regular},
396 $d{rescale}, );
397 }
398 }
399
400 sub plot_data_subset {
401 my ( $self, %d ) = @_;
402
403 $self->add_header( $d{regular}, $d{rescale} );
404 ##loop through rows
405 $self->plot_individual_row( $d{from}, $d{to}, 0, $d{regular},
406 $d{rescale}, );
407 }
408
409 sub push_all {
410 my ( $self, $array_ref, @values ) = @_;
411 foreach ( @{$array_ref} ) {
412 push( @{$_}, @values );
413 }
414 }
415
416 no Moose;
417 1;
418
419 __END__
420
421 =pod
422
423 =encoding UTF-8
424
425 =head1 NAME
426
427 CPT::Analysis::PAUSE::SVG - Library for use in PAUSE analysis
428
429 =head1 VERSION
430
431 version 1.96
432
433 =head1 AUTHOR
434
435 Eric Rasche <rasche.eric@yandex.ru>
436
437 =head1 COPYRIGHT AND LICENSE
438
439 This software is Copyright (c) 2014 by Eric Rasche.
440
441 This is free software, licensed under:
442
443 The GNU General Public License, Version 3, June 2007
444
445 =cut