Add Perl solution to challenge 270

5 files changed, 176 insertions, 0 deletions

diff --git a/challenge-270/paulo-custodio/Makefile b/challenge-270/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-270/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-270/paulo-custodio/perl/ch-1.pl b/challenge-270/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..a143b72356
--- /dev/null
+++ b/challenge-270/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+
+# Challenge 270
+#
+# Task 1: Special Positions
+# Submitted by: Mohammad Sajid Anwar
+# You are given a m x n binary matrix.
+#
+# Write a script to return the number of special positions in the given binary matrix.
+#
+# A position (i, j) is called special if $matrix[i][j] == 1 and all other
+# elements in the row i and column j are 0.
+#
+# Example 1
+# Input: $matrix = [ [1, 0, 0],
+#                    [0, 0, 1],
+#                    [1, 0, 0],
+#                  ]
+# Output: 1
+#
+# There is only one special position (1, 2) as $matrix[1][2] == 1
+# and all other elements in row 1 and column 2 are 0.
+# Example 2
+# Input: $matrix = [ [1, 0, 0],
+#                    [0, 1, 0],
+#                    [0, 0, 1],
+#                  ]
+# Output: 3
+#
+# Special positions are (0,0), (1, 1) and (2,2).
+
+use Modern::Perl;
+
+my @matrix = split /,/, "@ARGV";
+@matrix = map {[split ' ', $_]} @matrix;
+
+say count_special_pos(@matrix);
+
+sub count_special_pos {
+    my(@matrix) = @_;
+    my $special = 0;
+    for my $i (0 .. $#matrix) {
+        for my $j (0 .. $#{$matrix[0]}) {
+            $special++ if is_special_pos($i, $j, @matrix);
+        }
+    }
+    return $special;
+}
+
+sub is_special_pos {
+    my($i, $j, @matrix) = @_;
+    return 0 if $matrix[$i][$j] != 1;
+    for my $ii (0 .. $#matrix) {
+        if ($ii != $i) {
+            return 0 if $matrix[$ii][$j] != 0;
+        }
+    }
+    for my $jj (0 .. $#{$matrix[0]}) {
+        if ($jj != $j) {
+            return 0 if $matrix[$i][$jj] != 0;
+        }
+    }
+    return 1;
+}
diff --git a/challenge-270/paulo-custodio/perl/ch-2.pl b/challenge-270/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..4e31dda4c6
--- /dev/null
+++ b/challenge-270/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,90 @@
+#!/usr/bin/env perl
+
+# Challenge 270
+#
+# Task 2: Equalize Array
+# Submitted by: Mohammad Sajid Anwar
+# You are give an array of integers, @ints and two integers, $x and $y.
+#
+# Write a script to execute one of the two options:
+#
+# Level 1:
+# Pick an index i of the given array and do $ints[i] += 1
+#
+# Level 2:
+# Pick two different indices i,j and do $ints[i] +=1 and $ints[j] += 1.
+# You are allowed to perform as many levels as you want to make every elements
+# in the given array equal. There is cost attach for each level, for Level 1,
+# the cost is $x and $y for Level 2.
+#
+# In the end return the minimum cost to get the work done.
+#
+# Example 1
+# Input: @ints = (4, 1), $x = 3 and $y = 2
+# Output: 9
+#
+# Level 1: i=1, so $ints[1] += 1.
+# @ints = (4, 2)
+#
+# Level 1: i=1, so $ints[1] += 1.
+# @ints = (4, 3)
+#
+# Level 1: i=1, so $ints[1] += 1.
+# @ints = (4, 4)
+#
+# We perforned operation Level 1, 3 times.
+# So the total cost would be 3 x $x => 3 x 3 => 9
+# Example 2
+# Input: @ints = (2, 3, 3, 3, 5), $x = 2 and $y = 1
+# Output: 6
+#
+# Level 2: i=0, j=1, so $ints[0] += 1 and $ints[1] += 1
+# @ints = (3, 4, 3, 3, 5)
+#
+# Level 2: i=0, j=2, so $ints[0] += 1 and $ints[2] += 1
+# @ints = (4, 4, 4, 3, 5)
+#
+# Level 2: i=0, j=3, so $ints[0] += 1 and $ints[3] += 1
+# @ints = (5, 4, 4, 4, 5)
+#
+# Level 2: i=1, j=2, so $ints[1] += 1 and $ints[2] += 1
+# @ints = (5, 5, 5, 4, 5)
+#
+# Level 1: i=3, so $ints[3] += 1
+# @ints = (5, 5, 5, 5, 5)
+#
+# We perforned operation Level 1, 1 time and Level 2, 4 times.
+# So the total cost would be (1 x $x) + (4 x $y) => (1 x 2) + (4 x 1) => 6
+
+use Modern::Perl;
+
+my($x, $y, @ints) = @ARGV;
+
+say equalize($x, $y, @ints);
+
+sub equalize {
+    my($x, $y, @ints) = @_;
+
+    my $cost = 0;
+    @ints = sort {$a <=> $b} @ints;
+    return $cost if !@ints;
+    my $max = $ints[-1];
+
+    while (@ints) {
+        @ints = sort {$a <=> $b} @ints;
+        @ints = grep {$_ != $max} @ints;
+        last if !@ints;
+
+        if (@ints == 1) {
+            $ints[0]++;
+            $cost += $x;
+        }
+        else {
+            $ints[0]++;
+            $ints[1]++;
+            $cost += $y;
+        }
+    }
+
+    return $cost;
+}
diff --git a/challenge-270/paulo-custodio/t/test-1.yaml b/challenge-270/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..f7b1a39e9a
--- /dev/null
+++ b/challenge-270/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:     1 0 0 , 0 0 1 , 1 0 0
+  input:
+  output:   1
+- setup:
+  cleanup:
+  args:     1 0 0 , 0 1 0 , 0 0 1
+  input:
+  output:   3
diff --git a/challenge-270/paulo-custodio/t/test-2.yaml b/challenge-270/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..ba06b2f9ec
--- /dev/null
+++ b/challenge-270/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:     3 2   4 1
+  input:
+  output:   9
+- setup:
+  cleanup:
+  args:     2 1   2 3 3 3 5
+  input:
+  output:   6