#! /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.
#####################################

use Tk;

#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'
       );

$mw=MainWindow->new;
$mw->title("Phasing Hack");
$mw->configure(-background=>white);
#$mw->geometry('649x480');
$f=$mw->Frame(-background=>white)->pack(-side=>"top", -fill=>'x', -pady=>5);
$l1=$f->Label(-text=>"Paste Group 1",
	      -background=>white)->pack(-side=>'left', -expand => 1);
$e1=$f->Entry(-width=>4,
	      -textvariable=>\$first,
	      -background=>white)->pack(-side=>'left', -expand => 1);
$l2=$f->Label(-text=>"Paste Group 2",
	      -background=>white)->pack(-side=>'left', -expand => 1);
$e2=$f->Entry(-width=>4,
	      -textvariable=>\$second,
	      -background=>white)->pack(-side=>'left', -expand => 1);
$l3=$f->Label(-text=>"Paste Group 3",
	      -background=>white)->pack(-side=>'left', -expand => 1);
$e3=$f->Entry(-width=>4,
	      -textvariable=>\$third,
	      -background=>white)->pack(-side=>'left', -expand => 1);
$l4=$f->Label(-text=>"Other Pastes",
	      -background=>white)->pack(-side=>'left', -expand => 1);
$e4=$f->Entry(-width=>4,
	      -textvariable=>\$fourth,
	      -background=>white)->pack(-side=>'left', -expand => 1);
$f2=$mw->Frame(-background=>white, 
	       -height=>30)->pack(-side=>top, -fill=>x, -pady=>5);
$b1=$f2->Button(-text=>'Analyze', 
		-command=>\&do_one_unit,
		-background=>white)->place(-relx=>0.5, 
					   -rely=>0.5, 
					   -width=>75,
					   -anchor=>e);
$b2=$f2->Button(-text=>'Exit', 
		-command=>sub{$mw->destroy},
		-background=>white)->place(-relx=>0.5, 
					   -rely=>0.5,
					   -width=>75,
					   -anchor=>w);
$info="Please enter assemblage profile to be analyzed";
$mw->Label(-textvariable => \$info, 
	   -relief=>'ridge')->pack(-side=>"bottom", -fill=>'x');
$t2=$mw->Text(-height=>8,
	      -width=>40,
	      -background=>white,
	      -takefocus => 0)->pack(-side=>'bottom', -fill=>'x');
#$t2->tagConfigure('bold', 
#		  -font=>'-*-courier-bold-*-normal-*-12-*-*-*-*-*-*-*');
$t1=$mw->Scrolled("Text",
		  -height=>25,
		  -width=>40,
		  -background=>white,
		  -takefocus => 0,
		  -scrollbars=>e)->pack(-side=>'bottom', -fill=>'both', -expand=>1);
$t1->Subwidget("yscrollbar")->configure(-background=>white,
					-activebackground=>white,
					-troughcolor=>white,
					-borderwidth=>1,
					-takefocus=>0);
#$t1->tagConfigure('bold', 
#		  -font=>'-*-courier-bold-*-normal-*-12-*-*-*-*-*-*-*');
#$t1->tagConfigure('bu', 
#		  -font=>'-*-courier-bold-*-normal-*-12-*-*-*-*-*-*-*',
#		  -underline => 1);
MainLoop;
exit;

sub do_one_unit {
    $info="Calculating....";
    $t1->delete('1.0', 'end');
    $t2->delete('1.0', 'end');
    $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);
    $t1->insert('end',"\nSummary of data:\n", 'bold');
    $t1->insert('end',"\t\tGroup 1\tGroup 2\tGroup 3\tOther\n");
    $t1->insert('end',"Count\t\t$first\t$second\t$third\t$fourth\n");
    $t1->insert('end',"% 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");
    $t1->insert('end',"% of three\t" . round($first/$three,0.01) . "\t" . round($second/$three,0.01) . "\t" . round($third/$three,0.01)."\n\n");

    #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

    $t1->insert('end', "Matches with error less than or equal to " . $permit_error*100 . ":\n", 'bold');
    $t1->insert('end', "LC%\tMC%\tEC%\terror\tLC\tMC\tEC\n", 'bu');
    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);
		$t1->insert('end', "$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);
	    }
	}
    }

    $t2->insert('end', "\nBest match:\n", 'bold');
    $t2->insert('end',"LC%\tMC%\tEC%\terror\tLC\tMC\tEC\n");
    $t2->insert('end',"$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");
    $info="Done. Please enter another assemblage profile.";
}

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