line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package GitInsight; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# XXX: Add behavioural change detection, focusing on that period for predictions |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
BEGIN { |
6
|
2
|
|
|
2
|
|
14982
|
$| = 1; |
7
|
2
|
|
|
|
|
75
|
$^W = 1; |
8
|
|
|
|
|
|
|
} |
9
|
|
|
|
|
|
|
our $VERSION = '0.06'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
#use Carp::Always; |
12
|
2
|
|
|
2
|
|
703
|
use GitInsight::Obj -base; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
10
|
|
13
|
2
|
|
|
2
|
|
8
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
43
|
|
14
|
2
|
|
|
2
|
|
6
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
38
|
|
15
|
2
|
|
|
2
|
|
40
|
use 5.008_005; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
60
|
|
16
|
2
|
|
|
2
|
|
1123
|
use GD::Simple; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use Carp; |
19
|
|
|
|
|
|
|
use Storable qw(dclone); |
20
|
|
|
|
|
|
|
use POSIX; |
21
|
|
|
|
|
|
|
use Time::Local; |
22
|
|
|
|
|
|
|
use GitInsight::Util |
23
|
|
|
|
|
|
|
qw(markov markov_list LABEL_DIM gen_m_mat gen_trans_mat info error warning wday label prob label_step); |
24
|
|
|
|
|
|
|
use List::Util qw(max); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use LWP::UserAgent; |
27
|
|
|
|
|
|
|
use POSIX qw(strftime ceil); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
has [qw(username contribs calendar)]; |
30
|
|
|
|
|
|
|
has 'verbose' => sub {0}; |
31
|
|
|
|
|
|
|
has 'no_day_stats' => sub {0}; |
32
|
|
|
|
|
|
|
has 'statistics' => sub {0}; |
33
|
|
|
|
|
|
|
has 'ca_output' => sub {1}; |
34
|
|
|
|
|
|
|
has 'accuracy' => sub {0}; |
35
|
|
|
|
|
|
|
has [qw(left_cutoff cutoff_offset file_output)]; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub contrib_calendar { |
38
|
|
|
|
|
|
|
my $self = shift; |
39
|
|
|
|
|
|
|
my $username = shift || $self->username; |
40
|
|
|
|
|
|
|
$self->username($username) if !$self->username; |
41
|
|
|
|
|
|
|
my $ua = LWP::UserAgent->new; |
42
|
|
|
|
|
|
|
$ua->timeout(10); |
43
|
|
|
|
|
|
|
$ua->env_proxy; |
44
|
|
|
|
|
|
|
my $response |
45
|
|
|
|
|
|
|
= $ua->get( |
46
|
|
|
|
|
|
|
'https://github.com/users/' . $username . '/contributions' ); |
47
|
|
|
|
|
|
|
info "Getting " |
48
|
|
|
|
|
|
|
. 'https://github.com/users/' |
49
|
|
|
|
|
|
|
. $username |
50
|
|
|
|
|
|
|
. '/contributions' |
51
|
|
|
|
|
|
|
if $self->verbose; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
if ( $response->is_success ) { |
54
|
|
|
|
|
|
|
$self->decode( $response->decoded_content ); |
55
|
|
|
|
|
|
|
return $self->contribs; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
else { |
58
|
|
|
|
|
|
|
die $response->status_line; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub draw_ca { |
63
|
|
|
|
|
|
|
my $self = shift; |
64
|
|
|
|
|
|
|
my @CA = @_; |
65
|
|
|
|
|
|
|
my $cols = ceil( $#CA / 7 ) + 1; |
66
|
|
|
|
|
|
|
my $rows = 7; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my $cell_width = 50; |
69
|
|
|
|
|
|
|
my $cell_height = 50; |
70
|
|
|
|
|
|
|
my $border = 3; |
71
|
|
|
|
|
|
|
my $width = $cols * $cell_width; |
72
|
|
|
|
|
|
|
my $height = $rows * $cell_height; |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
my $img = GD::Simple->new( $width, $height ); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
$img->font(gdSmallFont); #i'll need that later |
77
|
|
|
|
|
|
|
for ( my $c = 0; $c < $cols; $c++ ) { |
78
|
|
|
|
|
|
|
for ( my $r = 0; $r < $rows; $r++ ) { |
79
|
|
|
|
|
|
|
my $color = $CA[ $c * $rows + $r ] |
80
|
|
|
|
|
|
|
or |
81
|
|
|
|
|
|
|
next; #infering ca from sequences of colours generated earlier |
82
|
|
|
|
|
|
|
my @topleft = ( $c * $cell_width, $r * $cell_height ); |
83
|
|
|
|
|
|
|
my @botright = ( |
84
|
|
|
|
|
|
|
$topleft[0] + $cell_width - $border, |
85
|
|
|
|
|
|
|
$topleft[1] + $cell_height - $border |
86
|
|
|
|
|
|
|
); |
87
|
|
|
|
|
|
|
eval { |
88
|
|
|
|
|
|
|
$img->bgcolor( @{$color} ); |
89
|
|
|
|
|
|
|
$img->fgcolor( @{$color} ); |
90
|
|
|
|
|
|
|
}; |
91
|
|
|
|
|
|
|
$img->rectangle( @topleft, @botright ); |
92
|
|
|
|
|
|
|
$img->moveTo( $topleft[0] + 2, $botright[1] + 2 ); |
93
|
|
|
|
|
|
|
$img->fgcolor( 255, 0, 0 ) |
94
|
|
|
|
|
|
|
and $img->rectangle( @topleft, @botright ) |
95
|
|
|
|
|
|
|
if ( $c * $rows + $r >= ( scalar(@CA) - 7 ) ); |
96
|
|
|
|
|
|
|
$img->fgcolor( 0, 0, 0 ) |
97
|
|
|
|
|
|
|
and $img->string( $GitInsight::Util::wday[$r] ) |
98
|
|
|
|
|
|
|
if ( $c == 0 ); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
if ( defined $self->file_output ) { |
102
|
|
|
|
|
|
|
my $filename = $self->file_output . ".png"; |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
#. "/" |
105
|
|
|
|
|
|
|
#. join( "_", $self->start_day, $self->last_day ) . "_" |
106
|
|
|
|
|
|
|
#. $self->username . "_" |
107
|
|
|
|
|
|
|
#. scalar(@CA) . |
108
|
|
|
|
|
|
|
open my $PNG, ">" . $filename; |
109
|
|
|
|
|
|
|
binmode($PNG); |
110
|
|
|
|
|
|
|
print $PNG $img->png; |
111
|
|
|
|
|
|
|
close $PNG; |
112
|
|
|
|
|
|
|
info "File written in : " . $filename if $self->verbose; |
113
|
|
|
|
|
|
|
return $filename; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
else { |
116
|
|
|
|
|
|
|
return $img->png; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# useful when interrogating the object |
122
|
|
|
|
|
|
|
sub start_day { shift->{first_day}->{data} } |
123
|
|
|
|
|
|
|
sub last_day { @{ shift->{result} }[-1]->[2] } |
124
|
|
|
|
|
|
|
sub prediction_start_day { @{ shift->{result} }[0]->[2] } |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub _accuracy { |
127
|
|
|
|
|
|
|
my $self = shift; |
128
|
|
|
|
|
|
|
my ( @chunks, @commits ); |
129
|
|
|
|
|
|
|
push @chunks, [ splice @{ $self->calendar }, 0, 7 ] |
130
|
|
|
|
|
|
|
while @{ $self->calendar }; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
#@chunks contain a list of arrays of 7 days each |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my $total_days = 0; |
135
|
|
|
|
|
|
|
my $accuracy = 0; |
136
|
|
|
|
|
|
|
for (@chunks) { |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# next if @{$_} < 4; |
139
|
|
|
|
|
|
|
push( @commits, @{$_} ); |
140
|
|
|
|
|
|
|
my $Insight = GitInsight->new( |
141
|
|
|
|
|
|
|
no_day_stats => $self->no_day_stats, |
142
|
|
|
|
|
|
|
ca_output => 0, |
143
|
|
|
|
|
|
|
username => $self->username |
144
|
|
|
|
|
|
|
); #disable png generation |
145
|
|
|
|
|
|
|
$Insight->decode( [@commits] ) |
146
|
|
|
|
|
|
|
; #using $_ for small contributors is better |
147
|
|
|
|
|
|
|
$Insight->process; |
148
|
|
|
|
|
|
|
foreach my $res ( @{ $Insight->{result} } ) { |
149
|
|
|
|
|
|
|
next if ( !exists $self->contribs->{ $res->[2] }->{l} ); |
150
|
|
|
|
|
|
|
$accuracy++ |
151
|
|
|
|
|
|
|
if ( $self->contribs->{ $res->[2] }->{l} == $res->[1] ); |
152
|
|
|
|
|
|
|
$total_days++; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
my $accuracy_prob = prob( $total_days, $accuracy ); |
156
|
|
|
|
|
|
|
$self->{accuracy} = $accuracy_prob; |
157
|
|
|
|
|
|
|
info "Accuracy is $accuracy / $total_days" if $self->verbose; |
158
|
|
|
|
|
|
|
info sprintf( "%.5f", $accuracy_prob * 100 ) . " \%" if $self->verbose; |
159
|
|
|
|
|
|
|
return $self; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub _decode_calendar { |
163
|
|
|
|
|
|
|
shift; |
164
|
|
|
|
|
|
|
my $content = shift; |
165
|
|
|
|
|
|
|
my @out; |
166
|
|
|
|
|
|
|
push( @out, [ $2, $1 ] ) |
167
|
|
|
|
|
|
|
while ( $content =~ m/data\-count="(.*?)" data\-date="(.*?)"/g ); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
return \@out; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# first argument is the data: |
173
|
|
|
|
|
|
|
# it should be a string in the form [ [2013-01-20, 9], .... ] a stringified form of arrayref. each element must be an array ref containing in the first position the date, and in the second the commits . |
174
|
|
|
|
|
|
|
sub decode { |
175
|
|
|
|
|
|
|
my $self = shift; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
#my $response = ref $_[0] ne "ARRAY" ? eval(shift) : shift; |
178
|
|
|
|
|
|
|
my $response |
179
|
|
|
|
|
|
|
= ref $_[0] ne "ARRAY" ? $self->_decode_calendar(shift) : shift; |
180
|
|
|
|
|
|
|
$self->calendar( dclone($response) ); |
181
|
|
|
|
|
|
|
my %commits_count; |
182
|
|
|
|
|
|
|
my $min = $self->left_cutoff || 0; |
183
|
|
|
|
|
|
|
$self->{result} = []; #empty the result |
184
|
|
|
|
|
|
|
$min = 0 if ( $min < 0 ); # avoid negative numbers |
185
|
|
|
|
|
|
|
my $max |
186
|
|
|
|
|
|
|
= $self->cutoff_offset || ( scalar( @{$response} ) - 1 ); |
187
|
|
|
|
|
|
|
$max = scalar( @{$response} ) |
188
|
|
|
|
|
|
|
if $max > scalar( @{$response} ) |
189
|
|
|
|
|
|
|
; # maximum cutoff boundary it's array element number |
190
|
|
|
|
|
|
|
info "$min -> $max portion" if $self->verbose; |
191
|
|
|
|
|
|
|
my $max_commit |
192
|
|
|
|
|
|
|
= max( map { $_->[1] } @{$response} ); #Calculating label steps |
193
|
|
|
|
|
|
|
label_step( 0 .. $max_commit ); #calculating quartiles over commit count |
194
|
|
|
|
|
|
|
info( "Max commit is: " . $max_commit ) if $self->verbose; |
195
|
|
|
|
|
|
|
$self->{first_day}->{day} = wday( $response->[0]->[0] ) |
196
|
|
|
|
|
|
|
; #getting the first day of the commit calendar, it's where the ca will start |
197
|
|
|
|
|
|
|
my ($index) |
198
|
|
|
|
|
|
|
= grep { $GitInsight::Util::wday[$_] eq $self->{first_day}->{day} } |
199
|
|
|
|
|
|
|
0 .. $#GitInsight::Util::wday; |
200
|
|
|
|
|
|
|
$self->{first_day}->{index} = $index; |
201
|
|
|
|
|
|
|
$self->{first_day}->{data} = $response->[$min]->[0]; |
202
|
|
|
|
|
|
|
push( @{ $self->{ca} }, [ 255, 255, 255 ] ) |
203
|
|
|
|
|
|
|
for ( |
204
|
|
|
|
|
|
|
0 .. scalar(@GitInsight::Util::wday) #white fill for labels |
205
|
|
|
|
|
|
|
+ ( $index - 1 ) |
206
|
|
|
|
|
|
|
); #white fill for no contribs |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
$self->{transition} = gen_trans_mat( $self->no_day_stats ); |
209
|
|
|
|
|
|
|
my $last; |
210
|
|
|
|
|
|
|
$self->{last_week} |
211
|
|
|
|
|
|
|
= [ map { [ $_->[0], label( $_->[1] ) ] } |
212
|
|
|
|
|
|
|
( @{$response} )[ ( ( $max + $min ) - 6 ) .. ( $max + $min ) ] ] |
213
|
|
|
|
|
|
|
; # cutting the last week from the answer and substituting the label instead of the commit number |
214
|
|
|
|
|
|
|
#print( $self->{transition}->{$_} ) for (last_week keys $self->{transition} ); |
215
|
|
|
|
|
|
|
# $self->{max_commit} =0; |
216
|
|
|
|
|
|
|
$self->contribs( |
217
|
|
|
|
|
|
|
$self->no_day_stats |
218
|
|
|
|
|
|
|
? { map { |
219
|
|
|
|
|
|
|
my $l = label( $_->[1] ); |
220
|
|
|
|
|
|
|
push( @{ $self->{ca} }, $GitInsight::Util::CA_COLOURS{$l} ) |
221
|
|
|
|
|
|
|
; #building the ca |
222
|
|
|
|
|
|
|
$last = $l if ( !$last ); |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# $commits_count{ $_->[1] } = 1; |
225
|
|
|
|
|
|
|
$self->{stats}->{$l}++ |
226
|
|
|
|
|
|
|
if $self->statistics == 1; #filling stats hashref |
227
|
|
|
|
|
|
|
$self->{transition_hash}->{$last}->{$l}++ |
228
|
|
|
|
|
|
|
; #filling transition_hash hashref from $last (last seen label) to current label |
229
|
|
|
|
|
|
|
$self->{transition} |
230
|
|
|
|
|
|
|
->slice("$last,$l")++; #filling transition matrix |
231
|
|
|
|
|
|
|
#$self->{max_commit} = $_->[1] if ($_->[1]>$self->{max_commit}); |
232
|
|
|
|
|
|
|
$last = $l; |
233
|
|
|
|
|
|
|
$_->[0] => { |
234
|
|
|
|
|
|
|
c => $_->[1], #commits |
235
|
|
|
|
|
|
|
l => $l #label |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
} splice( @{$response}, $min, ( $max + 1 ) ) |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
: { map { |
241
|
|
|
|
|
|
|
my $w = wday( $_->[0] ); |
242
|
|
|
|
|
|
|
my $l = label( $_->[1] ); |
243
|
|
|
|
|
|
|
push( @{ $self->{ca} }, $GitInsight::Util::CA_COLOURS{$l} ); |
244
|
|
|
|
|
|
|
$last = $l if ( !$last ); |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# $commits_count{ $_->[1] } = 1; |
247
|
|
|
|
|
|
|
$self->{stats}->{$w}->{$l}++ |
248
|
|
|
|
|
|
|
if $self->statistics == 1; #filling stats hashref |
249
|
|
|
|
|
|
|
$self->{transition_hash}->{$w}->{$last} |
250
|
|
|
|
|
|
|
->{$l}++; #filling stats hashref |
251
|
|
|
|
|
|
|
$self->{transition}->{$w} |
252
|
|
|
|
|
|
|
->slice("$last,$l")++; #filling transition matrix |
253
|
|
|
|
|
|
|
$last = $l; |
254
|
|
|
|
|
|
|
$_->[0] => { |
255
|
|
|
|
|
|
|
c => $_->[1], #commits |
256
|
|
|
|
|
|
|
d => $w, #day in the week |
257
|
|
|
|
|
|
|
l => $l #label |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
} splice( @{$response}, $min, ( $max + 1 ) ) |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
); |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
return $self->contribs; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
sub process { |
268
|
|
|
|
|
|
|
my $self = shift; |
269
|
|
|
|
|
|
|
croak "process() called while you have not specified an username" |
270
|
|
|
|
|
|
|
if !$self->username; |
271
|
|
|
|
|
|
|
$self->contrib_calendar( $self->username ) |
272
|
|
|
|
|
|
|
if !$self->contribs and $self->username; |
273
|
|
|
|
|
|
|
$self->_transition_matrix; |
274
|
|
|
|
|
|
|
$self->_markov; |
275
|
|
|
|
|
|
|
$self->_gen_stats if ( $self->statistics ); |
276
|
|
|
|
|
|
|
$self->{png} = $self->draw_ca( @{ $self->{ca} } ) |
277
|
|
|
|
|
|
|
if ( $self->ca_output == 1 ); |
278
|
|
|
|
|
|
|
$self->{steps} = \%GitInsight::Util::LABEL_STEPS; |
279
|
|
|
|
|
|
|
$self->_accuracy if $self->accuracy and $self->accuracy == 1; |
280
|
|
|
|
|
|
|
return $self; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub _gen_stats { |
284
|
|
|
|
|
|
|
my $self = shift; |
285
|
|
|
|
|
|
|
my $sum = 0; |
286
|
|
|
|
|
|
|
if ( $self->no_day_stats ) { |
287
|
|
|
|
|
|
|
$sum += $_ for values %{ $self->{stats} }; |
288
|
|
|
|
|
|
|
foreach my $k ( keys %{ $self->{stats} } ) { |
289
|
|
|
|
|
|
|
info "Calculating probability for label $k $sum / " |
290
|
|
|
|
|
|
|
. $self->{stats}->{$k} |
291
|
|
|
|
|
|
|
if $self->verbose; |
292
|
|
|
|
|
|
|
my $prob = prob( $sum, $self->{stats}->{$k} ); |
293
|
|
|
|
|
|
|
info "Is: $prob" if $self->verbose; |
294
|
|
|
|
|
|
|
$self->{stats}->{$k} = sprintf "%.5f", $prob; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
else { |
298
|
|
|
|
|
|
|
foreach my $k ( keys %{ $self->{stats} } ) { |
299
|
|
|
|
|
|
|
$sum = 0; |
300
|
|
|
|
|
|
|
$sum += $_ for values %{ $self->{stats}->{$k} }; |
301
|
|
|
|
|
|
|
map { |
302
|
|
|
|
|
|
|
info "Calculating probability for $k -> label $_ $sum / " |
303
|
|
|
|
|
|
|
. $self->{stats}->{$k}->{$_} |
304
|
|
|
|
|
|
|
if $self->verbose; |
305
|
|
|
|
|
|
|
my $prob = prob( $sum, $self->{stats}->{$k}->{$_} ); |
306
|
|
|
|
|
|
|
info "Is: $prob" if $self->verbose; |
307
|
|
|
|
|
|
|
$self->{stats}->{$k}->{$_} = sprintf "%.5f", $prob; |
308
|
|
|
|
|
|
|
} ( keys %{ $self->{stats}->{$k} } ); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub _markov { |
314
|
|
|
|
|
|
|
my $self = shift; |
315
|
|
|
|
|
|
|
info "Markov chain phase" if $self->verbose; |
316
|
|
|
|
|
|
|
my $dayn = 1; |
317
|
|
|
|
|
|
|
info "Calculating predictions for " |
318
|
|
|
|
|
|
|
. ( scalar( @{ $self->{last_week} } ) ) . " days" |
319
|
|
|
|
|
|
|
if $self->verbose; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
foreach my $day ( @{ $self->{last_week} } ) { #cycling the last week |
322
|
|
|
|
|
|
|
my $wd = wday( $day->[0] ); #computing the weekday |
323
|
|
|
|
|
|
|
my $ld = $day->[1]; #getting the label |
324
|
|
|
|
|
|
|
my $M = markov_list( |
325
|
|
|
|
|
|
|
gen_m_mat($ld), |
326
|
|
|
|
|
|
|
$self->no_day_stats |
327
|
|
|
|
|
|
|
? $self->{transition} |
328
|
|
|
|
|
|
|
: $self->{transition}->{$wd}, |
329
|
|
|
|
|
|
|
$dayn |
330
|
|
|
|
|
|
|
); #Computing the markov for the state |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
my $label = 0; |
333
|
|
|
|
|
|
|
$M->[$label] > $M->[$_] or $label = $_ for 1 .. scalar(@$M) - 1; |
334
|
|
|
|
|
|
|
push( @{ $self->{ca} }, $GitInsight::Util::CA_COLOURS{$label} ) |
335
|
|
|
|
|
|
|
; #adding the predictions to ca |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
my ( $mday, $mon, $year ) |
338
|
|
|
|
|
|
|
= reverse( split( /-/, $day->[0] ) ); #splitting date |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
push( |
341
|
|
|
|
|
|
|
@{ $self->{result} }, |
342
|
|
|
|
|
|
|
[ $wd, $label, |
343
|
|
|
|
|
|
|
$day->[0] = strftime( |
344
|
|
|
|
|
|
|
'%Y-%m-%d', |
345
|
|
|
|
|
|
|
localtime( |
346
|
|
|
|
|
|
|
timelocal( 0, 0, 0, $mday, $mon - 1, $year ) |
347
|
|
|
|
|
|
|
+ 7 * 86_400 |
348
|
|
|
|
|
|
|
) |
349
|
|
|
|
|
|
|
) #adding 7 days to the date, and adding the result to $self->{result} |
350
|
|
|
|
|
|
|
, |
351
|
|
|
|
|
|
|
$M |
352
|
|
|
|
|
|
|
] |
353
|
|
|
|
|
|
|
); |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
if ( $self->verbose ) { |
356
|
|
|
|
|
|
|
info "$wd: " |
357
|
|
|
|
|
|
|
. $label . " has " |
358
|
|
|
|
|
|
|
. ( sprintf "%.2f", $M->[$label] * 100 ) |
359
|
|
|
|
|
|
|
. "% of probability to happen"; |
360
|
|
|
|
|
|
|
info "\t" |
361
|
|
|
|
|
|
|
. $_ |
362
|
|
|
|
|
|
|
. " ---- " |
363
|
|
|
|
|
|
|
. ( sprintf "%.2f", $M->[$_] * 100 ) . "%" |
364
|
|
|
|
|
|
|
for 0 .. scalar(@$M) - 1; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
############# TREEMAP GENERATION ############# |
368
|
|
|
|
|
|
|
$self->{'treemap'}->{'name'} = "day"; |
369
|
|
|
|
|
|
|
my $hwd = { name => $day->[0], children => [] }; |
370
|
|
|
|
|
|
|
push( |
371
|
|
|
|
|
|
|
@{ $hwd->{children} }, |
372
|
|
|
|
|
|
|
{ name => $_, size => $M->[$_] * 10000 } |
373
|
|
|
|
|
|
|
) for 0 .. scalar(@$M) - 1; |
374
|
|
|
|
|
|
|
push( @{ $self->{'treemap'}->{"children"} }, $hwd ); |
375
|
|
|
|
|
|
|
################################################ |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
$dayn++ if $self->no_day_stats; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
return $self->{result}; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub _transition_matrix { |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
#transition matrix, sum all the transitions occourred in each day, and do prob(sumtransitionrow ,current transation occurrance ) |
387
|
|
|
|
|
|
|
my $self = shift; |
388
|
|
|
|
|
|
|
info "Going to build transation matrix probabilities" if $self->verbose; |
389
|
|
|
|
|
|
|
if ( $self->no_day_stats ) { |
390
|
|
|
|
|
|
|
my $sum = $self->{transition}->sumover(); |
391
|
|
|
|
|
|
|
map { |
392
|
|
|
|
|
|
|
foreach my $c ( 0 .. LABEL_DIM ) { |
393
|
|
|
|
|
|
|
$self->{transition}->slice("$_,$c") |
394
|
|
|
|
|
|
|
.= prob( # slice of the single element of the matrix , calculating bayesian inference |
395
|
|
|
|
|
|
|
$sum->at($c), #contains the transition sum of the row |
396
|
|
|
|
|
|
|
$self->{transition}->at( $_, $c ) |
397
|
|
|
|
|
|
|
); # all the transation occurred, current transation |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} ( 0 .. LABEL_DIM ); |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
else { |
402
|
|
|
|
|
|
|
foreach my $k ( keys %{ $self->{transition} } ) { |
403
|
|
|
|
|
|
|
my $sum = $self->{transition}->{$k}->sumover(); |
404
|
|
|
|
|
|
|
map { |
405
|
|
|
|
|
|
|
foreach my $c ( 0 .. LABEL_DIM ) { |
406
|
|
|
|
|
|
|
$self->{transition}->{$k}->slice("$_,$c") |
407
|
|
|
|
|
|
|
.= prob( # slice of the single element of the matrix , calculating bayesian inference |
408
|
|
|
|
|
|
|
$sum->at($c) |
409
|
|
|
|
|
|
|
, #contains the transition sum of the row over the day |
410
|
|
|
|
|
|
|
$self->{transition}->{$k}->at( $_, $c ) |
411
|
|
|
|
|
|
|
) |
412
|
|
|
|
|
|
|
; # all the transation occurred in those days, current transation |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
} ( 0 .. LABEL_DIM ); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
1; |
420
|
|
|
|
|
|
|
__END__ |