diff options
28 files changed, 615 insertions, 126 deletions
diff --git a/challenge-262/2colours/groovy/ch-1.groovy b/challenge-262/2colours/groovy/ch-1.groovy new file mode 100644 index 0000000000..bd1b79407a --- /dev/null +++ b/challenge-262/2colours/groovy/ch-1.groovy @@ -0,0 +1,6 @@ +import groovy.json.JsonSlurper + +final REPLACEMENTS = ['()', '[]'] +def jsonSlurper = new JsonSlurper() +def ints = jsonSlurper.parseText(System.console().readLine('@ints = ').tr(*REPLACEMENTS)) +println ints.groupBy{ Integer.signum(it) }.findAll{ it.key.abs() > 0 }.values()*.size().max()
\ No newline at end of file diff --git a/challenge-262/2colours/groovy/ch-2.groovy b/challenge-262/2colours/groovy/ch-2.groovy new file mode 100644 index 0000000000..2aa51bd176 --- /dev/null +++ b/challenge-262/2colours/groovy/ch-2.groovy @@ -0,0 +1,12 @@ +import groovy.json.JsonSlurper + +final REPLACEMENTS = ['()', '[]'] +def jsonSlurper = new JsonSlurper() +def ints = jsonSlurper.parseText(System.console().readLine('@ints = ').tr(*REPLACEMENTS)) +def k = System.console().readLine('$k = ').toInteger() +println ints.withIndex().collect { it, index -> + Integer neededFactor = k / (k as BigInteger).gcd(index as BigInteger) + Integer nextValid = Math.ceil((index + 1) / neededFactor) * neededFactor; + def possible_values = ints.drop(nextValid).collate(neededFactor)*.get(0) + possible_values.count(it) +}.sum()
\ No newline at end of file diff --git a/challenge-262/2colours/php/ch-1.php b/challenge-262/2colours/php/ch-1.php new file mode 100644 index 0000000000..c714bc2363 --- /dev/null +++ b/challenge-262/2colours/php/ch-1.php @@ -0,0 +1,7 @@ +<?php + +const PARENS = ['(', ')']; +const SQUARE_BRACKETS = ['[', ']']; +echo '@ints = '; +$ints = json_decode(str_replace(PARENS, SQUARE_BRACKETS, fgets(STDIN))); +echo max(...array_map(fn ($pred) => count(array_filter($ints, $pred)), [fn ($x) => $x > 0, fn ($x) => $x < 0]));
\ No newline at end of file diff --git a/challenge-262/2colours/php/ch-2.php b/challenge-262/2colours/php/ch-2.php new file mode 100644 index 0000000000..bec9137694 --- /dev/null +++ b/challenge-262/2colours/php/ch-2.php @@ -0,0 +1,16 @@ +<?php + +const PARENS = ['(', ')']; +const SQUARE_BRACKETS = ['[', ']']; +echo '@ints = '; +$ints = json_decode(str_replace(PARENS, SQUARE_BRACKETS, fgets(STDIN))); +echo '$k = '; +$k = fgets(STDIN); +$result = 0; +foreach ($ints as $index => $value) { + $needed_factor = intdiv($k, gmp_intval(gmp_gcd($index, $k))); + $next_valid = ceil(($index + 1) / $needed_factor) * $needed_factor; + $values_to_check = array_column(array_chunk(array_slice($ints, $next_valid), $needed_factor), 0); + $result += @array_count_values($values_to_check)[$value]; +} +echo $result;
\ No newline at end of file diff --git a/challenge-262/2colours/raku/ch-1.raku b/challenge-262/2colours/raku/ch-1.raku new file mode 100644 index 0000000000..b574e442b8 --- /dev/null +++ b/challenge-262/2colours/raku/ch-1.raku @@ -0,0 +1,12 @@ +#!/usr/bin/env raku + +my token integer { 0 | '-'? <[1..9]> <[0..9]>* } +subset IntList of Str where /^ '(' <integer>* % ',' ')' $/; + +sub MAIN( + $ints +) { + die 'Please provide valid input for @ints' unless $ints.subst(/\s/, '', :g) ~~ IntList; + my Int() @ints = $<integer>; + @ints.grep(* != 0).classify(*.sign).map(*.value.elems).max.say; +}
\ No newline at end of file diff --git a/challenge-262/2colours/raku/ch-2.raku b/challenge-262/2colours/raku/ch-2.raku new file mode 100644 index 0000000000..95733dc291 --- /dev/null +++ b/challenge-262/2colours/raku/ch-2.raku @@ -0,0 +1,16 @@ +#!/usr/bin/env raku + +my token integer { 0 | '-'? <[1..9]> <[0..9]>* } +subset IntList of Str where /^ '(' <integer>* % ',' ')' $/; + +sub MAIN( + $ints, Int $k +) { + die 'Please provide valid input for @ints' unless $ints.subst(/\s/, '', :g) ~~ IntList; + my Int() @ints = $<integer>; + @ints.kv.map(-> $index, $value { + my $needed-factor = $k div ($k gcd $index); + my $next-valid = ceiling(($index + 1) / $needed-factor) * $needed-factor; + @ints[$next-valid, $next-valid + $needed-factor ...^ @ints.elems].grep($value).elems + }).sum.say; +}
\ No newline at end of file diff --git a/challenge-267/sgreen/README.md b/challenge-267/sgreen/README.md deleted file mode 100644 index 0a7e07635b..0000000000 --- a/challenge-267/sgreen/README.md +++ /dev/null @@ -1,3 +0,0 @@ -# The Weekly Challenge 266 - -Blog: [Uncommon matrix](https://dev.to/simongreennet/uncommon-matrix-4mfh) diff --git a/challenge-268/0rir/raku/ch-1.raku b/challenge-268/0rir/raku/ch-1.raku new file mode 100644 index 0000000000..a3562c84f1 --- /dev/null +++ b/challenge-268/0rir/raku/ch-1.raku @@ -0,0 +1,73 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ « » ∴ +use v6.d; +use Test; + +=begin comment +268-1 Task 1: Magic Number Submitted by: Mohammad Sajid Anwar +You are given two arrays of integers of same size, @x and @y. + +Write a script to find the magic number that when added to each +elements of one of the array gives the second array. Elements order +is not important. + +Example 1 +Input: @x = (3, 7, 5) + @y = (9, 5, 7) +Output: 2 + +The magic number is 2. +@x = (3, 7, 5) + + 2 2 2 +@y = (5, 9, 7) +Example 2 +Input: @x = (1, 2, 1) + @y = (5, 4, 4) +Output: 3 + +The magic number is 3. +@x = (1, 2, 1) + + 3 3 3 +@y = (5, 4, 4) +Example 3 +Input: @x = (2) + @y = (5) +Output: 3 + +=end comment + +my @Test = + # ary ary magic_num + (3, 7, 5), (9, 5, 7), 2, + (1, 2, 1), (5, 4, 4), 3, + (2,), (5,), 3, + (2,5), (2,5), 0, + (2,5), (1,9), Int, + (), (), Int, +; +my @Die = + (1,0), (2,), + (), (1,2), + (1,2), (), +; +plan @Test ÷ 3 + @Die ÷ 2; + +multi func( @a where * ~~ [], @b where * ~~ [] --> Int ) { Int } +multi func( @a, @b where +* == +@a --> Int) { + my @candi = (@a.sort [Z-] @b.sort); + return (@candi.all == @candi[0]) + ?? @candi[0].Int.abs + !! Int; +} + +for @Test -> @a, @b, $exp { + is func(@a, @b), $exp, ($exp // "(Int)") ~ " ~~\t @a[] <=- @b[]"; +} + +for @Die -> @a, @b { + dies-ok { func(@a, @b) }, "die ~~\t @a[] <=- @b[]"; +} +done-testing; + +exit; + diff --git a/challenge-268/0rir/raku/ch-2.raku b/challenge-268/0rir/raku/ch-2.raku new file mode 100644 index 0000000000..31208a54f5 --- /dev/null +++ b/challenge-268/0rir/raku/ch-2.raku @@ -0,0 +1,57 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # 🦋 ∅∪∩∋∈∉⊆ ≡ ≢ « » ∴ +use v6.d; +use Test; + +=begin comment +268-2: Number Game Submitted by: Mohammad Sajid Anwar +You are given an array of integers, @ints, with even number of elements. + +Write a script to create a new array made up of elements of the given array. +Pick the two smallest integers and add it to new array in decreasing order +i.e. high to low. Keep doing until the given array is empty. + +Example 1 +Input: @ints = (2, 5, 3, 4) +Output: (3, 2, 5, 4) + +Round 1: we picked (2, 3) and push it to the new array (3, 2) +Round 2: we picked the remaining (4, 5) and push it to the new array (5, 4) +Example 2 +Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1) +Output: (1, 1, 4, 3, 6, 4, 9, 6) +Example 3 +Input: @ints = (1, 2, 2, 3) +Output: (2, 1, 3, 2) +=end comment + +my @Test = + # in out + (2, 5, 3, 4), (3,2, 5,4), + (9, 4, 1, 3, 6, 4, 6, 1), (1,1, 4,3, 6,4, 9,6), + (1, 2, 2, 3), (2,1, 3,2), + (), (), + (0,), (0,), + (0, 0), (0,0), + (0, 0, 0), (0,0, 0), + (9, 4, 1, 3, 6, 4, 6, 1, 0), (1,0, 3,1, 4,4, 6,6, 9), + (0,9, 4, 1, 3, 6, 4, 6, 1, 0), (0,0, 1,1, 4,3, 6,4, 9,6), +; + +plan @Test ÷ 2; + +sub func( @a is copy ) { + @a.=sort; + my @ret; # using two shift as Opt just two ptr moves but not tested + while @a > 1 { @ret.append: (@a.shift, @a.shift).sort.reverse } + if @a { @ret.append: @a.pop } + @ret; +} + +for @Test -> @in, @out { + func( @in); +} +for @Test -> @in, @exp { + is func(@in), @exp, "@exp[] <- @in.sort()"; +} +done-testing; diff --git a/challenge-268/arne-sommer/blog.txt b/challenge-268/arne-sommer/blog.txt new file mode 100644 index 0000000000..6f72301b3e --- /dev/null +++ b/challenge-268/arne-sommer/blog.txt @@ -0,0 +1 @@ +https://raku-musings.com/numerous-numbers.html diff --git a/challenge-268/arne-sommer/raku/ch-1.raku b/challenge-268/arne-sommer/raku/ch-1.raku new file mode 100755 index 0000000000..c057392b31 --- /dev/null +++ b/challenge-268/arne-sommer/raku/ch-1.raku @@ -0,0 +1,18 @@ +#! /usr/bin/env raku + +unit sub MAIN ($x, $y, :v(:$verbose)); + +my @x = $x.words>>.Int.sort; ## Numeric +my @y = $y.words>>.Int.sort; + +die "Not the same length" unless @x.elems == @y.elems; + +my @pairs = @x Z @y; + +say ":Pairs: { @pairs.raku }" if $verbose; + +my @diff = @pairs.map({ $_[0] - $_[1] }); + +say ":Diff: { @diff.join(", ") }" if $verbose; + +say ( [==] @diff ) ?? @diff[0].abs !! 'error'; diff --git a/challenge-268/arne-sommer/raku/ch-2.raku b/challenge-268/arne-sommer/raku/ch-2.raku new file mode 100755 index 0000000000..851142ccff --- /dev/null +++ b/challenge-268/arne-sommer/raku/ch-2.raku @@ -0,0 +1,20 @@ +#! /usr/bin/env raku + +unit sub MAIN (*@ints where @ints.elems > 1 && @ints.elems %% 2 && all(@ints) ~~ Int, :v(:$verbose)); + +my @sorted = @ints.sort; +my @new; + +while @sorted +{ + print ":Sorted: { @sorted.join(",")}" if $verbose; + + my $a = @sorted.shift; + my $b = @sorted.shift; + + say " -> pick $a,$b -> add $b,$a" if $verbose; + + @new.append: $b, $a; +} + +say "({ @new.join(", ") })"; diff --git a/challenge-268/arne-sommer/raku/magic-number b/challenge-268/arne-sommer/raku/magic-number new file mode 100755 index 0000000000..c057392b31 --- /dev/null +++ b/challenge-268/arne-sommer/raku/magic-number @@ -0,0 +1,18 @@ +#! /usr/bin/env raku + +unit sub MAIN ($x, $y, :v(:$verbose)); + +my @x = $x.words>>.Int.sort; ## Numeric +my @y = $y.words>>.Int.sort; + +die "Not the same length" unless @x.elems == @y.elems; + +my @pairs = @x Z @y; + +say ":Pairs: { @pairs.raku }" if $verbose; + +my @diff = @pairs.map({ $_[0] - $_[1] }); + +say ":Diff: { @diff.join(", ") }" if $verbose; + +say ( [==] @diff ) ?? @diff[0].abs !! 'error'; diff --git a/challenge-268/arne-sommer/raku/number-game b/challenge-268/arne-sommer/raku/number-game new file mode 100755 index 0000000000..851142ccff --- /dev/null +++ b/challenge-268/arne-sommer/raku/number-game @@ -0,0 +1,20 @@ +#! /usr/bin/env raku + +unit sub MAIN (*@ints where @ints.elems > 1 && @ints.elems %% 2 && all(@ints) ~~ Int, :v(:$verbose)); + +my @sorted = @ints.sort; +my @new; + +while @sorted +{ + print ":Sorted: { @sorted.join(",")}" if $verbose; + + my $a = @sorted.shift; + my $b = @sorted.shift; + + say " -> pick $a,$b -> add $b,$a" if $verbose; + + @new.append: $b, $a; +} + +say "({ @new.join(", ") })"; diff --git a/challenge-268/matthias-muth/README.md b/challenge-268/matthias-muth/README.md index 82f3d2b590..6d58a3ad92 100644 --- a/challenge-268/matthias-muth/README.md +++ b/challenge-268/matthias-muth/README.md @@ -1,137 +1,130 @@ -# Signs Count! -**Challenge 267 solutions in Perl by Matthias Muth** +# Perl Magic Games -## Task 1: Product Sign +**Challenge 268 solutions in Perl by Matthias Muth** -> You are given an array of @ints.<br/> -> Write a script to find the sign of product of all integers in the given array. The sign is 1 if the product is positive, -1 if the product is negative and 0 if product is zero.<br/> +## Task 1: Magic Number + +> You are given two arrays of integers of same size, @x and @y.<br/> +> Write a script to find the magic number that when added to each elements of one of the array gives the second array. Elements order is not important.<br/> > <br/> > Example 1<br/> -> Input: @ints = (-1, -2, -3, -4, 3, 2, 1)<br/> -> Output: 1<br/> -> The product -1 x -2 x -3 x -4 x 3 x 2 x 1 => 144 > 0<br/> +> Input: @x = (3, 7, 5)<br/> +> @y = (9, 5, 7)<br/> +> Output: 2<br/> +> The magic number is 2.<br/> +> @x = (3, 7, 5)<br/> +> \+ 2 2 2<br/> +> @y = (5, 9, 7)<br/> > <br/> > Example 2<br/> -> Input: @ints = (1, 2, 0, -2, -1)<br/> -> Output: 0<br/> -> The product 1 x 2 x 0 x -2 x -1 => 0<br/> +> Input: @x = (1, 2, 1)<br/> +> @y = (5, 4, 4)<br/> +> Output: 3<br/> +> The magic number is 3.<br/> +> @x = (1, 2, 1)<br/> +> \+ 3 3 3<br/> +> @y = (5, 4, 4)<br/> > <br/> > Example 3<br/> -> Input: @ints = (-1, -1, 1, -1, 2)<br/> -> Output: -1<br/> -> The product -1 x -1 x 1 x -1 x 2 => -2 < 0<br/> - -Probably one of the shortest Weekly Challenge solutions that I ever wrote!<br/> -Some considerations first: - -- Multiplying all the numbers in the list might cause an integer overflow.<br/> - So let's better to multiply only the 'signs' of the numbers, - like `-1` for negative numbers, `0` for zero and `+1` for positive numbers. - -- There is the `sign` function from `Math::Utils` - that returns the sign of a number like that. - -- But we can also use Perl's 'spaceship operator' `<=>` instead.<br/> - It returns `-1`, `0`, or `1` depending on whether the left argument is - numerically less than, equal to, or greater than the right argument.<br/> - So by comparing against zero, like<br/> - - `$n <=> 0` - - we get the number's sign just the same.<br/> - This reduces the startup cost because we don't need to load that module, - and it avoids the function call overhead. - -So we map the integers to their signs, -and let the `product` function from `List::Util` -do the work of multiplying them. +> Input: @x = (2)<br/> +> @y = (5)<br/> +> Output: 3<br/> +If we only could be sure that once we have a 'magic number', it will be the correct one for all the numbers in the two arrays! In that case, we would be done if we simply computed the difference of the two lowest numbers in each array!<br/>Very easy: ```perl use v5.36; -use List::Util qw( product ); +use List::Util qw( min ); -sub product_sign( @ints ) { - return product map $_ <=> 0, @ints; +sub magic_number_short( $x, $y ) { + return min( $y->@* ) - min( $x->@* ); } ``` -There is one optimization that I could consider for large lists -that also have a probability of containing zero values:<br/> -If there is at least one zero in the list, the product will always be zero, too. -So we can shortcut the result once we encounter the first zero. - -We even can return from right inside the map code block once we see a zero sign. -And this can even be a bit 'elegant' -if we chain the `return` with a logical `or`. -The `return` will be executed only if the first expression (the sign) -is 'logically false' (i.e., zero in our case), -and if not, the first expression (the sign) is used. +This works for all examples given, so there it is: a quite short solution for this task. + +But we all know that life can be hard, and input data can be not what we expect.<br/>So actually we should do some checking, and only return the magic number if it's the correct difference for *all* the numbers in the two arrays. + +So the longer solution is to sort the two arrays, and to compare all differences between corresponding pairs of numbers. + +To compute those differences, I use the `zip` function (from `List::Util`) to join the two sorted arrays. This results in a list of references to two-element arrays, each containing one number from the first and one number from the second array. I then use `map` to turn the two numbers from each entry into their difference. + +Once we have all differences, we can check whether all of them are the same as the first one (using `all`, also from `List::Util`), and if so, return this as our 'magic' number. If they are not all the same, we return `undef`, kind of 'extending the specification' because we are not told what should happen in that case. + +We also should deal with the edge case of empty input arrays, and also make sure that the two input arrays have the same number of elements. So we prepend a small input check, for not running into any 'undefined value' warnings in those cases. + +I think the result still looks quite reasonable: + ```perl -sub product_sign( @ints ) { - return product map { $_ <=> 0 or return 0 } @ints; +use v5.36; + +sub magic_number( $x, $y ) { + @$x && ( @$x == @$y ) + or return undef; + my @diffs = map $_->[1] - $_->[0], + zip [ sort { $a <=> $b } $x->@* ], + [ sort { $a <=> $b } $y->@* ]; + return + ( all { $_ == $diffs[0] } @diffs[1..$#diffs] ) + ? $diffs[0] + : undef; } ``` -Still nice and short! -## Task 2: Line Counts +## Task 2: Number Game -> You are given a string, \$str, and a 26-items array @widths containing the width of each character from a to z.<br/> -> Write a script to find out the number of lines and the width of the last line needed to display the given string, assuming you can only fit 100 width units on a line.<br/> +> You are given an array of integers, @ints, with even number of elements.<br/> +> Write a script to create a new array made up of elements of the given array. Pick the two smallest integers and add it to new array in decreasing order i.e. high to low. Keep doing until the given array is empty.<br/> > <br/> > Example 1<br/> -> Input: \$str = "abcdefghijklmnopqrstuvwxyz"<br/> -> @widths = (10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)<br/> -> Output: (3, 60)<br/> -> Line 1: abcdefghij (100 pixels)<br/> -> Line 2: klmnopqrst (100 pixels)<br/> -> Line 3: uvwxyz (60 pixels)<br/> +> Input: @ints = (2, 5, 3, 4)<br/> +> Output: (3, 2, 5, 4)<br/> +> Round 1: we picked (2, 3) and push it to the new array (3, 2)<br/> +> Round 2: we picked the remaining (4, 5) and push it to the new array (5, 4)<br/> > <br/> > Example 2<br/> -> Input: \$str = "bbbcccdddaaa"<br/> -> @widths = (4,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)<br/> -> Output: (2, 4)<br/> -> Line 1: bbbcccdddaa (98 pixels)<br/> -> Line 2: a (4 pixels)<br/> +> Input: @ints = (9, 4, 1, 3, 6, 4, 6, 1)<br/> +> Output: (1, 1, 4, 3, 6, 4, 9, 6)<br/> +> <br/> +> Example 3<br/> +> Input: @ints = (1, 2, 2, 3)<br/> +> Output: (2, 1, 3, 2)<br/> -This part needs a bit more of an algorithm, so I will be a bit more verbose to make the solution readable. +This is one of the tasks where a bit of thinking about what really happens helps to find a nice and easy solution: -First thing is to initialize the variables that will be returned in the end.<br/> -The number of lines reflects the lines *including* the one we will be working on -(the 'current line'), so we start with `1`. -But actually we need to return zero lines if the input `$str` is empty, -so we consider that in the initialization.<br/> -The current line width starts with zero, as we haven't added anything yet. +The instructions basically suggest to use a loop, where inside the loop we find the two smallest numbers in the array, +remove them from the input array +and add them -- in reversed order -- into the output array. -Then we loop over all letters in `$str`. -For each letter, we get its width from the input array, -using its distance from the letter `'a'` as the the index into that array. +I don't like searching within a loop body.<br/> +Even if we might not run into a purely quadratic big O complexity just by searching +(because we shorten the array after each iteration), +destroying the input array just for that reason is not really elegant, +and even if it takes only split-micro-seconds, +I don't like wasting computing power for something like that. -If adding the letter's width would exceed the maximum width of 100, -we increment the number of lines and reset the current line width. -Then we add the letter's width. +The good thing is that we can achieve the same result +by simply sorting the array numerically (with a typical complexity of $`O(n\log n)`$), +and then flipping each pair of adjacent numbers +(in one simple additional pass).<br/> +Ah, much better ;-) -When we exit the loop, we can directly return the result. +We even can do this 'on the fly', +feeding the `sort` output into the `pairs` function (from `List::Util`), +which splits the numbers into small two-element arrays, +and then flipping the two numbers using `reverse` on each of those mini-arrays, using a `map` code block. -Actually I guess my explanations did not add a lot that could not be -easily understood from reading the code. -Or at least I hope... +Looks 'perlish' to me, and hey, another one-liner! Who would have guessed! ```perl use v5.36; -sub line_counts( $str, $widths ) { - my ( $n_lines, $current_line_width ) = ( $str ne "" || 0, 0 ); - for ( split "", $str ) { - my $char_width = $widths->[ ord( $_ ) - ord( 'a' ) ]; - if ( $current_line_width + $char_width > 100 ) { - ++$n_lines; - $current_line_width = 0; - } - $current_line_width += $char_width; - } - return ( $n_lines, $current_line_width ); +use List::Util qw( pairs ); + +sub number_game( @ints ) { + return map { reverse $_->@* } pairs sort { $a <=> $b } @ints; } ``` #### **Thank you for the challenge!** + diff --git a/challenge-268/matthias-muth/blog.txt b/challenge-268/matthias-muth/blog.txt new file mode 100644 index 0000000000..e33601be6f --- /dev/null +++ b/challenge-268/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-268/challenge-268/matthias-muth#readme diff --git a/challenge-268/matthias-muth/perl/ch-1.pl b/challenge-268/matthias-muth/perl/ch-1.pl new file mode 100755 index 0000000000..24c0c04125 --- /dev/null +++ b/challenge-268/matthias-muth/perl/ch-1.pl @@ -0,0 +1,40 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 268 Task 1: Magic Number +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +use List::Util qw( all zip min ); + +sub magic_number_short( $x, $y ) { + return min( $y->@* ) - min( $x->@* ); +} + +sub magic_number( $x, $y ) { + @$x && ( @$x == @$y ) + or return undef; + my @diffs = map $_->[1] - $_->[0], + zip [ sort { $a <=> $b } $x->@* ], + [ sort { $a <=> $b } $y->@* ]; + return + ( all { $_ == $diffs[0] } @diffs[1..$#diffs] ) + ? $diffs[0] + : undef; +} + +use Test2::V0 qw( -no_srand ); +is magic_number( [], [] ), undef, + 'Test 1: magic_number( [], [] ) == undef'; +is magic_number( [3, 7, 5], [9, 5, 7] ), 2, + 'Example 1: magic_number( [3, 7, 5], [9, 5, 7] ) == 2'; +is magic_number( [1, 2, 1], [5, 4, 4] ), 3, + 'Example 2: magic_number( [1, 2, 1], [5, 4, 4] ) == 3'; +is magic_number( [2], [5] ), 3, + 'Example 3: magic_number( [2], [5] ) == 3'; +done_testing; diff --git a/challenge-268/matthias-muth/perl/ch-2.pl b/challenge-268/matthias-muth/perl/ch-2.pl new file mode 100755 index 0000000000..7d7f88a019 --- /dev/null +++ b/challenge-268/matthias-muth/perl/ch-2.pl @@ -0,0 +1,26 @@ +#!/usr/bin/env perl +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# Challenge 268 Task 2: Number Game +# +# Perl solution by Matthias Muth. +# + +use v5.36; + +use List::Util qw( pairs ); + +sub number_game( @ints ) { + return map { reverse $_->@* } pairs sort { $a <=> $b } @ints; +} + +use Test2::V0 qw( -no_srand ); +is [ number_game( 2, 5, 3, 4 ) ], [ 3, 2, 5, 4 ], + 'Example 1: number_game( 2, 5, 3, 4 ) == (3, 2, 5, 4)'; +is [ number_game( 9, 4, 1, 3, 6, 4, 6, 1 ) ], [ 1, 1, 4, 3, 6, 4, 9, 6 ], + 'Example 2: number_game( 9, 4, 1, 3, 6, 4, 6, 1 ) == (1, 1, 4, 3, 6, 4, 9, 6)'; +is [ number_game( 1, 2, 2, 3 ) ], [ 2, 1, 3, 2 ], + 'Example 3: number_game( 1, 2, 2, 3 ) == (2, 1, 3, 2)'; +done_testing; diff --git a/challenge-268/robbie-hatley/perl/ch-1.pl b/challenge-268/robbie-hatley/perl/ch-1.pl index 5f7860b760..8060986d2b 100755 --- a/challenge-268/robbie-hatley/perl/ch-1.pl +++ b/challenge-268/robbie-hatley/perl/ch-1.pl @@ -44,12 +44,11 @@ PROBLEM NOTES: I'll sort both arrays then subtract the second from the first. If all elements of the difference are the same, that common value is our "magic number", otherwise return "none": - # Determine "magic number" (if any) for given matrix: sub magic ($matref) { my @row1 = sort {$a<=>$b} @{$$matref[0]}; my @row2 = sort {$a<=>$b} @{$$matref[1]}; - my @diff = map {$$_[1]-$$_[0]} zip6 @row1, @row2; - all {$diff[0] == $_} @diff and return $diff[0] + my @diff = pairwise {$b-$a} @row1, @row2; + all {$_ == $diff[0]} @diff and return $diff[0] or return 'none'; } @@ -57,7 +56,7 @@ that common value is our "magic number", otherwise return "none": IO NOTES: Input is via either built-in variables or via @ARGV. If using @ARGV, provide one argument which must be a single-quoted array of arrays of pairs of same-size arrays of integers, in proper Perl syntax, like so: -./ch-1.pl '([[1,2,3],[7,8,9]],[[3,8],[9,4,2]],[[3,8,17],[4,5,72]])' +./ch-1.pl '([[3,8],[9,4,2]],[[3,8,17],[4,5,72]],[[1,2,3],[7,9,8]])' Output is to STDOUT and will be each input followed by the corresponding output. @@ -67,11 +66,11 @@ Output is to STDOUT and will be each input followed by the corresponding output. # PRAGMAS, MODULES, AND SUBS: use v5.38; - use List::MoreUtils 'zip6'; + use List::SomeUtils 'pairwise'; use List::Util 'all'; - # Is a given scalar a reference to a Pair Of Same-Size Arrays Of Numbers? - sub is_possaon ($matref) { + # Is a given scalar a reference to a Pair Of Same-Size Arrays Of Integers? + sub is_possaoi ($matref) { 'ARRAY' ne ref $matref and return 0; 2 != scalar(@$matref) and return 0; scalar(@{$$matref[0]}) != scalar(@{$$matref[1]}) and return 0; @@ -83,12 +82,12 @@ Output is to STDOUT and will be each input followed by the corresponding output. return 1; } - # Determine "magic number" (if any) for given matrix: + # Return the "magic number" (if any) of a matrix: sub magic ($matref) { my @row1 = sort {$a<=>$b} @{$$matref[0]}; my @row2 = sort {$a<=>$b} @{$$matref[1]}; - my @diff = map {$$_[1]-$$_[0]} zip6 @row1, @row2; - all {$diff[0] == $_} @diff and return $diff[0] + my @diff = pairwise {$b-$a} @row1, @row2; + all {$_ == $diff[0]} @diff and return $diff[0] or return 'none'; } @@ -124,7 +123,7 @@ for my $matref (@matrices) { say ''; say 'Matrix = '; say('[',join(', ', @$_),']') for @$matref; - !is_possaon($matref) + !is_possaoi($matref) and say 'Matrix is not a pair of same-size arrays of integers.' and say 'Moving on to next matrix.' and next; diff --git a/challenge-268/robbie-hatley/perl/ch-2.pl b/challenge-268/robbie-hatley/perl/ch-2.pl index a97e2828e0..a882accdce 100755 --- a/challenge-268/robbie-hatley/perl/ch-2.pl +++ b/ |