Merge pull request #12603 from MatthiasMuth/muthm-336

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

4 files changed, 232 insertions, 132 deletions

diff --git a/challenge-336/matthias-muth/README.md b/challenge-336/matthias-muth/README.md
index 5eaaa52372..3a66353fda 100644
--- a/challenge-336/matthias-muth/README.md
+++ b/challenge-336/matthias-muth/README.md
@@ -1,231 +1,255 @@
-# Uncommon Bags and Winning Lines
+# Equal Groups and Final Scores
 
-**Challenge 335 solutions in Perl by Matthias Muth**
+**Challenge 336 solutions in Perl by Matthias Muth**
 
-## Task 1: Common Characters
+## Task 1: Equal Group
 
-> You are given an array of words.<br/>
-> Write a script to return all characters that is in every word in the given array including duplicates.
+> You are given an array of integers.<br/>
+> Write a script to return true if the given array can be divided into one or more groups: each group must be of the same size as the others, with at least two members, and with all members having the same value.
 >
 > **Example 1**
 >
 > ```text
-> Input: @words = ("bella", "label", "roller")
-> Output: ("e", "l", "l")
+> Input: @ints = (1,1,2,2,2,2)
+> Output: true
+>
+> Groups: (1,1), (2,2), (2,2)
 >```
 > 
 >**Example 2**
 > 
 >```text
-> Input: @words = ("cool", "lock", "cook")
-> Output: ("c", "o")
+> Input: @ints = (1,1,1,2,2,2,3,3)
+> Output: false
+> 
+>Groups: (1,1,1), (2,2,2), (3,3)
 > ```
 >
 > **Example 3**
 >
 > ```text
->Input: @words = ("hello", "world", "pole")
-> Output: ("l", "o")
-> ```
+>Input: @ints = (5,5,5,5,5,5,7,7,7,7,7,7)
+> Output: true
+> 
+> Groups: (5,5,5,5,5,5), (7,7,7,7,7,7)
+>```
 > 
 >**Example 4**
 > 
 >```text
-> Input: @words = ("abc", "def", "ghi")
->Output: ()
+> Input: @ints = (1,2,3,4)
+>Output: false
 > ```
 > 
 > **Example 5**
 >
 > ```text
->Input: @words = ("aab", "aac", "aaa")
-> Output: ("a", "a")
->```
+>Input: @ints = (8,8,9,9,10,10,11,11)
+> Output: true
+>
+> Groups: (8,8), (9,9), (10,10), (11,11)
+> ```
 
-Maybe the concept of a 'Bag' data structure is a bit underrated in Perl. That's bad, because the `Set::Bag` module from CPAN does a great job, making many things a lot easier.
+##### Approach
 
-Essentially, a 'bag' is like a 'set', except if you add an element several times, all of the elements are kept in the bag, not just one as in a set.
+I first determine how often each number occurs, in other words, the **frequency** of each number.
 
-The same is true for removing elements. If I put five identical elements into a bag, then remove three of them from that bag, there will be two elements left in the bag. Very intuitive.
+If we need to split all numbers into groups of the same size, the frequencies of all numbers must be divisible by that group size. I determine the **divisors** of each number's frequency to get a list of possible group sizes for each number.
 
-This concept can be applied perfectly for this task here:
+Now, we are looking for a possible group size for *all* numbers. For this to happen, that group size must be in the list of divisors of *all* number's frequencies.
 
-We split up the first word into characters, and put those into a bag. Just like in a game of Scrabble.
+We can make this easy and just count how often each divisor occurs, and if that count matches the count of distinct input numbers, we have found a possible group size.
 
-The `Set::Bag` constructor expects pairs of each an element name and its respective number of occurrences. It's good that if the same element occurs multiple times in the parameter list, everything is added to the bag (other than when we create a hash!). So we can give a `1` as the number of occurrences for every letter, even if it reappears again later. So to create the initial 'common' bag:  
+##### Implementation
 
-```perl
-    my $common_bag = Set::Bag->new( map { ( $_ => 1 ) } split //, $words[0] );
-```
+For this task, I base my solution on some common modules.
 
-Then, we loop over all other words (all except the first one).
+The `frequency` function from `List::MoreUtils` is a good and solid way for determining the frequencies of the input numbers:
 
