diff options
| author | Bob Lied <boblied+github@gmail.com> | 2024-08-18 20:15:10 -0500 |
|---|---|---|
| committer | Bob Lied <boblied+github@gmail.com> | 2024-08-18 20:15:10 -0500 |
| commit | 16d0a043e6e2abf93c061bdcb21b3197d24ee43e (patch) | |
| tree | f5bc28cbf328d481972789629b911050c9d1371a | |
| parent | 1ec5389949cde3e7cae71c1c6298759adc5b9b1b (diff) | |
| download | perlweeklychallenge-club-16d0a043e6e2abf93c061bdcb21b3197d24ee43e.tar.gz perlweeklychallenge-club-16d0a043e6e2abf93c061bdcb21b3197d24ee43e.tar.bz2 perlweeklychallenge-club-16d0a043e6e2abf93c061bdcb21b3197d24ee43e.zip | |
Week 283 initial solutions
| -rw-r--r-- | challenge-283/bob-lied/README | 6 | ||||
| -rw-r--r-- | challenge-283/bob-lied/perl/ch-1.pl | 64 | ||||
| -rw-r--r-- | challenge-283/bob-lied/perl/ch-2.pl | 64 |
3 files changed, 131 insertions, 3 deletions
diff --git a/challenge-283/bob-lied/README b/challenge-283/bob-lied/README index 5d935bad60..56099381f7 100644 --- a/challenge-283/bob-lied/README +++ b/challenge-283/bob-lied/README @@ -1,4 +1,4 @@ -Solutions to weekly challenge 281 by Bob Lied +Solutions to weekly challenge 283 by Bob Lied -https://perlweeklychallenge.org/blog/perl-weekly-challenge-281/ -https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-281/bob-lied +https://perlweeklychallenge.org/blog/perl-weekly-challenge-283/ +https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-283/bob-lied diff --git a/challenge-283/bob-lied/perl/ch-1.pl b/challenge-283/bob-lied/perl/ch-1.pl new file mode 100644 index 0000000000..69d53c7187 --- /dev/null +++ b/challenge-283/bob-lied/perl/ch-1.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2024, Bob Lied +#============================================================================= +# ch-1.pl Perl Weekly Challenge 283 Task 1 Unique Number +#============================================================================= +# You are given an array of integers, @ints, where every element +# appears more than once except one element. +# Write a script to find the one element that appears exactly one time. +# Example 1 Input: @ints = (3, 3, 1) Output: 1 +# Example 2 Input: @ints = (3, 2, 4, 2, 4) Output: 3 +# Example 3 Input: @ints = (1) Output: 1 +# Example 4 Input: @ints = (4, 3, 1, 1, 1, 4) 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); +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +say uniqNum(@ARGV) // "none"; + +sub uniqNum(@ints) +{ + my %appear; + $appear{$_}++ for @ints; + my @candidate = grep { $appear{$_} == 1 } keys %appear; + if ( @candidate > 1 ) { return "multiple"; } + elsif ( @candidate == 1 ) { return $candidate[0]; } + else { return "none"; } +} + +sub runTest +{ + use Test2::V0; + + is( uniqNum(3, 3, 1), 1, "Example 1"); + is( uniqNum(3, 2, 4, 2, 4), 3, "Example 2"); + is( uniqNum(1), 1, "Example 3"); + is( uniqNum(4, 3, 1, 1, 1, 4), 3, "Example 4"); + + is( uniqNum(1, 2, 3), "multiple", "Multiple unique numbers"); + is( uniqNum(8, 8, 8), "none", "No unique numbers"); + is( uniqNum( ), "none", "Empty list"); + + done_testing; +} + +sub runBenchmark($repeat) +{ + use Benchmark qw/cmpthese/; + + cmpthese($repeat, { + label => sub { }, + }); +} diff --git a/challenge-283/bob-lied/perl/ch-2.pl b/challenge-283/bob-lied/perl/ch-2.pl new file mode 100644 index 0000000000..7691fd9a28 --- /dev/null +++ b/challenge-283/bob-lied/perl/ch-2.pl @@ -0,0 +1,64 @@ +#!/usr/bin/env perl +# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu: +#============================================================================= +# Copyright (c) 2024, Bob Lied +#============================================================================= +# ch-2.pl Perl Weekly Challenge 283 Task 2 Digit Count Value +#============================================================================= +# You are given an array of positive integers, @ints. +# Write a script to return true if for every index i in the range +# 0 <= i < size of array, the digit i occurs exactly the $ints[$i] +# times in the given array otherwise return false. +# Example 1 Input: @ints = (1, 2, 1, 0) +# Output: true +# $ints[0] = 1, the digit 0 occurs exactly 1 time. +# $ints[1] = 2, the digit 1 occurs exactly 2 times. +# $ints[2] = 1, the digit 2 occurs exactly 1 time. +# $ints[3] = 0, the digit 3 occurs 0 time. +# Example 2 Input: @ints = (0, 3, 0) +# Output: false +# $ints[0] = 0, the digit 0 occurs 2 times rather than 0 time. +# $ints[1] = 3, the digit 1 occurs 0 time rather than 3 times. +# $ints[2] = 0, the digit 2 occurs exactly 0 time. +#============================================================================= + +use v5.40; + +use Getopt::Long; +my $Verbose = false; +my $DoTest = false; +my $Benchmark = 0; + +GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$Benchmark); +exit(!runTest()) if $DoTest; +exit( runBenchmark($Benchmark) ) if $Benchmark; + +say digCountVal(@ARGV) ? "true" : "false"; + +sub digCountVal(@ints) +{ + my @appear = (0) x scalar(@ints); + $appear[$_]++ for @ints; + + use List::Util qw/all/; + return all { $appear[$_] == $ints[$_] } 0 .. $#ints; +} + +sub runTest +{ + use Test2::V0; + + is( digCountVal(1,2,1,0), true, "Example 1"); + is( digCountVal(0,3,0 ), false, "Example 1"); + + done_testing; +} + +sub runBenchmark($repeat) +{ + use Benchmark qw/cmpthese/; + + cmpthese($repeat, { + label => sub { }, + }); +} |
