Hockey Simulator
Simulates a hockey game using two database files (stats).
[ b a c k ]
#!/usr/bin/perl -w
#SUBROUTINE SECTION##################################################
##################OPENER#####################################
# This subroutine opens a specified file and reads it into an
# array of lines.
#############################################################
sub openFile {
my($file) = @_;
open(FILE, $file) || die "Error opening a file: $!\n";
@fileStuff=<FILE>;
close(FILE);
return(@fileStuff);
}
##############TEAMS AVAILABLE################################
# This routine constructs an array of the teams involved in a
# data base.
#
# INPUT: None
# OUTPUT: The teams that are in the csv files
# DPENDENCIES: openFile()
#############################################################
sub teamsArray {
@playersStats=openFile("playersDB.csv");
foreach $playerStat (@playersStats){#loop through all
@player = split(/,/,$playerStat);#lines split
#into seperate
#scalers
if (@teamsAvail == 0){ #check if
#it needs
#initializing
$teamsAvail[0] = $player[1];
}
$teamFoundFlag = 0;#resetflag each round
foreach $team (@teamsAvail){ #loop through
#the teams
#found array
if ($team eq $player[1]){#if it is
#there flag!
$teamFoundFlag = 1;
}
}
if ($teamFoundFlag == 0){
$teamsAvail[@teamsAvail] =
$player[1];
}
}
return @teamsAvail;
}
##############IS IT IN THERE - AVAILABLE TEAMS###############
# This routine makes an array of specified items in an
# existing array and prints them out
#
# INPUT: None
# OUTPUT: The teams that are in the csv files
# DPENDENCIES: teamsArray()
#############################################################
sub teamsAvailable {
print"\nHere are the teams available:\n\n";
@teams=teamsArray();
print "@teams\n\n";
print "Press ENTER to continue\n";
$bogus=<STDIN>;print"$bogus";
}
######GET TEAM###############################################
# This subroutine prompts the user for a team abriviation.
# INPUT: a name to be printed as the team identifier
# (example "AWAY")
# OUTPUT: Team id (abvr)
# EXAMPLE CALL: $homeTeam = getTeam("Home");
#############################################################
sub getTeam {
my($team) = @_;
print"\n$team team (in abr lowercase) ==> ";
$team=<STDIN>;
chomp $team;
return $team;
}
#CHECK TEAM SUBROUTINE#######################################
# This subroutine checks for a team abr and if it is availabe
# in the array supplied.
#
# IN: (an array of team initials, a team initial)
# OUT: Boolean 1=true it exists, 0=false does not exists
# DEPENDENCIES: none
#############################################################
sub checkTeam{
my($tm, @t) = @_;
%tms=();
foreach(@t){
$tms{$_}=1;#1 is dummy value.
}
if(exists $tms{$tm}){
return 1;
}else{
return 0;
}
}
###############COUNT LINES###################################
# This subroutine counts the players that are on each line.
# This subroutine NEEDS the subroutine OPEN FILE.
#############################################################
sub countLines {
my($teamWanted) = @_;
@playersStats=openFile("playersDB.csv");
@goalieStats =openFile("goaliesDB.csv");
###############LINE COUNT ARRAY######################
#This array is an array of numbers of players on
#each line. [0] is line 1, [1] is line 2. [2] is
#line 3, [3] is line 4, [4] is not dressed.
@lineCount = (0,0,0,0,0);
###############GOALIE COUNT ARRAY####################
#This array is an array of numbers of goalies on
#each line. [0] is line 1 (starting), [1] is line 2
#(backup), [2] is not dressed.
@goalieCount = (0,0,0);
#####################################################
foreach $playerStat (@playersStats){
@player = split(/,/,$playerStat);
if ($player[1] eq $teamWanted &&
$player[9] == 1){
$lineCount[0]++;
}elsif($player[1] eq $teamWanted &&
$player[9] == 2){
$lineCount[1]++;
}elsif($player[1] eq $teamWanted &&
$player[9] == 3){
$lineCount[2]++;
}elsif($player[1] eq $teamWanted &&
$player[9] == 4){
$lineCount[3]++;
}elsif($player[1] eq $teamWanted &&
$player[9] == 5){
$lineCount[4]++;
}
}
foreach $goalieStat (@goalieStats){
@goalie = split(/,/,$goalieStat);
if ($goalie[1] eq $teamWanted &&
$goalie[3] == 1){
$goalieCount[0]++;
}elsif($goalie[1] eq $teamWanted &&
$goalie[3] == 2){
$goalieCount[1]++;
}elsif($goalie[1] eq $teamWanted &&
$goalie[3] == 3){
$goalieCount[2]++;
}
}
}
######INSPECT LINES##########################################
# This subroutine prints out a warning if the lines on the
# team are not set - aka 5 per line 1-3 and 3 for line 4.
# INPUT: team abr.
# OUTPUT: 0 if ok - 1 if line errors exists:BOOLEAN
# PRECONDITIONS: countLines() must be present in this source
# code
#############################################################
sub inspectLines {
my($teem) = @_;
$lineErrorFlag=0;
countLines($teem);
for ($i = 0; $i < 3; $i++){
if ($lineCount[$i] > 5 ||
$lineCount[$i] < 5){
$lineErrorFlag=1;
}
if ($i < 4){
if ($goalieCount[$i] > 1 ||
$goalieCount[$i] < 1){
if ($i == 0 || $i == 1){
$lineErrorFlag=1;
}
}
}
}
if ($lineCount[3] > 3 || $lineCount[3] < 3){
$lineErrorFlag=1;
}
return $lineErrorFlag;
}
##################SAVE STATS#################################
# This subroutine opens a specified file and reads it into
# an array of lines.
#
# IN: File Path,
# Data to be saved in said file
# (copied over if file exists)
# OUT: A file that contains the data
# specified
# SUBROUTINES NEEDED: none.
# EXAMPLE: saveStats("playersDB.csv", @playersStats);
#############################################################
sub saveStats {
my($file, @stuffToBeFiled) = @_;
open(FILE, ">$file") ||
die "Error opening a file: $!\n";
print FILE @stuffToBeFiled;
close(FILE);
}
##################CHANGE LINES###############################
# This subroutine opens a file (NEEDS SUB OPENFILE) and goes
# through a roster one player at a time. The user has an
# option to change lines.
#
# IN: Team Wanted, (1 or 0), 1 if manual,
# 0 if random line
# OUT: A saved file of the db that was edited
# NEEDED SUBROUTINES: openFile(filePath), saveStats(filepath,
# data), printRunningTotal(lineNumber)
# {included} reinsertPlayer(string,number)
# {included}
#############################################################
sub changeLines{
##################PRINT RUNNING TOTAL################
# This subroutine keeps and prints a running toatl
# of how many players are on each line. This routine
# is for subroutine changeLines only and uses global
# variables (not portable)
#####################################################
sub printRunningTotal {
my($lineNumber) = @_;
$lineCount[$lineNumber]++;
print"Running Total => line 1";
print"[$lineCount[1]],";
print" line 2[$lineCount[2]],";
print" line 3[$lineCount[3]],";
print" line 4[$lineCount[4]],";
print" Not dressed[$lineCount[5]]\n";
}
#####reinsertPlayer##################################
# This subroutine takes a string and a line number
# and changes the line number in that string. First
# the string is put into an array and then the new
# line number is inserted, then the string is returned.
#
# INPUT: String,number, "index of line in array"
# OUTPUT: String
# DEPENDENCIES: Just the $player[9] needs changeLines,
# comment out if not needed
#####################################################
sub reinsertPlayer {
my($playerString, $whatLine, $index) = @_;
@thisPlayer = split(/,/,$playerString);
$thisPlayer[$index] = $whatLine;
$stat = join(',', @thisPlayer);
$stat = $stat."\n";
return $stat;
}
#CHANGE LINES START##################################
my($teamWanted,$manOrRand) = @_;
if($manOrRand == 1){
print"\nq to quit\n1 = line 1\n2 = line 2 ";
print"...etc.\n5 = not dressed\npress ENTER ";
print"to continue\n\nSKATERS________________";
print"_________________________\n";
}
# First we will do the players#######################
# This section opens a file of players and then
# initializes the players number and start a array of
# counts of how many players on a given line (has to
# be running total due to the sequential nature of the
# reading of the file). It then reads each line of
# the file and finds the team wanted. Once team
# wanted if found the line of that player is reported
# and the user inputs the line to be changed or hits
# enter to continue. If the random line action is
# invoked then the lines are assigned as the players
# are encountered in the database.
#####################################################
@playersStats=openFile("playersDB.csv");
$plyerNumber = 1;
@lineCount = (0,0,0,0,0,0);
foreach $playerStat (@playersStats){
@player = split(/,/,$playerStat);
#######################Find each team member.
if ($player[1] eq $teamWanted){
chomp $player[9];$plyerNumber++;
###############Manual or auto?
if ($manOrRand == 1){ ## MANUAL!
print"\n$plyerNumber. ";
print"$player[0] is on line ";
print"$player[9]: ";
print"change to ==> ";
$new_line = <STDIN>;
chomp $new_line;
if ($new_line eq 1 |
$new_line eq 2 |
$new_line eq 3 |
$new_line eq 4 |
$new_line eq 5) {
$playerStat=
reinsertPlayer
($playerStat,
$new_line, 9);
$player[9] =
$new_line;
printRunningTotal
($player[9]);
}
elsif ($new_line eq "q" ||
$new_line eq "Q"){
last;
}
else{
printRunningTotal
($player[9]);
}
}
else { ## AUTO!
if ($plyerNumber < 7){
$playerStat=
reinsertPlayer
($playerStat,
1, 9);
}
elsif ($plyerNumber < 12){
$playerStat=
reinsertPlayer
($playerStat,
2, 9);
}
elsif ($plyerNumber < 17){
$playerStat=
reinsertPlayer
($playerStat,
3, 9);
}
elsif ($plyerNumber < 20){
$playerStat=
reinsertPlayer
($playerStat,
4, 9);
}
else{
$playerStat=
reinsertPlayer
($playerStat,
5, 9);
}
}
}
}
# Now for the goalies################################
# The goalies process is much the same as for the
# players except that the goalies are either
# 1=starting, 2=backup, or 3+=not dressed.
# The arrays and file are goalieStat instead of the
# playerStat above.
#####################################################
if($manOrRand == 1){
print"\nGOALIES___________________________";
print"______________\n";
}
@goalieStats=openFile("goaliesDB.csv");
$goalieCount = 1;
foreach $goalieStat (@goalieStats){
@player = split(/,/,$goalieStat);
if ($player[1] eq $teamWanted){
chomp $player[3];
####################MANUAL OR AUTO?
if($manOrRand == 1){
if($player[3] eq 1){
print"\n";
print"$plyerNumber.";
print" $player[0]";
print" is starting";
print"in goal: ";
print"change to ";
print"==> ";
$new_line = <STDIN>;
chomp $new_line;
}elsif($player[3] eq 2){
print"\n";
print"$plyerNumber";
print". $player[0]";
print" is backup ";
print"goalie: ";
print"change to";
print"==> ";
$new_line = <STDIN>;
chomp $new_line;
}else{
print"\n$plyerNumber";
print". Goalie ";
print"$player[0]";
print" is not ";
print"dressed: ";
print"change to ==> ";
$new_line = <STDIN>;
chomp $new_line;
}
$plyerNumber++;
if ($new_line eq 1 |
$new_line eq 2 |
$new_line eq 3 |
$new_line eq 4 |
$new_line eq 5 ){
$goalieStat=
reinsertPlayer
($goalieStat,
$new_line, 3);
}
elsif ($new_line eq "q" ||
$new_line eq "Q"){
last;
}else{
next;
}
}
else{
if($goalieCount == 1){
$goalieCount++;
$goalieStat=
reinsertPlayer
($goalieStat,
1, 3);
}
elsif($goalieCount == 2){
$goalieCount++;
$goalieStat=
reinsertPlayer
($goalieStat,
2, 3);
}
else{
$goalieStat=
reinsertPlayer
($goalieStat,
3, 3);
}
}# END MANUAL OR AUTO!
}
}
# Save changes#######################################
# Now if the user has typed q or the end of the
# files has been reached the user is prompted to
# save.
#####################################################
if($manOrRand == 1){
print "\nDo you want to save changes? ";
print"(y or n) ";
$answer=<STDIN>; chomp $answer;
}
else{
$answer="y";
}
if ($answer eq "y" | $answer eq "Y"){
saveStats("playersDB.csv", @playersStats);
saveStats("goaliesDB.csv", @goalieStats);
}
}
##################MAKE GAME ARRAY############################
# This subroutine makes an array of lines which contain a
# player and their information. The structure is as follows:
#
# [0 to 17]name,team,pts,plus/Minus,pen,pp,sh,gw,gt,
# line(1-4)
#
# [18 & 19]*the last two are goalies:
# name,team,pct,Start(1=start,2=backup)
#
# INPUT: team abr. example: nyr
# OUTPUT: an array of the team ready for game
# Dependencies: openFile(fileName),inspectLines(team),
# changeLine(team,m or a[1,0]), saveStats,
# countLines.
# EXAMPLE CALL: @home=mkGameArray($team);
# NOTE OF IMPORTANCE: Lines are checked and set if incorrect
# - then checked again. Even so your
# calling program should not continue
# if the error message is prionted as
# the game array will not work in the
# game.
#############################################################
sub mkGameArray {
my($t) = @_;
if(inspectLines($t) == 1){
changeLines($t, 0);
if (inspectLines($t) == 1){
print"INVALID LINES\n";
}
}
@array=();
@stats=openFile("playersDB.csv");
foreach $teamMembers (@stats){
@member = split(/,/,$teamMembers);
if($member[1] eq $t &&
$member[9] < 5){
$array[@array] =join (',',
@member);
}
}
@stats=openFile("goaliesDB.csv");
foreach $teamMembers (@stats){
@member = split(/,/,$teamMembers);
if($member[1] eq $t &&
$member[3] < 3){
$array[@array] =join (',',
@member);
}
}
return @array;
}
#GAME SET UP#################################################
# This sub-routine will check to see if a team exist, and
# then create a game array.
#
# INPUT: team id string like "nyr"
# OUTPUT: an array from 1 to 20 of player values.
# see mkGameArray()
# DEPENDENCIES: getTeam(), checkTeam(), teamsArray(),
# mkGameArray();
# SAMPLE CALL: @home=gameSetUp($homeTeam);
#############################################################
sub gameSetUp{
my($id) = @_;
if (!checkTeam($id, teamsArray())){
print "\nTeam $id does not exist!\n";
}
return mkGameArray($id);
}
#GET VALUES##################################################
# This sub-routine gets a certain value from an array.
#
# INPUT: values index, and range (from, to),
# the array(coma delimited)
# OUTPUT: value of all the data added together at the
# given position
# DEPENDENCIES: none
# SAMPLE CALL: $homePlusMinus=getValues(3, 0, 17, @home);
#############################################################
sub getValues {
my($position, $from, $to, @a) = @_;
$value=0;
for ($i=$from; $i<$to; $i++){
$line=$a[$i];
@player = split(/,/,$line);
$value=$value+$player[$position];
}
return $value;
}
#GET VALUE###################################################
# This sub-routine gets a certain value from an array.
#
# INPUT: values index, which line,
# the array(coma delimited)
# OUTPUT: value of the data
# DEPENDENCIES: none
# SAMPLE CALL: $homePlusMinus=getValue(3, 17, @home);
#############################################################
sub getValue {
my($position, $from, @a) = @_;
$value=0;
$line=$a[$from];
@player = split(/,/,$line);
$value=$player[$position];
return $value;
}
##################DECIDER####################################
# This subroutine takes a percentage and based on that
# percentage number spits out either 1 (true) or 0 (false).
# It will return 1 the % number of times.
#
# INPUT: an integer (percentage)
# OUTPUT: Aboolean t=1, f=0
# DEPENDENCIES: None
# SAMPLE CALL: $decided = decider($percentage);
#############################################################
sub decider {
my($percentage) = @_;
if ($percentage > int(rand 110)){
return 1;
}else{
return 0;
}
}
#PUCK POSITION ##############################################
# This sub-routine takes two integers, and a power play flag
# then returns a puck Position. The two integers are the plus
# minus total of the teams. The difference will be added to
# 50 and returne a team id flag position = (h=0 or a=1). If
# one team is over 75% then they are defaulted to 75%. if
# one team is minus than the default will be zero. Remember
# that if 0 then the puck is in the away zone.
#
# INPUT: Two integers(home and away +/-),
# integer power play flag (0=reg,
# 1=power-play[home], 2=power-play[away])
# OUTPUT: One integer (home zone=0 or away zone=1)
# DEPENDENCIES: decider($percentage)
# SAMPLE CALL: $whersPuck=puckPosition($homePlusMinus,
# $awayPlusMinus, 0);
#############################################################
sub puckPosition{
my($h, $a, $ppf) = @_;
if($h<0){# Test to see if +/- is less than zero
$h=0;
}elsif($a<0){
$a=0;
}
if($ppf==1){# Is either team on the power play?
$h=$h+25;
}
elsif($ppf==2){
$a=$a+25;
}
if($h<$a){# Who has the bigger +/-?
$percentage=($a-$h)+60;# make %.
if($percentage>75){# Is % too big?
$percentage=75;
}
if(decider($percentage)){# Decider
return 0;
}else{
return 1;
}
}elsif($h==$a){#if same - home ice advantage
if(decider(63)){
return 1;
}else{
return 0;
}
}else{
$percentage=($h-$a)+70;#home ice advantage
if($percentage>75){
$percentage=75;
}
if(decider($percentage)){
return 1;
}else{
return 0;
}
}
}
##Game Clock#################################################
# This routine runs a game clock for a hockey game.
# This subroutine takes in an array(period, minutes, seconds)
# and increments it. This subroutine returns that array.
# Note that calling routine must check to see if $time[0] =
# 4, and if so end of game.
#
# INPUT: array[0=period,1=minutes,2=seconds]
# OUTPUT:
# DEPENDANCIES: array[0=period,1=minutes,2=seconds]
# SAMPLE CALL: @currentTime=gameClock(1, 0, 5);
#############################################################
sub gameClock{
my(@time) = @_;
$seconds=($time[1]*60)+$time[2];
$increment = (int(rand 1200/
(int(rand 75)+1)))+int(rand 15);
#+int(rand (5..15)) because at
#least 15 seconds between
#events
$incrementTotal = $seconds+$increment;
if($incrementTotal>1200){
$time[0]++;
$incrementTotal=$incrementTotal-1200;
}
$time[1]= int($incrementTotal/60);
$time[2]= int($incrementTotal%60);
return @time;
}
##Event Subroutines##########################################
# This routine returns a random event in a hockey game.
# There are three events. Scoring chance, Penalty, Play
# stoppage. These main events will be broken down later in
# another subrioutine.
#
# INPUT: None
# OUTPUT: random event (string)
# DEPENDANCIES: none
# SAMPLE CALL: $event = randEvent();
#############################################################
sub randEvent{
@event=('Scoring Opportunity', 'Scoring Opportunity',
'Scoring Opportunity', 'Scoring Opportunity',
'Scoring Opportunity', 'Scoring Opportunity',
'Scoring Opportunity', 'Scoring Opportunity',
'Stoppage in play', 'Stoppage in play',
'Scoring Opportunity', 'Scoring Opportunity',
'Stoppage in play', 'Stoppage in play',
'Stoppage in play', 'Penalty',
'Scoring Opportunity');
return($event[int(rand @event)-1]);
}
#getGoalie Subroutine#######################################
# This routine finds the starting goalie and returns their
# names and save percentages.
#
#
# INPUT: @homeTeamArray, @wayTeamArray
# OUTPUT: @goalies=(0=goalie name, 1=goalie name,)
# DEPENDANCIES: getValue(#,#,@)
# SAMPLE CALL: @goalie=getGoalie(@home);
# NOTE: remember that each team array is 0-19
#############################################################
sub getGoalie{
my(@a) = @_;
@ga=();
$g1=getValue(3, 18, @a);
$g2=getValue(3, 19, @a);
if($g1>$g2){
$ga[0]=getValue(0, 19, @a);
#this makes an integer percentage!!!!!!!!!!!!
$ga[1]=int((getValue(2, 19, @a)*100))+7;
return @ga;
}else{
$ga[0]=getValue(0, 18, @a);
$ga[1]=int((getValue(2, 18, @a)*100))+7;
return @ga;
}
}
##################WHO SCORED#################################
# This subroutine takes a team array and decides who has
# scored.
#
# INPUT: $index (integer)- this will index which set
# of stats to decide from, @team (array)
# OUTPUT: @scorers [scorer, assister, assister]
# DEPENDENCIES: mkGameArray("$homeTeam") openFile(fileName),
# inspectLines(team),changeLine
# (team,m or a[1,0]), countLines,
# saveStats(filepath, data)
#
# SAMPLE CALL: @scorer = whoScored(5, @homeTeam);
# NOTE: Make sure that user tests to se if unassisted
# is in the no. 1 spot in the array retuned for
# reasons that the user program can use.
#############################################################
sub whoScored {
my($index, @t) = @_;
#DESTINY SUBROUTINE##################################
# This subroutine takes a hash and spits out a member
# of that has. The hash is first put into an array
# and the hask keys with the biggest values are more
# likely to be in th array more times than the other
# lesser ones.
#
# IN: Hash key=name, value=points
# OUT: Scorer
# DEPEDANCIES: none
# SAMPLE CALL: $player=destiny(%fun);
#####################################################
sub destiny{
my(%p) = @_;
@d=();
$howManyTimes=1;#better players more frequent
foreach $member (sort {$p{$a} <=> $p{$b}}
keys %p){
for($i=$howManyTimes; $i>0; $i--){
$d[@d]= $member;
}
$howManyTimes++;
}
return $d[int(rand @d)-1];
}####################################################
#Random Line generator, 1st line is picked most
@lineDestiny=(1, 1, 1, 1, 2, 2, 2, 3, 3, 4);
$line=$lineDestiny[int(rand @lineDestiny)-1];
#Random assist generator, 1 assist is picked most
#0=unassisted, 1=1 assist, 2=2assists
@assistsDestiny=(0, 1, 2, 2, 2, 2, 1);
$assist=$assistsDestiny[int(rand @assistsDestiny)-1];
#Make an array of potential scorers on the same line
@scorer_array=();
@member=();
for($i=0; $i<(@t-2); $i++){
$this=$t[$i];
@member = split(/,/,$this);
$m=$member[9]; chomp $m;
if($m eq $line){
$scorer_array[@scorer_array] =
join (',', @member);
}
}
#Make a hash and fill with players
%players=();
foreach $eachScorer (@scorer_array){
@points=split(/,/, $eachScorer);
$players{$points[0]}=$points[2];
}
#Call up destiny which sorts and returns a player.
$scorer=destiny(%players);
#Check for asists then return scorers
@scorers=();
if($assist==0){ # If no assists then set scorers
# to 1 player unassisted in the
# position of the array to be
# returned
$scorers[0]=$scorer;
$scorers[1]="unassisted";
}else{ # If there are assists then read in
# the available scorers and choose
# with destiny any player that is not
# the scorer; put that assist person
# into the number 2 spot in the array
# to be returned.
$scorers[0]=$scorer;
%p2=();#EMPTY HASH
foreach $eachScorer (@scorer_array){
@p=split(/,/, $eachScorer);
if($p[0] ne $scorer){
$p2{$p[0]}=$p[2];
}
}
$assist1=destiny(%p2);
$scorers[1]=$assist1;
if($assist==2){# If there are two
# assists than the second if will do
# the same as the previous and put
# that assist person into the 2 spot
# in the array to be returned.
%p3=();
foreach $eachScorer (@scorer_array){
@p4=split(/,/,
$eachScorer);
if($p4[0] ne $scorer &&
$p4[0] ne $assist1){
$p3{$p4[0]}=
$p4[2];
}
}
$assist2=destiny(%p3);
$scorers[2]=$assist2;
}else{
$scorers[2]=" ";
}
}
return @scorers;# This array will contain the
# scorers and the potential
# assist persons
}
##PRINT CLOCK#################################################
# This routine will display the time on the game clock..
#
# INPUT: array[0=period,1=minutes,2=seconds]
# OUTPUT: to the screen the time.
# DEPENDANCIES: none
# SAMPLE CALL: printClock(@currentTime);
#############################################################
sub printClock{
my(@time) = @_;
printf(" %02.0f%s%02.0f", $time[1], ":", $time[2]);
}
##SPECIFIC PENALTY###########################################
# This routine will return a specific penalty randomly
#
# INPUT: none
# OUTPUT: array (penalty string, seconds penalized,
# matching[1or2(3 forunbalanced - like fighting
# instigsate.)])
# DEPENDANCIES: none
# SAMPLE CALL: @penalty=specificPen();
#############################################################
sub specificPen{
##SPECIFIC MINOR#####################################
# This routine will return a string that specifies
# the minor penalty.
#
# INPUT: none
# OUTPUT: string
# DEPEND: none
# SAMPLE CALL: $pen=specificMinor();
#####################################################
sub specificMinor{
$randNum=int(rand 158);
if($randNum <= 25){
return ("High Sticking", 2*60, int(rand 2)+1);
}elsif($randNum <= 50){
return ("Holding", 2*60, int(rand 2)+1);
}elsif($randNum <= 75){
return ("Hooking", 2*60, 1);
}elsif($randNum <= 84){
return ("Cross Checking", 2*60, 1);
}elsif($randNum <= 96){
return ("Roughing", 2*60, int(rand 2)+1);
}elsif($randNum < 105){
return ("Interference", 2*60, 1);
}elsif($randNum <= 115){
return ("Tripping", 2*60, 1);
}elsif($randNum < 120){
return ("Charging", 2*60, 1);
}elsif($randNum <= 123){
return ("Boarding", 2*60, 1);
}elsif($randNum < 126){
return ("Playing with Broken Stick", 2*60, 1);
}elsif($randNum <= 129){
return ("Clipping", 2*60, 1);
}elsif($randNum < 132){
return ("Delay of Game", 2*60, 1);
}elsif($randNum < 135){
return ("To Many Men on the Ice", 2*60, 1);
}elsif($randNum <= 138){
return ("Displacing Goal Post", 2*60, 1);
}elsif($randNum < 148){
return ("Elbowing", 2*60, 1);
}elsif($randNum <= 151){
return ("Keeing", 2*60, 1);
}elsif($randNum < 154){
return ("Hand Pass", 2*60, 1);
}elsif($randNum < 157){
return ("Falling on Puck", 2*60, 1);
}else{
return ("Throwing a Stick", 2*60, 1);
}
}
##SPECIFIC MAJOR#####################################
# This routine will return a string that specifies
# the major penalty.
#
# INPUT: none
# OUTPUT: string
# DEPEND: none
# SAMPLE CALL: $pen=specificMajor();
#####################################################
sub specificMajor{
$randNum=int(rand 87);
if($randNum <= 7){
return ("Boarding", 5*60, 1);
}elsif($randNum <= 13){
return ("Interference", 5*60, 1);
}elsif($randNum <= 22){
return ("Elbowing", 5*60, 1);
}elsif($randNum <= 23){
return ("Butt-Ending", 5*60, 1);
}elsif($randNum <= 31){
return ("Charging", 5*60, 1);
}elsif($randNum < 36){
return ("Checking From Behind", 5*60,
1);
}elsif($randNum <= 46){
return ("Cross-Checking", 5*60, 1);
}elsif($randNum < 48){
return ("Head-Butting", 5*60, 1);
}elsif($randNum <= 63){
return ("Hooking", 5*60, 1);
}elsif($randNum < 67){
return ("Kneeing", 5*60, 1);
}else{
return ("Slashing", 5*60, 1);
}
}
##SPECIFIC DOUBLE MINOR##############################
# This routine will return a string that specifies
# the double minor penalty.
#
# INPUT: none
# OUTPUT: string
# DEPEND: none
# SAMPLE CALL: $pen=specificDM();
#####################################################
sub specificDM{
$randNum=int(rand 80);
if($randNum <= 1){
return ("Butt-Ending", 4*60, 1);
}elsif($randNum <= 4){
return ("Head-Butting", 4*60, 1);
}elsif($randNum <= 54){
return ("Slashing", 4*60, 1);
}else{
return ("Spearing", 4*60, 1);
}
}
##SPECIFIC FIGHTING PENALTY MINUTES##################
# This routine will return a integer that specifies
# the fighting penalty.
#
# INPUT: none
# OUTPUT: integer
# DEPEND: none
# SAMPLE CALL: $minutesPenalized=fightPenMin();
#####################################################
sub fightPenMin{
$randNum=int(rand 100);
if($randNum <= 65){
return 5;
}elsif($randNum <= 85){
return 2;
}else{
return 60;
}
}
##SPECIFIC MISCONDUCT################################
# This routine will return a string that specifies
# the misconduct penalty.
#
# INPUT: none
# OUTPUT: string
# DEPEND: none
# SAMPLE CALL: $pen=specificMisconduct();
#####################################################
sub specificMisconduct{
$randNum=int(rand 157);
if($randNum <= 2){
return ("Charging the Goalie", 10*60,
1);
}elsif($randNum <= 27){
return ("Checking from Behind", 10*60,
1);
}elsif($randNum <= 32){
return ("Head-Butting", 10*60, 1);
}elsif($randNum <= 52){
return ("Hooking", 10*60, 1);
}elsif($randNum <= 57){
return ("Kneeing", 10*60, 1);
}elsif($randNum < 107){
return ("Unsportsmanlike Conduct",
10*60, int(rand 2)+1);
}elsif($randNum <= 132){
return ("Slashing", 10*60, 1);
}else{
return ("Spearing", 10*60, 1);
}
}
##SPECIFIC GAME MISCONDUCT###########################
# This routine will return a string that specifies
# the misconduct penalty.
#
# INPUT: none
# OUTPUT: string
# DEPEND: none
# SAMPLE CALL: $pen=specificGM();
#####################################################
sub specificGM{
$randNum=int(rand 155);
if($randNum <= 25){
return ("Checking from Behind",
60*60, 1);
}elsif($randNum <= 30){
return ("Deliberate Injury",
60*60, 1);
}elsif($randNum <= 35){
return ("Head-Butting", 60*60, 1);
}elsif($randNum <= 50){
return ("Hooking", 60*60, 1);
}elsif($randNum <= 55){
return ("Kicking", 60*60, 1);
}elsif($randNum < 105){
return ("Unsportsmanlike Conduct",
60*60, 1);
}elsif($randNum <= 130){
return ("Slashing", 60*60, 1);
}else{
return ("Spearing", 60*60, 1);
}
}
###############MAIN##################################
# Specify how many seconds in a minute for
# readability
$minutes=60;
# Get a random number that reflects the ratios of
# actual pens. called in the NHL
$randNum=int(rand 166);
# Main algo.
if($randNum <= 100){#MINOR PENALTIES ################
return specificMinor();
}elsif($randNum <= 120){#MAJOR PENALTIES ############
return specificMajor();
}elsif($randNum <= 135){#DOUBLE MINOR PENALTIES #####
return specificDM();
}elsif($randNum <= 150){#FIGHTING PENALTIES #########
$instigator=2;#Usually both go off
$penMin=fightPenMin();#Look for game miscond.
if($penMin > 5){#Sometimes one will get game
#misconduct for instigating
$instigator++;#If so flag!
}
return ("Fighting",
$penMin*$minutes,
$instigator);
}elsif($randNum <= 160){#MISCONDUCT PENALTIES #######
return specificMisconduct();
}elsif($randNum < 165){#GAME MISCONDUCT PENALTIES ###
return specificGM();
}else{#PENALTY SHOT PENALTIES #######################
return ("penaltyShot", 0*$minutes, 1);
}
}
##TEST FOR GAME MISCONDUCT###################################
# This subroutine tests for a pen greater than 10 min and
# prints to the screen the approporiate pre message for the
# game text.
#
# INPUT: int representing the penalty seconds
# OUTPUT: string pre-message for the report
# DEPENDANT: none
# SAMPLE: testGameMis();
#############################################################
sub testGameMis{
my($sec) = @_;
$min=$sec/60;
if($min>10){
return "Game Misconduct for ";
}else{
return "$min:00 for ";
}
}
##CURRENT SECOND#############################################
# This routine will return the current second in the game
# starting at 0 and continuing on till the end of game.
#
# INPUT: array[0=period,1=minutes,2=seconds]
# OUTPUT: $integer (seconds into the game)
# DEPENDANCIES: none
# SAMPLE CALL: $SecondCount=currentSecond(@currentTime);
#############################################################
sub currentSecond{
my(@time) = @_;
return (($time[0]-1)*1200)+($time[1]*60)+$time[2];
}
##UPDATE PENALTY BOX##########################################
# This routine will check the penalty box hash and delete any
# keys that contain expired box inhabitants.
#
# INPUT: $integer that is seconds into the game,
# %hash that is the pen box hash
# OUTPUT: %hash without the expired keys
# DEPENDANCIES: none
# SAMPLE CALL: %penaltyBox=
# updateBox($secondCount,%penaltyBox);
#############################################################
sub updateBox{
my($s,%pb) = @_;
foreach $i (keys %pb){
if($pb{$i}<$s){
delete $pb{$i};
}
}
return %pb;
}
#END SUBROUTINE SECTION##############################################
#####################################################################
########teamsAvailable();##user interface - not needed for testing
#driver teams
#$homeTeam="nyr";
#$awayTeam="nyi";
#Make the game arrays
$homeTeam=getTeam("home");
$awayTeam=getTeam("away");
@home=gameSetUp($homeTeam);
@away=gameSetUp($awayTeam);
#@home=mkGameArray("$homeTeam");
#@away=mkGameArray("$awayTeam");
#Get the goalie save percentages and names.
@homeGoalie=getGoalie(@home);
@awayGoalie=getGoalie(@away);
#Add up the plus/minuses for puck position
$homePlusMinus=getValues(3, 0, 17, @home);
$awayPlusMinus=getValues(3, 0, 17, @away);
#Keep score
$homeGoals=0; $awayGoals=0;
$homeShots=0; $awayShots=0;
#TESTING STUFF
print"\n$homeTeam is $homePlusMinus and $awayTeam is $awayPlusMinus\nNo pp\n";
print"\n@homeGoalie\n@awayGoalie\n\n";
print"\nHOME:\n@home\nAWAY:\n@away\n";
# Main Algorythm
@currentTime=gameClock(1, 0, 5);#start at least 5 seconds into it
#Main Loop
for($i=0; $i<4; $i=$currentTime[0]){
$event=randEvent();
#Set up penalty section
@penalty=specificPen();
$prefix=testGameMis($penalty[1]);
@homePenPerson=whoScored(4, @home);
@awayPenPerson=whoScored(4, @away);
#AWAY ZONE###################################################
if (puckPosition($homePlusMinus, $awayPlusMinus, 0)){
#SCORING OPPORTUNITY#################################
if ($event eq "Scoring Opportunity"){
$homeShots++;
if(!decider($awayGoalie[1])){# not a save.
@scorer=();
@scorer = whoScored(2, @home);
print"Period $currentTime[0] ";
printClock(@currentTime);
print" $homeTeam scores - ";
print"$scorer[0]";
# Assists section####################
if($scorer[1] eq "unassisted"){
print", unassisted\n";
}else{
print", from $scorer[1]";
if($scorer[2] ne " "){
print" and ";
print"$scorer[2]\n";
}else{
print"\n";
}
}
$homeGoals++;
}else{
#print" Save $awayGoalie[0]\n";
}
#PLAY WHISTLED DOWN##################################
}elsif($event eq "Stoppage in play"){
#print"Play whistled down in $awayTeam zone";
#print"!\n";
#PENALTY#############################################
}else{
$penaltyBox{$awayPenPerson[0]}=
currentSecond(@currentTime)+
$penalty[1];
print"Period $currentTime[0] ";
printClock(@currentTime);
print" Penalty against $awayTeam - ";
print"$awayPenPerson[0] ";
if ($penalty[2] == 1){
$penaltyBox{$awayPenPerson[0]}=
currentSecond(@currentTime)+
$penalty[1];
print"$prefix$penalty[0]\n";
}else{
$penaltyBox{$homePenPerson[0]}=
currentSecond(@currentTime)+
$penalty[1];
print"$prefix$penalty[0]\n";
print"Period $currentTime[0] ";
printClock(@currentTime);
print" Penalty against $homeTeam - ";
print"$homePenPerson[0] ";
print"$prefix$penalty[0]\n";
}
}
#HOME ZONE###################################################
}else{
#SCORING OPPORTUNITY#################################
if ($event eq "Scoring Opportunity"){
$awayShots++;
if(!decider($homeGoalie[1])){#not a save
@scorer=();
@scorer = whoScored(2, @away);
print"Period $currentTime[0] ";
printClock(@currentTime);
print" $awayTeam scores - ";
print"$scorer[0]";
# Assists section####################
if($scorer[1] eq "unassisted"){
print", unassisted\n";
}else{
print", from $scorer[1]";
if($scorer[2] ne " "){
print" and ";
print"$scorer[2]\n";
}else{
print"\n";
}
}
$awayGoals++;
}else{
#print" Save $homeGoalie[0]\n";
}
#PLAY WHISTLED DOWN##################################
}elsif($event eq "Stoppage in play"){
#print"Play whistled down in $homeTeam zone!\n";
#PENALTY#############################################
}else{
print"Period $currentTime[0] ";
printClock(@currentTime);
print" Penalty against $homeTeam - ";
print"$homePenPerson[0] ";
if ($penalty[2] == 1){
$penaltyBox{$homePenPerson[0]}=
currentSecond(@currentTime)+
$penalty[1];
print"$prefix$penalty[0]\n";
}else{
$penaltyBox{$awayPenPerson[0]}=
currentSecond(@currentTime)+
$penalty[1];
print"$prefix$penalty[0]\n";
print"Period $currentTime[0] ";
printClock(@currentTime);
print" Penalty against $awayTeam - ";
print"$awayPenPerson[0] ";
print"$prefix$penalty[0]\n";
}
}
}
#UPDATE TIME & PENALTY BOX INHABITANTS#######################
@currentTime=gameClock(@currentTime);
%penaltyBox=updateBox(currentSecond(@currentTime),
%penaltyBox);
}
print"\n$awayTeam - $awayGoals\n$homeTeam - $homeGoals\n";
print"\n$awayTeam shots - $awayShots\n$homeTeam shots - $homeShots\n";
$bogus=<STDIN>;