tsp.pm.in,v

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

head	1.4;
access;
symbols
	zero-five-zero:1.4
	zero-four-seventeen:1.4
	zero-four-ten:1.3
	zero-four-nine:1.3
	zero-four-eight:1.3
	zero-four-five:1.3
	zero-four-three:1.2
	zero-four-zero:1.1;
locks
	neto:1.4;
comment	@# @;


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

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

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

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


desc
@Perl class for handling TSPLIB instances.
@


1.4
log
@Allow exponents in coordinates.
@
text
@#! @@PERL@@ -w
# @@configure_input@@

# This is a Perl class encapsulating behaviour for TSPLIB instances.
# (insert reference to TSPLIB)

# This program is Copyright 1997 David Neto.
# It is distributed with the package LK. 
# It is licenced under the terms of the GNU Library General Public License, 
# See the file named COPYING for the details of the LGPL.
# version 2 or later, or under Larry Wall's Artistic License.

package TSP;  # Use cap first name, so it's not a pragma.
require	Exporter;
@@ISA 	= qw(Exporter);
@@EXPORT	= qw(new read write is_geo is_two_d is_explicit cost);

use strict;

my(%two_d_types)=("EUC_2D",2,"CEIL_2D",3);
my(%geo_types)=%two_d_types;
my(%explicit_types)=("EXPLICIT",1);
my(@@edge_types)=("EXPLICIT",1,"EUC_2D",2,"CEIL_2D",3);
sub cost_from_euc2d {
			my ($self) = shift;
		 	my ($u) = shift;
		 	my ($v) = shift;
			$u = int(0+$u);	# Ensure it is an integer
			$v= int(0+$v);	# Ensure it is an integer
			my ($ux) = $$self{'coords'}[$u][0];
			my ($uy) = $$self{'coords'}[$u][1]; 
			my ($vx) = $$self{'coords'}[$v][0];
			my ($vy) = $$self{'coords'}[$v][1];
			my ($dx)= $ux-$vx;
			my ($dy)= $uy-$vy;
			int(0.5+sqrt($dx*$dx+$dy*$dy)); }

sub cost_from_ceil2d {
		 	my ($self) = shift;
		 	my ($u) = shift;
		 	my ($v) = shift;
			$u = int(0+$u);	# Ensure it is an integer
			$v = int(0+$v);	# Ensure it is an integer
			my ($uc)= $$self{'coords'}[$u];
			my ($vc)= $$self{'coords'}[$v];
			my ($dx)= $$uc[0]-$$vc[0];
			my ($dy)= $$uc[1]-$$vc[1];
			my ($d) = sqrt($dx*$dx+$dy*$dy);
			my ($id)= int($d);
			$id < $d ? $id+1 : $id; }
			
sub cost_from_explicit {
			my ($self) = shift;
		 	my ($u) = shift;
		 	my ($v) = shift;
			$u = int(0+$u);	# Ensure it is an integer
			$v = int(0+$v);	# Ensure it is an integer
			if ( $u < $v ) { $$self{'explicit'}[$u][$v]; }
			else { $$self{'explicit'}[$v][$u]; } }

my(%cost_from_type)=(
	"EXPLICIT", \&cost_from_explicit,
	"EUC_2D", \&cost_from_euc2d,
	"CEIL_2D", \&cost_from_ceil2d);

				
my(@@edge_formats)=("LOWER_DIAG_ROW",101,"FULL_MATRIX",102,"UPPER_ROW",103);
my($float_expr)="(-?\\d+\\.?\[0-9\]*(\[eE\]\[+-\]\\d+)?|\\.\[0-9\]+(\[eE\]\[+-\]\\d+)?)";

# Class methods
# Class method new allocates a new TSP object and blesses it into the TSP 
# package (or whatever subclass inherits this).
sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = {};
   bless $self, $class;
   $self->initialize();
   return $self;
}

