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 21     21   121480 use v5.10.1;
  21         78  
4 21     21   98 use strict;
  21         41  
  21         446  
5 21     21   90 use warnings FATAL => 'all';
  21         30  
  21         644  
6 21     21   95 use experimental qw(smartmatch);
  21         33  
  21         134  
7              
8 21     21   1028 use Carp;
  21         48  
  21         1147  
9 21     21   1637 use Storable qw(store retrieve dclone);
  21         5582  
  21         1098  
10 21     21   1030 use POSIX qw(strftime);
  21         10637  
  21         136  
11              
12 21     21   4535 use Date::Parse;
  21         12695  
  21         1812  
13 21     21   132 use File::Basename;
  21         36  
  21         1163  
14 21     21   1109 use List::MoreUtils qw(uniq part);
  21         21235  
  21         141  
15              
16 21     21   14580 use Sport::Analytics::NHL::Config;
  21         75  
  21         3610  
17 21     21   865 use Sport::Analytics::NHL::DB;
  21         40  
  21         474  
18 21     21   104 use Sport::Analytics::NHL::Util;
  21         41  
  21         1213  
19 21     21   9051 use Sport::Analytics::NHL::Report;
  21         67  
  21         760  
20 21     21   7388 use Sport::Analytics::NHL::Test;
  21         46  
  21         3490  
21 21     21   145 use Sport::Analytics::NHL::Tools;
  21         35  
  21         2564  
22 21     21   8167 use Sport::Analytics::NHL::Scraper;
  21         80  
  21         1900  
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 21     21   152 use Data::Dumper;
  21         48  
  21         858  
