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   153468 use v5.10.1;
  21         83  
4 21     21   99 use strict;
  21         42  
  21         495  
5 21     21   91 use warnings FATAL => 'all';
  21         35  
  21         712  
6 21     21   106 use experimental qw(smartmatch);
  21         43  
  21         132  
7              
8 21     21   1112 use Carp;
  21         62  
  21         1132  
9 21     21   1455 use Storable qw(store retrieve dclone);
  21         7260  
  21         1097  
10 21     21   1137 use POSIX qw(strftime);
  21         14013  
  21         156  
11              
12 21     21   5331 use Date::Parse;
  21         15922  
  21         1820  
13 21     21   124 use File::Basename;
  21         38  
  21         1165  
14 21     21   1241 use List::MoreUtils qw(uniq part);
  21         25452  
  21         149  
15              
16 21     21   14561 use Sport::Analytics::NHL::Config;
  21         69  
  21         3554  
17 21     21   842 use Sport::Analytics::NHL::DB;
  21         38  
  21         477  
18 21     21   96 use Sport::Analytics::NHL::Util;
  21         49  
  21         1166  
19 21     21   8521 use Sport::Analytics::NHL::Report;
  21         60  
  21         690  
20 21     21   7271 use Sport::Analytics::NHL::Test;
  21         46  
  21         3426  
21 21     21   155 use Sport::Analytics::NHL::Tools;
  21         33  
  21         2544  
22 21     21   8236 use Sport::Analytics::NHL::Scraper;
  21         63  
  21         1662  
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   132 use Data::Dumper;
  21         47  
  21         719  