# Instance methods
# Instance method initialize sets default values for common fields. 
# The instance still needs populating with edge lengths or coordinates.
sub initialize {
	my ($self) = shift;
	$$self{'n'}=0;
	$$self{'name'}="(no name)";
	$$self{'comment'}="(no comment)";
	$$self{'type'}="(no type)";
	$$self{'edge_type'}="(no edge type)";
	$$self{'edge_format'}="(no edge format)";
	$$self{'cost'}= sub { 0 };	# This is the cost function.  It gets set later.
}

sub is_two_d { # Answer whether I am a 2-d geometric instance.
	my $self = shift;
	return $two_d_types{$$self{'edge_type'}};
}

sub is_geo { # Answer whether I am a geometric instance.
	my $self = shift;
#	print STDERR "geo types are: ", keys(%geo_types),"\n";
	return $geo_types{$$self{'edge_type'}};
}

sub is_explicit { # Answer whether I have explicit edge weights.
	my $self = shift;
	return $explicit_types{$$self{'edge_type'}};
}


# cost(u,v)
sub cost { # Compute the distance between u and v.
	my $self = shift;
	my $u = shift;
	my $v = shift;
	my $cost_sub = $$self{'cost'};
	return &$cost_sub($self,$u,$v);
}

# read: fileHandle
# Read the TSPLIB instance from the filehandle and populate myself with it.
sub read {
	my $self = shift;
	my $fh = shift;	# file handle
	my $line;

	# Parse the header
	HEADER: while($line=<$fh>) {
		$_ = $line;
		if (m/^\s*NAME\s*:\s*(.*)/) {
			$$self{'name'}=$1;
		} elsif (m/^\s*COMMENT\s*:\s*(.*)/) {
			$$self{'comment'}=$1;
		} elsif (m/^\s*TYPE\s*:\s*(.*)/) {
			my $str = $1;
			$str =~ m/^TSP$/ 
				|| die "TSP->read: I know TSPLIB files of type TSP, not $1";
			$$self{'type'}=$str;
		} elsif (m/^\s*EDGE_WEIGHT_TYPE\s*:\s*(.*)/) {
			$$self{'edge_type'}=$1;
			$$self{'cost'} = $cost_from_type{$1};
		} elsif (m/^\s*DIMENSION\s*:\s*(.*)/) { # The number of cities
			$$self{'n'}=0+$1;
		} elsif (m/^\s*NODE_COORD_SECTION\s*/) {
			if ( $self->is_geo ) { last HEADER; }
			else { 
				my ($edge_type) = $$self{'edge_type'};
				die "TSP->read: Can't have NODE_COORD_SECTION in $edge_type";
			}
		} else { die "TSP->read: Unrecognized line: $line"; }
	}

	# Parse the body
	SWITCH: {
		&two_d_body_from_handle($self,$fh),
			last SWITCH if (&is_two_d($self));
		&explicit_body_from_handle($self,$fh),
			last SWITCH if (&is_explicit($self));
		die "TSP->Unkown TSPLIB type";
	}

	return $self;
}

# two_d_body_from_handle: fileHandle
# Coordinates are stored in the 'coords' attribute of the object, and is
# 1-based array of references to 2-element arrays of double precision floating
# point numbers.
sub two_d_body_from_handle {
	my $self = shift;
	my $fh = shift;
	my $line;
	my $i=1;		# The array is 1-based, dammit.
	my $n = $$self{'n'};
	my @@coords=();
	LINE: while( $line=<$fh> ) {
		last LINE if ( $i > $n );
		last LINE if ( $line =~ m/^\s*EOF/ );
		if ( $line=~ m/^\s*\d+\s+$float_expr\s+$float_expr/o ) {
			my $float1=$1+0;
			my $float2=$4+0;
			#print "1 $1 2 $2 3 $3 4 $4 5 $5 6 $6\n";
			$coords[$i] = [ $float1, $float2 ];
			#print STDERR "$coords[$i][1]\n";
			$i++;
			#print STDERR ".";
		}
	}
	if ( $i-1 != $$self{'n'} ) { 
		die "Wrong number of coordinates: $i instead of $$self{'n'}";
	}
	$$self{'coords'} = \@@coords;
#print STDERR "coords are $$self{'coords'}\n";
	return $self;
}


