condense.pl,v

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

head	1.1;
access;
symbols
	zero-five-zero:1.1;
locks
	neto:1.1; strict;
comment	@# @;


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


desc
@Condense multiple experiment lines into one.
@


1.1
log
@Initial revision
@
text
@#! /usr/bin/perl

my $pname = '([a-z]+)\.([0-9]+)\.([0-9]+)';

foreach (@@ARGV) {
	my $file = $_;
	print "Examining file $_\n";
	open IN, "<$file" or die "Couldn't open $file for reading";
	open OUT, ">$file.con" or die "Couldn't open $file.con for writing";
	
	$last_class = "(none)";
	@@al=([],[],[]);
	@@bl=([],[],[]);
	
	LINE: while(<IN>) {
		if (   m/linethreem{$pname}(.*)/ 
			||   m/linetwom{$pname}(.*)/ ) {
			my ($class,$seed,$size,$rest) = ($1,$2,$3,$4);
			my $new_class = "$class.$size";
			#print "gotit $rest\n";
			if (!($new_class eq $last_class)) {
				emit($last_class);
			}
			parse_rp($rest);
			$last_class = "$class.$size";
			print "last class is now $last_class\n";
		} else {
			if ( m/$pname/ ) {
#				print "partial ($1)($2)($3) on $_";
			}
#			print "rejected $_";
		}
	}
	emit($last_class);
}


exit 0;

sub parse_rp {
	my $rp = shift;
	my @@rlist = split(/[{}]+/,$rp);
	shift @@rlist;
	#print "rlist=",join(' ',@@rlist),"\n";
	my ($rp,$a,$b,$d,$q,@@rest) = @@rlist;
	my $i = 0;
	while (defined $q && $rp eq '\renderpair') {
		#print "\t$rp $q\n";
		push @@{$al[$i]},$a;
		push @@{$bl[$i]},$b;
		($rp,$a,$b,$d,$q,@@rest) = @@rest;
		$i++;
	}
}

sub average {
	my @@list = @@_;
#print "Average of ",join(' ',@@list),"\n";
	my $sum=0;
	my $i=0;
	foreach (@@list) {
		#print ",";
		$sum += $_;
		$i++;
	}
	return 'NaN' unless $i>0;
	return $sum/$i;
}

sub emit {
	my $class = shift;
	my $i;
	my @@out = ();
	return if $class eq '(none)';
	#print "al = ",join(' ',@@al),"\n";
	#print "bl = ",join(' ',@@bl),"\n";
	my $columns = 0;
	COLUMNSET: foreach (@@al) {
		my $all = $_;
		my $bll = shift(@@bl);
		#print "CS all = $all --- ".join('|',@@{$all})." !!! \n";
		#print "CS bll = $bll --- @@{$bll} !!! \n";
		my $aa = average(@@{$all});
		my $ba = average(@@{$bll});
		last COLUMNSET if $aa eq 'NaN';
		push @@out, renderpair($aa,$ba,$ba-$aa,($ba>0?($aa/$ba):'NaN'));
		$columns++;
	}
	my @@macro_name = ('\lineonem','\linetwom','\linethreem');
	print OUT $macro_name[$columns-1],"{$class}{",join('}{',@@out),"}\n";
	print $macro_name[$columns-1],"{$class}{",join('}{',@@out),"}\n";
	
	@@al=([],[],[]);
	@@bl=([],[],[]);
}

sub renderpair {
	my @@list = @@_;
	@@list = map { sprintf "%.2f",$_ } @@list;
	return '\renderpair{'.join('}{',@@list).'}'; #}
}
@