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

11 files changed, 285 insertions, 201 deletions

diff --git a/challenge-276/0rir/raku/ch-1.raku b/challenge-276/0rir/raku/ch-1.raku
new file mode 100644
index 0000000000..527ac11e6f
--- /dev/null
+++ b/challenge-276/0rir/raku/ch-1.raku
@@ -0,0 +1,57 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ «␤ » ∴
+use v6.d;
+use Test;
+
+=begin comment
+276-1  Complete Day            Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @hours.  Write a script to return
+the number of pairs that forms a complete day.  A complete day is defined
+as a time duration that is an exact multiple of 24 hours.
+
+Example 1
+Input: @hours = (12, 12, 30, 24, 24)
+Output: 2
+
+Pair 1: (12, 12)
+Pair 2: (24, 24)
+Example 2
+Input: @hours = (72, 48, 24, 5)
+Output: 3
+
+Pair 1: (72, 48)
+Pair 2: (72, 24)
+Pair 3: (48, 24)
+Example 3
+Input: @hours = (12, 18, 24)
+Output: 0
+=end comment
+
+my @Test =
+   # exp        in
+    Int,        (),
+    0,          (1,),
+    2,          (12, 12, 24, 24,         30),
+    3,          (72, 48, 24,             5),
+    0,          (                        72, 5, 3),
+    0,          (                        12, 24, 18),
+    6,          (12, 12, 12, 12,         24, 7,4,1),
+    9,          (2, 2, 2, 2, 0, 24, 24,  7,4,1),
+;
+plan @Test ÷ 2;
+
+multi task( @a where * !~~ Empty --> Int) {
+        @a.classify( * % 24 ).values.map( { $_.elems × $_.end div 2}).sum;
+}
+multi task( @a --> Int) { Int }
+
+for @Test -> $exp, @in {
+    is task(@in), $exp, ($exp // "Int") ~ " <- @in.raku()";
+}
+
+done-testing;
+
+my @hour = (12, 12, 12, 12, 36, 60, 0, 24, 24, 48, 7, 4, 1);
+say "\nInput: \@hour = @hour[]\nOutput: &task(@hour)";
+
diff --git a/challenge-276/0rir/raku/ch-2.raku b/challenge-276/0rir/raku/ch-2.raku
new file mode 100644
index 0000000000..1d3204971c
--- /dev/null
+++ b/challenge-276/0rir/raku/ch-2.raku
@@ -0,0 +1,63 @@
+#!/usr/bin/env raku
+# :vim ft=raku sw=4 expandtab  # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ «␤ » ∴
+use v6.d;
+use Test;
+
+=begin comment
+276-2   Maximum Frequency       Submitted by: Mohammad Sajid Anwar
+
+You are given an array of positive integers, @ints.  Write a script to
+return the total number of elements in the given array which have the
+highest frequency.
+
+Example 1
+Input: @ints = (1, 2, 2, 4, 1, 5)
+Ouput: 4
+
+The maximum frequency is 2.
+The elements 1 and 2 has the maximum frequency.
+Example 2
+Input: @ints = (1, 2, 3, 4, 5)
+Ouput: 5
+
+The maximum frequency is 1.
+The elements 1, 2, 3, 4 and 5 has the maximum frequency.
+
+=end comment
+
+my @Test =
+    # exp   in
+    Int,    List,
+    Int,    Array,
+#   Int,    Seq,
+    3,  (1…3),
+    0,  (),
+    0,  [],
+    4,  (1, 2, 2, 4, 1, 5),
+    5,  (1, 2, 3, 4, 5),
+    10,  (1, 2, 3, 4, 5, 6, 2, 3, 4, 5, 6),
+;
+
+plan @Test ÷ 2;
+
+constant \MAX-RET-LIST = $*RAKU.compiler.version.Str ge "2023.08";
+
+#multi task( @a where { ! .defined and .isa( Seq) } ) { Int }
+multi task( @a where { ! .defined and .isa( List)} ) { Int }
+multi task( @a) {
+
+    if not MAX-RET-LIST { return sum @a.Bag.max( :v); }
+
+    my @v =@a.Bag.values».Int;
+    return sum grep ( * == @v.max ), @v;
+}
+
+for @Test -> $exp, @in {
+    is task(@in), $exp, !$exp.defined ?? '(Int)' !! " $exp  <- @in.raku()";
+}
+
+done-testing;
+
+my @int = 1, 2, 3, 4, 2, 3, 4, 3, 4, 3, 4, 5;
+say "\nInput: @ints = @int.raku()\nOutput: ", task( @int);
+
diff --git a/challenge-276/jaldhar-h-vyas/blog.txt b/challenge-276/jaldhar-h-vyas/blog.txt
new file mode 100644
index 0000000000..816edc923d
--- /dev/null
+++ b/challenge-276/jaldhar-h-vyas/blog.txt
@@ -0,0 +1 @@
+https://www.braincells.com/perl/2024/07/perl_weekly_challenge_week_276.html
diff --git a/challenge-276/jaldhar-h-vyas/perl/ch-1.pl b/challenge-276/jaldhar-h-vyas/perl/ch-1.pl
new file mode 100755
index 0000000000..1cfe9a0de9
--- /dev/null
+++ b/challenge-276/jaldhar-h-vyas/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+use v5.38;
+
+sub combinations($listref, $length) {
+    my @list = @{$listref};
+
+    if ($length <= 1) {
+        return map [$_], @list;
+    }
+
+    my @combos;
+
+    for (my $i = 0; $i + $length <= scalar @list; $i++) {
+        my $val  = $list[$i];
+        my @rest = @list[$i + 1 .. $#list];
+        for my $c (combinations(\@rest, $length - 1)) {
+            push @combos, [$val, @{$c}] ;
+        }
+    }
+
+    return @combos;
+}
+
+sub sum {
+    my $total;
+    for my $n (@_) {
+        $total += $n;
+    }
+
+    return $total;
+}
+
+my @hours = @ARGV;
+
+ say scalar grep { sum(@{$_}) % 24 == 0 } combinations(\@hours, 2);
diff --git a/challenge-276/jaldhar-h-vyas/perl/ch-2.pl b/challenge-276/jaldhar-h-vyas/perl/ch-2.pl
new file mode 100755
index 0000000000..d589b05412
--- /dev/null
+++ b/challenge-276/jaldhar-h-vyas/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+use v5.38;
+
+my @ints = @ARGV;
+
+my %freq;
+
+for my $int (@ints) {
+    $freq{$int}++;
+}
+
+my $max = 0;
+my $output = 0;
+
+while (my ($k, $v) = each %freq) {
+    if ($v > $max) {
+        $max = $v;
+        $output = 1;
+    } elsif ($v == $max) {
+        $output++;
+    }
+}
+
+say $output;
diff --git a/challenge-276/jaldhar-h-vyas/raku/ch-1.sh b/challenge-276/jaldhar-h-vyas/raku/ch-1.sh
new file mode 100755
index 0000000000..7648beaba0
--- /dev/null
+++ b/challenge-276/jaldhar-h-vyas/raku/ch-1.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+raku -e '@*ARGS.combinations(2).grep({$_.sum%%24}).elems.say' "$@"
diff --git a/challenge-276/jaldhar-h-vyas/raku/ch-2.raku b/challenge-276/jaldhar-h-vyas/raku/ch-2.raku
new file mode 100755
index 0000000000..f92a1efcb3
--- /dev/null
+++ b/challenge-276/jaldhar-h-vyas/raku/ch-2.raku
@@ -0,0 +1,25 @@
+#!/usr/bin/raku
+
+sub MAIN(
+    *@ints
+) {
+    my %freq;
+
+    for @ints -> $int {
+        %freq{$int}++;
+    }
+
+    my $max = 0;
+    my $output = 0;
+
+    for %freq.kv -> $k, $v {
+        if $v > $max {
+            $max = $v;
+            $output = 1;
+        } elsif $v == $max {
+            $output++;
+        }
+    }
+
+    say $output;
+}
\ No newline at end of file
diff --git a/challenge-276/matthias-muth/README.md b/challenge-276/matthias-muth/README.md
index 551d37babf..10e53d1eb9 100644
--- a/challenge-276/matthias-muth/README.md
+++ b/challenge-276/matthias-muth/README.md
@@ -1,202 +1,5 @@
-# Broken Keys and Test Driven Understanding (tm)
+**Challenge 276 solutions in Perl by Matthias Muth**
+<br/>
+(no blog post this time...)
 
-**Challenge 275 solutions in Perl by Matthias Muth**
-
-## Task 1: Broken Keys
-
-> You are given a sentence, $sentence and list of broken keys @keys.<br/>
-> Write a script to find out how many words can be typed fully.<br/>
-> <br/>
-> Example 1<br/>
-> Input: \$sentence = "Perl Weekly Challenge", @keys = ('l', 'a')<br/>
-> Output: 0<br/>
-> <br/>
-> Example 2<br/>
-> Input: \$sentence = "Perl and Raku", @keys = ('a')<br/>
-> Output: 1<br/>
-> Only Perl since the other word two words contain 'a' and can't be typed fully.<br/>
-> <br/>
-> Example 3<br/>
-> Input: \$sentence = "Well done Team PWC", @keys = ('l', 'o')<br/>
-> Output: 2<br/>
-> <br/>
-> Example 4<br/>
-> Input: \$sentence = "The joys of polyglottism", @keys = ('T')<br/>
-> Output: 2<br/>
-
-Regular expressions make this is an easy one.
-
-First thing, we have to separate the words in the sentence to deal with them one by one.<br/>
-No problem, just a standard call of `split " ", $sentence`.
-
-To find out whether a word contains a 'broken' key
-we can put those keys into a 'bracketed character class',
-and then check the word against that.
-For the second example above, we would try a match like this:
-
-```perl[]  
-    ! /[lo]/i
-```
-
-The `//i` modifier makes sure that lower or upper case doesn't matter
-(needed in the third example).  
-
-So then let's combine the broken keys into a string that we can use in the regular expressions,
-and then use it for counting the matches.
-For the counting, `grep` in scalar context does the job.
-
-```perl
-sub broken_keys( $sentence, $keys ) {
-    my $keys_as_string = join( "", $keys->@* );
-    return scalar grep ! /[$keys_as_string]/i, split " ", $sentence;
-}
-```
-
-Et voilà!
-
-## Task 2: Replace Digits
-
-> You are given an alphanumeric string, \$str, where each character is either a letter or a digit.<br/>
-> Write a script to replace each digit in the given string with the value of the previous letter plus (digit) places.<br/>
-> <br/>
-> Example 1<br/>
-> Input: \$str = 'a1c1e1'<br/>
-> Ouput: 'abcdef'<br/>
-> shift('a', 1) => 'b'<br/>
-> shift('c', 1) => 'd'<br/>
-> shift('e', 1) => 'f'<br/>
-> <br/>
-> Example 2<br/>
-> Input: \$str = 'a1b2c3d4'<br/>
-> Output: 'abbdcfdh'<br/>
-> shift('a', 1) => 'b'<br/>
-> shift('b', 2) => 'd'<br/>
-> shift('c', 3) => 'f'<br/>
-> shift('d', 4) => 'h'<br/>
-> <br/>
-> Example 3<br/>
-> Input: \$str = 'b2b'<br/>
-> Output: 'bdb'<br/>
-> <br/>
-> Example 4<br/>
-> Input: \$str = 'a16z'<br/>
-> Output: 'abgz'<br/>
-
-This task is a bit more tricky. At least for me.<br/>
-Not tricky for the programming,
-but it took me an 'iterative approach' to understand the details of the specification.
-As simple (and complete and correct!) as it seems, I misunderstood it as being *too* simple.
-
-So this is my 'test driven understanding' approach.  
-
-##### First try
-
-Maybe my first try was too naive.
-Repetitively match a letter and a digit,
-and then replace the digit by the properly shifted letter directly in the substitution.<br/>
-That means a `s///g` global substitution, and I added these additional 'tricks':
-
-* using the `[:alpha:]` POSIX character class to capture an upper or lower case letter,
-* using an `e` modifier to call a code block to determine the replacement string with the shifted letter,
-* using an `r` modifier to return the modified result instead of changing the input string,
-* using an `x` modifier for adding some spaces to improve readability: 
-
-```perl
-sub replace_digits_1( $str ) {
-    return $str =~ s{ ([[:alpha:]]) (\d) }{ $1 . chr( ord( $1 ) + $2 ) }egr;
-}
-```
-
-Great, that works well! ...
-Except for the fourth example!<br/>
-There we have two digits in a row (`'a16'`),
-and we didn't get the second digit.
-We need kind of an 'overlapping' operation.
-
-##### Second try.
-
-So next, the second approach,
-where I use an explicit loop, always restarting at the beginning of the string,
-and modifying the string itself:
-
-```perl
-sub replace_digits_2( $str ) {
-    while ( $str =~
-        s{ ([[:alpha:]]) (\d) }{ $1 . chr( ord( $1 ) + $2 ) }xe )
-    {
-        # Everything is in the loop condiiton.
-    }
-    return $str;
-}
-```
-
-Great, that's better!
-We catch the fourth example's second digit now, after replacing the first one.
-
-But the resulting letter for the second digit is off by one!
-
-My misunderstanding, again. Actually, we should not replace
-```perl
-    'a16' => ('a' shifted by 1 ) => 'ab6'
-    'b6'  => ('b' shifted by 6 ) => 'bh'
-```
-but, in one operation:
-```perl
-    'a16' => ('a' shifted by 1 ) => 'ab6'
-             ('a' shifted by 6 ) => 'abg'
-```
-
-##### So, third try:
-
-Same loop, but replacing sequences of digits from *right to left* instead of left to right.
-I capture the digits in between, and leave them for the next iterations,
-replacing the rightmost digit first:
-
-```perl
-sub replace_digits_3( $str ) {
-    while ( $str =~
-        s{ ([[:alpha:]]) (\d*) (\d) }{ "$1$2" . chr( ord( $1 ) + $3 ) }xe )
-    {
-        # Everything is in the loop condiiton.
-    }
-    return $str;
-}
-```
-
-Finally it works!
-
-Interesting that the bigger difficulty for me this time was not the programming itself,
-but to capture the task specification correctly.
-
-How good it is to have and use tests!
-
-##### 'Refacturing the understanding'
-
-I now understood that the task actually is not about replacing 'a letter and a digit',
-but more replacing 'a letter and a sequence of digits'.
-
-This lead me to yet another approach:<br/>
-Once the letter and *all following digits* are captured
-(using a `(\d+)` pattern), we build the replacement from
-
-- the letter itself,
-- the same letter, shifted by every digit's value.
-
-*Now* that sounds logical, of course! :-)
-
-I can turn back to the `s///g` style global substitution and avoid the `while` loop.
-Using `split` to split up the sequence of digits, and `map` to loop over the single digits.
-
-```perl
-sub replace_digits_4( $str ) {
-    return $str =~ s{ ([[:alpha:]]) (\d+) }{
-            join "", $1, map chr( ord( $1 ) + $_ ), split "", $2;
-        }xegr;
-}
-```
-
-Probably this is my solution that best reflects the task's specification.
-
-What a funny experience this challenge was!
-
-#### **Thank you for the challenge!**
+**Thank you for the challenge!**
diff --git a/challenge-276/matthias-muth/blog.txt b/challenge-276/matthias-muth/blog.txt
new file mode 100644
index 0000000000..ca23b47aad
--- /dev/null
+++ b/challenge-276/matthias-muth/blog.txt
@@ -0,0 +1 @@
+https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-276/challenge-276/matthias-muth#readme
diff --git a/challenge-276/matthias-muth/perl/ch-1.pl b/challenge-276/matthias-muth/perl/ch-1.pl
new file mode 100755
index 0000000000..077393ac37
--- /dev/null
+++ b/challenge-276/matthias-muth/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 276 Task 1: Complete Day
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+no warnings "experimental::for_list";
+
+sub complete_day_1( @hours ) {
+    my $hits = 0;
+    for my $i ( 0..$#hours ) {
+        for my $j ( $i + 1 .. $#hours ) {
+            ++$hits
+                if ( $hours[$i] + $hours[$j] ) % 24 == 0;
+        }
+    }
+    return $hits;
+}
+
+use Math::Combinatorics;
+use List::Util qw( sum );
+
+sub complete_day_2( @hours ) {
+    return scalar grep(
+        sum( $_->@* ) % 24 == 0,
+        combine( 2, @hours )
+    );
+}
+
+*complete_day = \&complete_day_2;
+
+use Test2::V0 qw( -no_srand );
+is complete_day( 12, 12, 30, 24, 24 ), 2,
+    'Example 1: complete_day( 12, 12, 30, 24, 24 ) == 2';
+is complete_day( 72, 48, 24, 5 ), 3,
+    'Example 2: complete_day( 72, 48, 24, 5 ) == 3';
+is complete_day( 12, 18, 24 ), 0,
+    'Example 3: complete_day( 12, 18, 24 ) == 0';
+done_testing;
diff --git a/challenge-276/matthias-muth/perl/ch-2.pl b/challenge-276/matthias-muth/perl/ch-2.pl
new file mode 100755
index 0000000000..cca72b9dd0
--- /dev/null
+++ b/challenge-276/matthias-muth/perl/ch-2.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+#
+#       The Weekly Challenge - Perl & Raku
+#       (https://theweeklychallenge.org)
+#
+#       Challenge 276 Task 2: Maximum Frequency
+#
+#       Perl solution by Matthias Muth.
+#
+
+use v5.36;
+
+use List::Util qw( max );
+
+sub maximum_frequency( @ints ) {
+    my %freq;
+    ++$freq{$_}
+        for @ints;
+    my $max_freq = max( values %freq );
+    return scalar grep $freq{$_} == $max_freq, @ints;
+}
+
+use Test2::V0 qw( -no_srand );
+is maximum_frequency( 1, 2, 2, 4, 1, 5 ), 4,
+    'Example 1: maximum_frequency( 1, 2, 2, 4, 1, 5 ) == 4';
+is maximum_frequency( 1, 2, 3, 4, 5 ), 5,
+    'Example 2: maximum_frequency( 1, 2, 3, 4, 5 ) == 5';
+done_testing;