line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SVG::Graph::Kit; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:GENE'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Data plotting with SVG |
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
1849
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
65
|
|
6
|
2
|
|
|
2
|
|
14
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
102
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.0402'; |
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
1492
|
use parent qw(SVG::Graph); |
|
2
|
|
|
|
|
612
|
|
|
2
|
|
|
|
|
15
|
|
11
|
|
|
|
|
|
|
|
12
|
2
|
|
|
2
|
|
126750
|
use SVG::Graph::Data; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
56
|
|
13
|
2
|
|
|
2
|
|
2213
|
use SVG::Graph::Data::Datum; |
|
2
|
|
|
|
|
918
|
|
|
2
|
|
|
|
|
64
|
|
14
|
2
|
|
|
2
|
|
3768
|
use Math::Trig; |
|
2
|
|
|
|
|
31321
|
|
|
2
|
|
|
|
|
2574
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub new { |
18
|
2
|
|
|
2
|
1
|
897
|
my $class = shift; |
19
|
2
|
|
|
|
|
6
|
my %args = @_; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Move non-parent arguments to the kit. |
22
|
2
|
|
|
|
|
5
|
my %kit = (); |
23
|
2
|
|
|
|
|
5
|
for my $arg (qw(axis data plot polar)) { |
24
|
8
|
100
|
|
|
|
28
|
next unless exists $args{$arg}; |
25
|
1
|
|
|
|
|
3
|
$kit{$arg} = $args{$arg}; |
26
|
1
|
|
|
|
|
3
|
delete $args{$arg}; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Construct the SVG::Graph object with the remaining arguments. |
30
|
2
|
|
50
|
|
|
17
|
$args{width} ||= 600; |
31
|
2
|
|
50
|
|
|
13
|
$args{height} ||= 600; |
32
|
2
|
|
50
|
|
|
8
|
$args{margin} ||= 35; |
33
|
2
|
|
|
|
|
16
|
my $self = $class->SUPER::new(%args); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# Re-bless as a Graph::Kit object. |
36
|
2
|
|
|
|
|
764
|
bless $self, $class; |
37
|
2
|
|
|
|
|
8
|
$self->_setup(%kit); |
38
|
2
|
|
|
|
|
4894
|
return $self; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub _setup { |
42
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
43
|
2
|
|
|
|
|
6
|
my %args = @_; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Start with an initial frame... |
46
|
2
|
|
|
|
|
11
|
my $frame = $self->add_frame; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Plot the data. |
49
|
2
|
100
|
|
|
|
605
|
if ($args{data}) { |
50
|
|
|
|
|
|
|
# Load the graph data and use the SVG::Graph::Data object for label making. |
51
|
1
|
|
|
|
|
6
|
$self->{graph_data} = _load_data($args{data}, $frame, $args{polar}); |
52
|
|
|
|
|
|
|
# Add the data to the graph. |
53
|
|
|
|
|
|
|
my %plot = ( |
54
|
|
|
|
|
|
|
stroke => $args{plot}{stroke} || 'red', |
55
|
|
|
|
|
|
|
fill => $args{plot}{fill} || 'red', |
56
|
1
|
|
50
|
|
|
26
|
'fill-opacity' => $args{plot}{'fill-opacity'} || 0.5, |
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
57
|
|
|
|
|
|
|
); |
58
|
1
|
|
50
|
|
|
6
|
$args{plot}{type} ||= 'scatter'; |
59
|
1
|
|
|
|
|
5
|
$frame->add_glyph($args{plot}{type}, %plot); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Handle the axis unless it's set to 0. |
63
|
2
|
50
|
0
|
|
|
1393
|
if (not(exists $args{axis}) or exists $args{axis} and $args{axis}) { |
|
|
|
33
|
|
|
|
|
64
|
2
|
|
|
|
|
10
|
my %axis = $self->_load_axis($args{data}, $args{axis}); |
65
|
2
|
|
|
|
|
13
|
$frame->add_glyph('axis', %axis); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub _load_axis { |
70
|
2
|
|
|
2
|
|
5
|
my($self, $data, $axis) = @_; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# Initialize an empty axis unless given a hashref. |
73
|
2
|
50
|
|
|
|
7
|
$axis = {} if not ref $axis eq 'HASH'; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# Set the default properties and user override. |
76
|
2
|
|
|
|
|
12
|
my %axis = ( |
77
|
|
|
|
|
|
|
x_intercept => 0, |
78
|
|
|
|
|
|
|
y_intercept => 0, |
79
|
|
|
|
|
|
|
stroke => 'gray', |
80
|
|
|
|
|
|
|
'stroke-width' => 2, |
81
|
|
|
|
|
|
|
ticks => 30, # Max data per axis |
82
|
|
|
|
|
|
|
log => 0, |
83
|
|
|
|
|
|
|
%$axis, # User override |
84
|
|
|
|
|
|
|
); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# Set the number of ticks to show on each axis. |
87
|
2
|
|
33
|
|
|
12
|
$axis{xticks} ||= $axis{ticks}; |
88
|
2
|
|
33
|
|
|
9
|
$axis{yticks} ||= $axis{ticks}; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Set the logarithmic scaling factor. |
91
|
2
|
|
33
|
|
|
10
|
$axis{xlog} ||= $axis{log}; |
92
|
2
|
|
33
|
|
|
9
|
$axis{ylog} ||= $axis{log}; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Compute scale factors. |
95
|
2
|
|
|
|
|
3
|
my ($xscale, $yscale) = (1, 1); |
96
|
2
|
50
|
66
|
|
|
14
|
if ($data and $self->{graph_data}->xmax - $self->{graph_data}->xmin > $axis{xticks}) { |
97
|
|
|
|
|
|
|
# Round to the integer, i.e. 0 decimal places. |
98
|
0
|
|
|
|
|
0
|
$xscale = sprintf '%.0f', $self->{graph_data}->xmax / $axis{xticks}; |
99
|
|
|
|
|
|
|
} |
100
|
2
|
50
|
66
|
|
|
705
|
if ($data and $self->{graph_data}->ymax - $self->{graph_data}->ymin > $axis{yticks}) { |
101
|
|
|
|
|
|
|
# Round to the integer, i.e. 0 decimal places. |
102
|
0
|
|
|
|
|
0
|
$yscale = sprintf '%.0f', $self->{graph_data}->ymax / $axis{yticks}; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# Use absolute_ticks if no tick mark setting is provided. |
106
|
2
|
50
|
33
|
|
|
50
|
unless (defined $axis{x_absolute_ticks} or defined $axis{x_fractional_ticks}) { |
107
|
2
|
|
|
|
|
5
|
$axis{x_absolute_ticks} = $xscale; |
108
|
|
|
|
|
|
|
} |
109
|
2
|
50
|
33
|
|
|
14
|
unless (defined $axis{y_absolute_ticks} or defined $axis{y_fractional_ticks}) { |
110
|
2
|
|
|
|
|
9
|
$axis{y_absolute_ticks} = $yscale; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Use increments of 1 to data-max for ticks if none are provided. |
114
|
2
|
50
|
66
|
|
|
17
|
if ($data and !defined $axis{x_tick_labels} and !defined $axis{x_intertick_labels}) { |
|
|
|
66
|
|
|
|
|
115
|
1
|
50
|
|
|
|
4
|
if ($xscale > 1) { |
116
|
0
|
|
|
|
|
0
|
$axis{x_tick_labels} = [ $self->{graph_data}->xmin ]; |
117
|
0
|
|
|
|
|
0
|
push @{ $axis{x_tick_labels} }, $_ * $xscale for 1 .. $axis{ticks}; |
|
0
|
|
|
|
|
0
|
|
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
else { |
120
|
1
|
|
|
|
|
6
|
$axis{x_tick_labels} = [ $self->{graph_data}->xmin .. $self->{graph_data}->xmax ]; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
} |
123
|
2
|
50
|
66
|
|
|
59
|
if ($data and !defined $axis{y_tick_labels} and !defined $axis{y_intertick_labels}) { |
|
|
|
66
|
|
|
|
|
124
|
1
|
50
|
|
|
|
4
|
if ($yscale > 1) { |
125
|
0
|
|
|
|
|
0
|
$axis{y_tick_labels} = [ $self->{graph_data}->ymin ]; |
126
|
0
|
|
|
|
|
0
|
push @{ $axis{y_tick_labels} }, $_ * $yscale for 1 .. $axis{ticks}; |
|
0
|
|
|
|
|
0
|
|
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
else { |
129
|
1
|
|
|
|
|
5
|
$axis{y_tick_labels} = [ $self->{graph_data}->ymin .. $self->{graph_data}->ymax ]; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Remove keys not used by parent module. |
134
|
2
|
|
|
|
|
37
|
delete $axis{ticks}; |
135
|
2
|
|
|
|
|
5
|
delete $axis{xticks}; |
136
|
2
|
|
|
|
|
3
|
delete $axis{yticks}; |
137
|
2
|
|
|
|
|
4
|
delete $axis{log}; |
138
|
2
|
|
|
|
|
20
|
delete $axis{xlog}; |
139
|
2
|
|
|
|
|
5
|
delete $axis{ylog}; |
140
|
|
|
|
|
|
|
|
141
|
2
|
|
|
|
|
18
|
return %axis; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub _load_data { |
145
|
1
|
|
|
1
|
|
2
|
my ($data, $frame, $polar) = @_; |
146
|
|
|
|
|
|
|
# Create individual data points. |
147
|
1
|
|
|
|
|
3
|
my @data = (); |
148
|
1
|
|
|
|
|
2
|
for my $datum (@$data) { |
149
|
|
|
|
|
|
|
# Set the coordinate. |
150
|
9
|
|
|
|
|
235
|
my @coord = @$datum; |
151
|
9
|
50
|
|
|
|
23
|
@coord = _to_polar($datum) if $polar; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# Add our 3D data point. |
154
|
9
|
|
|
|
|
35
|
push @data, SVG::Graph::Data::Datum->new( |
155
|
|
|
|
|
|
|
x => $coord[0], |
156
|
|
|
|
|
|
|
y => $coord[1], |
157
|
|
|
|
|
|
|
z => $coord[2], |
158
|
|
|
|
|
|
|
); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
# Instantiate a new SVG::Graph::Data object; |
161
|
1
|
|
|
|
|
41
|
my $obj = SVG::Graph::Data->new(data => \@data); |
162
|
|
|
|
|
|
|
# Populate our graph with data. |
163
|
1
|
|
|
|
|
78
|
$frame->add_data($obj); |
164
|
1
|
|
|
|
|
22
|
return $obj; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub _theta { |
168
|
0
|
|
|
0
|
|
0
|
my $point = shift; |
169
|
|
|
|
|
|
|
# return int(rand 359); |
170
|
0
|
|
|
|
|
0
|
return atan2($point->[1], $point->[0]); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub _to_polar { |
174
|
0
|
|
|
0
|
|
0
|
my $point = shift; |
175
|
0
|
|
|
|
|
0
|
my $r = 0; |
176
|
0
|
|
|
|
|
0
|
$r += $_ ** 2 for @$point; |
177
|
0
|
|
|
|
|
0
|
$r = sqrt $r; |
178
|
0
|
|
|
|
|
0
|
my $t = _theta($point); |
179
|
0
|
|
|
|
|
0
|
return $r, $t; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub stat { |
184
|
21
|
|
|
21
|
1
|
6988
|
my ($self, $dimension, $name, @args) = @_; |
185
|
21
|
|
|
|
|
37
|
my $method = $dimension . $name; |
186
|
21
|
|
|
|
|
94
|
return $self->{graph_data}->$method(@args); |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
1; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
__END__ |