Merge pull request #9954 from spadacciniweb/PWC-265

Add ch-1 and ch-2 in Perl

2 files changed, 158 insertions, 0 deletions

diff --git a/challenge-265/spadacciniweb/perl/ch-1.pl b/challenge-265/spadacciniweb/perl/ch-1.pl
new file mode 100644
index 0000000000..e8d82bf5db
--- /dev/null
+++ b/challenge-265/spadacciniweb/perl/ch-1.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+
+# Task 1: 33% Appearance
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given an array of integers, @ints.
+# Write a script to find an integer in the given array that appeared 33% or more. If more than one found, return the smallest. If none found then return undef.
+# Example 1
+# 
+# Input: @ints = (1,2,3,3,3,3,4,2)
+# Output: 3
+# 
+# 1 appeared 1 times.
+# 2 appeared 2 times.
+# 3 appeared 4 times.
+# 
+# 3 appeared 50% (>33%) in the given array.
+# 
+# Example 2
+# Input: @ints = (1,1)
+# Output: 1
+# 
+# 1 appeared 2 times.
+# 1 appeared 100% (>33%) in the given array.
+# 
+# Example 3
+# Input: @ints = (1,2,3)
+# Output: 1
+# 
+# 1 appeared 1 times.
+# 2 appeared 1 times.
+# 3 appeared 1 times.
+# 
+# Since all three appeared 33.3% (>33%) in the given array.
+# We pick the smallest of all.
+
+use strict;
+use warnings;
+use List::Util qw/ min /;
+
+my @ints = (1,2,3,3,3,3,4,2);
+appearance(\@ints);
+
+@ints = (1,1);
+appearance(\@ints);
+
+@ints = (1,2,3);
+appearance(\@ints);
+
+exit 0;
+
+sub appearance {
+    my $ints = shift;
+
+    my %ints;
+    $ints{$_}++
+        foreach @$ints;
+
+     printf "(%s) -> %s\n",
+        (join ',', @$ints),
+        min ( grep { $ints{$_} / (scalar @$ints) >= 0.33 } keys %ints );
+}
diff --git a/challenge-265/spadacciniweb/perl/ch-2.pl b/challenge-265/spadacciniweb/perl/ch-2.pl
new file mode 100644
index 0000000000..2be9430e73
--- /dev/null
+++ b/challenge-265/spadacciniweb/perl/ch-2.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+
+# Task 2: Completing Word
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a string, $str containing alphnumeric characters and array of strings (alphabetic characters only), @str.
+# 
+# Write a script to find the shortest completing word. If none found return empty string.
+# 
+#     A completing word is a word that contains all the letters in the given string, ignoring space and number. If a letter appeared more than once in the given string then it must appear the same number or more in the word.
+# 
+# Example 1
+# 
+# Input: $str = 'aBc 11c'
+#        @str = ('accbbb', 'abc', 'abbc')
+# Output: 'accbbb'
+# 
+# The given string contains following, ignoring case and number:
+# a 1 times
+# b 1 times
+# c 2 times
+# 
+# The only string in the given array that satisfies the condition is 'accbbb'.
+# 
+# Example 2
+# 
+# Input: $str = 'Da2 abc'
+#        @str = ('abcm', 'baacd', 'abaadc')
+# Output: 'baacd'
+# 
+# The given string contains following, ignoring case and number:
+# a 2 times
+# b 1 times
+# c 1 times
+# d 1 times
+# 
+# The are 2 strings in the given array that satisfies the condition:
+# 'baacd' and 'abaadc'.
+# 
+# Shortest of the two is 'baacd'
+# 
+# Example 3
+# 
+# Input: $str = 'JB 007'
+#        @str = ('jj', 'bb', 'bjb')
+# Output: 'bjb'
+# 
+# The given string contains following, ignoring case and number:
+# j 1 times
+# b 1 times
+# 
+# The only string in the given array that satisfies the condition is 'bjb'.
+
+use strict;
+use warnings;
+
+my $str = 'aBc 11c';
+my @str = ('accbbb', 'abc', 'abbc');
+completing_word($str, \@str);
+
+$str = 'Da2 abc';
+@str = ('abcm', 'baacd', 'abaadc');
+completing_word($str, \@str);
+
+$str = 'JB 007';
+@str = ('jj', 'bb', 'bjb');
+completing_word($str, \@str);
+
+exit 0;
+
+sub completing_word {
+    my $str = shift;
+    my $strs = shift;
+
+    my $str_lc = lc($str);
+    my $return_str = '';
+    $str_lc =~ s/\W|\d//g;
+    my @strs = sort { (length $a) <=> (length $b) } @$strs;
+    foreach my $strs (sort { (length $a) <=> (length $b) } @$strs) {
+        my %freq;
+        $freq{$_}++
+            foreach split //, $strs;
+        $freq{$_}--
+            foreach split //, $str_lc;
+
+        if ( scalar (map { $freq{$_} < 0 ? 1 : () } keys %freq) == 0) {
+            $return_str = $strs;
+            last;
+        }
+    }
+    
+    printf "'%s' ('%s') -> %s\n",
+        $str,
+        (join '\', \'', @$strs),
+        $return_str;
+}