w342 - Task 1 & 2 (Perl)

2 files changed, 87 insertions, 0 deletions

diff --git a/challenge-342/perlboy1967/perl/ch1.pl b/challenge-342/perlboy1967/perl/ch1.pl
new file mode 100755
index 0000000000..5d5d2ecec9
--- /dev/null
+++ b/challenge-342/perlboy1967/perl/ch1.pl
@@ -0,0 +1,50 @@
+#!/bin/perl
+
+=pod
+
+L<https://theweeklychallenge.org/blog/perl-weekly-challenge-342#TASK1>
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Balance String
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string made up of lowercase English letters and digits only.
+
+Write a script to format the give string where no letter is followed by
+another letter and no digit is followed by another digit. If there are 
+multiple valid rearrangements, always return the lexicographically smallest
+one. Return empty string if it is impossible to format the string.
+
+=cut
+
+use Test2::V0 qw(-no_srand);
+use exact 'v5.32', -signatures;
+
+use List::MoreUtils qw(zip);
+
+sub balanceString ($str) {
+  my (@d,@c);
+
+  map { /\d/ ? push(@d,$_) : push(@c,$_) } split(//,$str);
+
+  return '' if (abs(@d - @c) > 1);
+
+  if (@c <= @d) {
+    push(@c,'') if @c != @d;
+    return join '', zip(@d,@c);
+  } elsif (@c > @d) {
+    push(@d,'');
+    return join '', zip(@c,@d);
+  }
+}
+
+is(balanceString('a0b1c2'),'0a1b2c','Example 1');
+is(balanceString('abc12'),'a1b2c','Example 2');
+is(balanceString('0a2b1c3'),'0a2b1c3','Example 3');
+is(balanceString('1a23'),'','Example 4');
+is(balanceString('ab123'),'1a2b3','Example 5');
+is(balanceString('a'),'a','Own example 1');
+is(balanceString('1'),'1','Own example 2');
+
+done_testing;
diff --git a/challenge-342/perlboy1967/perl/ch2.pl b/challenge-342/perlboy1967/perl/ch2.pl
new file mode 100755
index 0000000000..68c9922647
--- /dev/null
+++ b/challenge-342/perlboy1967/perl/ch2.pl
@@ -0,0 +1,37 @@
+#!/bin/perl
+
+=pod
+
+L<https://theweeklychallenge.org/blog/perl-weekly-challenge-342#TASK2>
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Max Score
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string, $str, containing 0 and 1 only.
+
+Write a script to return the max score after splitting the string into 
+two non-empty substrings. The score after splitting a string is the number
+of zeros in the left substring plus the number of ones in the right substring.
+
+=cut
+
+use Test2::V0 qw(-no_srand);
+use exact 'v5.32', -signatures;
+
+use List::Util qw(max);
+
+sub maxScore ($str) {
+  max map { 
+        substr($str,0,$_) =~ tr/0/0/ + substr($str,$_) =~ tr/1/1/ 
+      } (1 .. length($str) - 1);
+}
+
+is(maxScore('0011'),4,'Example 1');
+is(maxScore('0000'),3,'Example 2');
+is(maxScore('1111'),3,'Example 3');
+is(maxScore('0101'),3,'Example 4');
+is(maxScore('011101'),5,'Example 5');
+
+done_testing;