# write: fileHandle
# Write the instance in TSPLIB form onto the filehandle.
sub write {
	my $self = shift;
	my $fh = shift;	# file handle

	print $fh "NAME: $$self{'name'}\n";
	print $fh "COMMENT: $$self{'comment'}\n";
	print $fh "TYPE: $$self{'type'}\n";
	print $fh "EDGE_WEIGHT_TYPE: $$self{'edge_type'}\n";
	print $fh "DIMENSION: $$self{'n'}\n";
	if ( &is_two_d($self) ) {
		print $fh "NODE_COORD_SECTION\n";
		my $i;
		for $i (1..$$self{'n'}) {
			my $x = $$self{'coords'}[$i][0];
			my $y = $$self{'coords'}[$i][1];
			print $fh "$i\t$x\t$y\n";
		}
	}
	print $fh "EOF\n";
	
	return $self;
}


# as_Rothberg_on: fileHandle
# Write the instance on the filehandle, but in a format digestible by
# Rothberg's weighted matching code.
# (See ftp://dimacs.rutgers.edu/pub/netflow/benchmarks/c/match_c.shell)
#
sub as_Rothberg_on {
	my $self = shift;
	my $fh = shift;	# file handle

	# There are three output cases: 
	#	E for Euclidean 
	#	U for Undirected (sparse)
	#	M for Matrix (dense)
	# All numbers, including distances, are integers.
	
	# All our instances are dense, so we never use U.
	# We just choose between E and M.
	SWITCH_ROTHBERG: {
		$self->two_d_as_Rothberg_on($fh), 
			last SWITCH_ROTHBERG if ($self->is_geo);
		$self->explicit_as_Rothberg_on($fh), 
			last SWITCH_ROTHBERG if ($self->is_geo);
	}
	return $self;
}

# two_d_as_Rothberg_on: fileHandle
# Write the instance on the filehandle, but in a format digestible by
# Rothberg's weighted matching code, type E.
# (See ftp://dimacs.rutgers.edu/pub/netflow/benchmarks/c/match_c.shell)
# The output is as follows:
# First line: <num-vertices> E
# Then <num-vertices> with coordinates.
# Beware that (I believe) his code always uses the CEIL_2D metric for Euclidean
# instances.
sub two_d_as_Rothberg_on {
	my $self = shift;
	my $fh = shift;	# file handle

	# All numbers, including distances, are integers.
	print $fh "$$self{'n'} E\n";
	my $i;
	foreach $i (1..$$self{'n'}) {
		my ($c)= $$self{'coords'}[$i];
		print "$$c[0] $$c[1]\n";
	}
	return $self;
}


# Add seconds reference to satisfy Perl -w.
1;
@


1.3
log
@Better docs.
@
text
@d68 1
a68 1
my($float_expr)="(-?\\d+\\.?\[0-9\]*|\\.\[0-9\]+)";
d182 4
a185 1
			$coords[$i] = [ ($1+0), ($2+0) ];
@


1.2
log
@I've got cost functions working for EUC2d (and I hope CEIL2d).
Explicit needs reading in.
@
text
@d8 4
a11 3
# It is distributed with the package LK under the terms of the 
# GNU Public License, version 2 or later.
# See the file named COPYING for the details of the license.
d273 1
a273 5
# Add a second reference to satisfy Perl -w.
#my @@foo = @@geo_types;
#my @@bar = @@two_d_types;

# $foo[0] ne $bar[0];  # This is *REALLY* stupid; it's just to get around Perl -w
@


1.1
log
@Initial revision
@
text
@d15 1
a15 1
@@EXPORT	= qw(new read write geo_types two_d_types explicit_types);
d23 43
d92 1
d111 10
d142 1
d162 1
a162 1
	
d179 1
d220 51
@