|
0
|
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
|
