Challenge 243 Task 1 and 2 solutions in Perl by Matthias Muth

6 files changed, 778 insertions, 80 deletions

diff --git a/challenge-243/matthias-muth/README.md b/challenge-243/matthias-muth/README.md
index 831aaebec6..b86d074bcf 100644
--- a/challenge-243/matthias-muth/README.md
+++ b/challenge-243/matthias-muth/README.md
@@ -1,115 +1,273 @@
-# Checking and Flipping
+# ComPAIRisons, optimized
 
-**Challenge 242 solutions in Perl by Matthias Muth**
+**Challenge 243 solutions in Perl by Matthias Muth**
 
-## Task 1: Missing Members
+## Task 1: Reverse Pairs
 
-> You are given two arrays of integers.<br/>
-> Write a script to find out the missing members in each other arrays.<br/>
+> You are given an array of integers.<br/>
+> Write a script to return the number of reverse pairs in the given array.<br/>
+> A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j].<br/>
 > <br/>
 > Example 1<br/>
-> Input: @arr1 = (1, 2, 3)<br/>
->        @arr2 = (2, 4, 6)<br/>
-> Output: ([1, 3], [4, 6])<br/>
-> (1, 2, 3) has 2 members (1, 3) missing in the array (2, 4, 6).<br/>
-> (2, 4, 6) has 2 members (4, 6) missing in the array (1, 2, 3).<br/>
+> Input: @nums = (1, 3, 2, 3, 1)<br/>
+> Output: 2<br/>
+> (1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1<br/>
+> (3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1<br/>
 > <br/>
 > Example 2<br/>
-> Input: @arr1 = (1, 2, 3, 3)<br/>
->        @arr2 = (1, 1, 2, 2)<br/>
-> Output: ([3])<br/>
-> (1, 2, 3, 3) has 2 members (3, 3) missing in the array (1, 1, 2, 2). Since they are same, keep just one.<br/>
-> (1, 1, 2, 2) has 0 member missing in the array (1, 2, 3, 3).<br/>
+> Input: @nums = (2, 4, 3, 5, 1)<br/>
+> Output: 3<br/>
+> (1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1<br/>
+> (2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1<br/>
+> (3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1<br/>
 
-In [perlfaq4](https://perldoc.perl.org/perlfaq4#How-can-I-get-the-unique-keys-from-two-hashes%3F), Brian D Foy gives a recommendation for removing duplicate elements from a list or an array:  
+This is a typical challenge task of the class *'Combine every number with every other'*.<br/>
+The obvious implementation is this:
 
-> Use a hash. When you think the words "unique" or "duplicated", think "hash keys".
+```perl
+sub reverse_pairs( @nums ) {
+    my $count = 0;
+    for my $i ( 0 .. $#nums - 1 ) {
+        for my $j ( $i + 1 .. $#nums ) {
+            ++$count
+                if $nums[$i] > 2 * $nums[$j];
+        }
+    }
+    return $count;
+}
+```
+
+And it works fine out of the box.
 
-I would like to extend this good advice to
-> Whenever you think "*existence of a value*", think "hash keys"! 
+I have recently become a fan of using a more 'functional' approach in my programming, and Perl actually offers a lot in this regard.
+It starts with `map` and `grep` that use code blocks for processing lists of data. Next, any novice Perl programmer will rapidly appreciate the power of `sort`, using a simple code block to compare any type of data, allowing for complex sorting criteria without large programming efforts.
 
-So when we need to decide whether members of one array are contained in the other,
-the easiest solution is to first build two hashes from the values of the two arrays.
-We create an entry containing the value 1 for each member,
-using a common Perl idiom.
-As we have two arrays as input to our function,
-we use references to the actual arrays as parameters.<br/>
-That can look like this:
+I also used to reckon that  
+So I changed my solution above into this:
 
 ```perl
-    my %arr1_members = map { ( $_ => 1 ) } $arr1->@*;
-    my %arr2_members = map { ( $_ => 1 ) } $arr2->@*;
+sub reverse_pairs_grep( @nums ) {
+    my $count = 0;
+    for my $i ( 0 .. $#nums - 1 ) {
+        $count += scalar grep { $nums[$i] > 2 * $nums[$_] } $i + 1 .. $#nums;
+    }
+    return $count;
+}
 ```
-Then, we can `grep` through the two arrays, with a condition of the current value *not* existing in the other array's lookup hash.<br/>
-There may be duplicate values in the input arrays, but we are supposed to return only distinct values in the results.
-So we could  follow the above advice and create another hash to reduce multiple values into distinct ones. But, to make it easy, we can also simply leave that work to the `uniq` function from the `List::Util` core module.<br/>
-We then return the results as two anonymous arrays.
 
-Which makes this my complete solution: 
+The whole inner loop now is in one statement, hiding the inner `for` loop in the `grep`.<br/>
+To me, this also looks more efficient, because running the loop is now done 'under the hood', and can be implemented very efficiently.
+
+Out of curiosity, I made a little benchmark, using the `Benchmark` core module.<br/>
+I compared the two implementations, running the two small challenge examples in every iteration:
 
+``` 
+                       Rate reverse_pairs_grep      reverse_pairs
+reverse_pairs_grep 184719/s                 --                -3%
+reverse_pairs      190023/s                 3%                 --
+```
+
+Woah??<br/>
+It seems that the `for` loop is more efficient than I expected!<br/>
+Or, put the other way round, `grep` does not necessarily beat a `for` loop!
+Maybe it plays a role that the parameters need to be passed into `grep`, which might involve copying the list.
+Ok, lesson learned, good to know that `for` or `foreach` is nothing that needs to be avoided.
+
+My curiosity then led me to try to see whether I could optimize the `for` loop version further.<br/>
+I exchanged the inner and the outer loop, from
 ```perl
-use List::Util qw( uniq );
-
-sub missing_members( $arr1, $arr2 ) {
-    my %arr1_members = map { ( $_ => 1 ) } $arr1->@*;
-    my %arr2_members = map { ( $_ => 1 ) } $arr2->@*;
-    return (
-        [ uniq grep ! $arr2_members{$_}, $arr1->@* ],
-        [ uniq grep ! $arr1_members{$_}, $arr2->@* ],
-    );
-}
+    for my $i ( 0 .. $#nums - 1 ) {
+        for my $j ( $i + 1 .. $#nums ) {
+```
+to
+```perl
+    for my $j ( 1 .. $#nums ) {
+        for my $i ( 0 .. $j - 1 ) {
+```
+This is the result of the benchmark:
 ```
+                                 Rate reverse_pairs reverse_pairs_reversed_loops
+reverse_pairs                187361/s            --                         -11%
+reverse_pairs_reversed_loops 211017/s           13%                           --
+```
+Whoa again!!<br/>
+The inside-out loop is faster than the original loop!
+
+The inner and the outer loop have the same number of iterations in both cases:
+
+`for $i` / `for $j` loop:<br/>
+    `$i` iterations: $n - 1$<br/>
+    all `$j` iterations: $(n-1) + (n-2) + \dots + 1 = \frac{(n-1)n}{2}$<br/>
+
+`for $j` / `for $i` loop:<br/>
+    `$j` iterations: $n - 1$<br/>
+    all `$i` iterations: $1 + 2 + \dots + (n-1) = \frac{(n-1)n}{2}$<br/>
+
+So the difference must be in the operations that are executed 'behind the scenes' implementing the iteration over the lists that are defined in the `for` statements.
+
+My speculation is that probably the inner loop expressions `$i + 1 `  and `$#nums` for the first version
+are more expensive to evaluate than `0` and `$j - 1` for the faster second version.<br/>
+Which might make sense, because one might expect that the `$i + 1` and `$j - 1` complexity is the same,
+and between `$#nums` and `0` it surely is more expensive to lookup the `@nums` array size than just using the constant `0`. 
 
-## Task 2: Flip Matrix
-
-> You are given n x n binary matrix.<br/>
-> Write a script to flip the given matrix as below.<br/>
-> 1 1 0<br/>
-> 0 1 1<br/>
-> 0 0 1<br/>
-> a) Reverse each row<br/>
-> 0 1 1<br/>
-> 1 1 0<br/>
-> 1 0 0<br/>
-> b) Invert each member<br/>
-> 1 0 0<br/>
-> 0 0 1<br/>
-> 0 1 1<br/>
+As interesting as it may be to find why this 'optimization by chance' really works,
+I expect that the performance difference will diminish when the `@num` array gets bigger.
+So actually the 'out of the box' solution does a great job.
+
+## Task 2: Floor Sum
+
+> You are given an array of positive integers (>=1).<br/>
+> Write a script to return the sum of floor(nums[i] / nums[j]) where 0 <= i,j < nums.length. The floor() function returns the integer part of the division.<br/>
 > <br/>
 > Example 1<br/>
-> Input: @matrix = ([1, 1, 0], [1, 0, 1], [0, 0, 0])<br/>
-> Output: ([1, 0, 0], [0, 1, 0], [1, 1, 1])<br/>
+> Input: @nums = (2, 5, 9)<br/>
+> Output: 10<br/>
+> floor(2 / 5) = 0<br/>
+> floor(2 / 9) = 0<br/>
+> floor(5 / 9) = 0<br/>
+> floor(2 / 2) = 1<br/>
+> floor(5 / 5) = 1<br/>
+> floor(9 / 9) = 1<br/>
+> floor(5 / 2) = 2<br/>
+> floor(9 / 2) = 4<br/>
+> floor(9 / 5) = 1<br/>
 > <br/>
 > Example 2<br/>
-> Input: @matrix = ([1, 1, 0, 0], [1, 0, 0, 1], [0, 1, 1, 1], [1, 0, 1, 0])<br/>
-> Output: ([1, 1, 0, 0], [0, 1, 1, 0], [0, 0, 0, 1], [1, 0, 1, 0])<br/>
-
-We are a bit lucky, because the operations described here can be performed on each row independently, for each row, one by one. This makes things quite easy.<br/>
-We can chain the `reverse` operation and the 'inverse' operation
-(which is a binary exclusive or, `^`. with the value `1`)
-using a `map` call for all values of a row.
-The results go into an anonymous array, which will be the resulting row.<br/>
-Assuming that the current row is represented by `$_`
-containing a reference to the row's data, this does the transformation
-for one row:
+> Input: @nums = (7, 7, 7, 7, 7, 7, 7)<br/>
+> Output: 49<br/>
+
+This task, too, lets us *'combine every number with every other'*.<br/>
+So let's see whether what we've learned from Task 1 can be applied here!<br/>
+First, the obvious solution:
 
 ```perl
-    [ map $_ ^ 1, reverse $_->@* ]
+sub floor_sum( @nums ) {
+    my $count = 0;
+    for my $i ( 0..$#nums ) {
+        for my $j ( 0..$#nums ) {
+            $count += int( $nums[$j] / $nums[$i] );
+        }
+    }
+    return $count;
+}
+```
+Next, the '`grep`' version:
+```perl
+sub floor_sum_grep( @nums ) {
+    my $count = 0;
+    for my $i ( 0..$#nums ) {
+        $count += sum( map int( $nums[$_] / $nums[$i] ), 0..$#nums );
+    }
+    return $count;
+}
+```
+And the benchmark comparing the two:
 ```
-In Perl's representation of two-dimensional arrays,
-each row actually is a reference to an array containing the values of that row.
-In addition, in our case, the `$matrix` parameter is a reference itself to the array of row references.<br/>
-This means that in an outer `map` call, we can loop over the rows like this:
+                  Rate floor_sum_grep      floor_sum
+floor_sum_grep 70447/s             --           -28%
+floor_sum      97303/s            38%             --
+```
+
+The difference in favor of the `for` loop version is even more evident than in the previous task.
+So let's stick with the `for` loops, for performance, and maybe also for readability.
+
+I didn't run a benchmark with the loops turned around for this version,
+because the loops are really identical here (both from `0` to `$#num`),
+so there's nothing to expect from that.
+
+**BUT!**<br/>
+There's another possible optimization, and it even has nothing to do with Perl and choosing the right language constructs.<br/>
+It actually is in the 'application domain'.
+
+Let's visualize all combinations of the first example's numbers $( 2, 5, 9 )$ in a matrix,
+with the division results as the matrix values. The values are sorted in ascending order already, which we could do for any list of numbers we get. Note that in the first example, all numbers are unique.
+
+$$
+\begin{array}{c|c & c & c}
+   & 2 & 5 & 9 \\ 
+  \hline
+  2 & \text{int}(2/2) & \text{int}(2/5) & \text{int}(2/9) \\
+  5 & \text{int}(5/2) & \text{int}(5/5) & \text{int}(5/9) \\
+  9 & \text{int}(9/2) & \text{int}(9/5) & \text{int}(9/9) \\
+ \end{array}
+$$
+
+From which we get these values to add up:
+
+$$
+\begin{array}{c|c & c & c}
+   & 2 & 5 & 9 \\ 
+  \hline
+  2 & {\color{blue}1} & {\color{green}0} & {\color{green}0} \\
+  5 & {\color{orange}2} & {\color{blue}1} & {\color{green}0} \\
+  9 & {\color{orange}4} & {\color{orange}1} & {\color{blue}1}  \\
+ \end{array}
+$$
+
+I have chosen colors for different parts of the matrix:<br/>
+
+${\color{blue}Blue}$ for the diagonal.<br/>
+All its values are always ${\color{blue}1}$.
+
+${\color{green}Green}$ for the upper right part of the matrix.
+All its values are ${\color{green}0}$, because the dividend is always smaller than the divisor (remembering that the numbers are sorted in ascending order).
+
+${\color{orange}Orange}$ is the lower left part of the matrix. Here, we really need to divide the two numbers. We will get a non-zero result, because the divident is bigger than the divisor.
+
+This means that we can reduce our loops to the lower left part of the matrix, because only there we will get significant numbers to add to our final result.
+For the values of ${\color{blue}1}$ in the diagonal we add the matrix size (which is the length of the diagonal), and we are done.
+
+Now what if the numbers are not unique, as in the second example?
+
+In that case, a value will appear more than once, and it will be combined with its duplicate of the same value. We will encounter a division of $int(value/value) = 1$. The thing is that if that happens, there will also be a $1$ in the upper right part of the matrix at the same place. There, the values will be combined the other way round, but $int(value/value)$ will still be $1$.
+
+This means that when we do the division, and the two values are the same, we add ${\color{orange}2}$ instead of ${\color{orange}1}$ to account for that. We don't actually need to do a division in that case.
+
+Here is how this looks in code:
 
 ```perl
-    map ..., $matrix->@*;
+sub floor_sum_half_matrix( @nums ) {
+    @nums = sort { $a <=> $b } @nums;
+    my $count = 0;
+    for my $i ( 0 .. $#nums - 1 ) {
+        # Loop over larger or equal values only.
+        for my $j ( $i + 1 .. $#nums ) {
+            # Add 2 if the values are equal,
+            # because each of $a/$b and $b/$a is 1.
+            $count += $nums[$j] == $nums[$i] ? 2 : int( $nums[$j] / $nums[$i] );
+        }
+    }
+    # Add 1 for each field in the diagonal.
+    return $count + scalar @nums;
+}      
 ```
-Putting the pieces together, this the complete (one-line :-) ) solution:
+
+The benchmark looks as if the change was worth it:
+```
+                          Rate             floor_sum floor_sum_half_matrix
+floor_sum              95836/s                    --                  -40%
+floor_sum_half_matrix 158906/s                   66%                    --
+```
+
+We then can squeeze out the last 3% by doing the 'reverse loop' trick from the previous task:
 
 ```perl
-sub flip_matrix( $matrix ) {
-    return map [ map $_ ^ 1, reverse $_->@* ], $matrix->@*;
+sub floor_sum_half_matrix_reversed( @nums ) {
+    ...
+    for my $j ( 1 .. $#nums ) {
+        for my $i ( 0 .. $j - 1 ) {
+            ...
+        }
+    }
+    ...
 }
 ```
+```
+                                   Rate floor_sum floor_sum_half_matrix floor_sum_half_matrix_reversed
+floor_sum                       97713/s        --                  -38%                           -40%
+floor_sum_half_matrix          158752/s       62%                    --                            -3%
+floor_sum_half_matrix_reversed 163793/s       68%                    3%                             --
+```
+But this doesn't change a lot anymore, and knowing that my laptop can run the *Weekly Challenge 243 Task 2* examples in Perl around 160,000 times in one second is enough to give me a smile... :-)
 
 #### **Thank you for the challenge!**
diff --git a/challenge-243/matthias-muth/blog.txt b/challenge-243/matthias-muth/blog.txt
new file mode 100644
index 0000000000..71a8716dd5
--- /dev/null
+++ b/challenge-243/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-243/challenge-243/matthias-muth#readme
diff --git a/challenge-243/matthias-muth/perl/TestExtractor.pm b/challenge-243/matthias-muth/perl/TestExtractor.pm
new file mode 100644
index 0000000000..4b7f1eb6ab
--- /dev/null
+++ b/challenge-243/matthias-muth/perl/TestExtractor.pm
@@ -0,0 +1,281 @@
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       The Test Data Extraction Machine (tm).
+#
+#       Perl solution by Matthias Muth.
+#
+
+use strict;
+use warnings;
+use feature 'say';
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+package TestExtractor;
+use Exporter 'import';
+our @EXPORT = qw(
+    run_tests
+    run_tests_for_subs
+    $verbose %options vprint vsay
+    done_testing
+    pp np carp croak
+);
+
+use Data::Dump qw( pp );
+use Data::Printer;
+use Getopt::Long;
+use Cwd qw( abs_path );
+use File::Basename;
+use List::Util qw( any );
+use Carp;
+use Test2::V0 qw( -no_srand );
+use Carp;
+no warnings 'experimental::signatures';
+
+our ( $verbose, %options );
+sub vprint { print @_ if $verbose };
+sub vsay   { say   @_ if $verbose };
+
+sub extract_and_run_tests( $sub_name ) {
+
+    $| = 1;
+
+    GetOptions(
+        "v|verbose!" => \$verbose,
+    ) or do { say "usage!"; exit 2 };
+
+    my $dir = dirname abs_path $0;
+    my ( $challenge, $task ) =
+        abs_path( $0 ) =~ m{challenge-(\d+) .* (\d+)[^[/\\]*$}x;
+    unless ( $challenge && $task ) {
+        say STDERR "ERROR: ",
+            "Cannot determine challenge number or task number. Exiting.";
+        exit 1;
+    }
+
+    my $local_tests;
+    ( undef, $local_tests ) = read_task( *::DATA )
+	if fileno *::DATA;
+
+    my ( $task_title, $task_description ) =
+        read_task( "$dir/challenge-${challenge}.txt", $task );
+	# vsay $task_title;
+
+    my @tests = (
+        $local_tests      ? extract_tests( $local_tests )      : (),
+	$task_description ? extract_tests( $task_description ) : (),
+    );
+    # vsay pp( @tests );
+
+    ( $sub_name //= lc $task_title ) =~ s/\W+/_/g;
+    my $sub = \&{"::$sub_name"};
+
+    my $n_failures = 0;
+
+    do {
+        my @input_params =
+	    @{$_->{INPUT}} == 1
+	    ? ( ref $_->{INPUT}[0] eq 'ARRAY'
+		&& ! grep( ref $_, @{$_->{INPUT}[0]} ) )
+		? @{$_->{INPUT}[0]}
+		: $_->{INPUT}[0]
+	    : @{$_->{INPUT}};
+	my $expected = $_->{OUTPUT};
+	my $diag =
+	    "$sub_name( " . pp( @input_params ) . " ) "
+	    . ( ( @$expected == 1 && $expected->[0] =~ /^(?:(true)|false)/ )
+	        ? "is $expected->[0]"
+		: ( "== " . pp( @{$_->{OUTPUT}} ) ) );
+
+	my $name = "$_->{TEST}";
+	$name .= ": $diag"
+	    if $_->{TEST} =~ /^(Test|Example)(?:\s+\d+)?$/;
+	$diag = "test: $diag";
+
+	my @output = $sub->( @input_params );
+
+	if ( @$expected == 1 && $expected->[0] =~ /^(?:(true)|false)/ ) {
+	    ok $1 ? $output[0] : ! $output[0], $name, $diag // ()
+		or ++$n_failures;
+	}
+	else {
+	    is \@output, $expected, $name, $diag // ()
+		or ++$n_failures;
+	}
+
+        # vsay "";
+
+    } for @tests;
+
+    return $n_failures;
+}
+
+sub run_tests( @sub_names ) {
+    my $n_failures = 0;
+    my $add_newline = 0;
+    for my $sub ( @sub_names ? @sub_names : ( undef ) ) {
+	$add_newline ? say "" : ( $add_newline = 1 );
+	say "Running tests for '$sub':"
+	    if $sub;
+	$n_failures += extract_and_run_tests( $sub );
+    }
+    done_testing;
+    return $n_failures == 0;
+}
+
+sub read_task( $fd_or_filename, $wanted_task = undef ) {
+
+    my $fd;
+    if ( ref \$fd_or_filename eq 'SCALAR' ) {
+        open $fd, "<", $fd_or_filename
+            or die "ERROR: cannot open '$fd_or_filename': $!\n";
+    }
+    else {
+        # non-SCALARs, like __DATA__ GLOB.
+        $fd = $fd_or_filename;
+    }
+
+    my ( $task, $task_title, $task_text ) = ( -1, undef );
+    while ( <$fd> ) {
+        /^Task (\d+):\s*(.*?)\s*$/ and do {
+            $task = $1;
+            $task_title = $2
+                if $wanted_task && $task == $wanted_task;
+            next;
+        };
+
+        next
+            if $wanted_task && $task != $wanted_task;
+
+	$task_text .= $_;
+    }
+
+    return $task_title, $task_text;
+}
+
+sub extract_tests( $task_text ) {
+    # vsay "extract_tests( ", pp( $task_text ), " )";
+
+    # These regular expressions are used for extracting input or output
+    # test data.
+    my $var_name      = qr/ [\@\$]\w+ /x;
+    my $literal       = qr/ ".*?" | '.*?' | [+-]?\d+ | undef /x;
+    my $bracketed     = qr/ \[ [^\[]*? \] /xs;
+    my $parenthesized = qr/ \( [^\[]*? \) /xs;
+    my $entry         = qr/ $literal | $bracketed | $parenthesized /x;
+    my $list          = qr/ $entry (?: \s*,\s* $entry )* \s*,? /xs;
+
+    # The combination of what we expect as input or output data.
+    # Capture unparenthesized lists for special handling.
+    my $data_re = qr/ (?<lit>      $literal )
+		    | (?<br_list>     \[ \s* (?:$list)? \s* \] )
+		    | (?<par_list>    \( \s* (?:$list)? \s* \) )
+		    | (?<no_paren> $list ) /x;
+
+    my @tests;
+    while ( $task_text =~
+	/^((?:Example|Test).*?)\s*:?\s*$ .*?
+	    ^Input: \s* ( .*? ) \s*
+	    ^Out?put: \s* ( .*? ) \s*? (?=(?: ^$ | ^\S | \Z ))
+	/xmsg )
+    {
+	my ( $test, $input, $output) = ( $1, $2, $3 );
+	# vsay pp $test, $input, $output;
+
+	push @tests, { TEST => $test };
+
+	# Check whether the Input: part contains any variable sigils.
+	# If not, we try to convert '<Sequence of Words> = ...'
+	# into '$sequence_of_words = ...'.
+	# This is for specification like
+	# Input: Year = 2024, Month = 4, Weekday of month = 3, day of week = 2
+	unless ( $input =~ /[\$\@]\w+/ ) {
+	    $input =~ s{(\w+?(?: \w+?)*?)(\s*=)}{
+		my ( $var_name, $equals ) = ( $1, $2 );
+		'$' . lc ( $var_name =~ s/ /_/gr ) . $equals;
+	    }eg;
+	    # vsay "changed \$input to '$input'";
+	}
+
+	for ( $input, $output ) {
+	    # To avoid misinterpretations of '@' or '$' when the data is
+	    # 'eval'ed, we turn all double quotes into single quotes.
+	    s/\"/'/g;
+
+	    # We convert 'barewords' into quoted strings.
+	    # We search for these patterns, but we just skip them without
+	    # changing them:
+	    #  * 'Input:', 'Output:' at the beginning of the string,
+	    #  * quoted strings,
+	    #  * variable names having a $ or @ sigil.
+	    # After we are sure it's none of those, we also check unquoted
+	    # 'barewords' (here: combinations of letters, digits or underscores,
+	    # starting with a letter) and enclose them in single quotes.
+	    my $bareword = qr/ \b (?!undef) [a-z_][a-z0-9_]* \b /ix;
+	    while ( / ^Input: | ^Output: | '.*?' | [\$\@]$bareword
+		    | ( $bareword ) /xg )
+	    {
+		if ( $1 ) {
+		    my $p = pos();
+		    substr $_, $p - length( $1 ), length( $1 ), "'$1'";
+		    pos = $p + 2;
+		}
+	    }
+
+	    # As all arrays will be stored as array references, we just
+	    # convert parentheses (...) to angle brackets [...].
+	    # s/\(/\[/g;
+	    # s/\)/\]/g;
+
+	    # Add missing commas between literals.
+	    while ( s/($literal)\s+($literal)/$1, $2/ ) {}
+	}
+
+	while ( $input =~ / ($var_name) \s* = \s* ($data_re) /xg ) {
+	    push @{$tests[-1]{VARIABLE_NAMES}}, $1;
+	    push @{$tests[-1]{INPUT}},
+		eval( ( $+{no_paren} || $+{par_list} ) ? "[ $2 ]" : $2 );
+        };
+
+	while ( $output =~ /^\s* ($data_re) $/xg ) {
+	    local $_ = $1;
+	    # vsay "\$_: <$_>";
+	    # Special case:  (1,2),(3,4),(5,6)
+	    # should become: [1,2],[3,4],[5,6] ]
+	    if ( $+{no_paren} && /$parenthesized/ ) {
+		# vsay "found special case <$_>";
+		s/\(/\[/g;
+		s/\)/\]/g;
+	    }
+	    push @{$tests[-1]{OUTPUT}},
+		eval( $+{no_paren} ? "( $_ )" : $_ );
+        };
+    }
+
+    unless ( @tests ) {
+	# Try an alternative description format:
+	# <input...> => <output...>
+	my $n_examples = 0;
+	while ( $task_text =~ /^( .*? ) \s* => \s* ( .* )$/xmg ) {
+	    # vsay pp @{^CAPTURE};
+	    push @tests, {
+	        TEST => "Example " . ++$n_examples,
+		INPUT => [ split " ", $1 ],
+		OUTPUT => [ $2 ],
+		VARIABLE_NAMES => [ '@input' ],
+	    }
+	}
+    }
+
+    # Use array refs for all OUTPUT lists if at least one of tests does.
+    if ( any { ref $_->{OUTPUT}[0] } @tests ) {
+	$_->{OUTPUT} = [ $_->{OUTPUT} ]
+	    for grep { ! ref $_->{OUTPUT}[0] } @tests;
+    }
+
+    return @tests;
+}
+
+1;
diff --git a/challenge-243/matthias-muth/perl/ch-1.pl b/challenge-243/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..d45541754d
--- /dev/null
+++ b/challenge-243/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 243 Task 1: Reverse Pairs
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.20;
+use strict;
+use warnings;
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+use lib '.';
+use TestExtractor;
+
+sub reverse_pairs( @nums ) {
+    my $count = 0;
+    for my $i ( 0 .. $#nums - 1 ) {
+	for my $j ( $i + 1 .. $#nums ) {
+	    ++$count
+	        if $nums[$i] > 2 * $nums[$j];
+	}
+    }
+    return $count;
+}
+
+sub reverse_pairs_reversed_loops( @nums ) {
+    my $count = 0;
+    for my $j ( 1 .. $#nums ) {
+	for my $i ( 0 .. $j - 1 ) {
+	    ++$count
+	        if $nums[$i] > 2 * $nums[$j];
+	}
+    }
+    return $count;
+}
+
+sub reverse_pairs_for( @nums ) {
+    my $count = 0;
+    for ( my $i = 0; $i <= $#nums - 1; ++$i ) {
+	for ( my $j = $i + 1; $j <= $#nums; ++$j ) {
+	    ++$count
+	        if $nums[$i] > 2 * $nums[$j];
+	}
+    }
+    return $count;
+}
+
+sub reverse_pairs_reversed_for( @nums ) {
+    my $count = 0;
+    for ( my $j = 1; $j <= $#nums; ++$j ) {
+	for ( my $i = 0; $i <= $j - 1; ++$i ) {
+	    ++$count
+	        if $nums[$i] > 2 * $nums[$j];
+	}
+    }
+    return $count;
+}
+
+sub reverse_pairs_grep( @nums ) {
+    my $count = 0;
+    for my $i ( 0 .. $#nums - 1 ) {
+        $count += scalar grep { $nums[$i] > 2 * $nums[$_] } $i + 1 .. $#nums; 
+    }
+    return $count;
+}
+
+sub reverse_pairs_reversed_grep( @nums ) {
+    my $count = 0;
+    for my $j ( 1 .. $#nums ) {
+	$count += scalar grep { $nums[$_] > 2 * $nums[$j] } 0 .. $j - 1;
+    }
+    return $count;
+}
+
+my @subs = qw(
+    reverse_pairs
+    reverse_pairs_reversed_loops
+    reverse_pairs_for
+    reverse_pairs_reversed_for
+);
+
+run_tests( @subs )
+    or exit 0;
+
+use Benchmark qw( :all );
+my %benchmark_runs =
+    map {
+	my $sub_name = $_;
+	( $sub_name => sub {
+	    no strict 'refs';
+	    $sub_name->( qw( 1 3 2 3 1 ) );
+	    $sub_name->( qw( 2 4 3 5 1 ) );
+	} )
+    }
+    @subs;
+
+
+say "\nRunning benchmarks:";
+cmpthese -3, \%benchmark_runs;
+
+exit 0;
diff --git a/challenge-243/matthias-muth/perl/ch-2.pl b/challenge-243/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..e765be7c23
--- /dev/null
+++ b/challenge-243/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 243 Task 2: Floor Sum
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.20;
+use strict;
+use warnings;
+use feature 'signatures';
+no warnings 'experimental::signatures';
+
+use lib '.';
+use TestExtractor;
+
+use List::Util qw( sum );
+
+sub floor_sum( @nums ) {
+    my $count = 0;
+    for my $i ( 0..$#nums ) {
+	for my $j ( 0..$#nums ) {
+	    $count += int( $nums[$j] / $nums[$i] );
+	}
+    }
+    return $count;
+}
+
+sub floor_sum_grep( @nums ) {
+    my $count = 0;
+    for my $i ( 0..$#nums ) {
+	$count += sum( map int( $nums[$_] / $nums[$i] ), 0..$#nums );
+    }
+    return $count;
+}
+
+sub floor_sum_half_matrix( @nums ) {
+    @nums = sort { $a <=> $b } @nums;
+    my $count = 0;
+    for my $i ( 0 .. $#nums - 1 ) {
+	# Loop over larger or equal values only.
+	for my $j ( $i + 1 .. $#nums ) {
+	    # Add 2 if the values are equal,
+	    # because each of $a/$b and $b/$a is 1.
+	    $count += $nums[$j] == $nums[$i] ? 2 : int( $nums[$j] / $nums[$i] );
+	}
+    }
+    # Add 1 for each field in the diagonal.
+    return $count + scalar @nums;
+}
+
+sub floor_sum_half_matrix_reversed( @nums ) {
+    @nums = sort { $a <=> $b } @nums;
+    my $count = 0;
+    for my $j ( 1 .. $#nums ) {
+	# Loop over larger or equal values only
+	# (half the matrix, without the diagonal).
+	for my $i ( 0 .. $j - 1 ) {
+	    # Add 2 for equal values,
+	    # because each of n(i) / n(j) and # n(j) / n(i) is 1.
+	    $count += $nums[$j] == $nums[$i] ? 2 : int( $nums[$j] / $nums[$i] );
+	}
+    }
+    # Add 1 for each field in the diagonal.
+    return $count + scalar @nums;
+}
+
+my @subs = qw(
+    floor_sum
+    floor_sum_half_matrix
+    floor_sum_half_matrix_reversed
+);
+
+run_tests( @subs )
+    or exit 0;
+
+use Benchmark qw( :all );
+my %benchmark_runs =
+    map {
+	my $sub_name = $_;
+	( $sub_name => sub {
+	    no strict 'refs';
+	    $sub_name->( qw( 2 5 9 ) );
+	    $sub_name->( ( 7 ) x 7 );
+	} )
+    }
+    @subs;
+
+
+say "\nRunning benchmarks:";
+cmpthese -10, \%benchmark_runs;
+
+exit 0;
diff --git a/challenge-243/matthias-muth/perl/challenge-243.txt b/challenge-243/matthias-muth/perl/challenge-243.txt
new file mode 100644
index 0000000000..cb119e4adf
--- /dev/null
+++ b/challenge-243/matthias-muth/perl/challenge-243.txt
@@ -0,0 +1,56 @@
+The Weekly Challenge - 243
+Monday, Nov 13, 2023
+
+
+Task 1: Reverse Pairs
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+Write a script to return the number of reverse pairs in the given array.
+A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j].
+Example 1
+
+Input: @nums = (1, 3, 2, 3, 1)
+Output: 2
+
+(1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1
+(3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1
+
+Example 2
+
+Input: @nums = (2, 4, 3, 5, 1)
+Output: 3
+
+(1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1
+(2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1
+(3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1
+
+
+Task 2: Floor Sum
+Submitted by: Mohammad S Anwar
+
+You are given an array of positive integers (>=1).
+Write a script to return the sum of floor(nums[i] / nums[j]) where 0 <= i,j < nums.length. The floor() function returns the integer part of the division.
+
+Example 1
+
+Input: @nums = (2, 5, 9)
+Output: 10
+
+floor(2 / 5) = 0
+floor(2 / 9) = 0
+floor(5 / 9) = 0
+floor(2 / 2) = 1
+floor(5 / 5) = 1
+floor(9 / 9) = 1
+floor(5 / 2) = 2
+floor(9 / 2) = 4
+floor(9 / 5) = 1
+
+Example 2
+
+Input: @nums = (7, 7, 7, 7, 7, 7, 7)
+Output: 49
+
+
+Last date to submit the solution 23:59 (UK Time) Sunday 19th November 2023.