Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

39 files changed, 3823 insertions, 3036 deletions

diff --git a/challenge-206/peter-meszaros/perl/ch-1.pl b/challenge-206/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..6aaf7a93c3
--- /dev/null
+++ b/challenge-206/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+#
+=head1 Task 1: Shortest Time
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of time points, at least 2, in the 24-hour clock format
+HH:MM.
+
+Write a script to find out the shortest time in minutes between any two time
+points.
+
+=head2 Example 1
+
+    Input: @time = ("00:00", "23:55", "20:00")
+    Output: 5
+
+    Since the difference between "00:00" and "23:55" is the shortest (5 minutes).
+
+=head2 Example 2
+
+    Input: @array = ("01:01", "00:50", "00:57")
+    Output: 4
+
+=head2 Example 3
+
+    Input: @array = ("10:10", "09:30", "09:00", "09:55")
+    Output: 15
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+
+my $cases = [
+    [["00:00", "23:55", "20:00"],           5, 'Example 1'],
+    [["01:01", "00:50", "00:57"],           4, 'Example 2'],
+    [["10:10", "09:30", "09:00", "09:55"], 15, 'Example 3'],
+];
+
+sub shortest_time
+{
+    my $l = shift;
+
+    my @l;
+    for my $t (@$l) {
+        my ($h, $m) = split ':', $t;
+        push @l, $h * 60 + $m || 1440;
+    }
+    my $min = 24 * 60;
+    for my $i (0 .. $#l-1) {
+        for my $j ($i+1 .. $#l) {
+            my $diff = abs($l[$i] - $l[$j]);
+            $min = $diff if $diff < $min;
+        }
+    }
+    return $min;
+}
+
+for (@$cases) {
+    is(shortest_time($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-206/peter-meszaros/perl/ch-2.pl b/challenge-206/peter-meszaros/perl/ch-2.pl
new file mode 100755
index 0000000000..c745f85c4e
--- /dev/null
+++ b/challenge-206/peter-meszaros/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+#
+=head1 Task 2: Array Pairings
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers having even number of elements..
+
+Write a script to find the maximum sum of the minimum of each pairs.
+
+=head2 Example 1
+
+    Input: @array = (1,2,3,4)
+    Output: 4
+
+    Possible Pairings are as below:
+    a) (1,2) and (3,4). So min(1,2) + min(3,4) => 1 + 3 => 4
+    b) (1,3) and (2,4). So min(1,3) + min(2,4) => 1 + 2 => 3
+    c) (1,4) and (2,3). So min(1,4) + min(2,3) => 2 + 1 => 3
+
+    So the maxium sum is 4.
+
+=head2 Example 2
+
+    Input: @array = (0,2,1,3)
+    Output: 2
+
+    Possible Pairings are as below:
+    a) (0,2) and (1,3). So min(0,2) + min(1,3) => 0 + 1 => 1
+    b) (0,1) and (2,3). So min(0,1) + min(2,3) => 0 + 2 => 2
+    c) (0,3) and (2,1). So min(0,3) + min(2,1) => 0 + 1 => 1
+
+    So the maximum sum is 2.
+
+=cut
+
+use strict;
+use warnings;
+use Test2::V0 -no_srand => 1;
+use Data::Dumper;
+use Algorithm::Combinatorics qw/partitions/;
+use List::Util qw/min/;
+
+my $cases = [
+    [[1, 2, 3, 4], 4, 'Example 1'],
+    [[0, 2, 1, 3], 2, 'Example 2'],
+];
+
+sub array_pairings
+{
+    my $l = shift;
+
+    my $max = 0;
+    my $iter = partitions($l, @$l/2);
+    PARTITION: while (my $c = $iter->next) {
+        my $v = 0;
+        for my $e (@$c) {
+            next PARTITION if @$e != 2;
+            $v += min(@$e);
+        }
+        $max = $v if $v > $max;
+    }
+    return $max;
+}
+
+for (@$cases) {
+    is(array_pairings($_->[0]), $_->[1], $_->[2]);
+}
+done_testing();
+
+exit 0;
diff --git a/challenge-285/laurent-rosenfeld/blog.txt b/challenge-285/laurent-rosenfeld/blog.txt
new file mode 100644
index 0000000000..af240056aa
--- /dev/null
+++ b/challenge-285/laurent-rosenfeld/blog.txt
@@ -0,0 +1 @@
+https://blogs.perl.org/users/laurent_r/2024/09/perl-weekly-challenge-285-no-connection.html
diff --git a/challenge-285/laurent-rosenfeld/perl/ch-1.pl b/challenge-285/laurent-rosenfeld/perl/ch-1.pl
new file mode 100644
index 0000000000..7fbe0a465c
--- /dev/null
+++ b/challenge-285/laurent-rosenfeld/perl/ch-1.pl
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use feature 'say';
+
+sub no_connection {
+    my %starts = map { $_->[0] => 1} @_;
+    my @ends = map { $_->[1] } @_;
+    return grep {not exists $starts{$_}} @ends;
+}
+
+my @tests = ([["B","C"], ["D","B"], ["C","A"]], [["A","Z"]]);
+for my $test (@tests) {
+    printf "%-20s => ", join " ", map {"(@{$test->[$_]})"}
+        0..scalar @$test - 1;
+    say no_connection @$test;
+}
diff --git a/challenge-285/laurent-rosenfeld/raku/ch-1.raku b/challenge-285/laurent-rosenfeld/raku/ch-1.raku
new file mode 100644
index 0000000000..9e9828f263
--- /dev/null
+++ b/challenge-285/laurent-rosenfeld/raku/ch-1.raku
@@ -0,0 +1,11 @@
+sub no-connection (@in) {
+    my @starts = map { .[0] }, @in;
+    my @ends = map { .[1] }, @in;
+    return ~ (@ends (-) @starts);
+}
+
+    my @tests = (("B","C"), ("D","B"), ("C","A")), (("A","Z"),);
+for @tests -> @test {
+    printf "%-20s => ", @test.gist;
+    say no-connection @test;
+}
diff --git a/challenge-285/matthias-muth/README.md b/challenge-285/matthias-muth/README.md
index 1c228a6fab..b0761730f3 100644
--- a/challenge-285/matthias-muth/README.md
+++ b/challenge-285/matthias-muth/README.md
@@ -1,121 +1,147 @@
-# Use `frequency` frequently!
+# Connected Coins in an Unconnected World
 
