#!/usr/bin/perl -w

=head1 NAME

polyclass - classify single-relation Boolean constraint languages

=head1 SYNOPSIS

    polyclass
    polyclass -s 1020 -r 3 -k 2 >> poly.3,2

=head1 DESCRIPTION

F<polyclass> is a wrapper around F<polyanna> which
enumerates and classifies constraint languages over
{0,1,...,(k-1)} which consist of a single relation of
arity r.  Richard Gault's package F<polyanna>, available from
F<http://web.comlab.ox.ac.uk/oucl/research/areas/constraints/>, is
used for the actual classification.  This determines if a constraint
language determines an NP-complete constraint satisfaction problem
(CSP), or if the CSP belongs to LOGSPACE, NL, PTIME, or is conjectured
to belong to PTIME.  Note that for some constraint languages,
F<polyanna> is unable to determine complexity.

The classification is written to standard output.  If standard
output is redirected and standard error is destined for the terminal,
progress is displayed via the standard error stream.

If a classification run

    polyclass > file

is terminated by an interrupt, it is possible to resume the run using

    polyclass -s `wc -l file` >> file

since each relation classified will generate one line in the output.

=head1 OPTIONS

=over 4

=item B<-h>

Print help text and exit.

=item B<-k> I<cardinality>

Cardinality of base set, a positive integer.  Defaults to 2.

=item B<-r> I<arity>

Arity of relation, a positive integer.  Defaults to 3.

=item B<-s> I<start-relation>

Starting relation number, an integer between 0 and 2**(k**n)-1.
Defaults to 0.

=item B<-V>

Show the version number and exit.

=back

=head1 RETURN VALUE

Returns 0 on success, 1 if there was an error with the arguments,
and 2 if terminated by an interrupt.

=head1 BUGS

Currently only deals with constraint languages containing a single
relation of fixed arity; should be extended to arbitrary constraint
languages.

=cut

require v5.6.0;
use vars qw( $opt_h $opt_k $opt_r $opt_s $opt_V );
use strict;
use Getopt::Std;
use Math::BigInt;

########################################################################
# globals

my $TMPFILE = "tmp$$"; # polyanna wants to read a file
my $this; # current relation
my $current = Math::BigInt->new('0'); # current relation number
# show progress if STDOUT is redirected and STDERR is the terminal
my $VERBOSE = ! (-t 1) and (-t 2);


########################################################################
# convert_to_base_digits
#
# convert a number $i to base $b, using $n digits

sub convert_to_base_digits {
    my ($i, $b, $n) = @_;
    my @r;
    while ( $i ) {
	unshift @r, ($i % $b);
	$i = int($i / $b);
    }
    foreach ( 1..($n - scalar(@r)) ) { unshift @r, 0 }
    return @r;
}


########################################################################
# signal_handler
#
# catch interrupt signals; 1st argument is signal name
# uses globals $TMPFILE, $this, $current, $VERBOSE

sub signal_handler {
    @SIG{'INT', 'HUP', 'QUIT', 'PIPE'} = ('IGNORE') x 4;
    my ($sig) = @_;
    print STDERR "\n" if $VERBOSE;
    print STDERR "Caught signal $sig, stopping\n";
    print STDERR "...during processing of relation $current: $this\n";
    unlink $TMPFILE;
    exit 2;
}


########################################################################
# default values

my $r = 3; # arity of relation
my $k = 2; # cardinality of base set
my $first = new Math::BigInt '0'; # starting relation
my $last;

@SIG{'INT', 'HUP', 'QUIT', 'PIPE'} = (\&signal_handler) x 4;

(my $BCMD = $0) =~ s/.*\///;
(my $REVISION) = ('$Revision: 1.8 $' =~ /[^\d\.]*([\d\.]*)/);
my $USAGE = "Usage: $BCMD [-hV] [-r arity] [-k base-set-size]";

if ( getopts('hk:r:s:V') ) {
    if ( $opt_h ) {
	print << "EOT";
$BCMD $REVISION
$USAGE
 -h				Prints this help text and exit
 -k base-set-size		Cardinality of base set [$k]
 -r arity			Arity of each relation [$r]
 -s startvalue			Relation number to start at [$first]
 -V				Print version number and exit
Prints and classifies complexity of all one-relation constraint
languages of given arity, over a base set of specified cardinality.
Relations are numbered 0 to 2**(k**n)-1.
EOT
	exit 0;
    }
    if ( $opt_V ) {
	print "$BCMD $REVISION\n";
	exit 0;
    }
    if ( defined($opt_r) and $opt_r <= 0 ) {
	print STDERR "ignoring \"-r $opt_r\", using $r instead\n";
    } else { $r = $opt_r if defined($opt_r) }
    if ( defined($opt_k) and $opt_k <= 0 ) {
	print STDERR "ignoring \"-k $opt_k\", using $k instead\n";
    } else { $k = $opt_k if defined($opt_k) }
    $last = (new Math::BigInt '2') **
	    ((new Math::BigInt "$k") ** (new Math::BigInt "$r")) - 1;
    if ( defined($opt_s) and ($opt_s < $first or $opt_s > $last ) ) {
	print STDERR "ignoring \"-s $opt_s\", using $first instead\n";
    } else { $first = $opt_s if defined($opt_s) }
} else {
    print STDERR $USAGE, "\n";
    exit 1;
}
my $POLYANNA = 'polyanna'; # replace with '/path/to/polyanna' if not in path

# print header
print STDERR "Classifying $r-ary relations on {0";
print STDERR ",1" if $k > 1;
print STDERR ',2' if $k == 4;
print STDERR ',...' if $k > 4;
print STDERR ',', $k-1 if $k > 2;
print STDERR "}, from # $first\n";

my %class;
# enumerate each r-ary relation
$current = $first;
while ( $current <= $last ) {
    $this = ''; # will contain input tuples present in relation
    my $i = 0;
    my $category;
    # iterate over all tuples potentially in the relation
    # a 1 in binary representation of $current signifies presence of a tuple
    foreach ( reverse( split //, sprintf('%0*b', $k**$r, $current) ) ) {
	$this .= '<'. join(',', convert_to_base_digits($i, $k, $r)) .'>' if $_;
	$i++;
    }
    $this = '{'. $this .'}';

    # now run polyanna to classify relation, discard output
    open OUT, ">$TMPFILE";
    print OUT "$current\n"; # use as title number of input relation
    print OUT "$this\n"; # relation represented as {<tuple><tuple>...}
    `$POLYANNA -t $TMPFILE`;
    $category = ${{
	0 => '?',
	1 => 'LOGSPACE',
	2 => 'NL',
	3 => 'P',
	4 => 'P?',
	5 => 'NPC',
	-1 => 'unknown',
	10 => 'error',
    }}{ $? >> 8 } || 'badcode';

    $class{ $category } ++;
    print "$this: $category\n";

    if ( $VERBOSE ) {
	my $tot = 0;
	print STDERR "\r";
	foreach ( keys %class ) {
	    $tot += $class{$_};
	    print STDERR "$_=$class{$_},";
	}
	print STDERR "SUM=$tot";
    }
    $current ++;
}
print STDERR "\n" if $VERBOSE;
unlink $TMPFILE;

exit 0;

=head1 AUTHOR

Andras Salamon, E<lt>andras@dns.netE<gt>

=head1 COPYRIGHT

Copyright 2004, Andras Salamon.

This code is distributed under the same terms as Polyanna itself.

=head1 SEE ALSO

L<polyanna>