#!/usr/bin/perl -w

use strict;

sub transpose3x17 {
    my $key = $_[0];
    my $stack1='';
    my $stack2='';
    my $stack3='';
    my $i;
    for ($i=0;$i<17;$i++) {
        $stack1 = $stack1 . chop($$key);
        $stack2 = $stack2 . chop($$key);
        $stack3 = $stack3 . chop($$key);
    }
    $$key = $$key . $stack1 . $stack2 . $stack3;
    return;
}

sub transpose5x7 {
    my $key = $_[0];
    my $stack1='';
    my $stack2='';
    my $stack3='';
    my $stack4='';
    my $stack5='';
    my $i;
    for ($i=0;$i<7;$i++) {
        $stack1 = $stack1 . chop($$key);
        $stack2 = $stack2 . chop($$key);
        $stack3 = $stack3 . chop($$key);
        $stack4 = $stack4 . chop($$key);
        $stack5 = $stack5 . chop($$key);
    }
    $$key = $$key . $stack1 . $stack2 . $stack3 . $stack4 . $stack5;
    return;
}

sub cutswapblack {
    my ($key, $oncard) = @_;
    $$key =~ s/(.)(.*)$oncard(.*)/$1$3$oncard$2/;
    return;
}

sub cutswapblacktwin {
    my ($key, $oncard) = @_;
    $oncard =~ tr/a-mn-z/n-za-m/;
    $$key =~ s/(.)(.*)$oncard(.*)/$1$3$oncard$2/;
    return;
}

sub cutswapblackbottom {
    my ($key) = @_;
    my ($oncard) = $$key =~ /^(.)/;
    $oncard =~ tr/a-mn-z/n-za-m/;
    $$key =~ s/(.)(.*)$oncard(.*)/$1$3$oncard$2/;
    return;
}

sub cutswapred {
    my ($key, $oncard) = @_;
    $$key =~ s/(.*)$oncard(.*)(.)/$2$oncard$1$3/;
    return;
}

sub cutswapredtop {
    my ($key) = @_;
    my ($oncard) = $$key =~ /(.)$/;
    $oncard =~ tr/a-mn-z/n-za-m/;
    $$key =~ s/(.*)$oncard(.*)(.)/$2$oncard$1$3/;
    return;
}

sub swapbottom {
    my ($key, $oncard) = @_;
    my ($withcard) = $$key =~ /^(.)/;
    $withcard =~ tr/a-mn-z/n-za-m/;
    if ($$key =~ /$oncard(.+)$withcard/) {
        $$key =~ s/$oncard(.+)$withcard/$withcard$1$oncard/;
    } else {
        $$key =~ s/$withcard(.+)$oncard/$oncard$1$withcard/;
    }
    return;
}

sub swap {
    my ($key, $oncard, $withcard) = @_;
    if ($$key =~ /$oncard(.+)$withcard/) {
        $$key =~ s/$oncard(.+)$withcard/$withcard$1$oncard/;
    } else {
        $$key =~ s/$withcard(.+)$oncard/$oncard$1$withcard/;
    }
    return;
}

sub sliggle {
    my ($key) = @_;
    $$key =~ s/^(.)(.)(.)/$3$2$1/;
    return;
}

sub sliggle2 {
    my ($key) = @_;
    $$key =~ s/^(.)(...)(.)/$3$2$1/;
    return;
}

sub elggils {
    my ($key) = @_;
    $$key =~ s/(.)(.)(.)$/$3$2$1/;
    return;
}

sub encrypt {
    my ($key, $plain) = @_;
    my $cipher = lookup($key, $plain);
    my $redplain = $plain;
    $redplain =~ tr/a-z/A-Z/;
    cutswapblack($key, $plain);
    swapbottom($key, $plain);
    cutswapred($key, $redplain);
    transpose3x17($key);
    cutswapblackbottom($key);
    transpose5x7($key);
    sliggle($key);
    return $cipher;
}

sub lookup {
    my($key, $input) = @_;
    my $temp;
    ($temp) = $$key =~ /$input(.)/;
    return $temp;
}

sub whereis {
    my($key, $input) = @_;
    $$key =~ /^(.*)$input/;
    return length($1);
}

my ($i,$j,$n);

my $key = 'aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ';

my @ciphertext;
my @location;
my @correlation;

for ($i=0;$i<=59;$i++) {
    $correlation[$i] = ();
    for ($j=0;$j<=57;$j++) {
        $correlation[$i]->[$j] = 0;
    }
}

for ($i=0;$i<52;$i++) { # First randomize the deck.
    encrypt(\$key, 'z');
}

for ($i=0;$i<70;$i++) {
    unshift @location, whereis(\$key, 'a');
    unshift @ciphertext, encrypt(\$key, 'a');
}

my $num_per_print = 10047;

my @alphabet = split ' ', 'a b c d e f g h i j k l m n o p q r s t u v w x y z';
my $num_sequence = 3;
$num_sequence = $ARGV[0] if ($#ARGV==0);

print "Rotating a sequence of $num_sequence\n";

for ($n=0;$n<50000;$n++) {
    for ($i=0;$i<$num_per_print*$num_sequence;$i++) {
        my $plain = $alphabet[$i % $num_sequence];
        unshift @location, whereis(\$key, $plain);
        unshift @ciphertext, encrypt(\$key, $plain);
        pop @location; 
        pop @ciphertext;
        for ($j=0;$j<=57;$j++) {
            $correlation[$location[$j]]->[$j]++ if ($ciphertext[$j] eq $ciphertext[0]);
        }
    }
    print "\n", ($n+1)*$num_per_print*$num_sequence, "\n\n";
    print "Correlation   1     2     3     4     5    ";
    print " 6     7     8     9    10    11    12    13    error\n"; 
    for ($i=0;$i<=26;$i++) {
        if ($correlation[$i*2]->[0] != 0) {
            my $error = 1/sqrt($correlation[$i*2]->[0]/26);
            printf "Location %2d: ", $i;
            for ($j=1;$j<=13;$j++) {
                my $fun = 
                    26*$correlation[$i*2]->[$j]/$correlation[$i*2]->[0]-1;
                printf "%5.1f ", 100*$fun;
            }
            printf "+- %4.1f\n", 100*$error;
        }
    }
    printf "  Total    : ", $i;
    my $zero_total = 0;
    for ($i=0;$i<=26;$i++) {
        $zero_total += $correlation[$i*2]->[0];
    }
    for ($j=1;$j<=13;$j++) {
        my $total = 0;
        for ($i=0;$i<=26;$i++) {
            $total += $correlation[$i*2]->[$j];
        }
        printf "%6.2f ", 100*(26*$total/$zero_total - 1);
    }
    printf "+- %5.2f\n", 100/sqrt($zero_total/26);

  #  for ($j=0;$j<56;$j++) {
  #      my $fun = 26*$correlation[$j]/$correlation[0];
  #      my $error = 0;
  #      $error = $fun/sqrt($correlation[$j]) if ($correlation[$j]!=0);
  #      printf("Correlation %2d %7.3f +- %5.3f \n", 
  #             $j, ($fun-1)*100, $error*100);
  #  }
}