PWC-271 Add ch-1 and ch-2 in Perl

2 files changed, 114 insertions, 0 deletions

diff --git a/challenge-271/spadacciniweb/perl/ch-1.pl b/challenge-271/spadacciniweb/perl/ch-1.pl
new file mode 100644
index 0000000000..aea02f289e
--- /dev/null
+++ b/challenge-271/spadacciniweb/perl/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+
+# Task 1: Maximum Ones
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are given a m x n binary matrix.
+# Write a script to return the row number containing maximum ones, in case of more than one rows then return smallest row number.
+# Example 1
+# 
+# Input: $matrix = [ [0, 1],
+#                    [1, 0],
+#                  ]
+# Output: 1
+# Row 1 and Row 2 have the same number of ones, so return row 1.
+# 
+# Example 2
+# Input: $matrix = [ [0, 0, 0],
+#                    [1, 0, 1],
+#                  ]
+# Output: 2
+# Row 2 has the maximum ones, so return row 2.
+# 
+# Example 3
+# Input: $matrix = [ [0, 0],
+#                    [1, 1],
+#                    [0, 0],
+#                  ]
+# Output: 2
+# Row 2 have the maximum ones, so return row 2.
+
+use strict;
+use warnings;
+use List::Util qw(sum max min);
+
+my $matrix = [[0, 1],
+              [1, 0]
+             ];
+maximum_ones($matrix);
+
+$matrix = [[0, 0, 0],
+           [1, 0, 1]
+          ];
+maximum_ones($matrix);
+
+$matrix = [[0, 0],
+           [1, 1],
+           [0, 0]
+          ];
+maximum_ones($matrix);
+
+exit 0;
+
+sub maximum_ones {
+    my $matrix = shift;
+    my %rows = map { $_ => sum(@{$matrix->[$_]}) }
+                 (0..(scalar(@$matrix)-1));
+    my $max = max values %rows;
+    printf "row %d\n",
+        (min map { $rows{$_} == $max ? $_ : () } keys %rows ) + 1;
+    return 0;
+}
diff --git a/challenge-271/spadacciniweb/perl/ch-2.pl b/challenge-271/spadacciniweb/perl/ch-2.pl
new file mode 100644
index 0000000000..6ae42294e4
--- /dev/null
+++ b/challenge-271/spadacciniweb/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+
+# Task 2: Sort by 1 bits
+# Submitted by: Mohammad Sajid Anwar
+# 
+# You are give an array of integers, @ints.
+# Write a script to sort the integers in ascending order by the number of 1 bits in their binary representation. In case more than one integers have the same number of 1 bits then sort them in ascending order.
+#
+# Example 1
+# Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
+# Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)
+# 
+# 0 = 0 one bits
+# 1 = 1 one bits
+# 2 = 1 one bits
+# 4 = 1 one bits
+# 8 = 1 one bits
+# 3 = 2 one bits
+# 5 = 2 one bits
+# 6 = 2 one bits
+# 7 = 3 one bits
+# 
+# Example 2
+# Input: @ints = (1024, 512, 256, 128, 64)
+# Output: (64, 128, 256, 512, 1024)
+# 
+# All integers in the given array have one 1-bits, so just sort them in ascending order.
+
+use strict;
+use warnings;
+use List::Util qw/ sum /;
+
+my @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8);
+sort_by_1_bits(\@ints);
+
+@ints = (1024, 512, 256, 128, 64);
+sort_by_1_bits(\@ints);
+
+exit 0;
+
+sub sort_by_1_bits {
+    my $ints = shift;
+
+    my %binary;
+    foreach my $int (@ints) {
+        push @{ $binary{ sum split //, sprintf '%b', $int } }, $int;
+    }
+    printf " (%s) -> (%s)\n",
+        ( join ', ', @ints ),
+        ( join ', ', map { sort { $a <=> $b } @{ $binary{$_} } }
+            sort { $a <=> $b } keys %binary
+        );
+}