250 21     21   102 use base 'Exporter';
  21         39  
  21         78375  
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 2177 my $event_summary = shift;
291 19         65 my $event = shift;
292 19         143 my $boxscore = shift;
293 19         85 my $positions = shift;
294 19   100     72 my $no_stats = shift || 0;
295              
296 19   100     49 $event->{assists} ||= [];
297 19         33 for my $assist (@{$event->{assists}}) {
  19         37  
298 33         63 $event_summary->{$assist}{assists}++;
299 33         39 push(@{$event_summary->{stats}}, 'assists');
  33         72  
300             }
301 19         62 $event_summary->{$boxscore->{teams}[$event->{t}]{name}}{score}++;
302 19 50       51 if ($event->{player1}) {
303 19 100       52 if ($positions->{$event->{player1}} eq 'G') {
304 1         3 $event_summary->{$event->{player1}}{g_goals}++;
305 1         2 $event_summary->{$event->{player1}}{g_shots}++;
306 1         2 push(@{$event_summary->{stats}}, 'g_goals', 'g_shots');
  1         3  
307             }
308             else {
309 18         37 $event_summary->{$event->{player1}}{goals}++;
310 18         28 $event_summary->{$event->{player1}}{shots}++;
311 18         24 push(@{$event_summary->{stats}}, 'goals', 'shots');
  18         30  
312             }
313             }
314 19 50       45 if ($event->{player2}) {
315 19         47 $event_summary->{$event->{player2}}{shots}++;
316 19 100       50 $event_summary->{$event->{player2}}{goalsAgainst}++ if $event->{ts};
317 19         25 push(@{$event_summary->{stats}}, 'goalsAgainst', 'shots');
  19         55  
318             }
319 19 100       77 delete $event_summary->{stats} if $no_stats;
320             }
321              
322             sub summarize_penalty ($$;$) {
323              
324 70     70 1 2409 my $event_summary = shift;
325 70         81 my $event = shift;
326 70   100     159 my $no_stats = shift || 0;
327              
328 70         166 $event_summary->{$event->{player1}}{penaltyMinutes} += $event->{length};
329 70         77 push(@{$event_summary->{stats}}, 'penaltyMinutes');
  70         117  
330 70 100       144 if ($event->{servedby}) {
    50          
331 4         22 $event_summary->{$event->{servedby}}{servedbyMinutes} += $event->{length};
332 4         11 push(@{$event_summary->{stats}}, 'servedbyMinutes');
  4         13  
333 4         15 $event_summary->{$event->{servedby}}{servedby}++;
334 4         7 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       158 delete $event_summary->{stats} if $no_stats;
340             }
341              
342             sub summarize_other_event ($$) {
343              
344 728     728 1 1940 my $event_summary = shift;
345 728         751 my $event = shift;
346              
347 728 50 66     1109 return unless $event->{sources}{PL} || $event->{sources}{BS};
348 727 100       1030 if ($event->{type} eq 'FAC') {
349 196   33     295 $event->{player1} ||= $UNKNOWN_PLAYER_ID;
350 196   33     269 $event->{player2} ||= $UNKNOWN_PLAYER_ID;
351 196         374 $event_summary->{$event->{player1}}{faceoffTaken}++;
352 196         326 $event_summary->{$event->{player2}}{faceoffTaken}++;
353 196         206 push(@{$event_summary->{stats}}, 'faceoffTaken');
  196         331  
354             }
355 727         1580 $event_summary->{$event->{player1}}{$EVENT_TYPE_TO_STAT{$event->{type}}}++;
356             }
357              
358             sub summarize ($) {
359              
360 4     4 1 5204 my $boxscore = shift;
361              
362 4         30 debug "Generating event summary";
363 4         19 my $event_summary = {so => [0,0], stats => []};
364 4         25 my $positions = set_roster_positions($boxscore);
365 4         23 my @stats = qw(goals assists);
366              
367 4         10 for my $event (@{$boxscore->{events}}) {
  4         14  
368 978 50       1481 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         1233 for ($event->{type}) {
373 978         1288 when ('GOAL') { summarize_goal($event_summary, $event, $boxscore, $positions); }
  16         41  
374 962         1041 when ('PENL') { summarize_penalty($event_summary, $event); }
  68         106  
375 894         1948 when ([ qw(SHOT MISS HIT BLOCK TAKE GIVE FAC) ]) {
376 726         1230 summarize_other_event($event_summary, $event);
377 726         1684 push(@stats, $EVENT_TYPE_TO_STAT{$event->{type}});
378             }
379             }
380             }
381 4         12 my $so = $event_summary->{so};
382 4 50 33     32 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         12 $event_summary->{stats} = [ uniq @{$event_summary->{stats}}, @stats ];
  4         169  
388 4         28 for my $t (0,1) {
389 8         13 for my $player (@{$boxscore->{teams}[$t]{roster}}) {
  8         21  
390 159   100     313 $event_summary->{$player->{_id}} ||= {};
391             }
392             }
393 4         14 for my $key (keys %{$event_summary}) {
  4         33  
394 177 100       401 next unless $key =~ /^\d{7}$/;
395 162         210 for my $stat (@{$event_summary->{stats}}) {
  162         245  
396 1998   100     3887 $event_summary->{$key}{$stat} ||= 0;
397             }
398             }
399 4         47 $event_summary;
400             }
401              
402             sub normalize_result ($) {
403              
404 9     9 1 13821 my $game = shift;
405 9 50       55 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 1692 my $game = shift;
419 5         356 $game->{date} = strftime("%Y%m%d", localtime($game->{start_ts}));
420 5 100       31 if ($game->{location}) {
421 3         21 $game->{location} =~ s/^\s+//;
422 3         23 $game->{location} =~ s/\s+$//;
423 3         19 $game->{location} =~ s/\s+/ /g;
424 3         11 $game->{location} = uc $game->{location};
425             }
426 5         21 for my $field (qw(last_updated _id attendance month date ot start_ts stop_ts stage season season_id)) {
427 55         107 $game->{$field} += 0;
428             }
429 5   100     29 $game->{tz} ||= 'EST';
430 5         22 normalize_result($game);
431              
432 5         14 delete @{$game}{qw(_t type scratches resolve_cache)};
  5         64  
433             }
434              
435             sub normalize_team ($) {
436              
437 12     12 1 320074 my $team = shift;
438              
439 12         19 for my $stat (keys %{$team->{stats}}) {
  12         67  
440 116         178 $team->{stats}{$stat} += 0.0;
441             }
442 12         36 for my $field (qw(pull shots score)) {
443 36         184 $team->{$field} += 0;
444             }
445 12         24 delete @{$team}{qw(teamid orig _decision)};
  12         39  
446 12         24 my $roster = [];
447 12         19 for my $player (@{$team->{roster}}) {
  12         26  
448 220         333 push(@{$roster}, $player)
449             unless $player->{_id} =~ /^80/ || (!$player->{shifts} && grep {
450 90         243 $player->{_id} eq $_
451 245 100 100     659 } @{$team->{scratches}});
  65   66     123  
452             }
453 12         36 $team->{roster} = $roster;
454 12   50     32 $team->{scratches} ||= [];
455             }
456              
457             sub normalize_players ($) {
458              
459 12     12 1 14384 my $team = shift;
460              
461 12         22 for my $player (@{$team->{roster}}) {
  12         33  
462 220         311 for my $toi (qw(evenTimeOnIce shortHandedTimeOnIce powerPlayTimeOnIce timeOnIce)) {
463             $player->{$toi} = get_seconds($player->{$toi})
464 880 100 100     3205 if defined $player->{$toi} && $player->{$toi} =~ /\:/;
465             }
466 220 100       426 unless ($player->{position} eq 'G') {
467 208         261 delete $player->{wl};
468             }
469             else {
470 12   0     31 $player->{decision} ||= delete $player->{wl} || 'N';
      33        
471             }
472 220 100 66     643 if (!
473             defined $player->{faceoffTaken}
474             || $player->{faceoffTaken} eq -1
475             ) {
476 40         54 for (grep { /faceoff/i } keys %{$player}) {
  677         907  
  40         156  
477 0         0 delete $player->{$_};
478             }
479             }
480 220         304 delete @{$player}{'Saves - Shots', qw(void EV SH PP TOITOT p1 p2 p3)};
  220         426  
481 220         276 for (keys %{$player}) {
  220         1089  
482 6937         8194 when ('faceOffPercentage') {
483             $player->{$_} = $player->{faceoffTaken}
484             ? $player->{faceOffWins} / $player->{faceoffTaken}
485 0 0       0 : 0;
486             }
487 6937   50     7604 when ('status') { $player->{$_} //= ' ' }
  190         473  
488 6747   50     7312 when ('start') { $player->{$_} //= 2 }
  190         437  
489 6557   66     13960 when ($_ ne 'plusMinus' && $player->{$_} eq -1 ) {
490 0         0 delete $player->{$_}
491             }
492             }
493 220         615 $player->{team} = $team->{name};
494 220         558 $PLAYER_IDS->{$player->{_id}} = \$player;
495             }
496 12         21 for my $player (@{$team->{scratches}}) {
  12         33  
497 25         58 $player += 0;
498             }
499             }
500              
501             sub normalize_teams ($) {
502              
503 5     5 1 977773 my $boxscore = shift;
504 5         483 $PLAYER_IDS = {};
505              
506 5         23 for my $t (0,1) {
507 10         24 my $team = $boxscore->{teams}[$t];
508 10         36 normalize_team($team);
509 10         78 normalize_players($team);
510             }
511             }
512              
513             sub normalize_event_header ($$) {
514              
515 1616     1616 1 3198878 my $event = shift;
516 1616         2238 my $game = shift;
517              
518 1616   33     6749 $event->{game} ||= $game->{_id};
519 1616         3254 $event->{game_id} = delete $event->{game};
520             $event->{zone} = uc(delete $event->{location} || 'UNK')
521 1616 100 100     6064 unless ! $event->{location} && is_noplay_event($event);
      100        
522 1616   50     3335 $event->{strength} ||= 'XX';
523 1616         3444 $event->{strength} =~ s/\W//g;
524 1616 50       3402 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         2217 delete @{$event}{qw(bsjs_id event_code event_idx file teamid)};
  1616         4919  
533 1616         2798 for my $field (qw(game_id id period season stage so t ts distance)) {
534 14544 100       26202 $event->{$field} += 0 if defined $event->{$field};
535             }
536 1616 50       3200 $event->{penaltyshot} += 0 if defined $event->{penaltyshot};
537             }
538              
539             sub normalize_event_players_teams ($$) {
540              
541 1616     1616 1 1324909 my $event = shift;
542 1616         2162 my $game = shift;
543              
544 1616 100 66     6376 if (! $event->{team2} && defined $event->{t} && $event->{t} != -1) {
      100        
545 621         1777 $event->{team2} = $game->{teams}[1-$event->{t}]{name};
546             }
547 1616         2571 for my $field (qw(en player1 player2 assist1 assist2)) {
548 8080 100       16879 if ($field =~ /assist(\d)/) {
549 3232         5599 my $as = $1;
550 3232 50 66     6221 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       14529 $event->{$field} += 0 if exists $event->{$field};
555             }
556             }
557              
558             sub normalize_event_on_ice ($) {
559              
560 1616     1616 1 345824 my $event = shift;
561 1616 50 33     3721 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         64 delete $event->{on_ice};
565 40         71 return;
566             }
567 1576 50 66     3783 if ($event->{on_ice} && @{$event->{on_ice}}
  1555   66     4055  
      33        
568 1555         3862 && @{$event->{on_ice}[0]} && @{$event->{on_ice}[1]}) {
  1555         3544  
569 1555         2336 for my $t (0,1) {
570             $event->{on_ice}[$t] = [grep {
571 17960 50       62248 /\d/ && ! /^800/
572 3110         3887 } @{$event->{on_ice}[$t]} ];
  3110         5546  
573             }
574             }
575 1576 100 66     4094 if ($event->{on_ice} && @{$event->{on_ice}}
  1555   66     3548  
      33        
576 1555         3580 && @{$event->{on_ice}[0]} && @{$event->{on_ice}[1]}) {
  1555         3322  
577 1555         2037 for my $o (@{$event->{on_ice}}) {
  1555         2967  
578 3110         3484 for my $on_ice (@{$o}) {
  3110         3784  
579 17960         21459 $on_ice += 0;
580             }
581             }
582             }
583             else {
584 21         26 delete $event->{on_ice};
585             }
586             }
587              
588             sub normalize_goal_event ($) {
589              
590 31     31 1 27105 my $event = shift;
591              
592 31   50     143 $event->{en} ||= 0;
593 31   100     105 $event->{gwg} ||= 0;
594 31   50     354 $event->{assists} ||= [];
595 31 100       72 if ($event->{assist1}) {
596 30         64 $event->{assists}[0] = $event->{assist1};
597             }
598 31 100       67 if ($event->{assist2}) {
599 30         65 $event->{assists}[1] = $event->{assist2};
600             }
601 31         52 $event->{assist1} = $event->{assists}[0];
602 31         54 $event->{assist2} = $event->{assists}[1];
603 31 0 33     289 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 86185 my $event = shift;
613              
614 116         189 $event->{length} += 0;
615 116 100       319 $event->{servedby} += 0 if defined $event->{servedby};
616 116 50       305 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     407 delete $event->{servedby} if $event->{servedby} && $event->{servedby} =~ /^80/;
623             }
624              
625             sub normalize_event_by_type ($) {
626              
627 1616     1616 1 1575530 my $event = shift;
628              
629 1616         2844 for ($event->{type}) {
630 1616         2981 when ('FAC') { $event->{winning_team} = resolve_team($event->{winning_team}); }
  325         996  
631 1291         1865 when ('GOAL') { normalize_goal_event($event); }
  26         72  
632 1265         1942 when ('PENL') { normalize_penl_event($event); }
  100         211  
633             }
634 1616 100       3394 if ($event->{type} ne 'GOAL') {
635 1590         3798 delete $event->{$_} for qw(assist1 assist2 assists);
636             }
637              
638 1616 100 100     8038 if ($event->{type} eq 'MISS' || $event->{type} eq 'GOAL'
      100        
      100        
639             || $event->{type} eq 'SHOT' || $event->{type} eq 'BLOCK') {
640 656   50     1305 $event->{shot_type} ||= 'UNKNOWN';
641 656   50     2023 $event->{penaltyshot} ||= 0;
642             }
643              
644 1616 50 66     6663 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         2151 my @fields = keys %{$event};
  1616         8556  
649 1616         3025 for my $field (@fields) {
650 33785 100       48415 if (! defined $event->{$field}) {
651 2         3 delete $event->{$field};
652 2         2 next;
653             }
654 33783 100 66     77368 next if $field eq 'file' || ref $event->{$field};
655 28719 100       58459 if ($event->{$field} =~ /^\d+$/) {
656 16351         23679 $event->{$field} += 0;
657             }
658             else {
659 12368         20155 $event->{$field} = uc $event->{$field};
660             }
661             }
662             }
663              
664             sub normalize_events ($) {
665              
666 5     5 1 44786 my $boxscore = shift;
667              
668 5         13 my $gp = scalar @{$boxscore->{periods}};
  5         15  
669 5         11 for my $event (@{$boxscore->{events}}) {
  5         21  
670 1297         1753 $EVENT = $event;
671 1297 50 33     3131 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         2675 normalize_event_header($event, $boxscore);
692 1297         2521 normalize_event_players_teams($event, $boxscore);
693 1297         2446 normalize_event_on_ice($event);
694 1297         2186 normalize_event_by_type($event);
695             }
696             }
697              
698             sub insert_pstr ($$$) {
699              
700 7     7 1 73 my $period = shift;
701 7         9 my $p = shift;
702 7         7 my $event = shift;
703              
704 7         22 debug "Inserting PSTR";
705             unshift(
706 7         44 @{$period},
707             {
708             ts => 0, period => $p, stage => $event->{stage}, season => $event->{season},
709 7   33     10 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 1428 my $period = shift;
717 9         10 my $p = shift;
718 9         12 my $event = shift;
719 9         14 my $is_last = shift;
720              
721 9         22 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     47 time => '00:00', type => 'PEND',
727             };
728 9 100 66     32 if ($p <= 3 || ! $is_last && $event->{stage} != $REGULAR) {
    100 66        
729 7         14 $pend_event->{ts} = $p*1200;
730 7         12 $pend_event->{time} = '20:00';
731             }
732             elsif ($is_last) {
733             $pend_event->{ts} = $event->{ts} ||
734 1   33     4 ($event->{stage} == $REGULAR ? 3900 : $p * 1200);
735             $pend_event->{time} = $event->{time} ||
736 1   33     3 ($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       3 $pend_event->{time} = $event->{season} < 1942 ? '10:00' : '5:00';
741             }
742 9         10 push(@{$period}, $pend_event);
  9         19  
743             }
744              
745             sub sort_events ($) {
746              
747 5     5 1 19 my $boxscore = shift;
748              
749 5         11 my $events = $boxscore->{events};
750 5         13 my $gp = $boxscore->{periods};
751              
752 5         11 my $sorted_events = [];
753             my @events_by_period = part {
754             my $x = $_->{period}
755 999     999   1226 } 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     44 } @{$events};
  1792   100     4817  
  5   100     60  
762             my $ot_end =
763             $boxscore->{result}[0] != $boxscore->{result}[1]
764 5   33     60 && ! $boxscore->{so};
765 5   66     37 pop @{$events_by_period[-1]} while @events_by_period && $events_by_period[-1]->[-1]{type} eq 'GEND';
  3         16  
766 5 50       20 my $periods = $#events_by_period > 3 ? $#events_by_period : 3;
767 5 50       9 $periods = scalar @{$gp} if $periods < scalar @{$gp};
  0         0  
  5         14  
768 5         24 for my $p (1..$periods) {
769 15   50     44 my $period = $events_by_period[$p] || [];
770             insert_pstr($period, $p, $events_by_period[$p]->[0] || $boxscore)
771 15 100 33     71 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     88 unless $period->[0] && $period->[-1]{type} eq 'PEND';
      66        
      66        
774 15         25 my $e = -1;
775             $period = [
776             grep {
777 1008         998 $e++;
778             $_->{type} eq 'PSTR' && $e > 0
779 1008 50 33     2709 || $_->{type} eq 'PEND' && $e < $#{$period}
780             ? () : $_
781 15         21 } @{$period}
  15         25  
782             ];
783 15         22 push(@{$sorted_events}, @{$period});
  15         25  
  15         168  
784             }
785             push(
786 5         13 @{$sorted_events},
  5         352  
787             dclone $sorted_events->[-1]
788             );
789 5         20 $sorted_events->[-1]{type} = 'GEND';
790 5         51 $boxscore->{events} = $sorted_events;
791             }
792              
793             sub assign_event_ids ($) {
794              
795 4     4 1 25012 my $events = shift;
796              
797 4         13 for my $e (1..@{$events}) {
  4         18  
798 670         721 my $event = $events->[$e-1];
799 670         811 $event->{event_id} = $e;
800 670         1096 $event->{_id} = $event->{game_id} * 10000 + $e;
801             }
802             }
803              
804             sub normalize_boxscore ($;$) {
805              
806 3     3 1 8023 my $boxscore = shift;
807 3   100     12 my $no_summarize = shift || 0;
808 3         262 $PLAYER_IDS = {};
809 3 100       11 unless ($no_summarize) {
810 1         4 my $event_summary = summarize($boxscore);
811 1         6 test_consistency($boxscore, $event_summary);
812             }
813              
814 3         17 normalize_header($boxscore);
815 3         21 normalize_teams($boxscore);
816 3         21 normalize_events($boxscore);
817 3         160 sort_events($boxscore);
818 3         16 assign_event_ids($boxscore->{events});
819 3         16 undef $EVENT;
820 3         19 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