#! /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, Sirrah...");

#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;
}