mktable.pl.in

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

#!@PERL@ -w
# @configure_input@
# mktable.pl.in
# Make tables from lk-0.4.16 and onward log files.
# Usage: 
# 	mktable.pl <lower_bound_name> [out.<instance>..i<iters>..*.gz ...]
# One line is produced for each instance name.

use strict;
use Carp;

$| = 1;  # Autoflush.
my $progname="mktable.pl";
my $pkgname = "@PACKAGE@";
my $pkgversion = "@VERSION@";
my @rcs_id = split(/ /,'$Id foo 2.2$');
my $version = $rcs_id[2];
my $version_banner="$progname $version ($pkgname $pkgversion)";

my %lower_bound=(); # Map instance name to lower bound value.

my @kinds=qw(no_d deg);

# Dictionary of results.
	# maps <instance>#<kind>#pct to list of percentage values above 
	#		lower_bound_name, one for each iteration.
	#	Here <kind> is in {deg,no_d}

my %result=();
my %instances=();
my %instance_iters=();
my %prefix_trans=(
	'ben.0\.' => 'uni',
	'ben.1\.' => 'annulus',
	'ben.2\.' => 'arith',
	'ben.3\.' => 'ball',
	'ben.4\.' => 'clusnorm',
	'ben.5\.' => 'cubediam',
	'ben.6\.' => 'cubeedge',
	'ben.7\.' => 'corners',
	'ben.8\.' => 'grid',
	'ben.9\.' => 'normal',
	'ben.10\.' => 'spokes',
);


my $lower_bound_name = "optimal";
my $value_type = 'time';
my @macro=();
$macro[0] = '\linezerom';
$macro[1] = '\lineonem';
$macro[2] = '\linetwom';
$macro[3] = '\linethreem';
my $render_pair_macro = '\renderpair';

my $usage = <<EOT;
$version_banner
Generate TSPLIB instances from one of the 10 Bentley distributions.
$progname [options]
  where options can be:
    -h              : Print this help and exit successfully.
    --help          : Print this help and exit successfully.
    -b <lower_bound_file>
                    : Read lower bounds from <lower_bound_file>, overriding
                      the percentage calculations in the log file.
                      This can be given many times to specify many files.
    -l <lower_bound_name>  : Set lower bound name <lower_bound_name>
    -m <nr> <macroname> : Use TeX <macroname> for <nr> pairs of results.
                    : The TeX macro for <nr> pairs gets 1 + <nr> arguments:
                      the instance name, and the <nr> macros:
                      $render_pair_macro\{LK result,LKcc result,LKcc-LK,LK/LKcc\}
                    : Defaults are 
                        -m 0 \\linezerom
                        -m 1 \\lineonem
                        -m 2 \\linetwom
                        -m 3 \\linethreem
    --macro <nr> <macroname> : Same as -m <nr> <macroname>
    -v <n>          : Set verbose to <n>
    -t <type>       : Set kind of table; <type> in {pct,time}
    --type <type>   : Set kind of table; <type> in {pct,time}
    --verbose <n>   : Set verbose to <n>
    --version       : Print version info, then exit
EOT


# Set the defaults;
my $verbose = 10;
my @lower_bound_file = ();

