w335 - Task 1 & 2

2 files changed, 99 insertions, 0 deletions

diff --git a/challenge-335/perlboy1967/perl/ch1.pl b/challenge-335/perlboy1967/perl/ch1.pl
new file mode 100755
index 0000000000..84b2ae0fd4
--- /dev/null
+++ b/challenge-335/perlboy1967/perl/ch1.pl
@@ -0,0 +1,41 @@
+#!/bin/perl
+
+=pod
+
+L<https://theweeklychallenge.org/blog/perl-weekly-challenge-335#TASK1>
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 1: Common Characters
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of words.
+
+Write a script to return all characters that is in every word in the given
+array including duplicates.
+
+=cut
+
+use Test2::V0 qw(-no_srand);
+use exact 'v5.32', -signatures;
+
+use List::Util qw(min);
+use List::MoreUtils qw(frequency);
+
+sub commonCharacters (@words) {
+  my (%chars,@wFreq);
+  # Build list with word character frequency numbers
+  push(@wFreq,{ frequency map { $chars{$_} = 1; $_ } split // }) for (@words);
+  # Return common characters based on minimum found per character
+  return map { 
+    my $char = $_; ($char) x min(map { $$_{$char} // 0 } @wFreq);
+  } sort keys %chars;
+}
+
+is [commonCharacters(qw{bella label roller})],[qw{e l l}],'Example 1';
+is [commonCharacters(qw{cool lock cook})],[qw{c o}],'Example 2';
+is [commonCharacters(qw{hello world pole})],[qw{l o}],'Example 3';
+is [commonCharacters(qw{abc def ghi})],[],'Example 4';
+is [commonCharacters(qw{aab aac aaa})],[qw{a a}],'Example 5';
+
+done_testing()
diff --git a/challenge-335/perlboy1967/perl/ch2.pl b/challenge-335/perlboy1967/perl/ch2.pl
new file mode 100755
index 0000000000..8717eca5c3
--- /dev/null
+++ b/challenge-335/perlboy1967/perl/ch2.pl
@@ -0,0 +1,58 @@
+#!/bin/perl
+
+=pod
+
+L<https://theweeklychallenge.org/blog/perl-weekly-challenge-335#TASK2>
+
+Author: Niels 'PerlBoy' van Dijke
+
+Task 2: Find Winner
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of all moves by the two players.
+
+Write a script to find the winner of the TicTacToe game if found based on
+the moves provided in the given array.
+
+UPDATE: Order move is in the order - A, B, A, B, A, ...
+
+=cut
+
+use Test2::V0 qw(-no_srand);
+use exact 'v5.32', -signatures;
+
+sub findWinner (@moves) {
+  # Define winner regexp ($+{w} is the winner)
+  state $re = qr/
+    ^(?<w>AAA|BBB)          | # Row 1
+    ^... (?<w>AAA|BBB)      | # Row 2
+    ^... ... (?<w>AAA|BBB)  | # Row 3
+    ^(?<w>[AB]).. \4.. \4   | # Column 1
+    ^.(?<w>[AB]). .\5. .\5  | # Column 2
+    ^..(?<w>[AB]) ..\6 ..\6 | # Column 3
+    ^(?<w>[AB]).. .\7. ..\7 | # Diagonal 1
+    ^..(?<w>[AB]) .\8. \8     # Diagonal 2 
+ /x;
+
+ # Initialise the board
+ my $board = '_' x 9;
+
+ # Initialise the turns
+ my @turns = qw(A B A B A B A B A);
+
+ for (@moves) {
+   substr($board, $_->[0] * 3 + $_->[1], 1, shift @turns);
+ }
+
+ return substr($+{w}, 0, 1) if ($board =~ $re);
+ return 'Pending' if (@moves < 9);
+ return 'Draw';
+}
+
+is findWinner([0,0],[2,0],[1,1],[2,1],[2,2]),'A','Example 1 (A wins)';
+is findWinner([0,0],[1,1],[0,1],[0,2],[1,0],[2,0]),'B','Example 2 (B wins)';
+is findWinner([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2]),'Draw','Example 3 (Draw)';
+is findWinner([0,0],[1,1]),'Pending','Example 4 (Pending)';
+is findWinner([1,1],[0,0],[2,2],[0,1],[1,0],[0,2]),'B','Example 5 (B wins)';
+
+done_testing;