Merge pull request #7418 from boblied/master

Backlog week 193 from bob-lied

3 files changed, 173 insertions, 2 deletions

diff --git a/challenge-193/bob-lied/README b/challenge-193/bob-lied/README
index c231e3a589..ca635b932e 100644
--- a/challenge-193/bob-lied/README
+++ b/challenge-193/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 138 by Bob Lied
+Solutions to weekly challenge 193 by Bob Lied
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-138/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-193/
diff --git a/challenge-193/bob-lied/perl/ch-1.pl b/challenge-193/bob-lied/perl/ch-1.pl
new file mode 100644
index 0000000000..dfe89058f4
--- /dev/null
+++ b/challenge-193/bob-lied/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl Perl Weekly Challenge Week 193 Task 1 Binary String
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given an integer, $n > 0.
+# Write a script to find all possible binary numbers of size $n.
+# Example 1 Input: $n = 2 Output: 00, 11, 01, 10
+# Example 2 Input: $n = 3 Output: 000, 001, 010, 100, 111, 110, 101, 011
+#
+# Not sure what creates this order of numbers, will pass tests if the same
+# set of numbers is generated.
+#=============================================================================
+
+use v5.36;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+sub _bs($n)
+{
+    my @s = ();
+    for ( 0 .. 2**$n-1) 
+    {
+        push @s, sprintf("%0${n}b", $_);
+    }
+    return \@s;
+}
+
+sub binaryString($n)
+{
+    return join ", ", sort { $a cmp $b } _bs($n)->@*;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( _bs(2), bag { item $_ for qw/ 00 01 10 11 / }, "Example 1 bag");
+    is( _bs(3), bag { item $_ for qw/ 000 001 010 011 100 101 110 111 / }, "Example 2 bag");
+
+    is( binaryString(2), "00, 01, 10, 11", "Example 1");
+    is( binaryString(3), "000, 001, 010, 011, 100, 101, 110, 111", "Example 2");
+
+    done_testing;
+}
+
diff --git a/challenge-193/bob-lied/perl/ch-2.pl b/challenge-193/bob-lied/perl/ch-2.pl
new file mode 100644
index 0000000000..32f5516150
--- /dev/null
+++ b/challenge-193/bob-lied/perl/ch-2.pl
@@ -0,0 +1,118 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl Perl Weekly Challenge Week 193 Task 2 Odd String
+#=============================================================================
+# Copyright (c) 2023, Bob Lied
+#=============================================================================
+# You are given a list of strings of same length, @s.
+# Write a script to find the odd string in the given list. Use positional
+# value of alphabet starting with 0, i.e. a = 0, b = 1, ... z = 25.
+# Find the difference array for each string as shown in the example.
+# Then pick the odd one out.
+#
+# Example 1: Input: @s = ("adc", "wzy", "abc") Output: "abc"
+#   Difference array for "adc" => [ d - a, c - d ]
+#                              => [ 3 - 0, 2 - 3 ]     => [ 3, -1 ]
+#   Difference array for "wzy" => [ z - w, y - z ]
+#                              => [ 25 - 22, 24 - 25 ] => [ 3, -1 ]
+#   Difference array for "abc" => [ b - a, c - b ]
+#                              => [ 1 - 0, 2 - 1 ]     => [ 1,  1 ]
+#   The difference array for "abc" is the odd one.
+# 
+# Example 2: Input: @s = ("aaa", "bob", "ccc", "ddd") Output: "bob"
+#   Difference array for "aaa" => [ a - a, a - a ]
+#                              => [ 0 - 0, 0 - 0 ] => [  0,   0 ]
+#   Difference array for "bob" => [ o - b, b - o ]
+#                            => [ 14 - 1, 1 - 14 ] => [ 13, -13 ]
+#   Difference array for "ccc" => [ c - c, c - c ]
+#                            => [ 2 - 2, 2 - 2 ]   => [  0,   0 ]
+#   Difference array for "ddd" => [ d - d, d - d ]
+#                            => [ 3 - 3, 3 - 3 ]   => [  0,   0 ]
+#   The difference array for "bob" is the odd one.
+#=============================================================================
+
+use v5.36;
+
+use List::Util qw/all min/;
+
+use Getopt::Long;
+my $Verbose = 0;
+my $DoTest  = 0;
+
+GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
+exit(!runTest()) if $DoTest;
+
+say oddString(@ARGV);
+
+sub oddString(@list)
+{
+    if ( @list < 3 )
+    {
+        warn "Should have at least three words";
+        return "";
+    }
+
+    my $len = length($list[0]); # All assumed to be same length
+    if ( ! all { length($_) == $len } @list ) 
+    {
+        # But go on, we can work up to a point
+        $len = min map { length($_) } @list;
+        warn "Not all strings same length, using length=$len";
+    }
+
+    # Convert each word into an array of numeric values We could use
+    # ord(_)-ord('a') to match the spec exactly, but it cancels out
+    # when we do the subtractions. ord(_) is enough.
+    #
+    # The outer map is forming an array of array references.
+    # The inner map is doing the conversion from letters to numbers.
+    #
+    # Use of $_ is a bit subtle here.  At the right end, it refers
+    # to the string in the @list array; in the ord in the middle
+    # it refers to one character from the split operation.
+    my @nlist = map { [ map { ord($_) } split '', $_ ] } @list;
+
+    # Instead of computing the difference arrays and comparing them,
+    # compare the differences at position i of each word.  We can
+    # stop as soon as we see any unique value.
+    for ( my $i = 1 ; $i < $len ; $i++ ) # Note: starts at 1, not 0
+    {
+        my $uniq = uniqIndex( map { $_->[$i] - $_->[$i-1] } @nlist );
+        return $list[$uniq] if $uniq != -1;
+    }
+    return "";  # They're all the same, no unique value
+}
+
+# Find the position of a unique value, assuming the list
+# is at least 3 long and there exists only one unique value
+sub uniqIndex(@list)
+{
+    use List::MoreUtils qw/first_index/;
+
+    if ( $list[0] != $list[1] )
+    {
+        # One of the first two numbers is the unique one
+        return ( $list[0] == $list[2] ) ? 1 : 0;
+    }
+    return first_index { $_ != $list[0] } @list;
+}
+
+sub runTest
+{
+    use Test2::V0;
+
+    is( oddString("adc", "wzy", "abc"),        "abc", "Example 1");
+    is( oddString("aaa", "bob", "ccc", "ddd"), "bob", "Example 2");
+    is( oddString("bob", "bob", "bob"),           "", "No odd one");
+    is( oddString("abcd", "mnop", "stuw"),    "stuw", "Different at end");
+    is( oddString("abcd", "mnqp", "stuv"),    "mnqp", "Different in middle");
+    is( oddString("abcd", "aceg", "adgj"),    "abcd", "Not unique diffs, chooses first");
+    is( oddString("abce", "mnop", "stuvwxyz"),"abce", "Different lengths accidentally works");
+    is( oddString("abcd", "mnop", "stuxw"),  "stuxw", "Different lengths works up to a point");
+    is( oddString("abcde", "mnop", "stuv"),       "", "Different lengths breaks");
+    is( oddString("foo", "bar"),                  "", "Not enough words");
+    is( oddString("abcd", "mñop", "stuw"),    "mñop", "En español");
+
+    done_testing;
+}