diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2025-08-23 23:30:50 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2025-08-23 23:30:50 +0100 |
| commit | a3de9de37e1f96b4dcf5dc80bb6b22d387ade531 (patch) | |
| tree | 6b0f35ff00f8747ba5e6c0869176c0f76ce9aeaa | |
| parent | 29e29ff9f76a1b6ace9bb48daee108d3e281e953 (diff) | |
| parent | 3145fb40a38b7657545a5043f423922ed470b06c (diff) | |
| download | perlweeklychallenge-club-a3de9de37e1f96b4dcf5dc80bb6b22d387ade531.tar.gz perlweeklychallenge-club-a3de9de37e1f96b4dcf5dc80bb6b22d387ade531.tar.bz2 perlweeklychallenge-club-a3de9de37e1f96b4dcf5dc80bb6b22d387ade531.zip | |
Merge pull request #12559 from MatthiasMuth/muthm-335
Challenge 335 Task 1 and 2 solutions in Perl by Matthias Muth
| -rw-r--r-- | challenge-335/matthias-muth/README.md | 360 | ||||
| -rw-r--r-- | challenge-335/matthias-muth/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-335/matthias-muth/perl/ch-1.pl | 36 | ||||
| -rwxr-xr-x | challenge-335/matthias-muth/perl/ch-2.pl | 53 |
4 files changed, 250 insertions, 200 deletions
diff --git a/challenge-335/matthias-muth/README.md b/challenge-335/matthias-muth/README.md index 36e7ef351a..5eaaa52372 100644 --- a/challenge-335/matthias-muth/README.md +++ b/challenge-335/matthias-muth/README.md @@ -1,271 +1,231 @@ -# Perl Slices Make a Valid Point +# Uncommon Bags and Winning Lines -**Challenge 334 solutions in Perl by Matthias Muth** +**Challenge 335 solutions in Perl by Matthias Muth** -## Task 1: Range Sum +## Task 1: Common Characters -> You are given a list integers and pair of indices..<br/> -> Write a script to return the sum of integers between the given indices (inclusive). +> 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. > > **Example 1** > > ```text -> Input: @ints = (-2, 0, 3, -5, 2, -1), $x = 0, $y = 2 -> Output: 1 +> Input: @words = ("bella", "label", "roller") +> Output: ("e", "l", "l") +>``` > -> Elements between indices (0, 2) => (-2, 0, 3) -> Range Sum: (-2) + 0 + 3 => 1 -> ``` -> -> **Example 2** -> -> ```text -> Input: @ints = (1, -2, 3, -4, 5), $x = 1, $y = 3 -> Output: -3 +>**Example 2** > -> Elements between indices (1, 3) => (-2, 3, -4) -> Range Sum: (-2) + 3 + (-4) => -3 +>```text +> Input: @words = ("cool", "lock", "cook") +> Output: ("c", "o") > ``` > > **Example 3** > > ```text -> Input: @ints = (1, 0, 2, -1, 3), $x = 3, $y = 4 -> Output: 2 -> -> Elements between indices (3, 4) => (-1, 3) -> Range Sum: (-1) + 3 => 2 +>Input: @words = ("hello", "world", "pole") +> Output: ("l", "o") > ``` -> -> **Example 4** -> -> ```text -> Input: @ints = (-5, 4, -3, 2, -1, 0), $x = 0, $y = 3 -> Output: -2 > -> Elements between indices (0, 3) => (-5, 4, -3, 2) -> Range Sum: (-5) + 4 + (-3) + 2 => -2 +>**Example 4** +> +>```text +> Input: @words = ("abc", "def", "ghi") +>Output: () > ``` -> +> > **Example 5** > > ```text -> Input: @ints = (-1, 0, 2, -3, -2, 1), $x = 0, $y = 2 -> Output: 1 -> -> Elements between indices (0, 2) => (-1, 0, 2) -> Range Sum: (-1) + 0 + 2 => 1 -> ``` +>Input: @words = ("aab", "aac", "aaa") +> Output: ("a", "a") +>``` + +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. + +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. + +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. + +This concept can be applied perfectly for this task here: + +We split up the first word into characters, and put those into a bag. Just like in a game of Scrabble. + +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: -Wait, what?<br/> -The elements between two indexes?<br/>As if Perl didn't have *array slices*...!<br/>It's just `@ints[$x..$y]`!<br/>OK, if we consider that the `@ints` array is passed in as a reference, it's `$ints->@[$x..$y]`. +```perl + my $common_bag = Set::Bag->new( map { ( $_ => 1 ) } split //, $words[0] ); +``` + +Then, we loop over all other words (all except the first one). + +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: -And summing up?<br/>Too lazy to write a loop. I'll use `sum` from `List::Util`.<br/>Maybe it's good to save my energy for Task 2... :wink: +>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). + +The *intersection* operation can even be called using an overloaded `&` operator, also as an assignment, like `&=`: + +```perl + $common_bag &= Set::Bag->new( map { ( $_ => 1 ) } split //, $_ ) + for @words[1..$#words]; +``` + +That's all the magic! + +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. + +The one-statement code for that is less complicated than this long description would let expect: + +```perl + return map +( $_ ) x $common_bag->grab( $_ ), + sort $common_bag->elements; +``` + +So this is my possibly 'uncommon' solution to the 'Common characters' task: ```perl use v5.36; -use List::Util qw( sum ); -sub range_sum( $ints, $x, $y ) { - return sum( $ints->@[$x..$y] ); +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; } ``` -## Task 2: Nearest Valid Point +## Task 2: Find Winner -> You are given current location as two integers: x and y. You are also given a list of points on the grid.<br/> -> A point is considered valid if it shares either the same x-coordinate or the same y-coordinate as the current location.<br/> -> Write a script to return the index of the valid point that has the smallest Manhattan distance to the current location. If multiple valid points are tied for the smallest distance, return the one with the lowest index. If no valid points exist, return -1.<br/> -> <br/> -> The Manhattan distance between two points (x1, y1) and (x2, y2) is calculated as: |x1 - x2| + |y1 - y2| +> 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, …. > > **Example 1** > > ```text -> Input: $x = 3, $y = 4, @points ([1, 2], [3, 1], [2, 4], [2, 3]) -> Output: 2 -> -> Valid points: [3, 1] (same x), [2, 4] (same y) +> Input: @moves = ([0,0],[2,0],[1,1],[2,1],[2,2]) +> Output: A > -> Manhattan distances: -> [3, 1] => |3-3| + |4-1| = 3 -> [2, 4] => |3-2| + |4-4| = 1 -> -> Closest valid point is [2, 4] at index 2. +> Game Board: +> [ A _ _ ] +> [ B A B ] +> [ _ _ A ] >``` > >**Example 2** > >```text -> Input: $x = 2, $y = 5, @points ([3, 4], [2, 3], [1, 5], [2, 5]) -> Output: 3 -> ->Valid points: [2, 3], [1, 5], [2, 5] +> Input: @moves = ([0,0],[1,1],[0,1],[0,2],[1,0],[2,0]) +> Output: B > ->Manhattan distances: -> [2, 3] => 2 -> [1, 5] => 1 -> [2, 5] => 0 -> ->Closest valid point is [2, 5] at index 3. +>Game Board: +> [ A A B ] +> [ A B _ ] +> [ B _ _ ] > ``` > > **Example 3** > > ```text ->Input: $x = 1, $y = 1, @points ([2, 2], [3, 3], [4, 4]) -> Output: -1 +>Input: @moves = ([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2]) +> Output: Draw > -> No point shares x or y with (1, 1). ->``` +> Game Board: +>[ A A B ] +> [ B B A ] +> [ A B A ] +> ``` > >**Example 4** > >```text -> Input: $x = 0, $y = 0, @points ([0, 1], [1, 0], [0, 2], [2, 0]) ->Output: 0 +> Input: @moves = ([0,0],[1,1]) +>Output: Pending > -> Valid points: all of them +> Game Board: +> [ A _ _ ] +>[ _ B _ ] +> [ _ _ _ ] +> ``` > ->Manhattan distances: -> [0, 1] => 1 -> [1, 0] => 1 -> [0, 2] => 2 -> [2, 0] => 2 -> -> Tie between index 0 and 1, pick the smaller index: 0 -> ``` -> > **Example 5** > > ```text ->Input: $x = 5, $y = 5, @points ([5, 6], [6, 5], [5, 4], [4, 5]) -> Output: 0 +>Input: @moves = ([1,1],[0,0],[2,2],[0,1],[1,0],[0,2]) +> Output: B > -> Valid points: all of them -> [5, 6] => 1 -> [6, 5] => 1 -> [5, 4] => 1 -> [4, 5] => 1 -> -> All tie, return the one with the lowest index: 0 -> ``` - -#### The Long Solution (using a `for` loop): - -I will start by constructing a more 'traditional' solution (even if it uses several concepts of 'modern' Perl).<br/>It will be based on a programmed-out `for` loop. - -Some thoughts: - -* We need to return the *index* of the closest 'valid' point (not the point itself, nor its distance from ( \$x, \$y )). That means that when we filter out the points that are 'valid', we must maintain their index into the *original* point list.<br/>This means that we need to use the index into the point list as a driver for the loop rather than the points themselves. So instead of iterating over the points, like - ```perl - for my $point ( $points->@* ) { ... } - ``` - we need to do this: - ```perl - for my $index ( keys $points->@* ) { - my $point = $points->[$index]; - ...; - } - ``` - -* Starting with Perl 5.36, however, we can use multiple (lexical) loop variables with `for`/`foreach` loops. <br/> - Together with the `indexed` builtin, also available since Perl 5.36, - we can loop over index and point at the same time, with a more concise syntax: - - ```perl - for my ( $index, $point ) ( indexed $points->@* ) { - ...; - } - ``` - -* If the point's x-coordinate is equal to `$x` or the point's y-coordinate is equal to `$y`, the point is 'valid'. - All other points need to be ignored.<br/> - Once we know that the point's x-coordinate is equal to `$x`, - the distance in the x dimension is zero, - and the point's Manhattan distance is reduced to the y dimension: - `abs( $y - $point->[1] )`.<br/> - The same for the y-coordinate being equal to `$y`, of course: - `abs( $x - $point->[0] )`.<br/> - If none of the equalities show up, we can directly start the next iteration. In Perl, we are lucky that statements (here, the `next` statement) can also be used within expressions, not only as separate statements. (Thank you, James Curtis-Smith, for giving me that idea in your [Challenge 325 solution](https://www.facebook.com/groups/perlcommunity/permalink/1954898661984417/)!).<br/> - So we can combine the Manhattan distance calculation and the filtering in one statement within the loop: - - ```perl - for my ( $index, $point ) ( indexed $points->@* ) { - my $distance = - $point->[0] == $x ? abs( $y - $point->[1] ) - : $point->[1] == $y ? abs( $x - $point->[0] ) - : next; - ... - } - ``` - -* For finding the index with the closest distance, we add some 'traditional' minimum finding code. We need to keep the best index as well as the closest distance, and update after a comparison in the loop. - - ```perl - my ( $closest_index, $closest_distance ) = ( undef, undef ); - for my ( $index, $point ) ( indexed $points->@* ) { - my $distance = ...; - ( $closest_index, $closest_distance ) = ( $index, $distance ) - if ! defined $closest_index || $distance < $closest_distance; - } - return $closest_index // -1; - ``` - -Putting all together, this is my 'traditional' solution: +> Game Board: +> [ B B B ] +> [ A A _ ] +>[ _ _ A ] +> ``` -```perl -use v5.36; -use builtin qw( indexed ); - -sub nearest_valid_point_traditional( $x, $y, $points ) { - my ( $closest_index, $closest_distance ) = ( undef, undef ); - for my ( $index, $point ) ( indexed $points->@* ) { - my $distance = - $point->[0] == $x ? abs( $y - $point->[1] ) - : $point->[1] == $y ? abs( $x - $point->[0] ) - : next; - ( $closest_index, $closest_distance ) = ( $index, $distance ) - if ! defined $closest_index || $distance < $closest_distance; - } - return $closest_index // -1; -} -``` +Instead of maintaining the 3 x 3 board, and analyzing it in the end, I chose a different approach. -#### The Shorter Solution (using a clever library function) +My idea is this: - Normally it is much easier to use a `min` function than programming a `for` loop for finding a minimum. -So let's see how that can make the code shorter.<br/> -As we have two values to keep (the index and the current closest distance), the normal `min` function from `List::Util` doesn't help here. But there is a `min_by` function in the `List::UtilsBy` CPAN module (also in `List::AllUtils`) that works like this: +* 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'. -> ##### min_by -> -> ``` -> $optimal = min_by { KEYFUNC } @vals -> @optimal = min_by { KEYFUNC } @vals -> ``` -> -> [...] returns values which give the numerically smallest result from the key function. +To implement this, I first define the line numbers: -We can provide the indexes of the 'valid' points, and let the `KEYFUNC` calculate the Manhattan distance as the minimum criterion.<br/>And for getting those 'valid' indexes, we can use `grep` to filter them from the original list of points. +* 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. -Since we are separating the filtering from the distance calculation, we cannot take the shortcuts that ignore one dimension if the x- or y-coordinates equal `$x` or `$y` here. We must perform the standard Manhattan distance calculation, which includes both dimensions. +Then, I produce a 'precomputed' list of line numbers for each point: + +```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 ] ], +); +``` -But still, this results in a much shorter solution, rendering both the `for` loop and the two-variable minimum calculation code unnecessary: +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. -```perl +```perl use v5.36; -use List::UtilsBy qw( min_by ); - -sub nearest_valid_point( $x, $y, $points ) { - my $closest_index = - min_by { abs( $points->[$_][0] - $x ) + abs( $points->[$_][1] - $y ) } - grep $points->[$_][0] == $x || $points->[$_][1] == $y, - keys $points->@*; - return $closest_index // -1; + +# 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"; + } + return $moves->@* == 9 ? "Draw" : "Pending"; } ``` -Less code is good code! +My hope is that this uses less resources than any type of analyzing the 2-D grid after putting in all marks. #### **Thank you for the challenge!** diff --git a/challenge-335/matthias-muth/blog.txt b/challenge-335/matthias-muth/blog.txt new file mode 100644 index 0000000000..fcafdd5af2 --- /dev/null +++ b/challenge-335/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-335/challenge-335/matthias-muth#readme diff --git a/challenge-335/matthias-muth/perl/ch-1.pl b/challenge-335/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..d7599c358c --- /dev/null +++ b/challenge-335/matthias-muth/perl/ch-1.pl @@ -0,0 +1,36 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 335 Task 1: Common Characters +# +# Perl solution by Matthias Muth. +# + +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 Test2::V0 qw( -no_srand ); + +is [ common_characters( "bella", "label", "roller" ) ], [ "e", "l", "l" ], + 'Example 1: common_characters( "bella", "label", "roller" ) == ("e", "l", "l")'; +is [ common_characters( "cool", "lock", "cook" ) ], [ "c", "o" ], + 'Example 2: common_characters( "cool", "lock", "cook" ) == ("c", "o")'; +is [ common_characters( "hello", "world", "pole" ) ], [ "l", "o" ], + 'Example 3: common_characters( "hello", "world", "pole" ) == ("l", "o")'; +is [ common_characters( "abc", "def", "ghi" ) ], [ ], + 'Example 4: common_characters( "abc", "def", "ghi" ) == ()'; +is [ common_characters( "aab", "aac", "aaa" ) ], [ "a", "a" ], + 'Example 5: common_characters( "aab", "aac", "aaa" ) == ("a", "a")'; + +done_testing; diff --git a/challenge-335/matthias-muth/perl/ch-2.pl b/challenge-335/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..42e2d6b192 --- /dev/null +++ b/challenge-335/matthias-muth/perl/ch-2.pl @@ -0,0 +1,53 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 335 Task 2: Find Winner +# +# Perl solution by Matthias Muth. +# + +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"; + } + return $moves->@* == 9 ? "Draw" : "Pending"; +} + +use Test2::V0 qw( -no_srand ); + +is find_winner( [[0, 0], [2, 0], [1, 1], [2, 1], [2, 2]] ), "A", + 'Example 1: find_winner( [[0, 0], [2, 0], [1, 1], [2, 1], [2, 2]] ) == "A"'; +is find_winner( [[0, 0], [1, 1], [0, 1], [0, 2], [1, 0], [2, 0]] ), "B", + 'Example 2: find_winner( [[0, 0], [1, 1], [0, 1], [0, 2], [1, 0], [2, 0]] ) == "B"'; +is find_winner( [ [0, 0], [1, 1], [2, 0], [1, 0], [1, 2], [2, 1], [0, 1], [0, 2], [2, 2], ] ), "Draw", + 'Example 3: find_winner( [ [0, 0], [1, 1], [2, 0], [1, 0], [1, 2], [2, 1], [0, 1], [0, 2], [2, 2], ] ) == "Draw"'; +is find_winner( [[0, 0], [1, 1]] ), "Pending", + 'Example 4: find_winner( [[0, 0], [1, 1]] ) == "Pending"'; +is find_winner( [[1, 1], [0, 0], [2, 2], [0, 1], [1, 0], [0, 2]] ), "B", + 'Example 5: find_winner( [[1, 1], [0, 0], [2, 2], [0, 1], [1, 0], [0, 2]] ) == "B"'; + +done_testing; |
