File Coverage

blib/lib/Sport/Analytics/NHL/Normalizer.pm
Criterion Covered Total %
statement 371 407 91.1
branch 87 132 65.9
condition 119 199 59.8
subroutine 41 41 100.0
pod 21 21 100.0
total 639 800 79.8


line stmt bran cond sub pod time code
1             package Sport::Analytics::NHL::Normalizer;
2              
3 28     28   107706 use v5.10.1;
  28         108  
4 28     28   164 use strict;
  28         58  
  28         692  
5 28     28   133 use warnings FATAL => 'all';
  28         52  
  28         1119  
6 28     28   141 use experimental qw(smartmatch);
  28         51  
  28         193  
7              
8 28     28   1771 use Carp;
  28         61  
  28         1591  
9 28     28   1170 use Storable qw(store retrieve dclone);
  28         5041  
  28         1481  
10 28     28   952 use POSIX qw(strftime);
  28         9616  
  28         247  
11              
12 28     28   4855 use Date::Parse;
  28         11273  
  28         2639  
13 28     28   173 use File::Basename;
  28         69  
  28         1657  
14 28     28   1060 use List::MoreUtils qw(uniq part);
  28         20893  
  28         233  
15              
16 28     28   20189 use Sport::Analytics::NHL::Config;
  28         57  
  28         5148  
17 28     28   1245 use Sport::Analytics::NHL::DB;
  28         62  
  28         691  
18 28     28   143 use Sport::Analytics::NHL::Util;
  28         64  
  28         1877  
19 28     28   9342 use Sport::Analytics::NHL::Report;
  28         87  
  28         968  
20 28     28   10462 use Sport::Analytics::NHL::Test;
  28         152  
  28         5544  
21 28     28   216 use Sport::Analytics::NHL::Tools;
  28         46  
  28         3812  
22 28     28   9602 use Sport::Analytics::NHL::Scraper;
  28         89  
  28         2512  
