File Coverage

File:blib/lib/SVG/Sparkline/Utils.pm
Coverage:95.6%

linestmtbrancondsubtimecode
1package SVG::Sparkline::Utils;
2
3
30
30
30
30
111
29
745
use warnings;
4
30
30
30
30
92
30
481
use strict;
5
30
30
30
30
121
71
1312
use Carp;
6
30
30
30
30
181
72
1010
use List::Util;
7
30
30
30
30
87
39
512
use SVG;
8
9our $VERSION = 0.35;
10
11sub format_f
12{
13
2972
2972
5341
    my $val = sprintf '%.02f', $_[0];
14
2972
2868
    $val =~ s/0$//;
15
2972
2282
    $val =~ s/\.0$//;
16
2972
100
2715
    $val = 0 if $val eq '-0';
17
2972
16581
    return $val;
18}
19
20sub calculate_xscale
21{
22
74
74
71
    my ($args, $xrange) = @_;
23
24
74
100
101
    if( $args->{width} )
25    {
26
8
15
        my $dwidth = $args->{width} - 2*$args->{padx};
27
8
32
        $args->{xscale} = ($dwidth-1) / $xrange;
28    }
29    else
30    {
31
66
100
98
        $args->{xscale} ||= 2;
32
66
66
58
95
        my $dwidth = @{$args->{values}} * $args->{xscale} - 1;
33
66
79
        $args->{width} = $dwidth + 2*$args->{padx};
34    }
35
74
820
    return;
36}
37
38sub calculate_yscale_and_offset
39{
40
74
74
80
    my ($args, $yrange, $offset) = @_;
41
42
74
81
    my $height = $args->{height} - 2*$args->{pady};
43
74
112
    $args->{yscale} = -$height / $yrange;
44
74
116
    my $baseline = format_f( -$args->{yscale} * $offset );
45
46
74
158
    $args->{yoff} = -($baseline+$height+$args->{pady});
47
48
74
851
    return;
49}
50
51sub xypairs_to_points_str
52{
53
74
74
73
    my ($vals, $xscale, $yscale) = @_;
54
763
719
    return join( ' ',
55
74
70
        map { format_f($xscale * $_->[0]) .','. format_f($yscale * $_->[1]) }
56
74
44
        @{$vals}
57    );
58}
59
60sub summarize_values
61{
62
64
64
55
    my ($array) = @_;
63
64
99
    my $desc = {
64
64
132
        min => List::Util::min( @{$array} ),
65
64
43
        max => List::Util::max( @{$array} ),
66    };
67
68
64
100
94
    $desc->{min} = 0 if $desc->{min} > 0;
69
64
100
79
    $desc->{max} = 0 if $desc->{max} < 0;
70
71
64
89
    $desc->{range} = $desc->{max}-$desc->{min};
72
64
737
    return $desc;
73}
74
75sub summarize_xy_values
76{
77
78
78
70
    my ($array) = @_;
78
78
100
120
    return _summarize_xy_pairs( $array ) if 'ARRAY' eq ref $array->[0];
79
72
139
    my $desc = {
80
72
102
        ymin => List::Util::min( @{$array} ),
81
72
66
        ymax => List::Util::max( @{$array} ),
82        xmin => 0,
83
72
143
        xmax => $#{$array},
84
72
44
        xrange => $#{$array},
85    };
86
72
81
    $desc->{base} = 0;
87
72
100
99
    $desc->{base} = $desc->{ymin} if $desc->{ymin} > 0;
88
72
100
83
    $desc->{base} = $desc->{ymax} if $desc->{ymax} < 0;
89
72
87
    $desc->{offset} = $desc->{ymin} - $desc->{base};
90
91
72
86
    $desc->{yrange} = $desc->{ymax}-$desc->{ymin};
92
72
49
    my $i = 0;
93
72
685
72
39
781
67
    $desc->{vals} = [map { [$i++,$_-$desc->{base}] } @{$array}];
94
72
862
    return $desc;
95}
96
97sub _summarize_xy_pairs
98{
99
6
6
5
    my ($array) = @_;
100
6
17
    my $desc = {
101        xmin => $array->[0]->[0],
102        xmax => $array->[-1]->[0],
103        ymin => $array->[0]->[1],
104        ymax => $array->[0]->[1],
105    };
106
107
6
6
5
6
    foreach my $p ( @{$array} )
108    {
109
32
82
        die "Array element is not a pair.\n"
110
34
100
100
76
            unless 'ARRAY' eq ref $p && 2 == @{$p};
111
30
50
35
        $desc->{xmin} = $p->[0] if $p->[0] < $desc->{xmin};
112
30
50
27
        $desc->{xmax} = $p->[0] if $p->[0] > $desc->{xmax};
113
30
100
30
        $desc->{ymin} = $p->[1] if $p->[1] < $desc->{ymin};
114
30
100
41
        $desc->{ymax} = $p->[1] if $p->[1] > $desc->{ymax};
115    }
116
2
2
    $desc->{base} = 0;
117
2
50
3
    $desc->{base} = $desc->{ymin} if $desc->{ymin} > 0;
118
2
50
3
    $desc->{base} = $desc->{ymax} if $desc->{ymax} < 0;
119
2
4
    $desc->{offset} = $desc->{ymin} - $desc->{base};
120
121
2
2
    $desc->{xrange} = $desc->{xmax}-$desc->{xmin};
122
2
3
    $desc->{yrange} = $desc->{ymax}-$desc->{ymin};
123
22
35
    $desc->{vals} =
124
2
2
12
2
        [map { [$_->[0]-$desc->{xmin},$_->[1]-$desc->{base}] } @{$array}];
125
2
27
    return $desc;
126}
127
128sub make_svg
129{
130
168
168
164
    my ($args) = @_;
131
168
1750
    my $svg = SVG->new(
132        -inline=>1, -nocredits=>1, -raiseerror=>1, -indent=>'', -elsep=>'',
133        width=>$args->{width}, height=>$args->{height},
134
168
392
        viewBox=> join( ' ', @{$args}{qw/xoff yoff width height/} )
135    );
136
137
168
100
31568
    if( exists $args->{bgcolor} )
138    {
139
8
87
        $svg->rect(
140            x => $args->{xoff}-1, y => $args->{yoff}-1,
141            width => $args->{width}+2, height => $args->{height}+2,
142            stroke => 'none', fill => $args->{bgcolor}
143        );
144    }
145
168
2303
    return $svg;
146}
147
148sub validate_array_param
149{
150
162
162
168
    my ($args, $name) = @_;
151
162
156
    local $Carp::CarpLevel = 2;
152
162
100
2272
    croak "Missing required '$name' parameter.\n" if !exists $args->{$name};
153
157
100
1313
    croak "'$name' must be an array reference.\n" unless 'ARRAY' eq ref $args->{$name};
154
149
149
100
107
715
    croak "No values for '$name' specified.\n" unless @{$args->{$name}};
155
144
1614
    return;
156}
157
158sub range_mark_to_index
159{
160
14
14
14
    my ($type, $index, $values) = @_;
161
14
100
59
    return 0 if $index eq 'first';
162
11
2
100
12
24
    return $#{$values} if $index eq 'last';
163
9
3
100
67
18
45
    return $index if $index !~ /\D/ && $index < @{$values};
164
6
100
50
10
    if( 'high' eq $index )
165    {
166
4
3
        my $high = $values->[0]->[1];
167
4
22
        my $ndx = 0;
168
4
4
3
7
        foreach my $i ( 1 .. $#{$values} )
169        {
170
16
100
24
            ($high,$ndx) = ($values->[$i]->[1],$i) if $values->[$i]->[1] > $high;
171        }
172
4
49
        return $ndx;
173    }
174    elsif( 'low' eq $index )
175    {
176
2
4
        my $low = $values->[0]->[0];
177
2
2
        my $ndx = 0;
178
2
2
2
3
        foreach my $i ( 1 .. $#{$values} )
179        {
180
8
100
12
            ($low,$ndx) = ($values->[$i]->[0],$i) if $values->[$i]->[0] < $low;
181        }
182
2
26
        return $ndx;
183    }
184
185
0
0
    croak "'$index' is not a valid mark for $type sparkline";
186}
187
188sub mark_to_index
189{
190
51
51
54
    my ($type, $index, $values) = @_;
191
51
100
150
    return 0 if $index eq 'first';
192
42
9
100
42
102
    return $#{$values} if $index eq 'last';
193
33
15
100
67
76
201
    return $index if $index !~ /\D/ && $index < @{$values};
194
18
100
50
29
    if( 'high' eq $index )
195    {
196
9
27
        my $high = $values->[0];
197
9
8
        my $ndx = 0;
198
9
9
5
12
        foreach my $i ( 1 .. $#{$values} )
199        {
200
54
100
110
            ($high,$ndx) = ($values->[$i],$i) if $values->[$i] > $high;
201        }
202
9
104
        return $ndx;
203    }
204    elsif( 'low' eq $index )
205    {
206
9
9
        my $low = $values->[0];
207
9
7
        my $ndx = 0;
208
9
9
4
17
        foreach my $i ( 1 .. $#{$values} )
209        {
210
54
100
61
            ($low,$ndx) = ($values->[$i],$i) if $values->[$i] < $low;
211        }
212
9
112
        return $ndx;
213    }
214
215
0
    croak "'$index' is not a valid mark for $type sparkline";
216}
217
218
2191; # Magic true value required at end of module