-For each word, we do the same splitting up into letters and putting them into a bag.<br/>
-Then, we use the *intersection* operation to get rid of all characters that are not in both bags. It is defined like this:
-
->The **intersection** leaves in the result bag only the elements that have instances in all bags and of those the minimal number of instances.
-
-This is exactly what we need: the minimum number of each element (letter) that is contained in both bags (words).
+```perl
+    use List::MoreUtils qw( frequency );
+    my %counts = frequency( @ints );
+```
 
-The *intersection* operation can even be called using an overloaded `&` operator, also as an assignment, like `&=`:
+For finding all possible divisors for each of the frequencies, `Math::Prime::Util` offers the `divisors` function, which is a perfect fit. I only need to exclude `1` (which always is a divisor) from being a possible group size. I put all possible divisors of all numbers into one big array, because we actually don't need the individual divisors per number, but we only need their count in the next step.
 
 ```perl
-    $common_bag &= Set::Bag->new( map { ( $_ => 1 ) } split //, $_ )
-        for @words[1..$#words];
+    use Math::Prime::Util qw( divisors );
+    my @all_divisors = grep $_ != 1, map divisors( $_ ), values %counts;
 ```
 
-That's all the magic!
+We can use `frequency` again to determine how often each divisor exists:
 
-After all words are processed, we need to get all elements that still remain in the bag. The `grab` function does this. It can either return list of *all* elements with their respective numbers of occurrences, as a paired list that can be assigned to a hash (similar to `frequency` from `List::MoreUtils`) , or used in a multi-variable `for` loop, but it can also return the number of occurrences of a *single* element that we give as a parameter. As we need a *sorted* return list, it is easier to get the names of elements using the `elements` function, sort them, then `grab` each elements number of occurrences and create a that number of entries for a list. For this multiplication of entries for the return list, we can use Perl's `x` list repetition operator.
+```perl
+    my %divisor_frequencies = frequency @all_divisors;
+```
 
-The one-statement code for that is less complicated than this long description would let expect:
+Eventually, `any` (from `List::Util`) can check whether there is any divisor whose frequency matches the count of all distinct input numbers. We already have the 'distinct input numbers': as we created a hash with the numbers' frequency counts, the keys in that hash are the distinct numbers. So we can use a shortcut and save some CPU cycles by using `scalar keys %counts` instead of `scalar uniq @ints` to get the number of distinct input numbers:
 
 ```perl
-    return map +( $_ ) x $common_bag->grab( $_ ),
-        sort $common_bag->elements;
+    return any { $_ == scalar keys %counts } values %divisor_frequencies;
 ```
 
-So this is my possibly 'uncommon' solution to the 'Common characters' task:
+This strategy, making good use of existing modules (whether in core Perl or on CPAN), results in a four lines-of-code solution:
 
 ```perl
 use v5.36;
-
-use Set::Bag;
-
-sub common_characters( @words ) {
-    my $common_bag = Set::Bag->new( map { ( $_ => 1 ) } split //, $words[0] );
-    $common_bag &= Set::Bag->new( map { ( $_ => 1 ) } split //, $_ )
-        for @words[1..$#words];
-    return map +( $_ ) x $common_bag->grab( $_ ),
-        sort $common_bag->elements;
+use List::MoreUtils qw( frequency );
+use Math::Prime::Util qw( divisors );
+use List::Util qw( any );
+
+sub equal_group( @ints ) {
+    my %counts = frequency( @ints );
+    my @all_divisors = grep $_ != 1, map divisors( $_ ), values %counts;
+    my %divisor_frequencies = frequency @all_divisors;
+    return any { $_ == scalar %counts } values %divisor_frequencies;
 }
 ```
 
-## Task 2: Find Winner
+## Task 2: Final Score
 