# Parse the command line options
while ($#ARGV >= 0 && $ARGV[0] =~ m/^-/) {
    my $option = $_ = shift(@ARGV);
    if (m/^-h$/ || m/^--help$/) { print $usage; exit; }
    if (m/^-l$/) { 
		if ( $#ARGV >= 0 ) {
			$lower_bound_name = shift(@ARGV);
			next;
		} else { die "$usage"."Option -l needs a string parameter"; }
	}
    if (m/^-m$/ || m/^--macro$/) {
		if ( $#ARGV >= 1 ) {
			my $nr = int(shift @ARGV);
			my $macroname = shift @ARGV;
			$macro[$nr]=$macroname;
			next;
		} else { die "$usage"."Option -m needs a string parameter"; }
	}
    if (m/^-b$/) {
		if ( $#ARGV >= 0 ) {
			push @lower_bound_file,(shift @ARGV);
			next;
		} else { die "$usage"."Option -b needs a file name argument"; }
	}
    if (m/^-t$/ || m/^--type$/) {
		if ( $#ARGV >= 0 ) {
			my $val = shift @ARGV;
			if ( $val eq 'pct' || $val eq 'time' ) { 
				$value_type = $val; 
				next;
			} else {
				die "$usage"."Option -t needs either 'pct' or 'time' argument";
			}
		} else { die "$usage"."Option -t needs argument of 'pct' or 'time'"; }
	}
    if (m/^-v$/ || m/^--verbose$/) { 
		if ( $#ARGV >= 0 ) {
			my($raw_N)=shift(@ARGV);
			$verbose=int($raw_N);
			next;
		} else { $verbose = 10; }
	}
    if (m/^--version$/) { print "$version_banner\n"; exit; }
    die "$progname: Unknown option $option\n$usage";
}

defined $lower_bound_name || die "$usage\nNo lower bound name specified.\n";

# print "lower bound files are: ".join("\n",@lower_bound_file)."\n";
foreach (@lower_bound_file) {
	read_bounds($_);
}

#################################
# Now actually read files, etc.

foreach (@ARGV) {
	my $logfile=$_;
	if (m/^\#/) {
		# Comment lines pass through.
		print "% $_";
	} else {
		read_file($logfile);
	}
}

#foreach $value_type ( qw(pct time) ) {
	foreach ( sort {cmp_instance($a,$b);} (keys %instance_iters) ) {
		my $instance_iter = $_;
		my $n = n_instance($instance_iter);	
		print "\n";
		print "%% $instance_iter, n = $n\n";
		my $instance = $instance_iter; $instance=~s/#.*//;
		summarize($value_type,$instance,$instance_iter);
	}
#}

exit 0;

# Read overriding lower bounds file
sub read_bounds {
	my $file = shift;
print "%%% reading bound file $file\n";
	open BOUNDFILE, "<$file" || die "Couldn't open $file for reading";
	while (<BOUNDFILE>) {
		if (m/^instance ([^:]+):\d+:-l\s+\S+\s+(\d+.?\d*)\s+:/) {
			my $inst = $1;
			my $bound = $2+0;
			$lower_bound{$inst}=$bound;
			print "%%% $inst $bound\n" if $verbose >= 50;
		}
	}
	close BOUNDFILE;
print "%%%closed bound file $file\n";
}

sub canon_name {
	my $name = shift;
	my $prefix;
	foreach $prefix ( keys %prefix_trans ) {
		if ( $name =~ m/^$prefix/ ) {
			return $prefix_trans{$prefix}.substr($name,length($prefix)-2);
		}
	}
	return $name;
}

sub summarize {
	my ($value_type,$instance,$instance_iter) = @_;
	my $kind;
	my $iter;
	my $n = n_instance($instance_iter);
	my %ns = (1=>1,int(0.5+$n/10)=>1,$n=>1);
	my @out = ();
	my $nr = 0;
	push @out, canon_name($instance);
	foreach $iter ( sort { ($a+0) <=> ($b+0)} (keys %ns) ) {
		my @pair=();
		foreach $kind (@kinds) { # first kind is no_d second is deg
			my @list = @{record($instance_iter,$kind,$iter,$value_type)};
			if ( defined @list ) {
				push @pair, (sprintf "%.2f",avg(@list)) if $#list >= 0;
				print " %% $instance_iter $kind $iter $value_type: avg ",
								  " of ",join(' ',@list)," \n"
					if $verbose >= 25;
			}
		}
		if ($#pair >= 1) {
			push @pair,sprintf("%.2f",($pair[1]-$pair[0])); 	# LKcc-LK
			if ( $pair[1] > 0 ) {
				push @pair,sprintf("%.2f",($pair[0]/$pair[1]));		# LK/LKcc
			} else {
				push @pair,'DivZeroNaN';		# LK/LKcc
			}
			push @out,$render_pair_macro."{".join("}{",@pair)."}";
			$nr++;
		}
	}
	print $macro[$nr]."{".join("}{",@out)."}\n" if $nr > 0;
	# print " \\\\ \\hline % $value_type\n";
}

