Perl Weekly Challenge 305.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 305.
Task 1: Binary Prefix
Submitted by: Mohammad Sajid Anwar
You are given a binary array.
Write a script to return an array of booleans where the partial binary number
up to that point is prime.
Example 1
Input: @binary = (1, 0, 1)
Output: (false, true, true)
Sub-arrays (base-10):
(1): 1 - not prime
(1, 0): 2 - prime
(1, 0, 1): 5 - prime
Example 2
Input: @binary = (1, 1, 0)
Output: (false, true, false)
Sub-arrays (base-10):
(1): 1 - not prime
(1, 1): 3 - prime
(1, 1, 0): 6 - not prime
Example 3
Input: @binary = (1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1)
Output: (false, true, true, false, false, true, false, false, false, false,
false, false, false, false, false, false, false, false, false, true)
I can build the candidate primes one bit at a time by duplicating the
ongoing candidate and adding the current digit. I use the is_prime
test from Math::Prime::Util for fast checking of primality (or
probable primality if the number is very large). This yields a one liner:
Example 1:
perl -MMath::Prime::Util=is_prime -E '
push @r,is_prime($x=2*$x+$_)?"t":"f" for (@ARGV) ; say "@ARGV -> @r";
' 1 0 1
Results:
1 0 1 -> f t t
Example 2:
perl -MMath::Prime::Util=is_prime -E '
push @r,is_prime($x=2*$x+$_)?"t":"f" for (@ARGV) ; say "@ARGV -> @r";
' 1 1 0
Results:
1 1 0 -> f t f
Example 3:
perl -MMath::Prime::Util=is_prime -E '
push @r,is_prime($x=2*$x+$_)?"t":"f" for (@ARGV) ; say "@ARGV -> @r";
' 1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1
Results:
1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 -> f t t f f t f f f f f f f f f f f f f t
I chose t and f rather than true and false for brevity.
The full code is similar, but I encode the binary digits in a single string, so I can test several strings in the same run:
1 # Perl weekly challenge 305
2 # Task 1: Binary Prefix
3 #
4 # See https://wlmb.github.io/2025/01/20/PWC305/#task-1-binary-prefix
5 use v5.36;
6 use Math::Prime::Util qw(is_prime);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 B0 B1 B2...
9 to test whether the binary substrings of the binary strings B0 B1...
10 represet a prime number.
11 FIN
12 for(@ARGV){
13 warn("Expected a bunary string"), next unless /^[01]*$/;
14 my @digits=split "";
15 my @result;
16 my $x=0;
17 push @result, is_prime($x=2*$x+$_)?"t":"f" for (@digits);
18 say "@digits -> @result";
19 }
Examples:
./ch-1.pl 101 110 11110100001010010001
Results:
1 0 1 -> f t t
1 1 0 -> f t f
1 1 1 1 0 1 0 0 0 0 1 0 1 0 0 1 0 0 0 1 -> f t t f f t f f f f f f f f f f f f f t
Task 2: Alien Dictionary
Submitted by: Mohammad Sajid Anwar
You are given a list of words and alien dictionary character order.
Write a script to sort lexicographically the given list of words based
on the alien dictionary characters.
Example 1
Input: @words = ("perl", "python", "raku")
@alien = qw/h l a b y d e f g i r k m n o p q j s t u v w x c z/
Output: ("raku", "python", "perl")
Example 2
Input: @words = ("the", "weekly", "challenge")
@alien = qw/c o r l d a b t e f g h i j k m n p q s w u v x y z/
Output: ("challenge", "the", "weekly")
I can read the dictionary, make a hash with integer values for each letter and use those values to sort the input. I use a Schwartz transform to split the strings into their letters and a recursive sort function. The solution fits a 3-liner.
Example 1:
perl -E '
$v{$_}=$i++for split"",$d=shift;@s=map{$_->[0]}sort{g($a->[1],$b->[1])}map{[$_,[split
"",$_]]}@ARGV;say"$d; @ARGV -> @s";sub g($x,$y){@x=@$x;@y=@$y;return 0unless@x||@y;
return -1unless@y;return 1unless@x;$c=$v{shift@x}<=>$v{shift@y};return$c||g(\@x,\@y)}
' hlabydefgirkmnopqjstuvwxcz perl python raku
Results:
hlabydefgirkmnopqjstuvwxcz; perl python raku -> raku python perl
Example 2:
perl -E '
$v{$_}=$i++for split"",$d=shift;@s=map{$_->[0]}sort{g($a->[1],$b->[1])}map{[$_,[split
"",$_]]}@ARGV;say"$d; @ARGV -> @s";sub g($x,$y){@x=@$x;@y=@$y;return 0unless@x||@y;
return -1unless@y;return 1unless@x;$c=$v{shift@x}<=>$v{shift@y};return$c||g(\@x,\@y)}
' corldabtefghijkmnpqswuvxyz the weekly challenge
Results:
corldabtefghijkmnpqswuvxyz; the weekly challenge -> challenge the weekly
The full code adds a few tests:
1 # Perl weekly challenge 305
2 # Task 2: Alien Dictionary
3 #
4 # See https://wlmb.github.io/2025/01/20/PWC305/#task-2-alien-dictionary
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 D W1 W2...
8 to sort the words Wi according the the order of
9 letters in the dictionary D. The dictionary is
10 a string with all letters.
11 FIN
12 my %values;
13 my $i=0;
14 $values{lc $_}=$i++ for split "", my $dictionary=shift;
15 die "Non-ascii letters: $dictionary" unless $dictionary =~ /^[a-z]*$/i;
16 my @letters=("A".."Z");
17 die "Missing letters: $dictionary" unless keys %values==@letters;
18 die "Repeated letters: $dictionary" unless length $dictionary == @letters;
19
20 my @sorted= map {$_->[0]}
21 sort {compare($a->[1], $b->[1])}
22 map {[$_, [split "", $_]]} @ARGV;
23 say "$dictionary; @ARGV -> @sorted";
24
25 sub compare($x, $y){
26 my @x=@$x;
27 my @y=@$y;
28 return 0 unless @x||@y; #
29 return -1 unless @y;
30 return 1 unless @x;
31 my $cmp = $values{shift @x}<=>$values{shift @y};
32 return $cmp || compare(\@x,\@y);
33 }
34
Example:
./ch-2.pl hlabydefgirkmnopqjstuvwxcz perl python raku
./ch-2.pl corldabtefghijkmnpqswuvxyz the weekly challenge
Results:
hlabydefgirkmnopqjstuvwxcz; perl python raku -> raku python perl
corldabtefghijkmnpqswuvxyz; the weekly challenge -> challenge the weekly
Written on January 20, 2025