-> You are given an array of all moves by the two players.<br/>
-> Write a script to find the winner of the TicTacToe game if found based on the moves provided in the given array.<br/>
-> UPDATE: Order move is in the order - A, B, A, B, A, ….
+> You are given an array of scores by a team.<br/>
+> Write a script to find the total score of the given team. The score can be any integer, +, C or D. The + adds the sum of previous two scores. The score C invalidates the previous score. The score D will double the previous score.
 >
 > **Example 1**
 >
 > ```text
-> Input: @moves = ([0,0],[2,0],[1,1],[2,1],[2,2])
-> Output: A
+> Input: @scores = ("5","2","C","D","+")
+> Output: 30
+>
+> Round 1: 5
+> Round 2: 5 + 2
+> Round 3: 5 (invalidate the previous score 2)
+> Round 4: 5 + 10 (double the previous score 5)
+> Round 5: 5 + 10 + 15 (sum of previous two scores)
 >
-> Game Board:
-> [ A _ _ ]
-> [ B A B ]
-> [ _ _ A ]
+> Total Scores: 30
 >```
 > 
 >**Example 2**
 > 
 >```text
-> Input: @moves = ([0,0],[1,1],[0,1],[0,2],[1,0],[2,0])
-> Output: B
+> Input: @scores = ("5","-2","4","C","D","9","+","+")
+> Output: 27
 > 
->Game Board:
-> [ A A B ]
-> [ A B _ ]
-> [ B _ _ ]
+>Round 1: 5
+> Round 2: 5 + (-2)
+> Round 3: 5 + (-2) + 4
+> Round 4: 5 + (-2) (invalidate the previous score 4)
+> Round 5: 5 + (-2) + (-4) (double the previous score -2)
+> Round 6: 5 + (-2) + (-4) + 9
+> Round 7: 5 + (-2) + (-4) + 9 + 5 (sum of previous two scores)
+> Round 8: 5 + (-2) + (-4) + 9 + 5 + 14 (sum of previous two scores)
+> 
+>Total Scores: 27
 > ```
 >
 > **Example 3**
 >
 > ```text
->Input: @moves = ([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2])
-> Output: Draw
+>Input: @scores = ("7","D","D","C","+","3")
+> Output: 45
 > 
-> Game Board:
->[ A A B ]
-> [ B B A ]
-> [ A B A ]
-> ```
+> Round 1: 7
+>Round 2: 7 + 14 (double the previous score 7)
+> Round 3: 7 + 14 + 28 (double the previous score 14)
+> Round 4: 7 + 14 (invalidate the previous score 28)
+> Round 5: 7 + 14 + 21 (sum of previous two scores)
+> Round 6: 7 + 14 + 21 + 3
+> 
+> Total Scores: 45
+>```
 > 
 >**Example 4**
 > 
 >```text
-> Input: @moves = ([0,0],[1,1])
->Output: Pending
+> Input: @scores = ("-5","-10","+","D","C","+")
+>Output: -55
 > 
-> Game Board:
-> [ A _ _ ]
->[ _ B _ ]
-> [ _ _ _ ]
-> ```
+> Round 1: (-5)
+> Round 2: (-5) + (-10)
+>Round 3: (-5) + (-10) + (-15) (sum of previous two scores)
+> Round 4: (-5) + (-10) + (-15) + (-30) (double the previous score -15)
+> Round 5: (-5) + (-10) + (-15) (invalidate the previous score -30)
+> Round 6: (-5) + (-10) + (-15) + (-25) (sum of previous two scores)
 > 
+> Total Scores: -55
+> ```
+>
 > **Example 5**
 >
 > ```text
->Input: @moves = ([1,1],[0,0],[2,2],[0,1],[1,0],[0,2])
-> Output: B
+>Input: @scores = ("3","6","+","D","C","8","+","D","-2","C","+")
+> Output: 128
 >
-> Game Board:
-> [ B B B ]
-> [ A A _ ]
->[ _ _ A ]
+> Round  1: 3
+> Round  2: 3 + 6
+> Round  3: 3 + 6 + 9 (sum of previous two scores)
+>Round  4: 3 + 6 + 9 + 18 (double the previous score 9)
+> Round  5: 3 + 6 + 9 (invalidate the previous score 18)
+> Round  6: 3 + 6 + 9 + 8
+> Round  7: 3 + 6 + 9 + 8 + 17 (sum of previous two scores)
+> Round  8: 3 + 6 + 9 + 8 + 17 + 34 (double the previous score 17)
+> Round  9: 3 + 6 + 9 + 8 + 17 + 34 + (-2)
+> Round 10: 3 + 6 + 9 + 8 + 17 + 34 (invalidate the previous score -2)
+> Round 11: 3 + 6 + 9 + 8 + 17 + 34 + 51 (sum of previous two scores)
+> 
+> Total Scores: 128
 > ```
 
