From 10f2f6c16c737eeefdbe5943594d55754e6a7976 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Tue, 10 Oct 2023 20:40:36 -0500 Subject: Task 1 done --- challenge-172/bob-lied/perl/ch-1.pl | 59 +++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 challenge-172/bob-lied/perl/ch-1.pl diff --git a/challenge-172/bob-lied/perl/ch-1.pl b/challenge-172/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..4085bc6dd2 --- /dev/null +++ b/challenge-172/bob-lied/perl/ch-1.pl @@ -0,0 +1,59 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge 172 Task 1 Prime Partition +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given two positive integers, $m and $n. +# Write a script to find out the Prime Partition of the given number. +# No duplicates allowed. +# Example 1 Input: $m = 18, $n = 2 +# Output: 5, 13 or 7, 11 +# Example 2 Input: $m = 19, $n = 3 +# Output: 3, 5, 11 +##### +# A prime partition is a set of primes that sums to the target number. +# There is a function in Math::Prime::Util that does this. +#============================================================================= + +use v5.38; +use Math::Prime::Util qw/forpart/; +use List::Util qw/uniqint/; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +sub noDup(@list) +{ + return scalar(uniqint(@list)) == scalar(@list); +} + +sub primePartition($m, $n) +{ + use Data::Dumper; + my @part; + forpart { push @part, [ @_ ] if noDup(@_) } $m, { n => $n, prime => 1} ; + + return \@part; +} + +sub runTest +{ + use Test2::V0; + use builtin qw/true false/; no warnings "experimental::builtin"; + + is( noDup(1,2,3,4), true, "noDup true"); + is( noDup(1,1,3,4), false, "noDup false begin"); + is( noDup(1,2,2,4), false, "noDup false middle"); + is( noDup(1,2,4,4), false, "noDup false end"); + + is( primePartition(18, 2), [ [5,13], [7,11] ], "Example 1"); + is( primePartition(19, 3), [ [3,5,11] ], "Example 2"); + + done_testing; +} -- cgit From 2cffde4d041fad2d6c977f81d0d0d633dec21467 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Tue, 10 Oct 2023 21:06:31 -0500 Subject: Task 2 checkpoint --- challenge-172/bob-lied/perl/ch-2.pl | 70 +++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 challenge-172/bob-lied/perl/ch-2.pl diff --git a/challenge-172/bob-lied/perl/ch-2.pl b/challenge-172/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..49b526e9e8 --- /dev/null +++ b/challenge-172/bob-lied/perl/ch-2.pl @@ -0,0 +1,70 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge 172 Task 2 Five-number Summary +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array of integers. +# Write a script to compute the five-number summary of the given set +# of integers. You can find the definition and example in the wikipedia page. +# https://en.wikipedia.org/wiki/Five-number_summary +# The five-number summary is a set of descriptive statistics that provides +# information about a dataset. It consists of the five most important +# sample percentiles: +# the sample minimum (smallest observation) +# the lower quartile or first quartile +# the median (the middle value) +# the upper quartile or third quartile +# the sample maximum (largest observation) +#============================================================================= + +use v5.38; +use builtin qw/true false/; no warnings "experimental::builtin"; + + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +sub median($ref) +{ + my $len = scalar( @$ref ); + if ( $len % 2 ) + { + # Odd length, take middle element + return $ref->[ int($len/2) ]; + } + else + { + # Even length, take average of middle 2 + my $mid = $len / 2; + return ( $ref->[$mid] + $ref->[$mid+1] ) / 2; + } +} + +sub fiveSummary(@list) +{ + my @sorted = sort { $a <=> $b } @list; + my $len = scalar( @list ); + my @summary = ( + $sorted[0], + 0, + median(\@sorted), + 1, + $sorted[-1] + ); +} + +sub runTest +{ + use Test2::V0; + + is( fiveSummary(0, 0, 1, 2, 63, 61, 27, 13), + [0.0, 0.5, 7.5, 44.0, 63.0 ], "Example 1"); + + done_testing; +} -- cgit From f5cf1052b7b9df42c9de547165c93a7eec3b708d Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Tue, 10 Oct 2023 21:08:48 -0500 Subject: Update README --- challenge-172/bob-lied/README | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-172/bob-lied/README b/challenge-172/bob-lied/README index c231e3a589..fe223977ff 100644 --- a/challenge-172/bob-lied/README +++ b/challenge-172/bob-lied/README @@ -1,3 +1,3 @@ -Solutions to weekly challenge 138 by Bob Lied +Solutions to weekly challenge 172 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/ +https://perlweeklychallenge.org/blog/perl-weekly-challenge-172/ -- cgit From 3fbb1075c1ce34ac910edfbf9bc07a4de501d3ea Mon Sep 17 00:00:00 2001 From: Roger Bell_West Date: Sun, 26 Nov 2023 10:16:46 +0000 Subject: RogerBW blog post for challenge no. 244 --- challenge-244/roger-bell-west/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-244/roger-bell-west/blog.txt diff --git a/challenge-244/roger-bell-west/blog.txt b/challenge-244/roger-bell-west/blog.txt new file mode 100644 index 0000000000..8fe3b9fd3c --- /dev/null +++ b/challenge-244/roger-bell-west/blog.txt @@ -0,0 +1 @@ +https://blog.firedrake.org/archive/2023/11/The_Weekly_Challenge_244__Counting_Your_Heroes.html -- cgit From 59481daad96eaa27bd9c4ecd81010941285c496e Mon Sep 17 00:00:00 2001 From: Simon Green Date: Sun, 26 Nov 2023 22:22:13 +1100 Subject: Simon's solution to challenge 244 --- challenge-244/sgreen/README.md | 4 ++-- challenge-244/sgreen/blog.txt | 1 + challenge-244/sgreen/perl/ch-1.pl | 18 ++++++++++++++++++ challenge-244/sgreen/perl/ch-2.pl | 30 ++++++++++++++++++++++++++++++ challenge-244/sgreen/python/ch-1.py | 14 ++++++++++++++ challenge-244/sgreen/python/ch-2.py | 25 +++++++++++++++++++++++++ 6 files changed, 90 insertions(+), 2 deletions(-) create mode 100644 challenge-244/sgreen/blog.txt create mode 100755 challenge-244/sgreen/perl/ch-1.pl create mode 100755 challenge-244/sgreen/perl/ch-2.pl create mode 100755 challenge-244/sgreen/python/ch-1.py create mode 100755 challenge-244/sgreen/python/ch-2.py diff --git a/challenge-244/sgreen/README.md b/challenge-244/sgreen/README.md index e2f63d2857..fb592c5c30 100644 --- a/challenge-244/sgreen/README.md +++ b/challenge-244/sgreen/README.md @@ -1,3 +1,3 @@ -# The Weekly Challenge 243 +# The Weekly Challenge 244 -Blog: [Weekly Challenge 243](https://dev.to/simongreennet/weekly-challenge-243-3ld) +Blog: [Weekly Challenge 244](https://dev.to/simongreennet/weekly-challenge-244-jim) diff --git a/challenge-244/sgreen/blog.txt b/challenge-244/sgreen/blog.txt new file mode 100644 index 0000000000..ca15406cb6 --- /dev/null +++ b/challenge-244/sgreen/blog.txt @@ -0,0 +1 @@ +https://dev.to/simongreennet/weekly-challenge-244-jim \ No newline at end of file diff --git a/challenge-244/sgreen/perl/ch-1.pl b/challenge-244/sgreen/perl/ch-1.pl new file mode 100755 index 0000000000..6698cd7195 --- /dev/null +++ b/challenge-244/sgreen/perl/ch-1.pl @@ -0,0 +1,18 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature 'say'; +use experimental 'signatures'; + +sub less_than ( $i, $ints ) { + # Return the number of items in the array less than $i + return scalar( grep { $_ < $i } @$ints ); +} + +sub main (@ints) { + my @solution = map { less_than( $_, \@ints ) } @ints; + say join ', ', @solution; +} + +main(@ARGV); \ No newline at end of file diff --git a/challenge-244/sgreen/perl/ch-2.pl b/challenge-244/sgreen/perl/ch-2.pl new file mode 100755 index 0000000000..af44e12ba5 --- /dev/null +++ b/challenge-244/sgreen/perl/ch-2.pl @@ -0,0 +1,30 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature 'say'; +use experimental 'signatures'; + +use Algorithm::Combinatorics 'combinations'; +use List::Util qw(min max); + +sub calculate_power($numbers) { + # Return the square of the maximum number multiplied by the smallest one + my $min_int = min(@$numbers); + my $max_int = max(@$numbers); + return $max_int ** 2 * $min_int; +} + +sub main (@ints) { + my $power = 0; + foreach my $len ( 1 .. $#ints + 1 ) { + my $iter = combinations( \@ints, $len ); + while ( my $c = $iter->next ) { + $power += calculate_power($c); + } + } + + say $power; +} + +main(@ARGV); \ No newline at end of file diff --git a/challenge-244/sgreen/python/ch-1.py b/challenge-244/sgreen/python/ch-1.py new file mode 100755 index 0000000000..230798c214 --- /dev/null +++ b/challenge-244/sgreen/python/ch-1.py @@ -0,0 +1,14 @@ +#!/usr/bin/env python3 + +import sys + + +def main(ints): + solution = [sum(1 for j in ints if j < i) for i in ints] + print(*solution, sep=', ') + + +if __name__ == '__main__': + # Convert input into integers + array = [int(n) for n in sys.argv[1:]] + main(array) diff --git a/challenge-244/sgreen/python/ch-2.py b/challenge-244/sgreen/python/ch-2.py new file mode 100755 index 0000000000..64f54aff7a --- /dev/null +++ b/challenge-244/sgreen/python/ch-2.py @@ -0,0 +1,25 @@ +#!/usr/bin/env python3 + +import sys +from itertools import combinations + + +def calculate_power(numbers): + '''Return the square of the maximum number multiplied by the smallest one''' + min_int = min(numbers) + max_int = max(numbers) + return max_int ** 2 * min_int + + +def main(ints): + power = 0 + for length in range(1, len(ints)+1): + power += sum(calculate_power(c) for c in combinations(ints, length)) + + print(power) + + +if __name__ == '__main__': + # Convert input into integers + array = [int(n) for n in sys.argv[1:]] + main(array) -- cgit From 264d3db16ad6a1123e1ff019830de79f3e59b04e Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Mon, 27 Nov 2023 00:24:40 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 244 --- challenge-244/athanasius/perl/ch-1.pl | 163 ++++++++++++++++++++++++++ challenge-244/athanasius/perl/ch-2.pl | 199 ++++++++++++++++++++++++++++++++ challenge-244/athanasius/raku/ch-1.raku | 160 +++++++++++++++++++++++++ challenge-244/athanasius/raku/ch-2.raku | 192 ++++++++++++++++++++++++++++++ 4 files changed, 714 insertions(+) create mode 100644 challenge-244/athanasius/perl/ch-1.pl create mode 100644 challenge-244/athanasius/perl/ch-2.pl create mode 100644 challenge-244/athanasius/raku/ch-1.raku create mode 100644 challenge-244/athanasius/raku/ch-2.raku diff --git a/challenge-244/athanasius/perl/ch-1.pl b/challenge-244/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..a0d2df4ff8 --- /dev/null +++ b/challenge-244/athanasius/perl/ch-1.pl @@ -0,0 +1,163 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 244 +========================= + +TASK #1 +------- +*Count Smaller* + +Submitted by: Mohammad S Anwar + +You are given an array of integers. + +Write a script to calculate the number of integers smaller than the integer at +each index. + +Example 1 + + Input: @int = (8, 1, 2, 2, 3) + Output: (4, 0, 1, 1, 3) + + For index = 0, count of elements less 8 is 4. + For index = 1, count of elements less 1 is 0. + For index = 2, count of elements less 2 is 1. + For index = 3, count of elements less 2 is 1. + For index = 4, count of elements less 3 is 3. + +Example 2 + + Input: @int = (6, 5, 4, 8) + Output: (2, 1, 0, 3) + +Example 3 + + Input: @int = (2, 2, 2) + Output: (0, 0, 0) + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use List::MoreUtils qw( first_index ); +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => +"Usage: + perl $0 [ ...] + perl $0 + + [ ...] A list of integers\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 244, Task #1: Count Smaller (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my @int = @ARGV; + + for (@int) + { + / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] ); + } + + printf "Input: \@int = (%s)\n", join ', ', @int; + + my $out = count_smaller( \@int ); + + printf "Output: (%s)\n", join ', ', @$out; + } +} + +#------------------------------------------------------------------------------- +sub count_smaller +#------------------------------------------------------------------------------- +{ + my ($ints) = @_; + my @sorted = sort { $a <=> $b } @$ints; + my @out; + + for my $int (@$ints) + { + push @out, first_index { $_ == $int } @sorted; + } + + return \@out; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $int_str, $exp_str) = split / \| /x, $line; + + for ($test_name, $int_str, $exp_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @int = split / \s+ /x, $int_str; + my $out = count_smaller( \@int ); + my @exp = split / \s+ /x, $exp_str; + + is_deeply $out, \@exp, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|8 1 2 2 3|4 0 1 1 3 +Example 2|6 5 4 8 |2 1 0 3 +Example 3|2 2 2 |0 0 0 diff --git a/challenge-244/athanasius/perl/ch-2.pl b/challenge-244/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..a07fe21754 --- /dev/null +++ b/challenge-244/athanasius/perl/ch-2.pl @@ -0,0 +1,199 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 244 +========================= + +TASK #2 +------- +*Group Hero* + +Submitted by: Mohammad S Anwar + +You are given an array of integers representing the strength. + +Write a script to return the sum of the powers of all possible combinations; +power is defined as the square of the largest number in a sequence, multiplied +by the smallest. + +Example 1 + + Input: @nums = (2, 1, 4) + Output: 141 + + Group 1: (2) => square(max(2)) * min(2) => 4 * 2 => 8 + Group 2: (1) => square(max(1)) * min(1) => 1 * 1 => 1 + Group 3: (4) => square(max(4)) * min(4) => 16 * 4 => 64 + Group 4: (2,1) => square(max(2,1)) * min(2,1) => 4 * 1 => 4 + Group 5: (2,4) => square(max(2,4)) * min(2,4) => 16 * 2 => 32 + Group 6: (1,4) => square(max(1,4)) * min(1,4) => 16 * 1 => 16 + Group 7: (2,1,4) => square(max(2,1,4)) * min(2,1,4) => 16 * 1 => 16 + + Sum: 8 + 1 + 64 + 4 + 32 + 16 + 16 => 141 + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Assumptions +----------- +1. Duplicates are allowed in the input list. +2. Combinations are unordered and unique, but may contain duplicates. So, (1, 2) + and (2, 1) are the same combination, BUT (1, 2) and (1, 2, 2) are different + combinations (and so must be counted separately). + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use List::Util qw( any max min uniqnum ); +use Math::Prime::Util qw( forcomb ); +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => +"Usage: + perl $0 [ ...] + perl $0 + + [ ...] A list of integers\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 244, Task #2: Group Hero (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my @nums = @ARGV; + + / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] ) + for @nums; + + printf "Input: \@nums = (%s)\n", join ', ', @nums; + + my $sum = power_sum( \@nums ); + + print "Output: $sum\n"; + } +} + +#------------------------------------------------------------------------------- +sub power_sum +#------------------------------------------------------------------------------- +{ + my ($nums) = @_; + my @set = sort { $a <=> $b } uniqnum @$nums; + my @combs; + my %groups; + + forcomb { push @combs, [ @set[ @_ ] ] } @set; + + for my $comb (@combs) + { + next if scalar @$comb == 0; + + my $key = join '|', @$comb; + + $groups{ $key } = power( $comb ); + } + + my $sum = 0; + my %counts; + ++$counts{ $_ } for @$nums; + + for my $key (keys %groups) + { + my @comb = split / \| /x, $key; + my $mult = 1; + + for my $num (keys %counts) + { + $mult *= $counts{ $num } if any { $num == $_ } @comb; + } + + $sum += $groups{ $key } * $mult; + } + + return $sum; +} + +#------------------------------------------------------------------------------- +sub power +#------------------------------------------------------------------------------- +{ + my ($comb) = @_; + my @nums = @$comb; + my $max = max @nums; + my $min = min @nums; + + return $max * $max * $min; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $nums_str, $exp_str) = split / \| /x, $line; + + for ($test_name, $nums_str, $exp_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @nums = split / \s+ /x, $nums_str; + my $sum = power_sum( \@nums ); + + is $sum, $exp_str, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 | 2 1 4 |141 +Multiples 1| 1 1 2 2 | 34 +Multiples 2| 2 1 4 1 2 1|315 diff --git a/challenge-244/athanasius/raku/ch-1.raku b/challenge-244/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..4b564c3cde --- /dev/null +++ b/challenge-244/athanasius/raku/ch-1.raku @@ -0,0 +1,160 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 244 +========================= + +TASK #1 +------- +*Count Smaller* + +Submitted by: Mohammad S Anwar + +You are given an array of integers. + +Write a script to calculate the number of integers smaller than the integer at +each index. + +Example 1 + + Input: @int = (8, 1, 2, 2, 3) + Output: (4, 0, 1, 1, 3) + + For index = 0, count of elements less 8 is 4. + For index = 1, count of elements less 1 is 0. + For index = 2, count of elements less 2 is 1. + For index = 3, count of elements less 2 is 1. + For index = 4, count of elements less 3 is 3. + +Example 2 + + Input: @int = (6, 5, 4, 8) + Output: (2, 1, 0, 3) + +Example 3 + + Input: @int = (2, 2, 2) + Output: (0, 0, 0) + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. If the first integer is negative, it must be preceded by "--" to indicate + that it is not a command-line flag. + +=end comment +#=============================================================================== + +use Test; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 244, Task #1: Count Smaller (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + *@int where { .elems > 0 && .all ~~ Int:D } #= A list of integers +) +#=============================================================================== +{ + "Input: \@int = (%s)\n".printf: @int.join: ', '; + + my UInt @out = count-smaller( @int ); + + "Output: (%s)\n"\.printf: @out.join: ', '; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub count-smaller( List:D[Int:D] $ints --> List:D[UInt:D] ) +#------------------------------------------------------------------------------- +{ + my Int @sorted = $ints.sort; + my UInt @out; + @out.push: @sorted.first: * == $_, :k for @$ints; + + return @out; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $int-str, $exp-str) = $line.split: / \| /; + + for $test-name, $int-str, $exp-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Int @int = $int-str.split( / \s+ / ).map: { .Int }; + my UInt @out = count-smaller( @int ); + my UInt @exp = $exp-str.split( / \s+ / ).map: { .Int }; + + is-deeply @out, @exp, $test-name; + } + + done-testing; +} + +#------------------------------------------------------------------------------- +sub error( Str:D $message ) +#------------------------------------------------------------------------------- +{ + "ERROR: $message".put; + + USAGE(); + + exit 0; +} + +#------------------------------------------------------------------------------- +sub USAGE() +#------------------------------------------------------------------------------- +{ + my Str $usage = $*USAGE; + + $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +#------------------------------------------------------------------------------- +sub test-data( --> Str:D ) +#------------------------------------------------------------------------------- +{ + return q:to/END/; + Example 1|8 1 2 2 3|4 0 1 1 3 + Example 2|6 5 4 8 |2 1 0 3 + Example 3|2 2 2 |0 0 0 + END +} + +################################################################################ diff --git a/challenge-244/athanasius/raku/ch-2.raku b/challenge-244/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..c1e927c869 --- /dev/null +++ b/challenge-244/athanasius/raku/ch-2.raku @@ -0,0 +1,192 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 244 +========================= + +TASK #2 +------- +*Group Hero* + +Submitted by: Mohammad S Anwar + +You are given an array of integers representing the strength. + +Write a script to return the sum of the powers of all possible combinations; +power is defined as the square of the largest number in a sequence, multiplied +by the smallest. + +Example 1 + + Input: @nums = (2, 1, 4) + Output: 141 + + Group 1: (2) => square(max(2)) * min(2) => 4 * 2 => 8 + Group 2: (1) => square(max(1)) * min(1) => 1 * 1 => 1 + Group 3: (4) => square(max(4)) * min(4) => 16 * 4 => 64 + Group 4: (2,1) => square(max(2,1)) * min(2,1) => 4 * 1 => 4 + Group 5: (2,4) => square(max(2,4)) * min(2,4) => 16 * 2 => 32 + Group 6: (1,4) => square(max(1,4)) * min(1,4) => 16 * 1 => 16 + Group 7: (2,1,4) => square(max(2,1,4)) * min(2,1,4) => 16 * 1 => 16 + + Sum: 8 + 1 + 64 + 4 + 32 + 16 + 16 => 141 + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Assumptions +----------- +1. Duplicates are allowed in the input list. +2. Combinations are unordered and unique, but may contain duplicates. So, (1, 2) + and (2, 1) are the same combination, BUT (1, 2) and (1, 2, 2) are different + combinations (and so must be counted separately). + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +=end comment +#=============================================================================== + +use Test; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 244, Task #2: Group Hero (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + *@nums where { .elems > 0 && .all ~~ Int:D } #= A list of integers +) +#=============================================================================== +{ + "Input: \@nums = (%s)\n".printf: @nums.join: ', '; + + my Int $sum = power-sum( @nums ); + + "Output: $sum".put; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub power-sum( List:D[Int:D] $nums --> Int:D ) +#------------------------------------------------------------------------------- +{ + my Int %groups{Set[Int]}; + + for $nums.combinations: 1 .. * -> List $comb + { + my $set = Set[Int].new: $comb.map: { .Int }; + + %groups{ $set } = power( $set ); + } + + my UInt %counts{Int}; + ++%counts{ $_ } for @$nums; + + my Int $sum = 0; + + for %groups.keys -> Set[Int] $comb + { + my UInt $multiplier = 1; + + for %counts.keys -> Int $num + { + $multiplier *= %counts{ $num } if $num.Int ∈ $comb; + } + + $sum += %groups{ $comb } * $multiplier; + } + + return $sum; +} + +#------------------------------------------------------------------------------- +sub power( Set:D[Int:D] $comb --> Int:D ) +#------------------------------------------------------------------------------- +{ + my Int @nums = $comb.keys; + my Int $max = @nums.max; + my Int $min = @nums.min; + + return $max² * $min; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $nums-str, $exp-str) = $line.split: / \| /; + + for $test-name, $nums-str, $exp-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Int @nums = $nums-str.split( / \s+ / ).map: { .Int }; + my Int $sum = power-sum( @nums ); + + is $sum, $exp-str.Int, $test-name; + } + + done-testing; +} + +#------------------------------------------------------------------------------- +sub error( Str:D $message ) +#------------------------------------------------------------------------------- +{ + "ERROR: $message".put; + + USAGE(); + + exit 0; +} + +#------------------------------------------------------------------------------- +sub USAGE() +#------------------------------------------------------------------------------- +{ + my Str $usage = $*USAGE; + + $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +#------------------------------------------------------------------------------- +sub test-data( --> Str:D ) +#------------------------------------------------------------------------------- +{ + return q:to/END/; + Example 1 |2 1 4 |141 + Multiples 1|1 1 2 2 | 34 + Multiples 2|2 1 4 1 2 1|315 + END +} + +################################################################################ -- cgit From dffd2da5d8674935ab48cbe4054aca53cc09ef84 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Sun, 26 Nov 2023 08:40:22 -0600 Subject: Week 172 solutions --- challenge-172/bob-lied/perl/ch-1.pl | 20 +++++++++++++--- challenge-172/bob-lied/perl/ch-2.pl | 46 ++++++++++++++++++++++++++++++++----- 2 files changed, 57 insertions(+), 9 deletions(-) diff --git a/challenge-172/bob-lied/perl/ch-1.pl b/challenge-172/bob-lied/perl/ch-1.pl index 4085bc6dd2..da6a73c1c8 100644 --- a/challenge-172/bob-lied/perl/ch-1.pl +++ b/challenge-172/bob-lied/perl/ch-1.pl @@ -18,8 +18,6 @@ #============================================================================= use v5.38; -use Math::Prime::Util qw/forpart/; -use List::Util qw/uniqint/; use Getopt::Long; my $Verbose = 0; @@ -28,14 +26,30 @@ my $DoTest = 0; GetOptions("test" => \$DoTest, "verbose" => \$Verbose); exit(!runTest()) if $DoTest; +my $M = shift; +my $N = shift; + +die "Usage: $0 m n" unless $M && $N; +die "n must be <= m/2" unless $N <= $M/2; +my $answer = primePartition($M, $N); +if ( $Verbose ) +{ + say join(" or ", map { join(", ", $_->@*) } $answer->@*); +} +else +{ + say "$_->@*" for $answer->@*; +} + sub noDup(@list) { + use List::Util qw/uniqint/; return scalar(uniqint(@list)) == scalar(@list); } sub primePartition($m, $n) { - use Data::Dumper; + use Math::Prime::Util qw/forpart/; my @part; forpart { push @part, [ @_ ] if noDup(@_) } $m, { n => $n, prime => 1} ; diff --git a/challenge-172/bob-lied/perl/ch-2.pl b/challenge-172/bob-lied/perl/ch-2.pl index 49b526e9e8..d73be53695 100644 --- a/challenge-172/bob-lied/perl/ch-2.pl +++ b/challenge-172/bob-lied/perl/ch-2.pl @@ -20,8 +20,7 @@ #============================================================================= use v5.38; -use builtin qw/true false/; no warnings "experimental::builtin"; - +use builtin qw/floor ceil/; no warnings "experimental::builtin"; use Getopt::Long; my $Verbose = 0; @@ -30,6 +29,24 @@ my $DoTest = 0; GetOptions("test" => \$DoTest, "verbose" => \$Verbose); exit(!runTest()) if $DoTest; +show(fiveSummary(@ARGV)); + +sub show($five) +{ + if ( $Verbose ) + { + printf " minimum: %12.3f\n", $five->[0]; + printf "1st quartile: %12.3f\n", $five->[1]; + printf " median: %12.3f\n", $five->[2]; + printf "3nd quartile: %12.3f\n", $five->[3]; + printf " maximum: %12.3f\n", $five->[4]; + } + else + { + say "(", join(", ", $five->@*), ")"; + } +} + sub median($ref) { my $len = scalar( @$ref ); @@ -42,7 +59,7 @@ sub median($ref) { # Even length, take average of middle 2 my $mid = $len / 2; - return ( $ref->[$mid] + $ref->[$mid+1] ) / 2; + return ( $ref->[$mid] + $ref->[$mid-1] ) / 2; } } @@ -50,19 +67,36 @@ sub fiveSummary(@list) { my @sorted = sort { $a <=> $b } @list; my $len = scalar( @list ); + my $mid = $len / 2; + my ($lowtop, $hibottom); + if ( $len % 2 ) + { + # Odd + $lowtop = $hibottom = floor($mid); + } + else + { + # Even + $lowtop = ($hibottom = $mid) - 1; + } + my @summary = ( $sorted[0], - 0, - median(\@sorted), - 1, + median( [ @sorted[0 .. $lowtop ] ]), + median( \@sorted ), + median( [ @sorted[ $hibottom .. $#list] ]), $sorted[-1] ); + return \@summary; } sub runTest { use Test2::V0; + is( median([3,5,7]), 5, "Median odd length"); + is( median([3,5,7,9]), 6, "Median even length"); + is( fiveSummary(0, 0, 1, 2, 63, 61, 27, 13), [0.0, 0.5, 7.5, 44.0, 63.0 ], "Example 1"); -- cgit From c301e328c95a9956c014c043776e8e81d0c20b47 Mon Sep 17 00:00:00 2001 From: CY Fung Date: Sun, 26 Nov 2023 22:49:13 +0800 Subject: Week 244 --- challenge-244/cheok-yin-fung/perl/ch-1.pl | 22 ++++++++++++++++++++++ challenge-244/cheok-yin-fung/perl/ch-2.pl | 20 ++++++++++++++++++++ 2 files changed, 42 insertions(+) create mode 100644 challenge-244/cheok-yin-fung/perl/ch-1.pl create mode 100644 challenge-244/cheok-yin-fung/perl/ch-2.pl diff --git a/challenge-244/cheok-yin-fung/perl/ch-1.pl b/challenge-244/cheok-yin-fung/perl/ch-1.pl new file mode 100644 index 0000000000..c364fc44a1 --- /dev/null +++ b/challenge-244/cheok-yin-fung/perl/ch-1.pl @@ -0,0 +1,22 @@ +# The Weekly Challenge 244 +# Task 1 Count Smaller +use v5.30.0; +use warnings; + +sub cs { + my @int = @_; + my @ans; + for my $k (0..$#int) { + push @ans, 0; + for my $i (0..$#int) { + $ans[-1]++ if $int[$i]<$int[$k]; + } + } + return [@ans]; +} + +use Test::More tests=>3; +use Test::Deep; +cmp_deeply cs(8,1,2,2,3),[4,0,1,1,3]; +cmp_deeply cs(6,5,4,8),[2,1,0,3]; +cmp_deeply cs(2,2,2),[0,0,0]; diff --git a/challenge-244/cheok-yin-fung/perl/ch-2.pl b/challenge-244/cheok-yin-fung/perl/ch-2.pl new file mode 100644 index 0000000000..315046e0c0 --- /dev/null +++ b/challenge-244/cheok-yin-fung/perl/ch-2.pl @@ -0,0 +1,20 @@ +# The Weekly Challenge 244 +# Task 2 Group Hero +use v5.30.0; +use warnings; +use List::Util qw/max min/; +sub gh { + my $ans = 0; + my @nums = @_; + my $num = $#nums+1; + for my $grp (2 .. 2 << $#nums) { + my $str = unpack("b$num", pack("s", $grp-1)); + my @arr = split "", $str; + my @ints = map {$nums[$_]} grep {$arr[$_]} 0..$#nums; + $ans += max(@ints)**2 * min(@ints); + } + return $ans; +} + +use Test::More tests=>1; +ok gh(2,1,4)==141; -- cgit From fd6f6bb10f450de06166e099cbe334de6bfa38ca Mon Sep 17 00:00:00 2001 From: irifkin Date: Sun, 26 Nov 2023 10:07:51 -0500 Subject: perl solution for challenge 244 and a short blog post --- challenge-244/ianrifkin/README.md | 135 +++++++++++++++-------------------- challenge-244/ianrifkin/blog.txt | 1 + challenge-244/ianrifkin/perl/ch-1.pl | 111 ++++++++++++++++++++++++++++ challenge-244/ianrifkin/perl/ch-2.pl | 100 ++++++++++++++++++++++++++ 4 files changed, 268 insertions(+), 79 deletions(-) create mode 100644 challenge-244/ianrifkin/blog.txt create mode 100644 challenge-244/ianrifkin/perl/ch-1.pl create mode 100644 challenge-244/ianrifkin/perl/ch-2.pl diff --git a/challenge-244/ianrifkin/README.md b/challenge-244/ianrifkin/README.md index 10bfcf4aa0..9e84586460 100644 --- a/challenge-244/ianrifkin/README.md +++ b/challenge-244/ianrifkin/README.md @@ -1,113 +1,90 @@ -# loop-de-loop +# And then a hero comes along -Challenge 243: https://theweeklychallenge.org/blog/perl-weekly-challenge-243/ +Challenge 244: https://theweeklychallenge.org/blog/perl-weekly-challenge-244/ -I decided to take what I think is a simple approcah to solving this week's problems (and I basically did the same approach in both tasks). +This task was during the week of American Thanksgiving so I may not be fully present with my responses. The first task seemed straightforward enough so let's start with that one. + +## Task 1: Count Smaller -## Task 1: Reverse Pairs ``` You are given an array of integers. -Write a script to return the number of reverse pairs in the given array. - -A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j]. +Write a script to calculate the number of integers smaller than the integer at each index. Example 1 -Input: @nums = (1, 3, 2, 3, 1) -Output: 2 - -(1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1 -(3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1 +Input: @int = (8, 1, 2, 2, 3) +Output: (4, 0, 1, 1, 3) + +For index = 0, count of elements less 8 is 4. +For index = 1, count of elements less 1 is 0. +For index = 2, count of elements less 2 is 1. +For index = 3, count of elements less 2 is 1. +For index = 4, count of elements less 3 is 3. Example 2 -Input: @nums = (2, 4, 3, 5, 1) -Output: 3 - -(1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1 -(2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1 -(3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1 +Input: @int = (6, 5, 4, 8) +Output: (2, 1, 0, 3) +Example 3 +Input: @int = (2, 2, 2) +Output: (0, 0, 0) ``` -I added some extra code to my solutions in support of features like supporting command-line input, but let's focus on the code that actually solves the task. - -I pass the `@nums` array to a subroutine `reverse_pairs` which has a nested `for` loop in it. We want to count how many times `$nums[$i]` is `>` `$nums[$j] * 2` where `$j` is any item after `$i` in the array. Since there is no point to look at an `$i` with no `$j` the parent loop should contain every array element except the last one: - +I solve this by looping through the `@int` array and creating an array for the output for each numbers total of numbers that are smaller than it (defaulting it to 0): ``` -for (my $i = 0; $i < @nums-1; $i++) +for (my $i=0; $i < @int; $i++) { + $int_out[$i] = 0; #default is no number is smaller than it ``` -Within the above loop I created a nested loop to compare `$nums[$i]` to every value after it in the array. We know that `$j` is after `$i` so the loop can start at the element after `$i` and continues to the end of the array: +Then I loop through the `@int` array again, this time to check each number in the array (except for itself) and increment the output number when needed: ``` -for (my $j = $i+1; $j < @nums; $j++) +for (my $j=0; $j < @int; $j++) { + $int_out[$i]++ if ($int[$i] > $int[$j] && $i != $j); +} ``` -Within that loop I increment a counter whenever `$nums[$i] > $nums[$j] * 2` - -The full sub is as follows: +That's it! Other than that it's just calling the sub and outputting it in the desired format. -``` -sub reverse_pairs { - my @nums = @_; - my $pairs_found = 0; - for (my $i = 0; $i < @nums-1; $i++) { - for (my $j = $i+1; $j < @nums; $j++) { - $pairs_found++ if ($nums[$i] > $nums[$j] * 2); - } - } - return $pairs_found; -} -``` +## Task 2: Group Hero -## Task 2: Floor Sum ``` -You are given an array of positive integers (>=1). +You are given an array of integers representing the strength. -Write a script to return the sum of floor(nums[i] / nums[j]) where 0 <= i,j < nums.length. The floor() function returns the integer part of the division. +Write a script to return the sum of the powers of all possible combinations; power is defined as the square of the largest number in a sequence, multiplied by the smallest. Example 1 -Input: @nums = (2, 5, 9) -Output: 10 - -floor(2 / 5) = 0 -floor(2 / 9) = 0 -floor(5 / 9) = 0 -floor(2 / 2) = 1 -floor(5 / 5) = 1 -floor(9 / 9) = 1 -floor(5 / 2) = 2 -floor(9 / 2) = 4 -floor(9 / 5) = 1 -Example 2 -Input: @nums = (7, 7, 7, 7, 7, 7, 7) -Output: 49 -``` +Input: @nums = (2, 1, 4) +Output: 141 -My solution to this task is very similar to my approach to solving task 1. Again I start with a loop of every array item, but this time the parent loop does include the last element in the array: -``` -for (my $i = 0; $i < @nums; $i++) -``` +Group 1: (2) => square(max(2)) * min(2) => 4 * 2 => 8 +Group 2: (1) => square(max(1)) * min(1) => 1 * 1 => 1 +Group 3: (4) => square(max(4)) * min(4) => 16 * 4 => 64 +Group 4: (2,1) => square(max(2,1)) * min(2,1) => 4 * 1 => 4 +Group 5: (2,4) => square(max(2,4)) * min(2,4) => 16 * 2 => 32 +Group 6: (1,4) => square(max(1,4)) * min(1,4) => 16 * 1 => 16 +Group 7: (2,1,4) => square(max(2,1,4)) * min(2,1,4) => 16 * 1 => 16 -Likewise, the nested loop within it needs to include every element (including where `$i == $j`) so it's basically the same loop as its parent: -``` -for (my $j = 0; $j < @nums; $j++) +Sum: 8 + 1 + 64 + 4 + 32 + 16 + 16 => 141 ``` -Within that loop I take the floor of `$nums[$i] / $nums[$j]` and add it to the sum of the previous values. To calculate the floor I was going to use the actual `floor()` from `POSIX` but just used `int()` -- I think it's good enough for this task but note that `int()` can sometimes produce counterintuitive results (see https://perldoc.perl.org/functions/int). +This task was a lot more challenging for me and I'm not entirely sure I am solving it in a sane manner, but I do appear to get the correct output. -The full sub is as follows: +I created a subroutine `group_hero` which accepts the input array. I then use `Algorithm::Combinatorics qw(partitions)` to create the different number combinations. Is this cheating? Maybe, but I'm okay with it. Don't worry, it's not the only "cheat" I used in this one. I also use `List::Util qw( min max )` to calculuate the min and max values in an array! +So I start byt creating the number combinations: `my @parts = partitions(\@nums);` + +The final array element in `@parts` is duplicative for our purposes so I ignore that. I loop through the rest of the parts: `for (my $i=0; $i<@parts-1; $i++) {` + +Each `$parts[$i]` is an array of the desired combinations so I loop through that: `foreach ( @{$parts[$i]} ) {` + +Within this final loop I calculate the min, max and perform the math: ``` -sub sum_floors { - my @nums = @_; - my $sum_floors = 0; - for (my $i = 0; $i < @nums; $i++) { - for (my $j = 0; $j < @nums; $j++) { - $sum_floors += int($nums[$i] / $nums[$j]); - } - } - return $sum_floors; -} +my $min = min @{$parts[0]}; +my $max = max @{$parts[0]}; +$group_hero += $max**2 * $min; ``` -The full code with comments is available at https://github.com/manwar/perlweeklychallenge-club/tree/master/challenge-243/ianrifkin \ No newline at end of file +Then at the conclusion I return `$group_hero` with the final number. + +--- +The full code with comments is available at https://github.com/manwar/perlweeklychallenge-club/tree/master/challenge-244/ianrifkin diff --git a/challenge-244/ianrifkin/blog.txt b/challenge-244/ianrifkin/blog.txt new file mode 100644 index 0000000000..39bffa2018 --- /dev/null +++ b/challenge-244/ianrifkin/blog.txt @@ -0,0 +1 @@ +https://github.com/manwar/perlweeklychallenge-club/tree/master/challenge-244/ianrifkin#readme diff --git a/challenge-244/ianrifkin/perl/ch-1.pl b/challenge-244/ianrifkin/perl/ch-1.pl new file mode 100644 index 0000000000..b41e0c1ae1 --- /dev/null +++ b/challenge-244/ianrifkin/perl/ch-1.pl @@ -0,0 +1,111 @@ +use v5.30.3; +use warnings; +use strict; +use Getopt::Long; +use Pod::Usage; +use Data::Dumper; + +# Task 1: Count Smaller + +my $man = 0; +my $help = 0; +my $str_input; +GetOptions ('help|?' => \$help, man => \$man, + "nums=s" => \$str_input + ) + or pod2usage(2); + +pod2usage(1) if $help; +pod2usage(-exitstatus => 0, -verbose => 2) if $man; + +# Prepare input array +my @int; +# if values provided at cmd line split on comma +if ( $str_input ) { + say reverse_pairs(split(/,/, $str_input)); +} +# else set default values from example if no cmd line input +else { + # Example 1 + @int = (8, 1, 2, 2, 3); + say count_smaller(@int); + + # Example 2 + @int = (6, 5, 4, 8); + say count_smaller(@int); + + # Example 3 + @int = (2, 2, 2); + say count_smaller(@int); +} + +sub count_smaller { + my @int = @_; + my @int_out; + + # Loop through each number in array to count how many numbers are smaller than it + for (my $i=0; $i < @int; $i++) { + $int_out[$i] = 0; #default is no number is smaller than it + # check each number in the array except for self + for (my $j=0; $j < @int; $j++) { + $int_out[$i]++ if ($int[$i] > $int[$j] && $i != $j); + } + } + + # Return the @output array in the desired format + $Data::Dumper::Terse = 1; #don't print VAR names + $Data::Dumper::Indent = 0; #keep output on one line + return '(' . join(',', Dumper(@int_out)) . ')'; +} + +__END__ + +=head1 Challenge 244, Task 1: Count Smaller, by IanRifkin + +You are given an array of integers. + +Write a script to calculate the number of integers smaller than the integer at each index. + +Example 1 +Input: @int = (8, 1, 2, 2, 3) +Output: (4, 0, 1, 1, 3) + +For index = 0, count of elements less 8 is 4. +For index = 1, count of elements less 1 is 0. +For index = 2, count of elements less 2 is 1. +For index = 3, count of elements less 2 is 1. +For index = 4, count of elements less 3 is 3. +Example 2 +Input: @int = (6, 5, 4, 8) +Output: (2, 1, 0, 3) +Example 3 +Input: @int = (2, 2, 2) +Output: (0, 0, 0) + +See https://theweeklychallenge.org/blog/perl-weekly-challenge-244/#TASK1 for more information on this challenge + +=head1 SYNOPSIS + +perl ./ch-1.pl [options] + +=head1 OPTIONS + +=over 8 + +=item B<-nums> + +A list of numbers + +=item B<-help> + +Print a brief help message and exits. + +=item B<-man> + +Prints the manual page and exits. + +=back + + + + diff --git a/challenge-244/ianrifkin/perl/ch-2.pl b/challenge-244/ianrifkin/perl/ch-2.pl new file mode 100644 index 0000000000..e15f62303b --- /dev/null +++ b/challenge-244/ianrifkin/perl/ch-2.pl @@ -0,0 +1,100 @@ +use v5.30.3; +use warnings; +use strict; +use Getopt::Long; +use Pod::Usage; +use Algorithm::Combinatorics qw(partitions); +use List::Util qw( min max ); +use Data::Dumper; + +# Task 2: Group Hero + +my $man = 0; +my $help = 0; +my $str_input; +GetOptions ('help|?' => \$help, man => \$man, + "nums=s" => \$str_input + ) + or pod2usage(2); + +pod2usage(1) if $help; +pod2usage(-exitstatus => 0, -verbose => 2) if $man; + +# Prepare input array +my @nums; +# if values provided at cmd line split on comma +if ( $str_input ) { + say reverse_pairs(split(/,/, $str_input)); +} +# else set default values from example if no cmd line input +else { + # Example 1 + @nums = (2, 1, 4); + say group_hero(@nums); +} + +sub group_hero { + my @nums = @_; + my $group_hero = 0; + + my @parts = partitions(\@nums); + for (my $i=0; $i<@parts-1; $i++) { + foreach ( @{$parts[$i]} ) { + my @parts = $_; + my $min = min @{$parts[0]}; + my $max = max @{$parts[0]}; + $group_hero += $max**2 * $min; + } + } + return $group_hero; +} + +__END__ + +=head1 Challenge 244, Task 2: Count Smaller, by IanRifkin + +You are given an array of integers representing the strength. + +Write a script to return the sum of the powers of all possible combinations; power is defined as the square of the largest number in a sequence, multiplied by the smallest. + +Example 1 +Input: @nums = (2, 1, 4) +Output: 141 + +Group 1: (2) => square(max(2)) * min(2) => 4 * 2 => 8 +Group 2: (1) => square(max(1)) * min(1) => 1 * 1 => 1 +Group 3: (4) => square(max(4)) * min(4) => 16 * 4 => 64 +Group 4: (2,1) => square(max(2,1)) * min(2,1) => 4 * 1 => 4 +Group 5: (2,4) => square(max(2,4)) * min(2,4) => 16 * 2 => 32 +Group 6: (1,4) => square(max(1,4)) * min(1,4) => 16 * 1 => 16 +Group 7: (2,1,4) => square(max(2,1,4)) * min(2,1,4) => 16 * 1 => 16 + +Sum: 8 + 1 + 64 + 4 + 32 + 16 + 16 => 141 + +See https://theweeklychallenge.org/blog/perl-weekly-challenge-244/#TASK2 for more information on this challenge + +=head1 SYNOPSIS + +perl ./ch-1.pl [options] + +=head1 OPTIONS + +=over 8 + +=item B<-nums> + +A list of numbers + +=item B<-help> + +Print a brief help message and exits. + +=item B<-man> + +Prints the manual page and exits. + +=back + + + + -- cgit From 0f5c6e2766bc5cdffb527197be49c85856c28fea Mon Sep 17 00:00:00 2001 From: Matthias Muth Date: Sun, 26 Nov 2023 18:37:33 +0100 Subject: Challenge 244 Task 1 and 2 solutions in Perl by Matthias Muth --- challenge-244/matthias-muth/README.md | 276 +------------------- challenge-244/matthias-muth/blog.txt | 1 + challenge-244/matthias-muth/perl/TestExtractor.pm | 287 +++++++++++++++++++++ challenge-244/matthias-muth/perl/ch-1.pl | 63 +++++ challenge-244/matthias-muth/perl/ch-2.pl | 140 ++++++++++ challenge-244/matthias-muth/perl/challenge-244.txt | 54 ++++ 6 files changed, 549 insertions(+), 272 deletions(-) create mode 100644 challenge-244/matthias-muth/blog.txt create mode 100644 challenge-244/matthias-muth/perl/TestExtractor.pm create mode 100755 challenge-244/matthias-muth/perl/ch-1.pl create mode 100755 challenge-244/matthias-muth/perl/ch-2.pl create mode 100644 challenge-244/matthias-muth/perl/challenge-244.txt diff --git a/challenge-244/matthias-muth/README.md b/challenge-244/matthias-muth/README.md index b86d074bcf..970c56c8bd 100644 --- a/challenge-244/matthias-muth/README.md +++ b/challenge-244/matthias-muth/README.md @@ -1,273 +1,5 @@ -# ComPAIRisons, optimized +**Challenge 244 solutions in Perl by Matthias Muth** +
+(no blog post this time...) -**Challenge 243 solutions in Perl by Matthias Muth** - -## Task 1: Reverse Pairs - -> You are given an array of integers.
-> Write a script to return the number of reverse pairs in the given array.
-> A reverse pair is a pair (i, j) where: a) 0 <= i < j < nums.length and b) nums[i] > 2 * nums[j].
->
-> Example 1
-> Input: @nums = (1, 3, 2, 3, 1)
-> Output: 2
-> (1, 4) => nums[1] = 3, nums[4] = 1, 3 > 2 * 1
-> (3, 4) => nums[3] = 3, nums[4] = 1, 3 > 2 * 1
->
-> Example 2
-> Input: @nums = (2, 4, 3, 5, 1)
-> Output: 3
-> (1, 4) => nums[1] = 4, nums[4] = 1, 4 > 2 * 1
-> (2, 4) => nums[2] = 3, nums[4] = 1, 3 > 2 * 1
-> (3, 4) => nums[3] = 5, nums[4] = 1, 5 > 2 * 1
- -This is a typical challenge task of the class *'Combine every number with every other'*.
-The obvious implementation is this: - -```perl -sub reverse_pairs( @nums ) { - my $count = 0; - for my $i ( 0 .. $#nums - 1 ) { - for my $j ( $i + 1 .. $#nums ) { - ++$count - if $nums[$i] > 2 * $nums[$j]; - } - } - return $count; -} -``` - -And it works fine out of the box. - -I have recently become a fan of using a more 'functional' approach in my programming, and Perl actually offers a lot in this regard. -It starts with `map` and `grep` that use code blocks for processing lists of data. Next, any novice Perl programmer will rapidly appreciate the power of `sort`, using a simple code block to compare any type of data, allowing for complex sorting criteria without large programming efforts. - -I also used to reckon that -So I changed my solution above into this: - -```perl -sub reverse_pairs_grep( @nums ) { - my $count = 0; - for my $i ( 0 .. $#nums - 1 ) { - $count += scalar grep { $nums[$i] > 2 * $nums[$_] } $i + 1 .. $#nums; - } - return $count; -} -``` - -The whole inner loop now is in one statement, hiding the inner `for` loop in the `grep`.
-To me, this also looks more efficient, because running the loop is now done 'under the hood', and can be implemented very efficiently. - -Out of curiosity, I made a little benchmark, using the `Benchmark` core module.
-I compared the two implementations, running the two small challenge examples in every iteration: - -``` - Rate reverse_pairs_grep reverse_pairs -reverse_pairs_grep 184719/s -- -3% -reverse_pairs 190023/s 3% -- -``` - -Woah??
-It seems that the `for` loop is more efficient than I expected!
-Or, put the other way round, `grep` does not necessarily beat a `for` loop! -Maybe it plays a role that the parameters need to be passed into `grep`, which might involve copying the list. -Ok, lesson learned, good to know that `for` or `foreach` is nothing that needs to be avoided. - -My curiosity then led me to try to see whether I could optimize the `for` loop version further.
-I exchanged the inner and the outer loop, from -```perl - for my $i ( 0 .. $#nums - 1 ) { - for my $j ( $i + 1 .. $#nums ) { -``` -to -```perl - for my $j ( 1 .. $#nums ) { - for my $i ( 0 .. $j - 1 ) { -``` -This is the result of the benchmark: -``` - Rate reverse_pairs reverse_pairs_reversed_loops -reverse_pairs 187361/s -- -11% -reverse_pairs_reversed_loops 211017/s 13% -- -``` -Whoa again!!
-The inside-out loop is faster than the original loop! - -The inner and the outer loop have the same number of iterations in both cases: - -`for $i` / `for $j` loop:
- `$i` iterations: $n - 1$
- all `$j` iterations: $(n-1) + (n-2) + \dots + 1 = \frac{(n-1)n}{2}$
- -`for $j` / `for $i` loop:
- `$j` iterations: $n - 1$
- all `$i` iterations: $1 + 2 + \dots + (n-1) = \frac{(n-1)n}{2}$
- -So the difference must be in the operations that are executed 'behind the scenes' implementing the iteration over the lists that are defined in the `for` statements. - -My speculation is that probably the inner loop expressions `$i + 1 ` and `$#nums` for the first version -are more expensive to evaluate than `0` and `$j - 1` for the faster second version.
-Which might make sense, because one might expect that the `$i + 1` and `$j - 1` complexity is the same, -and between `$#nums` and `0` it surely is more expensive to lookup the `@nums` array size than just using the constant `0`. - -As interesting as it may be to find why this 'optimization by chance' really works, -I expect that the performance difference will diminish when the `@num` array gets bigger. -So actually the 'out of the box' solution does a great job. - -## Task 2: Floor Sum - -> You are given an array of positive integers (>=1).
-> Write a script to return the sum of floor(nums[i] / nums[j]) where 0 <= i,j < nums.length. The floor() function returns the integer part of the division.
->
-> Example 1
-> Input: @nums = (2, 5, 9)
-> Output: 10
-> floor(2 / 5) = 0
-> floor(2 / 9) = 0
-> floor(5 / 9) = 0
-> floor(2 / 2) = 1
-> floor(5 / 5) = 1
-> floor(9 / 9) = 1
-> floor(5 / 2) = 2
-> floor(9 / 2) = 4
-> floor(9 / 5) = 1
->
-> Example 2
-> Input: @nums = (7, 7, 7, 7, 7, 7, 7)
-> Output: 49
- -This task, too, lets us *'combine every number with every other'*.
-So let's see whether what we've learned from Task 1 can be applied here!
-First, the obvious solution: - -```perl -sub floor_sum( @nums ) { - my $count = 0; - for my $i ( 0..$#nums ) { - for my $j ( 0..$#nums ) { - $count += int( $nums[$j] / $nums[$i] ); - } - } - return $count; -} -``` -Next, the '`grep`' version: -```perl -sub floor_sum_grep( @nums ) { - my $count = 0; - for my $i ( 0..$#nums ) { - $count += sum( map int( $nums[$_] / $nums[$i] ), 0..$#nums ); - } - return $count; -} -``` -And the benchmark comparing the two: -``` - Rate floor_sum_grep floor_sum -floor_sum_grep 70447/s -- -28% -floor_sum 97303/s 38% -- -``` - -The difference in favor of the `for` loop version is even more evident than in the previous task. -So let's stick with the `for` loops, for performance, and maybe also for readability. - -I didn't run a benchmark with the loops turned around for this version, -because the loops are really identical here (both from `0` to `$#num`), -so there's nothing to expect from that. - -**BUT!**
-There's another possible optimization, and it even has nothing to do with Perl and choosing the right language constructs.
-It actually is in the 'application domain'. - -Let's visualize all combinations of the first example's numbers $( 2, 5, 9 )$ in a matrix, -with the division results as the matrix values. The values are sorted in ascending order already, which we could do for any list of numbers we get. Note that in the first example, all numbers are unique. - -$$ -\begin{array}{c|c & c & c} - & 2 & 5 & 9 \\ - \hline - 2 & \text{int}(2/2) & \text{int}(2/5) & \text{int}(2/9) \\ - 5 & \text{int}(5/2) & \text{int}(5/5) & \text{int}(5/9) \\ - 9 & \text{int}(9/2) & \text{int}(9/5) & \text{int}(9/9) \\ - \end{array} -$$ - -From which we get these values to add up: - -$$ -\begin{array}{c|c & c & c} - & 2 & 5 & 9 \\ - \hline - 2 & {\color{blue}1} & {\color{green}0} & {\color{green}0} \\ - 5 & {\color{orange}2} & {\color{blue}1} & {\color{green}0} \\ - 9 & {\color{orange}4} & {\color{orange}1} & {\color{blue}1} \\ - \end{array} -$$ - -I have chosen colors for different parts of the matrix:
- -${\color{blue}Blue}$ for the diagonal.
-All its values are always ${\color{blue}1}$. - -${\color{green}Green}$ for the upper right part of the matrix. -All its values are ${\color{green}0}$, because the dividend is always smaller than the divisor (remembering that the numbers are sorted in ascending order). - -${\color{orange}Orange}$ is the lower left part of the matrix. Here, we really need to divide the two numbers. We will get a non-zero result, because the divident is bigger than the divisor. - -This means that we can reduce our loops to the lower left part of the matrix, because only there we will get significant numbers to add to our final result. -For the values of ${\color{blue}1}$ in the diagonal we add the matrix size (which is the length of the diagonal), and we are done. - -Now what if the numbers are not unique, as in the second example? - -In that case, a value will appear more than once, and it will be combined with its duplicate of the same value. We will encounter a division of $int(value/value) = 1$. The thing is that if that happens, there will also be a $1$ in the upper right part of the matrix at the same place. There, the values will be combined the other way round, but $int(value/value)$ will still be $1$. - -This means that when we do the division, and the two values are the same, we add ${\color{orange}2}$ instead of ${\color{orange}1}$ to account for that. We don't actually need to do a division in that case. - -Here is how this looks in code: - -```perl -sub floor_sum_half_matrix( @nums ) { - @nums = sort { $a <=> $b } @nums; - my $count = 0; - for my $i ( 0 .. $#nums - 1 ) { - # Loop over larger or equal values only. - for my $j ( $i + 1 .. $#nums ) { - # Add 2 if the values are equal, - # because each of $a/$b and $b/$a is 1. - $count += $nums[$j] == $nums[$i] ? 2 : int( $nums[$j] / $nums[$i] ); - } - } - # Add 1 for each field in the diagonal. - return $count + scalar @nums; -} -``` - -The benchmark looks as if the change was worth it: -``` - Rate floor_sum floor_sum_half_matrix -floor_sum 95836/s -- -40% -floor_sum_half_matrix 158906/s 66% -- -``` - -We then can squeeze out the last 3% by doing the 'reverse loop' trick from the previous task: - -```perl -sub floor_sum_half_matrix_reversed( @nums ) { - ... - for my $j ( 1 .. $#nums ) { - for my $i ( 0 .. $j - 1 ) { - ... - } - } - ... -} -``` -``` - Rate floor_sum floor_sum_half_matrix floor_sum_half_matrix_reversed -floor_sum 97713/s -- -38% -40% -floor_sum_half_matrix 158752/s 62% -- -3% -floor_sum_half_matrix_reversed 163793/s 68% 3% -- -``` -But this doesn't change a lot anymore, and knowing that my laptop can run the *Weekly Challenge 243 Task 2* examples in Perl around 160,000 times in one second is enough to give me a smile... :-) - -#### **Thank you for the challenge!** +**Thank you for the challenge!** diff --git a/challenge-244/matthias-muth/blog.txt b/challenge-244/matthias-muth/blog.txt new file mode 100644 index 0000000000..0e3d2eda1e --- /dev/null +++ b/challenge-244/matthias-muth/blog.txt @@ -0,0 +1 @@ +https://github.com/MatthiasMuth/perlweeklychallenge-club/tree/muthm-244/challenge-244/matthias-muth#readme diff --git a/challenge-244/matthias-muth/perl/TestExtractor.pm b/challenge-244/matthias-muth/perl/TestExtractor.pm new file mode 100644 index 0000000000..63bd4707a4 --- /dev/null +++ b/challenge-244/matthias-muth/perl/TestExtractor.pm @@ -0,0 +1,287 @@ +# +# The Weekly Challenge - Perl & Raku +# (https://theweeklychallenge.org) +# +# The Test Data Extraction Machine (tm). +# +# Perl solution by Matthias Muth. +# + +use strict; +use warnings; +use feature 'say'; +use feature 'signatures'; +no warnings 'experimental::signatures'; + +package TestExtractor; +use Exporter 'import'; +our @EXPORT = qw( + run_tests + run_tests_for_subs + $verbose %options vprint vsay + done_testing + pp np carp croak +); + +use Data::Dump qw( pp ); +use Data::Printer; +use Getopt::Long; +use Cwd qw( abs_path ); +use File::Basename; +use List::Util qw( any ); +use Carp; +use Test2::V0 qw( -no_srand ); +use Carp; +no warnings 'experimental::signatures'; + +our ( $verbose, %options ); +sub vprint { print @_ if $verbose }; +sub vsay { say @_ if $verbose }; + +sub extract_all_tests() { + + my $dir = dirname abs_path $0; + my ( $challenge, $task ) = + abs_path( $0 ) =~ m{challenge-(\d+) .* (\d+)[^[/\\]*$}x; + unless ( $challenge && $task ) { + say STDERR "ERROR: ", + "Cannot determine challenge number or task number. Exiting."; + exit 1; + } + + my $loc