Add solutions for challenge 162

3 files changed, 235 insertions, 0 deletions

diff --git a/challenge-162/alexander-pankoff/haskell/ch-1.hs b/challenge-162/alexander-pankoff/haskell/ch-1.hs
new file mode 100644
index 0000000000..9ad7233007
--- /dev/null
+++ b/challenge-162/alexander-pankoff/haskell/ch-1.hs
@@ -0,0 +1,45 @@
+module Main where
+
+import           Control.Monad      ((>=>))
+import           Data.Char          (ord)
+import           System.Environment (getArgs)
+import           System.Exit        (exitFailure)
+
+main :: IO ()
+main = do
+    testISBN <- getArgs >>= maybe (die usage) return . safeHead
+    either die print $ calculateCheckDigit <$> parseISBN testISBN
+  where usage = "Pass ISBN as first argument."
+
+parseISBN :: String -> Either String [Int]
+parseISBN =
+        maybeToEither "Contains invalid ISBN characters." . mapM digitToInt
+        .   filter (/= '-')
+        >=> checkLength
+  where
+    checkLength x | length x == 12 = return x
+                  | otherwise      = Left "Need 12 digits in ISBN."
+
+calculateCheckDigit :: [Int] -> Int
+calculateCheckDigit isbn12 =
+    let weightedSums =  sum $ zipWith (*) isbn12 weights
+    in (10 - weightedSums `mod` 10) `mod` 10
+  where
+    weights = [1, 3] ++ weights
+
+digitToInt :: Char -> Maybe Int
+digitToInt c =
+    let digit = ord c - ord '0'
+    in  if 0 <= digit && digit <= 9
+            then return digit
+            else Nothing
+
+safeHead :: [a] -> Maybe a
+safeHead []      = Nothing
+safeHead (x : _) = Just x
+
+maybeToEither :: a -> Maybe b -> Either a b
+maybeToEither a = maybe (Left a) Right
+
+die :: String -> IO a
+die msg = putStrLn msg >> exitFailure
diff --git a/challenge-162/alexander-pankoff/perl/ch-1.pl b/challenge-162/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..00448d8bbe
--- /dev/null
+++ b/challenge-162/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+
+=pod
+Task 1: ISBN-13
+Submitted by: Mohammad S Anwar
+
+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.
+=cut
+
+package challenge162::ch1;
+
+use strict;
+use warnings;
+use autodie;
+use feature qw'say state signatures';
+no warnings qw'experimental::signatures';
+
+use FindBin    ();
+use File::Spec ();
+use List::Util qw(sum);
+
+use lib File::Spec->catdir( $FindBin::RealBin,
+    qw'.. .. .. challenge-001 alexander-pankoff perl lib' );
+
+use My::List::Util qw(zip_with);
+use My::String::Util qw(explode);
+
+run() unless caller();
+
+sub run() {
+    my $isbn = $ARGV[0];
+    say calculate_isbn13_check_digit($isbn);
+
+}
+
+sub calculate_isbn13_check_digit($isbn) {
+
+    # make sure the input looks like a valid isbn number, remove spaces and
+    # dashes.
+    my $numbers = $isbn =~ s/-|\s//gr;
+    die "Invalid input\n" if $numbers !~ /^\d+$/ || length $numbers != 12;
+
+    # generate a list of the twelve weights.
+    my @weights = ( 1, 3 ) x 6;
+    my @numbers = explode($numbers);
+
+    # mutliply each number in the isbn with its weight and get the total sum of
+    # the weighted numbers
+    my $weighted_sum = sum( zip_with( \&mul, \@numbers, \@weights ) );
+
+    my $check_digit = ( 10 - $weighted_sum % 10 ) % 10;
+
+    return $check_digit;
+}
+
+sub mul ( $a, $b ) {
+    return $a * $b;
+}
+
+1;
diff --git a/challenge-162/alexander-pankoff/perl/ch-2.pl b/challenge-162/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..ec358304b4
--- /dev/null
+++ b/challenge-162/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,125 @@
+#!/usr/bin/env perl
+
+=pod
+Task 2: Wheatstone-Playfair
+Submitted by: Roger Bell_West
+
+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"
+=cut
+
+use strict;
+use warnings;
+use autodie;
+use feature qw'say state signatures';
+no warnings qw'experimental::signatures';
+
+use FindBin    ();
+use File::Spec ();
+
+use lib File::Spec->catdir( $FindBin::RealBin,
+    qw'.. .. .. challenge-001 alexander-pankoff perl lib' );
+
+package challenge162::ch2;
+
+run() unless caller();
+
+sub run() {
+    say WheatstonePlayfairCipher::encrypt( "playfair example",
+        "Hide the gold in the tree stump" );
+    say WheatstonePlayfairCipher::decrypt( "Perl and Raku",
+        "siderwrdulfipaarkcrw" );
+
+}
+
+package WheatstonePlayfairCipher {
+
+    use List::Util qw(uniq);
+    use My::String::Util qw(implode explode);
+    use My::List::Util qw(flatten zip chunks_of without);
+
+    sub encrypt ( $keyphrase, $cleartext ) {
+        my @keytable = _build_keytable($keyphrase);
+        _run_ciper( $cleartext, \@keytable );
+    }
+
+    sub decrypt ( $keyphrase, $ciphertext ) {
+        my @keytable = _build_keytable($keyphrase);
+        _run_ciper( $ciphertext,
+            [ reverse( map { [ reverse(@$_) ] } @keytable ) ] );
+    }
+
+    sub _run_ciper ( $input, $keytable ) {
+        $input =~ s/[^a-z]//gi;
+
+        # Split same chars in an even position using an 'x'. 'xx' will be kept
+        # as is and later treated by the same row rule.
+        while ( $input =~ s/^((?:.{2})*?)([^x])\2/$1$2x$2/i ) { }
+
+        my @chars = explode( lc($input) );
+        if ( @chars % 2 ) {
+            push @chars, 'x';
+        }
+
+        my @bigrams = chunks_of( 2, @chars );
+
+        my @transformed_bigrams =
+          map { _transform_bigram( $_, $keytable ) } @bigrams;
+
+        my $transformed = implode( flatten(@transformed_bigrams) );
+        return $transformed;
+    }
+
+    sub _transform_bigram ( $bigram, $keytable ) {
+        my ( $first, $second ) = @$bigram;
+
+        my %positions =
+          flatten( zip( [ flatten( @{$keytable} ) ], [ 0 .. 24 ] ) );
+        $positions{'j'} = $positions{'i'};
+
+        my $real_pos = sub($x) { ( int( $x / 5 ), $x % 5 ) };
+
+        my ( $first_row,  $first_col )  = $real_pos->( $positions{$first} );
+        my ( $second_row, $second_col ) = $real_pos->( $positions{$second} );
+
+        if ( $first_row == $second_row ) {
+            return [
+                $keytable->[$first_row][  ( $first_col + 1 ) % 5 ],
+                $keytable->[$second_row][ ( $second_col + 1 ) % 5 ],
+            ];
+        }
+
+        if ( $first_col == $second_col ) {
+            return [
+                $keytable->[ ( $first_row + 1 ) % 5 ][$first_col],
+                $keytable->[ ( $second_row + 1 ) % 5 ][$second_col],
+            ];
+        }
+
+        return [
+            $keytable->[$first_row][$second_col],
+            $keytable->[$second_row][$first_col],
+        ];
+
+    }
+
+    sub _build_keytable($keyphrase) {
+        $keyphrase = lc($keyphrase);
+        $keyphrase =~ s/[^a-z]//g;
+        $keyphrase =~ s/j/i/g;
+        my @alphabet = ( 'a' .. 'i', 'k' .. 'z' );
+        my @keyphrase_letters =
+          uniq( explode( lc($keyphrase) ) );
+        my @remaining = without( \@alphabet, \@keyphrase_letters );
+
+        return chunks_of( 5, @keyphrase_letters, @remaining );
+    }
+}
+