Perl Weekly Challenge 193.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 193.
Task 1: Binary String
Submitted by: Mohammad S Anwar
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
I just have to count up until I reach the maximum binary number with n bits, namely, 2n-1, and print the result in zero-padded binary notation with n bits. This yields a simple one liner:
perl -E '
foreach(@ARGV){print "$_: "; my $i; print sprintf "%0${_}b ", $i++ while $i<2**$_; say ""}
' 1 2 3 4 | fold -w 68
Results:
1: 0 1
2: 00 01 10 11
3: 000 001 010 011 100 101 110 111
4: 0000 0001 0010 0011 0100 0101 0110 0111 1000 1001 1010 1011 1100
1101 1110 1111
The corresponding full code is
1 # Perl weekly challenge 193
2 # Task 1: Binary String
3 #
4 # See https://wlmb.github.io/2022/11/29/PWC193/#task-1-binary-string
5 use v5.36;
6 die <<"EOF" unless @ARGV;
7 Usage; $0 n1 [n2...]
8 to print all binary numbers with n_i digits
9 EOF
10 foreach(@ARGV){
11 say("Expected positive number: $_"),next unless $_>0;
12 print "Binary numbers with $_ digit", $_>1?"s:":": ";
13 my $i=0;
14 print sprintf "%0${_}b ", $i++ while $i<2**$_;
15 say "";
16 }
Example:
./ch-1.pl 1 2 3 4 |fold -w 68
Results:
Binary numbers with 1 digit: 0 1
Binary numbers with 2 digits:00 01 10 11
Binary numbers with 3 digits:000 001 010 011 100 101 110 111
Binary numbers with 4 digits:0000 0001 0010 0011 0100 0101 0110 0111
1000 1001 1010 1011 1100 1101 1110 1111
Task 2: Odd String
Submitted by: Mohammad S Anwar
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.
The difference between lower case ascii letters can take the 51 different values from -25 up to 25. This I can map them to the digits 0-50 of a number in base 51. This number represents the difference array. To solve the problem I split the words into letters, map them to their positional values, calculate the difference array, map it to a single number and map each word to its corresponding number and each number to the number of times it has appeared. The odd words are those whose corresponding number appears only once. This yields a two liner:
perl -MList::Util=reduce -E '
sub f($x){($f,@r)=map {ord($_)-ord("a")} split "", $x; reduce{51*$a+$b} map {($p,$f)=($f,$_); $f-$p+25} @r}
++$r{$n{$_}=f($_)} for @ARGV; $r{$n{$_}}>1 || say "$_" for keys %n;
' adc wzy abc
perl -MList::Util=reduce -E '
sub f($x){($f,@r)=map {ord($_)-ord("a")} split "", $x; reduce{51*$a+$b} map {($p,$f)=($f,$_); $f-$p+25} @r}
++$r{$n{$_}=f($_)} for @ARGV; $r{$n{$_}}>1 || say "$_" for keys %n;
' aaa bob ccc ddd
Results:
abc
bob
The corresponding full code is:
1 # Perl weekly challenge 193
2 # Task 2: Odd String
3 #
4 # See https://wlmb.github.io/2022/11/29/PWC193/#task-2-odd-string
5 use v5.36;
6 use List::Util qw(reduce);
7 use bigint; # in case of many-lettered words
8 sub str2num($str){ # convert a string into an array of differences and a number
9 die "Only a..z allowed and >1 chars: $str" unless $str=~/^[a-z]{2,}$/;
10 $str=lc $str; # normalize to lower case
11 state $length=length $str;
12 die "Length of string must be larger than 1: $str" unless $length>1;
13 die "All strings musts have the same length: $str"
14 unless length $str == $length;
15 my ($next, @rest)=map {ord($_)-ord("a")} split "", $str;
16 my $previous;
17 reduce {51*$a+$b} # interpret elements as base-51 digits
18 map {
19 ($previous, $next)=($next, $_);
20 $next-$previous+25
21 } @rest
22 }
23 my %repetitions_of;
24 my %number_of;
25 ++$repetitions_of{$number_of{$_}=str2num($_)} for @ARGV; # initialize hashes
26 my @odd = grep {$repetitions_of{$number_of{$_}}==1} keys %number_of; # filter odd's
27 say join(", ", @ARGV), " -> ", join(", ", @odd);
Example:
./ch-2.pl adc wzy abc ab
./ch-2.pl aaa bob ccc ddd
Results:
adc, wzy, abc -> abc
aaa, bob, ccc, ddd -> bob
/;
Written on November 29, 2022