Merge pull request #10679 from pauloscustodio/master

Add Perl solution to challenge 236

10 files changed, 319 insertions, 0 deletions

diff --git a/challenge-236/paulo-custodio/Makefile b/challenge-236/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-236/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-236/paulo-custodio/perl/ch-1.pl b/challenge-236/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..97e1794293
--- /dev/null
+++ b/challenge-236/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/env perl
+
+# Challenge 236
+#
+# Task 1: Exact Change
+# Submitted by: Mohammad S Anwar
+#
+# You are asked to sell juice each costs $5. You are given an array of bills.
+# You can only sell ONE juice to each customer but make sure you return exact
+# change back. You only have $5, $10 and $20 notes. You do not have any change
+# in hand at first.
+#
+# Write a script to find out if it is possible to sell to each customers with
+# correct change.
+# Example 1
+#
+# Input: @bills = (5, 5, 5, 10, 20)
+# Output: true
+#
+# From the first 3 customers, we collect three $5 bills in order.
+# From the fourth customer, we collect a $10 bill and give back a $5.
+# From the fifth customer, we give a $10 bill and a $5 bill.
+# Since all customers got correct change, we output true.
+#
+# Example 2
+#
+# Input: @bills = (5, 5, 10, 10, 20)
+# Output: false
+#
+# From the first two customers in order, we collect two $5 bills.
+# For the next two customers in order, we collect a $10 bill and give back a $5 bill.
+# For the last customer, we can not give the change of $15 back because we only have two $10 bills.
+# Since not every customer received the correct change, the answer is false.
+#
+# Example 3
+#
+# Input: @bills = (5, 5, 5, 20)
+# Output: true
+
+use Modern::Perl;
+
+my $PRICE = 5;
+
+my @customers = @ARGV;
+say is_exact_change(@customers) ? "true" : "false";
+
+sub is_exact_change {
+    my(@customers) = @_;
+    my @bills;
+    while (@customers) {
+        my $received = shift @customers;
+        $bills[$received]++;
+        my $change = $received - $PRICE;
+        while ($change != 0) {
+            my $found;
+            for my $bill (reverse 0..$#bills) {
+                if (defined($bills[$bill]) && $change >= $bill && $bills[$bill] > 0) {
+                    $bills[$bill]--;
+                    $change -= $bill;
+                    $found = 1;
+                    last;
+                }
+            }
+            next if $found;
+            return 0;       # not possible to give correct change
+        }
+    }
+    return 1;
+}
diff --git a/challenge-236/paulo-custodio/perl/ch-2.pl b/challenge-236/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..498cf6f11a
--- /dev/null
+++ b/challenge-236/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/env perl
+
+# Challenge 236
+#
+# Task 2: Array Loops
+# Submitted by: Mark Anderson
+#
+# You are given an array of unique integers.
+#
+# Write a script to determine how many loops are in the given array.
+#
+#     To determine a loop: Start at an index and take the number at array[index]
+#     and then proceed to that index and continue this until you end up at the
+#     starting index.
+#
+#
+# Example 1
+#
+# Input: @ints = (4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10)
+# Output: 3
+#
+# To determine the 1st loop, start at index 0, the number at that index is 4,
+# proceed to index 4, the number at that index is 15, proceed to index 15 and
+# so on until you're back at index 0.
+#
+# Loops are as below:
+# [4 15 1 6 13 5 0]
+# [3 8 7 18 9 16 12 17 2]
+# [14 11 19 10]
+#
+# Example 2
+#
+# Input: @ints = (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19)
+# Output: 6
+#
+# Loops are as below:
+# [0]
+# [1]
+# [13 9 14 17 18 15 5 8 2]
+# [7 11 4 6 10 16 3]
+# [12]
+# [19]
+#
+# Example 3
+#
+# Input: @ints = (9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17)
+# Output: 1
+#
+# Loop is as below:
+# [9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0]
+
+use Modern::Perl;
+
+my @ints = @ARGV;
+my @visited = (0) x @ints;
+my $loops = 0;
+
+while ((my $start = next_unvisited(@visited)) != -1) {
+    do_loop($start, \@ints, \@visited);
+    $loops++;
+}
+say $loops;
+
+sub next_unvisited {
+    my(@visited) = @_;
+    for my $i (0 .. $#visited) {
+        return $i if !$visited[$i];
+    }
+    return -1;
+}
+
+sub do_loop {
+    my($start, $ints, $visited) = @_;
+    my $i = $start;
+    $visited->[$i] = 1;
+    while ($ints->[$i] != $start) {
+        return if $ints->[$i] == $start;
+        $i = $ints->[$i];
+        $visited->[$i] = 1;
+    }
+}
diff --git a/challenge-236/paulo-custodio/t/test-1.yaml b/challenge-236/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..e619be8b59
--- /dev/null
+++ b/challenge-236/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     5 5 5 10 20
+  input:
+  output:   true
+- setup:
+  cleanup:
+  args:     5 5 10 10 20
+  input:
+  output:   false
+- setup:
+  cleanup:
+  args:     5 5 5 20
+  input:
+  output:   true
diff --git a/challenge-236/paulo-custodio/t/test-2.yaml b/challenge-236/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..5d9d4b9b8a
--- /dev/null
+++ b/challenge-236/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10
+  input:
+  output:   3
+- setup:
+  cleanup:
+  args:     0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19
+  input:
+  output:   6
+- setup:
+  cleanup:
+  args:     9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17
+  input:
+  output:   1
diff --git a/challenge-237/paulo-custodio/Makefile b/challenge-237/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-237/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-237/paulo-custodio/perl/ch-1.pl b/challenge-237/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..367e6b5820
--- /dev/null
+++ b/challenge-237/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+
+# Challenge 237
+#
+# Task 1: Seize The Day
+# Submitted by: Mark Anderson
+#
+# Given a year, a month, a weekday of month, and a day of week (1 (Mon) ..
+# 7 (Sun)), print the day.
+#
+# Example 1
+#
+# Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2
+# Output: 16
+#
+# The 3rd Tue of Apr 2024 is the 16th
+#
+# Example 2
+#
+# Input: Year = 2025, Month = 10, Weekday of month = 2, day of week = 4
+# Output: 9
+#
+# The 2nd Thu of Oct 2025 is the 9th
+#
+# Example 3
+#
+# Input: Year = 2026, Month = 8, Weekday of month = 5, day of week = 3
+# Output: 0
+#
+# There isn't a 5th Wed in Aug 2026
+
+use Modern::Perl;
+use DateTime;
+
+my($year, $month, $wdom, $dow) = @ARGV;
+say find($year, $month, $wdom, $dow);
+
+sub find {
+    my($year, $month, $wdom, $dow) = @_;
+    my $count = 0;
+    for my $day (1 .. DateTime->last_day_of_month(year=>$year, month=>$month)->day) {
+        my $dt = DateTime->new(year=>$year, month=>$month, day=>$day);
+        if ($dt->dow == $dow) {
+            $count++;
+            if ($count==$wdom) {
+                return $day;
+            }
+        }
+    }
+    return 0;
+}
diff --git a/challenge-237/paulo-custodio/perl/ch-2.pl b/challenge-237/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..0cd8ec195e
--- /dev/null
+++ b/challenge-237/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+# Challenge 237
+#
+# Task 2: Maximise Greatness
+# Submitted by: Mohammad S Anwar
+#
+# You are given an array of integers.
+#
+# Write a script to permute the give array such that you get the maximum
+# possible greatness.
+#
+#     To determine greatness, nums[i] < perm[i] where 0 <= i < nums.length
+#
+#
+# Example 1
+#
+# Input: @nums = (1, 3, 5, 2, 1, 3, 1)
+# Output: 4
+#
+# One possible permutation: (2, 5, 1, 3, 3, 1, 1) which returns 4 greatness as
+# below:
+# nums[0] < perm[0]
+# nums[1] < perm[1]
+# nums[3] < perm[3]
+# nums[4] < perm[4]
+#
+# Example 2
+#
+# Input: @ints = (1, 2, 3, 4)
+# Output: 3
+#
+# One possible permutation: (2, 3, 4, 1) which returns 3 greatness as below:
+# nums[0] < perm[0]
+# nums[1] < perm[1]
+# nums[2] < perm[2]
+
+use Modern::Perl;
+use Math::Combinatorics;
+use List::Util 'max';
+
+my @nums = @ARGV;
+
+my $combinat = Math::Combinatorics->new(count => scalar(@nums), data => \@nums);
+my $max_greatness = 0;
+my @permu;
+while (@permu = $combinat->next_permutation) {
+    $max_greatness = max($max_greatness, calc_greatness(\@nums, \@permu));
+}
+say $max_greatness;
+
+sub calc_greatness {
+    my($nums, $permu) = @_;
+    my $greatness = 0;
+    for my $i (0 .. $#$nums) {
+        $greatness++ if $nums->[$i] < $permu->[$i];
+    }
+    return $greatness;
+}
diff --git a/challenge-237/paulo-custodio/t/test-1.yaml b/challenge-237/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..6bf3564221
--- /dev/null
+++ b/challenge-237/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,15 @@
+- setup:
+  cleanup:
+  args:     2024 4 3 2
+  input:
+  output:   16
+- setup:
+  cleanup:
+  args:     2025 10 2 4
+  input:
+  output:   9
+- setup:
+  cleanup:
+  args:     2026 8 5 3
+  input:
+  output:   0
diff --git a/challenge-237/paulo-custodio/t/test-2.yaml b/challenge-237/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..dc53115e28
--- /dev/null
+++ b/challenge-237/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:     1 3 5 2 1 3 1
+  input:
+  output:   4
+- setup:
+  cleanup:
+  args:     1 2 3 4
+  input:
+  output:   3