Merge pull request #6009 from simbabque/challenge-162

Challenge 162

2 files changed, 245 insertions, 0 deletions

diff --git a/challenge-162/julien-fiegehenn/perl/1.pl b/challenge-162/julien-fiegehenn/perl/1.pl
new file mode 100644
index 0000000000..615f3f75c2
--- /dev/null
+++ b/challenge-162/julien-fiegehenn/perl/1.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use feature 'say';
+use List::Util 'sum';
+
+# Write a script to generate the check digit of given ISBN-13 code. Please refer wikipedia for more information.
+
+# Example
+# ISBN-13 check digit for '978-0-306-40615-7' is 7.
+
+# https://en.wikipedia.org/wiki/ISBN#ISBN-13_check_digit_calculation
+
+sub isbn_13 {
+    my $number = shift;
+
+    die 'Input required' unless $number;
+
+    # clean up the number
+    $number =~ s/\D//g;
+
+    # we need to do maths on each digit
+    my @digits = split //, $number;
+
+    # discard the check digit
+    pop @digits if @digits == 13;
+
+    # do we have the right amount of digits?
+    die 'This does not look like an ISBN-13' unless @digits == 12;
+
+    # tripple all the even digits
+    $_ *= 3 for @digits[1, 3, 5, 7, 9, 11];
+
+    # and do the maths
+    return 10 - sum(@digits) % 10;
+}
+
+say isbn_13(shift);
+
+__END__
+use Test::More;
+
+is isbn_13('978-0-306-40615-7'), 7;
+
+done_testing;
\ No newline at end of file
diff --git a/challenge-162/julien-fiegehenn/perl/2.pl b/challenge-162/julien-fiegehenn/perl/2.pl
new file mode 100644
index 0000000000..ee3dc3206f
--- /dev/null
+++ b/challenge-162/julien-fiegehenn/perl/2.pl
@@ -0,0 +1,199 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use feature 'say';
+
+use constant {ROW => 0, COL => 1};
+
+# Implement encryption and decryption using the Wheatstone-Playfair cipher.
+#
+# Examples:
+#  (These combine I and J, and use X as padding.)
+#
+#  encrypt("playfair example", "hide the gold in the tree stump") = "bmodzbxdnabekudmuixmmouvif"
+#
+#  decrypt("perl and raku", "siderwrdulfipaarkcrw") = "thewexeklychallengex"
+
+# Comments based on example in  https://de.wikipedia.org/wiki/Playfair.
+
+# Turn on debugging with the DEBUG=0 environment variable.
+
+say encrypt('playfaire example', 'hide the gold in the tree stump');
+say decrypt("perl and raku", "siderwrdulfipaarkcrw");
+
+sub debug($) {
+  print @_ if $ENV{DEBUG};
+}
+
+sub generate_table {
+  my $key = shift;
+
+  my @letters = grep /[A-IK-Z]/, split //, uc $key;
+  push @letters, 'A' .. 'I', 'K' .. 'Z';
+
+  my ($table, $seen);
+
+  for my $row (0 .. 4) {
+    for my $col (0 .. 4) {
+      while (@letters) {
+        my $letter = shift @letters;
+
+        # skip the ones we've seen
+        redo if $seen->{$letter};
+
+        $table->[$row]->[$col] = $letter;
+        $seen->{$letter} = [$row, $col];
+        last;
+      }
+      debug "$table->[$row]->[$col] ";
+    }
+    debug "\n";
+  }
+  debug "\n";
+
+  return ($table, $seen);
+}
+
+sub encrypt {
+  my ($key, $string) = @_;
+
+  my ($table, $lookup) = generate_table($key);
+
+  my $encrypted = q{};
+
+  my @letters = grep /[A-Z]/, split //, uc $string;
+  while (my ($first, $second) = splice @letters, 0, 2) {
+
+    # pad to create a pair if we only have one letter left
+    $second ||= 'X';
+
+    # handle repeated letters
+    if ($first eq $second) {
+      unshift @letters, $second;
+      $second = 'X';
+    }
+
+    debug "$first$second ";
+
+    # 1. The pair HI forms a rectangle, replace it with BM
+    if ( $lookup->{$first}->[ROW] != $lookup->{$second}->[ROW]
+      && $lookup->{$first}->[COL] != $lookup->{$second}->[COL])
+    {
+      ($first, $second) = (
+        $table->[$lookup->{$first}->[ROW]]->[$lookup->{$second}->[COL]],
+        $table->[$lookup->{$second}->[ROW]]->[$lookup->{$first}->[COL]],
+      );
+    }
+
+    # 2. The pair DE is in a column, replace it with OD
+    elsif ($lookup->{$first}->[ROW] != $lookup->{$second}->[ROW]
+      && $lookup->{$first}->[COL] == $lookup->{$second}->[COL])
+    {
+      ($first, $second) = (
+        $table->[wrap_number($lookup->{$first}->[ROW] + 1)]
+          ->[$lookup->{$first}->[COL]],
+        $table->[wrap_number($lookup->{$second}->[ROW] + 1)]
+          ->[$lookup->{$second}->[COL]],
+      );
+    }
+
+    # 10. The pair EX (X inserted to split EE) is in a row, replace it with XM
+    elsif ($lookup->{$first}->[ROW] == $lookup->{$second}->[ROW]
+      && $lookup->{$first}->[COL] != $lookup->{$second}->[COL])
+    {
+      ($first, $second) = (
+        $table->[$lookup->{$first}->[ROW]]
+          ->[wrap_number($lookup->{$first}->[COL] + 1)],
+        $table->[$lookup->{$second}->[ROW]]
+          ->[wrap_number($lookup->{$second}->[COL] + 1)],
+      );
+    }
+    debug " -> $first$second\n";
+
+    $encrypted .= $first . $second;
+  }
+  debug "\n";
+
+  return $encrypted;
+}
+
+sub decrypt {
+  my ($key, $string) = @_;
+
+  my ($table, $lookup) = generate_table($key);
+
+  my $encrypted = q{};
+
+  my @letters = grep /[A-Z]/, split //, uc $string;
+  while (my ($first, $second) = splice @letters, 0, 2) {
+
+    # pad to create a pair if we only have one letter left
+    $second ||= 'X';
+
+    # handle repeated letters
+    if ($first eq $second) {
+      unshift @letters, $second;
+      $second = 'X';
+    }
+
+    debug "$first$second ";
+
+    # 1. The pair HI forms a rectangle, replace it with BM
+    if ( $lookup->{$first}->[ROW] != $lookup->{$second}->[ROW]
+      && $lookup->{$first}->[COL] != $lookup->{$second}->[COL])
+    {
+      ($first, $second) = (
+        $table->[$lookup->{$first}->[ROW]]->[$lookup->{$second}->[COL]],
+        $table->[$lookup->{$second}->[ROW]]->[$lookup->{$first}->[COL]],
+      );
+    }
+
+    # 2. The pair DE is in a column, replace it with OD
+    elsif ($lookup->{$first}->[ROW] != $lookup->{$second}->[ROW]
+      && $lookup->{$first}->[COL] == $lookup->{$second}->[COL])
+    {
+      ($first, $second) = (
+        $table->[wrap_number($lookup->{$first}->[ROW] - 1)]
+          ->[$lookup->{$first}->[COL]],
+        $table->[wrap_number($lookup->{$second}->[ROW] - 1)]
+          ->[$lookup->{$second}->[COL]],
+      );
+    }
+
+    # 10. The pair EX (X inserted to split EE) is in a row, replace it with XM
+    elsif ($lookup->{$first}->[ROW] == $lookup->{$second}->[ROW]
+      && $lookup->{$first}->[COL] != $lookup->{$second}->[COL])
+    {
+      ($first, $second) = (
+        $table->[$lookup->{$first}->[ROW]]
+          ->[wrap_number($lookup->{$first}->[COL] - 1)],
+        $table->[$lookup->{$second}->[ROW]]
+          ->[wrap_number($lookup->{$second}->[COL] - 1)],
+      );
+    }
+    debug " -> $first$second\n";
+
+    $encrypted .= $first . $second;
+  }
+  debug "\n";
+
+  return $encrypted;
+}
+
+sub wrap_number {
+  my $number = shift;
+
+  return 4 - $number if $number > 4;
+  return $number;
+}
+
+__END__
+
+use Test::More;
+
+is lc encrypt("playfair example", "hide the gold in the tree stump"),
+  "bmodzbxdnabekudmuixmmouvif";
+is lc decrypt("perl and raku", "siderwrdulfipaarkcrw"), "thewexeklychallengex";
+
+done_testing;
\ No newline at end of file