23              
24             =head1 NAME
25              
26             Sport::Analytics::NHL::Normalizer - normalize the merged boxscore, providing default values and erasing extra and redundant data.
27              
28             =head1 SYNOPSYS
29              
30             Normalizes the merged boxscore, providing default values and erasing extra and redundant data.
31              
32             These functions first summarize the events in the boxscore to help to try to find incosistencies with the summary in the player stats and in the team stats. Then all data in the boxscore is normalized and standardized, the PSTR, PEND and GEND events are added where necessary, and events are sorted and _id-ed properly.
33              
34             use Sport::Analytics::NHL::Normalizer;
35             my $event_summary = summarize($boxscore);
36             normalize($boxscore);
37              
38             =head1 GLOBAL VARIABLES
39              
40             The behaviour of the tests is controlled by several global variables:
41             * $PLAYER_IDS - hashref of all player ids encountered.
42              
43             =head1 FUNCTIONS
44              
45             =over 2
46              
47             =item C
48              
49             Assigns flowing event ids to the boxscore events of the form:
50              
51             * event_id : 1..@events
52             * _id: game_id*10000 + event_id
53              
54             Arguments: the events array reference
55             Returns: void. Sets the events in the boxscore.
56              
57             =item C
58              
59             Inserts a PEND (Period End) event into the group of events of a given period.
60              
61             Arguments:
62              
63             * The arrayref of the events of the period
64             * The number of the period
65             * The last event of the period
66             * The flag if the event ended the period (e.g. OT goal)
67              
68             Returns: void. Modifies the period arrayref
69              
70             =item C
71              
72             Inserts a PSTR (Period Start) event into the group of events of a given period.
73              
74             Arguments:
75              
76             * The arrayref of the events of the period
77             * The number of the period
78             * The first event of the period
79              
80             Returns: void. Modifies the period arrayref
81              
82             =item C
83              
84             Does the module's main purpose: normalizes the boxscore
85              
86             Arguments:
87              
88             * boxscore to normalize
89             * flag whether to skip summarizing
90              
91             Returns: the $PLAYER_IDS hashref (q.v.) of all player ids encountered. Boxscore is modified.
92              
93             =item C
94              
95             Normalizes event according to its type.
96              
97             Arguments: the event
98              
99             Returns: void. The event is modified.
100              
101             =item C
102              
103             Normalizes event's "header" - the general data such as zone, game, strength, time data.
104              
105             Arguments:
106              
107             * The event
108             * The boxscore
109              
110             Returns: void. The event is modified.
111              
112             =item C
113              
114             Normalizes event's on ice player data - makes sure that only NHL player ids are there, and if a team's on ice data is not present, removes it completely.
115              
116             Argument: the event
117              
118             Returns: void. The event is modified.
119              
120             =item C
121              
122             Normalizes the teams and the players actively participating in the event.
123              
124             =item C
125              
126             Normalizes the boxscore's event and calls the lesser functions according to the event's data.
127              
128             Argument: the boxscore
129              
130             Returns: void. The boxscore is modified.
131              
132             =item C
133              
134             Normalizes the specifics of the GOAL event.
135              
136             Argument: the event
137              
138             Returns: void. The event is modified.
139              
140             =item C
141              
142             Normalizes the game's header: date, location, attendance etc.
143              
144             Argument: the boxscore
145              
146             Returns: void. The boxscore is modified.
147              
148             =item C
149              
150             Normalizes the specifics of the PENL event.
151              
152             Argument: the event
153              
154             Returns: void. The event is modified.
155              
156             =item C
157              
158             Normalizes the players on the rosters of the boxscore, their stats and strings.
159              
160             Argument: the roster from the boxscore.
161              
162             Returns: void. The roster is modified.
163              
164             =item C
165              
166             Produces and normalizes an extra sub-structure of game result of one of the forms: [2,0], [0,2], [2,1], [1,2], [1,1] - points gained by each of the teams. First number indicates away, second indicates home team.
167              
168             Argument: the boxscore
169              
170             Returns: void. The result is set in the boxscore.
171              
172             =item C
173              
174             Normalizes the data of a team in the NHL boxscore - coach, score, name, etc.
175              
176             Argument: the boxscore team
177              
178             Returns: void. The team is modified.
179              
180             =item C
181              
182             Normalizes the teams in the NHL boxscore. Calls normalize_team (q.v.) and normalize_roster (q.v.)
183              
184             Argument: the boxscore
185              
186             Returns: void. The boxscore is modified.
187              
188             =item C
189              
190             Sorts the events of the boxscore, inserting the PSTR, PEND and GEND events if necessary. The events are sorted by:
191              
192             * Period
193             * Timestamp
194             * Event precedence rank (from PSTR (highest) to GEND (lowest))
195             * Event type
196             * Event's active team
197              
198             Argument: the boxscore
199              
200             Returns: void. The boxscore is modified.
201              
202             =item C
203              
204             Generates a summary of events of a boxscore. Each playing event is converted into stats of the players and teams participating in it.
205              
206             Argument: the boxscore
207              
208             Returns: the summary of the events
209              
210             =item C
211              
212             Summarizes the data of a GOAL event.
213              
214             Arguments:
215              
216             * the event summary
217             * the goal event
218             * the boxscore
219             * the positions cache generated with Sport::Analytics::NHL::Tools (q.v.)
220              
221             Returns: void. The event summary is modified.
222              
223             =item C
224              
225             Summarizes an event that is not a GOAL or a PENL.
226              
227             Arguments:
228              
229             * the event summary
230             * the event
231              
232             Returns: void. The event summary is modified.
233              
234             =item C
235              
236             Summarizes the data of a PENL event.
237              
238             Arguments:
239              
240             * the event summary
241             * the penalty event
242              
243             Returns: void. The event summary is modified.
244              
245             =back
246              
247             =cut
248              
249 28     28   208 use Data::Dumper;
  28         52  
  28         1017  
250 28     28   145 use base 'Exporter';
  28         51  
  28         107402  
