expt.pl.in

Lin-Kernighan heuristic for the TSP and minimum weight perfect matching

#! @PERL@ -w
# @configure_input@
#
# expt.pl
# Run experiments.
# Different but similar to lkdoit.  Alas...
#


use FileHandle;
require GB_flip;# random number generator.


@variations = (".deg",".no_d");
@permutations = ();
@preprocess = ();
@instances = ();
$algprefix = "";		# tsp. or wpm.
$bindir = "../src/";
$program = "lk";
$scriptdir = "../script/";
$inputdir = "../data";
$outputdir = "../expt/";
$salt = time;
$lkargs = "-S dsort -v 50 --maxdepth 50 -c nn 20";
$pre_cmd = undef;  # Example:  "perl ../script/tspreorder.pl -s %p";

# Preload inverse char lookup.
my %invchr=();
foreach $i (0..255) { $invchr{chr $i}=$i; }  # chr is in Perl5.

# Find out which experiment script to run.  Default is "expt"
$script_name = "expt";
#print "# = $#ARGV\n";
#print "\@ARGV = ", @ARGV,"\n";
#print "$ARGV[0] = ", $ARGV[0],"\n";
#exit 0;
if ( $#ARGV >= 0 ) { $script_name = $ARGV[0]; }

# Open an output log, based on the input script name.
open(EXPTLOG,">>$script_name.log");
autoflush EXPTLOG 1;

# Read in the script.
#$script_preprocess = 
#		 "sed -e 's/#.*//' $script_name"	# Remove comments
#		."| sed -e 's/[ ]*\$//'"			# Remove trailing spaces
#		."| grep -v '^\$' |";				# Remove empty lines
#print "script preproces\n\t$script_preprocess\n";
open(SCRIPT, "<$script_name")
	|| die "Can't find file $script_name";

#print "opened script\n";

SCRIPTLINE: while (defined($line=<SCRIPT>)) {
	print EXPTLOG $line;
	$line =~ s/#.*//;	# Remove comments.
	$line =~ s/\s*$//;	# Remove trailing whitespace
	next SCRIPTLINE if $line =~ m/^$/;  # Empty lines are skipped.
	if ( $line=~ m/^\s*instance\s+(.*)/) {
		push(@instances,$1);
	} elsif ($line=~ m/\s*require\s+([^\s]*)/) {
		# See if the script requires a later version of expt.pl than I am.
		my @reqd_version = split(/\./,$1);
		my @my_version =  split(/\./,"@VERSION@");
		REQUIRE_COMPONENT: for (;;) {
			my $next_reqd = shift(@reqd_version);
			my $next_mine = shift(@my_version);
			last REQUIRE_COMPONENT if (!defined($next_reqd));
			$next_mine = 0 if ( !defined($next_mine) );
			($next_reqd + 0 <= $next_mine + 0)
				|| die "Script requires version $next_reqd but I'm only version @VERSION@";
		}
	} elsif ($line=~ m/\s*preprocess\s+(.*)/) {
		push(@preprocess,$1);
	} elsif ($line=~ m/\s*permutations\s+(.*)/) {
		@permutations=split(/\s*:\s*/,$1);
	} elsif ($line=~ m/\s*variations\s+(.*)/) {
		@variations=split(/\s*:\s*/,$1);
	} elsif ($line=~ m/\s*bindir\s+(.*)/) {
		$bindir=$1;
	} elsif ($line=~ m/\s*algprefix\s+(.*)/) {
		$algprefix=$1;
	} elsif ($line=~ m/\s*scriptdir\s+(.*)/) {
		$scriptdir=$1;
	} elsif ($line=~ m/\s*inputdir\s+(.*)/) {
		$inputdir=$1;
	} elsif ($line=~ m/\s*precommand\s+(.*)/) {
		$pre_cmd=$1;
	} elsif ($line=~ m/\s*outputdir\s+(.*)/) {
		$outputdir=$1;
	} elsif ($line=~ m/\s*program\s+(.*)/) {
		$program=$1;
	} elsif ($line=~ m/\s*salt\s+(.*)/) {
		if ( $1 =~ m/now/i ) { $salt = time; }
		else { $salt=0+$1; }
	} elsif ($line=~ m/\s*lkargs\s+(.*)/) {
		$lkargs=$1;
	} else {
		die "expt: line not understood: $line";
	}
}

print EXPTLOG "Salt: $salt\n";

# Remove trailing slashes
$bindir   =~s+\/*$++; 
$inputdir =~s+\/*$++; 
$outputdir=~s+\/*$++; 
$scriptdir=~s+\/*$++; 


#print "$bindir\n$inputdir\n$outputdir\n$scriptdir\n";
#print "$lkargs\n";
#exit 0;

foreach $perm (@permutations) {
	foreach $instance (@instances) {
		my($file,$n,$always_option,@ns)=
			split(/\s*:\s*/,$instance);
		my $seed = &seed_from_salt_perm_file($salt,$perm,$file);
		foreach $pre (@preprocess) {
			# Form the preprocess command line, substituting $perm for %p 
			# in the string.
#print EXPTLOG "preprocess line is $pre\n";
			$pre =~ s/%p/$perm/g;
			my($pre_line,$pre_early_suffix,$pre_late_suffix)=split(/\s*:\s*/,$pre);

			# Form the arguments to lk.
			$rep = $n > 1000 ? "-r two-level" : "-r array";
			$args = "$lkargs $always_option $rep ";

			foreach $iters (@ns) {
				$iters =~ s/N/$n/g;
				$iters = int(0.5+eval($iters));
				print "expt: $file $args -i $iters\n";

				VARIATION: foreach $var (@variations) {
					if ( -e "stop" ) { 
						my $now = localtime;
						print EXPTLOG "Stopped at $now\n\n\n";
						die "expt: stopped";
					}
	$outname="out.$algprefix$file.$pre_early_suffix.i$iters.$pre_late_suffix.$perm$var";
					if ( -e "$outputdir/$outname.gz" ) {
						print EXPTLOG "Skipping $outname; file exists\n";
						next VARIATION;
					}
					# Build the command line to execute.
					$sys_str = 
						 "cat $inputdir/$file.tsp "
						." | $pre_line ";
					if ( defined $pre_cmd ) {
						$pc = $pre_cmd;
						$pc =~ s/%p/$perm/g;
						$sys_str .= " | $pc ";
					}
					$sys_str .= 
						" | $bindir/$program$var $args -i $iters --seed $seed"
						." | gzip -c >$outputdir/$outname.gz\n";
					chmod 0444, "$outputdir/$outname.gz";
					system("date >>$outputdir/$script_name.log");
					system("who >>$outputdir/$script_name.log");
					print EXPTLOG $sys_str;
					system($sys_str);
				}
			}
		}
	}
}

exit 0;

sub hash 
{ 
	my $str=shift;
	if  ( !defined($str) ) { $str = "foobar" };
	my $ch;
	my $c1 = 52845;  #Adobe type 1 font "encryption" constants...
	my $c2 = 22719;  # But not the "encryption" algorithm.
	my $val=0;
	foreach $ch ( split(//,$str) ) {
		$val = $val ^ $invchr{$ch};
		$val = int($val * $c1 + $c2);
	}
	int $val;
}

# Answer an integer that is basically random.  Sort of. 
# But easily reproducible from within the script.
sub seed_from_salt_perm_file
{
	my ($salt,$perm,$file)=@_;
	&GB_flip::gb_init_rand(int($salt+hash("$file:$perm")));
	my $ret=&GB_flip::gb_next_rand;
#	print "expt: salt |$salt| perm |perm| file |$file| seed $ret\n";
	$ret;
}