And here is the perl code. Nice and hidden under a spoiler, because it is very large.
$| = 1;
my $PrintForumCode = 0;
my $PrintCSV = 0;
my $PrintLegible = 1;
my @PlayersList =
(
'Cheeetar',
'Nuke9.13',
'Kashyyk',
'bob_smith',
'Alexhans',
'webadict',
'Frelock',
'Masami Phonix',
'Solifuge',
'Beacon80',
'chaoticjosh',
'Pandarsenic',
'Zaithemaster',
'Servant Corps',
'inaluct',
'Archangel'
);
my $PlayersNum = @PlayersList;
#$PlayersNum = 20;
my $MinDoppNum = 2;
my $MinHostile = int($PlayersNum / 4);
### May not use this right now...
my %Races;
$Races{'Human'} = .5;
$Races{'Doppelganger'} = .25;
$Races{'Alien'} = .25;
## Abilities
%TownAbilities;
%DoppAbilities;
%AlienAbilities;
## Town-aligned roles
%TownRoles;
## Dopp aligned
%DoppRoles;
## Aliens
%AlienRoles;
my $RoleFile = 'C:\Documents and Settings\dsevier\My Documents\ParanormalRoles.csv';
open RIN, "< $RoleFile" or die "Cannot open $RoleFile";
while(<RIN>)
{
my $line = $_;
chomp $line;
## 0=Name 1=Type 2=Faction 3=Max 4=Weight 5=Psychic 6=Goal
my @Data = split(",", $line);
if ($Data[0] eq "name") { next(); }
if ($Data[1] eq "ability")
{
if ($Data[2] eq "town")
{
$TownAbilities{$Data[0]}{'Max'} = $Data[3];
$TownAbilities{$Data[0]}{'Current'} = 0;
$TownAbilities{$Data[0]}{'Weight'} = $Data[4];
}
elsif ($Data[2] eq "dopp")
{
$DoppAbilities{$Data[0]}{'Max'} = $Data[3];
$DoppAbilities{$Data[0]}{'Current'} = 0;
$DoppAbilities{$Data[0]}{'Weight'} = $Data[4];
}
elsif ($Data[2] eq "alien")
{
$AlienAbilities{$Data[0]}{'Max'} = $Data[3];
$AlienAbilities{$Data[0]}{'Current'} = 0;
$AlienAbilities{$Data[0]}{'Weight'} = $Data[4];
}
else
{
warn "Unknown Faction $Data[2]\n";
}
}
elsif ($Data[1] eq "role")
{
if ($Data[2] eq "town")
{
$TownRoles{$Data[0]}{'Max'} = $Data[3];
$TownRoles{$Data[0]}{'Current'} = 0;
$TownRoles{$Data[0]}{'Weight'} = $Data[4];
$TownRoles{$Data[0]}{'Psychic'} = $Data[5];
$TownRoles{$Data[0]}{'Goal'} = $Data[6];
}
elsif ($Data[2] eq "dopp")
{
$DoppRoles{$Data[0]}{'Max'} = $Data[3];
$DoppRoles{$Data[0]}{'Current'} = 0;
$DoppRoles{$Data[0]}{'Weight'} = $Data[4];
$DoppRoles{$Data[0]}{'Psychic'} = $Data[5];
$DoppRoles{$Data[0]}{'Goal'} = $Data[6];
}
elsif ($Data[2] eq "alien")
{
$AlienRoles{$Data[0]}{'Max'} = $Data[3];
$AlienRoles{$Data[0]}{'Current'} = 0;
$AlienRoles{$Data[0]}{'Weight'} = $Data[4];
$AlienRoles{$Data[0]}{'Psychic'} = $Data[5];
$AlienRoles{$Data[0]}{'Goal'} = $Data[6];
}
else
{
warn "Unknown Faction $Data[2]\n";
}
}
else
{
warn "Unknown type $Data[1]\n";
}
}
close RIN;
my $AlienPct = int(rand(20) + 1) / 100;
my $AlienNum = int($PlayersNum * $AlienPct);
if ($AlienNum > keys(%AlienRoles)) { $AlienNum = keys(%AlienRoles); }
my $HumansNum = $PlayersNum - $MinHostile - $AlienNum;
print "There are $PlayersNum players, $MinHostile of which are Doppelgangers and at most $AlienNum are aliens ($AlienPct)\n";
# $PlayerInfo{Player}
# $PlayerInfo{Player}{Race}
# $PlayerInfo{Player}{Role}
# $PlayerInfo{Player}{Goal}
# $PlayerInfo{Player}{Ability}
my %PlayerInfo;
## Track dopp stuff
$Dopps = 0;
## Track alien stuff
$Aliens = 0;
## Track Human stuff
$Humans = 0;
## First run, set roles for everyone. Tries to keep balance, but the last few may not
$GameBalance = 0;
for (my $p = 0; $p < $PlayersNum; $p++)
{
my $Race = GetRace();
print "$p Race = $Race\n";
my $Role = GetRole($Race);
print "$p Role = $Role\n";
my $Goal = GetGoal($Race,$Role);
print "$p Goal = $Goal\n";
print " Game Balance is now: $GameBalance\n";
$PlayerInfo{$PlayersList[$p]}{'Race'} = $Race;
$PlayerInfo{$PlayersList[$p]}{'Role'} = $Role;
$PlayerInfo{$PlayersList[$p]}{'Goal'} = $Goal;
$PlayerInfo{$PlayersList[$p]}{'Ability'} = 'None';
}
## Second run, balance things out
print "----------------------------------------------\n";
## First, we'll try adding in a Mind Shield (or other ability) to one side or another (or to aliens)
for (my $p = 0; $p < $PlayersNum; $p++)
{
if ( int($GameBalance) == 0) { print "Abilities: Balance is close enough to 0\n"; last(); }
my $Race = $PlayerInfo{$PlayersList[$p]}{'Race'};
my $Role = $PlayerInfo{$PlayersList[$p]}{'Role'};
$PlayerInfo{$PlayersList[$p]}{'Ability'} = &GetAbility($Race, $Role);
}
print "Abilities: Game Balance is now: $GameBalance\n";
## Now we'll try rebalancing roles
my $BalanceOk = 0;
my $BalanceLoop = 0;
while ($BalanceOk == 0)
{
$BalanceLoop++;
for (my $p = 0; $p < $PlayersNum; $p++)
{
$Race = $PlayerInfo{$PlayersList[$p]}{'Race'};
if ( int($GameBalance) == 0) { print "Second Pass: Balance is close enough to 0\n"; last(); }
if ( $PlayerInfo{$PlayersList[$p]}{'Race'} ne "Alien" )
{
my $CurrentRole = $PlayerInfo{$PlayersList[$p]}{'Role'};
my $NewRole = &GetNewRole($CurrentRole, $Race);
$PlayerInfo{$PlayersList[$p]}{'Role'} = $NewRole;
print "$p OldRole = $CurrentRole NewRole = $NewRole\n";
print " Game Balance is now: $GameBalance\n";
}
}
if ( int($GameBalance) == 0 or $BalanceLoop == 30 ) { $BalanceOk = 1; }
}
## Now, enforce that there must be a human Agent for the Agent Seeker Alien to find
if ( $AlienRoles{'Agent Seeker'}{'Current'} )
{
if ( ! $TownRoles{'Agent'}{'Current'} )
{
print "**Enforcing Agent existance for the Agent Seeker to find\n";
my $BestHuman = 0;
my $BestDiff = 0;
my $AgentPlaced = 0;
for (my $p = 0; $p < $PlayersNum; $p++)
{
if ($PlayerInfo{$PlayersList[$p]}{'Race'} eq "Human")
{
my $CurrentRole = $PlayerInfo{$PlayersList[$p]}{'Role'};
my $Diff = $TownRoles{'Agent'}{'Weight'} - $TownRoles{$CurrentRole}{'Weight'};
if ( $Diff <= $BestDiff )
{
$BestHuman = $p;
$BestDiff = $Diff;
}
if ( &BalancesPower($TownRoles{'TownAgent'}{'Weight'},$TownRoles{$CurrentRole}{'Weight'}) )
{
$TownRoles{$CurrentRole}{'Current'}--;
$TownRoles{'Agent'}{'Current'}++;
$GameBalance-=$TownRoles{$CurrentRole}{'Weight'};
$GameBalance+=$TownRoles{'Agent'}{'Weight'};
$PlayerInfo{$PlayersList[$p]}{'Role'} = 'Agent';
$AgentPlaced++;
print " switching $p from $CurrentRole to Agent\n";
}
}
}
if ( ! $AgentPlaced)
{
my $LastRole = $PlayerInfo{$PlayersList[$BestHuman]}{'Role'};
print " Forcing switch of $BestHuman from $LastRole to Agent\n";
$TownRoles{$LastRole}{'Current'}--;
$TownRoles{'Agent'}{'Current'}++;
$GameBalance-=$TownRoles{$LastRole}{'Weight'};
$GameBalance+=$TownRoles{'Agent'}{'Weight'};
$PlayerInfo{$PlayersList[$BestHuman]}{'Role'} = 'Agent';
}
print " Game balance is now: $GameBalance\n";
}
}
###### Print Output ########
if ( $PrintForumCode )
{
print "\n";
print '[table]' . "\n";
print '[tr]' . "\n";
print '[td][b]Player[/b][/td]';
print '[td][b]Race[/b][/td]';
print '[td][b]Role[/b][/td]';
print '[td][b]Goal[/b][/td]' . "\n";
print '[td][b]Ability[/b][/td]' . "\n";
print '[/tr]' . "\n";
foreach my $Player ( sort keys %PlayerInfo )
{
#print "$Player,$PlayerInfo{$Player}{'Race'},$PlayerInfo{$Player}{'Role'},$PlayerInfo{$Player}{'Goal'}\n";
print '[tr]' . "\n";
print '[td]' . $Player . '[/td]';
print '[td]' . $PlayerInfo{$Player}{'Race'} . '[/td]';
print '[td]' . $PlayerInfo{$Player}{'Role'} . '[/td]';
print '[td]' . $PlayerInfo{$Player}{'Goal'} . '[/td]' . "\n";
print '[td]' . $PlayerInfo{$Player}{'Ability'} . '[/td]' . "\n";
print '[/tr]' . "\n";
}
print "[/table]\n";
}
if ($PrintCSV)
{
print "\n";
print "Player,Race,Role,Goal,Ability\n";
foreach my $Player ( sort keys %PlayerInfo )
{
print "$Player,$PlayerInfo{$Player}{'Race'},$PlayerInfo{$Player}{'Role'},$PlayerInfo{$Player}{'Goal'},$PlayerInfo{$Player}{'Ability'}\n";
}
}
if ( $PrintLegible )
{
print "\nThere are $PlayersNum players, $MinHostile of which are Doppelgangers and at most $AlienNum are aliens ($AlienPct)\n";
print "\n";
foreach my $Player ( sort keys %PlayerInfo )
{
print "$Player ($PlayerInfo{$Player}{'Race'})\n";
if ($PlayerInfo{$Player}{'Role'} ne "None" ) { print " $PlayerInfo{$Player}{'Role'}\n"; }
if ($PlayerInfo{$Player}{'Race'} eq "Alien" ) { print " $PlayerInfo{$Player}{'Goal'}\n"; }
if ($PlayerInfo{$Player}{'Ability'} ne 'None') { print " $PlayerInfo{$Player}{'Ability'}\n"; }
}
}
exit();
########################################################################
sub GetRace
{
my $RaceOk = 0;
my $Race;
while (! $RaceOk)
{
my $RaceRoll = int(rand(8) + 1);
if ($RaceRoll <= 2)
{
$Race = 'Doppelganger';
if ( ($Dopps +1) <= $MinHostile)
{
$Dopps++;
$RaceOk = 1;
}
}
elsif ($RaceRoll == 3)
{
$Race = 'Alien';
if ( ($Aliens +1) <= $AlienNum)
{
$Aliens++;
$RaceOk = 1;
}
}
else
{
$Race = 'Human';
if ( ($Humans +1) <= $HumansNum)
{
$Humans++;
$RaceOk = 1;
}
}
}
return $Race;
}
## ---------------------------
sub GetRole
{
my $Race = shift;
my $Role = "None";
if ($Race eq "Doppelganger")
{
my $RoleOk = 0;
my $Checks = 0;
$Role = 'Doppelganger';
my $LastOkRole = 'Doppelganger';
while ($RoleOk == 0)
{
$Checks++;
my @Roles = keys(%DoppRoles);
my $CheckRole = $Roles[rand @Roles];
if ($DoppRoles{$CheckRole}{'Current'} < $DoppRoles{$CheckRole}{'Max'})
{
$Role = $CheckRole;
$GameBalance+=$DoppRoles{$Role}{'Weight'};
$RoleOk = 1;
$DoppRoles{$CheckRole}{'Current'}++;
# if ( int($GameBalance) == 0 or &BalancesPower($DoppRoles{$CheckRole}{'Weight'},$DoppRoles{$LastOkRole}{'Weight'}) )
# {
# $RoleOk = 1;
# $DoppRoles{$CheckRole}{'Current'}++;
# $Role = $CheckRole;
# $GameBalance+=$DoppRoles{$Role}{'Weight'};
# }
}
if ( $Checks > 10 )
{
if ( $RoleOk != 1 )
{
$RoleOk = 1;
$GameBalance+=$DoppRoles{$Role}{'Weight'};
print "DEBUG: Checks got to $Checks\n";
}
}
}
}
elsif ($Race eq "Alien")
{
my $RoleOk = 0;
while ($RoleOk == 0)
{
my @Roles = keys(%AlienRoles);
my $CheckRole = $Roles[rand @Roles];
if ($AlienRoles{$CheckRole}{'Current'} < $AlienRoles{$CheckRole}{'Max'})
{
$RoleOk = 1;
$AlienRoles{$CheckRole}{'Current'}++;
$Role = $CheckRole;
$GameBalance+=$AlienRoles{$Role}{'Weight'};
}
}
}
else
{
my $RoleOk = 0;
$Role = 'Townsperson';
my $LastOkRole = 'Townsperson';
my $Checks = 0;
while ($RoleOk == 0)
{
$Checks++;
my @Roles = keys(%TownRoles);
my $CheckRole = $Roles[rand @Roles];
if ($TownRoles{$CheckRole}{'Current'} < $TownRoles{$CheckRole}{'Max'})
{
$TownRoles{$CheckRole}{'Current'}++;
$Role = $CheckRole;
$GameBalance+=$TownRoles{$Role}{'Weight'};
$RoleOk = 1;
# if ( int($GameBalance) == 0 or &BalancesPower($TownRoles{$CheckRole}{'Weight'},$TownRoles{$LastOkRole}{'Weight'}) )
# {
# $RoleOk = 1;
# $TownRoles{$CheckRole}{'Current'}++;
# $Role = $CheckRole;
# $GameBalance+=$TownRoles{$Role}{'Weight'};
# }
}
if ( $Checks > 10 )
{
if ( $RoleOk != 1 )
{
$RoleOk = 1;
$GameBalance+=$TownRoles{$Role}{'Weight'};
print "DEBUG: Checks got to $Checks\n";
}
}
}
}
return $Role;
}
##-------------------------
sub GetNewRole
{
my $OldRole = shift;
my $Race = shift;
my $Role = $OldRole;
if ($Race eq "Doppelganger")
{
my $RoleOk = 0;
my $Checks = 0;
my $LastOkRole = $OldRole;
$GameBalance-=$DoppRoles{$OldRole}{'Weight'};
$DoppRoles{$OldRole}{'Current'}--;
while ($RoleOk == 0)
{
$Checks++;
my @Roles = keys(%DoppRoles);
my $CheckRole = $Roles[rand @Roles];
print " debug: CR = $CheckRole\n";
if ($DoppRoles{$CheckRole}{'Current'} < $DoppRoles{$CheckRole}{'Max'})
{
if ( &BalancesPower($DoppRoles{$CheckRole}{'Weight'},$DoppRoles{$LastOkRole}{'Weight'}) )
{
$RoleOk = 1;
$DoppRoles{$CheckRole}{'Current'}++;
$Role = $CheckRole;
$GameBalance+=$DoppRoles{$Role}{'Weight'};
}
}
if ( $Checks > 30 )
{
if ( $RoleOk != 1 )
{
$RoleOk = 1;
$GameBalance+=$DoppRoles{$Role}{'Weight'};
$DoppRoles{$Role}{'Current'}++;
print "DEBUG: Checks got to $Checks\n";
}
}
}
}
else
{
my $RoleOk = 0;
my $LastOkRole = $OldRole;
$GameBalance-=$TownRoles{$OldRole}{'Weight'};
$TownRoles{$OldRole}{'Current'}--;
my $Checks = 0;
while ($RoleOk == 0)
{
$Checks++;
my @Roles = keys(%TownRoles);
my $CheckRole = $Roles[rand @Roles];
print " debug: CR = $CheckRole\n";
if ($TownRoles{$CheckRole}{'Current'} < $TownRoles{$CheckRole}{'Max'})
{
if ( &BalancesPower($TownRoles{$CheckRole}{'Weight'},$TownRoles{$LastOkRole}{'Weight'}) )
{
$RoleOk = 1;
$TownRoles{$CheckRole}{'Current'}++;
$Role = $CheckRole;
$GameBalance+=$TownRoles{$Role}{'Weight'};
}
}
if ( $Checks > 30 )
{
if ( $RoleOk != 1 )
{
$RoleOk = 1;
$GameBalance+=$TownRoles{$Role}{'Weight'};
$TownRoles{$Role}{'Current'}++;
print "DEBUG: Checks got to $Checks\n";
}
}
}
}
return $Role;
}
##----------------------------
sub GetGoal
{
my $Race = shift;
my $Role = shift;
if ($Race eq "Doppelganger")
{
$Goal = "Town Loses";
}
elsif ($Race eq "Alien")
{
$Goal = $AlienRoles{$Role}{'Goal'};
}
else
{
$Goal = "Town Wins";
}
return $Goal;
}
#-----------------------
sub GetAbility
{
my $Race = shift;
my $Role = shift;
my $Psychic;
my $NewBalance;
my $Ability = 'None';
if ($Race eq "Human")
{
$Psychic = $TownRoles{$Role}{'Psychic'};
print " debug: $Role is psychic ( $Psychic )\n";
if ($Psychic) { return $Ability; }
else
{
my @Abilities = keys(%TownAbilities);
my $AbilityNum = @Abilities;
my $CheckAbility = $Abilities[rand $AbilityNum];
if ( $TownAbilities{$CheckAbility}{'Current'} < $TownAbilities{$CheckAbility}{'Max'} )
{
if ( &BalancesPower($TownAbilities{$CheckAbility}{'Weight'}, 0) )
{
$TownAbilities{$CheckAbility}{'Current'}++;
$Ability = $CheckAbility;
$GameBalance+=$TownAbilities{$CheckAbility}{'Weight'};
}
}
}
}
elsif($Race eq "Doppelganger")
{
$Psychic = $DoppRoles{$Role}{'Psychic'};
print " debug: $Role is psychic ( $Psychic )\n";
if ($Psychic) { return $Ability; }
else
{
my @Abilities = keys(%DoppAbilities);
my $AbilityNum = @Abilities;
my $CheckAbility = $Abilities[rand $AbilityNum];
if ( $DoppAbilities{$CheckAbility}{'Current'} < $DoppAbilities{$CheckAbility}{'Max'} )
{
if ( &BalancesPower($DoppAbilities{$CheckAbility}{'Weight'}, 0) )
{
$DoppAbilities{$CheckAbility}{'Current'}++;
$Ability = $CheckAbility;
$GameBalance+=$DoppAbilities{$CheckAbility}{'Weight'};
}
}
}
}
else
{
$Psychic = $AlienRoles{$Role}{'Psychic'};
print " debug: $Role is psychic ( $Psychic )\n";
if ($Psychic) { return $Ability; }
else
{
my @Abilities = keys(%AlienAbilities);
my $AbilityNum = @Abilities;
my $CheckAbility = $Abilities[rand $AbilityNum];
if ( $AlienAbilities{$CheckAbility}{'Current'} < $AlienAbilities{$CheckAbility}{'Max'} )
{
if ( &BalancesPower($AlienRoles{$Role}{'Weight'}, 0) )
{
$AlienAbilities{$CheckAbility}{'Current'}++;
$Ability = $CheckAbility;
$GameBalance+=$AlienRoles{$Role}{'Weight'};
}
}
}
}
return $Ability;
}
#-----------------------
sub Round
{
my $Number = shift;
return int($Number + .5);
}
#-----------------------
sub BalancesPower
{
my $PowerOne = shift;
my $PowerTwo = shift;
my $ChangeOne = $GameBalance + $PowerOne;
my $ChangeTwo = $GameBalance + $PowerTwo;
if ( abs($ChangeOne) <= abs($ChangeTwo) )
{
return 1;
}
else
{
return 0;
}
}