sub avg {
	my @list = @_;
	my $sum = 0;
	foreach (@list) { $sum += $_; }
	if ( $#list < 0 ) { return -999} ;
	return $sum / ($#list + 1);
}

sub n_instance {
	my $inst = shift;
	defined $inst || croak "n_instance: undef'd inst";
	$inst =~ s/#.*//;
	$inst =~ m/(\d+)$/;
	my $n = $1+0;
	if ( $inst=~ m/^infill/ ) { $n *= 1.1; }  # HAck for infill instances.
	return $n;
}

sub cmp_instance { my ($a,$b) = @_;
	my $an = n_instance($a);
	my $bn = n_instance($b);
	return $an <=> $bn unless $an eq $bn;
	return 0 if ($a eq $b);
	return -1 if ($a le $b);
	return 1;
}

sub read_file {
	my $full_file = shift;
	my $file = $full_file; $file=~ s,.*/,,g;
	my $instance;
	my $iters;
	my $kind;
	if ( $file =~ m/^out\.[a-z]{3}\.(.*)\.\.i(\d+)\.\.[0-9]+\.([a-z_]*)\.gz/ ) {
		$instance = $1;
		$iters = $2;
		$kind = $3;
	} else {
		print "Couldn't parse filename $file.  Skipping\n";
		return;
	}
	print STDERR "$progname: Reading file $full_file\n";
	$instances{$instance}=1;
	my $lb_inst=undef;
	$lb_inst = $lower_bound{$instance} if defined $lower_bound{$instance};

	# Increment the count for this instance/iter pair.
	my $instance_iter = "$instance#$iters";
	if ( defined $instance_iters{$instance_iter} ) {
		$instance_iters{$instance_iter} += 1;
	} else {
		$instance_iters{$instance_iter} = 1;
	}
#	return;

	# Now read the file.
	open IN, "gzip -d -c $full_file|" || die "Couldn't open $file for gunzip";
#	my $next_iter = 0;
	print "%%<" if $verbose > 20;
	my $min_pct = 1000000;  # Compute minima on percentages...
	while (<IN>) {
		if (m/^Milestone:Requested:End of LK step (\d+): length\s+(\d+\.?\d+?)\s+(-?\d+.\d+)\% [a-z]+ $lower_bound_name after (\d+\.\d+) .* sec/) {
			my ($iter,$len,$pct,$time) = ($1,$2+0,$3+0,$4+0);
#			$iter == $next_iter || die "Got iter $iter instead of $next_iter";
#			$next_iter++;
			$pct = 100*($len-$lb_inst)/$lb_inst if defined $lb_inst;
			$min_pct = $pct if $pct < $min_pct;
			record($instance_iter,$kind,$iter,'pct',$min_pct);
			record($instance_iter,$kind,$iter,'time',$time);
			print "+" if $verbose >100;
		}
		print "." if $verbose > 200;
	}
	close IN;
	print ">\n" if $verbose > 20;
}

sub record {
	my ($instance_iter,$kind,$iter,$value_type,$value) = @_;
	my $key = "$instance_iter#$kind#$value_type";
	$result{$key} = [] unless defined $result{$key};
	my $aref = $result{$key};
	$$aref[$iter] = [] unless defined $$aref[$iter];
	push @{$$aref[$iter]}, $value if defined $value;  #Can be used for set or get.
	return $$aref[$iter];
}