compose.pl

#!/usr/bin/perl 

# composition of two permutations
# emilbarton 2013

## modules:
######################################################################
use strict;
use warnings FATAL => "all";

## args and globals
######################################################################
if ((@ARGV)< 2 || $ARGV[0] =~ /help|usage/){ &Usage() };
my $TARGET = $ARGV[0]; my @TARGET = split //, $TARGET;
my $AGENT = $ARGV[1]; my @AGENT = split //, $AGENT;
my @PERMUTATIONS; 
my $POW = 1; my $MODE = 0;
if ((@ARGV) > 2 ) { if (int($ARGV[2])) { $POW = $ARGV[2] } }
if ((@ARGV) > 3 ) { if (int($ARGV[3])) { $MODE = $ARGV[3] } }
my $SIGNS; my $SEEN = "";
my $INDEX = "0123456789ABCDEFGHIJKLMN";
my @INDEX = split //,$INDEX;

## permutation check:
######################################################################
my $ALEN = (@AGENT); my $LEN = (@TARGET); 
die "invalid length" if ($LEN > (@INDEX) || $ALEN > (@INDEX) || $LEN != $ALEN);
for (my $i = 0; $i < $LEN; $i++) { $SIGNS = $SIGNS.$INDEX[$i] }  
foreach (@AGENT) {
	my $char = $_; 
	die "invalid sign in $AGENT: $char" if ($SIGNS !~ /$char/i);
	die "repeated signs not allowed" if ($SEEN =~ /$char/i);
	$SEEN .= $char;
}
$SEEN = "";
foreach (@TARGET) {
	my $char = $_; 
	die "invalid sign in $TARGET: $char" if ($SIGNS !~ /$char/i);
	die "repeated signs not allowed" if ($SEEN =~ /$char/i);
	$SEEN .= $char;
}

## composition:
######################################################################

if ($POW < 0){
	print &Powerp($TARGET,$AGENT,(&Gradual($AGENT,$MODE)+$POW),$MODE)."\n" ;
}
else {
	print &Powerp($TARGET,$AGENT,$POW,$MODE)."\n"; 
}



## subroutines
######################################################################


### powerp:
sub Powerp{
	my ($target,$agent,$pow,$opt) = @_;
	my @rslt;
	if ($pow == 0) {
		$target = &Natural($target);
  }
  else {
		for (my $n = 1; $n <= abs($pow); $n++){
			$target = Composind($target,$agent);
			push @rslt, $target;
		}
  }
  if ($opt == 1) { return @rslt } 
  else { return $target }
} ## END Powerp().


### compose:
sub Composind { 
	my ($t,$g) = @_;
  my @target = split //,$t; 
  my @agent = split //,$g;
  my (@agent_by_char, $cnt, $result, @tmp_result, @target_by_char);
  for (my $i = 0; $i < (@agent); $i++) { # We create char-indice pairs.
    $target[$i] = [$target[$i],$i]; $agent[$i] = [$agent[$i],$i];
  }
  @target_by_char = sort {@$a[0] cmp @$b[0]} @target; # We order pairs according to the char.	
  @agent_by_char = sort {${$a}[0] cmp ${$b}[0]} @agent;
  @tmp_result = map { [ @$_ ] } @target_by_char; # Bait modifying sequence: note the indispensable call to map().
  for (my $i = 0; $i < (@agent_by_char); $i++){ ${$tmp_result[$i]}[1] = ${$target_by_char[${$agent_by_char[$i]}[1]]}[1] }
  foreach (sort {${$a}[1] <=> ${$b}[1]} @tmp_result) { $result .= ${$_}[0] }
  return $result;
} ## END Composind().


### gradual:
sub Gradual {
  my ($row,$opt) = @_;
  my $ind = &Natural($row);
  my $targ = $row;
  my $deg = 1; my @per;
  my $len = length($row);
  push @per, $row;
  goto GRAD_END if ($ind =~ /$row/);
  while (++$deg){
    $targ = &Composind($targ,$row);
    last if ($ind =~ /$targ/);
    push @per, $targ; 
  }
  GRAD_END: 
  if ($opt == 1) { return @per } 
  else { return $deg } 
} ## END Gradual().


### natural:
sub Natural { ## Revised 111002.
	my ($str) = @_;
  my @tmp = split(//,$INDEX);
  splice(@tmp,length($str));
	return(join '',@tmp);
} ## END Csgrouper::Natural().


### usage:
sub Usage {
	my $data;
	while (<DATA>) { $data .= $_ };
	die "Usage:\n$data";
} ## END Usage()

__DATA__

This program can be used to compute a compositon of permutations possibly
applied up to a given power. 

Try:

  ./compose.pl target agent [mode]

  Examples:
  
  ./gradual.pl 0132 0231 
  	0213
  
  ./gradual.pl 0132 0231 2
  	0321

Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s