Week 245 solutions

3 files changed, 202 insertions, 3 deletions

diff --git a/challenge-245/bob-lied/README b/challenge-245/bob-lied/README
index da2fb43649..80369a7f70 100644
--- a/challenge-245/bob-lied/README
+++ b/challenge-245/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 244 by Bob Lied
+Solutions to weekly challenge 245 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-244/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-244/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-245/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-245/bob-lied
diff --git a/challenge-245/bob-lied/perl/ch-1.pl b/challenge-245/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..6e266aacb7
--- /dev/null
+++ b/challenge-245/bob-lied/perl/ch-1.pl
@@ -0,0 +1,93 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge 245 Task 1 Language Sort
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given two array of languages and its popularity.
+# Write a script to sort the language based on popularity.
+# Example 1 Input: @lang = ('perl', 'c', 'python')
+#                  @popularity = (2, 1, 3)
+#           Output: ('c', 'perl', 'python')
+# Example 2 Input: @lang = ('c++', 'haskell', 'java')
+#                  @popularity = (1, 3, 2)
+#           Output: ('c++', 'java', 'haskell')
+# ---------
+# The @popularity array tells us where to move things.  For example 1,
+# it tells us that the language in position 1 should move to position 2,
+# the language in position 2 should move to position 1, and the language in
+# position 3 should move to position 3.
+#
+# @lang       perl    c       python
+#             [1]     [2]     [3]
+#               \      /       |            
+#              --\-----        |
+#             /   +___         |
+#             |       \        |
+# @popularity [1]=2   [2]=1   [3]=3
+#             |        |       |
+# @output     c       perl    python
+#             [1]     [2]     [3]
+# =============================================================================
+
+use v5.38;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+my $DoBenchmark = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose, "benchmark:i" => \$DoBenchmark);
+exit(!runTest()) if $DoTest;
+exit( runBenchmark($DoBenchmark) );
+
+sub langSort_M($lang, $popularity)
+{
+    my @place;
+    # Use map to shift to 0-based indexing.  Use a hash slice to select where
+    # each of the positions is supposed to move to.
+    @place[ map { $_ - 1 } $popularity->@* ] = 0 .. $lang->$#*;
+    # Return (a reference to) a hash slice of the calculated positions.
+    return [ $lang->@[@place] ];
+}
+
+sub langSort_S($lang, $popularity)
+{
+    # Sort positions by popularity, and alphabetically if tied.
+    # Use a hash slice to select the new positions.
+    [ $lang->@[ sort { $popularity->[$a] <=> $popularity->[$b]
+                     || $lang->[$a] cmp $lang->[$b] } 0 .. $lang->$#* ] ]
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    for my $version ( \&langSort_M, \&langSort_S )
+    {
+
+    is( $version->( [<perl c python >],   [2,1,3] ), [<c perl python   >], "Example 1");
+    is( $version->( ['c++', 'haskell', 'java'], [1,3,2] ), ['c++', 'java', 'haskell'], "Example 2");
+
+    is( $version->( [qw(a b c d e)], [1..5] ), [qw(a b c d e)], "More than 3");
+    is( $version->( [qw(a b c d e)], [5,4,3,2,1] ), [qw(e d c b a)], "More than 3 backwards");
+    is( $version->( [qw(a b c d e)], [5,1,3,2,4] ), [qw(b d c e a)], "More than 3 shuffled");
+
+    }
+
+    done_testing;
+}
+
+sub runBenchmark($repeat)
+{
+    use Benchmark qw/cmpthese/;
+
+    my @name = ('a' .. 'z', 'A' .. 'Z') x 10;
+    my @order =  reverse 1 .. @name;
+
+    cmpthese($repeat, {
+            "mapping" => sub { langSort_M(\@name, \@order) },
+            "sorting" => sub { langSort_S(\@name, \@order) },
+    });
+}
diff --git a/challenge-245/bob-lied/perl/ch-2.pl b/challenge-245/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..2e57b82b29
--- /dev/null
+++ b/challenge-245/bob-lied/perl/ch-2.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge 245 Task 2 Largest of Three
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an array of integers >= 0.
+# Write a script to return the largest number formed by concatenating
+# some of the given integers in any order which is also multiple of 3.
+# Return -1 if none found.
+# Example 1 Input: @ints = (8, 1, 9)
+#           Output: 981  because 981 % 3 == 0
+# Example 2 Input: @ints = (8, 6, 7, 1, 0)
+#           Output: 8760
+# Example 3 Input: @ints = (1)
+#           Output: -1
+#----------
+# Note that all the examples show single digit integers, but the problem
+# says integers in general.
+#=============================================================================
+
+use v5.38;
+use builtin qw/true false/; no warnings "experimental::builtin";
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+{
+use List::Util qw/all/;
+die "Numbers must be >= 0" unless all { $_ >= 0 } @ARGV;
+}
+
+say big3(@ARGV);
+
+sub is3($n) { join("", @$n) % 3 == 0 }
+
+sub _big3($ints, $indent)
+{
+    say "${indent}Enter (@$ints)" if $Verbose;
+    return -1 unless @$ints;
+    if ( is3($ints) )
+    {
+        say "${indent}Found @$ints" if $Verbose;
+        return 0 + join("", @$ints);
+    }
+
+    # Single digits fail at this point
+    return -1 if @$ints == 1;
+
+    # Try removing the smallest numbers first.
+    # ints is known to be sorted descending.
+    for ( my $exclude = $ints->$#* ; $exclude >= 0 ; $exclude-- )
+    {
+        # Never remove a zero; they will make the number 10 times bigger
+        next if $ints->[$exclude] == 0;
+
+        my @smaller = ( $ints->@[0 .. $exclude-1], $ints->@[$exclude+1 .. $ints->$#*] );
+        if ( is3( \@smaller ) )
+        {
+            say "${indent}Found @smaller" if $Verbose;
+            return 0 + join("", @smaller);
+        }
+        else
+        {
+            my $answer = _big3(\@smaller, "  $indent");
+            say "${indent}returning $answer" if $Verbose;
+            return $answer if $answer >= 0;
+        }
+    }
+    say "${indent}fail, return -1" if $Verbose;
+    return -1;
+}
+
+sub big3(@ints)
+{
+    # Put biggest values first
+    @ints = sort { $b <=> $a } @ints;
+
+    return _big3(\@ints, "");
+}
+
+sub runTest
+{
+    use Test2::V0;
+    use builtin qw/true false/; no warnings "experimental::builtin";
+
+    is( is3([    0]), true,  "is3 0");
+    is( is3([    8]), false, "is3 8");
+    is( is3([    9]), true,  "is3 9");
+    is( is3([  4,7]), false, "is3 47");
+    is( is3([  4,8]), true,  "is3 48");
+    is( is3([1,4,3]), false, "is3 143");
+    is( is3([1,4,4]), true,  "is3 144");
+    is( is3([14,34]), true,  "is3 1434");
+
+    is( big3(8,1,9    ),  981, "Example 1");
+    is( big3(8,6,7,1,0), 8760, "Example 2");
+    is( big3(1        ),   -1, "Example 3");
+
+    done_testing;
+}