Merge pull request #3413 from LubosKolouch/master

Challenge 097 LK Perl

2 files changed, 104 insertions, 0 deletions

diff --git a/challenge-097/lubos-kolouch/perl/ch-1.pl b/challenge-097/lubos-kolouch/perl/ch-1.pl
new file mode 100644
index 0000000000..db63827bc7
--- /dev/null
+++ b/challenge-097/lubos-kolouch/perl/ch-1.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-1.pl
+#
+#        USAGE: ./ch-1.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge 097
+#               Task 1
+#               Caesar Cipher
+#
+#       AUTHOR: Lubos Kolouch
+#      CREATED: 01/30/2021 10:11:26 AM
+#===============================================================================
+
+use strict;
+use warnings;
+use feature qw/say/;
+
+sub caesar_cipher {
+    my $what = shift;
+
+    my $inp = $what->[0];
+    my $shift = $what->[1];
+
+    my $result = '';
+
+    for (split '', $inp) {
+        
+        if (((ord($_) < ord('A')) or (ord($_) > ord('Z')))) {
+                    $result .= $_;
+                    next;
+        }
+
+        my $translated = ord($_) - $shift;
+
+        $translated = ord('Z') - ord('A') + $translated + 1 if $translated < ord('A');
+
+        $result .= chr($translated);
+    }
+
+    return $result;
+}
+
+use Test::More;
+
+is(caesar_cipher(['THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG',3]),'QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD');
+is(caesar_cipher(['ABCDEFGHIJKLMNOPQRSTUVWXYZ', 3]), 'XYZABCDEFGHIJKLMNOPQRSTUVW');
+
+done_testing;
diff --git a/challenge-097/lubos-kolouch/perl/ch-2.pl b/challenge-097/lubos-kolouch/perl/ch-2.pl
new file mode 100644
index 0000000000..9294a08f79
--- /dev/null
+++ b/challenge-097/lubos-kolouch/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl 
+#===============================================================================
+#
+#         FILE: ch-2.pl
+#
+#        USAGE: ./ch-2.pl  
+#
+#  DESCRIPTION: Perl Weekly Challenge 097
+#               Task 2
+#               Binary Substrings
+#
+#       AUTHOR: Lubos Kolouch
+#      CREATED: 01/30/2021 10:11:26 AM
+#===============================================================================
+
+use strict;
+use warnings;
+use feature qw/say/;
+use Data::Dumper;
+use List::Util qw/min/;
+
+sub binary_substrings {
+    my $what = shift;
+
+    my $inp_bin = $what->[0];
+    my $split_nr = $what->[1];
+
+
+    # count 0s and 1s at each position
+
+    my %counts;
+    
+    my $pos = 0;
+    for (split '', $inp_bin) {
+        $counts{$pos}{$_}++;
+        $pos++;
+        $pos = $pos % $split_nr;
+    }
+
+    # if both positions exist, count the smaller one
+    my $flips = 0;
+
+    for my $key (keys %counts) {
+        $flips += min(values %{$counts{$key}}) if (defined $counts{$key}{'0'}) and (defined $counts{$key}{'1'});
+    }
+
+    return $flips;
+}
+
+use Test::More;
+
+is(binary_substrings(['101100101', 3]), 1);
+is(binary_substrings(['10110111', 4]), 2);
+done_testing;