Merge pull request #7368 from boblied/master

Week 191 boblied

3 files changed, 160 insertions, 2 deletions

diff --git a/challenge-191/bob-lied/README b/challenge-191/bob-lied/README
index c231e3a589..6fb0b491da 100644
--- a/challenge-191/bob-lied/README
+++ b/challenge-191/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 191 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-191/
diff --git a/challenge-191/bob-lied/perl/ch-1.pl b/challenge-191/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..cdc0d034a1
--- /dev/null
+++ b/challenge-191/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:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Task 1 Twice Largest
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given list of integers, @list.
+# Write a script to find out whether the largest item in the list is at least
+# twice as large as each of the other items.
+# 
+# Example 1 Input: @list = (1,2,3,4) Output: -1
+#   The largest in the given list is 4.  #   However 4 is not greater than 2*3
+# Example 2 Input: @list = (1,2,0,5) Output: 1
+#   The largest in the given list is 5. Also 5 is greater than twice of
+#   every remaining elements.
+# Example 3 Input: @list = (2,6,3,1) Output: 1
+#   The largest in the given list is 6. Also 6 is greater than twice of
+#   every remaining elements.
+# Example 4 Input: @list = (4,5,2,3) Output: -1
+#   The largest in the given list is 5. But 5 is less than 2*4 and 2*3
+#
+# Specification is ambiguous about multiple occurrences of the max.  One
+# interpretation is that only one copy of max is taken out of the list for
+# comparison, meaning that the duplicate will fail the test.  The other
+# interpretation is that all copies of the maximum value are taken out
+# of the list before comparison.
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/all/;
+use List::MoreUtils qw/after_incl/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+(my $list = "@ARGV") =~ s/[[:punct:]]/ /g;
+say twiceLargest( [ split ' ', $list ] );
+
+sub twiceLargest($list)
+{
+    # Sort to put the max at the front, then shift it off
+    my @rest = sort { $b <=> $a } $list->@*;
+    my $max = shift @rest;
+
+    # Handle duplicates of max by excluding all max values.
+    @rest = after_incl { $_ < $max } @rest;
+
+    return ( all { $max >= 2*$_ } @rest )? 1 : -1;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( twiceLargest( [1,2,3,4]), -1, "Example 1");
+    is( twiceLargest( [1,2,0,5]),  1, "Example 2");
+    is( twiceLargest( [2,6,3,1]),  1, "Example 3");
+    is( twiceLargest( [4,5,2,3]), -1, "Example 4");
+    is( twiceLargest( [8,8,2,3]),  1, "Dup max");
+
+    done_testing;
+}
+
diff --git a/challenge-191/bob-lied/perl/ch-2.pl b/challenge-191/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..da130e329d
--- /dev/null
+++ b/challenge-191/bob-lied/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 191, Task 2 Cute List
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an integer, 0 < $n <= 15.
+# Write a script to find the number of orderings of numbers that form a
+# cute list.
+# With an input @list = (1, 2, 3, .. $n) for positive integer $n, an ordering
+# of @list is cute if for every entry, indexed with a base of 1, either
+#   1) $list[$i] is evenly divisible by $i
+# or
+#   2) $i is evenly divisible by $list[$i]
+#
+# Example Input: $n = 2 Ouput: 2
+#   Since $n = 2, the list can be made up of two integers only i.e. 1 and 2.
+#   Therefore we can have two list i.e. (1,2) and (2,1).
+#   @list = (1,2) is cute since $list[1] = 1 is divisible by 1 and $list[2] = 2 is divisible by 2.
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+for my $n ( grep { 0 < $_ <= 15 } @ARGV )
+{
+    say cuteList($n);
+}
+
+# Brute force would be to generate all the permutations and check
+# each one, but 15! is ... a lot.  Better to generate the possibilities
+# and count them.
+
+sub cuteList($n)
+{
+    my $count = 0;
+    my $cute = choose($n, 1, [ 1..$n ], \$count, [], "");
+    return $count;
+}
+
+sub choose($n, $i, $avail, $count, $permutation, $indent)
+{
+    say "${indent}choose n=$n i=$i c=$$count avail=[@$avail] p=[@$permutation]" if $Verbose;
+    if ( scalar(@$avail) == 0 )
+    {
+        say "${indent}Found permutation [ @$permutation ]" if $Verbose;
+        $$count++;
+        say "${indent}Progress: count=$$count" if $Verbose && $$count%1000==0;
+        return 1;
+    }
+    return 0 if ( $i > $n );
+
+    my @canFill = grep { $i % $avail->[$_] == 0 || $avail->[$_] % $i == 0 } 0 .. (scalar(@$avail-1));
+
+    return 0 if ( @canFill == 0 );
+
+    for ( @canFill )
+    {
+        my $subset = [ $avail->@* ]; # clone
+        my $p = [ $permutation->@*, $avail->[$_] ];
+        splice(@$subset, $_, 1);
+        choose($n, $i+1, $subset, $count, $p, "  $indent");
+    }
+}
+
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( cuteList( 2),     2, "Example 1");
+    is( cuteList( 1),     1, "Example 2");
+    is( cuteList( 3),     3, "Example 3");
+    is( cuteList( 4),     8, "Example 4");
+    is( cuteList( 5),    10, "Example 5");
+    is( cuteList(10),   700, "Example 10");
+    is( cuteList(12),  4010, "Example 12");
+    is( cuteList(15), 24679, "Example 15");
+
+    done_testing;
+}
+