251              
252             our @EXPORT = qw(summarize normalize_boxscore);
253              
254             our $PLAYER_IDS = {};
255              
256             our %EVENT_PRECEDENCE = (
257             PSTR => 1,
258             GIVE => 7,
259             BLOCK => 8,
260             HIT => 8,
261             TAKE => 9,
262             SHOT => 9,
263             MISS => 9,
264             GOAL => 10,
265             PENL => 11,
266             STOP => 12,
267             CHL => 13,
268             FAC => 14,
269             PEND => 98,
270             GEND => 99,
271             );
272              
273             our %EVENT_TYPE_TO_STAT = (
274             SHOT => 'shots',
275             MISS => 'misses',
276             HIT => 'hits',
277             BLOCK => 'blocked',
278             GIVE => 'giveaways',
279             TAKE => 'takeaways',
280             FAC => 'faceOffWins',
281             );
282              
283             $Data::Dumper::Trailingcomma = 1;
284             $Data::Dumper::Deepcopy = 1;
285             $Data::Dumper::Sortkeys = 1;
286             $Data::Dumper::Deparse = 1;
287              
288             sub summarize_goal ($$$$;$) {
289              
290 19     19 1 2453 my $event_summary = shift;
291 19         29 my $event = shift;
292 19         27 my $boxscore = shift;
293 19         27 my $positions = shift;
294 19   100     66 my $no_stats = shift || 0;
295              
296 19   100     57 $event->{assists} ||= [];
297 19         32 for my $assist (@{$event->{assists}}) {
  19         46  
298 33         78 $event_summary->{$assist}{assists}++;
299 33         73 push(@{$event_summary->{stats}}, 'assists');
  33         85  
300             }
301 19         81 $event_summary->{$boxscore->{teams}[$event->{t}]{name}}{score}++;
302 19 50       47 if ($event->{player1}) {
303 19 100       66 if ($positions->{$event->{player1}} eq 'G') {
304 1         3 $event_summary->{$event->{player1}}{g_goals}++;
305 1         3 $event_summary->{$event->{player1}}{g_shots}++;
306 1         3 push(@{$event_summary->{stats}}, 'g_goals', 'g_shots');
  1         3  
307             }
308             else {
309 18         40 $event_summary->{$event->{player1}}{goals}++;
310 18         33 $event_summary->{$event->{player1}}{shots}++;
311 18         28 push(@{$event_summary->{stats}}, 'goals', 'shots');
  18         42  
312             }
313             }
314 19 50       53 if ($event->{player2}) {
315 19         48 $event_summary->{$event->{player2}}{shots}++;
316 19 100       58 $event_summary->{$event->{player2}}{goalsAgainst}++ if $event->{ts};
317 19         29 push(@{$event_summary->{stats}}, 'goalsAgainst', 'shots');
  19         46  
318             }
319 19 100       67 delete $event_summary->{stats} if $no_stats;
320             }
321              
322             sub summarize_penalty ($$;$) {
323              
324 70     70 1 3041 my $event_summary = shift;
325 70         87 my $event = shift;
326 70   100     178 my $no_stats = shift || 0;
327              
328 70         184 $event_summary->{$event->{player1}}{penaltyMinutes} += $event->{length};
329 70         95 push(@{$event_summary->{stats}}, 'penaltyMinutes');
  70         125  
330 70 100       167 if ($event->{servedby}) {
    50          
331 4         24 $event_summary->{$event->{servedby}}{servedbyMinutes} += $event->{length};
332 4         14 push(@{$event_summary->{stats}}, 'servedbyMinutes');
  4         15  
333 4         18 $event_summary->{$event->{servedby}}{servedby}++;
334 4         10 push(@{$event_summary->{stats}}, 'servedby');
  4         18  
335             }
336             elsif ($event->{_servedby}) {
337 0         0 $event_summary->{$event->{player1}}{_servedbyMinutes} += $event->{length};
338             }
339 70 100       193 delete $event_summary->{stats} if $no_stats;
340             }
341              
342             sub summarize_other_event ($$) {
343              
344 728     728 1 2424 my $event_summary = shift;
345 728         817 my $event = shift;
346              
347 728 50 66     1436 return unless $event->{sources}{PL} || $event->{sources}{BS};
348 727 100       1267 if ($event->{type} eq 'FAC') {
349 196   33     355 $event->{player1} ||= $UNKNOWN_PLAYER_ID;
350 196   33     339 $event->{player2} ||= $UNKNOWN_PLAYER_ID;
351 196         342 $event_summary->{$event->{player1}}{faceoffTaken}++;
352 196         355 $event_summary->{$event->{player2}}{faceoffTaken}++;
353 196         248 push(@{$event_summary->{stats}}, 'faceoffTaken');
  196         370  
354             }
355 727         1811 $event_summary->{$event->{player1}}{$EVENT_TYPE_TO_STAT{$event->{type}}}++;
356             }
357              
358             sub summarize ($) {
359              
360 4     4 1 7913 my $boxscore = shift;
361              
362 4         22 debug "Generating event summary";
363 4         20 my $event_summary = {so => [0,0], stats => []};
364 4         24 my $positions = set_roster_positions($boxscore);
365 4         15 my @stats = qw(goals assists);
366              
367 4         10 for my $event (@{$boxscore->{events}}) {
  4         18  
368 978 50       1951 if ($event->{so}) {
369 0 0       0 $event_summary->{so}[$event->{t}]++ if $event->{type} eq 'GOAL';
370 0 0       0 next unless $event->{type} eq 'PENL';
371             }
372 978         1464 for ($event->{type}) {
373 978         1572 when ('GOAL') { summarize_goal($event_summary, $event, $boxscore, $positions); }
  16         39  
374 962         1270 when ('PENL') { summarize_penalty($event_summary, $event); }
  68         115  
375 894         2266 when ([ qw(SHOT MISS HIT BLOCK TAKE GIVE FAC) ]) {
376 726         1475 summarize_other_event($event_summary, $event);
377 726         2021 push(@stats, $EVENT_TYPE_TO_STAT{$event->{type}});
378             }
379             }
380             }
381 4         12 my $so = $event_summary->{so};
382 4 50 33     39 if ($so->[0] || $so->[1]) {
383 0 0       0 die "Strange shootout count for $boxscore->{_id}" if $so->[0] == $so->[1];
384 0 0       0 $event_summary->{$boxscore->{teams}[$so->[0] > $so->[1] ? 0 : 1]{name}}{score}++;
385 0 0       0 $event_summary->{so} = $so->[0] > $so->[1] ? [ 1, 0 ] : [ 0, 1 ];
386             }
387 4         10 $event_summary->{stats} = [ uniq @{$event_summary->{stats}}, @stats ];
  4         172  
388 4         27 for my $t (0,1) {
389 8         13 for my $player (@{$boxscore->{teams}[$t]{roster}}) {
  8         30  
390 159   100     415 $event_summary->{$player->{_id}} ||= {};
391             }
392             }
393 4         37 for my $key (keys %{$event_summary}) {
  4         32  
394 177 100       470 next unless $key =~ /^\d{7}$/;
395 162         209 for my $stat (@{$event_summary->{stats}}) {
  162         262  
396 1998   100     4454 $event_summary->{$key}{$stat} ||= 0;
397             }
398             }
399 4         60 $event_summary;
400             }
401              
402             sub normalize_result ($) {
403              
404 9     9 1 13370 my $game = shift;
405 9 50       57 if ($game->{teams}[0]{score} == $game->{teams}[1]{score}) {
    50          
406 0         0 $game->{result} = [ 1, 1 ];
407             }
408             elsif ($game->{teams}[0]{score} > $game->{teams}[1]{score}) {
409 0 0 0     0 $game->{result} = [ 2, $game->{ot} && $game->{season} >= 1999 ? 1 : 0 ],
410             }
411             else {
412 9 50 33     53 $game->{result} = [ $game->{ot} && $game->{season} >= 1999 ? 1 : 0, 2 ],
413             }
414             }
415              
416             sub normalize_header ($) {
417              
418 5     5 1 1640 my $game = shift;
419 5         332 $game->{date} = strftime("%Y%m%d", localtime($game->{start_ts}));
420 5 100       27 if ($game->{location}) {
421 3         17 $game->{location} =~ s/^\s+//;
422 3         14 $game->{location} =~ s/\s+$//;
423 3         15 $game->{location} =~ s/\s+/ /g;
424 3         11 $game->{location} = uc $game->{location};
425             }
426 5         16 for my $field (qw(last_updated _id attendance month date ot start_ts stop_ts stage season season_id)) {
427 55         89 $game->{$field} += 0;
428             }
429 5   100     34 $game->{tz} ||= 'EST';
430 5         20 normalize_result($game);
431              
432 5         16 delete @{$game}{qw(_t type scratches resolve_cache)};
  5         49  
433             }
434              
435             sub normalize_team ($) {
436              
437 12     12 1 290147 my $team = shift;
438              
439 12         21 for my $stat (keys %{$team->{stats}}) {
  12         62  
440 116         169 $team->{stats}{$stat} += 0.0;
441             }
442 12         32 for my $field (qw(pull shots score)) {
443 36         159 $team->{$field} += 0;
444             }
445 12         24 delete @{$team}{qw(teamid orig _decision)};
  12         40  
446 12         27 my $roster = [];
447 12         26 for my $player (@{$team->{roster}}) {
  12         27  
448 220         323 push(@{$roster}, $player)
449             unless $player->{_id} =~ /^80/ || (!$player->{shifts} && grep {
450 90         230 $player->{_id} eq $_
451 245 100 100     627 } @{$team->{scratches}});
  65   66     122  
452             }
453 12         40 $team->{roster} = $roster;
454 12   50     33 $team->{scratches} ||= [];
455             }
456              
457             sub normalize_players ($) {
458              
459 12     12 1 14180 my $team = shift;
460              
461 12         21 for my $player (@{$team->{roster}}) {
  12         32  
462 220         285 for my $toi (qw(evenTimeOnIce shortHandedTimeOnIce powerPlayTimeOnIce timeOnIce)) {
463             $player->{$toi} = get_seconds($player->{$toi})
464 880 100 100     2967 if defined $player->{$toi} && $player->{$toi} =~ /\:/;
465             }
466 220 100       381 unless ($player->{position} eq 'G') {
467 208         233 delete $player->{wl};
468             }
469             else {
470 12   0     32 $player->{decision} ||= delete $player->{wl} || 'N';
      33        
471             }
472 220 100 66     533 if (!
473             defined $player->{faceoffTaken}
474             || $player->{faceoffTaken} eq -1
475             ) {
476 40         50 for (grep { /faceoff/i } keys %{$player}) {
  677         892  
  40         133  
477 0         0 delete $player->{$_};
478             }
479             }
480 220         284 delete @{$player}{'Saves - Shots', qw(void EV SH PP TOITOT p1 p2 p3)};
  220         398  
481 220         262 for (keys %{$player}) {
  220         1123  
482 6937         7371 when ('faceOffPercentage') {
483             $player->{$_} = $player->{faceoffTaken}
484             ? $player->{faceOffWins} / $player->{faceoffTaken}
485 0 0       0 : 0;
486             }
487 6937   50     6986 when ('status') { $player->{$_} //= ' ' }
  190         417  
488 6747   50     6595 when ('start') { $player->{$_} //= 2 }
  190         410  
489 6557   66     12118 when ($_ ne 'plusMinus' && $player->{$_} eq -1 ) {
490 0         0 delete $player->{$_}
491             }
492             }
493 220         532 $player->{team} = $team->{name};
494 220         505 $PLAYER_IDS->{$player->{_id}} = \$player;
495             }
496 12         21 for my $player (@{$team->{scratches}}) {
  12         29  
497 25         49 $player += 0;
498             }
499             }
500              
501             sub normalize_teams ($) {
502              
503 5     5 1 931232 my $boxscore = shift;
504 5         402 $PLAYER_IDS = {};
505              
506 5         15 for my $t (0,1) {
507 10         23 my $team = $boxscore->{teams}[$t];
508 10         35 normalize_team($team);
509 10         25 normalize_players($team);
510             }
511             }
512              
513             sub normalize_event_header ($$) {
514              
515 1616     1616 1 2853445 my $event = shift;
516 1616         2205 my $game = shift;
517              
518 1616   33     6566 $event->{game} ||= $game->{_id};
519 1616         2900 $event->{game_id} = delete $event->{game};
520             $event->{zone} = uc(delete $event->{location} || 'UNK')
521 1616 100 100     5887 unless ! $event->{location} && is_noplay_event($event);
      100        
522 1616   50     3214 $event->{strength} ||= 'XX';
523 1616         3149 $event->{strength} =~ s/\W//g;
524 1616 50       4157 if ($event->{ts} > $event->{period} * 1200) {
525 0         0 $event->{ts} = $event->{ts} % 1200 + ($event->{period}-1)*1200;
526             $event->{time} = sprintf(
527             "%d:%02d",
528             ($event->{ts}-($event->{period}-1)*1200)/60,
529 0         0 $event->{ts}%60
530             );
531             }
532 1616         2091 delete @{$event}{qw(bsjs_id event_code event_idx file teamid)};
  1616         4534  
533 1616         2884 for my $field (qw(game_id id period season stage so t ts distance)) {
534 14544 100       23649 $event->{$field} += 0 if defined $event->{$field};
535             }
536 1616 50       3097 $event->{penaltyshot} += 0 if defined $event->{penaltyshot};
537             }
538              
539             sub normalize_event_players_teams ($$) {
540              
541 1616     1616 1 1171917 my $event = shift;
542 1616         2173 my $game = shift;
543              
544 1616 100 66     5812 if (! $event->{team2} && defined $event->{t} && $event->{t} != -1) {
      100        
545 621         1817 $event->{team2} = $game->{teams}[1-$event->{t}]{name};
546             }
547 1616         2625 for my $field (qw(en player1 player2 assist1 assist2)) {
548 8080 100       15383 if ($field =~ /assist(\d)/) {
549 3232         5515 my $as = $1;
550 3232 50 66     5696 if ($event->{$field} && $event->{$field} =~ /\D/ && $event->{assists}[$as-1] !~ /\D/) {
      33        
551 0         0 $event->{$field} = $event->{assists}[$as-1];
552             }
553             }
554 8080 100       13612 $event->{$field} += 0 if exists $event->{$field};
555             }
556             }
557              
558             sub normalize_event_on_ice ($) {
559              
560 1616     1616 1 304964 my $event = shift;
561 1616 50 33     3526 if (is_noplay_event($event) && (
      66        
562             ! $event->{on_ice} || ! @{$event->{on_ice}} || @{$event->{on_ice}} != 2 || ! $event->{on_ice}[0] || ! $event->{on_ice}[1])
563             ) {
564 40         58 delete $event->{on_ice};
565 40         66 return;
566             }
567 1576 50 66     3858 if ($event->{on_ice} && @{$event->{on_ice}}
  1555   66     4239  
      33        
568 1555         4055 && @{$event->{on_ice}[0]} && @{$event->{on_ice}[1]}) {
  1555         3434  
569 1555         2408 for my $t (0,1) {
570             $event->{on_ice}[$t] = [grep {
571 17960 50       57837 /\d/ && ! /^800/
572 3110         3594 } @{$event->{on_ice}[$t]} ];
  3110         4932  
573             }
574             }
575 1576 100 66     3982 if ($event->{on_ice} && @{$event->{on_ice}}
  1555   66     3611  
      33        
576 1555         3250 && @{$event->{on_ice}[0]} && @{$event->{on_ice}[1]}) {
  1555         3143  
577 1555         1881 for my $o (@{$event->{on_ice}}) {
  1555         2520  
578 3110         3165 for my $on_ice (@{$o}) {
  3110         3572  
579 17960         19408 $on_ice += 0;
580             }
581             }
582             }
583             else {
584 21         28 delete $event->{on_ice};
585             }
586             }
587              
588             sub normalize_goal_event ($) {
589              
590 31     31 1 24946 my $event = shift;
591              
592 31   50     150 $event->{en} ||= 0;
593 31   100     109 $event->{gwg} ||= 0;
594 31   50     345 $event->{assists} ||= [];
595 31 100       80 if ($event->{assist1}) {
596 30         70 $event->{assists}[0] = $event->{assist1};
597             }
598 31 100       69 if ($event->{assist2}) {
599 30         57 $event->{assists}[1] = $event->{assist2};
600             }
601 31         54 $event->{assist1} = $event->{assists}[0];
602 31         55 $event->{assist2} = $event->{assists}[1];
603 31 0 33     109 if (! $event->{player2} && $event->{on_ice} && @{$event->{on_ice}}) {
  0   0     0  
604 0         0 for my $o (@{$event->{on_ice}[1-$event->{t}]}) {
  0         0  
605 0 0       0 $event->{player2} = $o if ${$PLAYER_IDS->{$o}}->{position} eq 'G';
  0         0  
606             }
607             }
608             }
609              
610             sub normalize_penl_event ($) {
611              
612 116     116 1 77102 my $event = shift;
613              
614 116         227 $event->{length} += 0;
615 116 100       267 $event->{servedby} += 0 if defined $event->{servedby};
616 116 50       319 if ($event->{penalty} =~ /PS\s+\-\s+(\S.*)/) {
617 0         0 debug "Converting a PS penalty";
618 0         0 $event->{penalty} = $1;
619 0         0 $event->{length} = 0;
620 0         0 $event->{ps_penalty} = 1;
621             }
622 116 50 66     391 delete $event->{servedby} if $event->{servedby} && $event->{servedby} =~ /^80/;
623             }
624              
625             sub normalize_event_by_type ($) {
626              
627 1616     1616 1 1387919 my $event = shift;
628              
629 1616         2749 for ($event->{type}) {
630 1616         2961 when ('FAC') { $event->{winning_team} = resolve_team($event->{winning_team}); }
  325         900  
631 1291         1760 when ('GOAL') { normalize_goal_event($event); }
  26         81  
632 1265         1971 when ('PENL') { normalize_penl_event($event); }
  100         288  
633             }
634 1616 100       3180 if ($event->{type} ne 'GOAL') {
635 1590         3797 delete $event->{$_} for qw(assist1 assist2 assists);
636             }
637              
638 1616 100 100     7421 if ($event->{type} eq 'MISS' || $event->{type} eq 'GOAL'
      100        
      100        
639             || $event->{type} eq 'SHOT' || $event->{type} eq 'BLOCK') {
640 656   50     1321 $event->{shot_type} ||= 'UNKNOWN';
641 656   50     1927 $event->{penaltyshot} ||= 0;
642             }
643              
644 1616 50 66     6224 if ($event->{player2} && $event->{player2} !~ /^80/ && defined $REVERSE_STAT{$event->{player2}}) {
      66        
645 0   0     0 ${$PLAYER_IDS->{$event->{player2}}}->{$REVERSE_STAT{$event->{player2}}} ||= 0;
  0         0  
646 0         0 ${$PLAYER_IDS->{$event->{player2}}}->{$REVERSE_STAT{$event->{player2}}}++;
  0         0  
647             }
648 1616         2059 my @fields = keys %{$event};
  1616         7735  
649 1616         2851 for my $field (@fields) {
650 33785 100       43821 if (! defined $event->{$field}) {
651 2         3 delete $event->{$field};
652 2         4 next;
653             }
654 33783 100 66     69257 next if $field eq 'file' || ref $event->{$field};
655 28719 100       53080 if ($event->{$field} =~ /^\d+$/) {
656 16351         21131 $event->{$field} += 0;
657             }
658             else {
659 12368         18599 $event->{$field} = uc $event->{$field};
660             }
661             }
662             }
663              
664             sub normalize_events ($) {
665              
666 5     5 1 46280 my $boxscore = shift;
667              
668 5         12 my $gp = scalar @{$boxscore->{periods}};
  5         19  
669 5         12 for my $event (@{$boxscore->{events}}) {
  5         28  
670 1297         1590 $EVENT = $event;
671 1297 50 33     3152 if ($event->{period} == 4 && $gp < 4) {
672 0 0       0 if ($event->{time} eq '0:00') {
673 0         0 $event->{period} = 3;
674 0         0 $event->{ot} = 0;
675 0         0 $event->{time} = '20:00';
676             }
677             else {
678             push(
679 0         0 @{$boxscore->{periods}},
680             {
681             type => 'OVERTIME',
682             start_ts => $boxscore->{periods}[-1]{stop_ts} + 300,
683 0         0 stop_ts => $boxscore->{periods}[-1]{stop_ts} + 900,
684             id => 4,
685             score => [0,0,0,0],
686             },
687             );
688 0         0 $gp = @{$boxscore->{periods}};
  0         0  
689             }
690             }
691 1297         2574 normalize_event_header($event, $boxscore);
692 1297         2400 normalize_event_players_teams($event, $boxscore);
693 1297         2204 normalize_event_on_ice($event);
694 1297         1988 normalize_event_by_type($event);
695             }
696             }
697              
698             sub insert_pstr ($$$) {
699              
700 7     7 1 81 my $period = shift;
701 7         11 my $p = shift;
702 7         9 my $event = shift;
703              
704 7         25 debug "Inserting PSTR";
705             unshift(
706 7         52 @{$period},
707             {
708             ts => 0, period => $p, stage => $event->{stage}, season => $event->{season},
709 7   33     11 game_id => $event->{game_id} || $event->{_id}, time => '00:00', type => 'PSTR',
710             },
711             );
712             }
713              
714             sub insert_pend ($$$$) {
715              
716 9     9 1 1717 my $period = shift;
717 9         16 my $p = shift;
718 9         13 my $event = shift;
719 9         16 my $is_last = shift;
720              
721 9         28 debug "Inserting PEND";
722             my $pend_event = {
723             ts => 0, period => $p,
724             stage => $event->{stage}, season => $event->{season},
725             game_id => $event->{game_id} || $event->{_id},
726 9   33     57 time => '00:00', type => 'PEND',
727             };
728 9 100 66     73 if ($p <= 3 || ! $is_last && $event->{stage} != $REGULAR) {
    100 66        
729 7         14 $pend_event->{ts} = $p*1200;
730 7         11 $pend_event->{time} = '20:00';
731             }
732             elsif ($is_last) {
733             $pend_event->{ts} = $event->{ts} ||
734 1   33     7 ($event->{stage} == $REGULAR ? 3900 : $p * 1200);
735             $pend_event->{time} = $event->{time} ||
736 1   33     5 ($event->{stage} == $REGULAR ? '5:00' : '20:00');
737             }
738             else {
739 1 50       6 $pend_event->{ts} = $event->{season} < 1942 ? 4200 : 3900;
740 1 50       6 $pend_event->{time} = $event->{season} < 1942 ? '10:00' : '5:00';
741             }
742 9         15 push(@{$period}, $pend_event);
  9         24  
743             }
744              
745             sub sort_events ($) {
746              
747 5     5 1 18 my $boxscore = shift;
748              
749 5         14 my $events = $boxscore->{events};
750 5         14 my $gp = $boxscore->{periods};
751              
752 5         13 my $sorted_events = [];
753             my @events_by_period = part {
754             my $x = $_->{period}
755 999     999   1125 } sort {
756             $a->{period} <=> $b->{period}
757             || $a->{ts} <=> $b->{ts}
758             || $EVENT_PRECEDENCE{$a->{type}} <=> $EVENT_PRECEDENCE{$b->{type}}
759             || $a->{type} cmp $b->{type}
760             || $b->{t} <=> $a->{t}
761 5 50 100     34 } @{$events};
  1792   100     4986  
  5   100     70  
762             my $ot_end =
763             $boxscore->{result}[0] != $boxscore->{result}[1]
764 5   33     56 && ! $boxscore->{so};
765 5   66     38 pop @{$events_by_period[-1]} while @events_by_period && $events_by_period[-1]->[-1]{type} eq 'GEND';
  3         16  
766 5 50       21 my $periods = $#events_by_period > 3 ? $#events_by_period : 3;
767 5 50       10 $periods = scalar @{$gp} if $periods < scalar @{$gp};
  0         0  
  5         16  
768 5         29 for my $p (1..$periods) {
769 15   50     42 my $period = $events_by_period[$p] || [];
770             insert_pstr($period, $p, $events_by_period[$p]->[0] || $boxscore)
771 15 100 33     76 unless $period->[0] && $period->[0]{type} eq 'PSTR';
      66        
772             insert_pend($period, $p, $events_by_period[$p]->[-1] || $boxscore, $p == $periods && $ot_end)
773 15 100 33     87 unless $period->[0] && $period->[-1]{type} eq 'PEND';
      66        
      66        
774 15         21 my $e = -1;
775             $period = [
776             grep {
777 1008         996 $e++;
778             $_->{type} eq 'PSTR' && $e > 0
779 1008 50 33     2680 || $_->{type} eq 'PEND' && $e < $#{$period}
780             ? () : $_
781 15         27 } @{$period}
  15         27  
782             ];
783 15         23 push(@{$sorted_events}, @{$period});
  15         25  
  15         144  
784             }
785             push(
786 5         14 @{$sorted_events},
  5         481  
787             dclone $sorted_events->[-1]
788             );
789 5         18 $sorted_events->[-1]{type} = 'GEND';
790 5         65 $boxscore->{events} = $sorted_events;
791             }
792              
793             sub assign_event_ids ($) {
794              
795 4     4 1 25332 my $events = shift;
796              
797 4         12 for my $e (1..@{$events}) {
  4         19  
798 670         763 my $event = $events->[$e-1];
799 670         886 $event->{event_id} = $e;
800 670         1072 $event->{_id} = $event->{game_id} * 10000 + $e;
801             }
802             }
803              
804             sub normalize_boxscore ($;$) {
805              
806 3     3 1 5427 my $boxscore = shift;
807 3   100     13 my $no_summarize = shift || 0;
808 3         435 $PLAYER_IDS = {};
809 3 100       12 unless ($no_summarize) {
810 1         4 my $event_summary = summarize($boxscore);
811 1         5 test_consistency($boxscore, $event_summary);
812             }
813              
814 3         16 normalize_header($boxscore);
815 3         14 normalize_teams($boxscore);
816 3         27 normalize_events($boxscore);
817 3         23 sort_events($boxscore);
818 3         15 assign_event_ids($boxscore->{events});
819 3         19 undef $EVENT;
820 3         16 return $PLAYER_IDS;
821             }
822              
823             =head1 AUTHOR
824              
825             More Hockey Stats, C<< >>
826              
827             =head1 BUGS
828              
829             Please report any bugs or feature requests to C, or through
830             the web interface at L. I will be notified, and then you'll
831             automatically be notified of progress on your bug as I make changes.
832              
833              
834             =head1 SUPPORT
835              
836             You can find documentation for this module with the perldoc command.
837              
838             perldoc Sport::Analytics::NHL::Normalizer
839              
840             You can also look for information at:
841              
842             =over 4
843              
844             =item * RT: CPAN's request tracker (report bugs here)
845              
846             L
847              
848             =item * AnnoCPAN: Annotated CPAN documentation
849              
850             L
851              
852             =item * CPAN Ratings
853              
854             L
855              
856             =item * Search CPAN
857              
858             L
859              
860             =back