#! /usr/bin/perl
####################################
#This program, given percentages of the three Chiripa Paste
#Groups in a given surface assemblage, will then compute the
#most likely combination of the three phases that would result
#in the observed frequencies.
#####################################
#First, define the three phase profiles. These may later be edited as desired.
# Late Chiripa...
%LC = (
'1' => '0.68',
'2' => '0.18',
'3' => '0.14'
);
#Middle Chiripa...
%MC = (
'1' => '0.07',
'2' => '0.75',
'3' => '0.18'
);
#And Early Chiripa...
%EC = (
'1' => '0.02',
'2' => '0.27',
'3' => '0.71'
);
&do_one_unit;
&warn_and_exit("\nDone...");
#The following is the master subroutine that loops as long as the user wants
#it to...
sub do_one_unit {
&get_frequencies;
#Now we get down to the meat and potatos...
$permit_error = 0.01;
#displays results with errors <= than this value
$BEST{'error'}=10000;
#sets initial ridiculuously high value for best matches error
print "Matches with error less than or equal to ",$permit_error*100,":\n";
print "LC%\tMC%\tEC%\terror\tLC\tMC\tEC\n";
for $lc_percent (0..100) {
for $mc_percent (0..100-$lc_percent) {
$lc=$lc_percent/100;
$mc=$mc_percent/100;
$ec_percent=100-$lc_percent-$mc_percent;
$ec=$ec_percent/100;
$PROFILE{'1'}=$LC{'1'}*$lc+$MC{'1'}*$mc+$EC{'1'}*$ec;
$PROFILE{'2'}=$LC{'2'}*$lc+$MC{'2'}*$mc+$EC{'2'}*$ec;
$PROFILE{'3'}=$LC{'3'}*$lc+$MC{'3'}*$mc+$EC{'3'}*$ec;
$error1=abs($PROFILE{'1'}-$ASSEM{'1'});
$error2=abs($PROFILE{'2'}-$ASSEM{'2'});
$error3=abs($PROFILE{'3'}-$ASSEM{'3'});
$error = ($error1 + $error2 + $error3)/3;
$error_round = round($error,0.001);
if ($error <= $permit_error) {
$lc_num=round($lc*$all,1);
$mc_num=round($mc*$all,1);
$ec_num=round($ec*$all,1);
print "$lc_percent\t$mc_percent\t$ec_percent\t",
$error_round*100,
"\t$lc_num\t$mc_num\t$ec_num\n";
}
if ($error < $BEST{'error'}) {
$BEST{'error'}=$error_round;
$BEST{'lc_percent'}=$lc_percent;
$BEST{'mc_percent'}=$mc_percent;
$BEST{'ec_percent'}=$ec_percent;
$BEST{'lc_num'}=round($lc*$all,1);
$BEST{'mc_num'}=round($mc*$all,1);
$BEST{'ec_num'}=round($ec*$all,1);
}
}
}
print "\nBest match:\n";
print "LC%\tMC%\tEC%\terror\tLC\tMC\tEC\n";
print "$BEST{'lc_percent'}\t$BEST{'mc_percent'}\t
$BEST{'ec_percent'}\t",$BEST{'error'}*100,"\t$BEST{'lc_num'}\t
$BEST{'mc_num'}\t$BEST{'ec_num'}\n\n";
print "Would you like to process another surface collection unit?
(y/n)";
$reply=<STDIN>;
if ($reply = /y/) {
&do_one_unit;
}
}
sub get_frequencies {
print "\nEnter Paste Group counts in the assemblage to be analyzed:\n";
print "\tPaste Group 1: ";
$first = <STDIN>;
chop $first;
print "\tPaste Group 2: ";
$second = <STDIN>;
chop $second;
print "\tPaste Group 3: ";
$third = <STDIN>;
chop $third;
print "\tAll others: ";
$fourth = <STDIN>;
chop $fourth;
$three = $first + $second + $third;
$all = $three + $fourth;
$ASSEM{'1'}=round($first/$three,0.01);
$ASSEM{'2'}=round($second/$three,0.01);
$ASSEM{'3'}=round($third/$three,0.01);
print "\nSummary of data:\n";
print "\t\tGroup 1\tGroup 2\tGroup 3\tOther\n";
print "Count\t\t$first\t$second\t$third\t$fourth\n";
print "% of Total\t",round($first/$all,0.01),"\t",
round($second/$all,0.01),"\t",round($third/$all,0.01),"\t",
round($fourth/$all,0.01),"\n";
print "% of three\t",round($first/$three,0.01),"\t",
round($second/$three,0.01),"\t",round($third/$three,0.01),"\n\n";
print "Press ENTER to continue\n";
$trash= <STDIN>;
}
sub warn_and_exit {
print "$_[0]\n";
print "Press Enter to Exit\n";
$trash=<STDIN>;
exit (0);
}
sub round {
my $num = $_[0];
my $nearest = $_[1];
if (mod($num,$nearest) >= $nearest/2) {
return $num-mod($num,$nearest)+$nearest;
} else {
return $num-mod($num,$nearest);
}
}
sub mod {
my $num = $_[0];
my $div = $_[1];
my $times = int $num/$div;
return $num-$times*$div;
}