-Instead of maintaining the 3 x 3 board, and analyzing it in the end, I chose a different approach.
-
-My idea is this:
+We obviously need a loop. Let's see how I can write that in a somewhat elegant style that is easy to follow.
 
-* For each move, I don't mark the point in a 2-D grid, but instead, for every line that the point is on, I increment that line's counter for the current player.
-* Whenever a mark counter is incremented to 3, this is the winning line, and that player is the winner.
-* If we arrive at the end of the moves, and there has been no winner yet, the game is a 'draw' if nine moves were played, and if there were less than nine moves, it is 'pending'.
+Apparently we need an array for keeping the list of scores. We only operate on the most recent entries, so it actually implements a stack, but I call it `@list` nevertheless because it is used for building the final list of scores. So:
 
-To implement this, I first define the line numbers:
+```perl
+    my @list;
+```
 
-* 0..2: horizontal lines (top to bottom),
-* 3..5: vertical lines (left to right),
-* 6: top-left to bottom right diagonal,
-* 7: top-right to bottom-left diagonal.
+Then we loop over the 'input scores'. The word 'score' is a bit ambiguous, because it can mean the 'input scores', which includes commands like `'C'`, `'D'`, or `'+'`, but it also means the final list of scores, which only consist of numbers that we will eventually sum up.
 
-Then, I produce a 'precomputed' list of line numbers for each point:
+What we get as 'input scores' may be integer numbers (including negative ones), or commands. To distinguish between them, and to do what is needed for each of them, my preferred structure is this one:
 
 ```perl
-my @lines_by_points = (
-    [ [ 0, 3, 6 ], [ 0, 4 ],       [ 0, 5, 7 ] ],
-    [ [ 1, 3    ], [ 1, 4, 6, 7 ], [ 1, 5 ]    ],
-    [ [ 2, 3, 7 ], [ 2, 4 ],       [ 2, 5, 6 ] ],
-);
+    for ( @scores ) {
+        /^C$/   and do { ... };
+        /^D$/   and do { ... };
+        /^\+$/  and do { ... };
+        /-?\d+$ and do { ... };
+    }
 ```
 
-Then, the rest of the implementation is more or less straightforward.<br/>Just note the little shortcut for incrementing and comparing to `3` in the same statement.<br/>
-We also mustn't forget to switch players after every move. 
+This nicely groups the possible inputs, and gives a good overview over the whole process.
+
+Now we have to fill in what to do for each case:
+
+* `'C'`:
+  `pop` the last value from the `@list` stack.
+* `'D'`: double the last value and `push` the result on the stack.
+* `'+'`: add the last two entries and `push` the sum on the stack.
+* A (possibly negative) integer number: simply `push` it on the stack.
+
+Everything else is silently ignored.
+
+In the end I use `sum` from `List::Util` to sum up the scores gathered in the `@list` array. 
+
+This is my solution for task 2:
 
 ```perl
 use v5.36;
-
-# winning lines:
-#    0 - . . .
-#    1 - . . .
-#    2 - . . .
-#       /| | |\
-#     7  3 4 5  6
-
-my @lines_by_points = (
-    [ [ 0, 3, 6 ], [ 0, 4 ],       [ 0, 5, 7 ] ],
-    [ [ 1, 3    ], [ 1, 4, 6, 7 ], [ 1, 5 ]    ],
-    [ [ 2, 3, 7 ], [ 2, 4 ],       [ 2, 5, 6 ] ],
-);
-
-sub find_winner( $moves ) {
-    my @lines;
-    my $player = "A";
-    for ( $moves->@* ) {
-        my ( $r, $c ) = $_->@[0,1];
-        for my $line ( $lines_by_points[$r][$c]->@* ) {
-            return $player
-                if ++$lines[$line]{$player} == 3;
-        }
-        $player = $player eq "A" ? "B" : "A";
+use List::Util qw( sum );
+
+sub final_score( @scores ) {
+    my @list;
+    for ( @scores ) {
+        /^C$/    and do { pop @list;                         next };
+        /^D$/    and do { push @list, 2 * $list[-1];         next };
+        /^\+$/   and do { push @list, $list[-2] + $list[-1]; next };
+        /-?\d+$/ and do { push @list, $&;                    next };
     }
-    return $moves->@* == 9 ? "Draw" : "Pending";
+    return sum( @list );
 }
 ```
 
