expt.pl.in,v

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

head	1.14;
access;
symbols
	zero-five-zero:1.14
	zero-four-seventeen:1.13
	zero-four-ten:1.7
	zero-four-nine:1.6
	zero-four-eight:1.6
	zero-four-five:1.2
	zero-four-three:1.1
	zero-four-zero:1.1;
locks
	neto:1.14;
comment	@# @;


1.14
date	2000.09.17.04.25.37;	author neto;	state Exp;
branches;
next	1.13;

1.13
date	98.10.17.19.02.10;	author neto;	state Exp;
branches;
next	1.12;

1.12
date	98.10.17.18.45.32;	author neto;	state Exp;
branches;
next	1.11;

1.11
date	98.10.15.18.11.25;	author neto;	state Exp;
branches;
next	1.10;

1.10
date	98.09.27.00.30.39;	author neto;	state Exp;
branches;
next	1.9;

1.9
date	98.09.27.00.28.41;	author neto;	state Exp;
branches;
next	1.8;

1.8
date	98.08.29.21.34.24;	author neto;	state Exp;
branches;
next	1.7;

1.7
date	98.08.20.20.06.17;	author neto;	state Exp;
branches;
next	1.6;

1.6
date	98.08.14.20.43.24;	author neto;	state Exp;
branches;
next	1.5;

1.5
date	98.08.09.22.38.27;	author neto;	state Exp;
branches;
next	1.4;

1.4
date	98.08.09.22.33.45;	author neto;	state Exp;
branches;
next	1.3;

1.3
date	98.08.09.22.32.54;	author neto;	state Exp;
branches;
next	1.2;

1.2
date	98.08.08.00.05.21;	author neto;	state Exp;
branches;
next	1.1;

1.1
date	98.05.30.16.20.54;	author neto;	state Exp;
branches;
next	;


desc
@Run experiments based on an input script and implied matrix of options.
@


1.14
log
@Make output file readonly
@
text
@#! @@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;
}
@


1.13
log
@This skipping code now works.  I wasn't sensistive to dir or .gz before.
@
text
@d161 1
@


1.12
log
@Skip a run if its output file already exists.
@
text
@d145 1
a145 1
					if ( -e $outname ) {
@


1.11
log
@The program name is now also changeable within the script, to
something other than just "lk".
@
text
@d138 1
a138 1
				foreach $var (@@variations) {
d145 4
@


1.10
log
@Oops.  I forgot to reenable the runing of the experiments..
@
text
@d20 1
d92 2
d119 1
a119 1
		my($file,$n,$always_option,$bound_option,$bound_value,@@ns)=
d131 1
a131 1
			$args = "$lkargs $always_option $bound_option $bound_value $rep ";
d155 1
a155 1
						" | $bindir/lk$var $args -i $iters --seed $seed"
@


1.9
log
@The salted seed wasn't exactly very reproducible in the way I had wanted.
Fixed.
@
text
@d154 2
a155 2
					#system("date >>$outputdir/$script_name.log");
					#system("who >>$outputdir/$script_name.log");
d157 1
a157 1
					#system($sys_str);
@


1.8
log
@Now have consistent seeds based on instance name, perm number, and
user-specified salt.
@
text
@d54 1
a54 1
SCRIPTLINE: while ($line=<SCRIPT>) {
d118 1
a118 1
		my $seed = &seed_from_salt_perm_instance($salt,$perm,$instance);
d154 2
a155 2
					system("date >>$outputdir/$script_name.log");
					system("who >>$outputdir/$script_name.log");
d157 1
a157 1
					system($sys_str);
d183 1
a183 1
sub seed_from_salt_perm_instance 
d185 5
a189 3
	my ($salt,$perm,$inst)=@@_;
	&GB_flip::gb_init_rand(int($salt+hash("$inst:$perm")));
	&GB_flip::gb_next_rand;
@


1.7
log
@Same seed across each perm on an instance line.  Thisi s for more consistency.
@
text
@d11 1
d23 1
d27 4
d91 3
d101 2
d118 1
a118 4
		# Allow at least 1 second for the clock (and hence random
		# seed) seed to advance.  2 plays it safe.
		sleep 2; 
		my $seed = time;	 # Get current time in seconds as seed.
d162 26
@


1.6
log
@Use same seed for all variations, to reduce experimental noise
@
text
@d107 4
d112 1
a112 1
			# Form the preprocess command line, substituting $perm for $p 
a126 4
				# Allow at least 1 second for the clock (and hence random
				# seed) seed to advance.  2 plays it safe.
				sleep 2; 
				my $seed = time;	 # Get current time in seconds as seed.
@


1.5
log
@Added support for precommand, so that we can tell whether it should
run tspreorder.pl.
@
text
@d1 1
a1 1
e! @@PERL@@ -w
d122 5
d128 5
a132 1
					if ( -e "stop" ) { die "expt: stopped";}
d144 1
a144 1
						" | $bindir/lk$var $args -i $iters "
a149 4

					# Allow at least 1 second for LK's automatic random 
					# seed to advance.  2 plays it safe.
					sleep 2; 
@


1.4
log
@I forgot to mention that tspreorder isn't always run now.
@
text
@d1 1
a1 1
#! @@PERL@@ -w
d81 2
@


1.3
log
@Sleep 2 seconds between runs.  This is so time advances so auto seeds
advance.
@
text
@d12 1
@


1.2
log
@New input format.
A requie directive.
@
text
@d22 1
d122 1
d125 8
a132 3
						." | $pre_line "
						." | @@PERL@@ $scriptdir/tspreorder.pl -s $perm"
						." | $bindir/lk$var $args -i $iters "
d138 4
@


1.1
log
@Initial revision
@
text
@d16 1
a16 1
$algprefix = "tsp.";
d53 12
d101 1
a101 1
		my($file,$n,$ioption,@@ns)=
d104 1
a104 1
			# Form the preprocess command line, substuting $perm for $p 
d112 1
a112 1
			$args = "$lkargs $rep "; #lower bounds
a114 1
#print "pre pre iters $iters\n";
a115 1
#print "pre iters $iters\n";
a116 1
#print "post iters $iters\n";
d125 1
a125 1
						." | $bindir/lk$var $args -i $iters $ioption"
d128 1
@