#!/usr/sup/gnu/bin/perl -w -- -*- Mode: Perl -*- 

# Copyright (C) 1997 Matz Kindahl. All rights reserved.

# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

# %W%

use strict;
use vars qw($VERSION);
$VERSION = "%R%.%L%%B%";

my(@edges, $edge);
my %M = (RELAX => 0, EDGE => 0); 
my %delta = (0 => 0);
my $zero_edges = 0;
my $constraints = 0;
my $NUM = '\-?\d+';
my $ID = '[a-zA-Z]+';

# Eat all constraints from the file(s). There are several forms allowed.
while (<>) {
    # Case 'X - Y <= C'
    if (/^($ID)\s*-\s*($ID)\s*\<\=\s*($NUM)/o) {
	$constraints++;
	push(@edges, [$2,$1,$3]);
	$delta{$1} = $delta{$2} = 0;
    }
    # Cases 'C - X <= D' and '-X <= D'
    elsif (/^(?:($NUM))?\s*-\s*($ID)\s*\<\=\s*($NUM)/o) {
	$constraints++;
	push(@edges, [$2,0,$3 - (defined $1 ? +$1 : 0)]);
	++$zero_edges;
	$delta{$2} = 0;
    }
    # Cases 'X - C <= D' and 'X <= D'
    elsif (/^($ID)\s*(?:-\s*($NUM)\s*)?\<\=\s*($NUM)/o) {
	$constraints++;
	push(@edges, [0,$1,$3 + (defined $2 ? +$2 : 0)]);
	++$zero_edges;
	$delta{$1} = 0;
    }
    # Case 'X - Y == C'
    elsif (/^($ID)\s*-\s*($ID)\s*\=\=\s*($NUM)/o) {
	$constraints += 2;
	push(@edges, [$2,$1,$3]);
	push(@edges, [$1,$2,-$3]);
	$delta{$1} = $delta{$2} = 0;
    }
    elsif (/^\S/){
	die "Bad line $.\n";
    }

    # Everything else is a comment, hence ignored.
}

# Print out the variables found.
print "Variables: ", join(', ', grep(/^${ID}$/o, keys %delta)), "\n";

# This loop modifies the delta for every node until either we have
# found a loop (by repeating to many times) or it is stable.
my $counter = keys %delta;
while ($counter-- > 0) {
    my $changes = 0;
    foreach $edge (@edges) {
	my($from,$to,$weight) = @$edge;
	$M{'EDGE'}++;
	if ($delta{$to} > $delta{$from} + $weight) {
	    $delta{$to} = $delta{$from} + $weight;
	    $M{'RELAX'}++;
	    $changes++;
	}
    }
    # No need to repeat the loop if the graph is stable.
    goto NORMALIZE if $changes == 0;
}

# If there are some delta that is "too large", we have found a
# negative loop. This test might be redundant, but I have to think
# about it for a while.
foreach $edge (@edges) {
    my($from,$to,$weight) = @$edge;
    if ($delta{$to} > $delta{$from} + $weight) {
	print "!!!! Not satisfiable !!!!\n";
	goto EXITING;
    }
}

# If we have changed the node denoting 0, modify all variables accordingly.
NORMALIZE: if ($zero_edges > 0 && $delta{0} != 0) {
    foreach (keys %delta) {
        $delta{$_} -= $delta{0};
    }
}

# Print a possible assignment. Add a '+ k' to each variable if the
# assignment is not fixed towards zero.
PRINT: foreach (grep(/^${ID}$/o, keys %delta)) {
    print "$_ = $delta{$_}";
    print " + k" unless $zero_edges > 0;
    print "\n";
}

# print "For debugging: ", map("$_($delta{$_}) ", keys %delta), "\n";

EXITING: {
    print "# of constraints: $constraints\n";
    print "Edges investigated: $M{'EDGE'}\n";
    print "Relaxations made: $M{'RELAX'}\n";
}

__END__

=head1 NAME

diffsolve - Simple program to solve difference constraints.

=head1 SYNOPSIS

    diffsolve I<file>

=head1 DESCRIPTION

This is just a simple implementation of the Bellman-Ford algorithm to
solve difference constraints. There should be a maximum of one
constraint on each line, optionally followed by whitespace and a
comment. A line beginning with a whitespace is considered as a comment
and ignored.

A B<variable> is any sequence of one or more letters (no digits
allowed) while a B<constant> is a sequence of one or more digits
optionally preceded by a minus sign (no floats allowed currently). The
allowable forms for constraints are the following:

I<variable> - I<variable> <= I<constant>

I<variable> - I<variable> == I<constant>

I<variable> - I<constant> <= I<constant>

I<constant> - I<variable> <= I<constant>

I<variable> <= I<constant>

- I<variable> <= I<constant>

The output will consist of a possible assignment, if one exists, plus
some statistics. If the system is not fixed towards zero it is
possible to add a constant value to each variable and still satisfy
the constraints. If that is the case, a `+ k' is printed after each
constant.

=head1 EXAMPLE

Following is a simple example. Note that all lines start with
non-whitespace.

    [ 10:17:39 ] @ Radha $ ./diffsolve
    A - B == -3
    A - C <=  1
    B - D <= -5
    C     <=  8
    E - F <= -5
    F - A <= 10
    E - C <=  2
    C - D <= -1
    D - F <= -2
    F     <= -5
    G - A <= -20
    A - G <=  20
    H - A <=  13
    -H    <=  2
    ^D
    Variables: A, B, C, D, E, F, G, H
    A = -15
    B = -12
    C = -8
    D = -7
    E = -10
    F = -5
    G = -35
    H = -2
    Edges investigated: 75
    Relaxations made: 15

=head1 COPYRIGHT

Copyright (C) 1997 Matz Kindahl. All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.