Merge pull request #9433 from boblied/w252

Week 252 from Bob Lied

3 files changed, 175 insertions, 3 deletions

diff --git a/challenge-252/bob-lied/README b/challenge-252/bob-lied/README
index 1fb5d8a320..8b958edfe8 100644
--- a/challenge-252/bob-lied/README
+++ b/challenge-252/bob-lied/README
@@ -1,4 +1,4 @@
-Solutions to weekly challenge 251 by Bob Lied
+Solutions to weekly challenge 252 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-251/
-https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-251/bob-lied
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-252/
+https://github.com/boblied/perlweeklychallenge-club/tree/master/challenge-252/bob-lied
diff --git a/challenge-252/bob-lied/perl/ch-1.pl b/challenge-252/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..90da967a76
--- /dev/null
+++ b/challenge-252/bob-lied/perl/ch-1.pl
@@ -0,0 +1,85 @@
+#!/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 252 Task 1 Special Numbers
+#=============================================================================
+# You are given an array of integers, @ints.
+# Write a script to find the sum of the squares of all special elements of
+# the given array.  An element $int[i] of @ints is called special if
+# i divides n, i.e. n % i == 0.  Where n is the length of the given array.
+# Also the array is 1-indexed for the task.
+# Example 1 Input: @ints = (1, 2, 3, 4)
+#           Output: 21
+#   There are exactly 3 special elements in the given array:
+#   $ints[1] since 1 divides 4,
+#   $ints[2] since 2 divides 4, and
+#   $ints[4] since 4 divides 4.
+#   Hence, the sum of the squares of all special elements of given array:
+#   1 * 1 + 2 * 2 + 4 * 4 = 21.
+# Example 2 Input: @ints = (2, 7, 1, 19, 18, 3)
+#           Output: 63
+#=============================================================================
+
+use v5.38;
+
+use builtin qw/true false/; no warnings "experimental::builtin";
+use List::Util qw/sum0/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub specialNumbers(@ints)
+{
+    my $len = @ints;
+    # Insert an extra element at the front to make it 1-indexed
+    unshift @ints, $len+1;
+
+    return sum0 map { $_ * $_ } @ints[ grep { $len % $_ == 0 } 1 .. $len ];
+}
+
+sub factorsOf($n)
+{
+    use List::Util qw/uniqint/;
+    my @flist = (1, $n);
+    for my $f ( 2 .. int(sqrt($n)) )
+    {
+        push @flist, ($f, $n/$f) if $n % $f == 0;
+    }
+    return [ uniqint sort { $a <=> $b } @flist ]
+}
+
+sub sn2(@ints)
+{
+    use List::MoreUtils qw/before/;
+    my $len = @ints;
+    return 0 if $len == 0;
+    my @choose = map { $_ - 1 } before { $_ > $len } factorsOf($len)->@*;
+    return sum0 map { $_ * $_ } @ints[@choose];
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( specialNumbers(1,2,3,4),       21, "Example 1");
+    is( specialNumbers(2,7,1,19,18,3), 63, "Example 2");
+    is( specialNumbers(8            ), 64, "Singleton");
+    is( specialNumbers()            ,   0, "Empty list");
+
+    is( sn2(1,2,3,4),       21, "sn2 Example 1");
+    is( sn2(2,7,1,19,18,3), 63, "sn2 Example 2");
+    is( sn2(8            ), 64, "sn2 Singleton");
+    is( sn2()            ,   0, "sn2 Empty list");
+
+    is( factorsOf( 6), [1,2,3,6], "factorsOf 6");
+    is( factorsOf(36), [1,2,3,4,6,9,12,18,36], "factorsOf 36");
+
+    done_testing;
+}
diff --git a/challenge-252/bob-lied/perl/ch-2.pl b/challenge-252/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..505be53aed
--- /dev/null
+++ b/challenge-252/bob-lied/perl/ch-2.pl
@@ -0,0 +1,87 @@
+#!/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 252 Task 2 Unique Sum Zero
+#=============================================================================
+# You are given an integer, $n.  Write a script to find an array containing
+# $n unique integers such that they add up to zero.
+# Example 1 Input: $n = 5
+#           Output: (-7, -1, 1, 3, 4)
+#   Two other possible solutions could be as below:
+#   (-5, -1, 1, 2, 3) and (-3, -1, 2, -2, 4).
+# Example 2 Input: $n = 3
+#           Output: (-1, 0, 1)
+# Example 3 Input: $n = 1
+#           Output: (0)
+#=============================================================================
+
+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;
+
+sub usz($n)
+{
+    my @list;
+    my $pick = 2;
+    while ( $n > 0 )
+    {
+        if ( $n == 1 )
+        {
+            push @list, 0;
+            $n -= 1;
+        }
+        elsif ( $n == 2 )
+        {
+            push @list, (1, -1);
+            $n -= 2;
+        }
+        else
+        {
+            push @list, ( $pick, $pick+1, -($pick+$pick+1) );
+            $pick += 2;
+            $n -= 3;
+        }
+    }
+    say "\@usz=(@list)" if $Verbose;
+    return @list;
+}
+
+sub usz2($n)
+{
+    return ( $n == 0 ? () : ( (1 .. $n-1), -( $n*($n-1)/2 ) ) );
+}
+
+sub runTest
+{
+    use Test2::V0;
+    use List::Util qw/sum0 uniqint/;
+
+    my @usz;
+
+    for my $n ( 0 .. 5 )
+    {
+        @usz = usz($n);
+        is( scalar(@usz),                    $n, "n=$n count");
+        is( sum0(@usz),                       0, "n=$n sum");
+        is( scalar(uniqint(@usz)), scalar(@usz), "n=$n unique");
+    }
+
+    for my $n ( reverse 0 .. 5 )
+    {
+        @usz = usz2($n);
+        is( scalar(@usz),                    $n, "usz2 n=$n count");
+        is( sum0(@usz),                       0, "nusz2 =$n sum");
+        is( scalar(uniqint(@usz)), scalar(@usz), "nusz2 =$n unique");
+    }
+
+    done_testing;
+}