-My hope is that this uses less resources than any type of analyzing the 2-D grid after putting in all marks.  
+I hope it's easy enough to recognize the task structure in the code.
 
 #### **Thank you for the challenge!**
diff --git a/challenge-336/matthias-muth/blog.txt b/challenge-336/matthias-muth/blog.txt
new file mode 100644
index 0000000000..ee0bbe624b
--- /dev/null
+++ b/challenge-336/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-336/challenge-336/matthias-muth#readme
diff --git a/challenge-336/matthias-muth/perl/ch-1.pl b/challenge-336/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..1ff3b95165
--- /dev/null
+++ b/challenge-336/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 336 Task 1: Equal Group
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+use List::MoreUtils qw( frequency );
+use Math::Prime::Util qw( divisors );
+use List::Util qw( any );
+
+sub equal_group( @ints ) {
+    my %counts = frequency( @ints );
+    my @all_divisors = grep $_ != 1, map divisors( $_ ), values %counts;
+    my %divisor_frequencies = frequency @all_divisors;
+    return any { $_ == scalar keys %counts } values %divisor_frequencies;
+}
+
+use Test2::V0 qw( -no_srand );
+
+is equal_group( 1, 1, 2, 2, 2, 2 ), T,
+    'Example 1: equal_group( 1, 1, 2, 2, 2, 2 ) is true';
+is equal_group( 1, 1, 1, 2, 2, 2, 3, 3 ), F,
+    'Example 2: equal_group( 1, 1, 1, 2, 2, 2, 3, 3 ) is false';
+is equal_group( 5, 5, 5, 5, 5, 5, 7, 7, 7, 7, 7, 7 ), T,
+    'Example 3: equal_group( 5, 5, 5, 5, 5, 5, 7, 7, 7, 7, 7, 7 ) is true';
+is equal_group( 1, 2, 3, 4 ), F,
+    'Example 4: equal_group( 1, 2, 3, 4 ) is false';
+is equal_group( 8, 8, 9, 9, 10, 10, 11, 11 ), T,
+    'Example 5: equal_group( 8, 8, 9, 9, 10, 10, 11, 11 ) is true';
+
+done_testing;
diff --git a/challenge-336/matthias-muth/perl/ch-2.pl b/challenge-336/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..5444ff53b2
--- /dev/null
+++ b/challenge-336/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 336 Task 2: Final Score
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+use List::Util qw( sum );
+
+sub final_score( @scores ) {
+    my @list;
+    for ( @scores ) {
+        /^C$/    and do { pop @list;                         next };
+        /^D$/    and do { push @list, 2 * $list[-1];         next };
+        /^\+$/   and do { push @list, $list[-2] + $list[-1]; next };
+        /-?\d+$/ and do { push @list, $&;                    next };
+    }
+    return sum( @list );
+}
+
+use Test2::V0 qw( -no_srand );
+
+is final_score( 5, 2, "C", "D", "+" ), 30,
+    'Example 1: final_score( 5, 2, "C", "D", "+" ) == 30';
+is final_score( 5, -2, 4, "C", "D", 9, "+", "+" ), 27,
+    'Example 2: final_score( 5, -2, 4, "C", "D", 9, "+", "+" ) == 27';
+is final_score( 7, "D", "D", "C", "+", 3 ), 45,
+    'Example 3: final_score( 7, "D", "D", "C", "+", 3 ) == 45';
+is final_score( -5, -10, "+", "D", "C", "+" ), -55,
+    'Example 4: final_score( -5, -10, "+", "D", "C", "+" ) == -55';
+is final_score( 3, 6, "+", "D", "C", 8, "+", "D", -2, "C", "+" ), 128,
+    'Example 5: final_score( 3, 6, "+", "D", "C", 8, "+", "D", -2, "C", "+" ) == 128';
+
+done_testing;