Merge pull request #626 from jmaslak/joelle-25-2-1

Joelle's solutions to 25.2 in Perl 6 & 5

2 files changed, 246 insertions, 0 deletions

diff --git a/challenge-025/joelle-maslak/perl5/ch-2.pl b/challenge-025/joelle-maslak/perl5/ch-2.pl
new file mode 100755
index 0000000000..6b6b78bdf7
--- /dev/null
+++ b/challenge-025/joelle-maslak/perl5/ch-2.pl
@@ -0,0 +1,123 @@
+#!/usr/bin/env perl
+use v5.26;
+use strict;
+use warnings;
+
+# Turn on method signatures
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+use autodie;
+use Getopt::Long;
+
+MAIN: {
+    my $left   = 'HXUCZVAMDSLKPEFJRIGTWOBNYQ';
+    my $right  = 'PTLNBQDEOYSFAVZKGJRIHWXUMC';
+    my $zenith = 1;
+    my $nadir  = 14;
+    GetOptions(
+        "left=s" => \$left,
+        "right=s" => \$right,
+        "zenity=i" => \$zenith,
+        "nadir=i" => \$nadir,
+    );
+    if ( @ARGV != 2 ) {
+        die("Invalid parameters, provide command (encrypt|decrypt) and text at a minimum");
+    }
+
+    my $cmd = shift(@ARGV);
+    my $text = shift(@ARGV);
+
+    if ($cmd ne 'encrypt' and $cmd ne 'decrypt') {
+        die "Invaid command, must be encrypt or decrypt";
+    }
+
+    say endecrypt($cmd, $text, $left, $right, $zenith, $nadir);
+}
+
+sub endecrypt(
+    $mode,
+    $text,
+    $left,
+    $right,
+    $zenith,
+    $nadir,
+) {
+    die "Wheels not same size" if length($left) != length($right);
+    my $size = length($left);
+
+    # Normalize zenith and nadir to start at zero
+    $zenith--;
+    $nadir--;
+
+    # Get the input text
+    my (@input) = split //, $text;
+    my @output;
+
+    for my $char (@input) {
+        my (@left) = split //, $left;
+        my (@right) = split //, $right;
+
+        my $pos = $mode eq 'encrypt' ? index($right, $char) : index($left, $char);
+        die "Letter ($char) not on wheel" unless $pos >= 0;
+        my $pletter = $right[$pos];
+        my $eletter = $left[$pos];
+
+        push @output, $mode eq 'encrypt' ? $eletter : $pletter;
+
+        # Permeate left wheel
+        do {
+            # We need to rotate the left alphabet so ciphertext is the
+            # cyphertext letter at the zenith
+            while ($left[$zenith] ne $eletter) {
+                push @left, shift @left;
+            }
+
+            # We note the letter in the zenith + 1 position
+            my $tmp = $left[($zenith + 1) % $size];
+
+            # We move all the letters from the zenith + 2 to nadir left
+            my $pos = ($zenith + 2) % $size;
+            while ($pos != ($nadir + 1) % $size) {
+                $left[($pos - 1) % $size] = $left[$pos];
+                $pos = ($pos + 1) % $size;
+            }
+
+            # We put the saved letter in the nadir position
+            $left[$nadir] = $tmp;
+
+            # Store the alphabet
+            $left = join '', @left;
+        };
+
+        # Permeate right wheel
+        do {
+            # We put the plaintext letter at the zenith
+            while ($right[$zenith] ne $pletter) {
+                push @right, shift @right;
+            }
+
+            # Move the wheel one more position left
+            push @right, shift @right;
+
+            # We note the letter in the zenith + 2 position
+            my $tmp = $right[($zenith + 2) % $size];
+
+            # We move all the letters from the zenith + 3 to nadir left
+            my $pos = ($zenith + 3) % $size;
+            while ($pos != ($nadir + 1) % $size) {
+                $right[($pos - 1) % $size] = $right[$pos];
+                $pos = ($pos + 1) % $size;
+            }
+
+            # We put the saved letter in the nadir position
+            $right[$nadir] = $tmp;
+
+            # Store the alphabet
+            $right = join '', @right;
+        };
+    }
+
+    return join("", @output);
+}
+
diff --git a/challenge-025/joelle-maslak/perl6/ch-2.p6 b/challenge-025/joelle-maslak/perl6/ch-2.p6
new file mode 100755
index 0000000000..da5b2aa5a4
--- /dev/null
+++ b/challenge-025/joelle-maslak/perl6/ch-2.p6
@@ -0,0 +1,123 @@
+#!/usr/bin/env perl6
+use v6;
+
+#
+# Copyright © 2019 Joelle Maslak
+# All Rights Reserved - See License
+#
+    
+my Str:D  $LDEFAULT = 'HXUCZVAMDSLKPEFJRIGTWOBNYQ';
+my Str:D  $RDEFAULT = 'PTLNBQDEOYSFAVZKGJRIHWXUMC';
+my UInt:D $ZDEFAULT = 1;   # Start counting at 1
+my UInt:D $NDEFAULT = 14;  # Start counting at 1
+
+multi sub MAIN(
+    'encrypt',
+    Str:D  $text,
+    Str:D  :$left   = $LDEFAULT,
+    Str:D  :$right  = $RDEFAULT,
+    UInt:D :$zenith = $ZDEFAULT,
+    UInt:D :$nadir  = $NDEFAULT,
+) {
+    say endecrypt('encrypt', $text, $left, $right, $zenith, $nadir);
+}
+
+multi sub MAIN(
+    'decrypt',
+    Str:D  $text,
+    Str:D  :$left   = $LDEFAULT,
+    Str:D  :$right  = $RDEFAULT,
+    UInt:D :$zenith = $ZDEFAULT,
+    UInt:D :$nadir  = $NDEFAULT,
+) {
+    say endecrypt('decrypt', $text, $left, $right, $zenith, $nadir);
+}
+
+sub endecrypt(
+    Str:D $mode,
+    Str:D $text,
+    Str:D $left   is copy,
+    Str:D $right  is copy,
+    Int:D $zenith is copy,
+    Int:D $nadir  is copy,
+) {
+    die "Wheels not same size" if $left.chars ≠ $right.chars;
+    my $size = $left.chars;
+
+    # Normalize zenith and nadir to start at zero.
+    $zenith--;
+    $nadir--;
+
+    # Get the input text
+    my @input = $text.comb;
+    my @output;
+
+    for @input -> $char {
+        my @left  = $left.comb;
+        my @right = $right.comb;
+   
+        my $pos = $mode eq 'encrypt' ?? $right.index($char) !! $left.index($char);
+        die "Letter ($char) not on wheels" unless $pos.defined;
+        my $pletter = @right[$pos];
+        my $eletter = @left[$pos];
+
+        @output.push: $mode eq 'encrypt' ?? $eletter !! $pletter;
+
+        # Permeate left wheel
+        {
+            # We need to rotate the left alphabet so ciphertext is the
+            # ciphertext letter at the zenith.
+            while @left[$zenith] ne $eletter {
+                @left.append: @left.shift;
+            }
+
+            # We note the letter in the zenith + 1 position
+            my $tmp = @left[($zenith + 1) % $size];
+
+            # We move all the letters from the zenith + 2 to nadir left
+            my $pos = ($zenith + 2) % $size;
+            while $pos ≠ ($nadir + 1) % $size {
+                @left[($pos - 1) % $size] = @left[$pos];
+                $pos = ($pos + 1) % $size;
+            }
+
+            # We put the saved letter in the nadir position
+            @left[$nadir] = $tmp;
+
+            # Store the alphabet
+            $left = @left.join;
+        }
+
+        # Permeate right wheel
+        {
+            # We put the plaintext letter at the zenith
+            while @right[$zenith] ne $pletter {
+                @right.append: @right.shift;
+            }
+
+            # Move the wheel one more position left
+            @right.append: @right.shift;
+
+            # We note the letter in the zenith + 2 position
+            my $tmp = @right[($zenith + 2) % $size];
+
+            # We move all the letters from the zenith + 3 to nadir left
+            my $pos = ($zenith + 3) % $size;
+            while $pos ≠ ($nadir + 1) % $size {
+                @right[($pos - 1) % $size] = @right[$pos];
+                $pos = ($pos + 1) % $size;
+            }
+
+            # We put the saved letter in the nadir position
+            @right[$nadir] = $tmp;
+
+            # Store the alphabet
+            $right = @right.join;
+        }
+    }
+
+    return @output.join;
+}
+
+
+