From 7566d1623c7a91133d96d2b31732194a72536789 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Thu, 2 Nov 2023 08:11:48 -0500 Subject: Week 241 solutions --- challenge-241/bob-lied/README | 6 +-- challenge-241/bob-lied/blog.txt | 0 challenge-241/bob-lied/perl/ch-1.pl | 79 +++++++++++++++++++++++++++++++++++++ challenge-241/bob-lied/perl/ch-2.pl | 47 ++++++++++++++++++++++ 4 files changed, 129 insertions(+), 3 deletions(-) create mode 100644 challenge-241/bob-lied/blog.txt create mode 100644 challenge-241/bob-lied/perl/ch-1.pl create mode 100644 challenge-241/bob-lied/perl/ch-2.pl diff --git a/challenge-241/bob-lied/README b/challenge-241/bob-lied/README index 152add2898..9391e2c242 100644 --- a/challenge-241/bob-lied/README +++ b/challenge-241/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 240 by Bob Lied +Solutions to weekly challenge 241 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-240/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-240/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-241/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-241/bob-lied diff --git a/challenge-241/bob-lied/blog.txt b/challenge-241/bob-lied/blog.txt new file mode 100644 index 0000000000..e69de29bb2 diff --git a/challenge-241/bob-lied/perl/ch-1.pl b/challenge-241/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..ad968e7bc3 --- /dev/null +++ b/challenge-241/bob-lied/perl/ch-1.pl @@ -0,0 +1,79 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-1.pl Perl Weekly Challenge 241 Task 1 Arithmetic Triplets +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array (3 or more members) of integers in increasing +# order and a positive integer. Write a script to find out the number +# of unique Arithmetic Triplets satisfying the following rules: +# a) i < j < k +# b) nums[j] - nums[i] == diff +# c) nums[k] - nums[j] == diff +# Example 1 Input: @nums = (0, 1, 4, 6, 7, 10) $diff = 3 +# Output: 2 +# Index (1, 2, 4) is an arithmetic triplet +# because both 7 - 4 == 3 and 4 - 1 == 3. +# Index (2, 4, 5) is an arithmetic triplet +# because both 10 - 7 == 3 and 7 - 4 == 3. +# Example 2 Input: @nums = (4, 5, 6, 7, 8, 9) $diff = 2 +# Output: 2 +# (0, 2, 4) is an arithmetic triplet with difference 2 +# (1, 3, 5) is an arithmetic triplet with difference 2 +#============================================================================= + +use v5.38; + +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +my $Diff; + +GetOptions("diff:i" => \$Diff, "test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +die "Usage: $0 -d DIFF m n o ..." unless defined $Diff && @ARGV > 0; + +say triplet($Diff, @ARGV); + +sub triplet($diff, @nums) +{ + my $count = 0; + my @show; + for ( my $i = 0 ; $i <= $#nums-2; $i++ ) + { + for ( my $j = $i+1; $j <= $#nums-1; $j++ ) + { + for ( my $k = $j+1; $k <= $#nums ; $k++ ) + { + if ( $nums[$k] - $nums[$j] == $diff + && $nums[$j] - $nums[$i] == $diff ) + { + $count++; + push @show, [ $i, $j, $k ] if $Verbose; + } + } + } + } + if ( $Verbose ) + { + for my $triplet ( @show ) + { + local $" = ", "; + say "\@nums[$triplet->@*] = ( @nums[$triplet->@*] )"; + } + } + return $count; +} + +sub runTest +{ + use Test2::V0; + + is( triplet(3, 0,1,4,6,7,10), 2, "Example 1"); + is( triplet(2, 4,5,6,7,8,9 ), 2, "Example 2"); + + done_testing; +} diff --git a/challenge-241/bob-lied/perl/ch-2.pl b/challenge-241/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..ee37342218 --- /dev/null +++ b/challenge-241/bob-lied/perl/ch-2.pl @@ -0,0 +1,47 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# ch-2.pl Perl Weekly Challenge 241 Task 2 Prime Order +#============================================================================= +# Copyright (c) 2023, Bob Lied +#============================================================================= +# You are given an array of unique positive integers greater than 2. +# Write a script to sort them in ascending order of the count of their +# prime factors, tie-breaking by ascending value. +# Example 1 Input: @int = (11, 8, 27, 4) +# Output: (11, 4, 8, 27)) +# Prime factors of 11 => 11 +# Prime factors of 4 => 2, 2 +# Prime factors of 8 => 2, 2, 2 +# Prime factors of 27 => 3, 3, 3 +#============================================================================= + +use v5.38; + +use Math::Prime::Util qw/factor/; +use Getopt::Long; +my $Verbose = 0; +my $DoTest = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose); +exit(!runTest()) if $DoTest; + +say "(", join(", ", primeOrder(@ARGV)->@*), ")"; + +sub primeOrder(@int) +{ + [ + map { $_->[0] } + sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0] } + map { [ $_, scalar(factor($_)) ] } @int + ] +} + +sub runTest +{ + use Test2::V0; + + is( primeOrder(11, 8, 27, 4), [ 11, 4, 8, 27 ], "Example 1"); + + done_testing; +} -- cgit From 29f7e5df704c38565548f328b4b2142450260ad8 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Thu, 2 Nov 2023 08:39:55 -0500 Subject: Slight optimization to avoid third loop --- challenge-241/bob-lied/perl/ch-1.pl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/challenge-241/bob-lied/perl/ch-1.pl b/challenge-241/bob-lied/perl/ch-1.pl index ad968e7bc3..28954dc13b 100644 --- a/challenge-241/bob-lied/perl/ch-1.pl +++ b/challenge-241/bob-lied/perl/ch-1.pl @@ -46,10 +46,10 @@ sub triplet($diff, @nums) { for ( my $j = $i+1; $j <= $#nums-1; $j++ ) { + next unless $nums[$j] - $nums[$i] == $diff; for ( my $k = $j+1; $k <= $#nums ; $k++ ) { - if ( $nums[$k] - $nums[$j] == $diff - && $nums[$j] - $nums[$i] == $diff ) + if ( $nums[$k] - $nums[$j] == $diff ) { $count++; push @show, [ $i, $j, $k ] if $Verbose; @@ -61,7 +61,6 @@ sub triplet($diff, @nums) { for my $triplet ( @show ) { - local $" = ", "; say "\@nums[$triplet->@*] = ( @nums[$triplet->@*] )"; } } -- cgit From a01357c96a9bc6f4425e77a5254419e4f603a7b9 Mon Sep 17 00:00:00 2001 From: Bob Lied Date: Thu, 2 Nov 2023 19:00:44 -0500 Subject: Optimization to end loop early once difference can't be achieved --- challenge-241/bob-lied/perl/ch-1.pl | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/challenge-241/bob-lied/perl/ch-1.pl b/challenge-241/bob-lied/perl/ch-1.pl index 28954dc13b..efb05edce9 100644 --- a/challenge-241/bob-lied/perl/ch-1.pl +++ b/challenge-241/bob-lied/perl/ch-1.pl @@ -46,10 +46,17 @@ sub triplet($diff, @nums) { for ( my $j = $i+1; $j <= $#nums-1; $j++ ) { - next unless $nums[$j] - $nums[$i] == $diff; + my $dj = $nums[$j] - $nums[$i]; + + # Input is sorted, so stop once the difference is too big. + last if $dj > $diff; + next unless $dj == $diff; + for ( my $k = $j+1; $k <= $#nums ; $k++ ) { - if ( $nums[$k] - $nums[$j] == $diff ) + my $dk = $nums[$k] - $nums[$j]; + last if $dk > $diff; + if ( $dk == $diff ) { $count++; push @show, [ $i, $j, $k ] if $Verbose; -- cgit