diff options
| author | Bob Lied <boblied+github@gmail.com> | 2025-06-23 08:38:52 -0500 |
|---|---|---|
| committer | Bob Lied <boblied+github@gmail.com> | 2025-06-23 08:38:52 -0500 |
| commit | ea9d20e7f81b548f49d778fd12865cfaf3692513 (patch) | |
| tree | 6b82b9db4644b52d5dfc9578410766b94278c6a0 | |
| parent | 99d8fa43930abb471fac2b94b68c0785619b37fc (diff) | |
| download | perlweeklychallenge-club-ea9d20e7f81b548f49d778fd12865cfaf3692513.tar.gz perlweeklychallenge-club-ea9d20e7f81b548f49d778fd12865cfaf3692513.tar.bz2 perlweeklychallenge-club-ea9d20e7f81b548f49d778fd12865cfaf3692513.zip | |
Week 327 solutions
| -rw-r--r-- | challenge-327/bob-lied/README.md | 6 | ||||
| -rw-r--r-- | challenge-327/bob-lied/perl/ch-1.pl | 69 | ||||
| -rw-r--r-- | challenge-327/bob-lied/perl/ch-2.pl | 77 |
3 files changed, 149 insertions, 3 deletions
diff --git a/challenge-327/bob-lied/README.md b/challenge-327/bob-lied/README.md index 7152e056f1..13e20a4e1e 100644 --- a/challenge-327/bob-lied/README.md +++ b/challenge-327/bob-lied/README.md @@ -1,4 +1,4 @@ -# Solutions to weekly challenge 326 by Bob Lied +# Solutions to weekly challenge 327 by Bob Lied -## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-326/) -## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-326/bob-lied) +## [PWC](https://perlweeklychallenge.org/blog/perl-weekly-challenge-327/) +## [GitHub](https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-327/bob-lied) diff --git a/challenge-327/bob-lied/perl/ch-1.pl b/challenge-327/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..b8944059ec --- /dev/null +++ b/challenge-327/bob-lied/perl/ch-1.pl @@ -0,0 +1,69 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2025, Bob Lied +#============================================================================= +# ch-1.pl Perl Weekly Challenge 327 Task 1 Missing Integers +#============================================================================= +# You are given an array of n integers. Write a script to find all the +# missing integers in the range 1..n in the given array. +# Example 1 Input: @ints = (1, 2, 1, 3, 2, 5) +# Output: (4, 6) +# The given array has 6 elements. So we are looking for integers in the +# range 1..6 in the given array. The missing integers: (4, 6) +# Example 2 Input: @ints = (1, 1, 1) +# Output: (2, 3) +# Example 3 Input: @ints = (2, 2, 1) +# Output: (3) +#============================================================================= + +use v5.40; + + +use Getopt::Long; +my $Verbose = false; +my $DoTest = false; +my $Benchmark = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark); +my $logger; +{ + use Log::Log4perl qw(:easy); + Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ), + layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" }); + $logger = Log::Log4perl->get_logger(); +} +#============================================================================= + +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +say '(', join(', ', missing(@ARGV)), ')'; + +#============================================================================= +sub missing(@ints) +{ + my @present = (true, (false) x @ints); + $present[$_] = true for @ints; + return grep { not $present[$_] } 1 .. $#present; +} + +sub runTest +{ + use Test2::V0; + + is( [ missing(1,2,1,3,2,5) ], [4,6], "Example 1"); + is( [ missing(1,1,1) ], [2,3], "Example 2"); + is( [ missing(2,2,1) ], [3 ], "Example 3"); + + done_testing; +} + +sub runBenchmark($repeat) +{ + use Benchmark qw/cmpthese/; + + cmpthese($repeat, { + label => sub { }, + }); +} diff --git a/challenge-327/bob-lied/perl/ch-2.pl b/challenge-327/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..ab68f2ba37 --- /dev/null +++ b/challenge-327/bob-lied/perl/ch-2.pl @@ -0,0 +1,77 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2025, Bob Lied +#============================================================================= +# ch-2.pl Perl Weekly Challenge 327 Task 2 MAD +#============================================================================= +# You are given an array of distinct integers. Write a script to find all +# pairs of elements with minimum absolute difference (MAD) of any two elements. +# Example 1 Input: @ints = (4, 1, 2, 3) +# Output: [1,2], [2,3], [3,4] +# The minimum absolute difference is 1. Pairs with MAD: [1,2], [2,3], [3,4] +# Example 2 Input: @ints = (1, 3, 7, 11, 15) +# Output: [1,3] +# Example 3 Input: @ints = (1, 5, 3, 8) +# Output: [1,3], [3,5] +#============================================================================= + +use v5.40; + + +use Getopt::Long; +my $Verbose = false; +my $DoTest = false; +my $Benchmark = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark); +my $logger; +{ + use Log::Log4perl qw(:easy); + Log::Log4perl->easy_init({ level => ($Verbose ? $DEBUG : $INFO ), + layout => "%d{HH:mm:ss.SSS} %p{1} %m%n" }); + $logger = Log::Log4perl->get_logger(); +} +#============================================================================= + +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +say join ", ", map { "[$_->[0],$_[1]]" } mad(@ARGV); + +#============================================================================= +sub mad(@ints) +{ + use List::Util qw/max/; + + my $mindiff = max @ints; + @ints = sort { $a <=> $b } @ints; + my @diff; + for my $i ( 1 .. $#ints ) + { + my $d = $diff[$i] = abs( $ints[$i] - $ints[$i-1] ); + $mindiff = $d if $d < $mindiff; + } + return [ map { [ $ints[$_-1], $ints[$_] ] } + grep { $diff[$_] == $mindiff } 1 .. $#ints ]; +} + +sub runTest +{ + use Test2::V0; + + is( mad(4,1,2,3), [ [1,2], [2,3], [3,4] ], "Example 1"); + is( mad(1,3,7.11,15), [ [1,3] ], "Example 2"); + is( mad(1,5,3,8), [ [1,3], [3,5] ], "Example 3"); + + done_testing; +} + +sub runBenchmark($repeat) +{ + use Benchmark qw/cmpthese/; + + cmpthese($repeat, { + label => sub { }, + }); +} |
