diff options
| -rw-r--r-- | challenge-193/bob-lied/README | 4 | ||||
| -rw-r--r-- | challenge-193/bob-lied/perl/ch-1.pl | 53 | ||||
| -rw-r--r-- | challenge-193/bob-lied/perl/ch-2.pl | 118 |
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; +} |