#!/usr/bin/perl -w

=head1 NAME

lift - apply n-tuple of permutations over D to n-ary relation over D

=head1 SYNOPSIS

echo '((0,1),(1,2)){<0,1><0,2><1,2><2,0><2,1>}' | lift
echo '((),(0,2),(3,2,1)){<0,1,1><0,2,1><1,2,0><2,0,2><2,1,3>}' | lift
echo '((0,1),(0,2),(3,2,1)){<0,1,1><0,2,1><1,2,0><2,0,2><2,1,3>}' | lift
echo '((1,3)(0,1),(),(3,2)){<0,1,1><0,2,1><1,2,0><2,0,2><2,1,3>}' | lift
echo '((0,1)(1,3),(),(3,2)){<0,1,1><0,2,1><1,2,0><2,0,2><2,1,3>}' | lift

=head1 DESCRIPTION

Standard input is read, one line per expression.  Spaces within an
expression are ignored.  Each expression is evaluated by applying
the given n-tuple of permutations to the given n-ary relation.
Permutations are represented as right-associative compositions
of cycles, with () denoting the identity permutation.  A tuple of
permutations is bracketed using parentheses, and commas must be used
to separate permutations within the tuple.  Tuples in a relation
are bracketed using angle brackets; commas may be used to separate
tuples but are optional.  The representation of relations should be
compatible with polyanna.

=head1 AVAILABILITY

The latest version of B<lift> is available from
F<http://www.dns.net/dist/lift/> .

=cut

use strict;

# convert a relation to internal format
sub string_to_relation {
    my @tuples;
    local $_ = shift;
    s#\s*##g; s#{<##; s#>}##;
    foreach ( split />,?</ ) { push @tuples, [ split /,/ ] }
    return \@tuples;
}

# convert a tuple in internal format to a string
sub tuple_to_string {
    my $t = shift;
    return '<' . join(',', @$t) . '>';
}

# convert a relation in internal format to a string
sub relation_to_string {
    my $r = shift;
    my @s;
    foreach ( @$r ) { push @s, tuple_to_string( $_ ) }
    return '{' . join('', sort(@s)) . '}';
}

# convert one permutation to internal format
# each permutation is represented as a right-associative composition of cycles
sub string_to_perm {
    my (%p, $f, $l);
    my $s = shift;
    $s =~ s#\s*##g;
    while ( $s ) { # deal with composition of cycles, from the right
	undef $f; undef $l;
	$s =~ s#\(([^\)]*)\)$##;
	foreach ( split /,/, $1 ) { # deal with each individual cycle
	    $f = $_ unless defined($f);
	    $p{$l} = $_ if defined($l);
	    $l = $_;
	}
	$p{$l} = $f if defined($f); # since then $l is also defined
    }
    return \%p;
}

# convert a permutation in internal format to a string
sub perm_to_string {
    my $p = shift;
    my @vals = sort keys %$p;
    my @cycle;
    my $s;
    while ( @vals ) {
	my $first = shift @vals;
	my $l;
	my $f = $first;
	@cycle = ();
	while ( 1 ) {
	    $l = $$p{$f};
	    # note that a->b->b cannot occur in a permutation!
	    push @cycle, $f if $l != $f; # suppress unicycles
	    last if $l == $first; # $l has already been removed from @vals
	    @vals = grep { $l != $_ } @vals; # otherwise remove it
	    $f = $l;
	}
	$s .= '(' . join(',', @cycle) . ')';
    }
    $s = '()' unless $s;
    return $s;
}

# input: list of permutations and a tuple in internal format
# apply each permutation to each element of the tuple in turn
# number of permutations must match arity of tuple
sub apply_permlist_to_tuple {
    my $ps = shift;
    my $tuple = shift;
    my @t;
    my $m = scalar @$tuple;
    die unless @$ps == $m;
    while ( $m-- ) {
	my $k = ${$tuple}[$m];
	my $v = ${${$ps}[$m]}{$k};
	unshift @t, ( defined( $v ) ? $v : $k );
    }
    return \@t;
}

while ( <> ) {
    s#\s*##g;
    print;
    print '=';
    m#\(((\([^\)]*\))+(,(\([^\)]*\))+)*)\)({[^}]*})#;
#    print "1:$1 2:$2 3:$3 4:$4 5:$5\n";
    my $relation = string_to_relation( $5 );
#print scalar @$relation, '=';
#print relation_to_string($relation);
    my $permliststring = $1;
    $permliststring =~ s#\),\(#\);\(#g;
    my @perms = map { string_to_perm( $_ ) } split(/;/, $permliststring);
#foreach (@perms) {print perm_to_string($_)}

    print relation_to_string(
	[map { apply_permlist_to_tuple( \@perms, $_ ) } @$relation]
    ), "\n";
}

exit 0;

=head1 SEE ALSO

L<polyanna>

=head1 AUTHOR

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

=head1 HISTORY

Version 1.4 added more documentation and availability info.

Version 1.3 was privately released, with documentation and fixes for
several errors.

Version 1.2 was privately released, with comments to indicate usage.

Version 1.1 was the initial unreleased version.