250 21     21   120 use base 'Exporter';
  21         42  
  21         83948  
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 2519 my $event_summary = shift;
291 19         27 my $event = shift;
292 19         116 my $boxscore = shift;
293 19         69 my $positions = shift;
294 19   100     75 my $no_stats = shift || 0;
295              
296 19   100     61 $event->{assists} ||= [];
297 19         42 for my $assist (@{$event->{assists}}) {
  19         56  
298 33         79 $event_summary->{$assist}{assists}++;
299 33         43 push(@{$event_summary->{stats}}, 'assists');
  33         100  
300             }
301 19         76 $event_summary->{$boxscore->{teams}[$event->{t}]{name}}{score}++;
302 19 50       48 if ($event->{player1}) {
303 19 100       59 if ($positions->{$event->{player1}} eq 'G') {
304 1         4 $event_summary->{$event->{player1}}{g_goals}++;
305 1         3 $event_summary->{$event->{player1}}{g_shots}++;
306 1         2 push(@{$event_summary->{stats}}, 'g_goals', 'g_shots');
  1         3  
307             }
308             else {
309 18         40 $event_summary->{$event->{player1}}{goals}++;
310 18         35 $event_summary->{$event->{player1}}{shots}++;
311 18         24 push(@{$event_summary->{stats}}, 'goals', 'shots');
  18         40  
312             }
313             }
314 19 50       43 if ($event->{player2}) {
315 19         52 $event_summary->{$event->{player2}}{shots}++;
316 19 100       57 $event_summary->{$event->{player2}}{goalsAgainst}++ if $event->{ts};
317 19         28 push(@{$event_summary->{stats}}, 'goalsAgainst', 'shots');
  19         47  
318             }
319 19 100       72 delete $event_summary->{stats} if $no_stats;
320             }
321              
322             sub summarize_penalty ($$;$) {
323              
324 70     70 1 2822 my $event_summary = shift;
325 70         87 my $event = shift;
326 70   100     174 my $no_stats = shift || 0;
327              
328 70         188 $event_summary->{$event->{player1}}{penaltyMinutes} += $event->{length};
329 70         95 push(@{$event_summary->{stats}}, 'penaltyMinutes');
  70         129  
330 70 100       164 if ($event->{servedby}) {
    50          
331 4         33 $event_summary->{$event->{servedby}}{servedbyMinutes} += $event->{length};
332 4         14 push(@{$event_summary->{stats}}, 'servedbyMinutes');
  4         15  
333 4         17 $event_summary->{$event->{servedby}}{servedby}++;
334 4         9 push(@{$event_summary->{stats}}, 'servedby');
  4         15  
335             }
336             elsif ($event->{_servedby}) {
337 0         0 $event_summary->{$event->{player1}}{_servedbyMinutes} += $event->{length};
338             }
339 70 100       178 delete $event_summary->{stats} if $no_stats;
340             }
341              
342             sub summarize_other_event ($$) {
343              
344 728     728 1 2142 my $event_summary = shift;
345 728         805 my $event = shift;
346              
347 728 50 66     1240 return unless $event->{sources}{PL} || $event->{sources}{BS};
348 727 100       1067 if ($event->{type} eq 'FAC') {
349 196   33     286 $event->{player1} ||= $UNKNOWN_PLAYER_ID;
350 196   33     293 $event->{player2} ||= $UNKNOWN_PLAYER_ID;
351 196         387 $event_summary->{$event->{player1}}{faceoffTaken}++;
352 196         349 $event_summary->{$event->{player2}}{faceoffTaken}++;
353 196         237 push(@{$event_summary->{stats}}, 'faceoffTaken');
  196         382  
354             }
355 727         1672 $event_summary->{$event->{player1}}{$EVENT_TYPE_TO_STAT{$event->{type}}}++;
356             }
357              
358             sub summarize ($) {
359              
360 4     4 1 4814 my $boxscore = shift;
361              
362 4         38 debug "Generating event summary";
363 4         26 my $event_summary = {so => [0,0], stats => []};
364 4         36 my $positions = set_roster_positions($boxscore);
365 4         37 my @stats = qw(goals assists);
366              
367 4         15 for my $event (@{$boxscore->{events}}) {
  4         22  
368 978 50       1606 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         1264 for ($event->{type}) {
373 978         1327 when ('GOAL') { summarize_goal($event_summary, $event, $boxscore, $positions); }
  16         37  
374 962         1137 when ('PENL') { summarize_penalty($event_summary, $event); }
  68         141  
375 894         2051 when ([ qw(SHOT MISS HIT BLOCK TAKE GIVE FAC) ]) {
376 726         1268 summarize_other_event($event_summary, $event);
377 726         1722 push(@stats, $EVENT_TYPE_TO_STAT{$event->{type}});
378             }
379             }
380             }
381 4         10 my $so = $event_summary->{so};
382 4 50 33     34 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         13 $event_summary->{stats} = [ uniq @{$event_summary->{stats}}, @stats ];
  4         164  
388 4         27 for my $t (0,1) {
389 8         13 for my $player (@{$boxscore->{teams}[$t]{roster}}) {
  8         20  
390 159   100     308 $event_summary->{$player->{_id}} ||= {};
391             }
392             }
393 4         29 for my $key (keys %{$event_summary}) {
  4         38  
394 177 100       426 next unless $key =~ /^\d{7}$/;
395 162         184 for my $stat (@{$event_summary->{stats}}) {
  162         246  
396 1998   100     4120 $event_summary->{$key}{$stat} ||= 0;
397             }
398             }
399 4         47 $event_summary;
400             }
401              
402             sub normalize_result ($) {
403              
404 9     9 1 14096 my $game = shift;
405 9 50       63 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     59 $game->{result} = [ $game->{ot} && $game->{season} >= 1999 ? 1 : 0, 2 ],
413             }
414             }
415              
416             sub normalize_header ($) {
417              
418 5     5 1 1534 my $game = shift;
419 5         374 $game->{date} = strftime("%Y%m%d", localtime($game->{start_ts}));
420 5 100       33 if ($game->{location}) {
421 3         18 $game->{location} =~ s/^\s+//;
422 3         26 $game->{location} =~ s/\s+$//;
423 3         21 $game->{location} =~ s/\s+/ /g;
424 3         20 $game->{location} = uc $game->{location};
425             }
426 5         20 for my $field (qw(last_updated _id attendance month date ot start_ts stop_ts stage season season_id)) {
427 55         96 $game->{$field} += 0;
428             }
429 5   100     32 $game->{tz} ||= 'EST';
430 5         22 normalize_result($game);
431              
432 5         13 delete @{$game}{qw(_t type scratches resolve_cache)};
  5         50  
433             }
434              
435             sub normalize_team ($) {
436              
437 12     12 1 315926 my $team = shift;
438              
439 12         21 for my $stat (keys %{$team->{stats}}) {
  12         61  
440 116         184 $team->{stats}{$stat} += 0.0;
441             }
442 12         41 for my $field (qw(pull shots score)) {
443 36         202 $team->{$field} += 0;
444             }
445 12         27 delete @{$team}{qw(teamid orig _decision)};
  12         40  
446 12         30 my $roster = [];
447 12         23 for my $player (@{$team->{roster}}) {
  12         28  
448 220         355 push(@{$roster}, $player)
449             unless $player->{_id} =~ /^80/ || (!$player->{shifts} && grep {
450 90         265 $player->{_id} eq $_
451 245 100 100     623 } @{$team->{scratches}});
  65   66     139  
452             }
453 12         61 $team->{roster} = $roster;
454 12   50     45 $team->{scratches} ||= [];
455             }
456              
457             sub normalize_players ($) {
458              
459 12     12 1 14215 my $team = shift;
460              
461 12         22 for my $player (@{$team->{roster}}) {
  12         27  
462 220         328 for my $toi (qw(evenTimeOnIce shortHandedTimeOnIce powerPlayTimeOnIce timeOnIce)) {
463             $player->{$toi} = get_seconds($player->{$toi})
464 880 100 100     3387 if defined $player->{$toi} && $player->{$toi} =~ /\:/;
465             }
466 220 100       452 unless ($player->{position} eq 'G') {
467 208         257 delete $player->{wl};
468             }
469             else {
470 12   0     34 $player->{decision} ||= delete $player->{wl} || 'N';
      33        
471             }
472 220 100 66     653 if (!
473             defined $player->{faceoffTaken}
474             || $player->{faceoffTaken} eq -1
475             ) {
476 40         59 for (grep { /faceoff/i } keys %{$player}) {
  677         1052  
  40         189  
477 0         0 delete $player->{$_};
478             }
479             }
480 220         330 delete @{$player}{'Saves - Shots', qw(void EV SH PP TOITOT p1 p2 p3)};
  220         448  
481 220         289 for (keys %{$player}) {
  220         1070  
482 6937         8348 when ('faceOffPercentage') {
483             $player->{$_} = $player->{faceoffTaken}
484             ? $player->{faceOffWins} / $player->{faceoffTaken}
485 0 0       0 : 0;
486             }
487 6937   50     7816 when ('status') { $player->{$_} //= ' ' }
  190         491  
488 6747   50     7590 when ('start') { $player->{$_} //= 2 }
  190         477  
489 6557   66     14187 when ($_ ne 'plusMinus' && $player->{$_} eq -1 ) {
490 0         0 delete $player->{$_}
491             }
492             }
493 220         606 $player->{team} = $team->{name};
494 220         648 $PLAYER_IDS->{$player->{_id}} = \$player;
495             }
496 12         28 for my $player (@{$team->{scratches}}) {
  12         32  
497 25         52 $player += 0;
498             }
499             }
500              
501             sub normalize_teams ($) {
502              
503 5     5 1 956463 my $boxscore = shift;
504 5         505 $PLAYER_IDS = {};
505              
506 5         20 for my $t (0,1) {
507 10         24 my $team = $boxscore->{teams}[$t];
508 10         49 normalize_team($team);
509 10         28 normalize_players($team);
510             }
511             }
512              
513             sub normalize_event_header ($$) {
514              
515 1616     1616 1 3133178 my $event = shift;
516 1616         2070 my $game = shift;
517              
518 1616   33     6590 $event->{game} ||= $game->{_id};
519 1616         3175 $event->{game_id} = delete $event->{game};
520             $event->{zone} = uc(delete $event->{location} || 'UNK')
521 1616 100 100     6075 unless ! $event->{location} && is_noplay_event($event);
      100        
522 1616   50     3079 $event->{strength} ||= 'XX';
523 1616         3160 $event->{strength} =~ s/\W//g;
524 1616 50       3358 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         2047 delete @{$event}{qw(bsjs_id event_code event_idx file teamid)};
  1616         4852  
533 1616         2633 for my $field (qw(game_id id period season stage so t ts distance)) {
534 14544 100       26772 $event->{$field} += 0 if defined $event->{$field};
535             }
536 1616 50       3150 $event->{penaltyshot} += 0 if defined $event->{penaltyshot};
537             }
538              
539             sub normalize_event_players_teams ($$) {
540              
541 1616     1616 1 1297811 my $event = shift;
542 1616         2067 my $game = shift;
543              
544 1616 100 66     5456 if (! $event->{team2} && defined $event->{t} && $event->{t} != -1) {
      100        
545 621         1695 $event->{team2} = $game->{teams}[1-$event->{t}]{name};
546             }
547 1616         2504 for my $field (qw(en player1 player2 assist1 assist2)) {
548 8080 100       16487 if ($field =~ /assist(\d)/) {
549 3232         5632 my $as = $1;
550 3232 50 66     6151 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       14140 $event->{$field} += 0 if exists $event->{$field};
555             }
556             }
557              
558             sub normalize_event_on_ice ($) {
559              
560 1616     1616 1 335507 my $event = shift;
561 1616 50 33     3677 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         72 delete $event->{on_ice};
565 40         75 return;
566             }
567 1576 50 66     3636 if ($event->{on_ice} && @{$event->{on_ice}}
  1555   66     3870  
      33        
568 1555         4002 && @{$event->{on_ice}[0]} && @{$event->{on_ice}[1]}) {
  1555         3648  
569 1555         2211 for my $t (0,1) {
570             $event->{on_ice}[$t] = [grep {
571 17960 50       62987 /\d/ && ! /^800/
572 3110         3894 } @{$event->{on_ice}[$t]} ];
  3110         5629  
573             }
574             }
575 1576 100 66     4122 if ($event->{on_ice} && @{$event->{on_ice}}
  1555   66     3636  
      33        
576 1555         3355 && @{$event->{on_ice}[0]} && @{$event->{on_ice}[1]}) {
  1555         3293  
577 1555         1891 for my $o (@{$event->{on_ice}}) {
  1555         2914  
578 3110         3520 for my $on_ice (@{$o}) {
  3110         3859  
579 17960         21634 $on_ice += 0;
580             }
581             }
582             }
583             else {
584 21         31 delete $event->{on_ice};
585             }
586             }
587              
588             sub normalize_goal_event ($) {
589              
590 31     31 1 27255 my $event = shift;
591              
592 31   50     149 $event->{en} ||= 0;
593 31   100     126 $event->{gwg} ||= 0;
594 31   50     381 $event->{assists} ||= [];
595 31 100       73 if ($event->{assist1}) {
596 30         60 $event->{assists}[0] = $event->{assist1};
597             }
598 31 100       93 if ($event->{assist2}) {
599 30         55 $event->{assists}[1] = $event->{assist2};
600             }
601 31         58 $event->{assist1} = $event->{assists}[0];
602 31         51 $event->{assist2} = $event->{assists}[1];
603 31 0 33     318 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 83368 my $event = shift;
613              
614 116         189 $event->{length} += 0;
615 116 100       280 $event->{servedby} += 0 if defined $event->{servedby};
616 116 50       308 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     413 delete $event->{servedby} if $event->{servedby} && $event->{servedby} =~ /^80/;
623             }
624              
625             sub normalize_event_by_type ($) {
626              
627 1616     1616 1 1537310 my $event = shift;
628              
629 1616         2489 for ($event->{type}) {
630 1616         2938 when ('FAC') { $event->{winning_team} = resolve_team($event->{winning_team}); }
  325         942  
631 1291         1775 when ('GOAL') { normalize_goal_event($event); }
  26         110  
632 1265         1915 when ('PENL') { normalize_penl_event($event); }
  100         238  
633             }
634 1616 100       3211 if ($event->{type} ne 'GOAL') {
635 1590         3637 delete $event->{$_} for qw(assist1 assist2 assists);
636             }
637              
638 1616 100 100     7790 if ($event->{type} eq 'MISS' || $event->{type} eq 'GOAL'
      100        
      100        
639             || $event->{type} eq 'SHOT' || $event->{type} eq 'BLOCK') {
640 656   50     1215 $event->{shot_type} ||= 'UNKNOWN';
641 656   50     1772 $event->{penaltyshot} ||= 0;
642             }
643              
644 1616 50 66     6018 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         9134  
649 1616         2851 for my $field (@fields) {
650 33785 100       49579 if (! defined $event->{$field}) {
651 2         4 delete $event->{$field};
652 2         4 next;
653             }
654 33783 100 66     78638 next if $field eq 'file' || ref $event->{$field};
655 28719 100       60901 if ($event->{$field} =~ /^\d+$/) {
656 16351         23888 $event->{$field} += 0;
657             }
658             else {
659 12368         20357 $event->{$field} = uc $event->{$field};
660             }
661             }
662             }
663              
664             sub normalize_events ($) {
665              
666 5     5 1 45738 my $boxscore = shift;
667              
668 5         33 my $gp = scalar @{$boxscore->{periods}};
  5         19  
669 5         13 for my $event (@{$boxscore->{events}}) {
  5         20  
670 1297         1945 $EVENT = $event;
671 1297 50 33     3515 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         2872 normalize_event_header($event, $boxscore);
692 1297         2573 normalize_event_players_teams($event, $boxscore);
693 1297         2603 normalize_event_on_ice($event);
694 1297         2295 normalize_event_by_type($event);
695             }
696             }
697              
698             sub insert_pstr ($$$) {
699              
700 7     7 1 95 my $period = shift;
701 7         12 my $p = shift;
702 7         10 my $event = shift;
703              
704 7         25 debug "Inserting PSTR";
705             unshift(
706 7         70 @{$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 1869 my $period = shift;
717 9         16 my $p = shift;
718 9         12 my $event = shift;
719 9         14 my $is_last = shift;
720              
721 9         29 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     63 time => '00:00', type => 'PEND',
727             };
728 9 100 66     45 if ($p <= 3 || ! $is_last && $event->{stage} != $REGULAR) {
    100 66        
729 7         14 $pend_event->{ts} = $p*1200;
730 7         13 $pend_event->{time} = '20:00';
731             }
732             elsif ($is_last) {
733             $pend_event->{ts} = $event->{ts} ||
734 1   33     5 ($event->{stage} == $REGULAR ? 3900 : $p * 1200);
735             $pend_event->{time} = $event->{time} ||
736 1   33     4 ($event->{stage} == $REGULAR ? '5:00' : '20:00');
737             }
738             else {
739 1 50       7 $pend_event->{ts} = $event->{season} < 1942 ? 4200 : 3900;
740 1 50       5 $pend_event->{time} = $event->{season} < 1942 ? '10:00' : '5:00';
741             }
742 9         14 push(@{$period}, $pend_event);
  9         24  
743             }
744              
745             sub sort_events ($) {
746              
747 5     5 1 24 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   1325 } 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     49 } @{$events};
  1792   100     5384  
  5   100     71  
762             my $ot_end =
763             $boxscore->{result}[0] != $boxscore->{result}[1]
764 5   33     80 && ! $boxscore->{so};
765 5   66     38 pop @{$events_by_period[-1]} while @events_by_period && $events_by_period[-1]->[-1]{type} eq 'GEND';
  3         15  
766 5 50       22 my $periods = $#events_by_period > 3 ? $#events_by_period : 3;
767 5 50       10 $periods = scalar @{$gp} if $periods < scalar @{$gp};
  0         0  
  5         17  
768 5         25 for my $p (1..$periods) {
769 15   50     47 my $period = $events_by_period[$p] || [];
770             insert_pstr($period, $p, $events_by_period[$p]->[0] || $boxscore)
771 15 100 33     91 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     107 unless $period->[0] && $period->[-1]{type} eq 'PEND';
      66        
      66        
774 15         25 my $e = -1;
775             $period = [
776             grep {
777 1008         1125 $e++;
778             $_->{type} eq 'PSTR' && $e > 0
779 1008 50 33     3012 || $_->{type} eq 'PEND' && $e < $#{$period}
780             ? () : $_
781 15         22 } @{$period}
  15         35  
782             ];
783 15         42 push(@{$sorted_events}, @{$period});
  15         27  
  15         184  
784             }
785             push(
786 5         34 @{$sorted_events},
  5         409  
787             dclone $sorted_events->[-1]
788             );
789 5         28 $sorted_events->[-1]{type} = 'GEND';
790 5         60 $boxscore->{events} = $sorted_events;
791             }
792              
793             sub assign_event_ids ($) {
794              
795 4     4 1 30142 my $events = shift;
796              
797 4         13 for my $e (1..@{$events}) {
  4         18  
798 670         762 my $event = $events->[$e-1];
799 670         918 $event->{event_id} = $e;
800 670         1052 $event->{_id} = $event->{game_id} * 10000 + $e;
801             }
802             }
803              
804             sub normalize_boxscore ($;$) {
805              
806 3     3 1 6187 my $boxscore = shift;
807 3   100     15 my $no_summarize = shift || 0;
808 3         278 $PLAYER_IDS = {};
809 3 100       11 unless ($no_summarize) {
810 1         2 my $event_summary = summarize($boxscore);
811 1         6 test_consistency($boxscore, $event_summary);
812             }
813              
814 3         24 normalize_header($boxscore);
815 3         21 normalize_teams($boxscore);
816 3         28 normalize_events($boxscore);
817 3         150 sort_events($boxscore);
818 3         19 assign_event_ids($boxscore->{events});
819 3         28 undef $EVENT;
820 3         22 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