aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBob Lied <boblied+github@gmail.com>2024-08-18 20:15:10 -0500
committerBob Lied <boblied+github@gmail.com>2024-08-18 20:15:10 -0500
commit16d0a043e6e2abf93c061bdcb21b3197d24ee43e (patch)
treef5bc28cbf328d481972789629b911050c9d1371a
parent1ec5389949cde3e7cae71c1c6298759adc5b9b1b (diff)
downloadperlweeklychallenge-club-16d0a043e6e2abf93c061bdcb21b3197d24ee43e.tar.gz
perlweeklychallenge-club-16d0a043e6e2abf93c061bdcb21b3197d24ee43e.tar.bz2
perlweeklychallenge-club-16d0a043e6e2abf93c061bdcb21b3197d24ee43e.zip
Week 283 initial solutions
-rw-r--r--challenge-283/bob-lied/README6
-rw-r--r--challenge-283/bob-lied/perl/ch-1.pl64
-rw-r--r--challenge-283/bob-lied/perl/ch-2.pl64
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 { },
+ });
+}