revert_uplets.pl

#!/usr/bin/perl 

# rebuild a permutation from its uplets
# emilbarton 2013

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

## args and globals
######################################################################
if ((@ARGV)< 1 || $ARGV[0] =~ /help|usage/){ &Usage() };
my @UPLETS = @ARGV; my $MODE = 0;
my $SIGNS; my $SEEN = "";
my $INDEX = "0123456789ABCDEFGHIJKLMN";
my @INDEX = split //,$INDEX;
our 	%Digh;
for 	(my $n = 0; $n < scalar(@INDEX); $n++){ $Digh{$INDEX[$n]} = $n };

## uplets:
######################################################################
my $PERMUTATION = &Revert_uplets(@UPLETS);
print "$PERMUTATION \n";

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

### dodecad:
sub Dodecad { 
  my ($n) = @_; 
	my $res = $n;
	if (exists $Digh{$n}){ $res = $Digh{$n} }
	else { die "$n is no valid arg." }
  return $res;
} ## END Dodecad().

### (for information) partel: 
sub Partel { 
  my ($row) = @_;
  my @perm = split //, $row;
  my @partel;
  for (my $n = 0; $n < (@perm); $n++) {
    my $U = "";
    my $j = &Dodecad($perm[$n]);
    my $J = $perm[$n];
    next if ("@partel" =~ /$J/);
    if ($J =~ /$INDEX[$n]/){ push @partel,$J }
    else {
      while ($U !~ /$J/){
        $U .= $J;
        $J = $perm[$j];
        $j = &Dodecad($J);
      }
      push @partel,$U;
    }	
  }		
   return @partel;
} ## END Partel().

## Create the series corresponding to an elementary partition:
sub Revert_uplets {
	my @spart = @_;
	my $ind = "@spart" ; $ind =~ s/ //g; 
	my @ind = split //,$ind;
	@ind = sort(@ind); $ind = "@ind"; $ind =~ s/ //g; 
	my $subname = "Revert_uplets()"; my $mode = 0;
	die ("Not the right charset: $ind",$subname) if ($INDEX !~ /$ind/);
	my @perm = @ind; 
	for (my $n = 0; $n < (@spart); $n++) {
		my @U = split //,$spart[$n];
		print "u: $n @U :\n" if ($mode == 1);
		for (my $i = 0; $i < (@U); $i++) {
			print "\ti: $i : @perm\n" if ($mode == 1);
			next if not defined($U[$i+1]);
			my $j = &Dodecad($U[$i]);
			my $k = &Dodecad($U[$i+1]);
			my $l = $perm[$j];
			print "\t\tjkl: $j,$k,$l\n" if ($mode == 1);
			$perm[$j] = $perm[$k];
			print "\t\t\t @perm\n" if ($mode == 1);
			$perm[$k] = $l;
			print "\t\t\t @perm\n" if ($mode == 1);
		}
	}
	my $perm = "@perm"; $perm =~ s/ //g;
	print "@spart -> $perm \n" if ($mode == 1);
	return $perm;
} ## END Revert_uplets()

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

__DATA__

This program can be used to rebuild a permutation from its elementary 
partition (or uplets). 

Try:

  $ ./revert_uplets.pl uplets 

  Example:

  $ ./revert_uplets.pl 746130 2 5 
  73206514
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