Merge pull request #10695 from boblied/w283

Week 283 solutions from Bob Lied

3 files changed, 179 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..9e02d1fd2d
--- /dev/null
+++ b/challenge-283/bob-lied/perl/ch-1.pl
@@ -0,0 +1,83 @@
+#!/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 un2(@ints)
+{
+    use List::MoreUtils qw/singleton/;
+    my @candidate = singleton(@ints);
+    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");
+
+    is( un2(3, 3, 1), 1,          "Example 1");
+    is( un2(3, 2, 4, 2, 4), 3,    "Example 2");
+    is( un2(1), 1,                "Example 3");
+    is( un2(4, 3, 1, 1, 1, 4), 3, "Example 4");
+    is( un2(1, 2, 3), "multiple", "Multiple unique numbers");
+    is( un2(8, 8, 8), "none",     "No unique numbers");
+    is( un2(       ), "none",     "Empty list");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my @ints = ( (1..100), (1..99) );
+
+    cmpthese($repeat, {
+            hash => sub { uniqNum(@ints) },
+            util => sub { un2(@ints) },
+        });
+}
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..e42d9fac7c
--- /dev/null
+++ b/challenge-283/bob-lied/perl/ch-2.pl
@@ -0,0 +1,93 @@
+#!/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;
+
+    my $i = 0;
+    for ( @ints )
+    {
+        return false if $appear[$i++] != $_;
+    }
+    return true;
+}
+
+use List::Util qw/all/;
+use List::MoreUtils qw/frequency/;
+sub dc2(@ints)
+{
+    my %freq;
+    %freq = frequency(@ints);
+    return all { ($freq{$_} // 0) == $ints[$_] } 0 .. $#ints;
+}
+
+sub dc3(@ints)
+{
+    my %freq;
+    %freq = frequency(@ints);
+    my $i;
+    return all { ($freq{$i++} // 0) == $_ } @ints;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( digCountVal(1,2,1,0), true,  "Example 1");
+    is( digCountVal(0,3,0  ), false, "Example 2");
+    is( dc2(1,2,1,0), true,  "Example 1 dc2");
+    is( dc2(0,3,0  ), false, "Example 2 dc2");
+    is( dc3(1,2,1,0), true,  "Example 1 dc3");
+    is( dc3(0,3,0  ), false, "Example 2 dc3");
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my @ints = (1, 1, 3, 1, 0, 0, 0, 0 );
+
+    cmpthese($repeat, {
+            array => sub { digCountVal(@ints) },
+            util  => sub { dc2(@ints) },
+            index => sub { dc3(@ints) },
+        });
+}