Add Perl solution to challenge 271

5 files changed, 118 insertions, 0 deletions

diff --git a/challenge-271/paulo-custodio/Makefile b/challenge-271/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-271/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-271/paulo-custodio/perl/ch-1.pl b/challenge-271/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..a724f3a898
--- /dev/null
+++ b/challenge-271/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+
+# Challenge 271
+#
+# 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 Modern::Perl;
+use List::Util 'max';
+
+my @matrix = split /,/, "@ARGV";
+@matrix = map {[split ' ', $_]} @matrix;
+
+say 1+max_ones(@matrix);
+
+sub max_ones {
+    my(@matrix) = @_;
+    my @ones = map {tr/1/1/} map {join '', @$_} @matrix;
+    my $max = max(@ones);
+    for (0 .. $#ones) {
+        return $_ if $ones[$_] == $max;
+    }
+    return 0;
+}
diff --git a/challenge-271/paulo-custodio/perl/ch-2.pl b/challenge-271/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..b442ed791c
--- /dev/null
+++ b/challenge-271/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+
+# Challenge 271
+#
+# 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 Modern::Perl;
+
+my @n = @ARGV;
+
+say join ' ',
+        map {$_->[0]}
+        sort {$a->[1] != $b->[1] ? $a->[1] <=> $b->[1] : $a->[0] <=> $b->[0]}
+        map {[$n[$_], sprintf("%b", $n[$_]) =~ tr/1/1/]} 0 .. $#n;
diff --git a/challenge-271/paulo-custodio/t/test-1.yaml b/challenge-271/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..aa277fd3e8
--- /dev/null
+++ b/challenge-271/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     0 1 , 1 0
+  input:
+  output:   1
+- setup:
+  cleanup:
+  args:     0 0 0 , 1 0 1
+  input:
+  output:   2
+- setup:
+  cleanup:
+  args:     0 0 , 1 1 , 0 0
+  input:
+  output:   2
diff --git a/challenge-271/paulo-custodio/t/test-2.yaml b/challenge-271/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..248d4ffc6b
--- /dev/null
+++ b/challenge-271/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:     0 1 2 3 4 5 6 7 8
+  input:
+  output:   0 1 2 4 8 3 5 6 7
+- setup:
+  cleanup:
+  args:     1024 512 256 128 64
+  input:
+  output:   64 128 256 512 1024