#! /usr/bin/perl
####################################
#This program will parse a 2-column tab-delimited file, with the columns
#being site and period (phase), and determine percentages of
#occupation continuity between any two given phases. No headers in
#original file, please, and I'm not sure what'll
#happen if it's fed a file not of this strict format, so don't do it.
#####################################
print "Input file must be tab-delimited, and must contain 2 columns: \n";
print "\t1) Site, 2) Period\n";
print "Name or path of input file: ";
$infile=<STDIN>;
chop $infile;
$continue=1;
while ($continue) {
print "\n\t1: Early Formative 1\n";
print "\t2: Early Formative 2\n";
print "\t3: Middle Formative\n";
print "\t4: Late Formative 1\n";
print "\t5: Late Formative 2\n";
print "\t6: Tiwanaku\n";
print "\t7: Early Pacajes\n";
print "\t8: Pacajes-Inka\n";
print "\t9: Late Pacajes\n";
print "Calculate occupation continuity from:";
$phase1=<STDIN>;
chop $phase1;
print "To: ";
$phase2=<STDIN>;
chop $phase2;
if ($phase1==1) {
$phase1=1.1; # Early Formative 1
} elsif ($phase1==2) {
$phase1=1.2; # Early Formative 2
} elsif ($phase1==3) {
$phase1=2.0; # Middle Formative
} elsif ($phase1==4) {
$phase1=3.1; # Late Formative 1
} elsif ($phase1==5) {
$phase1=3.2;# Late Formative 2
} elsif ($phase1==6) {
$phase1=4.0; # Tiwanaku
} elsif ($phase1==7) {
$phase1=5.1; # Early Pacajes
} elsif ($phase1==8) {
$phase1=5.2; # Pacajes-Inka
} elsif ($phase1==9) {
$phase1=5.3; # Late Pacajes
} else {
&warn_and_exit ("Phase not defined.\n");
}
if ($phase2==1) {
$phase2=1.1;
} elsif ($phase2==2) {
$phase2=1.2;
} elsif ($phase2==3) {
$phase2=2.0;
} elsif ($phase2==4) {
$phase2=3.1;
} elsif ($phase2==5) {
$phase2=3.2;
} elsif ($phase2==6) {
$phase2=4.0;
} elsif ($phase2==7) {
$phase2=5.1;
} elsif ($phase2==8) {
$phase2=5.2;
} elsif ($phase2==9) {
$phase2=5.3;
} else {
&warn_and_exit ("Phase not defined.\n");
}
print "\nWorking...\n\n";
undef %SITES;
#Now we take a first pass through the file to build a list of sites with
#occupations in $phase
open (INFILE, "< $infile");
|| &warn_and_exit ("File $infile could not be opened. Aborted.");
while ($line = <INFILE>) {
chop $line;
@data = split /\t/, $line;
if ($data[1]==$phase1) {
$SITES{$data[0]}=0;
}
}
close INFILE;
#Now a second pass to see which have occupations of $phase2...
open (INFILE, "< $infile")
|| &warn_and_exit ("File $infile could not be opened. Aborted.");
$phase2_sites=0;
while ($line = <INFILE>) {
chop $line;
@data = split /\t/, $line;
if ($data[1]==$phase2) {
++$phase2_sites;
}
if (($data[1]==$phase2)&&(exists($SITES{$data[0]}))) {
$SITES{$data[0]}=1;
}
}
close INFILE;
#Now report the results...
$sites=0;
$continuities=0;
foreach $site (keys %SITES) {
++$sites;
if ($SITES{$site}) {
++$continuities;
}
}
print "Results:\n";
print "\tTotal sites with a $phase1 occupation:\t$sites\n";
print "\tTotal sites with a $phase2 occupation:\t$phase2_sites\n";
print "\tSites with both $phase1 and $phase2 occupations:\t$continuities\n";
$percent=&round($continuities*100/$sites,1);
print "\t$percent percent continuity between $phase1 and $phase2\n";
$new_sites=&round(($phase2_sites-$continuities)/$phase2_sites*100,1);
$abandonment=&round(($sites-$continuities)*100/$sites,1);
print "\t$abandonment percent site abandonment rate\n";
print "\t$new_sites percent new site founding rate\n";
print "Would you like another? ";
$answer=<STDIN>;
chop $answer;
if ($answer = /n/) {
$continue=0;
}
}
&warn_and_exit ("Okay. All done.\n");
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;
}
sub warn_and_exit {
print "$_[0]\n";
print "Press Enter to Exit\n";
$trash=<STDIN>;
exit (0);
}