diff options
22 files changed, 468 insertions, 9 deletions
diff --git a/challenge-307/jaldhar-h-vyas/blog.txt b/challenge-307/jaldhar-h-vyas/blog.txt new file mode 100644 index 0000000000..04cbc3ba55 --- /dev/null +++ b/challenge-307/jaldhar-h-vyas/blog.txt @@ -0,0 +1 @@ +https://www.braincells.com/perl/2025/02/perl_weekly_challenge_week_307.html diff --git a/challenge-307/jaldhar-h-vyas/perl/ch-1.pl b/challenge-307/jaldhar-h-vyas/perl/ch-1.pl new file mode 100755 index 0000000000..463fd60cf7 --- /dev/null +++ b/challenge-307/jaldhar-h-vyas/perl/ch-1.pl @@ -0,0 +1,15 @@ +#!/usr/bin/perl +use v5.38; + +my @ints = @ARGV; + +my @sorted = sort { $a <=> $b } @ints; +my @diffs; + +for my $i (keys @ints) { + if ($ints[$i] != $sorted[$i]) { + push @diffs, $i; + } +} + +say q{(}, (join q{, }, @diffs), q{)}; diff --git a/challenge-307/jaldhar-h-vyas/perl/ch-2.pl b/challenge-307/jaldhar-h-vyas/perl/ch-2.pl new file mode 100755 index 0000000000..75810c4e15 --- /dev/null +++ b/challenge-307/jaldhar-h-vyas/perl/ch-2.pl @@ -0,0 +1,12 @@ +#!/usr/bin/perl +use v5.38; + +my @words = @ARGV; + +my %anagrams; +foreach my $word (@words) { + my $sorted = join q{}, sort split //, $word; + $anagrams{$sorted}++; +} + +say scalar %anagrams; diff --git a/challenge-307/jaldhar-h-vyas/raku/ch-1.raku b/challenge-307/jaldhar-h-vyas/raku/ch-1.raku new file mode 100755 index 0000000000..e379469aa3 --- /dev/null +++ b/challenge-307/jaldhar-h-vyas/raku/ch-1.raku @@ -0,0 +1,16 @@ +#!/usr/bin/raku + +sub MAIN( + *@ints +) { + my @sorted = @ints.sort({ $^a <=> $^b }); + my @diffs; + + for @ints.keys -> $i { + if @ints[$i] != @sorted[$i] { + @diffs.push($i); + } + } + + say q{(}, @diffs.join(q{, }), q{)}; +} diff --git a/challenge-307/jaldhar-h-vyas/raku/ch-2.sh b/challenge-307/jaldhar-h-vyas/raku/ch-2.sh new file mode 100755 index 0000000000..6be4df2fd5 --- /dev/null +++ b/challenge-307/jaldhar-h-vyas/raku/ch-2.sh @@ -0,0 +1,3 @@ +#!/bin/sh + +raku -e '@*ARGS.map({$_.comb.sort.join}).unique.elems.say' "$@" diff --git a/challenge-307/matthias-muth/README.md b/challenge-307/matthias-muth/README.md index dd189e7059..a7897b1e35 100644 --- a/challenge-307/matthias-muth/README.md +++ b/challenge-307/matthias-muth/README.md @@ -1,6 +1,155 @@ -**Challenge 305 solutions in Perl by Matthias Muth** +# Don't Get Trapped in the Anagram Order! -Sorry, no blog post this time. -But the solutions are in the [`perl`](perl) subdirectory... +**Challenge 307 solutions in Perl by Matthias Muth** -**Thank you for the challenge!** +## Task 1: Check Order + +> You are given an array of integers, @ints.<br/> +> Write a script to re-arrange the given array in an increasing order and return the indices where it differs from the original array. +> +> **Example 1** +> +> ```text +> Input: @ints = (5, 2, 4, 3, 1) +> Output: (0, 2, 3, 4) +> Before: (5, 2, 4, 3, 1) +> After : (1, 2, 3, 4, 5) +> Difference at indices: (0, 2, 3, 4) +> ``` +> **Example 2** +> +> ```text +> Input: @ints = (1, 2, 1, 1, 3) +> Output: (1, 3) +> Before: (1, 2, 1, 1, 3) +> After : (1, 1, 1, 2, 3) +> Difference at indices: (1, 3) +> ``` +> **Example 3** +> +> ```text +> Input: @ints = (3, 1, 3, 2, 3) +> Output: (0, 1, 3) +> Before: (3, 1, 3, 2, 3) +> After : (1, 2, 3, 3, 3) +> Difference at indices: (0, 1, 3) +> ``` + +For this task, I think it is easiest to follow the task description very closely.<br/> +First, *'re-arrange the given array in an increasing order'*. Let's use `sort` with the well-known code block to sort the entries numerically: + +```perl + my @sorted = sort { $a <=> $b } @ints; +``` + +Then, *'return the indices where it differs from the original array'*.<br/>For this, `grep` is the method of choice, walking through the arrays one by one.<br>I am getting into the habit to write `keys @array` instead of `0..$#array`. This language construct (`keys` of arrays) has been available since Perl version 5.12, published in 2010), so I actually feel like I'm quite late adapting that, but hey! + +`grep` returns the indexes that passed the test, which is exactly what we need to return as our function result: + +```perl + return grep $sorted[$_] != $ints[$_], keys @sorted; +``` + +Which completes my short solution: + +```perl +use v5.36; + +sub check_order( @ints ) { + my @sorted = sort { $a <=> $b } @ints; + return grep $sorted[$_] != $ints[$_], keys @sorted; +} +``` + +Nice once again to see how Perl makes things easy. + + +## Task 2: Find Anagrams + +> You are given a list of words, @words.<br/> +> Write a script to find any two consecutive words and if they are anagrams, drop the first word and keep the second. You continue this until there is no more anagrams in the given list and return the count of final list. +> +> **Example 1** +> +> ```text +> Input: @words = ("acca", "dog", "god", "perl", "repl") +> Output: 3 +> Step 1: "dog" and "god" are anagrams, so dropping "dog" and keeping "god" => ("acca", "god", "perl", "repl") +> Step 2: "perl" and "repl" are anagrams, so dropping "perl" and keeping "repl" => ("acca", "god", "repl") +> ``` +> **Example 2** +> +> ```text +> Input: @words = ("abba", "baba", "aabb", "ab", "ab") +> Output: 2 +> Step 1: "abba" and "baba" are anagrams, so dropping "abba" and keeping "baba" => ("baba", "aabb", "ab", "ab") +> Step 2: "baba" and "aabb" are anagrams, so dropping "baba" and keeping "aabb" => ("aabb", "ab", "ab") +> Step 3: "ab" and "ab" are anagrams, so dropping "ab" and keeping "ab" => ("aabb", "ab") +> ``` + +**Normalize** + +How do I compare whether two words are anagrams? That's not too difficult. +We 'normalize' the words: + +- Split both words into their characters, +- sort the characters into the same order<br/> + (it actually doesn't matter which order it used, but it must be the same + for both sets of characters), +- recombine the sorted letters into strings. + +If the normalized strings are equal, the two words are anagrams. + +Let's create the normalizations for all word in the input array: + +```perl + my @normalized = map join( "", sort split "" ), @words; +``` + +Now we can walk through the `@normalized` array instead of the original words +to check for neighboring anagrams. + +**Watch out! There's a trap!!** + +It is tempting to just count the number of unique normalized words to get the result.<br/> +BUT! +What happens if two anagrams are *not* next to each other?<br/> +They both will make it into the result list if we follow the instructions. +But if we use `uniq`, they will only be counted once. + +We *cannot* simply use `uniq`, for that reason.<br/> +Even if it would work without a problem for the examples given. + +**Do the counting, not the skipping** + +For any sequence of one ore more anagrams, +the instructions say to only keep the last one, and then count in the end. +But as we *only* need the count, +it is not relevant whether we count the first or the last word of a sequence. +So let's simply count every normalized word that is different from the one before. + +We can use a `grep` call for that, +which returns the number of times the condition was true in scalar context. +That's exactly what we need. + +We have to be careful because the word at index 0 has no predecessor to compare to. +So we start the `grep` at index 1, and as the first word always starts a sequence, +we add 1 for that to the count returned by `grep`. +Of course we shouldn't do that when the word list is completely empty +(then there is no 'first word'). +So we add a check for that special case right at the beginning. + +So here we are: + +```perl +sub find_anagrams( @words ) { + @words > 0 or return 0; + my @normalized = map join( "", sort split "", $_ ), @words; + return 1 + scalar grep( $normalized[ $_ - 1 ] ne $normalized[$_], 1..$#normalized ); +} +``` +The only thing that I don't like about my solution is that that array name ('`@normalized`') +is a bit too long.<br/> +But I always prefer 'speaking names'! + +#### **Thank you for the challenge!** diff --git a/challenge-307/matthias-muth/blog.txt b/challenge-307/matthias-muth/blog.txt new file mode 100644 index 0000000000..0b12aa85ee --- /dev/null +++ b/challenge-307/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-307/challenge-307/matthias-muth#readme diff --git a/challenge-307/matthias-muth/perl/ch-1.pl b/challenge-307/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..d62bd04930 --- /dev/null +++ b/challenge-307/matthias-muth/perl/ch-1.pl @@ -0,0 +1,28 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 307 Task 1: Check Order +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +sub check_order( @ints ) { + my @sorted = sort { $a <=> $b } @ints; + return grep $sorted[$_] != $ints[$_], keys @sorted; +} + +use Test2::V0 qw( -no_srand ); +use Data::Dump qw( pp ); + +is [ check_order( 5, 2, 4, 3, 1 ) ], [ 0, 2, 3, 4 ], + 'Example 1: check_order( 5, 2, 4, 3, 1 ) == (0, 2, 3, 4)'; +is [ check_order( 1, 2, 1, 1, 3 ) ], [ 1, 3 ], + 'Example 2: check_order( 1, 2, 1, 1, 3 ) == (1, 3)'; +is [ check_order( 3, 1, 3, 2, 3 ) ], [ 0, 1, 3 ], + 'Example 3: check_order( 3, 1, 3, 2, 3 ) == (0, 1, 3)'; + +done_testing; diff --git a/challenge-307/matthias-muth/perl/ch-2.pl b/challenge-307/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..678de7069d --- /dev/null +++ b/challenge-307/matthias-muth/perl/ch-2.pl @@ -0,0 +1,36 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 307 Task 2: Find Anagrams +# +# Perl solution by Matthias Muth. +# + +use v5.36; + + +# 'Normalize' words by putting their letters in a defined order, +# so that words that are anagrams of each other become equal. +# (I use ascending sort because it's the default, but it doesn't +# really matter). +# We don't need to actually produce the list of kept words, we only +# need the count. + +sub find_anagrams( @words ) { + @words > 0 or return 0; + my @normalized = map join( "", sort split "", $_ ), @words; + return 1 + scalar grep( $normalized[ $_ - 1 ] ne $normalized[$_], + 1..$#normalized ); +} + +use Test2::V0 qw( -no_srand ); +use Data::Dump qw( pp ); + +is find_anagrams( "acca", "dog", "god", "perl", "repl" ), 3, + 'Example 1: find_anagrams( "acca", "dog", "god", "perl", "repl" ) == 3'; +is find_anagrams( "abba", "baba", "aabb", "ab", "ab" ), 2, + 'Example 2: find_anagrams( "abba", "baba", "aabb", "ab", "ab" ) == 2'; + +done_testing; diff --git a/challenge-307/sgreen/README.md b/challenge-307/sgreen/README.md index c4195b4620..75cb943e9b 100644 --- a/challenge-307/sgreen/README.md +++ b/challenge-307/sgreen/README.md @@ -1,3 +1,3 @@ -# The Weekly Challenge 306 +# The Weekly Challenge 307 -Blog: [The last odd](https://dev.to/simongreennet/the-last-odd-kib) +Blog: [Sorting and counting](https://dev.to/simongreennet/weekly-challenge-sorting-and-counting-2on) diff --git a/challenge-307/sgreen/blog.txt b/challenge-307/sgreen/blog.txt new file mode 100644 index 0000000000..7521b12b17 --- /dev/null +++ b/challenge-307/sgreen/blog.txt @@ -0,0 +1 @@ +https://dev.to/simongreennet/weekly-challenge-sorting-and-counting-2on
\ No newline at end of file diff --git a/challenge-307/sgreen/perl/ch-1.pl b/challenge-307/sgreen/perl/ch-1.pl new file mode 100755 index 0000000000..45cf2e8a67 --- /dev/null +++ b/challenge-307/sgreen/perl/ch-1.pl @@ -0,0 +1,25 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature 'say'; +use experimental 'signatures'; + +sub main (@ints) { + # Sort the lists numerically + my @sorted_ints = sort { $a <=> $b } @ints; + my @differences = (); + + foreach my $idx ( 0 .. $#ints ) { + if ( $ints[$idx] != $sorted_ints[$idx] ) { + # If the value in the original list and sorted list at this + # position is different, add it to the differences list. + push @differences, $idx; + } + } + + # Return the list + say '(', join( ', ', @differences ), ')'; +} + +main(@ARGV); diff --git a/challenge-307/sgreen/perl/ch-2.pl b/challenge-307/sgreen/perl/ch-2.pl new file mode 100755 index 0000000000..338581543d --- /dev/null +++ b/challenge-307/sgreen/perl/ch-2.pl @@ -0,0 +1,28 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature 'say'; +use experimental 'signatures'; + +sub sort_word($word) { + return join( '', sort split( //, lc($word) ) ); +} + +sub main (@words) { + # Sort each word alphabetically, ignoring case + my @sorted_words = map { sort_word($_) } @words; + my $anagrams = 0; + + foreach my $idx ( 1 .. $#words ) { + if ( $sorted_words[ $idx - 1 ] eq $sorted_words[$idx] ) { + # The word at this position is an anagram of the previous word + $anagrams++; + } + } + + # Return the number of words that aren't an anagram + say scalar(@words) - $anagrams; +} + +main(@ARGV); diff --git a/challenge-307/sgreen/python/ch-1.py b/challenge-307/sgreen/python/ch-1.py new file mode 100755 index 0000000000..cc227d0d95 --- /dev/null +++ b/challenge-307/sgreen/python/ch-1.py @@ -0,0 +1,29 @@ +#!/usr/bin/env python3 + +import sys + + +def check_order(ints: list) -> str: + # Sort the lists numerically + sorted_ints = sorted(ints) + differences = [] + + for idx in range(len(ints)): + if ints[idx] != sorted_ints[idx]: + # If the value in the original list and sorted list at this + # position is different, add it to the differences list. + differences.append(idx) + + # Return the list + return differences + + +def main(): + # Convert input into integers + array = [int(n) for n in sys.argv[1:]] + result = check_order(array) + print(result) + + +if __name__ == '__main__': + main() diff --git a/challenge-307/sgreen/python/ch-2.py b/challenge-307/sgreen/python/ch-2.py new file mode 100755 index 0000000000..14f80dc96e --- /dev/null +++ b/challenge-307/sgreen/python/ch-2.py @@ -0,0 +1,26 @@ +#!/usr/bin/env python3 + +import sys + + +def find_anagrams(words: list) -> list: + # Sort each word alphabetically, ignoring case + sorted_words = [''.join(sorted(word.lower())) for word in words] + anagrams = 0 + + for idx in range(1, len(words)): + if sorted_words[idx-1] == sorted_words[idx]: + # The word at this position is an anagram of the previous word + anagrams += 1 + + # Return the number of words that aren't an anagram + return len(words) - anagrams + + +def main(): + result = find_anagrams(sys.argv[1:]) + print(result) + + +if __name__ == '__main__': + main() diff --git a/challenge-307/sgreen/python/test.py b/challenge-307/sgreen/python/test.py new file mode 100755 index 0000000000..965631aecf --- /dev/null +++ b/challenge-307/sgreen/python/test.py @@ -0,0 +1,25 @@ +#!/usr/bin/env python3 + +import unittest +ch_1 = __import__('ch-1') +ch_2 = __import__('ch-2') + + +class TestClass(unittest.TestCase): + def test_ch_1(self): + self.assertEqual(ch_1.check_order([5, 2, 4, 3, 1]), [0, 2, 3, 4]) + self.assertEqual(ch_1.check_order([1, 2, 1, 1, 3]), [1, 3]) + self.assertEqual(ch_1.check_order([3, 1, 3, 2, 3]), [0, 1, 3]) + + def test_ch_2(self): + words_1 = ["acca", "dog", "god", "perl", "repl"] + words_2 = ["abba", "baba", "aabb", "ab", "ab"] + words_3 = ["abba", "baba", "ab", "ab", "aabb"] + + self.assertEqual(ch_2.find_anagrams(words_1), 3) + self.assertEqual(ch_2.find_anagrams(words_2), 2) + self.assertEqual(ch_2.find_anagrams(words_3), 3) + + +if __name__ == '__main__': + unittest.main() diff --git a/challenge-307/steven-wilson/perl/ch-1.pl b/challenge-307/steven-wilson/perl/ch-1.pl index 9c50d392db..452ffb9c67 100644 --- a/challenge-307/steven-wilson/perl/ch-1.pl +++ b/challenge-307/steven-wilson/perl/ch-1.pl @@ -1,12 +1,11 @@ #!/usr/bin/env perl -use strict; use v5.35; use Test2::Bundle::More; sub checkOrder { my @ints = @_; - my @sorted_ints = sort @ints; + my @sorted_ints = sort { $a <=> $b } @ints; return grep { $ints[$_] != $sorted_ints[$_] } 0..scalar @ints - 1; } diff --git a/challenge-307/steven-wilson/perl/ch-2.pl b/challenge-307/steven-wilson/perl/ch-2.pl index 6d488525e1..68a4819a5c 100644 --- a/challenge-307/steven-wilson/perl/ch-2.pl +++ b/challenge-307/steven-wilson/perl/ch-2.pl @@ -1,8 +1,9 @@ #!/usr/bin/env perl -use strict; use v5.35; use Test2::Bundle::More; +use Memoize; +memoize('sortString'); sub findAnagrams { my @words = @_; diff --git a/challenge-307/wambash/julia/ch-1.jl b/challenge-307/wambash/julia/ch-1.jl new file mode 100644 index 0000000000..c53f7440a0 --- /dev/null +++ b/challenge-307/wambash/julia/ch-1.jl @@ -0,0 +1,14 @@ +check_order(ints) = keys(ints)[ints.!==sort(ints)] + + +using Test + +function TEST() + @testset "Check Order" begin + @test check_order([5, 2, 4, 3, 1]) == [1,3,4,5] + @test check_order([1, 2, 1, 1, 3]) == [2,4] + @test check_order([3, 1, 3, 2, 3]) == [1,2,4] + end +end + +TEST() diff --git a/challenge-307/wambash/julia/ch-2.jl b/challenge-307/wambash/julia/ch-2.jl new file mode 100644 index 0000000000..251ebdf7f9 --- /dev/null +++ b/challenge-307/wambash/julia/ch-2.jl @@ -0,0 +1,13 @@ +using Lazy +find_anagrams(words) = @>> words map(frequencies) unique length + +using Test + +function TEST() + @testset "Find Anagrams" begin + @test find_anagrams(["acca", "dog", "god", "perl", "repl"]) == 3 + @test find_anagrams(["abba", "baba", "aabb", "ab", "ab"]) == 2 + end +end + +TEST() diff --git a/challenge-307/wambash/raku/ch-1.raku b/challenge-307/wambash/raku/ch-1.raku new file mode 100644 index 0000000000..31b784d106 --- /dev/null +++ b/challenge-307/wambash/raku/ch-1.raku @@ -0,0 +1,18 @@ +#!/usr/bin/env raku + +sub check-order (+@ints) { + @ints Z== @ints.sort + andthen .grep: *.not, :k +} + +multi MAIN (Bool :test($)!) { + use Test; + is check-order(5,2,4,3,1),(0,2,3,4); + is check-order(1, 2, 1, 1, 3), (1,3); + is check-order(3, 1, 3, 2, 3), (0,1,3); + done-testing; +} + +multi MAIN (+ints) { + put check-order ints +} diff --git a/challenge-307/wambash/raku/ch-2.raku b/challenge-307/wambash/raku/ch-2.raku new file mode 100644 index 0000000000..1184ed5b32 --- /dev/null +++ b/challenge-307/wambash/raku/ch-2.raku @@ -0,0 +1,19 @@ +#!/usr/bin/env raku + +sub find-anagrams (+words) { + words + andthen .map: *.comb.Bag + andthen .unique + andthen .elems +} + +multi MAIN (Bool :test($)!) { + use Test; + is find-anagrams(<acca dog god perl repl>), 3; + is find-anagrams(<abba baba aabb ab ab>), 2; + done-testing; +} + +multi MAIN (+words) { + say find-anagrams words +} |