sgreen solution to challenge 097

4 files changed, 76 insertions, 2 deletions

diff --git a/challenge-097/sgreen/README.md b/challenge-097/sgreen/README.md
index 4f295734b3..63010965b5 100644
--- a/challenge-097/sgreen/README.md
+++ b/challenge-097/sgreen/README.md
@@ -1,3 +1,3 @@
-# The Weekly Challenge 095
+# The Weekly Challenge 097
 
-Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-095-2jkl)
+Solution by Simon Green. [Blog](https://dev.to/simongreennet/weekly-challenge-097-3ag8)
diff --git a/challenge-097/sgreen/blog.txt b/challenge-097/sgreen/blog.txt
new file mode 100644
index 0000000000..88369b2577
--- /dev/null
+++ b/challenge-097/sgreen/blog.txt
@@ -0,0 +1 @@
+https://dev.to/simongreennet/weekly-challenge-097-3ag8
diff --git a/challenge-097/sgreen/perl/ch-1.pl b/challenge-097/sgreen/perl/ch-1.pl
new file mode 100755
index 0000000000..467b11df3f
--- /dev/null
+++ b/challenge-097/sgreen/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+sub main {
+    my ( $string, $offset ) = @_;
+
+    # Sanity check
+    die "You must enter a string\n" if not defined $string;
+    die "You must enter a number\n" if not defined $offset;
+    die "The string can only contain the letters A - Z and spaces\n" unless $string =~ /^[A-Z ]+$/;
+    die "The value '$offset' does not look like an integer between 1 and 25\n"
+      unless $offset =~ /^\d+$/
+      and $offset > 0
+      and $offset < 26;
+
+    # Work out the plain text cipher
+    my $plain  = join '', ( 'A' .. 'Z' );
+    my $cipher = substr( $plain, -$offset ) . substr( $plain, 0, 26 - $offset );
+
+    # Create a mapping table
+    my %mapping = ( ' ' => ' ' );
+    for my $i ( 0 .. 25 ) {
+        $mapping{ substr( $plain, $i, 1 ) } = substr( $cipher, $i, 1 );
+    }
+
+    # Translate
+    my $ciphertext = join '', map { $mapping{$_} } split //, $string;
+    say $ciphertext;
+}
+
+main(@ARGV);
diff --git a/challenge-097/sgreen/perl/ch-2.pl b/challenge-097/sgreen/perl/ch-2.pl
new file mode 100755
index 0000000000..2dc6109dee
--- /dev/null
+++ b/challenge-097/sgreen/perl/ch-2.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature 'say';
+
+sub main {
+    my ( $B, $S ) = @_;
+
+    # Sanity check
+    die "You must enter a binary string\n"                        unless $B;
+    die "You must enter an integer\n"                             unless $S;
+    die "The binary string can only contain ones and zeros\n"     unless $B =~ /^[01]+$/;
+    die "The second value doesn't look like a postive integer!\n" unless $S =~ /^[1-9][0-9]*$/;
+
+    # Expand the binary string if necessary, and then split it
+    while ( length($B) % $S ) { $B = "0$B" }
+    my @chunks = unpack( "(A$S)*", $B );
+
+    # Find the most used character at each bit
+    my $most_used = '';
+    foreach my $i ( 0 .. $S - 1 ) {
+        my $is_set = scalar( grep { substr( $_, $i, 1 ) } @chunks );
+        $most_used .= $is_set > scalar( @chunks / 2 ) ? '1' : '0';
+    }
+
+    # Calculate the number of flips required
+    my $flips = 0;
+    foreach my $chunk (@chunks) {
+        foreach my $i ( 0 .. $S - 1 ) {
+            ++$flips if substr( $chunk, $i, 1 ) ne substr( $most_used, $i, 1 );
+        }
+    }
+
+    say $flips;
+
+}
+
+main(@ARGV);