Merge pull request #1229 from PerlMonk-Athanasius/branch-for-challenge-046

Perl solutions to Tasks 1 & 2 of the Perl Weekly Challenge #046

2 files changed, 153 insertions, 0 deletions

diff --git a/challenge-046/athanasius/perl/ch-1.pl b/challenge-046/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..fbc4d28abb
--- /dev/null
+++ b/challenge-046/athanasius/perl/ch-1.pl
@@ -0,0 +1,88 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 046
+=========================
+
+Task #1
+-------
+*Cryptic Message*
+
+The communication system of an office is broken and message received are not
+completely reliable. To send message Hello, it ended up sending these following:
+
+  H x l 4 !
+  c e - l o
+  z e 6 l g
+  H W l v R
+  q 9 m # o
+
+Similary another day we received a message repeatedly like below:
+
+  P + 2 l ! a t o
+  1 e 8 0 R $ 4 u
+  5 - r ] + a > /
+  P x w l b 3 k \
+  2 e 3 5 R 8 y u
+  < ! r ^ ( ) k 0
+
+Write a script to decrypt the above repeated message (one message repeated 6
+times).
+
+*HINT: Look for characters repeated in a particular position in all six messages
+received.*
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+
+BEGIN
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $message = 'P + 2 l ! a t o
+                   1 e 8 0 R $ 4 u
+                   5 - r ] + a > /
+                   P x w l b 3 k \
+                   2 e 3 5 R 8 y u
+                   < ! r ^ ( ) k 0';
+    my $array   = make_array($message);
+    my $decrypt = '';
+
+    for my $char (0 .. $array->[0]->$#*)
+    {
+        my %opts;
+         ++$opts{ $array->[$_][$char] } for 0 .. $#$array;
+
+        $decrypt .= (sort { $opts{$b} <=> $opts{$a} } keys %opts)[0];
+    }
+
+    print "Decrypted message: $decrypt\n";
+}
+
+#-------------------------------------------------------------------------------
+sub make_array
+#-------------------------------------------------------------------------------
+{
+    my  ($message) = @_;
+    my   @array;
+    push @array, [ grep { length } split /\s+/, $_ ] for split /\n/, $message;
+
+    return \@array;
+}
+
+################################################################################
diff --git a/challenge-046/athanasius/perl/ch-2.pl b/challenge-046/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..9ed405e1bd
--- /dev/null
+++ b/challenge-046/athanasius/perl/ch-2.pl
@@ -0,0 +1,65 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 046
+=========================
+
+Task #2
+-------
+*Is the room open?*
+
+There are 500 rooms in a hotel with 500 employees having keys to all the rooms.
+The first employee opened main entrance door of all the rooms. The second
+employee then closed the doors of room numbers 2,4,6,8,10 and so on to 500. The
+third employee then closed the door if it was opened or opened the door if it
+was closed of rooms 3,6,9,12,15 and so on to 500. Similarly the fourth employee
+did the same as the third but only room numbers 4,8,12,16 and so on to 500. This
+goes on until all employees has had a turn.
+
+Write a script to find out all the rooms still open at the end.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my $CLOSED =>   0;
+const my $OPEN   =>   1;
+const my $ROOMS  => 500;
+
+BEGIN
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my @rooms = (-1, ($CLOSED) x $ROOMS);
+
+    for my $employee (1 .. $ROOMS)
+    {
+        for (my $door = $employee; $door <= $ROOMS; $door += $employee)
+        {
+            $rooms[$door] = ($rooms[$door] == $CLOSED ? $OPEN : $CLOSED);
+        }
+    }
+
+    my @open = grep { $rooms[$_] == $OPEN } 1 .. $#rooms;
+
+    printf "There are %d rooms still open at the end (the square-numbered " .
+           "rooms):\n%s\n", scalar @open,
+            join ', ', map { sprintf '%3d', $_ } @open;
+}
+
+################################################################################