Mercurial > repos > cpt > cpt_psm_recombine

comparison lib/CPT/Analysis/PAUSE/SVG.pm @ 1:97ef96676b48 draft

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:51:26 +0000
parents
children
comparison
equal deleted inserted replaced
0:b18e8268bf4e 1:97ef96676b48
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