-**Challenge 284 solutions in Perl by Matthias Muth**
+**Challenge 285 solutions in Perl by Matthias Muth**
 
-Making use of `frequency` from `List::MoreUtils` gives us nice and short results for both challenges!
+## Task 1: No Connection
 
-## Task 1: Lucky Integer
-
-> You are given an array of integers, @ints.<br/>
-> Write a script to find the lucky integer if found otherwise return -1. If there are more than one then return the largest.<br/>
-> A lucky integer is an integer that has a frequency in the array equal to its value.<br/>
+> You are given a list of routes, @routes.<br/>
+> Write a script to find the destination with no further outgoing connection.<br/>
 > <br/>
 > Example 1<br/>
-> Input: @ints = (2, 2, 3, 4)<br/>
-> Output: 2<br/>
+> Input: @routes = (["B","C"], ["D","B"], ["C","A"])<br/>
+> Output: "A"<br/>
+> "D" -> "B" -> "C" -> "A".<br/>
+> "B" -> "C" -> "A".<br/>
+> "C" -> "A".<br/>
+> "A".<br/>
 > <br/>
 > Example 2<br/>
-> Input: @ints = (1, 2, 2, 3, 3, 3)<br/>
-> Output: 3<br/>
-> <br/>
-> Example 3<br/>
-> Input: @ints = (1, 1, 1, 3)<br/>
-> Output: -1<br/>
-
-For comparing the numbers in the `@ints` array to their own frequency in that array,
-we need to compute the frequencies first.
-Obviously.
-`List::MoreUtils` is our friend, once again, because its `frequency` function does exactly that.
-It returns a list of $( value, frequency )$ pairs,
-which we can simply assign to a hash, and there we are.
-
-Now we need to find the 'lucky integer',
-and if we happen to find more than one we are supposed to return the highest one.
-So we put together a chain:
-
-* `grep` with a 'lucky' condition
-  (the current number's frequency is the same as the number itself),
-  applied on all existing numbers.<br/>
-  We use `keys %freq` for the set of numbers, to make sure to check all numbers, but only once.
-* Get the highest number of the result.<br/>
-  Using `max` from `List::Util` for this.
-* If there is no lucky number at all, `max` will return `undef`.<br/>
-  We use the defined-or operator (`//`) to return a `-1` in that case.
-
-So we got our solution in two lines of code:
+> Input: @routes = (["A","Z"])<br/>
+> Output: "Z"<br/>
+
+At first glance, it seems like we need to construct a directed graph, for then analyzing it for finding the end nodes of that graph.
+
+We don't! It's much easier!
+
+If a destination (the right side in a route) has 'no further outgoing connection', this simply means that it does not appear as a source node (on the left side) in any route.
+
+So if we put all routes (source => destination) into a hash, we can use it for an existence check for all destinations.
+
+For constructing that hash from the pairs given in the `$routes` array-ref parameter,
+I use the `unpairs` function from `List::Util`. It takes the pairs and flattens them, so that we can directly assign it to a hash variable.
+
+Then, I look up the 'unconnected destination' by searching through the destinations (which happen to be the `values` of our hash) to find the one that has no route entry in the hash. Actually I use `first` (also from `List::Util`) instead of `grep`, just in case the data contain more that one unconnected destinations. 
 
 ```perl
 use v5.36;
-use List::MoreUtils qw( frequency );
-use List::Util qw( max );
+use List::Util qw( unpairs first );
 
-sub lucky_integer( @ints ) {
-    my %freq = frequency( @ints );
-    return max( grep $freq{$_} == $_, keys %freq ) // -1;
+sub no_connection( $routes ) {
+    # Store all given routes in a hash ( source => destination ).
+    my %connections = unpairs $routes->@*;
+    # Return the first destination that does not have a route going out of it.
+    return first { ! exists $connections{$_} } values %connections;
 }
 ```
 
-## Task 2: Relative Sort
+## Task 2: Making Change
 
-> You are given two list of integers, @list1 and @list2. The elements in the @list2 are distinct and also in the @list1.<br/>
-> Write a script to sort the elements in the @list1 such that the relative order of items in @list1 is same as in the @list2. Elements that is missing in @list2 should be placed at the end of @list1 in ascending order.<br/>
+> Compute the number of ways to make change for given amount in cents. By using the coins e.g. Penny, Nickel, Dime, Quarter and Half-dollar, in how many distinct ways can the total value equal to the given amount? Order of coin selection does not matter.<br/>
+> A penny (P) is equal to 1 cent.<br/>
+> A nickel (N) is equal to 5 cents.<br/>
+> A dime (D) is equal to 10 cents.<br/>
+> A quarter (Q) is equal to 25 cents.<br/>
+> A half-dollar (HD) is equal to 50 cents.<br/>
 > <br/>
 > Example 1<br/>
-> Input: @list1 = (2, 3, 9, 3, 1, 4, 6, 7, 2, 8, 5)<br/>
->        @list2 = (2, 1, 4, 3, 5, 6)<br/>
-> Ouput: (2, 2, 1, 4, 3, 3, 5, 6, 7, 8, 9)<br/>
+> Input: \$amount = 9<br/>
+> Ouput: 2<br/>
+> 1: 9P<br/>
+> 2: N + 4P<br/>
 > <br/>
 > Example 2<br/>
-> Input: @list1 = (3, 3, 4, 6, 2, 4, 2, 1, 3)<br/>
->        @list2 = (1, 3, 2)<br/>
-> Ouput: (1, 3, 3, 3, 2, 2, 4, 4, 6)<br/>
+> Input: \$amount = 15<br/>
+> Ouput: 6<br/>
+> 1: D + 5P<br/>
+> 2: D + N<br/>
+> 3: 3N<br/>
+> 4: 2N + 5P<br/>
+> 5: N + 10P<br/>
+> 6: 15P<br/>
 > <br/>
 > Example 3<br/>
-> Input: @list1 = (3, 0, 5, 0, 2, 1, 4, 1, 1)<br/>
->        @list2 = (1, 0, 3, 2)<br/>
-> Ouput: (1, 1, 1, 0, 0, 3, 2, 4, 5)<br/>
+> Input: \$amount = 100<br/>
+> Ouput: 292<br/>
 
-Seems that our result set consists of two parts:
+I use a **recursive approach** for this task.
 
-* first, all numbers from `@list1` that also are in `@list2`, in the order that is given by `@list2`,
-* then, the numbers that are *not* in `@list2`, sorted in ascending order, from low to high.
+To get good sequences, without any permutations, all sequences are generated using higher coin values first, with only the same or lower values following. This means that whenever we add a given value to a sequence, we need to make sure that no higher values will be added to it anymore.
 
-We will put the two parts together in the end, but first we need to find a way to construct each of them.
+How do we do that?
 
-For the numbers 'in the order of `@list2`', we actually can *use* `@list2`. That already gives us each number once, and for sure they are in the correct order!<br/>
-We only need to *repeat* each number as many times as it appears in `@list1`.
+For the parameters of my recursive function, we don't only use the amount to change, but also a list of currently available coins values. This list can (and will!) vary as we descend down into the recursion, as higher values will be excluded.
 
-So we are back to counting numbers again, and again, we use the `frequency` function from `List::MoreUtils` to keep it short.<br/>The first part of our result then simply is each number from `@list2`, repeated by its frequency in `@list1`:
+A call to the function walks through those coin values, for each of them trying to add it to the sequence:
 
-```perl
-    my %freq1 = frequency( $list1->@* );
-    map( ( $_ ) x $freq1{$_}, $list2->@* )
-```
+* If this coin value is too high, no combination is possible, so nothing is counted.
+* If the coin value matches the amount exactly, we have found a combination, which we count (as 1).
+* If the coin value is lower than the amount, we use that coin and descend into a recursion,
+to find the number of possible combinations for the rest of the amount.<br/>
+For that recursive call, the coin values that we give as parameters
+are only the current coin value and all following lower ones.<br/>
+The number of combinations returned by the recursive call
+is added to the total number of combinations in the current call.
 
-For the second part, we need to use `@list1`, but exclude the numbers from `@list2`, because we already have dealt with those.
+For convenience we allow the function to be called with *only* an amount, and *no* list of coin values.
+This is for the main call. In that case, we supply the list of coin values from the task description (50, 25, 10, 5, 1) as a default value.
 
-For simplicity, I use `frequency` again to built an 'existence hash' for `@list2`. Knowing that every number there appears only once, all the frequencies will be 1, but that's exactly what I need.
+We will get around 7.500 recursive calls for Example 3.<br/>
+Perl emits a warning when it detects a certain number of recursive calls (which is not really high). I think it's safe in our case to suppress this warning.   
 
-The second part then is `@list1`, with any element `grep`ped away that exists in `@list2`, then sorted numerically:
+```perl
+use v5.36;
+no warnings 'recursion';
+
+sub making_change( $amount, @coins ) {
+    @coins = qw( 50 25 10 5 1 )
+        unless @coins;
+    my $n = 0;
+    for ( 0..$#coins ) {
+        $n +=
+            $coins[$_] > $amount  ? 0
+            : $coins[$_] == $amount ? 1
+            : making_change( $amount - $coins[$_], @coins[$_..$#coins] );
+    }
+    return $n;
+}
 
-```Perl
-    my %exists2 = frequency( $list2->@* );
-    sort { $a <=> $b } grep ! $exists2{$_}, $list1->@*
+say making_change( 9 );
+say making_change( 15 );
+say making_change( 100 );
 ```
 
-Which gives us a solution with a high frequency of `frequency`. :-)
+'In reality', I use this for actually running the examples:
 
 ```perl
-use v5.36;
-use List::MoreUtils qw( frequency );
-
-sub relative_sort( $list1, $list2 ) {
-    my %freq1   = frequency( $list1->@* );
-    my %exists2 = frequency( $list2->@* );
-    return
-        map( ( $_ ) x $freq1{$_}, $list2->@* ),
-        sort { $a <=> $b } grep ! $exists2{$_}, $list1->@*;
-}
+use Test2::V0 qw( -no_srand );
+is making_change( 9 ), 2,
+    'Example 1: making_change( 9 ) == 2';
+is making_change( 15 ), 6,
+    'Example 2: making_change( 15 ) == 6';
+is making_change( 100 ), 292,
+    'Example 3: making_change( 100 ) == 292';
+done_testing;
 ```
 
-#### **Thank you for the challenge!**
+ which gives me this nice output:
+
+```
+ok 1 - Example 1: making_change( 9 ) == 2
+ok 2 - Example 2: making_change( 15 ) == 6
+ok 3 - Example 3: making_change( 100 ) == 292
+1..3
+```
+
+ 
+
+## **Thank you for the challenge!**
diff --git a/challenge-285/matthias-muth/blog.txt b/challenge-285/matthias-muth/blog.txt
new file mode 100644
index 0000000000..719469193f
--- /dev/null
+++ b/challenge-285/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-285/challenge-285/matthias-muth#readme
diff --git a/challenge-285/matthias-muth/perl/ch-1.pl b/challenge-285/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..1e31b14e52
--- /dev/null
+++ b/challenge-285/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 285 Task 1: No Connection
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+sub no_connection( $routes ) {
+    # Store all given routes in a hash ( from => to ).
+    my %from_to = map { $_->[0] => $_->[1] } $routes->@*;
+    # Return the first 'to' node that does not have a route going out of it.
+    return ( grep { ! exists $from_to{$_} } values %from_to )[0];
+}
+
+use List::Util qw( unpairs );
+
+sub no_connection( $routes ) {
+    # Store all given routes in a hash ( from => to ).
+    my %connections = unpairs $routes->@*;
+    # Return the first destination node that does not have a route going out of it.
+    return ( grep { ! exists $connections{$_} } values %connections )[0];
+}
+
+use Test2::V0 qw( -no_srand );
+is no_connection( [["B", "C"], ["D", "B"], ["C", "A"]] ), "A",
+    'Example 1: no_connection( [["B", "C"], ["D", "B"], ["C", "A"]] ) == "A"';
+is no_connection( [["A", "Z"]] ), "Z",
+    'Example 2: no_connection( [["A", "Z"]] ) == "Z"';
+done_testing;
diff --git a/challenge-285/matthias-muth/perl/ch-2.pl b/challenge-285/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..0442850a61
--- /dev/null
+++ b/challenge-285/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 285 Task 2: Making Change
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+no warnings 'recursion';
+
+sub making_change( $amount, @coins ) {
+    state $indent = "";
+    @coins = qw( 50 25 10 5 1 )
+        unless @coins;
+    say $indent, "making_change( $amount, @coins )";
+    $indent .= "  ";
+    my $n = 0;
+    for ( 0..$#coins ) {
+        if ( $coins[$_] > $amount ) {
+            say $indent, "$coins[$_] is too big";
+            next;
+        }
+        elsif ( $coins[$_] == $amount ) {
+            ++$n;
+            say $indent, "$coins[$_] is the exact amount. Found a combination.";
+            next;
+        }
+        else {
+            # $coins[$_] < $amount
+            say $indent, "adding coin of $coins[$_] to the sequence,",
+                " trying to change the rest of ", $amount - $coins[$_];
+            $n += making_change( $amount - $coins[$_], @coins[$_..$#coins] );
+        }
+    }
+
+    say $indent, "returning n==$n";
+    substr $indent, -2, 2, "";
+    return $n;
+}
+
+sub making_change( $amount, @coins ) {
+    @coins = qw( 50 25 10 5 1 )
+        unless @coins;
+    my $n = 0;
+    for ( 0..$#coins ) {
+        $n +=
+            $coins[$_] > $amount  ? 0
+            : $coins[$_] == $amount ? 1
+            : making_change( $amount - $coins[$_], @coins[$_..$#coins] );
+    }
+    return $n;
+}
+
+use List::Util qw( sum );
+
+sub making_change_3( $amount, @coins ) {
+    @coins = qw( 50 25 10 5 1 )
+        unless @coins;
+    return sum(
+        map
+            $coins[$_] > $amount  ? 0 :
+            $coins[$_] == $amount ? 1 :
+                making_change( $amount - $coins[$_], @coins[$_..$#coins] ),
+        0..$#coins
+    );
+}
+
+say making_change( 9 );
+
+use Test2::V0 qw( -no_srand );
+is making_change( 9 ), 2,
+    'Example 1: making_change( 9 ) == 2';
+is making_change( 15 ), 6,
+    'Example 2: making_change( 15 ) == 6';
+is making_change( 100 ), 292,
+    'Example 3: making_change( 100 ) == 292';
+done_testing;
diff --git a/challenge-285/peter-campbell-smith/blog.txt b/challenge-285/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..5e8e341c9e
--- /dev/null
+++ b/challenge-285/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/285
diff --git a/challenge-285/peter-campbell-smith/perl/ch-1.pl b/challenge-285/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..b1dd302958
--- /dev/null
+++ b/challenge-285/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-09-02
+use utf8;     # Week 285 - task 1 - No connection
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+no_connection(['B', 'C'], ['D', 'B'], ['C', 'A']);
+no_connection(['F', 'G'], ['G', 'H'], ['H', 'F']);
+no_connection(['B', 'C'], ['A', 'A'], ['B', 'B']);
+
+# longer example - random routes
+my ($x, $y);
+for (0 .. 24) {
+	$x .= qq{['} . chr(int(rand(15)) + ord('A')) . qq{','} .
+		chr(int(rand(15)) + ord('A')) . qq{'],}
+}
+$x =~ s|.$||;
+no_connection(eval($x));
+
+sub no_connection {
+	
+	my (@routes, $r, $input, $output, %from, %to);
+	
+	# create list of froms and tos where from and to are distinct
+	@routes = @_;
+	for $r (@routes) {
+		$input .= qq{['$r->[0]', '$r->[1]'], };
+		next if $r->[1] eq $r->[0]; 
+		$from{$r->[0]} = 1;
+		$to{$r->[1]} = 1;
+	}
+	
+	# create list of froms and tos where from and to are distinct
+	$output = '';
+	for $r (@routes) {
+		next if $output =~ m|'$r->[1]'|;
+		$output .= qq['$r->[1]', ] unless defined $from{$r->[1]};
+	}
+	
+	# edge case of ['X', 'X']
+	for $r (@routes) {
+		if ($r->[1] eq $r->[0] and not $from{$r->[1]}) {
+			$output .= qq['$r->[1]', ] unless $output =~ m|'$r->[1]'|;
+		}
+	}
+	say qq[\nInput:  \@routes = (] . substr($input, 0, -2) . ')';
+	say qq[Output: ] . ($output ? substr($output, 0, -2) : 'none');
+}
diff --git a/challenge-285/peter-campbell-smith/perl/ch-2.pl b/challenge-285/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..f5b36cc871
--- /dev/null
+++ b/challenge-285/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-09-02
+use utf8;     # Week 285 - task 2 - Making change
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+making_change(9);
+making_change(15);
+making_change(100);
+making_change(500);
+
+sub making_change {
+	
+	my ($cents, $h, $q, $d, $n, $p, @sum, $count, $explain);
+	
+	# initialise
+	$cents = $_[0];
+	$count = 0;
+	$explain = '';
+	
+	# intelligently loop over all combs
+	H: for $h (0 .. 1e6) {
+		$sum[0] = $h * 50;
+		last H if $sum[0] > $cents;
+
+		Q: for $q (0 .. 1e6) {
+			$sum[1] = $sum[0] + $q * 25;
+			last Q if $sum[1] > $cents;
+
+			D: for $d (0 .. 1e6) {
+				$sum[2] = $sum[1] + $d * 10;
+				last D if $sum[2] > $cents;
+
+				N: for $n (0 .. 1e6) {
+					$sum[3] = $sum[2] + $n * 5;
+					last N if $sum[3] > $cents;
+
+					P: for $p (0 .. 1e6) {
+						$sum[4] = $sum[3] + $p;
+						
+						# found a valid combination
+						if ($sum[4] == $cents) {
+							$count ++;
+							$explain .= qq[  $count: ${h}H + ${q}Q + ${d}D + ${n}N + ${p}P\n];
+						}
+						last P if $sum[4] >= $cents;
+					}
+				}
+			}
+		}
+	}
+	
+	# output
+	say qq[\nInput:  \$cents = $cents];
+	$explain = qq[\n] if $count > 300;
+	$explain =~ s| \+ 0.||gm;
+	$explain =~ s|0H \+ ||gm;
+	print qq[Output: $count\n$explain];	
+}
+
diff --git a/challenge-285/peter-meszaros/perl/ch-1.pl b/challenge-285/peter-meszaros/perl/ch-1.pl
new file mode 100755
index 0000000000..3c5a00ebf2
--- /dev/null
+++ b/challenge-285/peter-meszaros/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+#
+=head1 Task